No OneTemporary
Actions

Size

4 MB

Subscribers

None

View Options

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

	Index: trunk/src/process_integration/process_integration.nw
	===================================================================
	--- trunk/src/process_integration/process_integration.nw (revision 8835)
	+++ trunk/src/process_integration/process_integration.nw (revision 8836)
	@@ -1,23918 +1,23959 @@
	% -- 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

	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

	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%meta%final ()
	call process%env%final ()
	! call process%config%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
	- phs_config => process%component(i_component)%phs_config
	+ 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
	- 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
	+ 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
	@ Current implementation: nothing to finalize.
	<<Process config: process config data: TBP>>=
	procedure :: final => process_config_data_final
	<<Process config: sub interfaces>>=
	module subroutine process_config_data_final (config)
	class(process_config_data_t), intent(inout) :: config
	end subroutine process_config_data_final
	<<Process config: procedures>>=
	module subroutine process_config_data_final (config)
	class(process_config_data_t), intent(inout) :: config
	end subroutine process_config_data_final

	@ %def process_config_data_final
	@ 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

	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, &
	component(pcm%i_real)%phs_config, model, alpha_power, alphas_power)
	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, phs_config, model, alpha_power, alphas_power)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	class(phs_config_t), intent(inout) :: phs_config
	type(model_t), intent(in), target :: model
	integer, intent(in) :: alpha_power, alphas_power
	end subroutine pcm_nlo_setup_region_data
	<<PCM: procedures>>=
	module subroutine pcm_nlo_setup_region_data &
	(pcm, core_entry, phs_config, model, alpha_power, alphas_power)
	class(pcm_nlo_t), intent(inout) :: pcm
	type(core_entry_t), dimension(:), intent(in) :: core_entry
	class(phs_config_t), intent(inout) :: phs_config
	type(model_t), intent(in), target :: model
	integer, intent(in) :: alpha_power, alphas_power
	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
	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_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_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

	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.
	<<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)
	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
	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
	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
	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
	+ 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%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 &
	(size (process%get_component_i_terms (i_component))))
	i_terms = 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 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/fks/fks.nw
	===================================================================
	--- trunk/src/fks/fks.nw (revision 8835)
	+++ trunk/src/fks/fks.nw (revision 8836)
	@@ -1,12049 +1,12056 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: matrix elements and process libraries
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{FKS Subtraction Scheme}
	\includemodulegraph{fks}

	The code in this chapter implements the FKS subtraction scheme for use
	with \whizard.

	These are the modules:
	\begin{description}
	\item[fks\_regions]
	Given a process definition, identify singular regions in the
	associated phase space.
	\item[virtual]
	Handle the virtual correction matrix element.
	\item[real\_subtraction]
	Handle the real-subtraction matrix element.
	\item[nlo\_data]
	Manage the subtraction objects.
	\item[dglap\_remnant]
	Handle the DGLAP Remnant matrix element.
	\end{description}

	This chapter deals with next-to-leading order contributions to cross sections.
	Basically, there are three major issues to be adressed: The creation
	of the $N+1$-particle flavor structure, the construction of the
	$N+1$-particle phase space and the actual calculation of the real- and
	virtual-subtracted matrix elements. The first is dealt with using the
	[[auto_components]] class, and it will be shown that the second
	and third issue are connected in FKS subtraction.

	\section{Brief outline of FKS subtraction}
	{\em In the current state, this discussion is only concerned with
	lepton collisions. For hadron collisions, renormalization of parton
	distributions has to be taken into account. Further, for QCD
	corrections, initial-state radiation is necessarily
	present.}

	The aim is to calculate the next-to-leading order cross section
	according to
	\begin{equation*}
	d\sigma_{\rm{NLO}} = \mathcal{B} + \mathcal{V} +
	\mathcal{R}d\Phi_{\rm{rad}}.
	\end{equation*}
	Analytically, the divergences, in terms of poles in the complex
	quantity $\varepsilon = 2-d/2$, cancel. However, this is in general
	only valid in an arbitrary, complex number of dimensions. This is,
	roughly, the content of the KLN-theorem. \whizard, as any
	other numerical program, is confined to four dimensions. We will
	assume that the KLN-theorem is valid and that there exist subtraction
	terms $\mathcal{C}$ such that
	\begin{equation*}
	d\sigma_{\rm{NLO}} = \mathcal{B} + \underbrace{\mathcal{V} +
	\mathcal{C}}_{\text{finite}} + \underbrace{\mathcal{R} -
	\mathcal{C}}_{\text{finite}},
	\end{equation*}
	i.e. the subtraction terms correspond to the divergent limits of the
	real and virtual matrix element.

	Because $\mathcal{C}$ subtracts the divergences of $\mathcal{R}$ as
	well as those of $\mathcal{V}$, it suffices to consider one of them,
	so we focus on $\mathcal{R}$. For this purpose, $\mathcal{R}$ is
	rewritten as
	\begin{equation*}
	\mathcal{R} = \frac{1}{\xi^2}\frac{1}{1-y} \left(\xi^2
	(1-y)\mathcal{R}\right) =
	\frac{1}{\xi^2}\frac{1}{1-y}\tilde{\mathcal{R}},
	\end{equation*}
	with $\xi = \left(2k_{\rm{rad}}^0\right)/\sqrt{s}$ and $y =
	\cos\theta$, where $k_{\rm{rad}}^0$ denotes the energy of the radiated
	parton and $\theta$ is the angle between emitter and radiated
	parton. $\tilde{\mathcal{R}}$ is finite, therefore the whole
	singularity structure is contained in the prefactor
	$\xi^{-2}(1-y)^{-1}$. Combined with the $d$-dimensional phase space
	element,
	\begin{equation*}
	\frac{d^{d-1}k}{2k^0(2\pi)^{d-1}} =
	\frac{s^{1-\varepsilon}}{(4\pi)^{d-1}}\xi^{1-2\varepsilon}\left(1-y^2\right)^{-\varepsilon}
	d\xi dy d\Omega^{d-2},
	\end{equation*}
	this yields
	\begin{equation*}
	d\Phi_{\rm{rad}} \mathcal{R} = dy (1-y)^{-1-\varepsilon} d\xi
	\xi^{-1-2\varepsilon} \tilde{R}.
	\end{equation*}
	This can further be rewritten in terms of plus-distributions,
	\begin{align*}
	\xi^{-1-2\varepsilon} &= -\frac{1}{2\varepsilon}\delta(\xi) +
	\left(\frac{1}{\xi}\right)_+ -
	2\varepsilon\left(\frac{\log\xi}{\xi}\right)_+ +
	\mathcal{O}(\varepsilon^2),\\
	(1-y)^{-1-\varepsilon} &= -\frac{2^{-\varepsilon}}{\varepsilon}
	\delta(1-y) + \left(\frac{1}{1-y}\right)_+ - \varepsilon
	\left(\frac{1}{1-y}\right)_+\log(1-y) + \mathcal{O}(\varepsilon^2),
	\end{align*}
	(imagine that all this is written inside of integrals, which are
	spared for ease of notation) such that
	\begin{align*}
	d\Phi_{\rm{rad}} \mathcal{R} &= -\frac{1}{2\varepsilon} dy
	(1-y)^{-1-\varepsilon}\tilde{R} (0,y) -
	d\xi\left[\frac{2^{-\varepsilon}}{\varepsilon}\left(\frac{1}{\xi}\right)_+
	- 2\left(\frac{\log\xi}{\xi}\right)_+\right] \tilde{R}(\xi,1) \\
	&+ dy d\xi \left(\frac{1}{\xi}\right)_+
	\left(\frac{1}{1-y}\right)_+
	\tilde{R}(\xi, y) +
	\mathcal{O}(\varepsilon).\\
	\end{align*}
	The summand in the second line is of order $\mathcal{O}(1)$ and is the
	only one to reproduce $\mathcal{R}(\xi,y)$. It thus constitutes the
	sum of the real matrix element and the corresponding counterterms.
	The first summand consequently consists of the subtraction terms to
	the virtual matrix elements. Above formula thus allows to calculate
	all quantities to render the matrix elements finite.

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Identifying singular regions}
	In the FKS subtraction scheme, the phase space is decomposed into
	disjoint singular regions, such that
	\begin{equation}
	\label{eq:S_complete}
	\sum_i \mathcal{S}_i + \sum_{ij}\mathcal{S}_{ij} = 1.
	\end{equation}
	The quantities $\mathcal{S}_i$ and $\mathcal{S}_{ij}$ are functions of
	phase space corresponding to a pair of particles indices which can
	make up a divergent phase space region. We call such an index pair a
	fundamental tuple. For example, the process $e^+ \, e^- \rightarrow u
	\, \bar{u} \, g$ has two singular regions, $(3,5)$ and $(4,5)$,
	indicating that the gluon can be soft or collinear with respect to
	either the quark or the anti-quark. Therefore, the functions $S_{ij}$
	have to be chosen in such a way that their contribution makes up most
	of \eqref{eq:S_complete} in phase-space configurations where
	(final-state) particle $j$ is collinear to particle $i$ or/and
	particle $j$ is soft. The functions $S_i$ is the corresponding
	quantity for initial-state divergences.

	As a singular region we understand the collection of real flavor
	structures associated with an emitter and a list of all possible
	fundamental tuples. As an example, consider the process $e^+ \, e^-
	\rightarrow u \, \bar{u} \, g$. At next-to-leading order, processes
	with an additionally radiated particle have to be considered. In this
	case, these are $e^+ \, e^- \rightarrow u \, \bar{u}, \, g \, g$,
	and $e^+ \, e^- \rightarrow u \, \bar{u} \, u \, \bar{u}$ (or the same
	process with any other quark). Table \ref{table:singular regions} sums
	up all possible singular regions for this problem.
	\begin{table}
	\begin{tabular}{\|c\|c\|c\|c\|}
	\hline
	\texttt{alr} & \texttt{flst\_alr} & \texttt{emitter} &
	\texttt{ftuple\_list}\\ \hline
	1 & [-11,11,2,-2,21,21] & 3 & {(3,5), (3,6), (4,5), (4,6), (5,6)} \\ \hline
	2 & [-11,11,2,-2,21,21] & 4 & {(3,5), (3,6), (4,5), (4,6), (5,6)} \\ \hline
	3 & [-11,11,2,-2,21,21] & 5 & {(3,5), (3,6), (4,5), (4,6), (5,6)} \\ \hline
	4 & [-11,11,2,-2,2,-2] & 5 & {(3,4), (3,6), (4,5), (5,6)} \\
	\hline
	\end{tabular}
	\caption{List of singular regions. The particles are represented by
	their PDG codes. The third column contains the emitter for the
	specific singular region. For the process involving an additional
	gluon, the gluon can either be emitted from one of the quarks or
	from the first gluon. Each emitter yields the same list of
	fundamental tuples, five in total. The last singular region
	corresponds to the process where the gluon splits up into two
	quarks. As the matrix element for this process has no information
	on which quarks originate from a gluon splitting, there are ftuples
	for all the quark pairs and not just those involving the emitter.}
	\label{table:singular regions}
	\end{table}
	\\
	\begin{table}
	\begin{tabular}{\|c\|c\|c\|c\|}
	\hline
	\texttt{alr} & \texttt{ftuple} & \texttt{emitter} &
	\texttt{flst\_alr} \\ \hline
	1 & $(3,5)$ & 5 & [-11,11,-2,21,2,21] \\ \hline
	2 & $(4,5)$ & 5 & [-11,11,2,21,-2,21] \\ \hline
	3 & $(3,6)$ & 5 & [-11,11,-2,21,2,21] \\ \hline
	4 & $(4,6)$ & 5 & [-11,11,2,21,-2,21] \\ \hline
	5 & $(5,6)$ & 5 & [-11,11,2,-2,21,21] \\ \hline
	6 & $(5,6)$ & 5 & [-11,11,2,-2,2,-2] \\ \hline
	\end{tabular}
	\caption{Initial list of singular regions}
	\label{table:ftuples and flavors}
	\end{table}
	Thus, during the preparation of a NLO-calculation, the possible
	singular regions have to be identified. [[fks_regions.f90]] deals
	with this issue.

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{FKS Regions}
	<<[[fks_regions.f90]]>>=
	<<File header>>

	module fks_regions

	<<Use kinds>>
	<<Use strings>>
	use diagnostics
	use os_interface
	use constants
	use process_constants
	use lorentz
	use models
	use resonances, only: resonance_contributors_t, resonance_history_t
	use phs_fks, only: phs_identifier_t, check_for_phs_identifier

	use nlo_data

	<<Standard module head>>

	<<FKS regions: public>>

	<<FKS regions: parameters>>

	<<FKS regions: types>>

	<<FKS regions: interfaces>>

	interface
	<<FKS regions: sub interfaces>>
	end interface

	contains

	<<FKS regions: main procedures>>

	end module fks_regions

	@ %def fks_regions
	@
	<<[[fks_regions_sub.f90]]>>=
	<<File header>>

	submodule (fks_regions) fks_regions_s

	<<Use debug>>
	use format_utils, only: write_separator
	use numeric_utils
	use string_utils, only: str
	use io_units
	use permutations
	use physics_defs
	use flavors
	use pdg_arrays

	implicit none

	contains

	<<FKS regions: procedures>>

	end submodule fks_regions_s

	@ %def fks_regions_s
	@ There are three fundamental splitting types: $q \rightarrow qg$, $g
	\rightarrow gg$ and $g \rightarrow qq$ for FSR and additionally $q
	\rightarrow gq$ for ISR which is different from $q \rightarrow qg$ by
	which particle enters the hard process.
	<<FKS regions: parameters>>=
	integer, parameter :: UNDEFINED_SPLITTING = 0
	integer, parameter :: F_TO_FV = 1
	integer, parameter :: V_TO_VV = 2
	integer, parameter :: V_TO_FF = 3
	integer, parameter :: F_TO_VF = 4

	@
	@ We group the indices of the emitting and the radiated particle in
	the [[ftuple]]-object.
	<<FKS regions: public>>=
	public :: ftuple_t
	<<FKS regions: types>>=
	type :: ftuple_t
	integer, dimension(2) :: ireg = [-1,-1]
	integer :: i_res = 0
	integer :: splitting_type
	logical :: pseudo_isr = .false.
	logical :: qcd_split = .false.
	contains
	<<FKS regions: ftuple: TBP>>
	end type ftuple_t

	@ %def ftuple_t
	@
	<<FKS regions: interfaces>>=
	interface assignment(=)
	module procedure ftuple_assign
	end interface

	interface operator(==)
	module procedure ftuple_equal
	end interface

	interface operator(>)
	module procedure ftuple_greater
	end interface

	interface operator(<)
	module procedure ftuple_less
	end interface

	<<FKS regions: sub interfaces>>=
	pure module subroutine ftuple_assign (ftuple_out, ftuple_in)
	type(ftuple_t), intent(out) :: ftuple_out
	type(ftuple_t), intent(in) :: ftuple_in
	end subroutine ftuple_assign
	<<FKS regions: procedures>>=
	pure module subroutine ftuple_assign (ftuple_out, ftuple_in)
	type(ftuple_t), intent(out) :: ftuple_out
	type(ftuple_t), intent(in) :: ftuple_in
	ftuple_out%ireg = ftuple_in%ireg
	ftuple_out%i_res = ftuple_in%i_res
	ftuple_out%splitting_type = ftuple_in%splitting_type
	ftuple_out%pseudo_isr = ftuple_in%pseudo_isr
	ftuple_out%qcd_split = ftuple_in%qcd_split
	end subroutine ftuple_assign

	@ %def ftuple_assign
	@
	<<FKS regions: sub interfaces>>=
	elemental module function ftuple_equal (f1, f2) result (value)
	logical :: value
	type(ftuple_t), intent(in) :: f1, f2
	end function ftuple_equal
	<<FKS regions: procedures>>=
	elemental module function ftuple_equal (f1, f2) result (value)
	logical :: value
	type(ftuple_t), intent(in) :: f1, f2
	value = all (f1%ireg == f2%ireg) .and. f1%i_res == f2%i_res &
	.and. f1%splitting_type == f2%splitting_type &
	.and. (f1%pseudo_isr .eqv. f2%pseudo_isr) &
	.and. (f1%qcd_split .eqv. f2%qcd_split)
	end function ftuple_equal

	@ %def ftuple_equal
	@
	<<FKS regions: procedures>>=
	elemental function ftuple_equal_ireg (f1, f2) result (value)
	logical :: value
	type(ftuple_t), intent(in) :: f1, f2
	value = all (f1%ireg == f2%ireg)
	end function ftuple_equal_ireg

	@ %def ftuple_equal_ireg
	@
	<<FKS regions: sub interfaces>>=
	elemental module function ftuple_greater (f1, f2) result (greater)
	logical :: greater
	type(ftuple_t), intent(in) :: f1, f2
	end function ftuple_greater
	<<FKS regions: procedures>>=
	elemental module function ftuple_greater (f1, f2) result (greater)
	logical :: greater
	type(ftuple_t), intent(in) :: f1, f2
	if (f1%ireg(1) == f2%ireg(1)) then
	greater = f1%ireg(2) > f2%ireg(2)
	else
	greater = f1%ireg(1) > f2%ireg(1)
	end if
	end function ftuple_greater

	@ %def ftuple_greater
	@
	<<FKS regions: sub interfaces>>=
	elemental module function ftuple_less (f1, f2) result (less)
	logical :: less
	type(ftuple_t), intent(in) :: f1, f2
	end function ftuple_less
	<<FKS regions: procedures>>=
	elemental module function ftuple_less (f1, f2) result (less)
	logical :: less
	type(ftuple_t), intent(in) :: f1, f2
	if (f1%ireg(1) == f2%ireg(1)) then
	less = f1%ireg(2) < f2%ireg(2)
	else
	less = f1%ireg(1) < f2%ireg(1)
	end if
	end function ftuple_less

	@ %def ftuple_less
	<<FKS regions: procedures>>=
	subroutine ftuple_sort_array (ftuple_array, equivalences)
	type(ftuple_t), intent(inout), dimension(:), allocatable :: ftuple_array
	logical, intent(inout), dimension(:,:), allocatable :: equivalences
	type(ftuple_t) :: ftuple_tmp
	logical, dimension(:), allocatable :: eq_tmp
	integer :: i1, i2, n
	n = size (ftuple_array)
	allocate (eq_tmp (n))
	do i1 = 2, n
	i2 = i1
	do while (ftuple_array(i2 - 1) > ftuple_array(i2))
	ftuple_tmp = ftuple_array(i2 - 1)
	eq_tmp = equivalences(i2, :)
	ftuple_array(i2 - 1) = ftuple_array(i2)
	ftuple_array(i2) = ftuple_tmp
	equivalences(i2 - 1, :) = equivalences(i2, :)
	equivalences(i2, :) = eq_tmp
	i2 = i2 - 1
	if (i2 == 1) exit
	end do
	end do
	end subroutine ftuple_sort_array

	@ %def ftuple_sort_array
	@
	<<FKS regions: ftuple: TBP>>=
	procedure :: write => ftuple_write
	<<FKS regions: sub interfaces>>=
	module subroutine ftuple_write (ftuple, unit, newline)
	class(ftuple_t), intent(in) :: ftuple
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: newline
	end subroutine ftuple_write
	<<FKS regions: procedures>>=
	module subroutine ftuple_write (ftuple, unit, newline)
	class(ftuple_t), intent(in) :: ftuple
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: newline
	integer :: u
	logical :: nl
	u = given_output_unit (unit); if (u < 0) return
	nl = .true.; if (present(newline)) nl = newline
	if (all (ftuple%ireg > -1)) then
	if (ftuple%i_res > 0) then
	if (nl) then
	write (u, "(A1,I1,A1,I1,A1,I1,A1)") &
	'(', ftuple%ireg(1), ',', ftuple%ireg(2), ';', ftuple%i_res, ')'
	else
	write (u, "(A1,I1,A1,I1,A1,I1,A1)", advance = "no") &
	'(', ftuple%ireg(1), ',', ftuple%ireg(2), ';', ftuple%i_res, ')'
	end if
	else
	if (nl) then
	write (u, "(A1,I1,A1,I1,A1)") &
	'(', ftuple%ireg(1), ',', ftuple%ireg(2), ')'
	else
	write (u, "(A1,I1,A1,I1,A1)", advance = "no") &
	'(', ftuple%ireg(1), ',', ftuple%ireg(2), ')'
	end if
	end if
	else
	write (u, "(A)") "(Empty)"
	end if
	end subroutine ftuple_write

	@ %def ftuple_write
	@
	<<FKS regions: procedures>>=
	function ftuple_string (ftuples, latex)
	type(string_t) :: ftuple_string
	type(ftuple_t), intent(in), dimension(:) :: ftuples
	logical, intent(in) :: latex
	integer :: i, nreg
	if (latex) then
	ftuple_string = var_str ("$\left\{")
	else
	ftuple_string = var_str ("{")
	end if
	nreg = size(ftuples)
	do i = 1, nreg
	if (ftuples(i)%i_res == 0) then
	ftuple_string = ftuple_string // var_str ("(") // &
	str (ftuples(i)%ireg(1)) // var_str (",") // &
	str (ftuples(i)%ireg(2)) // var_str (")")
	else
	ftuple_string = ftuple_string // var_str ("(") // &
	str (ftuples(i)%ireg(1)) // var_str (",") // &
	str (ftuples(i)%ireg(2)) // var_str (";") // &
	str (ftuples(i)%i_res) // var_str (")")
	end if
	if (ftuples(i)%pseudo_isr) ftuple_string = ftuple_string // var_str ("*")
	if (i < nreg) ftuple_string = ftuple_string // var_str (",")
	end do
	if (latex) then
	ftuple_string = ftuple_string // var_str ("\right\}$")
	else
	ftuple_string = ftuple_string // var_str ("}")
	end if
	end function ftuple_string

	@ %def ftuple_string
	@
	<<FKS regions: ftuple: TBP>>=
	procedure :: get => ftuple_get
	<<FKS regions: sub interfaces>>=
	module subroutine ftuple_get (ftuple, pos1, pos2)
	class(ftuple_t), intent(in) :: ftuple
	integer, intent(out) :: pos1, pos2
	end subroutine ftuple_get
	<<FKS regions: procedures>>=
	module subroutine ftuple_get (ftuple, pos1, pos2)
	class(ftuple_t), intent(in) :: ftuple
	integer, intent(out) :: pos1, pos2
	pos1 = ftuple%ireg(1)
	pos2 = ftuple%ireg(2)
	end subroutine ftuple_get

	@ %def ftuple_get
	@
	<<FKS regions: ftuple: TBP>>=
	procedure :: set => ftuple_set
	<<FKS regions: sub interfaces>>=
	module subroutine ftuple_set (ftuple, pos1, pos2)
	class(ftuple_t), intent(inout) :: ftuple
	integer, intent(in) :: pos1, pos2
	end subroutine ftuple_set
	<<FKS regions: procedures>>=
	module subroutine ftuple_set (ftuple, pos1, pos2)
	class(ftuple_t), intent(inout) :: ftuple
	integer, intent(in) :: pos1, pos2
	ftuple%ireg(1) = pos1
	ftuple%ireg(2) = pos2
	end subroutine ftuple_set

	@ %def ftuple_set
	@ Determines the splitting type for FSR. There are three different
	types of splittings relevant here: $g \to gg$ tagged [[V_TO_VV]], $g
	\to qq$ tagged [[V_TO_FF]] and $q \to qg$ tagged [[F_TO_FV]]. For FSR,
	there is no need to differentiate between $q \to qg$ and $q \to gq$
	splittings.
	<<FKS regions: ftuple: TBP>>=
	procedure :: determine_splitting_type_fsr => &
	ftuple_determine_splitting_type_fsr
	<<FKS regions: sub interfaces>>=
	module subroutine ftuple_determine_splitting_type_fsr (ftuple, flv, i, j)
	class(ftuple_t), intent(inout) :: ftuple
	type(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: i, j
	end subroutine ftuple_determine_splitting_type_fsr
	<<FKS regions: procedures>>=
	module subroutine ftuple_determine_splitting_type_fsr (ftuple, flv, i, j)
	class(ftuple_t), intent(inout) :: ftuple
	type(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: i, j
	associate (flst => flv%flst)
	if (is_vector (flst(i)) .and. is_vector (flst(j))) then
	ftuple%splitting_type = V_TO_VV
	else if (flst(i)+flst(j) == 0 &
	.and. is_fermion (flst(i))) then
	ftuple%splitting_type = V_TO_FF
	else if (is_fermion(flst(i)) .and. is_massless_vector (flst(j)) &
	.or. is_fermion(flst(j)) .and. is_massless_vector (flst(i))) then
	ftuple%splitting_type = F_TO_FV
	else
	ftuple%splitting_type = UNDEFINED_SPLITTING
	end if
	end associate
	end subroutine ftuple_determine_splitting_type_fsr

	@ %def ftuple_determine_splitting_type_fsr
	@ Determines the splitting type for ISR. There are four different
	types of splittings relevant here: $g \to gg$ tagged [[V_TO_VV]], $g
	\to qq$ tagged [[V_TO_FF]], $q \to qg$ tagged [[F_TO_FV]] and $q \to
	gq$ tagged [[F_TO_VF]]. The latter two need to be considered
	separately for ISR as they differ with respect to which particle
	enters the hard process. A splitting [[F_TO_FV]] may lead to soft
	divergences while [[F_TO_VF]] does not.

	We also want to emphasize that the splitting type naming convention
	for ISR names the splittings considering backwards evolution. So in
	the splitting [[V_TO_FF]], it is the \textit{gluon} that enteres the
	hard process.

	Special treatment here is required if emitter $0$ is assigned. This is
	the case only when a gluon was radiated from any of the IS
	particles. In this case, both splittings are soft divergent so we can
	equivalently choose $1$ or $2$ as the emitter here even if both have
	different flavors.
	<<FKS regions: ftuple: TBP>>=
	procedure :: determine_splitting_type_isr => &
	ftuple_determine_splitting_type_isr
	<<FKS regions: sub interfaces>>=
	module subroutine ftuple_determine_splitting_type_isr (ftuple, flv, i, j)
	class(ftuple_t), intent(inout) :: ftuple
	type(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: i, j
	end subroutine ftuple_determine_splitting_type_isr
	<<FKS regions: procedures>>=
	module subroutine ftuple_determine_splitting_type_isr (ftuple, flv, i, j)
	class(ftuple_t), intent(inout) :: ftuple
	type(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: i, j
	integer :: em
	em = i; if (i == 0) em = 1
	associate (flst => flv%flst)
	if (is_vector (flst(em)) .and. is_vector (flst(j))) then
	ftuple%splitting_type = V_TO_VV
	else if (is_massless_vector(flst(em)) .and. is_fermion(flst(j))) then
	ftuple%splitting_type = F_TO_VF
	else if (is_fermion(flst(em)) .and. is_massless_vector(flst(j))) then
	ftuple%splitting_type = F_TO_FV
	else if (is_fermion(flst(em)) .and. is_fermion(flst(j))) then
	ftuple%splitting_type = V_TO_FF
	else
	ftuple%splitting_type = UNDEFINED_SPLITTING
	end if
	end associate
	end subroutine ftuple_determine_splitting_type_isr

	@ %def ftuple_determine_splitting_type_isr

	<<FKS regions: ftuple: TBP>>=
	procedure :: determine_sub_correction_type => &
	ftuple_determine_sub_correction_type
	<<FKS regions: sub interfaces>>=
	module subroutine ftuple_determine_sub_correction_type &
	(ftuple, flv_born, flv_real, i, j)
	class(ftuple_t), intent(inout) :: ftuple
	type(flv_structure_t), intent(in) :: flv_born, flv_real
	integer, intent(in) :: i, j
	end subroutine ftuple_determine_sub_correction_type
	<<FKS regions: procedures>>=
	module subroutine ftuple_determine_sub_correction_type &
	(ftuple, flv_born, flv_real, i, j)
	class(ftuple_t), intent(inout) :: ftuple
	type(flv_structure_t), intent(in) :: flv_born, flv_real
	integer, intent(in) :: i, j
	type(flv_structure_t) :: flv_test_qcd
	integer :: em
	em = i; if (i == 0) em = 1
	select case (ftuple%splitting_type)
	case (V_TO_VV)
	ftuple%qcd_split = is_gluon (flv_real%flst(em)) .and. is_gluon (flv_real%flst(j))
	case (F_TO_VF)
	ftuple%qcd_split = is_gluon (flv_real%flst(em))
	case (F_TO_FV)
	if (i == 0) then
	ftuple%qcd_split = is_gluon (flv_real%flst(j))
	else
	ftuple%qcd_split = is_gluon (flv_real%flst(i)) .or. is_gluon (flv_real%flst(j))
	end if
	case (V_TO_FF)
	if (any ([i, j] <= flv_real%n_in)) then
	flv_test_qcd = flv_real%insert_particle_isr (i, j, GLUON)
	else
	flv_test_qcd = flv_real%insert_particle_fsr (i, j, GLUON)
	end if
	ftuple%qcd_split = flv_test_qcd .equiv. flv_born
	case (UNDEFINED_SPLITTING)
	ftuple%qcd_split = .false.
	end select
	end subroutine ftuple_determine_sub_correction_type

	@ %def ftuple_determine_sub_correction_type
	@ Two debug functions to check the consistency of [[ftuples]]
	<<FKS regions: ftuple: TBP>>=
	procedure :: has_negative_elements => ftuple_has_negative_elements
	procedure :: has_identical_elements => ftuple_has_identical_elements
	<<FKS regions: sub interfaces>>=
	elemental module function ftuple_has_negative_elements &
	(ftuple) result (value)
	logical :: value
	class(ftuple_t), intent(in) :: ftuple
	end function ftuple_has_negative_elements
	elemental module function ftuple_has_identical_elements &
	(ftuple) result (value)
	logical :: value
	class(ftuple_t), intent(in) :: ftuple
	end function ftuple_has_identical_elements
	<<FKS regions: procedures>>=
	elemental module function ftuple_has_negative_elements &
	(ftuple) result (value)
	logical :: value
	class(ftuple_t), intent(in) :: ftuple
	value = any (ftuple%ireg < 0)
	end function ftuple_has_negative_elements

	elemental module function ftuple_has_identical_elements &
	(ftuple) result (value)
	logical :: value
	class(ftuple_t), intent(in) :: ftuple
	value = ftuple%ireg(1) == ftuple%ireg(2)
	end function ftuple_has_identical_elements

	@ %def ftuple_has_negative_elements, ftuple_has_identical_elements
	@ Each singular region can have a different number of
	emitter-radiation pairs. This is coped with using the linked list
	[[ftuple_list]].
	<<FKS regions: types>>=
	type :: ftuple_list_t
	integer :: index = 0
	type(ftuple_t) :: ftuple
	type(ftuple_list_t), pointer :: next => null ()
	type(ftuple_list_t), pointer :: prev => null ()
	type(ftuple_list_t), pointer :: equiv => null ()
	contains
	<<FKS regions: ftuple list: TBP>>
	end type ftuple_list_t

	@ %def ftuple_list_t
	@
	<<FKS regions: ftuple list: TBP>>=
	procedure :: write => ftuple_list_write
	<<FKS regions: sub interfaces>>=
	module subroutine ftuple_list_write (list, unit, verbose)
	class(ftuple_list_t), intent(in), target :: list
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine ftuple_list_write
	<<FKS regions: procedures>>=
	module subroutine ftuple_list_write (list, unit, verbose)
	class(ftuple_list_t), intent(in), target :: list
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	type(ftuple_list_t), pointer :: current
	logical :: verb
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	verb = .false.; if (present (verbose)) verb = verbose
	select type (list)
	type is (ftuple_list_t)
	current => list
	do
	call current%ftuple%write (unit = u, newline = .false.)
	if (verb .and. associated (current%equiv)) &
	write (u, '(A)', advance = "no") "'"
	if (associated (current%next)) then
	current => current%next
	else
	exit
	end if
	end do
	write (u, *) ""
	end select
	end subroutine ftuple_list_write

	@ %def ftuple_list_write
	@
	<<FKS regions: ftuple list: TBP>>=
	procedure :: append => ftuple_list_append
	<<FKS regions: sub interfaces>>=
	module subroutine ftuple_list_append (list, ftuple)
	class(ftuple_list_t), intent(inout), target :: list
	type(ftuple_t), intent(in) :: ftuple
	end subroutine ftuple_list_append
	<<FKS regions: procedures>>=
	module subroutine ftuple_list_append (list, ftuple)
	class(ftuple_list_t), intent(inout), target :: list
	type(ftuple_t), intent(in) :: ftuple
	type(ftuple_list_t), pointer :: current

	select type (list)
	type is (ftuple_list_t)
	if (list%index == 0) then
	nullify (list%next)
	list%index = 1
	list%ftuple = ftuple
	else
	current => list
	do
	if (associated (current%next)) then
	current => current%next
	else
	allocate (current%next)
	nullify (current%next%next)
	nullify (current%next%equiv)
	current%next%prev => current
	current%next%index = current%index + 1
	current%next%ftuple = ftuple
	exit
	end if
	end do
	end if
	end select
	end subroutine ftuple_list_append

	@ %def ftuple_list_append
	@
	<<FKS regions: ftuple list: TBP>>=
	procedure :: get_n_tuples => ftuple_list_get_n_tuples
	<<FKS regions: sub interfaces>>=
	impure elemental module function ftuple_list_get_n_tuples &
	(list) result(n_tuples)
	integer :: n_tuples
	class(ftuple_list_t), intent(in), target :: list
	end function ftuple_list_get_n_tuples
	<<FKS regions: procedures>>=
	impure elemental module function ftuple_list_get_n_tuples &
	(list) result(n_tuples)
	integer :: n_tuples
	class(ftuple_list_t), intent(in), target :: list
	type(ftuple_list_t), pointer :: current
	n_tuples = 0
	select type (list)
	type is (ftuple_list_t)
	current => list
	if (current%index > 0) then
	n_tuples = 1
	do
	if (associated (current%next)) then
	current => current%next
	n_tuples = n_tuples + 1
	else
	exit
	end if
	end do
	end if
	end select
	end function ftuple_list_get_n_tuples

	@ %def ftuple_list_get_n_tuples
	@
	<<FKS regions: ftuple list: TBP>>=
	procedure :: get_entry => ftuple_list_get_entry
	<<FKS regions: sub interfaces>>=
	module function ftuple_list_get_entry (list, index) result (entry)
	type(ftuple_list_t), pointer :: entry
	class(ftuple_list_t), intent(in), target :: list
	integer, intent(in) :: index
	end function ftuple_list_get_entry
	<<FKS regions: procedures>>=
	module function ftuple_list_get_entry (list, index) result (entry)
	type(ftuple_list_t), pointer :: entry
	class(ftuple_list_t), intent(in), target :: list
	integer, intent(in) :: index
	type(ftuple_list_t), pointer :: current
	integer :: i
	entry => null()
	select type (list)
	type is (ftuple_list_t)
	current => list
	if (index == 1) then
	entry => current
	else
	do i = 1, index - 1
	current => current%next
	end do
	entry => current
	end if
	end select
	end function ftuple_list_get_entry

	@ %def ftuple_list_get_entry
	@
	<<FKS regions: ftuple list: TBP>>=
	procedure :: get_ftuple => ftuple_list_get_ftuple
	<<FKS regions: sub interfaces>>=
	module function ftuple_list_get_ftuple (list, index) result (ftuple)
	type(ftuple_t) :: ftuple
	class(ftuple_list_t), intent(in), target :: list
	integer, intent(in) :: index
	end function ftuple_list_get_ftuple
	<<FKS regions: procedures>>=
	module function ftuple_list_get_ftuple (list, index) result (ftuple)
	type(ftuple_t) :: ftuple
	class(ftuple_list_t), intent(in), target :: list
	integer, intent(in) :: index
	type(ftuple_list_t), pointer :: entry
	entry => list%get_entry (index)
	ftuple = entry%ftuple
	end function ftuple_list_get_ftuple

	@ %def ftuple_list_get_ftuple
	@
	<<FKS regions: ftuple list: TBP>>=
	procedure :: set_equiv => ftuple_list_set_equiv
	<<FKS regions: sub interfaces>>=
	module subroutine ftuple_list_set_equiv (list, i1, i2)
	class(ftuple_list_t), intent(in) :: list
	integer, intent(in) :: i1, i2
	end subroutine ftuple_list_set_equiv
	<<FKS regions: procedures>>=
	module subroutine ftuple_list_set_equiv (list, i1, i2)
	class(ftuple_list_t), intent(in) :: list
	integer, intent(in) :: i1, i2
	type(ftuple_list_t), pointer :: list1, list2 => null ()
	select type (list)
	type is (ftuple_list_t)
	if (list%get_ftuple (i1) > list%get_ftuple (i2)) then
	list1 => list%get_entry (i2)
	list2 => list%get_entry (i1)
	else
	list1 => list%get_entry (i1)
	list2 => list%get_entry (i2)
	end if
	do
	if (associated (list1%equiv)) then
	list1 => list1%equiv
	else
	exit
	end if
	end do
	list1%equiv => list2
	end select
	end subroutine ftuple_list_set_equiv

	@ %def ftuple_list_set_equiv
	@
	<<FKS regions: ftuple list: TBP>>=
	procedure :: check_equiv => ftuple_list_check_equiv
	<<FKS regions: sub interfaces>>=
	module function ftuple_list_check_equiv(list, i1, i2) result (eq)
	class(ftuple_list_t), intent(in) :: list
	integer, intent(in) :: i1, i2
	logical :: eq
	end function ftuple_list_check_equiv
	<<FKS regions: procedures>>=
	module function ftuple_list_check_equiv(list, i1, i2) result (eq)
	class(ftuple_list_t), intent(in) :: list
	integer, intent(in) :: i1, i2
	logical :: eq
	type(ftuple_list_t), pointer :: current
	eq = .false.
	select type (list)
	type is (ftuple_list_t)
	current => list%get_entry (i1)
	do
	if (associated (current%equiv)) then
	current => current%equiv
	if (current%index == i2) then
	eq = .true.
	exit
	end if
	else
	exit
	end if
	end do
	end select
	end function ftuple_list_check_equiv

	@ %def ftuple_list_sort
	@
	<<FKS regions: ftuple list: TBP>>=
	procedure :: to_array => ftuple_list_to_array
	<<FKS regions: sub interfaces>>=
	module subroutine ftuple_list_to_array &
	(ftuple_list, ftuple_array, equivalences, ordered)
	class(ftuple_list_t), intent(in), target :: ftuple_list
	type(ftuple_t), intent(out), dimension(:), allocatable :: ftuple_array
	logical, intent(out), dimension(:,:), allocatable :: equivalences
	logical, intent(in) :: ordered
	end subroutine ftuple_list_to_array
	<<FKS regions: procedures>>=
	module subroutine ftuple_list_to_array &
	(ftuple_list, ftuple_array, equivalences, ordered)
	class(ftuple_list_t), intent(in), target :: ftuple_list
	type(ftuple_t), intent(out), dimension(:), allocatable :: ftuple_array
	logical, intent(out), dimension(:,:), allocatable :: equivalences
	logical, intent(in) :: ordered
	integer :: i_tuple, n
	type(ftuple_list_t), pointer :: current => null ()
	integer :: i1, i2
	type(ftuple_t) :: ftuple_tmp
	logical, dimension(:), allocatable :: eq_tmp
	n = ftuple_list%get_n_tuples ()
	allocate (ftuple_array (n), equivalences (n, n))
	equivalences = .false.
	select type (ftuple_list)
	type is (ftuple_list_t)
	current => ftuple_list
	i_tuple = 1
	do
	ftuple_array(i_tuple) = current%ftuple
	if (associated (current%equiv)) then
	i1 = current%index
	i2 = current%equiv%index
	equivalences (i1, i2) = .true.
	end if
	if (associated (current%next)) then
	current => current%next
	i_tuple = i_tuple + 1
	else
	exit
	end if
	end do
	end select
	if (ordered) call ftuple_sort_array (ftuple_array, equivalences)
	end subroutine ftuple_list_to_array

	@ %def ftuple_list_to_array
	@
	<<FKS regions: procedures>>=
	subroutine print_equivalence_matrix (ftuple_array, equivalences)
	type(ftuple_t), intent(in), dimension(:) :: ftuple_array
	logical, intent(in), dimension(:,:) :: equivalences
	integer :: i, i1, i2
	print *, 'Equivalence matrix: '
	do i = 1, size (ftuple_array)
	call ftuple_array(i)%get(i1,i2)
	print *, 'i: ', i, '(', i1, i2, '): ', equivalences(i,:)
	end do
	end subroutine print_equivalence_matrix

	@ %def print_equivalence_matrix
	@ Class for working with the flavor specification arrays.
	<<FKS regions: public>>=
	public :: flv_structure_t
	<<FKS regions: types>>=
	type :: flv_structure_t
	integer, dimension(:), allocatable :: flst
	integer, dimension(:), allocatable :: tag
	integer :: nlegs = 0
	integer :: n_in = 0
	logical, dimension(:), allocatable :: massive
	logical, dimension(:), allocatable :: colored
	real(default), dimension(:), allocatable :: charge
	real(default) :: prt_symm_fs = 1._default
	integer :: eqv_index = 0
	contains
	<<FKS regions: flv structure: TBP>>
	end type flv_structure_t

	@ %def flv_structure_t
	@
	Returns \texttt{true} if the two particles at position \texttt{i}
	and \texttt{j} in the flavor array can originate from the same
	splitting. For this purpose, the function first checks whether the splitting is
	allowed at all. If this is the case, the emitter is removed from the
	flavor array. If the resulting array is equivalent to the Born flavor
	structure \texttt{flv\_born}, the pair is accepted as a valid
	splitting.

	We first check whether the splitting is possible. The array
	[[flv_orig]] contains all particles which share a vertex with the
	particles at position [[i]] and [[j]]. If any of these particles belongs
	to the initial state, a PDG-ID flip is necessary to correctly recognize
	the vertex. If its size is equal to zero, no splitting is possible and
	the subroutine is exited. Otherwise, we loop over all possible underlying
	Born flavor structures and check if any of them equals the actual underlying
	Born flavor structure. For a quark emitting a gluon, [[flv_orig]] contains
	the PDG code of the anti-quark. To be on the safe side, a second array is created,
	which contains both the positively and negatively signed PDG
	codes. Then, the origial tuple $(i,j)$ is removed from the real flavor
	structure and the particles in [[flv_orig2]] are inserted.
	If the resulting Born configuration is equal to the underlying Born
	configuration, up to a permutation of final-state particles, the tuple
	$(i,j)$ is accepted as valid.
	<<FKS regions: flv structure: TBP>>=
	procedure :: valid_pair => flv_structure_valid_pair
	<<FKS regions: sub interfaces>>=
	module function flv_structure_valid_pair &
	(flv, i, j, flv_ref, model) result (valid)
	logical :: valid
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: i,j
	type(flv_structure_t), intent(in) :: flv_ref
	type(model_t), intent(in) :: model
	end function flv_structure_valid_pair
	<<FKS regions: procedures>>=
	module function flv_structure_valid_pair &
	(flv, i, j, flv_ref, model) result (valid)
	logical :: valid
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: i,j
	type(flv_structure_t), intent(in) :: flv_ref
	type(model_t), intent(in) :: model
	integer :: k, n_orig
	type(flv_structure_t) :: flv_test
	integer, dimension(:), allocatable :: flv_orig
	valid = .false.
	if (all ([i, j] <= flv%n_in)) return
	if (i <= flv%n_in .and. is_fermion(flv%flst(i))) then
	call model%match_vertex (-flv%flst(i), flv%flst(j), flv_orig)
	else if (j <= flv%n_in .and. is_fermion(flv%flst(j))) then
	call model%match_vertex (flv%flst(i), -flv%flst(j), flv_orig)
	else
	call model%match_vertex (flv%flst(i), flv%flst(j), flv_orig)
	end if
	n_orig = size (flv_orig)
	if (n_orig == 0) then
	return
	else
	do k = 1, n_orig
	if (any ([i, j] <= flv%n_in)) then
	flv_test = flv%insert_particle_isr (i, j, flv_orig(k))
	else
	flv_test = flv%insert_particle_fsr (i, j, flv_orig(k))
	end if
	valid = flv_ref .equiv. flv_test
	call flv_test%final ()
	if (valid) return
	end do
	end if
	deallocate (flv_orig)
	end function flv_structure_valid_pair

	@ %def flv_structure_valid_pair
	@ This function checks whether two flavor arrays are the same up to a
	permutation of the final-state particles
	<<FKS regions: procedures>>=
	function flv_structure_equivalent (flv1, flv2, with_tag) result (equiv)
	logical :: equiv
	type(flv_structure_t), intent(in) :: flv1, flv2
	logical, intent(in) :: with_tag
	type(flv_perm_t) :: perm
	integer :: n
	n = size (flv1%flst)
	equiv = .true.
	if (n /= size (flv2%flst)) then
	call msg_fatal &
	('flv_structure_equivalent: flavor arrays do not have equal lengths')
	else if (flv1%n_in /= flv2%n_in) then
	call msg_fatal &
	('flv_structure_equivalent: flavor arrays do not have equal n_in')
	else
	call perm%init (flv1, flv2, flv1%n_in, flv1%nlegs, with_tag)
	equiv = perm%eqv (flv2, flv1, with_tag)
	call perm%final ()
	end if
	end function flv_structure_equivalent

	@ %def flv_structure_equivalent
	@
	<<FKS regions: sub interfaces>>=
	module function flv_structure_equivalent_no_tag (flv1, flv2) result(equiv)
	logical :: equiv
	type(flv_structure_t), intent(in) :: flv1, flv2
	end function flv_structure_equivalent_no_tag
	module function flv_structure_equivalent_with_tag (flv1, flv2) result(equiv)
	logical :: equiv
	type(flv_structure_t), intent(in) :: flv1, flv2
	endfunction flv_structure_equivalent_with_tag
	<<FKS regions: procedures>>=
	module function flv_structure_equivalent_no_tag (flv1, flv2) result(equiv)
	logical :: equiv
	type(flv_structure_t), intent(in) :: flv1, flv2
	equiv = flv_structure_equivalent (flv1, flv2, .false.)
	end function flv_structure_equivalent_no_tag

	module function flv_structure_equivalent_with_tag (flv1, flv2) result(equiv)
	logical :: equiv
	type(flv_structure_t), intent(in) :: flv1, flv2
	equiv = flv_structure_equivalent (flv1, flv2, .true.)
	end function flv_structure_equivalent_with_tag


	@ %def flv_structure_equivalent_no_tag, flv_structure_equivalent_with_tag
	@
	<<FKS regions: sub interfaces>>=
	pure module subroutine flv_structure_assign_flv (flv_out, flv_in)
	type(flv_structure_t), intent(out) :: flv_out
	type(flv_structure_t), intent(in) :: flv_in
	end subroutine flv_structure_assign_flv
	<<FKS regions: procedures>>=
	pure module subroutine flv_structure_assign_flv (flv_out, flv_in)
	type(flv_structure_t), intent(out) :: flv_out
	type(flv_structure_t), intent(in) :: flv_in
	flv_out%nlegs = flv_in%nlegs
	flv_out%n_in = flv_in%n_in
	flv_out%prt_symm_fs = flv_in%prt_symm_fs
	if (allocated (flv_in%flst)) then
	allocate (flv_out%flst (size (flv_in%flst)))
	flv_out%flst = flv_in%flst
	end if
	if (allocated (flv_in%tag)) then
	allocate (flv_out%tag (size (flv_in%tag)))
	flv_out%tag = flv_in%tag
	end if
	if (allocated (flv_in%massive)) then
	allocate (flv_out%massive (size (flv_in%massive)))
	flv_out%massive = flv_in%massive
	end if
	if (allocated (flv_in%colored)) then
	allocate (flv_out%colored (size (flv_in%colored)))
	flv_out%colored = flv_in%colored
	end if
	end subroutine flv_structure_assign_flv

	@ %def flv_structure_assign_flv
	@
	<<FKS regions: sub interfaces>>=
	pure module subroutine flv_structure_assign_integer (flv_out, iarray)
	type(flv_structure_t), intent(out) :: flv_out
	integer, intent(in), dimension(:) :: iarray
	end subroutine flv_structure_assign_integer
	<<FKS regions: procedures>>=
	pure module subroutine flv_structure_assign_integer (flv_out, iarray)
	type(flv_structure_t), intent(out) :: flv_out
	integer, intent(in), dimension(:) :: iarray
	integer :: i
	flv_out%nlegs = size (iarray)
	allocate (flv_out%flst (flv_out%nlegs))
	allocate (flv_out%tag (flv_out%nlegs))
	flv_out%flst = iarray
	flv_out%tag = [(i, i = 1, flv_out%nlegs)]
	end subroutine flv_structure_assign_integer

	@ %def flv_structure_assign_integer
	@ Returs a new flavor array with the particle at position
	\texttt{index} removed.
	<<FKS regions: flv structure: TBP>>=
	procedure :: remove_particle => flv_structure_remove_particle
	<<FKS regions: sub interfaces>>=
	module function flv_structure_remove_particle (flv, index) result (flv_new)
	type(flv_structure_t) :: flv_new
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: index
	end function flv_structure_remove_particle
	<<FKS regions: procedures>>=
	module function flv_structure_remove_particle (flv, index) result (flv_new)
	type(flv_structure_t) :: flv_new
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: index
	integer :: n1, n2
	integer :: i, removed_tag
	n1 = size (flv%flst); n2 = n1 - 1
	allocate (flv_new%flst (n2), flv_new%tag (n2))
	flv_new%nlegs = n2
	flv_new%n_in = flv%n_in
	removed_tag = flv%tag(index)
	if (index == 1) then
	flv_new%flst(1 : n2) = flv%flst(2 : n1)
	flv_new%tag(1 : n2) = flv%tag(2 : n1)
	else if (index == n1) then
	flv_new%flst(1 : n2) = flv%flst(1 : n2)
	flv_new%tag(1 : n2) = flv%tag(1 : n2)
	else
	flv_new%flst(1 : index - 1) = flv%flst(1 : index - 1)
	flv_new%flst(index : n2) = flv%flst(index + 1 : n1)
	flv_new%tag(1 : index - 1) = flv%tag(1 : index - 1)
	flv_new%tag(index : n2) = flv%tag(index + 1 : n1)
	end if
	do i = 1, n2
	if (flv_new%tag(i) > removed_tag) &
	flv_new%tag(i) = flv_new%tag(i) - 1
	end do
	call flv_new%compute_prt_symm_fs (flv_new%n_in)
	end function flv_structure_remove_particle

	@ %def flv_structure_remove_particle
	@ Removes the particles at position i1 and i2 and inserts a new
	particle of matching flavor at position i1.
	<<FKS regions: flv structure: TBP>>=
	procedure :: insert_particle_fsr => flv_structure_insert_particle_fsr
	<<FKS regions: sub interfaces>>=
	module function flv_structure_insert_particle_fsr &
	(flv, i1, i2, flv_add) result (flv_new)
	type(flv_structure_t) :: flv_new
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: i1, i2, flv_add
	end function flv_structure_insert_particle_fsr
	<<FKS regions: procedures>>=
	module function flv_structure_insert_particle_fsr &
	(flv, i1, i2, flv_add) result (flv_new)
	type(flv_structure_t) :: flv_new
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: i1, i2, flv_add
	if (flv%flst(i1) + flv_add == 0 .or. flv%flst(i2) + flv_add == 0) then
	flv_new = flv%insert_particle (i1, i2, -flv_add)
	else
	flv_new = flv%insert_particle (i1, i2, flv_add)
	end if
	end function flv_structure_insert_particle_fsr

	@ %def flv_structure_insert_particle_fsr
	@ Same as [[insert_particle_fsr]] but for ISR, the two particles are
	not exchangeable.
	<<FKS regions: flv structure: TBP>>=
	procedure :: insert_particle_isr => flv_structure_insert_particle_isr
	<<FKS regions: sub interfaces>>=
	module function flv_structure_insert_particle_isr &
	(flv, i_in, i_out, flv_add) result (flv_new)
	type(flv_structure_t) :: flv_new
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: i_in, i_out, flv_add
	end function flv_structure_insert_particle_isr
	<<FKS regions: procedures>>=
	module function flv_structure_insert_particle_isr &
	(flv, i_in, i_out, flv_add) result (flv_new)
	type(flv_structure_t) :: flv_new
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: i_in, i_out, flv_add
	if (flv%flst(i_in) + flv_add == 0) then
	flv_new = flv%insert_particle (i_in, i_out, -flv_add)
	else
	flv_new = flv%insert_particle (i_in, i_out, flv_add)
	end if
	end function flv_structure_insert_particle_isr

	@ %def flv_structure_insert_particle_isr
	@ Removes the particles at position i1 and i2 and inserts a new
	particle at position i1.
	<<FKS regions: flv structure: TBP>>=
	procedure :: insert_particle => flv_structure_insert_particle
	<<FKS regions: sub interfaces>>=
	module function flv_structure_insert_particle &
	(flv, i1, i2, particle) result (flv_new)
	type(flv_structure_t) :: flv_new
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: i1, i2, particle
	end function flv_structure_insert_particle
	<<FKS regions: procedures>>=
	module function flv_structure_insert_particle &
	(flv, i1, i2, particle) result (flv_new)
	type(flv_structure_t) :: flv_new
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: i1, i2, particle
	type(flv_structure_t) :: flv_tmp
	integer :: n1, n2
	integer :: new_tag
	n1 = size (flv%flst); n2 = n1 - 1
	allocate (flv_new%flst (n2), flv_new%tag (n2))
	flv_new%nlegs = n2
	flv_new%n_in = flv%n_in
	new_tag = maxval(flv%tag) + 1
	if (i1 < i2) then
	flv_tmp = flv%remove_particle (i1)
	flv_tmp = flv_tmp%remove_particle (i2 - 1)
	else if(i2 < i1) then
	flv_tmp = flv%remove_particle(i2)
	flv_tmp = flv_tmp%remove_particle(i1 - 1)
	else
	call msg_fatal ("flv_structure_insert_particle: Indices are identical!")
	end if
	if (i1 == 1) then
	flv_new%flst(1) = particle
	flv_new%flst(2 : n2) = flv_tmp%flst(1 : n2 - 1)
	flv_new%tag(1) = new_tag
	flv_new%tag(2 : n2) = flv_tmp%tag(1 : n2 - 1)
	else if (i1 == n1 .or. i1 == n2) then
	flv_new%flst(1 : n2 - 1) = flv_tmp%flst(1 : n2 - 1)
	flv_new%flst(n2) = particle
	flv_new%tag(1 : n2 - 1) = flv_tmp%tag(1 : n2 - 1)
	flv_new%tag(n2) = new_tag
	else
	flv_new%flst(1 : i1 - 1) = flv_tmp%flst(1 : i1 - 1)
	flv_new%flst(i1) = particle
	flv_new%flst(i1 + 1 : n2) = flv_tmp%flst(i1 : n2 - 1)
	flv_new%tag(1 : i1 - 1) = flv_tmp%tag(1 : i1 - 1)
	flv_new%tag(i1) = new_tag
	flv_new%tag(i1 + 1 : n2) = flv_tmp%tag(i1 : n2 - 1)
	end if
	call flv_new%compute_prt_symm_fs (flv_new%n_in)
	end function flv_structure_insert_particle

	@ %def flv_structure_insert_particle
	@ Counts the number of occurances of a particle in a
	flavor array
	<<FKS regions: flv structure: TBP>>=
	procedure :: count_particle => flv_structure_count_particle
	<<FKS regions: sub interfaces>>=
	module function flv_structure_count_particle (flv, part) result (n)
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: part
	integer :: n
	end function flv_structure_count_particle
	<<FKS regions: procedures>>=
	module function flv_structure_count_particle (flv, part) result (n)
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: part
	integer :: n
	n = count (flv%flst == part)
	end function flv_structure_count_particle

	@ %def flv_structure_count_particle
	@ Initializer for flavor structures
	<<FKS regions: flv structure: TBP>>=
	procedure :: init => flv_structure_init
	<<FKS regions: sub interfaces>>=
	module subroutine flv_structure_init (flv, aval, n_in, tags)
	class(flv_structure_t), intent(inout) :: flv
	integer, intent(in), dimension(:) :: aval
	integer, intent(in) :: n_in
	integer, intent(in), dimension(:), optional :: tags
	end subroutine flv_structure_init
	<<FKS regions: procedures>>=
	module subroutine flv_structure_init (flv, aval, n_in, tags)
	class(flv_structure_t), intent(inout) :: flv
	integer, intent(in), dimension(:) :: aval
	integer, intent(in) :: n_in
	integer, intent(in), dimension(:), optional :: tags
	integer :: i, n
	integer, dimension(:), allocatable :: aval_unique
	integer, dimension(:), allocatable :: mult
	n = size (aval)
	allocate (flv%flst (n), flv%tag (n))
	flv%flst = aval
	if (present (tags)) then
	flv%tag = tags
	else
	do i = 1, n
	flv%tag(i) = i
	end do
	end if
	flv%nlegs = n
	flv%n_in = n_in
	call flv%compute_prt_symm_fs (flv%n_in)
	end subroutine flv_structure_init

	@ %def flv_structure_init
	@
	<<FKS regions: flv structure: TBP>>=
	procedure :: compute_prt_symm_fs => flv_structure_compute_prt_symm_fs
	<<FKS regions: sub interfaces>>=
	module subroutine flv_structure_compute_prt_symm_fs (flv, n_in)
	class(flv_structure_t), intent(inout) :: flv
	integer, intent(in) :: n_in
	end subroutine flv_structure_compute_prt_symm_fs
	<<FKS regions: procedures>>=
	module subroutine flv_structure_compute_prt_symm_fs (flv, n_in)
	class(flv_structure_t), intent(inout) :: flv
	integer, intent(in) :: n_in
	integer, dimension(:), allocatable :: flst_unique
	integer, dimension(:), allocatable :: mult
	integer :: i
	flst_unique = remove_duplicates_from_int_array (flv%flst(n_in + 1 :))
	allocate (mult(size (flst_unique)))
	do i = 1, size (flst_unique)
	mult(i) = count (flv%flst(n_in + 1 :) == flst_unique(i))
	end do
	flv%prt_symm_fs = one / product (gamma (real (mult + 1, default)))
	end subroutine flv_structure_compute_prt_symm_fs

	@ %def flv_structure_compute_prt_symm_fs
	@
	<<FKS regions: flv structure: TBP>>=
	procedure :: write => flv_structure_write
	<<FKS regions: sub interfaces>>=
	module subroutine flv_structure_write (flv, unit)
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in), optional :: unit
	end subroutine flv_structure_write
	<<FKS regions: procedures>>=
	module subroutine flv_structure_write (flv, unit)
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, '(A)') char (flv%to_string ())
	end subroutine flv_structure_write

	@ %def flv_structure_write
	@
	<<FKS regions: flv structure: TBP>>=
	procedure :: to_string => flv_structure_to_string
	<<FKS regions: sub interfaces>>=
	module function flv_structure_to_string (flv) result (flv_string)
	type(string_t) :: flv_string
	class(flv_structure_t), intent(in) :: flv
	end function flv_structure_to_string
	<<FKS regions: procedures>>=
	module function flv_structure_to_string (flv) result (flv_string)
	type(string_t) :: flv_string
	class(flv_structure_t), intent(in) :: flv
	integer :: i, n
	if (allocated (flv%flst)) then
	flv_string = var_str ("[")
	n = size (flv%flst)
	do i = 1, n - 1
	flv_string = flv_string // str (flv%flst(i)) // var_str(",")
	end do
	flv_string = flv_string // str (flv%flst(n)) // var_str("]")
	else
	flv_string = var_str ("[not allocated]")
	end if
	end function flv_structure_to_string

	@ %def flv_structure_to_string
	@ Creates the underlying Born flavor structure for a given real flavor
	structure if the particle at position \texttt{emitter} is removed
	<<FKS regions: flv structure: TBP>>=
	procedure :: create_uborn => flv_structure_create_uborn
	<<FKS regions: sub interfaces>>=
	module function flv_structure_create_uborn &
	(flv, emitter, nlo_correction_type) result(flv_uborn)
	type(flv_structure_t) :: flv_uborn
	class(flv_structure_t), intent(in) :: flv
	type(string_t), intent(in) :: nlo_correction_type
	integer, intent(in) :: emitter
	end function flv_structure_create_uborn
	<<FKS regions: procedures>>=
	module function flv_structure_create_uborn &
	(flv, emitter, nlo_correction_type) result(flv_uborn)
	type(flv_structure_t) :: flv_uborn
	class(flv_structure_t), intent(in) :: flv
	type(string_t), intent(in) :: nlo_correction_type
	integer, intent(in) :: emitter
	integer n_legs
	integer :: f1, f2
	integer :: gauge_boson

	n_legs = size(flv%flst)
	allocate (flv_uborn%flst (n_legs - 1), flv_uborn%tag (n_legs - 1))
	gauge_boson = determine_gauge_boson_to_be_inserted ()

	if (emitter > flv%n_in) then
	f1 = flv%flst(n_legs); f2 = flv%flst(n_legs - 1)
	if (is_massless_vector (f1)) then
	!!! Emitted particle is a gluon or photon => just remove it
	flv_uborn = flv%remove_particle(n_legs)
	else if (is_fermion (f1) .and. is_fermion (f2) .and. f1 + f2 == 0) then
	!!! Emission type is a gauge boson splitting into two fermions
	flv_uborn = flv%insert_particle(n_legs - 1, n_legs, gauge_boson)
	else
	call msg_error ("Create underlying Born: Unsupported splitting type.")
	call msg_error (char (str (flv%flst)))
	call msg_fatal ("FKS - FAIL")
	end if
	else if (emitter > 0) then
	f1 = flv%flst(n_legs); f2 = flv%flst(emitter)
	if (is_massless_vector (f1)) then
	flv_uborn = flv%remove_particle(n_legs)
	else if (is_fermion (f1) .and. is_massless_vector (f2)) then
	flv_uborn = flv%insert_particle (emitter, n_legs, -f1)
	else if (is_fermion (f1) .and. is_fermion (f2) .and. f1 == f2) then
	flv_uborn = flv%insert_particle(emitter, n_legs, gauge_boson)
	end if
	else
	flv_uborn = flv%remove_particle (n_legs)
	end if

	contains
	integer function determine_gauge_boson_to_be_inserted ()
	select case (char (nlo_correction_type))
	case ("QCD")
	determine_gauge_boson_to_be_inserted = GLUON
	case ("EW")
	determine_gauge_boson_to_be_inserted = PHOTON
	case ("Full")
	call msg_fatal ("NLO correction type 'Full' not yet implemented!")
	case default
	call msg_fatal ("Invalid NLO correction type! Valid inputs " // &
	"are: QCD, EW and Full (default: QCD)")
	end select
	end function determine_gauge_boson_to_be_inserted

	end function flv_structure_create_uborn

	@ %def flv_structure_create_uborn
	@
	<<FKS regions: flv structure: TBP>>=
	procedure :: init_mass_color_and_charge => &
	flv_structure_init_mass_color_and_charge
	<<FKS regions: sub interfaces>>=
	module subroutine flv_structure_init_mass_color_and_charge (flv, model)
	class(flv_structure_t), intent(inout) :: flv
	type(model_t), intent(in) :: model
	end subroutine flv_structure_init_mass_color_and_charge
	<<FKS regions: procedures>>=
	module subroutine flv_structure_init_mass_color_and_charge (flv, model)
	class(flv_structure_t), intent(inout) :: flv
	type(model_t), intent(in) :: model
	integer :: i
	type(flavor_t) :: flavor
	allocate (flv%massive (flv%nlegs), flv%colored(flv%nlegs), &
	flv%charge(flv%nlegs))
	do i = 1, flv%nlegs
	call flavor%init (flv%flst(i), model)
	flv%massive(i) = flavor%get_mass () > 0
	flv%colored(i) = &
	is_quark (flv%flst(i)) .or. is_gluon (flv%flst(i))
	flv%charge(i) = flavor%get_charge ()
	end do
	end subroutine flv_structure_init_mass_color_and_charge

	@ %def flv_structure_init_mass_color_and_charge
	@
	<<FKS regions: flv structure: TBP>>=
	procedure :: get_last_two => flv_structure_get_last_two
	<<FKS regions: sub interfaces>>=
	module function flv_structure_get_last_two (flv, n) result (flst_last)
	integer, dimension(2) :: flst_last
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: n
	end function flv_structure_get_last_two
	<<FKS regions: procedures>>=
	module function flv_structure_get_last_two (flv, n) result (flst_last)
	integer, dimension(2) :: flst_last
	class(flv_structure_t), intent(in) :: flv
	integer, intent(in) :: n
	flst_last = [flv%flst(n - 1), flv%flst(n)]
	end function flv_structure_get_last_two

	@ %def flv_structure_get_last_two
	@
	<<FKS regions: flv structure: TBP>>=
	procedure :: final => flv_structure_final
	<<FKS regions: sub interfaces>>=
	module subroutine flv_structure_final (flv)
	class(flv_structure_t), intent(inout) :: flv
	end subroutine flv_structure_final
	<<FKS regions: procedures>>=
	module subroutine flv_structure_final (flv)
	class(flv_structure_t), intent(inout) :: flv
	if (allocated (flv%flst)) deallocate (flv%flst)
	if (allocated (flv%tag)) deallocate (flv%tag)
	if (allocated (flv%massive)) deallocate (flv%massive)
	if (allocated (flv%colored)) deallocate (flv%colored)
	if (allocated (flv%charge)) deallocate (flv%charge)
	end subroutine flv_structure_final

	@ %def flv_structure_final
	@
	<<FKS regions: types>>=
	type :: flv_perm_t
	integer, dimension(:,:), allocatable :: perms
	contains
	<<FKS regions: flavor permutation: TBP>>
	end type flv_perm_t

	@ %def flv_perm_t
	@
	<<FKS regions: flavor permutation: TBP>>=
	procedure :: init => flv_perm_init
	<<FKS regions: sub interfaces>>=
	module subroutine flv_perm_init &
	(perm, flv_in, flv_ref, n_first, n_last, with_tag)
	class(flv_perm_t), intent(out) :: perm
	type(flv_structure_t), intent(in) :: flv_in, flv_ref
	integer, intent(in) :: n_first, n_last
	logical, intent(in) :: with_tag
	end subroutine flv_perm_init
	<<FKS regions: procedures>>=
	module subroutine flv_perm_init &
	(perm, flv_in, flv_ref, n_first, n_last, with_tag)
	class(flv_perm_t), intent(out) :: perm
	type(flv_structure_t), intent(in) :: flv_in, flv_ref
	integer, intent(in) :: n_first, n_last
	logical, intent(in) :: with_tag
	integer :: flv1, flv2, tmp
	integer :: tag1, tag2
	integer :: i, j, j_min, i_perm
	integer, dimension(:,:), allocatable :: perm_list_tmp
	type(flv_structure_t) :: flv_copy
	logical :: condition
	logical, dimension(:), allocatable :: already_correct
	flv_copy = flv_in
	allocate (perm_list_tmp (factorial (n_last - n_first - 1), 2))
	allocate (already_correct (flv_in%nlegs))
	already_correct = flv_in%flst == flv_ref%flst
	if (with_tag) &
	already_correct = already_correct .and. (flv_in%tag == flv_ref%tag)
	j_min = n_first + 1
	i_perm = 0
	do i = n_first + 1, n_last
	flv1 = flv_ref%flst(i)
	tag1 = flv_ref%tag(i)
	do j = j_min, n_last
	if (already_correct(i) .or. already_correct(j)) cycle
	flv2 = flv_copy%flst(j)
	tag2 = flv_copy%tag(j)
	condition = (flv1 == flv2) .and. i /= j
	if (with_tag) condition = condition .and. (tag1 == tag2)
	if (condition) then
	i_perm = i_perm + 1
	tmp = flv_copy%flst(i)
	flv_copy%flst(i) = flv2
	flv_copy%flst(j) = tmp
	tmp = flv_copy%tag(i)
	flv_copy%tag(i) = tag2
	flv_copy%tag(j) = tmp
	perm_list_tmp (i_perm, 1) = i
	perm_list_tmp (i_perm, 2) = j
	exit
	end if
	end do
	j_min = j_min + 1
	end do
	allocate (perm%perms (i_perm, 2))
	perm%perms = perm_list_tmp (1 : i_perm, :)
	deallocate (perm_list_tmp)
	call flv_copy%final ()
	end subroutine flv_perm_init

	@ %def flv_perm_init
	@
	<<FKS regions: flavor permutation: TBP>>=
	procedure :: write => flv_perm_write
	<<FKS regions: sub interfaces>>=
	module subroutine flv_perm_write (perm, unit)
	class(flv_perm_t), intent(in) :: perm
	integer, intent(in), optional :: unit
	end subroutine flv_perm_write
	<<FKS regions: procedures>>=
	module subroutine flv_perm_write (perm, unit)
	class(flv_perm_t), intent(in) :: perm
	integer, intent(in), optional :: unit
	integer :: i, n, u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A)") "Flavor permutation list: "
	n = size (perm%perms, dim = 1)
	if (n > 0) then
	do i = 1, n
	write (u, "(A1,I1,1X,I1,A1)", advance = "no") "[", &
	perm%perms(i,1), perm%perms(i,2), "]"
	if (i < n) write (u, "(A4)", advance = "no") " // "
	end do
	write (u, "(A)") ""
	else
	write (u, "(A)") "[Empty]"
	end if
	end subroutine flv_perm_write

	@ %def flv_perm_write
	@
	<<FKS regions: flavor permutation: TBP>>=
	procedure :: reset => flv_perm_final
	procedure :: final => flv_perm_final
	<<FKS regions: sub interfaces>>=
	module subroutine flv_perm_final (perm)
	class(flv_perm_t), intent(inout) :: perm
	end subroutine flv_perm_final
	<<FKS regions: procedures>>=
	module subroutine flv_perm_final (perm)
	class(flv_perm_t), intent(inout) :: perm
	if (allocated (perm%perms)) deallocate (perm%perms)
	end subroutine flv_perm_final

	@ %def flv_perm_final
	@
	<<FKS regions: flavor permutation: TBP>>=
	generic :: apply => &
	apply_flv_structure, apply_index, apply_ftuple
	procedure :: apply_flv_structure => flv_perm_apply_flv_structure
	procedure :: apply_index => flv_perm_apply_index
	procedure :: apply_ftuple => flv_perm_apply_ftuple
	<<FKS regions: sub interfaces>>=
	elemental module function flv_perm_apply_flv_structure &
	(perm, flv_in, invert) result (flv_out)
	type(flv_structure_t) :: flv_out
	class(flv_perm_t), intent(in) :: perm
	type(flv_structure_t), intent(in) :: flv_in
	logical, intent(in), optional :: invert
	end function flv_perm_apply_flv_structure
	<<FKS regions: procedures>>=
	elemental module function flv_perm_apply_flv_structure &
	(perm, flv_in, invert) result (flv_out)
	type(flv_structure_t) :: flv_out
	class(flv_perm_t), intent(in) :: perm
	type(flv_structure_t), intent(in) :: flv_in
	logical, intent(in), optional :: invert
	integer :: i, i1, i2
	integer :: p1, p2, incr
	integer :: flv_tmp, tag_tmp
	logical :: inv
	inv = .false.; if (present(invert)) inv = invert
	flv_out = flv_in
	if (inv) then
	p1 = 1
	p2 = size (perm%perms, dim = 1)
	incr = 1
	else
	p1 = size (perm%perms, dim = 1)
	p2 = 1
	incr = -1
	end if
	do i = p1, p2, incr
	i1 = perm%perms(i,1)
	i2 = perm%perms(i,2)
	flv_tmp = flv_out%flst(i1)
	tag_tmp = flv_out%tag(i1)
	flv_out%flst(i1) = flv_out%flst(i2)
	flv_out%flst(i2) = flv_tmp
	flv_out%tag(i1) = flv_out%tag(i2)
	flv_out%tag(i2) = tag_tmp
	end do
	end function flv_perm_apply_flv_structure

	@ %def flv_perm_apply_flv_structure
	@
	<<FKS regions: sub interfaces>>=
	elemental module function flv_perm_apply_index &
	(perm, i_in) result (i_out)
	integer :: i_out
	class(flv_perm_t), intent(in) :: perm
	integer, intent(in) :: i_in
	end function flv_perm_apply_index
	<<FKS regions: procedures>>=
	elemental module function flv_perm_apply_index &
	(perm, i_in) result (i_out)
	integer :: i_out
	class(flv_perm_t), intent(in) :: perm
	integer, intent(in) :: i_in
	integer :: i, i1, i2
	i_out = i_in
	do i = size (perm%perms(:,1)), 1, -1
	i1 = perm%perms(i,1)
	i2 = perm%perms(i,2)
	if (i_out == i1) then
	i_out = i2
	else if (i_out == i2) then
	i_out = i1
	end if
	end do
	end function flv_perm_apply_index

	@ %def flv_perm_apply_index
	@
	<<FKS regions: sub interfaces>>=
	elemental module function flv_perm_apply_ftuple &
	(perm, f_in) result (f_out)
	type(ftuple_t) :: f_out
	class(flv_perm_t), intent(in) :: perm
	type(ftuple_t), intent(in) :: f_in
	end function flv_perm_apply_ftuple
	<<FKS regions: procedures>>=
	elemental module function flv_perm_apply_ftuple &
	(perm, f_in) result (f_out)
	type(ftuple_t) :: f_out
	class(flv_perm_t), intent(in) :: perm
	type(ftuple_t), intent(in) :: f_in
	integer :: i, i1, i2
	f_out = f_in
	do i = size (perm%perms, dim = 1), 1, -1
	i1 = perm%perms(i,1)
	i2 = perm%perms(i,2)
	if (f_out%ireg(1) == i1) then
	f_out%ireg(1) = i2
	else if (f_out%ireg(1) == i2) then
	f_out%ireg(1) = i1
	end if
	if (f_out%ireg(2) == i1) then
	f_out%ireg(2) = i2
	else if (f_out%ireg(2) == i2) then
	f_out%ireg(2) = i1
	end if
	end do
	if (f_out%ireg(1) > f_out%ireg(2)) f_out%ireg = f_out%ireg([2,1])
	end function flv_perm_apply_ftuple

	@ %def flv_perm_apply_ftuple
	@
	<<FKS regions: flavor permutation: TBP>>=
	procedure :: eqv => flv_perm_eqv
	<<FKS regions: sub interfaces>>=
	module function flv_perm_eqv &
	(perm, flv1, flv2, with_tag) result (valid)
	logical :: valid
	class(flv_perm_t), intent(in) :: perm
	type(flv_structure_t), intent(in) :: flv1, flv2
	logical, intent(in) :: with_tag
	end function flv_perm_eqv
	<<FKS regions: procedures>>=
	module function flv_perm_eqv &
	(perm, flv1, flv2, with_tag) result (valid)
	logical :: valid
	class(flv_perm_t), intent(in) :: perm
	type(flv_structure_t), intent(in) :: flv1, flv2
	logical, intent(in) :: with_tag
	type(flv_structure_t) :: flv_tmp
	flv_tmp = perm%apply (flv2, invert = .true.)
	valid = all (flv_tmp%flst == flv1%flst)
	if (with_tag) valid = valid .and. all (flv_tmp%tag == flv1%tag)
	call flv_tmp%final ()
	end function flv_perm_eqv

	@ %def flv_perm_eqv
	@ A singular region is a partition of phase space which is associated with
	an individual emitter and, if relevant, resonance. It is associated with
	an $\alpha_r$- and resonance-index, with a real flavor structure and
	its underlying Born flavor structure. To compute the FKS weights, it is
	relevant to know all the other particle indices which can result in a
	divergenent phase space configuration, which are collected in the
	[[ftuples]]-array.

	Some singular regions might behave physically identical. E.g. a real
	flavor structure associated with three-jet production is $[11,-11,2,-2,21,21]$.
	Here, there are two possible [[ftuples]] which contribute to the same
	$u \rightarrow u g$ splitting, namely $(3,5)$ and $(3,6)$. The resulting
	singular regions will be identical. To avoid this, one singular region
	is associated with the multiplicity factor [[mult]]. When computing the
	subtraction terms for each singular region, the result is then simply
	multiplied by this factor.\\
	The [[double_fsr]]-flag indicates whether the singular region should
	also be supplied by a symmetry factor, explained below.
	<<FKS regions: public>>=
	public :: singular_region_t
	<<FKS regions: types>>=
	type :: singular_region_t
	integer :: alr
	integer :: i_res
	type(flv_structure_t) :: flst_real
	type(flv_structure_t) :: flst_uborn
	integer :: mult
	integer :: emitter
	integer :: nregions
	integer :: real_index
	type(ftuple_t), dimension(:), allocatable :: ftuples
	integer :: uborn_index
	logical :: double_fsr = .false.
	logical :: soft_divergence = .false.
	logical :: coll_divergence = .false.
	type(string_t) :: nlo_correction_type
	integer, dimension(:), allocatable :: i_reg_to_i_con
	logical :: pseudo_isr = .false.
	logical :: sc_required = .false.
	integer :: eqv_index = 0
	contains
	<<FKS regions: singular region: TBP>>
	end type singular_region_t

	@ %def singular_region_t
	@
	<<FKS regions: singular region: TBP>>=
	procedure :: init => singular_region_init
	<<FKS regions: sub interfaces>>=
	module subroutine singular_region_init (sregion, alr, mult, i_res, &
	flst_real, flst_uborn, flv_born, emitter, ftuples, equivalences, &
	nlo_correction_type)
	class(singular_region_t), intent(out) :: sregion
	integer, intent(in) :: alr, mult, i_res
	type(flv_structure_t), intent(in) :: flst_real
	type(flv_structure_t), intent(in) :: flst_uborn
	type(flv_structure_t), dimension(:), intent(in) :: flv_born
	integer, intent(in) :: emitter
	type(ftuple_t), intent(inout), dimension(:) :: ftuples
	logical, intent(inout), dimension(:,:) :: equivalences
	type(string_t), intent(in) :: nlo_correction_type
	end subroutine singular_region_init
	<<FKS regions: procedures>>=
	module subroutine singular_region_init (sregion, alr, mult, i_res, &
	flst_real, flst_uborn, flv_born, emitter, ftuples, equivalences, &
	nlo_correction_type)
	class(singular_region_t), intent(out) :: sregion
	integer, intent(in) :: alr, mult, i_res
	type(flv_structure_t), intent(in) :: flst_real
	type(flv_structure_t), intent(in) :: flst_uborn
	type(flv_structure_t), dimension(:), intent(in) :: flv_born
	integer, intent(in) :: emitter
	type(ftuple_t), intent(inout), dimension(:) :: ftuples
	logical, intent(inout), dimension(:,:) :: equivalences
	type(string_t), intent(in) :: nlo_correction_type
	integer :: i
	call debug_input_values ()
	sregion%alr = alr
	sregion%mult = mult
	sregion%i_res = i_res
	sregion%flst_real = flst_real
	sregion%flst_uborn = flst_uborn
	sregion%emitter = emitter
	sregion%nlo_correction_type = nlo_correction_type
	sregion%nregions = size (ftuples)
	allocate (sregion%ftuples (sregion%nregions))
	sregion%ftuples = ftuples
	do i = 1, size(flv_born)
	if (flv_born (i) .equiv. sregion%flst_uborn) then
	sregion%uborn_index = i
	exit
	end if
	end do
	sregion%sc_required = any (sregion%flst_uborn%flst == GLUON) .or. &
	any (sregion%flst_uborn%flst == PHOTON)
	contains
	subroutine debug_input_values()
	if (debug_on) call msg_debug2 (D_SUBTRACTION, "singular_region_init")
	if (debug2_active (D_SUBTRACTION)) then
	print *, 'alr = ', alr
	print *, 'mult = ', mult
	print *, 'i_res = ', i_res
	call flst_real%write ()
	call flst_uborn%write ()
	print *, 'emitter = ', emitter
	call print_equivalence_matrix (ftuples, equivalences)
	end if
	end subroutine debug_input_values
	end subroutine singular_region_init

	@ %def singular_region_init
	<<FKS regions: singular region: TBP>>=
	procedure :: write => singular_region_write
	<<FKS regions: sub interfaces>>=
	module subroutine singular_region_write (sregion, unit, maxnregions)
	class(singular_region_t), intent(in) :: sregion
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: maxnregions
	end subroutine singular_region_write
	<<FKS regions: procedures>>=
	module subroutine singular_region_write (sregion, unit, maxnregions)
	class(singular_region_t), intent(in) :: sregion
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: maxnregions
	character(len=7), parameter :: flst_format = "(I3,A1)"
	character(len=7), parameter :: ireg_space_format = "(7X,A1)"
	integer :: nreal, nborn, i, u, mr
	integer :: nleft, nright, nreg, nreg_diff
	u = given_output_unit (unit); if (u < 0) return
	mr = sregion%nregions; if (present (maxnregions)) mr = maxnregions
	nreal = size (sregion%flst_real%flst)
	nborn = size (sregion%flst_uborn%flst)
	call write_vline (u)
	write (u, '(A1)', advance = 'no') '['
	do i = 1, nreal - 1
	write (u, flst_format, advance = 'no') sregion%flst_real%flst(i), ','
	end do
	write (u, flst_format, advance = 'no') sregion%flst_real%flst(nreal), ']'
	call write_vline (u)
	write (u, '(I6)', advance = 'no') sregion%real_index
	call write_vline (u)
	write (u, '(I3)', advance = 'no') sregion%emitter
	call write_vline (u)
	write (u, '(I3)', advance = 'no') sregion%mult
	call write_vline (u)
	write (u, '(I4)', advance = 'no') sregion%nregions
	call write_vline (u)
	if (sregion%i_res > 0) then
	write (u, '(I3)', advance = 'no') sregion%i_res
	call write_vline (u)
	end if
	nreg = sregion%nregions
	if (nreg == mr) then
	nleft = 0
	nright = 0
	else
	nreg_diff = mr - nreg
	nleft = nreg_diff / 2
	if (mod(nreg_diff , 2) == 0) then
	nright = nleft
	else
	nright = nleft + 1
	end if
	end if
	if (nleft > 0) then
	do i = 1, nleft
	write(u, ireg_space_format, advance='no') ' '
	end do
	end if
	write (u, '(A)', advance = 'no') char (ftuple_string (sregion%ftuples, .false.))
	call write_vline (u)
	write (u,'(A1)',advance = 'no') '['
	do i = 1, nborn - 1
	write(u, flst_format, advance = 'no') sregion%flst_uborn%flst(i), ','
	end do
	write (u, flst_format, advance = 'no') sregion%flst_uborn%flst(nborn), ']'
	call write_vline (u)
	write (u, '(I7)', advance = 'no') sregion%uborn_index
	call write_vline (u)
	if (sregion%nlo_correction_type == "EW") then
	write (u, '(A3)', advance = 'no') 'ew'
	else if (sregion%nlo_correction_type == "QCD") then
	write (u, '(A4)', advance = 'no') 'qcd'
	else
	write (u, '(A5)', advance = 'no') 'none'
	end if
	write (u, '(A)')
	end subroutine singular_region_write

	@ %def singular_region_write
	@
	<<FKS regions: singular region: TBP>>=
	procedure :: write_latex => singular_region_write_latex
	<<FKS regions: sub interfaces>>=
	module subroutine singular_region_write_latex (region, unit)
	class(singular_region_t), intent(in) :: region
	integer, intent(in), optional :: unit
	end subroutine singular_region_write_latex
	<<FKS regions: procedures>>=
	module subroutine singular_region_write_latex (region, unit)
	class(singular_region_t), intent(in) :: region
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(I2,A3,A,A3,I2,A3,I1,A3,I1,A3,A,A3,I2,A3,A,A3)") &
	region%alr, " & ", char (region%flst_real%to_string ()), &
	" & ", region%real_index, " & ", region%emitter, " & ", &
	region%mult, " & ", char (ftuple_string (region%ftuples, .true.)), &
	" & ", region%uborn_index, " & ", char (region%flst_uborn%to_string ()), &
	" \\"
	end subroutine singular_region_write_latex

	@ %def singular_region_write_latex
	@ In case of a $g \rightarrow gg$ splitting, the factor
	\begin{equation*}
	\frac{2E_{\rm{em}}}{E_{\rm{em}} + E_{\rm{rad}}}
	\end{equation*}
	is multiplied to the real matrix element. This way, the symmetry of
	the splitting is used and only one singular region has to be taken
	into account. However, the factor ensures that there is only a soft
	singularity if the radiated parton becomes soft.
	<<FKS regions: singular region: TBP>>=
	procedure :: set_splitting_info => singular_region_set_splitting_info
	<<FKS regions: sub interfaces>>=
	module subroutine singular_region_set_splitting_info (region, n_in)
	class(singular_region_t), intent(inout) :: region
	integer, intent(in) :: n_in
	end subroutine singular_region_set_splitting_info
	<<FKS regions: procedures>>=
	module subroutine singular_region_set_splitting_info (region, n_in)
	class(singular_region_t), intent(inout) :: region
	integer, intent(in) :: n_in
	integer :: i1, i2
	integer :: reg
	region%double_fsr = .false.
	region%soft_divergence = .false.
	associate (ftuple => region%ftuples)
	do reg = 1, region%nregions
	call ftuple(reg)%get (i1, i2)
	if (i1 /= region%emitter .or. i2 /= region%flst_real%nlegs) then
	cycle
	else
	if (ftuple(reg)%splitting_type == V_TO_VV .or. &
	ftuple(reg)%splitting_type == F_TO_FV ) then
	region%soft_divergence = .true.
	end if

	if (i1 == 0) then
	region%coll_divergence = &
	.not. all (region%flst_real%massive(1:n_in))
	else
	region%coll_divergence = .not. region%flst_real%massive(i1)
	end if

	if (ftuple(reg)%splitting_type == V_TO_VV) then
	if (all (ftuple(reg)%ireg > n_in)) &
	region%double_fsr = &
	all (is_gluon (region%flst_real%flst(ftuple(reg)%ireg)))
	exit
	else if (ftuple(reg)%splitting_type == UNDEFINED_SPLITTING) then
	call msg_fatal ("All splittings should be defined!")
	end if
	end if
	end do
	if (.not. region%soft_divergence .and. .not. region%coll_divergence) &
	call msg_fatal ("Singular region defined without divergence!")
	end associate
	end subroutine singular_region_set_splitting_info

	@ %def singular_region_set_splitting_info
	@
	<<FKS regions: singular region: TBP>>=
	procedure :: double_fsr_factor => singular_region_double_fsr_factor
	<<FKS regions: sub interfaces>>=
	module function singular_region_double_fsr_factor (region, p) result (val)
	class(singular_region_t), intent(in) :: region
	type(vector4_t), intent(in), dimension(:) :: p
	real(default) :: val
	end function singular_region_double_fsr_factor
	<<FKS regions: procedures>>=
	module function singular_region_double_fsr_factor (region, p) result (val)
	class(singular_region_t), intent(in) :: region
	type(vector4_t), intent(in), dimension(:) :: p
	real(default) :: val
	real(default) :: E_rad, E_em
	if (region%double_fsr) then
	E_em = energy (p(region%emitter))
	E_rad = energy (p(region%flst_real%nlegs))
	val = two * E_em / (E_em + E_rad)
	else
	val = one
	end if
	end function singular_region_double_fsr_factor

	@ %def singular_region_double_fsr_factor
	@
	<<FKS regions: singular region: TBP>>=
	procedure :: has_soft_divergence => singular_region_has_soft_divergence
	<<FKS regions: sub interfaces>>=
	module function singular_region_has_soft_divergence (region) result (div)
	logical :: div
	class(singular_region_t), intent(in) :: region
	end function singular_region_has_soft_divergence
	<<FKS regions: procedures>>=
	module function singular_region_has_soft_divergence (region) result (div)
	logical :: div
	class(singular_region_t), intent(in) :: region
	div = region%soft_divergence
	end function singular_region_has_soft_divergence

	@ %def singular_region_has_soft_divergence
	@
	<<FKS regions: singular region: TBP>>=
	procedure :: has_collinear_divergence => &
	singular_region_has_collinear_divergence
	<<FKS regions: sub interfaces>>=
	module function singular_region_has_collinear_divergence &
	(region) result (div)
	logical :: div
	class(singular_region_t), intent(in) :: region
	end function singular_region_has_collinear_divergence
	<<FKS regions: procedures>>=
	module function singular_region_has_collinear_divergence &
	(region) result (div)
	logical :: div
	class(singular_region_t), intent(in) :: region
	div = region%coll_divergence
	end function singular_region_has_collinear_divergence

	@ %def singular_region_has_collinear_divergence
	@
	<<FKS regions: singular region: TBP>>=
	procedure :: has_identical_ftuples => singular_region_has_identical_ftuples
	<<FKS regions: sub interfaces>>=
	elemental module function singular_region_has_identical_ftuples &
	(sregion) result (value)
	logical :: value
	class(singular_region_t), intent(in) :: sregion
	end function singular_region_has_identical_ftuples
	<<FKS regions: procedures>>=
	elemental module function singular_region_has_identical_ftuples &
	(sregion) result (value)
	logical :: value
	class(singular_region_t), intent(in) :: sregion
	integer :: alr
	value = .false.
	do alr = 1, sregion%nregions
	value = value .or. (count (sregion%ftuples(alr) == sregion%ftuples) > 1)
	end do
	end function singular_region_has_identical_ftuples

	@ %def singular_region_has_identical_ftuples
	@
	<<FKS regions: interfaces>>=
	interface assignment(=)
	module procedure singular_region_assign
	end interface

	<<FKS regions: sub interfaces>>=
	module subroutine singular_region_assign (reg_out, reg_in)
	type(singular_region_t), intent(out) :: reg_out
	type(singular_region_t), intent(in) :: reg_in
	end subroutine singular_region_assign
	<<FKS regions: procedures>>=
	module subroutine singular_region_assign (reg_out, reg_in)
	type(singular_region_t), intent(out) :: reg_out
	type(singular_region_t), intent(in) :: reg_in
	reg_out%alr = reg_in%alr
	reg_out%i_res = reg_in%i_res
	reg_out%flst_real = reg_in%flst_real
	reg_out%flst_uborn = reg_in%flst_uborn
	reg_out%mult = reg_in%mult
	reg_out%emitter = reg_in%emitter
	reg_out%nregions = reg_in%nregions
	reg_out%real_index = reg_in%real_index
	reg_out%uborn_index = reg_in%uborn_index
	reg_out%double_fsr = reg_in%double_fsr
	reg_out%soft_divergence = reg_in%soft_divergence
	reg_out%coll_divergence = reg_in%coll_divergence
	reg_out%nlo_correction_type = reg_in%nlo_correction_type
	if (allocated (reg_in%ftuples)) then
	allocate (reg_out%ftuples (size (reg_in%ftuples)))
	reg_out%ftuples = reg_in%ftuples
	else
	call msg_bug ("singular_region_assign: Trying to copy a " // &
	"singular region without allocated ftuples!")
	end if
	end subroutine singular_region_assign
	@ %def singular_region_assign
	@ Two singular regions match if they would produce the same amplitude.
	For this we have to check that their real and underlying Born flavor
	structures are equivalent, as determined by the [[prc_core]]. However,
	since there are more aspects of a singular region that make it unique,
	we have to check other attributes as well.
	<<FKS regions: interfaces>>=
	interface operator(.match.)
	module procedure singular_region_match
	end interface

	<<FKS regions: sub interfaces>>=
	module function singular_region_match (reg1, reg2) result (match)
	type(singular_region_t), intent(in) :: reg1, reg2
	logical :: match
	end function singular_region_match
	<<FKS regions: procedures>>=
	module function singular_region_match (reg1, reg2) result (match)
	type(singular_region_t), intent(in) :: reg1, reg2
	logical :: match
	match = all ([reg1%flst_real%eqv_index, reg2%flst_real%eqv_index] > 0)
	match = match .and. (reg1%flst_real%eqv_index == reg2%flst_real%eqv_index)
	match = match .and. (reg1%flst_uborn%eqv_index == reg2%flst_uborn%eqv_index)
	match = match .and. (reg1%mult == reg2%mult)
	match = match .and. (reg1%emitter == reg2%emitter)
	match = match .and. (reg1%nregions == reg2%nregions)
	match = match .and. (reg1%double_fsr .eqv. reg2%double_fsr)
	match = match .and. (reg1%soft_divergence .eqv. reg2%soft_divergence)
	match = match .and. (reg1%coll_divergence .eqv. reg2%coll_divergence)
	match = match .and. (char (reg1%nlo_correction_type) == char (reg2%nlo_correction_type))
	if (match) match = match .and. (all (reg1%ftuples == reg2%ftuples))
	end function singular_region_match

	@ %def singular_region_match
	@
	<<FKS regions: types>>=
	type :: resonance_mapping_t
	type(resonance_history_t), dimension(:), allocatable :: res_histories
	integer, dimension(:), allocatable :: alr_to_i_res
	integer, dimension(:,:), allocatable :: i_res_to_alr
	type(vector4_t), dimension(:), allocatable :: p_res
	contains
	<<FKS regions: resonance mapping: TBP>>
	end type resonance_mapping_t

	@ %def resonance_mapping_t
	@ Testing: Init resonance mapping for $\mu \mu b b$ final state.
	<<FKS regions: resonance mapping: TBP>>=
	procedure :: init => resonance_mapping_init
	<<FKS regions: sub interfaces>>=
	module subroutine resonance_mapping_init (res_map, res_hist)
	class(resonance_mapping_t), intent(inout) :: res_map
	type(resonance_history_t), intent(in), dimension(:) :: res_hist
	end subroutine resonance_mapping_init
	<<FKS regions: procedures>>=
	module subroutine resonance_mapping_init (res_map, res_hist)
	class(resonance_mapping_t), intent(inout) :: res_map
	type(resonance_history_t), intent(in), dimension(:) :: res_hist
	integer :: n_hist, i_hist1, i_hist2, n_contributors
	n_contributors = 0
	n_hist = size (res_hist)
	allocate (res_map%res_histories (n_hist))
	do i_hist1 = 1, n_hist
	if (i_hist1 + 1 <= n_hist) then
	do i_hist2 = i_hist1 + 1, n_hist
	if (.not. (res_hist(i_hist1) .contains. res_hist(i_hist2))) &
	n_contributors = n_contributors + &
	res_hist(i_hist2)%n_resonances
	end do
	else
	n_contributors = n_contributors + res_hist(i_hist1)%n_resonances
	end if
	end do
	allocate (res_map%p_res (n_contributors))
	res_map%res_histories = res_hist
	res_map%p_res = vector4_null
	end subroutine resonance_mapping_init

	@ %def resonance_mapping_init
	@
	<<FKS regions: resonance mapping: TBP>>=
	procedure :: set_alr_to_i_res => resonance_mapping_set_alr_to_i_res
	<<FKS regions: sub interfaces>>=
	module subroutine resonance_mapping_set_alr_to_i_res &
	(res_map, regions, alr_new_to_old)
	class(resonance_mapping_t), intent(inout) :: res_map
	type(singular_region_t), intent(in), dimension(:) :: regions
	integer, intent(out), dimension(:), allocatable :: alr_new_to_old
	end subroutine resonance_mapping_set_alr_to_i_res
	<<FKS regions: procedures>>=
	module subroutine resonance_mapping_set_alr_to_i_res &
	(res_map, regions, alr_new_to_old)
	class(resonance_mapping_t), intent(inout) :: res_map
	type(singular_region_t), intent(in), dimension(:) :: regions
	integer, intent(out), dimension(:), allocatable :: alr_new_to_old
	integer :: alr, i_res
	integer :: alr_new, n_alr_res
	integer :: k
	if (debug_on) call msg_debug &
	(D_SUBTRACTION, "resonance_mapping_set_alr_to_i_res")
	n_alr_res = 0
	do alr = 1, size (regions)
	do i_res = 1, size (res_map%res_histories)
	if (res_map%res_histories(i_res)%contains_leg &
	(regions(alr)%emitter)) &
	n_alr_res = n_alr_res + 1
	end do
	end do

	allocate (res_map%alr_to_i_res (n_alr_res))
	allocate (res_map%i_res_to_alr (size (res_map%res_histories), 10))
	res_map%i_res_to_alr = 0
	allocate (alr_new_to_old (n_alr_res))
	alr_new = 1
	do alr = 1, size (regions)
	do i_res = 1, size (res_map%res_histories)
	if (res_map%res_histories(i_res)%contains_leg &
	(regions(alr)%emitter)) then
	res_map%alr_to_i_res (alr_new) = i_res
	alr_new_to_old (alr_new) = alr
	alr_new = alr_new + 1
	end if
	end do
	end do

	do i_res = 1, size (res_map%res_histories)
	k = 1
	do alr = 1, size (regions)
	if (res_map%res_histories(i_res)%contains_leg &
	(regions(alr)%emitter)) then
	res_map%i_res_to_alr (i_res, k) = alr
	k = k + 1
	end if
	end do
	end do
	if (debug_active (D_SUBTRACTION)) then
	print *, 'i_res_to_alr:'
	do i_res = 1, size(res_map%i_res_to_alr, dim=1)
	print *, res_map%i_res_to_alr (i_res, :)
	end do
	print *, 'alr_new_to_old:', alr_new_to_old
	end if
	end subroutine resonance_mapping_set_alr_to_i_res

	@ %def resonance_mapping_set_alr_to_i_res
	@
	<<FKS regions: resonance mapping: TBP>>=
	procedure :: get_resonance_history => resonance_mapping_get_resonance_history
	<<FKS regions: sub interfaces>>=
	module function resonance_mapping_get_resonance_history &
	(res_map, alr) result (res_hist)
	type(resonance_history_t) :: res_hist
	class(resonance_mapping_t), intent(in) :: res_map
	integer, intent(in) :: alr
	end function resonance_mapping_get_resonance_history
	<<FKS regions: procedures>>=
	module function resonance_mapping_get_resonance_history &
	(res_map, alr) result (res_hist)
	type(resonance_history_t) :: res_hist
	class(resonance_mapping_t), intent(in) :: res_map
	integer, intent(in) :: alr
	res_hist = res_map%res_histories(res_map%alr_to_i_res (alr))
	end function resonance_mapping_get_resonance_history

	@ %def resonance_mapping_get_resonance_history
	@
	<<FKS regions: resonance mapping: TBP>>=
	procedure :: write => resonance_mapping_write
	<<FKS regions: sub interfaces>>=
	module subroutine resonance_mapping_write (res_map)
	class(resonance_mapping_t), intent(in) :: res_map
	end subroutine resonance_mapping_write
	<<FKS regions: procedures>>=
	module subroutine resonance_mapping_write (res_map)
	class(resonance_mapping_t), intent(in) :: res_map
	integer :: i_res
	do i_res = 1, size (res_map%res_histories)
	call res_map%res_histories(i_res)%write ()
	end do
	end subroutine resonance_mapping_write

	@ %def resonance_mapping_write
	@
	<<FKS regions: resonance mapping: TBP>>=
	procedure :: get_resonance_value => resonance_mapping_get_resonance_value
	<<FKS regions: sub interfaces>>=
	module function resonance_mapping_get_resonance_value &
	(res_map, i_res, p, i_gluon) result (p_map)
	real(default) :: p_map
	class(resonance_mapping_t), intent(in) :: res_map
	integer, intent(in) :: i_res
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in), optional :: i_gluon
	end function resonance_mapping_get_resonance_value
	<<FKS regions: procedures>>=
	module function resonance_mapping_get_resonance_value &
	(res_map, i_res, p, i_gluon) result (p_map)
	real(default) :: p_map
	class(resonance_mapping_t), intent(in) :: res_map
	integer, intent(in) :: i_res
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in), optional :: i_gluon
	p_map = res_map%res_histories(i_res)%mapping (p, i_gluon)
	end function resonance_mapping_get_resonance_value

	@ %def resonance_mapping_get_resonance_value
	@
	<<FKS regions: resonance mapping: TBP>>=
	procedure :: get_resonance_all => resonance_mapping_get_resonance_all
	<<FKS regions: sub interfaces>>=
	module function resonance_mapping_get_resonance_all &
	(res_map, alr, p, i_gluon) result (p_map)
	real(default) :: p_map
	class(resonance_mapping_t), intent(in) :: res_map
	integer, intent(in) :: alr
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in), optional :: i_gluon
	end function resonance_mapping_get_resonance_all
	<<FKS regions: procedures>>=
	module function resonance_mapping_get_resonance_all &
	(res_map, alr, p, i_gluon) result (p_map)
	real(default) :: p_map
	class(resonance_mapping_t), intent(in) :: res_map
	integer, intent(in) :: alr
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in), optional :: i_gluon
	integer :: i_res
	p_map = zero
	do i_res = 1, size (res_map%res_histories)
	associate (res => res_map%res_histories(i_res))
	if (any (res_map%i_res_to_alr (i_res, :) == alr)) &
	p_map = p_map + res%mapping (p, i_gluon)
	end associate
	end do
	end function resonance_mapping_get_resonance_all

	@ %def resonance_mapping_get_resonance_all
	@
	<<FKS regions: resonance mapping: TBP>>=
	procedure :: get_weight => resonance_mapping_get_weight
	<<FKS regions: sub interfaces>>=
	module function resonance_mapping_get_weight (res_map, alr, p) result (pfr)
	real(default) :: pfr
	class(resonance_mapping_t), intent(in) :: res_map
	integer, intent(in) :: alr
	type(vector4_t), intent(in), dimension(:) :: p
	end function resonance_mapping_get_weight
	<<FKS regions: procedures>>=
	module function resonance_mapping_get_weight (res_map, alr, p) result (pfr)
	real(default) :: pfr
	class(resonance_mapping_t), intent(in) :: res_map
	integer, intent(in) :: alr
	type(vector4_t), intent(in), dimension(:) :: p
	real(default) :: sumpfr
	integer :: i_res
	sumpfr = zero
	do i_res = 1, size (res_map%res_histories)
	sumpfr = sumpfr + res_map%get_resonance_value (i_res, p)
	end do
	pfr = res_map%get_resonance_value (res_map%alr_to_i_res (alr), p) / sumpfr
	end function resonance_mapping_get_weight

	@ %def resonance_mapping_get_weight
	@
	<<FKS regions: resonance mapping: TBP>>=
	procedure :: get_resonance_alr => resonance_mapping_get_resonance_alr
	<<FKS regions: sub interfaces>>=
	module function resonance_mapping_get_resonance_alr &
	(res_map, alr, p, i_gluon) result (p_map)
	real(default) :: p_map
	class(resonance_mapping_t), intent(in) :: res_map
	integer, intent(in) :: alr
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in), optional :: i_gluon
	end function resonance_mapping_get_resonance_alr
	<<FKS regions: procedures>>=
	module function resonance_mapping_get_resonance_alr &
	(res_map, alr, p, i_gluon) result (p_map)
	real(default) :: p_map
	class(resonance_mapping_t), intent(in) :: res_map
	integer, intent(in) :: alr
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in), optional :: i_gluon
	integer :: i_res
	i_res = res_map%alr_to_i_res (alr)
	p_map = res_map%res_histories(i_res)%mapping (p, i_gluon)
	end function resonance_mapping_get_resonance_alr

	@ %def resonance_mapping_get_resonance_alr
	@
	<<FKS regions: interfaces>>=
	interface assignment(=)
	module procedure resonance_mapping_assign
	end interface

	<<FKS regions: sub interfaces>>=
	module subroutine resonance_mapping_assign (res_map_out, res_map_in)
	type(resonance_mapping_t), intent(out) :: res_map_out
	type(resonance_mapping_t), intent(in) :: res_map_in
	end subroutine resonance_mapping_assign
	<<FKS regions: procedures>>=
	module subroutine resonance_mapping_assign (res_map_out, res_map_in)
	type(resonance_mapping_t), intent(out) :: res_map_out
	type(resonance_mapping_t), intent(in) :: res_map_in
	if (allocated (res_map_in%res_histories)) then
	allocate (res_map_out%res_histories (size (res_map_in%res_histories)))
	res_map_out%res_histories = res_map_in%res_histories
	end if
	if (allocated (res_map_in%alr_to_i_res)) then
	allocate (res_map_out%alr_to_i_res (size (res_map_in%alr_to_i_res)))
	res_map_out%alr_to_i_res = res_map_in%alr_to_i_res
	end if
	if (allocated (res_map_in%i_res_to_alr)) then
	allocate (res_map_out%i_res_to_alr (size (res_map_in%i_res_to_alr, 1), &
	size (res_map_in%i_res_to_alr, 2)))
	res_map_out%i_res_to_alr = res_map_in%i_res_to_alr
	end if
	if (allocated (res_map_in%p_res)) then
	allocate (res_map_out%p_res (size (res_map_in%p_res)))
	res_map_out%p_res = res_map_in%p_res
	end if
	end subroutine resonance_mapping_assign

	@ %def resonance_mapping_assign
	@ Every FKS mapping should store the $\sum_\alpha d_{ij}^{-1}$ and
	$\sum_\alpha d_{ij,\rm{soft}}^{-1}$.
	Also we keep the option open to use a normlization factor, which ensures
	$\sum_\alpha S_\alpha = 1$.
	<<FKS regions: types>>=
	type, abstract :: fks_mapping_t
	real(default) :: sumdij
	real(default) :: sumdij_soft
	logical :: pseudo_isr = .false.
	real(default) :: normalization_factor = one
	contains
	<<FKS regions: fks mapping: TBP>>
	end type fks_mapping_t

	@ %def fks_mapping_t
	@
	<<FKS regions: public>>=
	public :: fks_mapping_default_t
	<<FKS regions: types>>=
	type, extends (fks_mapping_t) :: fks_mapping_default_t
	real(default) :: exp_1, exp_2
	integer :: n_in
	contains
	<<FKS regions: fks mapping default: TBP>>
	end type fks_mapping_default_t

	@ %def fks_mapping_default_t
	@
	<<FKS regions: public>>=
	public :: fks_mapping_resonances_t
	<<FKS regions: types>>=
	type, extends (fks_mapping_t) :: fks_mapping_resonances_t
	real(default) :: exp_1, exp_2
	type(resonance_mapping_t) :: res_map
	integer :: i_con = 0
	contains
	<<FKS regions: fks mapping resonances: TBP>>
	end type fks_mapping_resonances_t

	@ %def fks_mapping_resonances_t
	@
	<<FKS regions: public>>=
	public :: operator(.equiv.)
	public :: operator(.equivtag.)
	<<FKS regions: interfaces>>=
	interface operator(.equiv.)
	module procedure flv_structure_equivalent_no_tag
	end interface

	interface operator(.equivtag.)
	module procedure flv_structure_equivalent_with_tag
	end interface

	interface assignment(=)
	module procedure flv_structure_assign_flv
	module procedure flv_structure_assign_integer
	end interface

	@ %def operator_equiv
	@
	<<FKS regions: public>>=
	public :: region_data_t
	<<FKS regions: types>>=
	type :: region_data_t
	type(singular_region_t), dimension(:), allocatable :: regions
	type(flv_structure_t), dimension(:), allocatable :: flv_born
	type(flv_structure_t), dimension(:), allocatable :: flv_real
	integer, dimension(:), allocatable :: eqv_flv_index_born
	integer, dimension(:), allocatable :: eqv_flv_index_real
	integer, dimension(:), allocatable :: emitters
	integer :: n_regions = 0
	integer :: n_emitters = 0
	integer :: n_flv_born = 0
	integer :: n_flv_real = 0
	integer :: n_in = 0
	integer :: n_legs_born = 0
	integer :: n_legs_real = 0
	integer :: n_phs = 0
	integer :: alpha_power = 0
	integer :: alphas_power = 0
	type(string_t) :: nlo_correction_type
	class(fks_mapping_t), allocatable :: fks_mapping
	integer, dimension(:), allocatable :: resonances
	type(resonance_contributors_t), dimension(:), allocatable :: alr_contributors
	integer, dimension(:), allocatable :: alr_to_i_contributor
	integer, dimension(:), allocatable :: i_phs_to_i_con
	contains
	<<FKS regions: reg data: TBP>>
	end type region_data_t

	@ %def region_data_t
	@ Gfortran 7/8/9/ bug, has to remain in the main module:
	<<FKS regions: reg data: TBP>>=
	procedure :: allocate_fks_mappings => region_data_allocate_fks_mappings
	<<FKS regions: main procedures>>=
	subroutine region_data_allocate_fks_mappings (reg_data, mapping_type)
	class(region_data_t), intent(inout) :: reg_data
	integer, intent(in) :: mapping_type
	select case (mapping_type)
	case (FKS_DEFAULT)
	allocate (fks_mapping_default_t :: reg_data%fks_mapping)
	case (FKS_RESONANCES)
	allocate (fks_mapping_resonances_t :: reg_data%fks_mapping)
	case default
	call msg_fatal ("Init region_data: FKS mapping not implemented!")
	end select
	end subroutine region_data_allocate_fks_mappings

	@ %def region_data_allocate_fks_mappings
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: init => region_data_init
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_init (reg_data, n_in, model, flavor_born, &
	flavor_real, nlo_correction_type, alpha_pow, alphas_pow)
	class(region_data_t), intent(out) :: reg_data
	integer, intent(in) :: n_in, alpha_pow, alphas_pow
	type(model_t), intent(in) :: model
	integer, intent(in), dimension(:,:) :: flavor_born, flavor_real
	type(string_t), intent(in) :: nlo_correction_type
	end subroutine region_data_init
	<<FKS regions: procedures>>=
	module subroutine region_data_init (reg_data, n_in, model, flavor_born, &
	flavor_real, nlo_correction_type, alpha_pow, alphas_pow)
	class(region_data_t), intent(out) :: reg_data
	integer, intent(in) :: n_in, alpha_pow, alphas_pow
	type(model_t), intent(in) :: model
	integer, intent(in), dimension(:,:) :: flavor_born, flavor_real
	type(string_t), intent(in) :: nlo_correction_type
	integer, dimension(:,:), allocatable :: flv_real_tmp
	type(ftuple_list_t), dimension(:), allocatable :: ftuples
	integer, dimension(:), allocatable :: emitter
	type(flv_structure_t), dimension(:), allocatable :: flst_alr
	integer :: i, n_real
	integer :: n_flv_real_before_check
	reg_data%n_in = n_in
	reg_data%alpha_power = alpha_pow
	reg_data%alphas_power = alphas_pow
	reg_data%n_flv_born = size (flavor_born, dim = 2)
	reg_data%n_legs_born = size (flavor_born, dim = 1)
	reg_data%n_legs_real = reg_data%n_legs_born + 1
	reg_data%nlo_correction_type = nlo_correction_type
	n_flv_real_before_check = size (flavor_real, dim = 2)
	allocate (reg_data%flv_born (reg_data%n_flv_born))
	allocate (flv_real_tmp (reg_data%n_legs_real, n_flv_real_before_check))
	do i = 1, reg_data%n_flv_born
	call reg_data%flv_born(i)%init (flavor_born (:, i), n_in)
	end do
	n_real = 0
	do i = 1, n_flv_real_before_check
	if (nlo_correction_type == "EW") then
	if (.not. (query_coupling_powers &
	(flavor_real (:, i), reg_data%alpha_power + 1, &
	reg_data%alphas_power))) cycle
	end if
	n_real = n_real + 1
	flv_real_tmp (:, n_real) = flavor_real (:, i)
	end do
	allocate (reg_data%flv_real (n_real))
	do i = 1, n_real
	call reg_data%flv_real(i)%init (flv_real_tmp (:, i), n_in)
	end do

	call reg_data%find_regions (model, ftuples, emitter, flst_alr)
	call reg_data%init_singular_regions (ftuples, emitter, &
	flst_alr, nlo_correction_type)
	reg_data%n_flv_real = maxval (reg_data%regions%real_index)
	call reg_data%find_emitters ()
	call reg_data%set_mass_color_and_charge (model)
	call reg_data%set_splitting_info ()
	end subroutine region_data_init

	@ %def region_data_init
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: init_resonance_information => &
	region_data_init_resonance_information
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_init_resonance_information (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	end subroutine region_data_init_resonance_information
	<<FKS regions: procedures>>=
	module subroutine region_data_init_resonance_information (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	call reg_data%enlarge_singular_regions_with_resonances ()
	call reg_data%find_resonances ()
	end subroutine region_data_init_resonance_information

	@ %def region_data_init_resonance_information
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: set_resonance_mappings => region_data_set_resonance_mappings
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_set_resonance_mappings &
	(reg_data, resonance_histories)
	class(region_data_t), intent(inout) :: reg_data
	type(resonance_history_t), intent(in), dimension(:) :: resonance_histories
	end subroutine region_data_set_resonance_mappings
	<<FKS regions: procedures>>=
	module subroutine region_data_set_resonance_mappings &
	(reg_data, resonance_histories)
	class(region_data_t), intent(inout) :: reg_data
	type(resonance_history_t), intent(in), dimension(:) :: resonance_histories
	select type (map => reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	call map%res_map%init (resonance_histories)
	end select
	end subroutine region_data_set_resonance_mappings

	@ %def region_data_set_resonance_mappings
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: setup_fks_mappings => region_data_setup_fks_mappings
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_setup_fks_mappings (reg_data, template, n_in)
	class(region_data_t), intent(inout) :: reg_data
	type(fks_template_t), intent(in) :: template
	integer, intent(in) :: n_in
	end subroutine region_data_setup_fks_mappings
	<<FKS regions: procedures>>=
	module subroutine region_data_setup_fks_mappings (reg_data, template, n_in)
	class(region_data_t), intent(inout) :: reg_data
	type(fks_template_t), intent(in) :: template
	integer, intent(in) :: n_in
	call reg_data%allocate_fks_mappings (template%mapping_type)
	select type (map => reg_data%fks_mapping)
	type is (fks_mapping_default_t)
	call map%set_parameter (n_in, template%fks_dij_exp1, &
	template%fks_dij_exp2)
	end select
	end subroutine region_data_setup_fks_mappings

	@ %def region_data_setup_fks_mappings
	@ So far, we have only created singular regions for a non-resonant case. When
	resonance mappings are required, we have more singular regions, since they
	must now be identified by their emitter-resonance pair index, where the emitter
	must be compatible with the resonance.
	<<FKS regions: reg data: TBP>>=
	procedure :: enlarge_singular_regions_with_resonances &
	=> region_data_enlarge_singular_regions_with_resonances
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_enlarge_singular_regions_with_resonances &
	(reg_data)
	class(region_data_t), intent(inout) :: reg_data
	end subroutine region_data_enlarge_singular_regions_with_resonances
	<<FKS regions: procedures>>=
	module subroutine region_data_enlarge_singular_regions_with_resonances &
	(reg_data)
	class(region_data_t), intent(inout) :: reg_data
	integer :: alr
	integer, dimension(:), allocatable :: alr_new_to_old
	integer :: n_alr_new
	type(singular_region_t), dimension(:), allocatable :: save_regions
	if (debug_on) call msg_debug &
	(D_SUBTRACTION, "region_data_enlarge_singular_regions_with_resonances")
	call debug_input_values ()
	select type (fks_mapping => reg_data%fks_mapping)
	type is (fks_mapping_default_t)
	return
	type is (fks_mapping_resonances_t)
	allocate (save_regions (reg_data%n_regions))
	do alr = 1, reg_data%n_regions
	save_regions(alr) = reg_data%regions(alr)
	end do

	associate (res_map => fks_mapping%res_map)
	call res_map%set_alr_to_i_res (reg_data%regions, alr_new_to_old)
	deallocate (reg_data%regions)
	n_alr_new = size (alr_new_to_old)
	reg_data%n_regions = n_alr_new
	allocate (reg_data%regions (n_alr_new))
	do alr = 1, n_alr_new
	reg_data%regions(alr) = save_regions(alr_new_to_old (alr))
	reg_data%regions(alr)%i_res = res_map%alr_to_i_res (alr)
	end do
	end associate
	end select

	contains

	subroutine debug_input_values ()
	if (debug2_active (D_SUBTRACTION)) then
	call reg_data%write ()
	end if
	end subroutine debug_input_values

	end subroutine region_data_enlarge_singular_regions_with_resonances

	@ %def region_data_enlarge_singular_regions_with_resonances
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: set_isr_pseudo_regions => region_data_set_isr_pseudo_regions
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_set_isr_pseudo_regions (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	end subroutine region_data_set_isr_pseudo_regions
	<<FKS regions: procedures>>=
	module subroutine region_data_set_isr_pseudo_regions (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	integer :: alr
	integer :: n_alr_new
	!!! Subroutine called for threshold factorization ->
	!!! Size of singular regions at this point is fixed
	type(singular_region_t), dimension(2) :: save_regions
	integer, dimension(4) :: alr_new_to_old
	do alr = 1, reg_data%n_regions
	save_regions(alr) = reg_data%regions(alr)
	end do
	n_alr_new = reg_data%n_regions * 2
	alr_new_to_old = [1, 1, 2, 2]
	deallocate (reg_data%regions)
	allocate (reg_data%regions (n_alr_new))
	reg_data%n_regions = n_alr_new
	do alr = 1, n_alr_new
	reg_data%regions(alr) = save_regions(alr_new_to_old (alr))
	call add_pseudo_emitters (reg_data%regions(alr))
	if (mod (alr, 2) == 0) reg_data%regions(alr)%pseudo_isr = .true.
	end do
	contains
	subroutine add_pseudo_emitters (sregion)
	type(singular_region_t), intent(inout) :: sregion
	type(ftuple_t), dimension(2) :: ftuples_save
	integer :: alr
	do alr = 1, 2
	ftuples_save(alr) = sregion%ftuples(alr)
	end do
	deallocate (sregion%ftuples)
	sregion%nregions = sregion%nregions * 2
	allocate (sregion%ftuples (sregion%nregions))
	do alr = 1, sregion%nregions
	sregion%ftuples(alr) = ftuples_save (alr_new_to_old(alr))
	if (mod (alr, 2) == 0) sregion%ftuples(alr)%pseudo_isr = .true.
	end do
	end subroutine add_pseudo_emitters
	end subroutine region_data_set_isr_pseudo_regions

	@ %def region_data_set_isr_pseudo_regions
	@ This subroutine splits up the ftuple-list of the singular regions
	into interference-free lists, i.e. lists which only contain the same
	emitter. This is relevant for factorized NLO calculations. In the
	current implementation, it is hand-tailored for the threshold
	computation, but should be generalized further in the future.
	<<FKS regions: reg data: TBP>>=
	procedure :: split_up_interference_regions_for_threshold => &
	region_data_split_up_interference_regions_for_threshold
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_split_up_interference_regions_for_threshold &
	(reg_data)
	class(region_data_t), intent(inout) :: reg_data
	end subroutine region_data_split_up_interference_regions_for_threshold
	<<FKS regions: procedures>>=
	module subroutine region_data_split_up_interference_regions_for_threshold &
	(reg_data)
	class(region_data_t), intent(inout) :: reg_data
	integer :: alr, i_ftuple
	integer :: current_emitter
	integer :: i1, i2
	integer :: n_new_reg
	type(ftuple_t), dimension(2) :: ftuples
	do alr = 1, reg_data%n_regions
	associate (region => reg_data%regions(alr))
	current_emitter = region%emitter
	n_new_reg = 0
	do i_ftuple = 1, region%nregions
	call region%ftuples(i_ftuple)%get (i1, i2)
	if (i1 == current_emitter) then
	n_new_reg = n_new_reg + 1
	ftuples(n_new_reg) = region%ftuples(i_ftuple)
	end if
	end do
	deallocate (region%ftuples)
	allocate (region%ftuples(n_new_reg))
	region%ftuples = ftuples (1 : n_new_reg)
	region%nregions = n_new_reg
	end associate
	end do
	reg_data%fks_mapping%normalization_factor = 0.5_default
	end subroutine region_data_split_up_interference_regions_for_threshold

	@ %def region_data_split_up_interference_regions_for_threshold
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: set_mass_color_and_charge => &
	region_data_set_mass_color_and_charge
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_set_mass_color_and_charge (reg_data, model)
	class(region_data_t), intent(inout) :: reg_data
	type(model_t), intent(in) :: model
	end subroutine region_data_set_mass_color_and_charge
	<<FKS regions: procedures>>=
	module subroutine region_data_set_mass_color_and_charge (reg_data, model)
	class(region_data_t), intent(inout) :: reg_data
	type(model_t), intent(in) :: model
	integer :: i
	do i = 1, reg_data%n_regions
	associate (region => reg_data%regions(i))
	call region%flst_uborn%init_mass_color_and_charge (model)
	call region%flst_real%init_mass_color_and_charge (model)
	end associate
	end do
	do i = 1, reg_data%n_flv_born
	call reg_data%flv_born(i)%init_mass_color_and_charge (model)
	end do
	do i = 1, size (reg_data%flv_real)
	call reg_data%flv_real(i)%init_mass_color_and_charge (model)
	end do
	end subroutine region_data_set_mass_color_and_charge

	@ %def region_data_set_mass_color_and_charge
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: uses_resonances => region_data_uses_resonances
	<<FKS regions: sub interfaces>>=
	module function region_data_uses_resonances (reg_data) result (val)
	logical :: val
	class(region_data_t), intent(in) :: reg_data
	end function region_data_uses_resonances
	<<FKS regions: procedures>>=
	module function region_data_uses_resonances (reg_data) result (val)
	logical :: val
	class(region_data_t), intent(in) :: reg_data
	select type (fks_mapping => reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	val = .true.
	class default
	val = .false.
	end select
	end function region_data_uses_resonances

	@ %def region_data_uses_resonances
	@ Creates a list containing the emitter of each singular region.
	<<FKS regions: reg data: TBP>>=
	procedure :: get_emitter_list => region_data_get_emitter_list
	<<FKS regions: sub interfaces>>=
	pure module function region_data_get_emitter_list &
	(reg_data) result (emitters)
	class(region_data_t), intent(in) :: reg_data
	integer, dimension(:), allocatable :: emitters
	end function region_data_get_emitter_list
	<<FKS regions: procedures>>=
	pure module function region_data_get_emitter_list (reg_data) result (emitters)
	class(region_data_t), intent(in) :: reg_data
	integer, dimension(:), allocatable :: emitters
	integer :: i
	allocate (emitters (reg_data%n_regions))
	do i = 1, reg_data%n_regions
	emitters(i) = reg_data%regions(i)%emitter
	end do
	end function region_data_get_emitter_list

	@ %def region_data_get_emitter_list
	@ Returns the number of emitters not equal to 0 to avoid double counting
	between emitters 0, 1 and 2.
	<<FKS regions: reg data: TBP>>=
	procedure :: get_n_emitters_sc => region_data_get_n_emitters_sc
	<<FKS regions: sub interfaces>>=
	module function region_data_get_n_emitters_sc &
	(reg_data) result (n_emitters_sc)
	class(region_data_t), intent(in) :: reg_data
	integer :: n_emitters_sc
	end function region_data_get_n_emitters_sc
	<<FKS regions: procedures>>=
	module function region_data_get_n_emitters_sc &
	(reg_data) result (n_emitters_sc)
	class(region_data_t), intent(in) :: reg_data
	integer :: n_emitters_sc
	n_emitters_sc = count (reg_data%emitters /= 0)
	end function region_data_get_n_emitters_sc

	@ %def region_data_get_n_emitters_sc
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: get_associated_resonances => &
	region_data_get_associated_resonances
	<<FKS regions: sub interfaces>>=
	module function region_data_get_associated_resonances &
	(reg_data, emitter) result (res)
	integer, dimension(:), allocatable :: res
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: emitter
	end function region_data_get_associated_resonances
	<<FKS regions: procedures>>=
	module function region_data_get_associated_resonances &
	(reg_data, emitter) result (res)
	integer, dimension(:), allocatable :: res
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: emitter
	integer :: alr, i
	integer :: n_res
	select type (fks_mapping => reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	n_res = 0

	do alr = 1, reg_data%n_regions
	if (reg_data%regions(alr)%emitter == emitter) &
	n_res = n_res + 1
	end do

	if (n_res > 0) then
	allocate (res (n_res))
	else
	return
	end if
	i = 1

	do alr = 1, reg_data%n_regions
	if (reg_data%regions(alr)%emitter == emitter) then
	res (i) = fks_mapping%res_map%alr_to_i_res (alr)
	i = i + 1
	end if
	end do
	end select
	end function region_data_get_associated_resonances

	@ %def region_data_get_associated_resonances
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: emitter_is_compatible_with_resonance => &
	region_data_emitter_is_compatible_with_resonance
	<<FKS regions: sub interfaces>>=
	module function region_data_emitter_is_compatible_with_resonance &
	(reg_data, i_res, emitter) result (compatible)
	logical :: compatible
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_res, emitter
	end function region_data_emitter_is_compatible_with_resonance
	<<FKS regions: procedures>>=
	module function region_data_emitter_is_compatible_with_resonance &
	(reg_data, i_res, emitter) result (compatible)
	logical :: compatible
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_res, emitter
	integer :: i_res_alr, alr
	compatible = .false.
	select type (fks_mapping => reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	do alr = 1, reg_data%n_regions
	i_res_alr = fks_mapping%res_map%alr_to_i_res (alr)
	if (i_res_alr == i_res .and. reg_data%get_emitter(alr) == emitter) then
	compatible = .true.
	exit
	end if
	end do
	end select
	end function region_data_emitter_is_compatible_with_resonance

	@ %def region_data_emitter_is_compatible_with_resonance
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: emitter_is_in_resonance => region_data_emitter_is_in_resonance
	<<FKS regions: sub interfaces>>=
	module function region_data_emitter_is_in_resonance &
	(reg_data, i_res, emitter) result (exist)
	logical :: exist
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_res, emitter
	end function region_data_emitter_is_in_resonance
	<<FKS regions: procedures>>=
	module function region_data_emitter_is_in_resonance &
	(reg_data, i_res, emitter) result (exist)
	logical :: exist
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_res, emitter
	integer :: i
	exist = .false.
	select type (fks_mapping => reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	associate (res_history => fks_mapping%res_map%res_histories(i_res))
	do i = 1, res_history%n_resonances
	exist = exist .or. &
	any (res_history%resonances(i)%contributors%c == emitter)
	end do
	end associate
	end select
	end function region_data_emitter_is_in_resonance

	@ %def region_data_emitter_is_in_resonance
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: get_contributors => region_data_get_contributors
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_get_contributors &
	(reg_data, i_res, emitter, c, success)
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_res, emitter
	integer, intent(inout), dimension(:), allocatable :: c
	logical, intent(out) :: success
	end subroutine region_data_get_contributors
	<<FKS regions: procedures>>=
	module subroutine region_data_get_contributors &
	(reg_data, i_res, emitter, c, success)
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_res, emitter
	integer, intent(inout), dimension(:), allocatable :: c
	logical, intent(out) :: success
	integer :: i
	success = .false.
	select type (fks_mapping => reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	associate (res_history => fks_mapping%res_map%res_histories (i_res))
	do i = 1, res_history%n_resonances
	if (any (res_history%resonances(i)%contributors%c == emitter)) then
	allocate (c (size (res_history%resonances(i)%contributors%c)))
	c = res_history%resonances(i)%contributors%c
	success = .true.
	exit
	end if
	end do
	end associate
	end select
	end subroutine region_data_get_contributors

	@ %def region_data_get_contributors
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: get_emitter => region_data_get_emitter
	<<FKS regions: sub interfaces>>=
	pure module function region_data_get_emitter &
	(reg_data, alr) result (emitter)
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: alr
	integer :: emitter
	end function region_data_get_emitter
	<<FKS regions: procedures>>=
	pure module function region_data_get_emitter (reg_data, alr) result (emitter)
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: alr
	integer :: emitter
	emitter = reg_data%regions(alr)%emitter
	end function region_data_get_emitter

	@ %def region_data_get_emitter
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: map_real_to_born_index => region_data_map_real_to_born_index
	<<FKS regions: sub interfaces>>=
	module function region_data_map_real_to_born_index &
	(reg_data, real_index) result (uborn_index)
	integer :: uborn_index
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: real_index
	end function region_data_map_real_to_born_index
	<<FKS regions: procedures>>=
	module function region_data_map_real_to_born_index &
	(reg_data, real_index) result (uborn_index)
	integer :: uborn_index
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: real_index
	integer :: alr
	uborn_index = 0
	do alr = 1, size (reg_data%regions)
	if (reg_data%regions(alr)%real_index == real_index) then
	uborn_index = reg_data%regions(alr)%uborn_index
	exit
	end if
	end do
	end function region_data_map_real_to_born_index

	@ %def region_data_map_real_to_born_index
	@
	<<FKS regions: reg data: TBP>>=
	generic :: get_flv_states_born => get_flv_states_born_single, &
	get_flv_states_born_array
	procedure :: get_flv_states_born_single => &
	region_data_get_flv_states_born_single
	procedure :: get_flv_states_born_array => &
	region_data_get_flv_states_born_array
	<<FKS regions: sub interfaces>>=
	module function region_data_get_flv_states_born_array &
	(reg_data) result (flv_states)
	integer, dimension(:,:), allocatable :: flv_states
	class(region_data_t), intent(in) :: reg_data
	end function region_data_get_flv_states_born_array
	module function region_data_get_flv_states_born_single &
	(reg_data, i_flv) result (flv_states)
	integer, dimension(:), allocatable :: flv_states
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_flv
	end function region_data_get_flv_states_born_single
	<<FKS regions: procedures>>=
	module function region_data_get_flv_states_born_array &
	(reg_data) result (flv_states)
	integer, dimension(:,:), allocatable :: flv_states
	class(region_data_t), intent(in) :: reg_data
	integer :: i_flv
	allocate (flv_states (reg_data%n_legs_born, reg_data%n_flv_born))
	do i_flv = 1, reg_data%n_flv_born
	flv_states (:, i_flv) = reg_data%flv_born(i_flv)%flst
	end do
	end function region_data_get_flv_states_born_array

	module function region_data_get_flv_states_born_single &
	(reg_data, i_flv) result (flv_states)
	integer, dimension(:), allocatable :: flv_states
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_flv
	allocate (flv_states (reg_data%n_legs_born))
	flv_states = reg_data%flv_born(i_flv)%flst
	end function region_data_get_flv_states_born_single

	@ %def region_data_get_flv_states_born
	@
	<<FKS regions: reg data: TBP>>=
	generic :: get_flv_states_real => &
	get_flv_states_real_single, get_flv_states_real_array
	procedure :: get_flv_states_real_single => &
	region_data_get_flv_states_real_single
	procedure :: get_flv_states_real_array => &
	region_data_get_flv_states_real_array
	<<FKS regions: sub interfaces>>=
	module function region_data_get_flv_states_real_single &
	(reg_data, i_flv) result (flv_states)
	integer, dimension(:), allocatable :: flv_states
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_flv
	end function region_data_get_flv_states_real_single
	module function region_data_get_flv_states_real_array &
	(reg_data) result (flv_states)
	integer, dimension(:,:), allocatable :: flv_states
	class(region_data_t), intent(in) :: reg_data
	end function region_data_get_flv_states_real_array
	<<FKS regions: procedures>>=
	module function region_data_get_flv_states_real_single &
	(reg_data, i_flv) result (flv_states)
	integer, dimension(:), allocatable :: flv_states
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_flv
	integer :: i_reg
	allocate (flv_states (reg_data%n_legs_real))
	do i_reg = 1, reg_data%n_regions
	if (i_flv == reg_data%regions(i_reg)%real_index) then
	flv_states = reg_data%regions(i_reg)%flst_real%flst
	exit
	end if
	end do
	end function region_data_get_flv_states_real_single

	module function region_data_get_flv_states_real_array &
	(reg_data) result (flv_states)
	integer, dimension(:,:), allocatable :: flv_states
	class(region_data_t), intent(in) :: reg_data
	integer :: i_flv
	allocate (flv_states (reg_data%n_legs_real, reg_data%n_flv_real))
	do i_flv = 1, reg_data%n_flv_real
	flv_states (:, i_flv) = reg_data%get_flv_states_real (i_flv)
	end do
	end function region_data_get_flv_states_real_array

	@ %def region_data_get_flv_states_real
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: get_all_flv_states => region_data_get_all_flv_states
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_get_all_flv_states &
	(reg_data, flv_born, flv_real)
	class(region_data_t), intent(in) :: reg_data
	integer, dimension(:,:), allocatable, intent(out) :: flv_born, flv_real
	end subroutine region_data_get_all_flv_states
	<<FKS regions: procedures>>=
	module subroutine region_data_get_all_flv_states &
	(reg_data, flv_born, flv_real)
	class(region_data_t), intent(in) :: reg_data
	integer, dimension(:,:), allocatable, intent(out) :: flv_born, flv_real
	allocate (flv_born (reg_data%n_legs_born, reg_data%n_flv_born))
	flv_born = reg_data%get_flv_states_born ()
	allocate (flv_real (reg_data%n_legs_real, reg_data%n_flv_real))
	flv_real = reg_data%get_flv_states_real ()
	end subroutine region_data_get_all_flv_states

	@ %def region_data_get_all_flv_states
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: get_n_in => region_data_get_n_in
	<<FKS regions: sub interfaces>>=
	module function region_data_get_n_in (reg_data) result (n_in)
	integer :: n_in
	class(region_data_t), intent(in) :: reg_data
	end function region_data_get_n_in
	<<FKS regions: procedures>>=
	module function region_data_get_n_in (reg_data) result (n_in)
	integer :: n_in
	class(region_data_t), intent(in) :: reg_data
	n_in = reg_data%n_in
	end function region_data_get_n_in

	@ %def region_data_get_n_in
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: get_n_legs_real => region_data_get_n_legs_real
	<<FKS regions: sub interfaces>>=
	module function region_data_get_n_legs_real (reg_data) result (n_legs)
	integer :: n_legs
	class(region_data_t), intent(in) :: reg_data
	end function region_data_get_n_legs_real
	<<FKS regions: procedures>>=
	module function region_data_get_n_legs_real (reg_data) result (n_legs)
	integer :: n_legs
	class(region_data_t), intent(in) :: reg_data
	n_legs = reg_data%n_legs_real
	end function region_data_get_n_legs_real

	@ %def region_data_get_n_legs_real
	<<FKS regions: reg data: TBP>>=
	procedure :: get_n_legs_born => region_data_get_n_legs_born
	<<FKS regions: sub interfaces>>=
	module function region_data_get_n_legs_born (reg_data) result (n_legs)
	integer :: n_legs
	class(region_data_t), intent(in) :: reg_data
	end function region_data_get_n_legs_born
	<<FKS regions: procedures>>=
	module function region_data_get_n_legs_born (reg_data) result (n_legs)
	integer :: n_legs
	class(region_data_t), intent(in) :: reg_data
	n_legs = reg_data%n_legs_born
	end function region_data_get_n_legs_born

	@ %def region_data_get_n_legs_born
	<<FKS regions: reg data: TBP>>=
	procedure :: get_n_flv_real => region_data_get_n_flv_real
	<<FKS regions: sub interfaces>>=
	module function region_data_get_n_flv_real (reg_data) result (n_flv)
	integer :: n_flv
	class(region_data_t), intent(in) :: reg_data
	end function region_data_get_n_flv_real
	<<FKS regions: procedures>>=
	module function region_data_get_n_flv_real (reg_data) result (n_flv)
	integer :: n_flv
	class(region_data_t), intent(in) :: reg_data
	n_flv = reg_data%n_flv_real
	end function region_data_get_n_flv_real

	@ %def region_data_get_n_flv_real
	<<FKS regions: reg data: TBP>>=
	procedure :: get_n_flv_born => region_data_get_n_flv_born
	<<FKS regions: sub interfaces>>=
	module function region_data_get_n_flv_born (reg_data) result (n_flv)
	integer :: n_flv
	class(region_data_t), intent(in) :: reg_data
	end function region_data_get_n_flv_born
	<<FKS regions: procedures>>=
	module function region_data_get_n_flv_born (reg_data) result (n_flv)
	integer :: n_flv
	class(region_data_t), intent(in) :: reg_data
	n_flv = reg_data%n_flv_born
	end function region_data_get_n_flv_born

	@ %def region_data_get_n_flv_born

	@ Returns $S_i = \frac{1}{\mathcal{D}d_i}$ or $S_{ij} =
	\frac{1}{\mathcal{D}d_{ij}}$ for one particular singular region. At
	this point, the flavor array should be rearranged in such a way that
	the emitted particle is at the last position of
	the flavor structure list.
	<<FKS regions: reg data: TBP>>=
	generic :: get_svalue => get_svalue_last_pos, get_svalue_ij
	procedure :: get_svalue_last_pos => region_data_get_svalue_last_pos
	procedure :: get_svalue_ij => region_data_get_svalue_ij
	<<FKS regions: sub interfaces>>=
	module function region_data_get_svalue_ij &
	(reg_data, p_real, alr, i, j, i_res) result (sval)
	class(region_data_t), intent(inout) :: reg_data
	type(vector4_t), intent(in), dimension(:) :: p_real
	integer, intent(in) :: alr, i, j
	integer, intent(in) :: i_res
	real(default) :: sval
	end function region_data_get_svalue_ij
	module function region_data_get_svalue_last_pos &
	(reg_data, p, alr, emitter, i_res) result (sval)
	class(region_data_t), intent(inout) :: reg_data
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: alr, emitter
	integer, intent(in) :: i_res
	real(default) :: sval
	end function region_data_get_svalue_last_pos
	<<FKS regions: procedures>>=
	module function region_data_get_svalue_ij &
	(reg_data, p_real, alr, i, j, i_res) result (sval)
	class(region_data_t), intent(inout) :: reg_data
	type(vector4_t), intent(in), dimension(:) :: p_real
	integer, intent(in) :: alr, i, j
	integer, intent(in) :: i_res
	real(default) :: sval
	associate (map => reg_data%fks_mapping)
	call map%compute_sumdij (reg_data%regions(alr), p_real)
	select type (map)
	type is (fks_mapping_resonances_t)
	map%i_con = reg_data%alr_to_i_contributor (alr)
	end select
	map%pseudo_isr = reg_data%regions(alr)%pseudo_isr
	sval = map%svalue (p_real, i, j, i_res) * map%normalization_factor
	end associate
	end function region_data_get_svalue_ij

	module function region_data_get_svalue_last_pos &
	(reg_data, p, alr, emitter, i_res) result (sval)
	class(region_data_t), intent(inout) :: reg_data
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: alr, emitter
	integer, intent(in) :: i_res
	real(default) :: sval
	sval = reg_data%get_svalue (p, alr, emitter, reg_data%n_legs_real, i_res)
	end function region_data_get_svalue_last_pos

	@ %def region_data_get_svalue
	@ The same as above, but for the soft limit.
	<<FKS regions: reg data: TBP>>=
	procedure :: get_svalue_soft => region_data_get_svalue_soft
	<<FKS regions: sub interfaces>>=
	module function region_data_get_svalue_soft &
	(reg_data, p_born, p_soft, alr, emitter, i_res) result (sval)
	class(region_data_t), intent(inout) :: reg_data
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	integer, intent(in) :: alr, emitter, i_res
	real(default) :: sval
	end function region_data_get_svalue_soft
	<<FKS regions: procedures>>=
	module function region_data_get_svalue_soft &
	(reg_data, p_born, p_soft, alr, emitter, i_res) result (sval)
	class(region_data_t), intent(inout) :: reg_data
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	integer, intent(in) :: alr, emitter, i_res
	real(default) :: sval
	associate (map => reg_data%fks_mapping)
	call map%compute_sumdij_soft (reg_data%regions(alr), p_born, p_soft)
	select type (map)
	type is (fks_mapping_resonances_t)
	map%i_con = reg_data%alr_to_i_contributor (alr)
	end select
	map%pseudo_isr = reg_data%regions(alr)%pseudo_isr
	sval = map%svalue_soft (p_born, p_soft, emitter, i_res) * &
	map%normalization_factor
	end associate
	end function region_data_get_svalue_soft

	@ %def region_data_get_svalue_soft
	@ This subroutine starts with a specification of $N$- and
	$N+1$-particle configurations, [[flst_born]] and [[flst_real]], saved
	in [[reg_data]]. From these, it creates a list of fundamental tuples,
	a list of emitters and a list containing the $N+1$-particle
	configuration, rearranged in such a way that the emitter-radiation
	pair is last ([[flst_alr]]). For the $e^+ \, e^- \, \rightarrow u \,
	\bar{u} \, g$- example, the generated objects are shown in table
	\ref{table:ftuples and flavors}. Note that at this point, [[flst_alr]]
	is arranged in such a way that the emitter can only be equal to
	$n_{legs}-1$ for final-state radiation or 0, 1, or 2 for initial-state
	radiation. Further, it occurs that regions can be equivalent. For
	example in table \ref{table:ftuples and flavors} the regions
	corresponding to \texttt{alr} = 1 and \texttt{alr} = 3 as well as
	\texttt{alr} = 2 and \texttt{alr} = 4 describe the same physics and
	are therefore equivalent.
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: find_regions => region_data_find_regions
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_find_regions &
	(reg_data, model, ftuples, emitters, flst_alr)
	class(region_data_t), intent(in) :: reg_data
	type(model_t), intent(in) :: model
	type(ftuple_list_t), intent(out), dimension(:), allocatable :: ftuples
	integer, intent(out), dimension(:), allocatable :: emitters
	type(flv_structure_t), intent(out), dimension(:), allocatable :: flst_alr
	end subroutine region_data_find_regions
	<<FKS regions: procedures>>=
	module subroutine region_data_find_regions &
	(reg_data, model, ftuples, emitters, flst_alr)
	class(region_data_t), intent(in) :: reg_data
	type(model_t), intent(in) :: model
	type(ftuple_list_t), intent(out), dimension(:), allocatable :: ftuples
	integer, intent(out), dimension(:), allocatable :: emitters
	type(flv_structure_t), intent(out), dimension(:), allocatable :: flst_alr
	type(ftuple_list_t), dimension(:,:), allocatable :: ftuples_tmp
	integer, dimension(:,:), allocatable :: ftuple_index
	integer :: n_born, n_real
	integer :: n_legreal
	integer :: i_born, i_real, i_ftuple
	integer :: last_registered_i_born, last_registered_i_real

	n_born = size (reg_data%flv_born)
	n_real = size (reg_data%flv_real)
	n_legreal = size (reg_data%flv_real(1)%flst)
	allocate (emitters (0))
	allocate (flst_alr (0))
	allocate (ftuples (0))
	i_ftuple = 0
	last_registered_i_born = 0; last_registered_i_real = 0

	do i_real = 1, n_real
	do i_born = 1, n_born
	call setup_flsts_emitters_and_ftuples_fsr &
	(i_real, i_born, i_ftuple, flst_alr, emitters, ftuples)
	call setup_flsts_emitters_and_ftuples_isr &
	(i_real, i_born, i_ftuple, flst_alr, emitters, ftuples)
	end do
	end do

	contains
	function incr_i_ftuple_if_required (i_born, i_real, i_ftuple_in) result (i_ftuple)
	integer :: i_ftuple
	integer, intent(in) :: i_born, i_real, i_ftuple_in
	if (last_registered_i_born /= i_born .or. last_registered_i_real /= i_real) then
	last_registered_i_born = i_born
	last_registered_i_real = i_real
	i_ftuple = i_ftuple_in + 1
	else
	i_ftuple = i_ftuple_in
	end if
	end function incr_i_ftuple_if_required

	subroutine setup_flsts_emitters_and_ftuples_fsr &
	(i_real, i_born, i_ftuple, flst_alr, emitters, ftuples)
	integer, intent(in) :: i_real, i_born
	integer, intent(inout) :: i_ftuple
	type(flv_structure_t), intent(inout), dimension(:), allocatable :: flst_alr
	integer, intent(inout), dimension(:), allocatable :: emitters
	type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples
	type(ftuple_list_t) :: ftuples_tmp
	type(flv_structure_t) :: flst_alr_tmp
	type(ftuple_t) :: current_ftuple
	integer :: leg1, leg2
	logical :: valid
	associate (flv_born => reg_data%flv_born(i_born), &
	flv_real => reg_data%flv_real(i_real))
	do leg1 = reg_data%n_in + 1, n_legreal
	do leg2 = leg1 + 1, n_legreal
	valid = flv_real%valid_pair(leg1, leg2, flv_born, model)
	if (valid) then
	if (is_vector(flv_real%flst(leg1)) .and. &
	is_fermion(flv_real%flst(leg2))) then
	flst_alr_tmp = create_alr (flv_real, &
	reg_data%n_in, leg2, leg1)
	else
	flst_alr_tmp = create_alr (flv_real, &
	reg_data%n_in, leg1, leg2)
	end if
	flst_alr = [flst_alr, flst_alr_tmp]
	emitters = [emitters, n_legreal - 1]
	call current_ftuple%set (leg1, leg2)
	call current_ftuple%determine_splitting_type_fsr &
	(flv_real, leg1, leg2)
	call current_ftuple%determine_sub_correction_type &
	(flv_born, flv_real, leg1, leg2)
	i_ftuple = incr_i_ftuple_if_required (i_born, i_real, i_ftuple)
	if (i_ftuple > size (ftuples)) then
	call ftuples_tmp%append (current_ftuple)
	ftuples = [ftuples, ftuples_tmp]
	else
	call ftuples(i_ftuple)%append (current_ftuple)
	end if
	end if
	end do
	end do
	end associate
	end subroutine setup_flsts_emitters_and_ftuples_fsr

	subroutine setup_flsts_emitters_and_ftuples_isr &
	(i_real, i_born, i_ftuple, flst_alr, emitters, ftuples)
	integer, intent(in) :: i_real, i_born
	integer, intent(inout) :: i_ftuple
	type(flv_structure_t), intent(inout), dimension(:), allocatable :: flst_alr
	integer, intent(inout), dimension(:), allocatable :: emitters
	type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples
	type(ftuple_list_t) :: ftuples_tmp
	type(flv_structure_t) :: flst_alr_tmp
	type(ftuple_t) :: current_ftuple
	integer :: leg, emitter
	logical :: valid1, valid2
	associate (flv_born => reg_data%flv_born(i_born), &
	flv_real => reg_data%flv_real(i_real))
	do leg = reg_data%n_in + 1, n_legreal
	valid1 = flv_real%valid_pair(1, leg, flv_born, model)
	if (reg_data%n_in > 1) then
	valid2 = flv_real%valid_pair(2, leg, flv_born, model)
	else
	valid2 = .false.
	end if
	if (valid1 .and. valid2) then
	emitter = 0
	else if (valid1 .and. .not. valid2) then
	emitter = 1
	else if (.not. valid1 .and. valid2) then
	emitter = 2
	else
	emitter = -1
	end if
	if (valid1 .or. valid2) then
	flst_alr_tmp = create_alr (flv_real, reg_data%n_in, emitter, leg)
	flst_alr = [flst_alr, flst_alr_tmp]
	emitters = [emitters, emitter]
	call current_ftuple%set(emitter, leg)
	call current_ftuple%determine_splitting_type_isr &
	(flv_real, emitter, leg)
	call current_ftuple%determine_sub_correction_type &
	(flv_born, flv_real, emitter, leg)
	i_ftuple = incr_i_ftuple_if_required (i_born, i_real, i_ftuple)
	if (i_ftuple > size (ftuples)) then
	call ftuples_tmp%append (current_ftuple)
	ftuples = [ftuples, ftuples_tmp]
	else
	call ftuples(i_ftuple)%append (current_ftuple)
	end if
	end if
	end do
	end associate
	end subroutine setup_flsts_emitters_and_ftuples_isr

	end subroutine region_data_find_regions

	@ %def region_data_find_regions
	@ We transfer the mapping of flavor structures that lead to the same amplitude
	(with structure functions already accounted for!) to the Born and real
	[[flv_structure]] of each [[singular_region]].
	We then use this information, besides other data of each [[singular_region]],
	to determine which produce the same amplitude for the non-subtracted real
	and real subtraction terms and set up the equivalence index mapping for
	each region.
	<<FKS regions: reg data: TBP>>=
	procedure :: find_eqv_regions => region_data_find_eqv_regions
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_find_eqv_regions (reg_data, optimize)
	class(region_data_t), intent(inout) :: reg_data
	logical, intent(in) :: optimize
	end subroutine region_data_find_eqv_regions
	<<FKS regions: procedures>>=
	module subroutine region_data_find_eqv_regions (reg_data, optimize)
	class(region_data_t), intent(inout) :: reg_data
	logical, intent(in) :: optimize
	integer :: n_reg, alr1, alr2
	n_reg = reg_data%n_regions
	if (optimize) then
	do alr1 = 1, n_reg
	reg_data%regions(alr1)%flst_uborn%eqv_index = &
	reg_data%eqv_flv_index_born(reg_data%regions(alr1)%uborn_index)
	reg_data%regions(alr1)%flst_real%eqv_index = &
	reg_data%eqv_flv_index_real(reg_data%regions(alr1)%real_index)
	end do
	do alr1 = 1, n_reg
	do alr2 = 1, alr1
	if (reg_data%regions(alr2) .match. reg_data%regions(alr1)) then
	reg_data%regions(alr1)%eqv_index = alr2
	exit
	end if
	end do
	end do
	else
	do alr1 = 1, n_reg
	reg_data%regions(alr1)%eqv_index = alr1
	end do
	end if
	end subroutine region_data_find_eqv_regions

	@ %def region_data_find_eqv_regions
	@ Creates singular regions according to table \ref{table:singular
	regions}. It scans all regions in table \ref{table:ftuples and
	flavors} and records the real flavor structures. If they are
	equivalent, the flavor structure is not recorded, but the multiplicity
	of the present one is increased.
	<<FKS regions: reg data: TBP>>=
	procedure :: init_singular_regions => region_data_init_singular_regions
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_init_singular_regions &
	(reg_data, ftuples, emitter, flv_alr, nlo_correction_type)
	class(region_data_t), intent(inout) :: reg_data
	type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples
	type(string_t), intent(in) :: nlo_correction_type
	integer, intent(in), dimension(:) :: emitter
	type(flv_structure_t), intent(in), dimension(:) :: flv_alr
	end subroutine region_data_init_singular_regions
	<<FKS regions: procedures>>=
	module subroutine region_data_init_singular_regions &
	(reg_data, ftuples, emitter, flv_alr, nlo_correction_type)
	class(region_data_t), intent(inout) :: reg_data
	type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples
	type(string_t), intent(in) :: nlo_correction_type
	type(string_t), dimension(:), allocatable :: nlo_correction_type_dyn
	integer, intent(in), dimension(:) :: emitter
	integer :: n_independent_flv
	type(flv_structure_t), intent(in), dimension(:) :: flv_alr
	type(flv_structure_t), dimension(:), allocatable :: flv_uborn, &
	flv_alr_registered
	integer, dimension(:), allocatable :: mult
	integer, dimension(:), allocatable :: flst_emitter
	integer :: n_regions, maxregions
	integer, dimension(:), allocatable :: index
	integer :: i, i_flv, n_legs
	logical :: equiv, valid_fs_splitting, pure_corr_type, &
	corr_type_valid, non_singular_reg
	integer :: i_first, i_reg, i_reg_prev
	integer, dimension(:), allocatable :: region_to_ftuple, alr_limits
	integer, dimension(:), allocatable :: equiv_index

	maxregions = size (emitter)
	n_legs = flv_alr(1)%nlegs

	allocate (flv_uborn (maxregions))
	allocate (flv_alr_registered (maxregions))
	allocate (mult (maxregions))
	mult = 0
	allocate (flst_emitter (maxregions))
	allocate (index (0))
	allocate (region_to_ftuple (maxregions))
	allocate (equiv_index (maxregions))
	allocate (nlo_correction_type_dyn (maxregions))

	call setup_region_mappings (n_independent_flv, alr_limits, region_to_ftuple)
	nlo_correction_type_dyn = nlo_correction_type
	i_first = 1
	i_reg = 1
	SCAN_FLAVORS: do i_flv = 1, n_independent_flv
	SCAN_FTUPLES: do i = i_first, i_first + alr_limits (i_flv) - 1
	equiv = .false.
	corr_type_valid = .true.
	non_singular_reg = .false.
	if (i == i_first) then
	flv_alr_registered(i_reg) = flv_alr(i)
	if (nlo_correction_type == "EW" .and. &
	reg_data%alphas_power > 0) then
	nlo_correction_type_dyn (i_reg) = &
	set_dynamic_correction_type (i)
	end if
	flv_uborn(i_reg) = flv_alr(i)%create_uborn (emitter(i), &
	nlo_correction_type_dyn (i_reg))
	flst_emitter(i_reg) = emitter(i)
	equiv_index(i_reg) = region_to_ftuple(i)
	if (nlo_correction_type == "EW" .and. reg_data%alphas_power > 0) then
	corr_type_valid = (nlo_correction_type_dyn (i_reg) == "EW" .and. &
	query_coupling_powers (flv_uborn(i_reg)%flst, &
	reg_data%alpha_power, reg_data%alphas_power)) &
	.or. (nlo_correction_type_dyn (i_reg) == "QCD" .and. &
	query_coupling_powers (flv_uborn(i_reg)%flst, &
	reg_data%alpha_power + 1, reg_data%alphas_power - 1))
	non_singular_reg = .not. corr_type_valid .and. &
	qcd_ew_interferences (flv_alr_registered(i_reg)%flst) &
	.and. query_coupling_powers (flv_alr_registered(i_reg)%flst, &
	reg_data%alpha_power+2, reg_data%alphas_power-1) &
	.and. .not. qcd_ew_interferences (flv_uborn(i_reg)%flst) &
	.and. nlo_correction_type_dyn (i_reg) == "QCD"
	if (non_singular_reg) nlo_correction_type_dyn (i_reg) = "none"
	end if
	if (corr_type_valid .or. non_singular_reg) then
	mult(i_reg) = mult(i_reg) + 1
	index = [index, region_to_real_index(ftuples, i)]
	i_reg = i_reg + 1
	end if
	else
	!!! Check for equivalent flavor structures
	do i_reg_prev = 1, i_reg - 1
	if (emitter(i) == flst_emitter(i_reg_prev) .and. emitter(i) > reg_data%n_in) then
	valid_fs_splitting = check_fs_splitting &
	(flv_alr(i)%get_last_two(n_legs), &
	flv_alr_registered(i_reg_prev)%get_last_two(n_legs), &
	flv_alr(i)%tag(n_legs - 1), &
	flv_alr_registered(i_reg_prev)%tag(n_legs - 1))
	if (nlo_correction_type == "EW" .and. reg_data%alphas_power > 0) then
	nlo_correction_type_dyn (i_reg) = set_dynamic_correction_type (i)
	end if
	pure_corr_type = nlo_correction_type_dyn (i_reg) &
	== nlo_correction_type_dyn (i_reg_prev)
	if ((flv_alr(i) .equiv. flv_alr_registered(i_reg_prev)) &
	.and. valid_fs_splitting .and. pure_corr_type) then
	mult(i_reg_prev) = mult(i_reg_prev) + 1
	equiv = .true.
	call ftuples(region_to_real_index(ftuples, i))%set_equiv &
	(equiv_index(i_reg_prev), region_to_ftuple(i))
	exit
	end if
	else if (emitter(i) == flst_emitter(i_reg_prev) .and. emitter(i) <= reg_data%n_in) then
	if (nlo_correction_type == "EW" .and. reg_data%alphas_power > 0) then
	nlo_correction_type_dyn (i_reg) = set_dynamic_correction_type (i)
	end if
	pure_corr_type = nlo_correction_type_dyn (i_reg) &
	== nlo_correction_type_dyn (i_reg_prev)
	if ((flv_alr(i) .equiv. flv_alr_registered(i_reg_prev)) &
	.and. pure_corr_type) then
	mult(i_reg_prev) = mult(i_reg_prev) + 1
	equiv = .true.
	call ftuples(region_to_real_index(ftuples, i))%set_equiv &
	(equiv_index(i_reg_prev), region_to_ftuple(i))
	exit
	end if
	end if
	end do
	if (.not. equiv) then
	flv_alr_registered(i_reg) = flv_alr(i)
	if (nlo_correction_type == "EW" .and. reg_data%alphas_power > 0) then
	nlo_correction_type_dyn (i_reg) = set_dynamic_correction_type (i)
	end if
	flv_uborn(i_reg) = flv_alr(i)%create_uborn (emitter(i), &
	nlo_correction_type_dyn (i_reg))
	flst_emitter(i_reg) = emitter(i)
	equiv_index (i_reg) = region_to_ftuple(i)
	if (nlo_correction_type == "EW" .and. reg_data%alphas_power > 0) then
	corr_type_valid = (nlo_correction_type_dyn (i_reg) == "EW" .and. &
	query_coupling_powers (flv_uborn(i_reg)%flst, &
	reg_data%alpha_power, reg_data%alphas_power)) &
	.or. (nlo_correction_type_dyn (i_reg) == "QCD" .and. &
	query_coupling_powers (flv_uborn(i_reg)%flst, &
	reg_data%alpha_power + 1, reg_data%alphas_power - 1))
	non_singular_reg = .not. corr_type_valid .and. &
	qcd_ew_interferences (flv_alr_registered(i_reg)%flst) &
	.and. query_coupling_powers (flv_alr_registered(i_reg)%flst, &
	reg_data%alpha_power+2, reg_data%alphas_power-1) &
	.and. .not. qcd_ew_interferences (flv_uborn(i_reg)%flst) &
	.and. nlo_correction_type_dyn (i_reg) == "QCD"
	if (non_singular_reg) nlo_correction_type_dyn (i_reg) = "none"
	end if
	if (corr_type_valid .or. non_singular_reg) then
	mult(i_reg) = mult(i_reg) + 1
	index = [index, region_to_real_index(ftuples, i)]
	i_reg = i_reg + 1
	end if
	end if
	end if
	end do SCAN_FTUPLES
	i_first = i_first + alr_limits(i_flv)
	end do SCAN_FLAVORS
	n_regions = i_reg - 1

	allocate (reg_data%regions (n_regions))
	reg_data%n_regions = n_regions
	call account_for_regions_from_other_uborns (ftuples)
	call init_regions_with_permuted_flavors ()
	call assign_real_indices ()

	deallocate (flv_uborn)
	deallocate (flv_alr_registered)
	deallocate (mult)
	deallocate (flst_emitter)
	deallocate (index)
	deallocate (region_to_ftuple)
	deallocate (equiv_index)

	contains

	subroutine account_for_regions_from_other_uborns (ftuples)
	type(ftuple_list_t), intent(inout), dimension(:), allocatable :: ftuples
	integer :: alr1, alr2, i
	type(ftuple_t), dimension(:), allocatable :: ftuples_alr1, ftuples_alr2
	logical, dimension(:,:), allocatable :: equivalences
	do alr1 = 1, n_regions
	do alr2 = 1, n_regions
	if (index(alr1) == index(alr2)) cycle
	if (flv_alr_registered(alr1) .equiv. flv_alr_registered(alr2)) then
	call ftuples(index(alr1))%to_array (ftuples_alr1, equivalences, .false.)
	call ftuples(index(alr2))%to_array (ftuples_alr2, equivalences, .false.)
	do i = 1, size (ftuples_alr2)
	if (.not. any (ftuple_equal_ireg (ftuples_alr1, ftuples_alr2(i)))) then
	call ftuples(index(alr1))%append (ftuples_alr2(i))
	end if
	end do
	end if
	end do
	end do
	end subroutine account_for_regions_from_other_uborns

	subroutine setup_region_mappings (n_independent_flv, &
	alr_limits, region_to_ftuple)
	integer, intent(inout) :: n_independent_flv
	integer, intent(inout), dimension(:), allocatable :: alr_limits
	integer, intent(inout), dimension(:), allocatable :: region_to_ftuple
	integer :: i, j, i_flv
	if (any (ftuples%get_n_tuples() == 0)) &
	call msg_fatal ("Inconsistent collection of FKS pairs!")
	n_independent_flv = size (ftuples)
	alr_limits = ftuples%get_n_tuples()
	if (.not. (sum (alr_limits) == maxregions)) &
	call msg_fatal ("Too many regions!")
	j = 1
	do i_flv = 1, n_independent_flv
	do i = 1, alr_limits(i_flv)
	region_to_ftuple(j) = i
	j = j + 1
	end do
	end do
	end subroutine setup_region_mappings

	subroutine check_permutation (perm, flv_perm, flv_orig, i_reg)
	type(flv_perm_t), intent(in) :: perm
	type(flv_structure_t), intent(in) :: flv_perm, flv_orig
	integer, intent(in) :: i_reg
	type(flv_structure_t) :: flv_tmp
	flv_tmp = perm%apply (flv_orig, invert = .true.)
	if (.not. all (flv_tmp%flst == flv_perm%flst)) then
	print *, 'Fail at: ', i_reg
	print *, 'Original flavor structure: ', flv_orig%flst
	call perm%write ()
	print *, 'Permuted flavor: ', flv_perm%flst
	print *, 'Should be: ', flv_tmp%flst
	call msg_fatal ("Permutation does not reproduce original flavor!")
	end if
	end subroutine check_permutation

	subroutine init_regions_with_permuted_flavors ()
	type(flv_perm_t) :: perm_list
	type(ftuple_t), dimension(:), allocatable :: ftuple_array
	logical, dimension(:,:), allocatable :: equivalences
	integer :: i, j
	do j = 1, n_regions
	do i = 1, reg_data%n_flv_born
	if (reg_data%flv_born (i) .equiv. flv_uborn (j)) then
	call perm_list%reset ()
	call perm_list%init (reg_data%flv_born(i), flv_uborn(j), &
	reg_data%n_in, reg_data%n_legs_born, .true.)
	flv_uborn(j) = perm_list%apply (flv_uborn(j))
	flv_alr_registered(j) = perm_list%apply (flv_alr_registered(j))
	flst_emitter(j) = perm_list%apply (flst_emitter(j))
	end if
	end do
	call ftuples(index(j))%to_array (ftuple_array, equivalences, .false.)
	do i = 1, size (reg_data%flv_real)
	if (reg_data%flv_real(i) .equiv. flv_alr_registered(j)) then
	call perm_list%reset ()
	call perm_list%init (flv_alr_registered(j), reg_data%flv_real(i), &
	reg_data%n_in, reg_data%n_legs_real, .false.)
	if (debug_active (D_SUBTRACTION)) call check_permutation &
	(perm_list, reg_data%flv_real(i), flv_alr_registered(j), j)
	ftuple_array = perm_list%apply (ftuple_array)
	call ftuple_sort_array (ftuple_array, equivalences)
	end if
	end do
	call reg_data%regions(j)%init (j, mult(j), 0, flv_alr_registered(j), &
	flv_uborn(j), reg_data%flv_born, flst_emitter(j), ftuple_array, &
	equivalences, nlo_correction_type_dyn (j))
	if (allocated (ftuple_array)) deallocate (ftuple_array)
	if (allocated (equivalences)) deallocate (equivalences)
	end do
	end subroutine init_regions_with_permuted_flavors

	subroutine assign_real_indices ()
	type(flv_structure_t) :: current_flv_real
	type(flv_structure_t), dimension(:), allocatable :: these_flv
	integer :: i_real, current_uborn_index
	integer :: i, j, this_i_real
	allocate (these_flv (size (flv_alr_registered)))
	i_real = 1
	associate (regions => reg_data%regions)
	do i = 1, reg_data%n_regions
	do j = 1, size (these_flv)
	if (.not. allocated (these_flv(j)%flst)) then
	this_i_real = i_real
	call these_flv(i_real)%init (flv_alr_registered(i)%flst, reg_data%n_in)
	i_real = i_real + 1
	exit
	else if (all (these_flv(j)%flst == flv_alr_registered(i)%flst)) then
	this_i_real = j
	exit
	end if
	end do
	regions(i)%real_index = this_i_real
	end do
	end associate
	deallocate (these_flv)
	end subroutine assign_real_indices

	function check_fs_splitting (flv1, flv2, tag1, tag2) result (valid)
	logical :: valid
	integer, intent(in), dimension(2) :: flv1, flv2
	integer, intent(in) :: tag1, tag2
	if (flv1(1) + flv1(2) == 0) then
	valid = abs(flv1(1)) == abs(flv2(1)) .and. abs(flv1(2)) == abs(flv2(2))
	else
	valid = flv1(1) == flv2(1) .and. flv1(2) == flv2(2) .and. tag1 == tag2
	end if
	end function check_fs_splitting

	function set_dynamic_correction_type (i_flv_alr) result (nlo_corr_type_dyn)
	type(string_t) :: nlo_corr_type_dyn
	type(ftuple_t) :: ftuple_tmp
	integer, intent(in) :: i_flv_alr
	ftuple_tmp = ftuples (region_to_real_index(ftuples, i_flv_alr))%get_ftuple &
	(region_to_ftuple(i_flv_alr))
	if (ftuple_tmp%qcd_split) then
	nlo_corr_type_dyn = var_str ("QCD")
	else
	nlo_corr_type_dyn = var_str ("EW")
	end if
	end function set_dynamic_correction_type
	end subroutine region_data_init_singular_regions

	@ %def region_data_init_singular_regions
	@ Create an array containing all emitters and resonances of [[region_data]].
	<<FKS regions: reg data: TBP>>=
	procedure :: find_emitters => region_data_find_emitters
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_find_emitters (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	end subroutine region_data_find_emitters
	<<FKS regions: procedures>>=
	module subroutine region_data_find_emitters (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	integer :: alr, j, n_em, em
	integer, dimension(:), allocatable :: em_count
	allocate (em_count(reg_data%n_regions))
	em_count = -1
	n_em = 0

	!!!Count the number of different emitters
	do alr = 1, reg_data%n_regions
	em = reg_data%regions(alr)%emitter
	if (.not. any (em_count == em)) then
	n_em = n_em + 1
	em_count(alr) = em
	end if
	end do

	if (n_em < 1) call msg_fatal ("region_data_find_emitters: No emitters found!")
	reg_data%n_emitters = n_em
	allocate (reg_data%emitters (reg_data%n_emitters))
	reg_data%emitters = -1

	j = 1
	do alr = 1, size (reg_data%regions)
	em = reg_data%regions(alr)%emitter
	if (.not. any (reg_data%emitters == em)) then
	reg_data%emitters(j) = em
	j = j + 1
	end if
	end do
	end subroutine region_data_find_emitters

	@ %def region_data_find_emitters
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: find_resonances => region_data_find_resonances
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_find_resonances (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	end subroutine region_data_find_resonances
	<<FKS regions: procedures>>=
	module subroutine region_data_find_resonances (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	integer :: alr, j, k, n_res, n_contr
	integer :: res
	integer, dimension(10) :: res_count
	type(resonance_contributors_t), dimension(10) :: contributors_count
	type(resonance_contributors_t) :: contributors
	integer :: i_res, emitter
	logical :: share_emitter
	res_count = -1
	n_res = 0; n_contr = 0

	!!! Count the number of different resonances
	do alr = 1, reg_data%n_regions
	select type (fks_mapping => reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	res = fks_mapping%res_map%alr_to_i_res (alr)
	if (.not. any (res_count == res)) then
	n_res = n_res + 1
	res_count(alr) = res
	end if
	end select
	end do

	if (n_res > 0) allocate (reg_data%resonances (n_res))

	j = 1
	select type (fks_mapping => reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	do alr = 1, size (reg_data%regions)
	res = fks_mapping%res_map%alr_to_i_res (alr)
	if (.not. any (reg_data%resonances == res)) then
	reg_data%resonances(j) = res
	j = j + 1
	end if
	end do

	allocate (reg_data%alr_to_i_contributor (size (reg_data%regions)))
	do alr = 1, size (reg_data%regions)
	i_res = fks_mapping%res_map%alr_to_i_res (alr)
	emitter = reg_data%regions(alr)%emitter
	call reg_data%get_contributors (i_res, emitter, contributors%c, share_emitter)
	if (.not. share_emitter) cycle
	if (.not. any (contributors_count == contributors)) then
	n_contr = n_contr + 1
	contributors_count(alr) = contributors
	end if
	if (allocated (contributors%c)) deallocate (contributors%c)
	end do
	allocate (reg_data%alr_contributors (n_contr))
	j = 1
	do alr = 1, size (reg_data%regions)
	i_res = fks_mapping%res_map%alr_to_i_res (alr)
	emitter = reg_data%regions(alr)%emitter
	call reg_data%get_contributors (i_res, emitter, contributors%c, share_emitter)
	if (.not. share_emitter) cycle
	if (.not. any (reg_data%alr_contributors == contributors)) then
	reg_data%alr_contributors(j) = contributors
	reg_data%alr_to_i_contributor (alr) = j
	j = j + 1
	else
	do k = 1, size (reg_data%alr_contributors)
	if (reg_data%alr_contributors(k) == contributors) exit
	end do
	reg_data%alr_to_i_contributor (alr) = k
	end if
	if (allocated (contributors%c)) deallocate (contributors%c)
	end do
	end select
	call reg_data%extend_ftuples (n_res)
	call reg_data%set_contributors ()

	end subroutine region_data_find_resonances

	@ %def region_data_find_resonances
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: set_i_phs_to_i_con => region_data_set_i_phs_to_i_con
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_set_i_phs_to_i_con (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	end subroutine region_data_set_i_phs_to_i_con
	<<FKS regions: procedures>>=
	module subroutine region_data_set_i_phs_to_i_con (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	integer :: alr
	integer :: i_res, emitter, i_con, i_phs, i_em
	type(phs_identifier_t), dimension(:), allocatable :: phs_id_tmp
	logical :: share_emitter, phs_exist
	type(resonance_contributors_t) :: contributors
	allocate (phs_id_tmp (reg_data%n_phs))
	if (allocated (reg_data%resonances)) then
	allocate (reg_data%i_phs_to_i_con (reg_data%n_phs))
	do i_em = 1, size (reg_data%emitters)
	emitter = reg_data%emitters(i_em)
	do i_res = 1, size (reg_data%resonances)
	if (reg_data%emitter_is_compatible_with_resonance (i_res, emitter)) then
	alr = find_alr (emitter, i_res)
	if (alr == 0) call msg_fatal ("Could not find requested alpha region!")
	i_con = reg_data%alr_to_i_contributor (alr)
	call reg_data%get_contributors (i_res, emitter, contributors%c, share_emitter)
	if (.not. share_emitter) cycle
	call check_for_phs_identifier &
	(phs_id_tmp, reg_data%n_in, emitter, contributors%c, phs_exist, i_phs)
	if (phs_id_tmp(i_phs)%emitter < 0) then
	phs_id_tmp(i_phs)%emitter = emitter
	allocate (phs_id_tmp(i_phs)%contributors (size (contributors%c)))
	phs_id_tmp(i_phs)%contributors = contributors%c
	end if
	reg_data%i_phs_to_i_con (i_phs) = i_con
	end if
	if (allocated (contributors%c)) deallocate (contributors%c)
	end do
	end do
	end if
	contains
	function find_alr (emitter, i_res) result (alr)
	integer :: alr
	integer, intent(in) :: emitter, i_res
	integer :: i
	do i = 1, reg_data%n_regions
	if (reg_data%regions(i)%emitter == emitter .and. &
	reg_data%regions(i)%i_res == i_res) then
	alr = i
	return
	end if
	end do
	alr = 0
	end function find_alr
	end subroutine region_data_set_i_phs_to_i_con

	@ %def region_data_set_i_phs_to_i_con
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: set_alr_to_i_phs => region_data_set_alr_to_i_phs
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_set_alr_to_i_phs &
	(reg_data, phs_identifiers, alr_to_i_phs)
	class(region_data_t), intent(inout) :: reg_data
	type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
	integer, intent(out), dimension(:) :: alr_to_i_phs
	end subroutine region_data_set_alr_to_i_phs
	<<FKS regions: procedures>>=
	module subroutine region_data_set_alr_to_i_phs &
	(reg_data, phs_identifiers, alr_to_i_phs)
	class(region_data_t), intent(inout) :: reg_data
	type(phs_identifier_t), intent(in), dimension(:) :: phs_identifiers
	integer, intent(out), dimension(:) :: alr_to_i_phs
	integer :: alr, i_phs
	integer :: emitter, i_res
	type(resonance_contributors_t) :: contributors
	logical :: share_emitter, phs_exist
	do alr = 1, reg_data%n_regions
	associate (region => reg_data%regions(alr))
	emitter = region%emitter
	i_res = region%i_res
	if (i_res /= 0) then
	call reg_data%get_contributors (i_res, emitter, &
	contributors%c, share_emitter)
	if (.not. share_emitter) cycle
	end if
	if (allocated (contributors%c)) then
	call check_for_phs_identifier (phs_identifiers, reg_data%n_in, &
	emitter, contributors%c, phs_exist = phs_exist, i_phs = i_phs)
	else
	call check_for_phs_identifier (phs_identifiers, reg_data%n_in, &
	emitter, phs_exist = phs_exist, i_phs = i_phs)
	end if
	if (.not. phs_exist) &
	call msg_fatal ("phs identifiers are not set up correctly!")
	alr_to_i_phs(alr) = i_phs
	end associate
	if (allocated (contributors%c)) deallocate (contributors%c)
	end do
	end subroutine region_data_set_alr_to_i_phs

	@ %def region_data_set_alr_to_i_phs
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: set_contributors => region_data_set_contributors
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_set_contributors (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	end subroutine region_data_set_contributors
	<<FKS regions: procedures>>=
	module subroutine region_data_set_contributors (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	integer :: alr, i_res, i_reg, i_con
	integer :: i1, i2, i_em
	integer, dimension(:), allocatable :: contributors
	logical :: share_emitter
	do alr = 1, size (reg_data%regions)
	associate (sregion => reg_data%regions(alr))
	allocate (sregion%i_reg_to_i_con (sregion%nregions))
	do i_reg = 1, sregion%nregions
	call sregion%ftuples(i_reg)%get (i1, i2)
	i_em = get_emitter_index (i1, i2, reg_data%n_legs_real)
	i_res = sregion%ftuples(i_reg)%i_res
	call reg_data%get_contributors &
	(i_res, i_em, contributors, share_emitter)
	!!! Lookup contributor index
	do i_con = 1, size (reg_data%alr_contributors)
	if (all (reg_data%alr_contributors(i_con)%c == contributors)) &
	then
	sregion%i_reg_to_i_con (i_reg) = i_con
	exit
	end if
	end do
	deallocate (contributors)
	end do
	end associate
	end do
	contains
	function get_emitter_index (i1, i2, n) result (i_em)
	integer :: i_em
	integer, intent(in) :: i1, i2, n
	if (i1 == n) then
	i_em = i2
	else
	i_em = i1
	end if
	end function get_emitter_index
	end subroutine region_data_set_contributors

	@ %def region_data_set_contributors
	@ This extension of the ftuples is still too naive as it assumes that the same
	resonances are possible for all ftuples
	<<FKS regions: reg data: TBP>>=
	procedure :: extend_ftuples => region_data_extend_ftuples
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_extend_ftuples (reg_data, n_res)
	class(region_data_t), intent(inout) :: reg_data
	integer, intent(in) :: n_res
	end subroutine region_data_extend_ftuples
	<<FKS regions: procedures>>=
	module subroutine region_data_extend_ftuples (reg_data, n_res)
	class(region_data_t), intent(inout) :: reg_data
	integer, intent(in) :: n_res
	integer :: alr, n_reg_save
	integer :: i_reg, i_res, i_em, k
	type(ftuple_t), dimension(:), allocatable :: ftuple_save
	integer :: n_new
	do alr = 1, size (reg_data%regions)
	associate (sregion => reg_data%regions(alr))
	n_reg_save = sregion%nregions
	allocate (ftuple_save (n_reg_save))
	ftuple_save = sregion%ftuples
	n_new = count_n_new_ftuples (sregion, n_res)
	deallocate (sregion%ftuples)
	sregion%nregions = n_new
	allocate (sregion%ftuples (n_new))
	k = 1
	do i_res = 1, n_res
	do i_reg = 1, n_reg_save
	associate (ftuple_new => sregion%ftuples(k))
	i_em = ftuple_save(i_reg)%ireg(1)
	if (reg_data%emitter_is_in_resonance (i_res, i_em)) then
	call ftuple_new%set (i_em, ftuple_save(i_reg)%ireg(2))
	ftuple_new%i_res = i_res
	ftuple_new%splitting_type = ftuple_save(i_reg)%splitting_type
	k = k + 1
	end if
	end associate
	end do
	end do
	end associate
	deallocate (ftuple_save)
	end do
	contains
	function count_n_new_ftuples (sregion, n_res) result (n_new)
	integer :: n_new
	type(singular_region_t), intent(in) :: sregion
	integer, intent(in) :: n_res
	integer :: i_reg, i_res, i_em
	n_new = 0
	do i_reg = 1, sregion%nregions
	do i_res = 1, n_res
	i_em = sregion%ftuples(i_reg)%ireg(1)
	if (reg_data%emitter_is_in_resonance (i_res, i_em)) &
	n_new = n_new + 1
	end do
	end do
	end function count_n_new_ftuples
	end subroutine region_data_extend_ftuples

	@ %def region_data_extend_ftuples
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: get_flavor_indices => region_data_get_flavor_indices
	<<FKS regions: sub interfaces>>=
	module function region_data_get_flavor_indices &
	(reg_data, born) result (i_flv)
	integer, dimension(:), allocatable :: i_flv
	class(region_data_t), intent(in) :: reg_data
	logical, intent(in) :: born
	end function region_data_get_flavor_indices
	<<FKS regions: procedures>>=
	module function region_data_get_flavor_indices (reg_data, born) result (i_flv)
	integer, dimension(:), allocatable :: i_flv
	class(region_data_t), intent(in) :: reg_data
	logical, intent(in) :: born
	allocate (i_flv (reg_data%n_regions))
	if (born) then
	i_flv = reg_data%regions%uborn_index
	else
	i_flv = reg_data%regions%real_index
	end if
	end function region_data_get_flavor_indices

	@ %def region_data_get_flavor_indices
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: get_matrix_element_index => region_data_get_matrix_element_index
	<<FKS regions: sub interfaces>>=
	module function region_data_get_matrix_element_index &
	(reg_data, i_reg) result (i_me)
	integer :: i_me
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_reg
	end function region_data_get_matrix_element_index
	<<FKS regions: procedures>>=
	module function region_data_get_matrix_element_index &
	(reg_data, i_reg) result (i_me)
	integer :: i_me
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_reg
	i_me = reg_data%regions(i_reg)%real_index
	end function region_data_get_matrix_element_index

	@ %def region_data_get_matrix_element_index
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: compute_number_of_phase_spaces &
	=> region_data_compute_number_of_phase_spaces
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_compute_number_of_phase_spaces (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	end subroutine region_data_compute_number_of_phase_spaces
	<<FKS regions: procedures>>=
	module subroutine region_data_compute_number_of_phase_spaces (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	integer :: i_em, i_res, i_phs
	integer :: emitter
	type(resonance_contributors_t) :: contributors
	integer, parameter :: n_max_phs = 10
	type(phs_identifier_t), dimension(n_max_phs) :: phs_id_tmp
	logical :: share_emitter, phs_exist
	if (allocated (reg_data%resonances)) then
	reg_data%n_phs = 0
	do i_em = 1, size (reg_data%emitters)
	emitter = reg_data%emitters(i_em)
	do i_res = 1, size (reg_data%resonances)
	if (reg_data%emitter_is_compatible_with_resonance (i_res, emitter)) then
	call reg_data%get_contributors &
	(i_res, emitter, contributors%c, share_emitter)
	if (.not. share_emitter) cycle
	call check_for_phs_identifier (phs_id_tmp, reg_data%n_in, &
	emitter, contributors%c, phs_exist, i_phs)
	if (.not. phs_exist) then
	reg_data%n_phs = reg_data%n_phs + 1
	if (reg_data%n_phs > n_max_phs) call msg_fatal &
	("Buffer of phase space identifieres: Too much phase spaces!")
	call phs_id_tmp(i_phs)%init (emitter, contributors%c)
	end if
	end if
	if (allocated (contributors%c)) deallocate (contributors%c)
	end do
	end do
	else
	reg_data%n_phs = size (remove_duplicates_from_int_array &
	(reg_data%emitters))
	end if
	end subroutine region_data_compute_number_of_phase_spaces

	@ %def region_data_compute_number_of_phase_spaces
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: get_n_phs => region_data_get_n_phs
	<<FKS regions: sub interfaces>>=
	module function region_data_get_n_phs (reg_data) result (n_phs)
	integer :: n_phs
	class(region_data_t), intent(in) :: reg_data
	end function region_data_get_n_phs
	<<FKS regions: procedures>>=
	module function region_data_get_n_phs (reg_data) result (n_phs)
	integer :: n_phs
	class(region_data_t), intent(in) :: reg_data
	n_phs = reg_data%n_phs
	end function region_data_get_n_phs

	@ %def region_data_get_n_phs
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: set_splitting_info => region_data_set_splitting_info
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_set_splitting_info (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	end subroutine region_data_set_splitting_info
	<<FKS regions: procedures>>=
	module subroutine region_data_set_splitting_info (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	integer :: alr
	do alr = 1, reg_data%n_regions
	call reg_data%regions(alr)%set_splitting_info (reg_data%n_in)
	end do
	end subroutine region_data_set_splitting_info

	@ %def region_data_set_splitting_info
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: init_phs_identifiers => region_data_init_phs_identifiers
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_init_phs_identifiers (reg_data, phs_id)
	class(region_data_t), intent(in) :: reg_data
	type(phs_identifier_t), intent(out), dimension(:), allocatable :: phs_id
	end subroutine region_data_init_phs_identifiers
	<<FKS regions: procedures>>=
	module subroutine region_data_init_phs_identifiers (reg_data, phs_id)
	class(region_data_t), intent(in) :: reg_data
	type(phs_identifier_t), intent(out), dimension(:), allocatable :: phs_id
	integer :: i_em, i_res, i_phs
	integer :: emitter
	type(resonance_contributors_t) :: contributors
	logical :: share_emitter, phs_exist
	allocate (phs_id (reg_data%n_phs))
	do i_em = 1, size (reg_data%emitters)
	emitter = reg_data%emitters(i_em)
	if (allocated (reg_data%resonances)) then
	do i_res = 1, size (reg_data%resonances)
	call reg_data%get_contributors (i_res, emitter, &
	contributors%c, share_emitter)
	if (.not. share_emitter) cycle
	call check_for_phs_identifier &
	(phs_id, reg_data%n_in, emitter, contributors%c, &
	phs_exist, i_phs)
	if (.not. phs_exist) &
	call phs_id(i_phs)%init (emitter, contributors%c)
	if (allocated (contributors%c)) deallocate (contributors%c)
	end do
	else
	call check_for_phs_identifier (phs_id, reg_data%n_in, emitter, &
	phs_exist = phs_exist, i_phs = i_phs)
	if (.not. phs_exist) call phs_id(i_phs)%init (emitter)
	end if
	end do
	end subroutine region_data_init_phs_identifiers

	@ %def region_data_init_phs_identifiers
	@ Gathers all ftuples from all ALRs.
	There are at most $n \cdot (n-1)$ ftuples with $i$ and $j$ in the final state
	and up to $3n$ ftuples with $i$ in the initial state.
	<<FKS regions: reg data: TBP>>=
	procedure :: get_all_ftuples => region_data_get_all_ftuples
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_get_all_ftuples (reg_data, ftuples)
	class(region_data_t), intent(in) :: reg_data
	type(ftuple_t), intent(inout), dimension(:), allocatable :: ftuples
	end subroutine region_data_get_all_ftuples
	<<FKS regions: procedures>>=
	module subroutine region_data_get_all_ftuples (reg_data, ftuples)
	class(region_data_t), intent(in) :: reg_data
	type(ftuple_t), intent(inout), dimension(:), allocatable :: ftuples
	type(ftuple_t), dimension(:), allocatable :: ftuple_tmp
	integer :: i, j, alr, n_fs
	j = 0
	n_fs = reg_data%n_legs_real - reg_data%n_in
	allocate (ftuple_tmp (n_fs * (n_fs - 1) + 3 * n_fs))
	do i = 1, reg_data%n_regions
	associate (region => reg_data%regions(i))
	do alr = 1, region%nregions
	if (.not. any &
	(ftuple_equal_ireg (region%ftuples(alr), ftuple_tmp))) then
	j = j + 1
	ftuple_tmp(j) = region%ftuples(alr)
	end if
	end do
	end associate
	end do
	allocate (ftuples (j))
	ftuples = ftuple_tmp(1:j)
	deallocate (ftuple_tmp)
	end subroutine region_data_get_all_ftuples

	@ %def region_data_get_all_ftuples
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: write_to_file => region_data_write_to_file
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_write_to_file &
	(reg_data, proc_id, latex, os_data)
	class(region_data_t), intent(inout) :: reg_data
	type(string_t), intent(in) :: proc_id
	logical, intent(in) :: latex
	type(os_data_t), intent(in) :: os_data
	end subroutine region_data_write_to_file
	<<FKS regions: procedures>>=
	module subroutine region_data_write_to_file &
	(reg_data, proc_id, latex, os_data)
	class(region_data_t), intent(inout) :: reg_data
	type(string_t), intent(in) :: proc_id
	logical, intent(in) :: latex
	type(os_data_t), intent(in) :: os_data
	type(string_t) :: filename
	integer :: u
	integer :: status

	if (latex) then
	filename = proc_id // "_fks_regions.tex"
	else
	filename = proc_id // "_fks_regions.out"
	end if
	u = free_unit ()
	open (u, file=char(filename), action = "write", status="replace")
	if (latex) then
	call reg_data%write_latex (u)
	close (u)
	call os_data%build_latex_file &
	(proc_id // "_fks_regions", stat_out = status)
	if (status /= 0) &
	call msg_error (char ("Failed to compile " // filename))
	else
	call reg_data%write (u)
	close (u)
	end if
	end subroutine region_data_write_to_file

	@ %def region_data_write_to_file
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: write_latex => region_data_write_latex
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_write_latex (reg_data, unit)
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in), optional :: unit
	end subroutine region_data_write_latex
	<<FKS regions: procedures>>=
	module subroutine region_data_write_latex (reg_data, unit)
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in), optional :: unit
	integer :: i, u
	u = given_output_unit (); if (present (unit)) u = unit
	write (u, "(A)") "\documentclass{article}"
	write (u, "(A)") "\begin{document}"
	write (u, "(A)") "%FKS region data, automatically created by WHIZARD"
	write (u, "(A)") "\begin{table}"
	write (u, "(A)") "\begin{center}"
	write (u, "(A)") "\begin{tabular} {\|c\|c\|c\|c\|c\|c\|c\|c\|}"
	write (u, "(A)") "\hline"
	write (u, "(A)") "$\alpha_r$ & $f_r$ & $i_r$ & $\varepsilon$ & " // &
	"$\varsigma$ & $\mathcal{P}_{\rm{FKS}}$ & $i_b$ & $f_b$ \\"
	write (u, "(A)") "\hline"
	do i = 1, reg_data%n_regions
	call reg_data%regions(i)%write_latex (u)
	end do
	write (u, "(A)") "\hline"
	write (u, "(A)") "\end{tabular}"
	write (u, "(A)") "\caption{List of singular regions}"
	write (u, "(A)") "\begin{description}"
	write (u, "(A)") "\item[$\alpha_r$] Index of the singular region"
	write (u, "(A)") "\item[$f_r$] Real flavor structure"
	write (u, "(A)") "\item[$i_r$] Index of the associated real flavor structure"
	write (u, "(A)") "\item[$\varepsilon$] Emitter"
	write (u, "(A)") "\item[$\varsigma$] Multiplicity"
	!!! The symbol used by 0908.4272 for multiplicities
	write (u, "(A)") "\item[$\mathcal{P}_{\rm{FKS}}$] The set of singular FKS-pairs"
	write (u, "(A)") "\item[$i_b$] Underlying Born index"
	write (u, "(A)") "\item[$f_b$] Underlying Born flavor structure"
	write (u, "(A)") "\end{description}"
	write (u, "(A)") "\end{center}"
	write (u, "(A)") "\end{table}"
	write (u, "(A)") "\end{document}"
	end subroutine region_data_write_latex

	@ %def region_data_write_latex
	@ Creates a table with information about all singular regions and
	writes it to a file.
	<<FKS regions: reg data: TBP>>=
	procedure :: write => region_data_write
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_write (reg_data, unit)
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in), optional :: unit
	end subroutine region_data_write
	<<FKS regions: procedures>>=
	module subroutine region_data_write (reg_data, unit)
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in), optional :: unit
	integer :: j
	integer :: maxnregions, i_reg_max
	type(string_t) :: flst_title, ftuple_title
	integer :: n_res, u
	u = given_output_unit (unit); if (u < 0) return
	maxnregions = 1; i_reg_max = 1
	do j = 1, reg_data%n_regions
	if (size (reg_data%regions(j)%ftuples) > maxnregions) then
	maxnregions = reg_data%regions(j)%nregions
	i_reg_max = j
	end if
	end do
	flst_title = '(A' // flst_title_format(reg_data%n_legs_real) // ')'
	ftuple_title = '(A' // ftuple_title_format() // ')'
	write (u,'(A,1X,I4)') 'Total number of regions: ', size(reg_data%regions)
	write (u, '(A4)', advance = 'no') ' alr'
	call write_vline (u)
	write (u, char (flst_title), advance = 'no') 'flst_real'
	call write_vline (u)
	write (u, '(A6)', advance = 'no') 'i_real'
	call write_vline (u)
	write (u, '(A3)', advance = 'no') 'em'
	call write_vline (u)
	write (u, '(A3)', advance = 'no') 'mult'
	call write_vline (u)
	write (u, '(A4)', advance = 'no') 'nreg'
	call write_vline (u)
	if (allocated (reg_data%fks_mapping)) then
	select type (fks_mapping => reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	write (u, '(A3)', advance = 'no') 'res'
	call write_vline (u)
	end select
	end if
	write (u, char (ftuple_title), advance = 'no') 'ftuples'
	call write_vline (u)
	flst_title = '(A' // flst_title_format(reg_data%n_legs_born) // ')'
	write (u, char (flst_title), advance = 'no') 'flst_born'
	call write_vline (u)
	write (u, '(A7)', advance = 'no') 'i_born'
	call write_vline (u)
	write (u, '(A4)') 'corr'
	do j = 1, reg_data%n_regions
	write (u, '(I4)', advance = 'no') j
	call reg_data%regions(j)%write (u, maxnregions)
	end do
	call write_separator (u)
	if (allocated (reg_data%fks_mapping)) then
	select type (fks_mapping => reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	write (u, '(A)')
	write (u, '(A)') &
	"The FKS regions are combined with resonance information: "
	n_res = size (fks_mapping%res_map%res_histories)
	write (u, '(A,1X,I1)') "Number of QCD resonance histories: ", n_res
	do j = 1, n_res
	write (u, '(A,1X,I1)') "i_res = ", j
	call fks_mapping%res_map%res_histories(j)%write (u)
	call write_separator (u)
	end do
	end select
	end if

	contains

	function flst_title_format (n) result (frmt)
	integer, intent(in) :: n
	type(string_t) :: frmt
	character(len=2) :: frmt_char
	write (frmt_char, '(I2)') 4 * n + 1
	frmt = var_str (frmt_char)
	end function flst_title_format

	function ftuple_title_format () result (frmt)
	type(string_t) :: frmt
	integer :: n_ftuple_char
	!!! An ftuple (x,x) consists of five characters. In the string, they
	!!! are separated by maxregions - 1 commas. In total these are
	!!! 5 * maxnregions + maxnregions - 1 = 6 * maxnregions - 1 characters.
	!!! The {} brackets at add two additional characters.
	n_ftuple_char = 6 * maxnregions + 1
	!!! If there are resonances, each ftuple with a resonance adds a ";x"
	!!! to the ftuple
	n_ftuple_char = n_ftuple_char + &
	2 * count (reg_data%regions(i_reg_max)%ftuples%i_res > 0)
	!!! Pseudo-ISR regions are denoted with a * at the end
	n_ftuple_char = n_ftuple_char + &
	count (reg_data%regions(i_reg_max)%ftuples%pseudo_isr)
	frmt = str (n_ftuple_char)
	end function ftuple_title_format

	end subroutine region_data_write

	@ %def region_data_write
	@
	<<FKS regions: procedures>>=
	subroutine write_vline (u)
	integer, intent(in) :: u
	character(len=10), parameter :: sep_format = "(1X,A2,1X)"
	write (u, sep_format, advance = 'no') '\|\|'
	end subroutine write_vline

	@ %def write_vline
	@
	<<FKS regions: public>>=
	public :: assignment(=)
	<<FKS regions: interfaces>>=
	interface assignment(=)
	module procedure region_data_assign
	end interface

	<<FKS regions: sub interfaces>>=
	module subroutine region_data_assign (reg_data_out, reg_data_in)
	type(region_data_t), intent(out) :: reg_data_out
	type(region_data_t), intent(in) :: reg_data_in
	end subroutine region_data_assign
	<<FKS regions: procedures>>=
	module subroutine region_data_assign (reg_data_out, reg_data_in)
	type(region_data_t), intent(out) :: reg_data_out
	type(region_data_t), intent(in) :: reg_data_in
	integer :: i
	if (allocated (reg_data_in%regions)) then
	allocate (reg_data_out%regions (size (reg_data_in%regions)))
	do i = 1, size (reg_data_in%regions)
	reg_data_out%regions(i) = reg_data_in%regions(i)
	end do
	else
	call msg_warning &
	("Copying region data without allocated singular regions!")
	end if
	if (allocated (reg_data_in%flv_born)) then
	allocate (reg_data_out%flv_born (size (reg_data_in%flv_born)))
	do i = 1, size (reg_data_in%flv_born)
	reg_data_out%flv_born(i) = reg_data_in%flv_born(i)
	end do
	else
	call msg_warning &
	("Copying region data without allocated born flavor structure!")
	end if
	if (allocated (reg_data_in%flv_real)) then
	allocate (reg_data_out%flv_real (size (reg_data_in%flv_real)))
	do i = 1, size (reg_data_in%flv_real)
	reg_data_out%flv_real(i) = reg_data_in%flv_real(i)
	end do
	else
	call msg_warning ("Copying region data without allocated real flavor structure!")
	end if
	if (allocated (reg_data_in%emitters)) then
	allocate (reg_data_out%emitters (size (reg_data_in%emitters)))
	do i = 1, size (reg_data_in%emitters)
	reg_data_out%emitters(i) = reg_data_in%emitters(i)
	end do
	else
	call msg_warning ("Copying region data without allocated emitters!")
	end if
	reg_data_out%n_regions = reg_data_in%n_regions
	reg_data_out%n_emitters = reg_data_in%n_emitters
	reg_data_out%n_flv_born = reg_data_in%n_flv_born
	reg_data_out%n_flv_real = reg_data_in%n_flv_real
	reg_data_out%n_in = reg_data_in%n_in
	reg_data_out%n_legs_born = reg_data_in%n_legs_born
	reg_data_out%n_legs_real = reg_data_in%n_legs_real
	if (allocated (reg_data_in%fks_mapping)) then
	select type (fks_mapping_in => reg_data_in%fks_mapping)
	type is (fks_mapping_default_t)
	allocate (fks_mapping_default_t :: reg_data_out%fks_mapping)
	select type (fks_mapping_out => reg_data_out%fks_mapping)
	type is (fks_mapping_default_t)
	fks_mapping_out = fks_mapping_in
	end select
	type is (fks_mapping_resonances_t)
	allocate (fks_mapping_resonances_t :: reg_data_out%fks_mapping)
	select type (fks_mapping_out => reg_data_out%fks_mapping)
	type is (fks_mapping_resonances_t)
	fks_mapping_out = fks_mapping_in
	end select
	end select
	else
	call msg_warning ("Copying region data without allocated FKS regions!")
	end if
	if (allocated (reg_data_in%resonances)) then
	allocate (reg_data_out%resonances (size (reg_data_in%resonances)))
	reg_data_out%resonances = reg_data_in%resonances
	end if
	reg_data_out%n_phs = reg_data_in%n_phs
	if (allocated (reg_data_in%alr_contributors)) then
	allocate (reg_data_out%alr_contributors (size (reg_data_in%alr_contributors)))
	reg_data_out%alr_contributors = reg_data_in%alr_contributors
	end if
	if (allocated (reg_data_in%alr_to_i_contributor)) then
	allocate (reg_data_out%alr_to_i_contributor &
	(size (reg_data_in%alr_to_i_contributor)))
	reg_data_out%alr_to_i_contributor = reg_data_in%alr_to_i_contributor
	end if
	end subroutine region_data_assign

	@ %def region_data_assign
	@ Returns the index of the real flavor structure an ftuple belogs to.
	<<FKS regions: procedures>>=
	function region_to_real_index (list, i) result(index)
	type(ftuple_list_t), intent(in), dimension(:), allocatable :: list
	integer, intent(in) :: i
	integer, dimension(:), allocatable :: nreg
	integer :: index, j
	allocate (nreg (0))
	index = 0
	do j = 1, size (list)
	nreg = [nreg, sum (list(:j)%get_n_tuples ())]
	if (j == 1) then
	if (i <= nreg(j)) then
	index = j
	exit
	end if
	else
	if (i > nreg(j - 1) .and. i <= nreg(j)) then
	index = j
	exit
	end if
	end if
	end do
	end function region_to_real_index

	@ %def region_to_real_index
	@ Final state emission: Rearrange the flavor array in such a way that
	the emitted particle is last and the emitter is second last. [[i1]] is
	the index of the emitter, [[i2]] is the index of the emitted particle.

	Initial state emission: Just put the emitted particle to the last
	position.
	<<FKS regions: procedures>>=
	function create_alr (flv1, n_in, i_em, i_rad) result(flv2)
	type(flv_structure_t), intent(in) :: flv1
	integer, intent(in) :: n_in
	integer, intent(in) :: i_em, i_rad
	type(flv_structure_t) :: flv2
	integer :: n
	n = size (flv1%flst)
	allocate (flv2%flst (n), flv2%tag (n))
	flv2%nlegs = n
	flv2%n_in = n_in
	if (i_em > n_in) then
	flv2%flst(1 : n_in) = flv1%flst(1 : n_in)
	flv2%flst(n - 1) = flv1%flst(i_em)
	flv2%flst(n) = flv1%flst(i_rad)
	flv2%tag(1 : n_in) = flv1%tag(1 : n_in)
	flv2%tag(n - 1) = flv1%tag(i_em)
	flv2%tag(n) = flv1%tag(i_rad)
	call fill_remaining_flavors (n_in, .true.)
	else
	flv2%flst(1 : n_in) = flv1%flst(1 : n_in)
	flv2%flst(n) = flv1%flst(i_rad)
	flv2%tag(1 : n_in) = flv1%tag(1 : n_in)
	flv2%tag(n) = flv1%tag(i_rad)
	call fill_remaining_flavors (n_in, .false.)
	end if
	call flv2%compute_prt_symm_fs (flv2%n_in)
	contains
	@ Order remaining particles according to their original position
	<<FKS regions: procedures>>=
	subroutine fill_remaining_flavors (n_in, final_final)
	integer, intent(in) :: n_in
	logical, intent(in) :: final_final
	integer :: i, j
	logical :: check
	j = n_in + 1
	do i = n_in + 1, n
	if (final_final) then
	check = (i /= i_em .and. i /= i_rad)
	else
	check = (i /= i_rad)
	end if
	if (check) then
	flv2%flst(j) = flv1%flst(i)
	flv2%tag(j) = flv1%tag(i)
	j = j + 1
	end if
	end do
	end subroutine fill_remaining_flavors
	end function create_alr

	@ %def create_alr
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: has_pseudo_isr => region_data_has_pseudo_isr
	<<FKS regions: sub interfaces>>=
	module function region_data_has_pseudo_isr (reg_data) result (flag)
	logical :: flag
	class(region_data_t), intent(in) :: reg_data
	end function region_data_has_pseudo_isr
	<<FKS regions: procedures>>=
	module function region_data_has_pseudo_isr (reg_data) result (flag)
	logical :: flag
	class(region_data_t), intent(in) :: reg_data
	flag = any (reg_data%regions%pseudo_isr)
	end function region_data_has_pseudo_isr

	@ %def region_data_has_pseudo_isr
	@ Performs consistency checks on [[region_data]]. Up to now only
	checks that no [[ftuple]] appears more than once.
	<<FKS regions: reg data: TBP>>=
	procedure :: check_consistency => region_data_check_consistency
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_check_consistency (reg_data, fail_fatal, unit)
	class(region_data_t), intent(in) :: reg_data
	logical, intent(in) :: fail_fatal
	integer, intent(in), optional :: unit
	end subroutine region_data_check_consistency
	<<FKS regions: procedures>>=
	module subroutine region_data_check_consistency (reg_data, fail_fatal, unit)
	class(region_data_t), intent(in) :: reg_data
	logical, intent(in) :: fail_fatal
	integer, intent(in), optional :: unit
	integer :: u
	integer :: i_reg, alr
	integer :: i1, f1, f2
	logical :: undefined_ftuples, same_ftuple_indices, valid_splitting
	logical, dimension(4) :: no_fail
	u = given_output_unit(unit); if (u < 0) return
	no_fail = .true.
	call msg_message ("Check that no negative ftuple indices occur", unit = u)
	do i_reg = 1, reg_data%n_regions
	if (any (reg_data%regions(i_reg)%ftuples%has_negative_elements ())) then
	!!! This error is so severe that we stop immediately
	call msg_fatal ("Negative ftuple indices!")
	end if
	end do
	call msg_message ("Success!", unit = u)
	call msg_message ("Check that there is no ftuple with identical elements", unit = u)
	do i_reg = 1, reg_data%n_regions
	if (any (reg_data%regions(i_reg)%ftuples%has_identical_elements ())) then
	!!! This error is so severe that we stop immediately
	call msg_fatal ("Identical ftuple indices!")
	end if
	end do
	call msg_message ("Success!", unit = u)
	call msg_message ("Check that there are no duplicate ftuples in a region", unit = u)
	do i_reg = 1, reg_data%n_regions
	if (reg_data%regions(i_reg)%has_identical_ftuples ()) then
	if (no_fail(1)) then
	call msg_error ("FAIL: ", unit = u)
	no_fail(1) = .false.
	end if
	write (u, '(A,1x,I3)') 'i_reg:', i_reg
	end if
	end do
	if (no_fail(1)) call msg_message ("Success!", unit = u)
	call msg_message ("Check that ftuples add up to a valid splitting", unit = u)
	do i_reg = 1, reg_data%n_regions
	do alr = 1, reg_data%regions(i_reg)%nregions
	associate (region => reg_data%regions(i_reg))
	i1 = region%ftuples(alr)%ireg(1)
	if (i1 == 0) i1 = 1 !!! Gluon emission from both initial-state particles
	f1 = region%flst_real%flst(i1)
	f2 = region%flst_real%flst(region%ftuples(alr)%ireg(2))
	! Flip PDG sign of IS fermions to allow a q -> g q splitting
	! in which the ftuple has the flavors (q,q).
	if (i1 <= reg_data%n_in .and. is_fermion(f1)) then
	f1 = -f1
	end if
	valid_splitting = f1 + f2 == 0 &
	.or. (is_gluon(f1) .and. is_gluon(f2)) &
	.or. (is_massive_vector(f1) .and. is_photon(f2)) &
	.or. is_fermion_vector_splitting (f1, f2)
	if (.not. valid_splitting) then
	if (no_fail(2)) then
	call msg_error ("FAIL: ", unit = u)
	no_fail(2) = .false.
	end if
	write (u, '(A,1x,I3)') 'i_reg:', i_reg
	exit
	end if
	end associate
	end do
	end do
	if (no_fail(2)) call msg_message ("Success!", unit = u)
	call msg_message ("Check that at least one ftuple contains the emitter", unit = u)
	do i_reg = 1, reg_data%n_regions
	associate (region => reg_data%regions(i_reg))
	if (.not. any (region%emitter == region%ftuples%ireg(1))) then
	if (no_fail(3)) then
	call msg_error ("FAIL: ", unit = u)
	no_fail(3) = .false.
	end if
	write (u, '(A,1x,I3)') 'i_reg:', i_reg
	end if
	end associate
	end do
	if (no_fail(3)) call msg_message ("Success!", unit = u)
	call msg_message ("Check that each region has at least one ftuple &
	&with index n + 1", unit = u)
	do i_reg = 1, reg_data%n_regions
	if (.not. any (reg_data%regions(i_reg)%ftuples%ireg(2) == reg_data%n_legs_real)) then
	if (no_fail(4)) then
	call msg_error ("FAIL: ", unit = u)
	no_fail(4) = .false.
	end if
	write (u, '(A,1x,I3)') 'i_reg:', i_reg
	end if
	end do
	if (no_fail(4)) call msg_message ("Success!", unit = u)
	if (.not. all (no_fail)) &
	call abort_with_message ("Stop due to inconsistent region data!")

	contains
	subroutine abort_with_message (msg)
	character(len=*), intent(in) :: msg
	if (fail_fatal) then
	call msg_fatal (msg)
	else
	call msg_error (msg, unit = u)
	end if
	end subroutine abort_with_message

	function is_fermion_vector_splitting (pdg_1, pdg_2) result (value)
	logical :: value
	integer, intent(in) :: pdg_1, pdg_2
	value = (is_fermion (pdg_1) .and. is_massless_vector (pdg_2)) .or. &
	(is_fermion (pdg_2) .and. is_massless_vector (pdg_1))
	end function
	end subroutine region_data_check_consistency

	@ %def region_data_check_consistency
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: requires_spin_correlations => &
	region_data_requires_spin_correlations
	<<FKS regions: sub interfaces>>=
	module function region_data_requires_spin_correlations &
	(reg_data) result (flag)
	class(region_data_t), intent(in) :: reg_data
	logical :: flag
	end function region_data_requires_spin_correlations
	<<FKS regions: procedures>>=
	module function region_data_requires_spin_correlations &
	(reg_data) result (flag)
	class(region_data_t), intent(in) :: reg_data
	logical :: flag
	integer :: alr
	flag = .false.
	do alr = 1, reg_data%n_regions
	flag = reg_data%regions(alr)%sc_required
	if (flag) return
	end do
	end function region_data_requires_spin_correlations

	@ %def region_data_requires_spin_correlations
	@ We have to apply the symmetry factor for identical particles of the
	real flavor structure to the born squared matrix element. The corresponding
	factor from the born flavor structure has to be cancelled.
	<<FKS regions: reg data: TBP>>=
	procedure :: born_to_real_symm_factor_fs => &
	region_data_born_to_real_symm_factor_fs
	<<FKS regions: sub interfaces>>=
	module function region_data_born_to_real_symm_factor_fs &
	(reg_data, alr) result (factor)
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: alr
	real(default) :: factor
	end function region_data_born_to_real_symm_factor_fs
	<<FKS regions: procedures>>=
	module function region_data_born_to_real_symm_factor_fs &
	(reg_data, alr) result (factor)
	class(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: alr
	real(default) :: factor
	associate (flv_real => reg_data%regions(alr)%flst_real, &
	flv_uborn => reg_data%regions(alr)%flst_uborn)
	factor = flv_real%prt_symm_fs / flv_uborn%prt_symm_fs
	end associate
	end function region_data_born_to_real_symm_factor_fs

	@ %def region_data_born_to_real_symm_factor_fs
	@
	<<FKS regions: reg data: TBP>>=
	procedure :: final => region_data_final
	<<FKS regions: sub interfaces>>=
	module subroutine region_data_final (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	end subroutine region_data_final
	<<FKS regions: procedures>>=
	module subroutine region_data_final (reg_data)
	class(region_data_t), intent(inout) :: reg_data
	if (allocated (reg_data%regions)) deallocate (reg_data%regions)
	if (allocated (reg_data%flv_born)) deallocate (reg_data%flv_born)
	if (allocated (reg_data%flv_real)) deallocate (reg_data%flv_real)
	if (allocated (reg_data%emitters)) deallocate (reg_data%emitters)
	if (allocated (reg_data%fks_mapping)) deallocate (reg_data%fks_mapping)
	if (allocated (reg_data%resonances)) deallocate (reg_data%resonances)
	if (allocated (reg_data%alr_contributors)) &
	deallocate (reg_data%alr_contributors)
	if (allocated (reg_data%alr_to_i_contributor)) &
	deallocate (reg_data%alr_to_i_contributor)
	end subroutine region_data_final

	@ %def region_data_final
	@
	<<FKS regions: fks mapping: TBP>>=
	procedure (fks_mapping_dij), deferred :: dij
	<<FKS regions: interfaces>>=
	abstract interface
	function fks_mapping_dij (map, p, i, j, i_con) result (d)
	import
	real(default) :: d
	class(fks_mapping_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: i, j
	integer, intent(in), optional :: i_con
	end function fks_mapping_dij
	end interface

	@ %def fks_mapping_dij
	@
	<<FKS regions: fks mapping: TBP>>=
	procedure (fks_mapping_compute_sumdij), deferred :: compute_sumdij
	<<FKS regions: interfaces>>=
	abstract interface
	subroutine fks_mapping_compute_sumdij (map, sregion, p_real)
	import
	class(fks_mapping_t), intent(inout) :: map
	type(singular_region_t), intent(in) :: sregion
	type(vector4_t), intent(in), dimension(:) :: p_real
	end subroutine fks_mapping_compute_sumdij
	end interface

	@ %def fks_mapping_compute_sumdij
	@
	<<FKS regions: fks mapping: TBP>>=
	procedure (fks_mapping_svalue), deferred :: svalue
	<<FKS regions: interfaces>>=
	abstract interface
	function fks_mapping_svalue (map, p, i, j, i_res) result (value)
	import
	real(default) :: value
	class(fks_mapping_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: i, j
	integer, intent(in), optional :: i_res
	end function fks_mapping_svalue
	end interface

	@ %def fks_mapping_svalue
	<<FKS regions: fks mapping: TBP>>=
	procedure (fks_mapping_dij_soft), deferred :: dij_soft
	<<FKS regions: interfaces>>=
	abstract interface
	function fks_mapping_dij_soft (map, p_born, p_soft, em, i_con) result (d)
	import
	real(default) :: d
	class(fks_mapping_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	integer, intent(in) :: em
	integer, intent(in), optional :: i_con
	end function fks_mapping_dij_soft
	end interface

	@ %def fks_mapping_dij_soft
	@
	<<FKS regions: fks mapping: TBP>>=
	procedure (fks_mapping_compute_sumdij_soft), deferred :: compute_sumdij_soft
	<<FKS regions: interfaces>>=
	abstract interface
	subroutine fks_mapping_compute_sumdij_soft (map, sregion, p_born, p_soft)
	import
	class(fks_mapping_t), intent(inout) :: map
	type(singular_region_t), intent(in) :: sregion
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	end subroutine fks_mapping_compute_sumdij_soft
	end interface
	@ %def fks_mapping_compute_sumdij_soft
	@
	<<FKS regions: fks mapping: TBP>>=
	procedure (fks_mapping_svalue_soft), deferred :: svalue_soft
	<<FKS regions: interfaces>>=
	abstract interface
	function fks_mapping_svalue_soft (map, p_born, p_soft, em, i_res) result (value)
	import
	real(default) :: value
	class(fks_mapping_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	integer, intent(in) :: em
	integer, intent(in), optional :: i_res
	end function fks_mapping_svalue_soft
	end interface

	@ %def fks_mapping_svalue_soft
	@
	<<FKS regions: fks mapping default: TBP>>=
	procedure :: set_parameter => fks_mapping_default_set_parameter
	<<FKS regions: sub interfaces>>=
	module subroutine fks_mapping_default_set_parameter &
	(map, n_in, dij_exp1, dij_exp2)
	class(fks_mapping_default_t), intent(inout) :: map
	integer, intent(in) :: n_in
	real(default), intent(in) :: dij_exp1, dij_exp2
	end subroutine fks_mapping_default_set_parameter
	<<FKS regions: procedures>>=
	module subroutine fks_mapping_default_set_parameter &
	(map, n_in, dij_exp1, dij_exp2)
	class(fks_mapping_default_t), intent(inout) :: map
	integer, intent(in) :: n_in
	real(default), intent(in) :: dij_exp1, dij_exp2
	map%n_in = n_in
	map%exp_1 = dij_exp1
	map%exp_2 = dij_exp2
	end subroutine fks_mapping_default_set_parameter

	@ %def fks_mapping_default_set_parameter
	@ Computes the $d_{ij}$-quantities defined als follows:
	\begin{align*}
	d_{0i} &= \left[E_i^2\left(1-y_i\right)\right]^{p_2}\\,
	d_{1i} &= \left[2E_i^2\left(1-y_i\right)\right]^{p_2}\\,
	d_{2i} &= \left[2E_i^2\left(1+y_i\right)\right]^{p_2}\\,
	\end{align*}
	for initial state regions and
	\begin{align*}
	d_{ij} = \left[2(k_i \cdot k_j) \frac{E_i E_j}{(E_i+E_j)^2}\right]^{p_1}
	\end{align*}
	for final state regions, c.f. [1002.2581, Eq. 4.23f].
	The exponents $p_1$ and $p_2$ can be used for
	tuning the efficiency of the mapping and are set to $1$ per default.
	<<FKS regions: fks mapping default: TBP>>=
	procedure :: dij => fks_mapping_default_dij
	<<FKS regions: sub interfaces>>=
	module function fks_mapping_default_dij (map, p, i, j, i_con) result (d)
	real(default) :: d
	class(fks_mapping_default_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: i, j
	integer, intent(in), optional :: i_con
	end function fks_mapping_default_dij
	<<FKS regions: procedures>>=
	module function fks_mapping_default_dij (map, p, i, j, i_con) result (d)
	real(default) :: d
	class(fks_mapping_default_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: i, j
	integer, intent(in), optional :: i_con
	d = zero
	if (map%pseudo_isr) then
	d = dij_threshold_gluon_from_top (i, j, p, map%exp_1)
	else if (i > map%n_in .and. j > map%n_in) then
	d = dij_fsr (p(i), p(j), map%exp_1)
	else
	d = dij_isr (map%n_in, i, j, p, map%exp_2)
	end if
	contains

	function dij_fsr (p1, p2, expo) result (d_ij)
	real(default) :: d_ij
	type(vector4_t), intent(in) :: p1, p2
	real(default), intent(in) :: expo
	real(default) :: E1, E2
	E1 = p1%p(0); E2 = p2%p(0)
	d_ij = (two * p1 * p2 * E1 * E2 / (E1 + E2)2)expo
	end function dij_fsr

	function dij_threshold_gluon_from_top (i, j, p, expo) result (d_ij)
	real(default) :: d_ij
	integer, intent(in) :: i, j
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: expo
	type(vector4_t) :: p_top
	if (i == THR_POS_B) then
	p_top = p(THR_POS_WP) + p(THR_POS_B)
	else
	p_top = p(THR_POS_WM) + p(THR_POS_BBAR)
	end if
	d_ij = dij_fsr (p_top, p(j), expo)
	end function dij_threshold_gluon_from_top

	function dij_isr (n_in, i, j, p, expo) result (d_ij)
	real(default) :: d_ij
	integer, intent(in) :: n_in, i, j
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in) :: expo
	real(default) :: E, y
	select case (n_in)
	case (1)
	call get_emitter_variables (1, i, j, p, E, y)
	d_ij = (E*2 (one - y2))expo
	case (2)
	if ((i == 0 .and. j > 2) .or. (j == 0 .and. i > 2)) then
	call get_emitter_variables (0, i, j, p, E, y)
	d_ij = (E*2 (one - y2))expo
	else if ((i == 1 .and. j > 2) .or. (j == 1 .and. i > 2)) then
	call get_emitter_variables (1, i, j, p, E, y)
	d_ij = (two * E*2 (one - y))**expo
	else if ((i == 2 .and. j > 2) .or. (j == 2 .and. i > 2)) then
	call get_emitter_variables (2, i, j, p, E, y)
	d_ij = (two * E*2 (one + y))**expo
	end if
	end select
	end function dij_isr

	subroutine get_emitter_variables (i_check, i, j, p, E, y)
	integer, intent(in) :: i_check, i, j
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(out) :: E, y
	if (j == i_check) then
	E = energy (p(i))
	y = polar_angle_ct (p(i))
	else
	E = energy (p(j))
	y = polar_angle_ct(p(j))
	end if
	end subroutine get_emitter_variables

	end function fks_mapping_default_dij

	@ %def fks_mapping_default_dij
	@ Computes the quantity
	\begin{equation*}
	\mathcal{D} = \sum_k \frac{1}{d_{0k}} + \sum_{kl} \frac{1}{d_{kl}}.
	\end{equation*}
	where the sum goes over all ftuples of a single singular region.
	<<FKS regions: fks mapping default: TBP>>=
	procedure :: compute_sumdij => fks_mapping_default_compute_sumdij
	<<FKS regions: sub interfaces>>=
	module subroutine fks_mapping_default_compute_sumdij (map, sregion, p_real)
	class(fks_mapping_default_t), intent(inout) :: map
	type(singular_region_t), intent(in) :: sregion
	type(vector4_t), intent(in), dimension(:) :: p_real
	end subroutine fks_mapping_default_compute_sumdij
	<<FKS regions: procedures>>=
	module subroutine fks_mapping_default_compute_sumdij (map, sregion, p_real)
	class(fks_mapping_default_t), intent(inout) :: map
	type(singular_region_t), intent(in) :: sregion
	type(vector4_t), intent(in), dimension(:) :: p_real
	real(default) :: d
	integer :: i_ftuple, i, j

	associate (ftuples => sregion%ftuples)
	d = zero
	do i_ftuple = 1, sregion%nregions
	call ftuples(i_ftuple)%get (i, j)
	map%pseudo_isr = ftuples(i_ftuple)%pseudo_isr
	d = d + one / map%dij (p_real, i, j)
	end do
	end associate
	map%sumdij = d
	end subroutine fks_mapping_default_compute_sumdij

	@ %def fks_mapping_default_compute_sumdij
	@ Computes
	\begin{equation*}
	S_i = \frac{1}{\mathcal{D} d_{0i}}
	\end{equation*}
	or
	\begin{equation*}
	S_{ij} = \frac{1}{\mathcal{D} d_{ij}},
	\end{equation*}
	respectively.
	<<FKS regions: fks mapping default: TBP>>=
	procedure :: svalue => fks_mapping_default_svalue
	<<FKS regions: sub interfaces>>=
	module function fks_mapping_default_svalue &
	(map, p, i, j, i_res) result (value)
	real(default) :: value
	class(fks_mapping_default_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: i, j
	integer, intent(in), optional :: i_res
	end function fks_mapping_default_svalue
	<<FKS regions: procedures>>=
	module function fks_mapping_default_svalue &
	(map, p, i, j, i_res) result (value)
	real(default) :: value
	class(fks_mapping_default_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: i, j
	integer, intent(in), optional :: i_res
	value = one / (map%dij (p, i, j) * map%sumdij)
	end function fks_mapping_default_svalue

	@ %def fks_mapping_default_svalue
	@ In the soft limit, our treatment of the divergencies requires a
	modification of the mapping functions. Recall that there, the ratios of
	the $d$-functions must approach either $1$ or $0$. This means
	\begin{equation*}
	\frac{d_{lm}}{d_{0m}} = \frac{(2k_l \cdot k_m) \left[E_lE_m /(E_l +
	E_m)^2\right]}{E_m^2 (1-y^2)}
	\overset {k_m = E_m \hat{k}} {=} \frac{E_l E_m^2}{(E_l + E_m)^2}
	\frac{2k_l \cdot \hat{k}}{E_m^2 (1-y^2)}
	\overset {E_m \to 0}{=} \frac{2k_l \cdot \hat{k}}{E_l}{(1-y^2)},
	\end{equation*}
	where we have written the gluon momentum in terms of the soft momentum
	$\hat{k}$. In the same limit
	\begin{equation*}
	\frac{d_{lm}}{d_{nm}} = \frac{k_l \cdot \hat{k}}{k_n \cdot \hat{k}}
	\frac{E_n}{E_l}.
	\end{equation*}
	From these equations we can deduce the soft limit of $d$:
	\begin{align*}
	d_0^{\rm{soft}} &= 1 - y^2,\\
	d_1^{\rm{soft}} &= 2(1-y),\\
	d_2^{\rm{soft}} &= 2(1+y),\\
	d_i^{\rm{soft}} &= \frac{2 k_i \cdot \hat{k}}{E_i}.
	\end{align*}
	<<FKS regions: fks mapping default: TBP>>=
	procedure :: dij_soft => fks_mapping_default_dij_soft
	<<FKS regions: sub interfaces>>=
	module function fks_mapping_default_dij_soft &
	(map, p_born, p_soft, em, i_con) result (d)
	real(default) :: d
	class(fks_mapping_default_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	integer, intent(in) :: em
	integer, intent(in), optional :: i_con
	end function fks_mapping_default_dij_soft
	<<FKS regions: procedures>>=
	module function fks_mapping_default_dij_soft &
	(map, p_born, p_soft, em, i_con) result (d)
	real(default) :: d
	class(fks_mapping_default_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	integer, intent(in) :: em
	integer, intent(in), optional :: i_con
	if (map%pseudo_isr) then
	d = dij_soft_threshold_gluon_from_top (em, p_born, p_soft, map%exp_1)
	else if (em <= map%n_in) then
	d = dij_soft_isr (map%n_in, p_soft, map%exp_2)
	else
	d = dij_soft_fsr (p_born(em), p_soft, map%exp_1)
	end if
	contains

	function dij_soft_threshold_gluon_from_top &
	(em, p_born, p_soft, expo) result (dij_soft)
	real(default) :: dij_soft
	integer, intent(in) :: em
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	real(default), intent(in) :: expo
	type(vector4_t) :: p_top
	if (em == THR_POS_B) then
	p_top = p_born(THR_POS_WP) + p_born(THR_POS_B)
	else
	p_top = p_born(THR_POS_WM) + p_born(THR_POS_BBAR)
	end if
	dij_soft = dij_soft_fsr (p_top, p_soft, expo)
	end function dij_soft_threshold_gluon_from_top

	function dij_soft_fsr (p_em, p_soft, expo) result (dij_soft)
	real(default) :: dij_soft
	type(vector4_t), intent(in) :: p_em, p_soft
	real(default), intent(in) :: expo
	dij_soft = (two * p_em * p_soft / p_em%p(0))**expo
	end function dij_soft_fsr

	function dij_soft_isr (n_in, p_soft, expo) result (dij_soft)
	real(default) :: dij_soft
	integer, intent(in) :: n_in
	type(vector4_t), intent(in) :: p_soft
	real(default), intent(in) :: expo
	real(default) :: y
	y = polar_angle_ct (p_soft)
	select case (n_in)
	case (1)
	dij_soft = one - y**2
	case (2)
	select case (em)
	case (0)
	dij_soft = one - y**2
	case (1)
	dij_soft = two * (one - y)
	case (2)
	dij_soft = two * (one + y)
	case default
	dij_soft = zero
	call msg_fatal ("fks_mappings_default_dij_soft: n_in > 2")
	end select
	case default
	dij_soft = zero
	call msg_fatal ("fks_mappings_default_dij_soft: n_in > 2")
	end select
	dij_soft = dij_soft**expo
	end function dij_soft_isr
	end function fks_mapping_default_dij_soft

	@ %def fks_mapping_default_dij_soft
	@ Computes the sum of all soft [[dij]]s required to normalize the soft
	$S$ functions [[s_alpha_soft]] similar to
	[[fks_mapping_default_compute_sumdij]]. In the soft limit however, we
	need to skip all ftuples $(i,j)$ in which $j$ does not correspond to
	the emitted particle because those $d_{ij}$s are finite and thus their
	contribution to the soft S function vanishes in the limit of soft
	radiation. Technically, they would not vanish if computed here because
	the fixed [[p_soft]] at this point would not fit their actual
	emitter.
	<<FKS regions: fks mapping default: TBP>>=
	procedure :: compute_sumdij_soft => fks_mapping_default_compute_sumdij_soft
	<<FKS regions: sub interfaces>>=
	module subroutine fks_mapping_default_compute_sumdij_soft &
	(map, sregion, p_born, p_soft)
	class(fks_mapping_default_t), intent(inout) :: map
	type(singular_region_t), intent(in) :: sregion
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	end subroutine fks_mapping_default_compute_sumdij_soft
	<<FKS regions: procedures>>=
	module subroutine fks_mapping_default_compute_sumdij_soft &
	(map, sregion, p_born, p_soft)
	class(fks_mapping_default_t), intent(inout) :: map
	type(singular_region_t), intent(in) :: sregion
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	real(default) :: d
	integer :: i_ftuple, i, j
	integer :: nlegs
	d = zero
	nlegs = size (sregion%flst_real%flst)
	associate (ftuples => sregion%ftuples)
	do i_ftuple = 1, sregion%nregions
	call ftuples(i_ftuple)%get (i ,j)
	if (j == nlegs) then
	map%pseudo_isr = ftuples(i_ftuple)%pseudo_isr
	d = d + one / map%dij_soft (p_born, p_soft, i)
	end if
	end do
	end associate
	map%sumdij_soft = d
	end subroutine fks_mapping_default_compute_sumdij_soft

	@ %def fks_mapping_default_compute_sumdij_soft
	@
	<<FKS regions: fks mapping default: TBP>>=
	procedure :: svalue_soft => fks_mapping_default_svalue_soft
	<<FKS regions: sub interfaces>>=
	module function fks_mapping_default_svalue_soft &
	(map, p_born, p_soft, em, i_res) result (value)
	real(default) :: value
	class(fks_mapping_default_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	integer, intent(in) :: em
	integer, intent(in), optional :: i_res
	end function fks_mapping_default_svalue_soft
	<<FKS regions: procedures>>=
	module function fks_mapping_default_svalue_soft &
	(map, p_born, p_soft, em, i_res) result (value)
	real(default) :: value
	class(fks_mapping_default_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	integer, intent(in) :: em
	integer, intent(in), optional :: i_res
	value = one / (map%sumdij_soft * map%dij_soft (p_born, p_soft, em))
	end function fks_mapping_default_svalue_soft

	@ %def fks_mapping_default_svalue_soft
	@
	<<FKS regions: interfaces>>=
	interface assignment(=)
	module procedure fks_mapping_default_assign
	end interface

	<<FKS regions: sub interfaces>>=
	module subroutine fks_mapping_default_assign (fks_map_out, fks_map_in)
	type(fks_mapping_default_t), intent(out) :: fks_map_out
	type(fks_mapping_default_t), intent(in) :: fks_map_in
	end subroutine fks_mapping_default_assign
	<<FKS regions: procedures>>=
	module subroutine fks_mapping_default_assign (fks_map_out, fks_map_in)
	type(fks_mapping_default_t), intent(out) :: fks_map_out
	type(fks_mapping_default_t), intent(in) :: fks_map_in
	fks_map_out%exp_1 = fks_map_in%exp_1
	fks_map_out%exp_2 = fks_map_in%exp_2
	fks_map_out%n_in = fks_map_in%n_in
	end subroutine fks_mapping_default_assign

	@ %def fks_mapping_default_assign
	@ The $d_{ij,k}$-functions for the resonance mapping are basically the same
	as in the default case, but the kinematical values here must be evaluated
	in the resonance frame of reference. The energy of parton $i$ in a given
	resonance frame with momentum $p_{res}$ is
	\begin{equation*}
	E_i = \frac{p_i^0 \cdot p_{res}}{m_{res}}.
	\end{equation*}
	However, since the expressions only depend on ratios of four-momenta, we
	leave out the denominator because it will cancel out anyway.
	<<FKS regions: fks mapping resonances: TBP>>=
	procedure :: dij => fks_mapping_resonances_dij
	<<FKS regions: sub interfaces>>=
	module function fks_mapping_resonances_dij (map, p, i, j, i_con) result (d)
	real(default) :: d
	class(fks_mapping_resonances_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: i, j
	integer, intent(in), optional :: i_con
	end function fks_mapping_resonances_dij
	<<FKS regions: procedures>>=
	module function fks_mapping_resonances_dij (map, p, i, j, i_con) result (d)
	real(default) :: d
	class(fks_mapping_resonances_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: i, j
	integer, intent(in), optional :: i_con
	real(default) :: E1, E2
	integer :: ii_con
	if (present (i_con)) then
	ii_con = i_con
	else
	call msg_fatal ("Resonance mappings require resonance index as input!")
	end if
	d = 0
	if (i /= j) then
	if (i > 2 .and. j > 2) then
	associate (p_res => map%res_map%p_res (ii_con))
	E1 = p(i) * p_res
	E2 = p(j) * p_res
	d = two * p(i) * p(j) * E1 * E2 / (E1 + E2)**2
	end associate
	else
	call msg_fatal ("Resonance mappings are not implemented for ISR")
	end if
	end if
	end function fks_mapping_resonances_dij

	@ %def fks_mapping_resonances_dij
	@ Computes
	\begin{equation*}
	S_\alpha = \frac{P^{f_r(\alpha)}d^{-1}(\alpha)}
	{\sum_{f_r' \in T(F_r(\alpha))}P^{f_r'}\sum_{\alpha' \in Sr(f_r')}d^{-1}(\alpha)}.
	\end{equation*}
	<<FKS regions: fks mapping resonances: TBP>>=
	procedure :: compute_sumdij => fks_mapping_resonances_compute_sumdij
	<<FKS regions: sub interfaces>>=
	module subroutine fks_mapping_resonances_compute_sumdij &
	(map, sregion, p_real)
	class(fks_mapping_resonances_t), intent(inout) :: map
	type(singular_region_t), intent(in) :: sregion
	type(vector4_t), intent(in), dimension(:) :: p_real
	end subroutine fks_mapping_resonances_compute_sumdij
	<<FKS regions: procedures>>=
	module subroutine fks_mapping_resonances_compute_sumdij (map, sregion, p_real)
	class(fks_mapping_resonances_t), intent(inout) :: map
	type(singular_region_t), intent(in) :: sregion
	type(vector4_t), intent(in), dimension(:) :: p_real
	real(default) :: d, pfr
	integer :: i_res, i_reg, i, j, i_con
	integer :: nlegreal

	nlegreal = size (p_real)
	d = zero
	do i_reg = 1, sregion%nregions
	associate (ftuple => sregion%ftuples(i_reg))
	call ftuple%get (i, j)
	i_res = ftuple%i_res
	end associate
	pfr = map%res_map%get_resonance_value (i_res, p_real, nlegreal)
	i_con = sregion%i_reg_to_i_con (i_reg)
	d = d + pfr / map%dij (p_real, i, j, i_con)
	end do
	map%sumdij = d
	end subroutine fks_mapping_resonances_compute_sumdij

	@ %def fks_mapping_resonances_compute_sumdij
	@
	<<FKS regions: fks mapping resonances: TBP>>=
	procedure :: svalue => fks_mapping_resonances_svalue
	<<FKS regions: sub interfaces>>=
	module function fks_mapping_resonances_svalue &
	(map, p, i, j, i_res) result (value)
	real(default) :: value
	class(fks_mapping_resonances_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: i, j
	integer, intent(in), optional :: i_res
	end function fks_mapping_resonances_svalue
	<<FKS regions: procedures>>=
	module function fks_mapping_resonances_svalue &
	(map, p, i, j, i_res) result (value)
	real(default) :: value
	class(fks_mapping_resonances_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p
	integer, intent(in) :: i, j
	integer, intent(in), optional :: i_res
	real(default) :: pfr
	integer :: i_gluon
	i_gluon = size (p)
	pfr = map%res_map%get_resonance_value (i_res, p, i_gluon)
	value = pfr / (map%dij (p, i, j, map%i_con) * map%sumdij)
	end function fks_mapping_resonances_svalue

	@ %def fks_mapping_resonances_svalue
	@
	<<FKS regions: fks mapping resonances: TBP>>=
	procedure :: get_resonance_weight => &
	fks_mapping_resonances_get_resonance_weight
	<<FKS regions: sub interfaces>>=
	module function fks_mapping_resonances_get_resonance_weight &
	(map, alr, p) result (pfr)
	real(default) :: pfr
	class(fks_mapping_resonances_t), intent(in) :: map
	integer, intent(in) :: alr
	type(vector4_t), intent(in), dimension(:) :: p
	end function fks_mapping_resonances_get_resonance_weight
	<<FKS regions: procedures>>=
	module function fks_mapping_resonances_get_resonance_weight &
	(map, alr, p) result (pfr)
	real(default) :: pfr
	class(fks_mapping_resonances_t), intent(in) :: map
	integer, intent(in) :: alr
	type(vector4_t), intent(in), dimension(:) :: p
	pfr = map%res_map%get_weight (alr, p)
	end function fks_mapping_resonances_get_resonance_weight

	@ %def fks_mapping_resonances_get_resonance_weight
	@ As above, the soft limit of $d_{ij,k}$ must be computed in the resonance frame of
	reference.
	<<FKS regions: fks mapping resonances: TBP>>=
	procedure :: dij_soft => fks_mapping_resonances_dij_soft
	<<FKS regions: sub interfaces>>=
	module function fks_mapping_resonances_dij_soft &
	(map, p_born, p_soft, em, i_con) result (d)
	real(default) :: d
	class(fks_mapping_resonances_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	integer, intent(in) :: em
	integer, intent(in), optional :: i_con
	end function fks_mapping_resonances_dij_soft
	<<FKS regions: procedures>>=
	module function fks_mapping_resonances_dij_soft &
	(map, p_born, p_soft, em, i_con) result (d)
	real(default) :: d
	class(fks_mapping_resonances_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	integer, intent(in) :: em
	integer, intent(in), optional :: i_con
	real(default) :: E1, E2
	integer :: ii_con
	type(vector4_t) :: pb
	if (present (i_con)) then
	ii_con = i_con
	else
	call msg_fatal ("fks_mapping_resonances requires resonance index")
	end if
	associate (p_res => map%res_map%p_res(ii_con))
	pb = p_born(em)
	E1 = pb * p_res
	E2 = p_soft * p_res
	d = two * pb * p_soft * E1 * E2 / E1**2
	end associate
	end function fks_mapping_resonances_dij_soft

	@ %def fks_mapping_resonances_dij_soft
	@
	<<FKS regions: fks mapping resonances: TBP>>=
	procedure :: compute_sumdij_soft => fks_mapping_resonances_compute_sumdij_soft
	<<FKS regions: sub interfaces>>=
	module subroutine fks_mapping_resonances_compute_sumdij_soft &
	(map, sregion, p_born, p_soft)
	class(fks_mapping_resonances_t), intent(inout) :: map
	type(singular_region_t), intent(in) :: sregion
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	end subroutine fks_mapping_resonances_compute_sumdij_soft
	<<FKS regions: procedures>>=
	module subroutine fks_mapping_resonances_compute_sumdij_soft &
	(map, sregion, p_born, p_soft)
	class(fks_mapping_resonances_t), intent(inout) :: map
	type(singular_region_t), intent(in) :: sregion
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	real(default) :: d
	real(default) :: pfr
	integer :: i_res, i, j, i_reg, i_con
	integer :: nlegs

	d = zero
	nlegs = size (sregion%flst_real%flst)
	do i_reg = 1, sregion%nregions
	associate (ftuple => sregion%ftuples(i_reg))
	call ftuple%get(i, j)
	i_res = ftuple%i_res
	end associate
	pfr = map%res_map%get_resonance_value (i_res, p_born)
	i_con = sregion%i_reg_to_i_con (i_reg)
	if (j == nlegs) d = d + pfr / map%dij_soft (p_born, p_soft, i, i_con)
	end do
	map%sumdij_soft = d
	end subroutine fks_mapping_resonances_compute_sumdij_soft

	@ %def fks_mapping_resonances_ompute_sumdij_soft
	@
	<<FKS regions: fks mapping resonances: TBP>>=
	procedure :: svalue_soft => fks_mapping_resonances_svalue_soft
	<<FKS regions: sub interfaces>>=
	module function fks_mapping_resonances_svalue_soft &
	(map, p_born, p_soft, em, i_res) result (value)
	real(default) :: value
	class(fks_mapping_resonances_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	integer, intent(in) :: em
	integer, intent(in), optional :: i_res
	end function fks_mapping_resonances_svalue_soft
	<<FKS regions: procedures>>=
	module function fks_mapping_resonances_svalue_soft &
	(map, p_born, p_soft, em, i_res) result (value)
	real(default) :: value
	class(fks_mapping_resonances_t), intent(in) :: map
	type(vector4_t), intent(in), dimension(:) :: p_born
	type(vector4_t), intent(in) :: p_soft
	integer, intent(in) :: em
	integer, intent(in), optional :: i_res
	real(default) :: pfr
	pfr = map%res_map%get_resonance_value (i_res, p_born)
	value = pfr / (map%sumdij_soft * map%dij_soft &
	(p_born, p_soft, em, map%i_con))
	end function fks_mapping_resonances_svalue_soft

	@ %def fks_mapping_resonances_svalue_soft
	@
	<<FKS regions: fks mapping resonances: TBP>>=
	procedure :: set_resonance_momentum => &
	fks_mapping_resonances_set_resonance_momentum
	<<FKS regions: sub interfaces>>=
	module subroutine fks_mapping_resonances_set_resonance_momentum (map, p)
	class(fks_mapping_resonances_t), intent(inout) :: map
	type(vector4_t), intent(in) :: p
	end subroutine fks_mapping_resonances_set_resonance_momentum
	<<FKS regions: procedures>>=
	module subroutine fks_mapping_resonances_set_resonance_momentum (map, p)
	class(fks_mapping_resonances_t), intent(inout) :: map
	type(vector4_t), intent(in) :: p
	map%res_map%p_res = p
	end subroutine fks_mapping_resonances_set_resonance_momentum

	@ %def fks_mapping_resonances_set_resonance_momentum
	@
	<<FKS regions: fks mapping resonances: TBP>>=
	procedure :: set_resonance_momenta => &
	fks_mapping_resonances_set_resonance_momenta
	<<FKS regions: sub interfaces>>=
	module subroutine fks_mapping_resonances_set_resonance_momenta (map, p)
	class(fks_mapping_resonances_t), intent(inout) :: map
	type(vector4_t), intent(in), dimension(:) :: p
	end subroutine fks_mapping_resonances_set_resonance_momenta
	<<FKS regions: procedures>>=
	module subroutine fks_mapping_resonances_set_resonance_momenta (map, p)
	class(fks_mapping_resonances_t), intent(inout) :: map
	type(vector4_t), intent(in), dimension(:) :: p
	map%res_map%p_res = p
	end subroutine fks_mapping_resonances_set_resonance_momenta

	@ %def fks_mapping_resonances_set_resonance_momenta
	@
	<<FKS regions: interfaces>>=
	interface assignment(=)
	module procedure fks_mapping_resonances_assign
	end interface

	<<FKS regions: sub interfaces>>=
	module subroutine fks_mapping_resonances_assign (fks_map_out, fks_map_in)
	type(fks_mapping_resonances_t), intent(out) :: fks_map_out
	type(fks_mapping_resonances_t), intent(in) :: fks_map_in
	end subroutine fks_mapping_resonances_assign
	<<FKS regions: procedures>>=
	module subroutine fks_mapping_resonances_assign (fks_map_out, fks_map_in)
	type(fks_mapping_resonances_t), intent(out) :: fks_map_out
	type(fks_mapping_resonances_t), intent(in) :: fks_map_in
	fks_map_out%exp_1 = fks_map_in%exp_1
	fks_map_out%exp_2 = fks_map_in%exp_2
	fks_map_out%res_map = fks_map_in%res_map
	end subroutine fks_mapping_resonances_assign

	@ %def fks_mapping_resonances_assign
	@
	<<FKS regions: public>>=
	public :: create_resonance_histories_for_threshold
	<<FKS regions: sub interfaces>>=
	module function create_resonance_histories_for_threshold &
	() result (res_history)
	type(resonance_history_t) :: res_history
	end function create_resonance_histories_for_threshold
	<<FKS regions: procedures>>=
	module function create_resonance_histories_for_threshold &
	() result (res_history)
	type(resonance_history_t) :: res_history
	res_history%n_resonances = 2
	allocate (res_history%resonances (2))
	allocate (res_history%resonances(1)%contributors%c(2))
	allocate (res_history%resonances(2)%contributors%c(2))
	res_history%resonances(1)%contributors%c = [THR_POS_WP, THR_POS_B]
	res_history%resonances(2)%contributors%c = [THR_POS_WM, THR_POS_BBAR]
	end function create_resonance_histories_for_threshold

	@ %def create_resonance_histories_for_threshold
	@
	<<FKS regions: public>>=
	public :: setup_region_data_for_test
	<<FKS regions: sub interfaces>>=
	module subroutine setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, &
	nlo_corr_type, alpha_pow, alphas_pow)
	integer, intent(in) :: n_in, alpha_pow, alphas_pow
	integer, intent(in), dimension(:,:) :: flv_born, flv_real
	type(string_t), intent(in) :: nlo_corr_type
	type(region_data_t), intent(out) :: reg_data
	end subroutine setup_region_data_for_test
	<<FKS regions: procedures>>=
	module subroutine setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, &
	nlo_corr_type, alpha_pow, alphas_pow)
	integer, intent(in) :: n_in, alpha_pow, alphas_pow
	integer, intent(in), dimension(:,:) :: flv_born, flv_real
	type(string_t), intent(in) :: nlo_corr_type
	type(region_data_t), intent(out) :: reg_data
	type(model_t), pointer :: test_model => null ()
	call create_test_model (var_str ("SM"), test_model)
	call test_model%set_real (var_str ("me"), 0._default)
	call test_model%set_real (var_str ("mmu"), 0._default)
	call test_model%set_real (var_str ("mtau"), 0._default)
	call test_model%set_real (var_str ("ms"), 0._default)
	call test_model%set_real (var_str ("mc"), 0._default)
	call test_model%set_real (var_str ("mb"), 0._default)
	call reg_data%init (n_in, test_model, flv_born, flv_real, nlo_corr_type, alpha_pow, &
	alphas_pow)
	end subroutine setup_region_data_for_test

	@ %def setup_region_data_for_test
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\subsection{Unit tests}
	\clearpage
	<<[[fks_regions_ut.f90]]>>=
	<<File header>>

	module fks_regions_ut
	use unit_tests
	use fks_regions_uti

	<<Standard module head>>

	<<FKS regions: public test>>

	contains

	<<FKS regions: test driver>>

	end module fks_regions_ut
	@ %def fks_regions_ut
	@
	<<[[fks_regions_uti.f90]]>>=
	<<File header>>

	module fks_regions_uti

	<<Use strings>>
	use format_utils, only: write_separator
	use os_interface
	use models

	use fks_regions

	<<Standard module head>>

	<<FKS regions: test declarations>>

	contains

	<<FKS regions: tests>>

	end module fks_regions_uti
	@ %def fks_regions_uti
	@
	<<FKS regions: public test>>=
	public :: fks_regions_test
	<<FKS regions: test driver>>=
	subroutine fks_regions_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	call test(fks_regions_1, "fks_regions_1", &
	"Test flavor structure utilities", u, results)
	call test(fks_regions_2, "fks_regions_2", &
	"Test singular regions for final-state radiation for n = 2", &
	u, results)
	call test(fks_regions_3, "fks_regions_3", &
	"Test singular regions for final-state radiation for n = 3", &
	u, results)
	call test(fks_regions_4, "fks_regions_4", &
	"Test singular regions for final-state radiation for n = 4", &
	u, results)
	call test(fks_regions_5, "fks_regions_5", &
	"Test singular regions for final-state radiation for n = 5", &
	u, results)
	call test(fks_regions_6, "fks_regions_6", &
	"Test singular regions for initial-state radiation", &
	u, results)
	call test(fks_regions_7, "fks_regions_7", &
	"Check Latex output", u, results)
	call test(fks_regions_8, "fks_regions_8", &
	"Test singular regions for initial-state photon contributions", &
	u, results)
	end subroutine fks_regions_test

	@ %def fks_regions_test
	@
	<<FKS regions: test declarations>>=
	public :: fks_regions_1
	<<FKS regions: tests>>=
	subroutine fks_regions_1 (u)
	integer, intent(in) :: u
	type(flv_structure_t) :: flv_born, flv_real
	type(model_t), pointer :: test_model => null ()
	write (u, "(A)") "* Test output: fks_regions_1"
	write (u, "(A)") "* Purpose: Test utilities of flavor structure manipulation"
	write (u, "(A)")

	call create_test_model (var_str ("SM"), test_model)

	flv_born = [11, -11, 2, -2]
	flv_real = [11, -11, 2, -2, 21]
	flv_born%n_in = 2; flv_real%n_in = 2
	write (u, "(A)") "* Valid splittings of ee -> uu"
	write (u, "(A)") "Born Flavors: "
	call flv_born%write (u)
	write (u, "(A)") "Real Flavors: "
	call flv_real%write (u)
	write (u, "(A,L1)") "3, 4 (2, -2) : ", flv_real%valid_pair (3, 4, flv_born, test_model)
	write (u, "(A,L1)") "4, 3 (-2, 2) : ", flv_real%valid_pair (4, 3, flv_born, test_model)
	write (u, "(A,L1)") "3, 5 (2, 21) : ", flv_real%valid_pair (3, 5, flv_born, test_model)
	write (u, "(A,L1)") "5, 3 (21, 2) : ", flv_real%valid_pair (5, 3, flv_born, test_model)
	write (u, "(A,L1)") "4, 5 (-2, 21): ", flv_real%valid_pair (4, 5, flv_born, test_model)
	write (u, "(A,L1)") "5, 4 (21, -2): ", flv_real%valid_pair (5, 4, flv_born, test_model)
	call write_separator (u)

	call flv_born%final ()
	call flv_real%final ()

	flv_born = [2, -2, 11, -11]
	flv_real = [2, -2, 11, -11, 21]
	flv_born%n_in = 2; flv_real%n_in = 2
	write (u, "(A)") "* Valid splittings of uu -> ee"
	write (u, "(A)") "Born Flavors: "
	call flv_born%write (u)
	write (u, "(A)") "Real Flavors: "
	call flv_real%write (u)
	write (u, "(A,L1)") "1, 2 (2, -2) : " , flv_real%valid_pair (1, 2, flv_born, test_model)
	write (u, "(A,L1)") "2, 1 (-2, 2) : " , flv_real%valid_pair (2, 1, flv_born, test_model)
	write (u, "(A,L1)") "5, 2 (21, -2): " , flv_real%valid_pair (5, 2, flv_born, test_model)
	write (u, "(A,L1)") "2, 5 (-2, 21): " , flv_real%valid_pair (2, 5, flv_born, test_model)
	write (u, "(A,L1)") "1, 5 (21, 2) : " , flv_real%valid_pair (5, 1, flv_born, test_model)
	write (u, "(A,L1)") "5, 1 (2, 21) : " , flv_real%valid_pair (1, 5, flv_born, test_model)
	call flv_real%final ()
	flv_real = [21, -2, 11, -11, -2]
	flv_real%n_in = 2
	write (u, "(A)") "Real Flavors: "
	call flv_real%write (u)
	write (u, "(A,L1)") "1, 2 (21, -2): " , flv_real%valid_pair (1, 2, flv_born, test_model)
	write (u, "(A,L1)") "2, 1 (-2, 21): " , flv_real%valid_pair (2, 1, flv_born, test_model)
	write (u, "(A,L1)") "5, 2 (-2, -2): " , flv_real%valid_pair (5, 2, flv_born, test_model)
	write (u, "(A,L1)") "2, 5 (-2, -2): " , flv_real%valid_pair (2, 5, flv_born, test_model)
	write (u, "(A,L1)") "5, 1 (-2, 21): " , flv_real%valid_pair (5, 1, flv_born, test_model)
	write (u, "(A,L1)") "1, 5 (21, -2): " , flv_real%valid_pair (1, 5, flv_born, test_model)
	call flv_real%final ()
	flv_real = [2, 21, 11, -11, 2]
	flv_real%n_in = 2
	write (u, "(A)") "Real Flavors: "
	call flv_real%write (u)
	write (u, "(A,L1)") "1, 2 (2, 21) : " , flv_real%valid_pair (1, 2, flv_born, test_model)
	write (u, "(A,L1)") "2, 1 (21, 2) : " , flv_real%valid_pair (2, 1, flv_born, test_model)
	write (u, "(A,L1)") "5, 2 (2, 21) : " , flv_real%valid_pair (5, 2, flv_born, test_model)
	write (u, "(A,L1)") "2, 5 (21, 2) : " , flv_real%valid_pair (2, 5, flv_born, test_model)
	write (u, "(A,L1)") "5, 1 (2, 2) : " , flv_real%valid_pair (5, 1, flv_born, test_model)
	write (u, "(A,L1)") "1, 5 (2, 2) : " , flv_real%valid_pair (1, 5, flv_born, test_model)
	call write_separator (u)

	call flv_born%final ()
	call flv_real%final ()

	flv_born = [11, -11, 2, -2, 21]
	flv_real = [11, -11, 2, -2, 21, 21]
	flv_born%n_in = 2; flv_real%n_in = 2
	write (u, "(A)") "* Valid splittings of ee -> uug"
	write (u, "(A)") "Born Flavors: "
	call flv_born%write (u)
	write (u, "(A)") "Real Flavors: "
	call flv_real%write (u)
	write (u, "(A,L1)") "3, 4 (2, -2) : " , flv_real%valid_pair (3, 4, flv_born, test_model)
	write (u, "(A,L1)") "4, 3 (-2, 2) : " , flv_real%valid_pair (4, 3, flv_born, test_model)
	write (u, "(A,L1)") "3, 5 (2, 21) : " , flv_real%valid_pair (3, 5, flv_born, test_model)
	write (u, "(A,L1)") "5, 3 (21, 2) : " , flv_real%valid_pair (5, 3, flv_born, test_model)
	write (u, "(A,L1)") "4, 5 (-2, 21): " , flv_real%valid_pair (4, 5, flv_born, test_model)
	write (u, "(A,L1)") "5, 4 (21, -2): " , flv_real%valid_pair (5, 4, flv_born, test_model)
	write (u, "(A,L1)") "3, 6 (2, 21) : " , flv_real%valid_pair (3, 6, flv_born, test_model)
	write (u, "(A,L1)") "6, 3 (21, 2) : " , flv_real%valid_pair (6, 3, flv_born, test_model)
	write (u, "(A,L1)") "4, 6 (-2, 21): " , flv_real%valid_pair (4, 6, flv_born, test_model)
	write (u, "(A,L1)") "6, 4 (21, -2): " , flv_real%valid_pair (6, 4, flv_born, test_model)
	write (u, "(A,L1)") "5, 6 (21, 21): " , flv_real%valid_pair (5, 6, flv_born, test_model)
	write (u, "(A,L1)") "6, 5 (21, 21): " , flv_real%valid_pair (6, 5, flv_born, test_model)
	call flv_real%final ()
	flv_real = [11, -11, 2, -2, 1, -1]
	flv_real%n_in = 2
	write (u, "(A)") "Real Flavors (exemplary g -> dd splitting): "
	call flv_real%write (u)
	write (u, "(A,L1)") "3, 4 (2, -2) : " , flv_real%valid_pair (3, 4, flv_born, test_model)
	write (u, "(A,L1)") "4, 3 (-2, 2) : " , flv_real%valid_pair (4, 3, flv_born, test_model)
	write (u, "(A,L1)") "3, 5 (2, 1) : " , flv_real%valid_pair (3, 5, flv_born, test_model)
	write (u, "(A,L1)") "5, 3 (1, 2) : " , flv_real%valid_pair (5, 3, flv_born, test_model)
	write (u, "(A,L1)") "4, 5 (-2, 1) : " , flv_real%valid_pair (4, 5, flv_born, test_model)
	write (u, "(A,L1)") "5, 4 (1, -2) : " , flv_real%valid_pair (5, 4, flv_born, test_model)
	write (u, "(A,L1)") "3, 6 (2, -1) : " , flv_real%valid_pair (3, 6, flv_born, test_model)
	write (u, "(A,L1)") "6, 3 (-1, 2) : " , flv_real%valid_pair (6, 3, flv_born, test_model)
	write (u, "(A,L1)") "4, 6 (-2, -1): " , flv_real%valid_pair (4, 6, flv_born, test_model)
	write (u, "(A,L1)") "6, 4 (-1, -2): " , flv_real%valid_pair (6, 4, flv_born, test_model)
	write (u, "(A,L1)") "5, 6 (1, -1) : " , flv_real%valid_pair (5, 6, flv_born, test_model)
	write (u, "(A,L1)") "6, 5 (-1, 1) : " , flv_real%valid_pair (6, 5, flv_born, test_model)
	call write_separator (u)

	call flv_born%final ()
	call flv_real%final ()

	flv_born = [6, -5, 2, -1 ]
	flv_real = [6, -5, 2, -1, 21]
	flv_born%n_in = 1; flv_real%n_in = 1
	write (u, "(A)") "* Valid splittings of t -> b u d~"
	write (u, "(A)") "Born Flavors: "
	call flv_born%write (u)
	write (u, "(A)") "Real Flavors: "
	call flv_real%write (u)
	write (u, "(A,L1)") "1, 2 (6, -5) : " , flv_real%valid_pair (1, 2, flv_born, test_model)
	write (u, "(A,L1)") "1, 3 (6, 2) : " , flv_real%valid_pair (1, 3, flv_born, test_model)
	write (u, "(A,L1)") "1, 4 (6, -1) : " , flv_real%valid_pair (1, 4, flv_born, test_model)
	write (u, "(A,L1)") "2, 1 (-5, 6) : " , flv_real%valid_pair (2, 1, flv_born, test_model)
	write (u, "(A,L1)") "3, 1 (2, 6) : " , flv_real%valid_pair (3, 1, flv_born, test_model)
	write (u, "(A,L1)") "4, 1 (-1, 6) : " , flv_real%valid_pair (4, 1, flv_born, test_model)
	write (u, "(A,L1)") "2, 3 (-5, 2) : " , flv_real%valid_pair (2, 3, flv_born, test_model)
	write (u, "(A,L1)") "2, 4 (-5, -1): " , flv_real%valid_pair (2, 4, flv_born, test_model)
	write (u, "(A,L1)") "3, 2 (2, -5) : " , flv_real%valid_pair (3, 2, flv_born, test_model)
	write (u, "(A,L1)") "4, 2 (-1, -5): " , flv_real%valid_pair (4, 2, flv_born, test_model)
	write (u, "(A,L1)") "3, 4 (2, -1) : " , flv_real%valid_pair (3, 4, flv_born, test_model)
	write (u, "(A,L1)") "4, 3 (-1, 2) : " , flv_real%valid_pair (4, 3, flv_born, test_model)
	write (u, "(A,L1)") "1, 5 (6, 21) : " , flv_real%valid_pair (1, 5, flv_born, test_model)
	write (u, "(A,L1)") "5, 1 (21, 6) : " , flv_real%valid_pair (5, 1, flv_born, test_model)
	write (u, "(A,L1)") "2, 5 (-5, 21): " , flv_real%valid_pair (2, 5, flv_born, test_model)
	write (u, "(A,L1)") "5, 2 (21, 5) : " , flv_real%valid_pair (5, 2, flv_born, test_model)
	write (u, "(A,L1)") "3, 5 (2, 21) : " , flv_real%valid_pair (3, 5, flv_born, test_model)
	write (u, "(A,L1)") "5, 3 (21, 2) : " , flv_real%valid_pair (5, 3, flv_born, test_model)
	write (u, "(A,L1)") "4, 5 (-1, 21): " , flv_real%valid_pair (4, 5, flv_born, test_model)
	write (u, "(A,L1)") "5, 4 (21, -1): " , flv_real%valid_pair (5, 4, flv_born, test_model)

	call flv_born%final ()
	call flv_real%final ()

	end subroutine fks_regions_1

	@ %def fks_regions_1
	@
	<<FKS regions: test declarations>>=
	public :: fks_regions_2
	<<FKS regions: tests>>=
	subroutine fks_regions_2 (u)
	integer, intent(in) :: u
	integer :: n_flv_born, n_flv_real
	integer :: n_legs_born, n_legs_real
	integer :: n_in
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	type(region_data_t) :: reg_data
	write (u, "(A)") "* Test output: fks_regions_2"
	write (u, "(A)") "* Create singular regions for processes with up to four singular regions"
	write (u, "(A)") "* ee -> qq with QCD corrections"
	write (u, "(A)")

	n_flv_born = 1; n_flv_real = 1
	n_legs_born = 4; n_legs_real = 5
	n_in = 2

	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))
	flv_born (:, 1) = [11, -11, 2, -2]
	flv_real (:, 1) = [11, -11, 2, -2, 21]
	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 0)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()
	call write_separator (u)

	write (u, "(A)") "* ee -> qq with EW corrections"
	write (u, "(A)")

	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))
	flv_born (:, 1) = [11, -11, 2, -2]
	flv_real (:, 1) = [11, -11, 2, -2, 22]

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("EW"), 2, 0)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()
	call write_separator (u)

	write (u, "(A)") "* ee -> tt"
	write (u, "(A)")
	write (u, "(A)") "* This process has four singular regions because they are not equivalent."

	n_flv_born = 1; n_flv_real = 1
	n_legs_born = 6; n_legs_real = 7
	n_in = 2

	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))
	flv_born (:, 1) = [11, -11, 6, -6, 6, -6]
	flv_real (:, 1) = [11, -11, 6, -6, 6, -6, 21]
	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 4, 0)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()
	end subroutine fks_regions_2

	@ %def fks_regions_2
	@
	<<FKS regions: test declarations>>=
	public :: fks_regions_3
	<<FKS regions: tests>>=
	subroutine fks_regions_3 (u)
	integer, intent(in) :: u
	integer :: n_flv_born, n_flv_real
	integer :: n_legs_born, n_legs_real
	integer :: n_in, i, j
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	type(region_data_t) :: reg_data
	write (u, "(A)") "* Test output: fks_regions_3"
	write (u, "(A)") "* Create singular regions for processes with three final-state particles"

	write (u, "(A)") "* ee -> qqg"
	write (u, "(A)")
	n_flv_born = 1; n_flv_real = 2
	n_legs_born = 5; n_legs_real = 6
	n_in = 2
	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))

	flv_born (:, 1) = [11, -11, 2, -2, 21]
	flv_real (:, 1) = [11, -11, 2, -2, 21, 21]
	flv_real (:, 2) = [11, -11, 2, -2, 1, -1]

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 1)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()
	call write_separator (u)

	write (u, "(A)") "* ee -> qqA"
	write (u, "(A)")
	n_flv_born = 1; n_flv_real = 2
	n_legs_born = 5; n_legs_real = 6
	n_in = 2
	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))

	flv_born (:, 1) = [11, -11, 2, -2, 22]
	flv_real (:, 1) = [11, -11, 2, -2, 22, 22]
	flv_real (:, 2) = [11, -11, 2, -2, 11, -11]

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("EW"), 3, 0)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()
	call write_separator (u)

	write (u, "(A)") "* ee -> jet jet jet"
	write (u, "(A)") "* with jet = u:U:d:D:s:S:c:C:b:B:gl"
	write (u, "(A)")
	n_flv_born = 5; n_flv_real = 22
	n_legs_born = 5; n_legs_real = 6
	n_in = 2
	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))

	flv_born (:, 1) = [11, -11, -4, 4, 21]
	flv_born (:, 2) = [11, -11, -2, 2, 21]
	flv_born (:, 3) = [11, -11, -5, 5, 21]
	flv_born (:, 4) = [11, -11, -3, 3, 21]
	flv_born (:, 5) = [11, -11, -1, 1, 21]
	flv_real (:, 1) = [11, -11, -4, -4, 4, 4]
	flv_real (:, 2) = [11, -11, -4, -2, 2, 4]
	flv_real (:, 3) = [11, -11, -4, 4, 21, 21]
	flv_real (:, 4) = [11, -11, -4, -5, 4, 5]
	flv_real (:, 5) = [11, -11, -4, -3, 4, 3]
	flv_real (:, 6) = [11, -11, -4, -1, 2, 3]
	flv_real (:, 7) = [11, -11, -4, -1, 4, 1]
	flv_real (:, 8) = [11, -11, -2, -2, 2, 2]
	flv_real (:, 9) = [11, -11, -2, 2, 21, 21]
	flv_real (:, 10) = [11, -11, -2, -5, 2, 5]
	flv_real (:, 11) = [11, -11, -2, -3, 2, 3]
	flv_real (:, 12) = [11, -11, -2, -3, 4, 1]
	flv_real (:, 13) = [11, -11, -2, -1, 2, 1]
	flv_real (:, 14) = [11, -11, -5, -5, 5, 5]
	flv_real (:, 15) = [11, -11, -5, -3, 3, 5]
	flv_real (:, 16) = [11, -11, -5, -1, 1, 5]
	flv_real (:, 17) = [11, -11, -5, 5, 21, 21]
	flv_real (:, 18) = [11, -11, -3, -3, 3, 3]
	flv_real (:, 19) = [11, -11, -3, -1, 1, 3]
	flv_real (:, 20) = [11, -11, -3, 3, 21, 21]
	flv_real (:, 21) = [11, -11, -1, -1, 1, 1]
	flv_real (:, 22) = [11, -11, -1, 1, 21, 21]

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 1)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()
	call write_separator (u)

	write (u, "(A)") "* ee -> L L A"
	write (u, "(A)") "* with L = e2:E2:e3:E3"
	write (u, "(A)")
	n_flv_born = 2; n_flv_real = 6
	n_legs_born = 5; n_legs_real = 6
	n_in = 2
	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))

	flv_born (:, 1) = [11, -11, -15, 15, 22]
	flv_born (:, 2) = [11, -11, -13, 13, 22]

	flv_real (:, 1) = [11, -11, -15, -15, 15, 15]
	flv_real (:, 2) = [11, -11, -15, -13, 13, 13]
	flv_real (:, 3) = [11, -11, -13, -15, 13, 15]
	flv_real (:, 4) = [11, -11, -15, 15, 22, 22]
	flv_real (:, 5) = [11, -11, -13, -13, 13, 13]
	flv_real (:, 6) = [11, -11, -13, 13, 22, 22]

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("EW"), 3, 0)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()

	end subroutine fks_regions_3

	@ %def fks_regions_3
	@
	<<FKS regions: test declarations>>=
	public :: fks_regions_4
	<<FKS regions: tests>>=
	subroutine fks_regions_4 (u)
	integer, intent(in) :: u
	integer :: n_flv_born, n_flv_real
	integer :: n_legs_born, n_legs_real
	integer :: n_in
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	type(region_data_t) :: reg_data
	write (u, "(A)") "* Test output: fks_regions_4"
	write (u, "(A)") "* Create singular regions for processes with four final-state particles"
	write (u, "(A)") "* ee -> 4 jet"
	write (u, "(A)") "* with jet = u:U:d:D:s:S:c:C:b:B:gl"
	write (u, "(A)")
	n_flv_born = 22; n_flv_real = 22
	n_legs_born = 6; n_legs_real = 7
	n_in = 2
	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))

	flv_born (:, 1) = [11, -11, -4, -4, 4, 4]
	flv_born (:, 2) = [11, -11, -4, -2, 2, 4]
	flv_born (:, 3) = [11, -11, -4, 4, 21, 21]
	flv_born (:, 4) = [11, -11, -4, -5, 4, 5]
	flv_born (:, 5) = [11, -11, -4, -3, 4, 3]
	flv_born (:, 6) = [11, -11, -4, -1, 2, 3]
	flv_born (:, 7) = [11, -11, -4, -1, 4, 1]
	flv_born (:, 8) = [11, -11, -2, -2, 2, 2]
	flv_born (:, 9) = [11, -11, -2, 2, 21, 21]
	flv_born (:, 10) = [11, -11, -2, -5, 2, 5]
	flv_born (:, 11) = [11, -11, -2, -3, 2, 3]
	flv_born (:, 12) = [11, -11, -2, -3, 4, 1]
	flv_born (:, 13) = [11, -11, -2, -1, 2, 1]
	flv_born (:, 14) = [11, -11, -5, -5, 5, 5]
	flv_born (:, 15) = [11, -11, -5, -3, 3, 5]
	flv_born (:, 16) = [11, -11, -5, -1, 1, 5]
	flv_born (:, 17) = [11, -11, -5, 5, 21, 21]
	flv_born (:, 18) = [11, -11, -3, -3, 3, 3]
	flv_born (:, 19) = [11, -11, -3, -1, 1, 3]
	flv_born (:, 20) = [11, -11, -3, -3, 21, 21]
	flv_born (:, 21) = [11, -11, -1, -1, 1, 1]
	flv_born (:, 22) = [11, -11, -1, 1, 21, 21]
	flv_real (:, 1) = [11, -11, -4, -4, 4, 4, 21]
	flv_real (:, 2) = [11, -11, -4, -2, 2, 4, 21]
	flv_real (:, 3) = [11, -11, -4, 4, 21, 21, 21]
	flv_real (:, 4) = [11, -11, -4, -5, 4, 5, 21]
	flv_real (:, 5) = [11, -11, -4, -3, 4, 3, 21]
	flv_real (:, 6) = [11, -11, -4, -1, 2, 3, 21]
	flv_real (:, 7) = [11, -11, -4, -1, 4, 1, 21]
	flv_real (:, 8) = [11, -11, -2, -2, 2, 2, 21]
	flv_real (:, 9) = [11, -11, -2, 2, 21, 21, 21]
	flv_real (:, 10) = [11, -11, -2, -5, 2, 5, 21]
	flv_real (:, 11) = [11, -11, -2, -3, 2, 3, 21]
	flv_real (:, 12) = [11, -11, -2, -3, 4, 1, 21]
	flv_real (:, 13) = [11, -11, -2, -1, 2, 1, 21]
	flv_real (:, 14) = [11, -11, -5, -5, 5, 5, 21]
	flv_real (:, 15) = [11, -11, -5, -3, 3, 5, 21]
	flv_real (:, 16) = [11, -11, -5, -1, 1, 5, 21]
	flv_real (:, 17) = [11, -11, -5, 5, 21, 21, 21]
	flv_real (:, 18) = [11, -11, -3, -3, 3, 3, 21]
	flv_real (:, 19) = [11, -11, -3, -1, 1, 3, 21]
	flv_real (:, 20) = [11, -11, -3, 3, 21, 21, 21]
	flv_real (:, 21) = [11, -11, -1, -1, 1, 1, 21]
	flv_real (:, 22) = [11, -11, -1, 1, 21, 21, 21]

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 2)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()
	call write_separator (u)

	write (u, "(A)") "* ee -> bbmumu with QCD corrections"
	write (u, "(A)")
	n_flv_born = 1; n_flv_real = 1
	n_legs_born = 6; n_legs_real = 7
	n_in = 2
	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))

	flv_born (:, 1) = [11, -11, -5, 5, -13, 13]
	flv_real (:, 1) = [11, -11, -5, 5, -13, 13, 21]

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 4, 0)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()
	call write_separator (u)

	write (u, "(A)") "* ee -> bbmumu with EW corrections"
	write (u, "(A)")
	n_flv_born = 1; n_flv_real = 1
	n_legs_born = 6; n_legs_real = 7
	n_in = 2
	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))

	flv_born (:, 1) = [11, -11, -5, 5, -13, 13]
	flv_real (:, 1) = [11, -11, -5, 5, -13, 13, 22]

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 4, 0)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()

	end subroutine fks_regions_4

	@ %def fks_regions_4
	@
	<<FKS regions: test declarations>>=
	public :: fks_regions_5
	<<FKS regions: tests>>=
	subroutine fks_regions_5 (u)
	integer, intent(in) :: u
	integer :: n_flv_born, n_flv_real
	integer :: n_legs_born, n_legs_real
	integer :: n_in
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	type(region_data_t) :: reg_data
	write (u, "(A)") "* Test output: fks_regions_5"
	write (u, "(A)") "* Create singular regions for processes with five final-state particles"
	write (u, "(A)") "* ee -> 5 jet"
	write (u, "(A)") "* with jet = u:U:d:D:s:S:c:C:b:B:gl"
	write (u, "(A)")
	n_flv_born = 22; n_flv_real = 67
	n_legs_born = 7; n_legs_real = 8
	n_in = 2
	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))


	flv_born (:,1) = [11,-11,-4,-4,4,4,21]
	flv_born (:,2) = [11,-11,-4,-2,2,4,21]
	flv_born (:,3) = [11,-11,-4,4,21,21,21]
	flv_born (:,4) = [11,-11,-4,-5,4,5,21]
	flv_born (:,5) = [11,-11,-4,-3,4,3,21]
	flv_born (:,6) = [11,-11,-4,-1,2,3,21]
	flv_born (:,7) = [11,-11,-4,-1,4,1,21]
	flv_born (:,8) = [11,-11,-2,-2,2,2,21]
	flv_born (:,9) = [11,-11,-2,2,21,21,21]
	flv_born (:,10) = [11,-11,-2,-5,2,5,21]
	flv_born (:,11) = [11,-11,-2,-3,2,3,21]
	flv_born (:,12) = [11,-11,-2,-3,4,1,21]
	flv_born (:,13) = [11,-11,-2,-1,2,1,21]
	flv_born (:,14) = [11,-11,-5,-5,5,5,21]
	flv_born (:,15) = [11,-11,-5,-3,3,5,21]
	flv_born (:,16) = [11,-11,-5,-1,1,5,21]
	flv_born (:,17) = [11,-11,-5,5,21,21,21]
	flv_born (:,18) = [11,-11,-3,-3,3,3,21]
	flv_born (:,19) = [11,-11,-3,-1,1,3,21]
	flv_born (:,20) = [11,-11,-3,3,21,21,21]
	flv_born (:,21) = [11,-11,-1,-1,1,1,21]
	flv_born (:,22) = [11,-11,-1,1,21,21,21]

	flv_real (:,1) = [11,-11,-4,-4,-4,4,4,4]
	flv_real (:,2) = [11,-11,-4,-4,-2,2,4,4]
	flv_real (:,3) = [11,-11,-4,-4,4,4,21,21]
	flv_real (:,4) = [11,-11,-4,-4,-5,4,4,5]
	flv_real (:,5) = [11,-11,-4,-4,-3,4,4,3]
	flv_real (:,6) = [11,-11,-4,-4,-1,2,4,3]
	flv_real (:,7) = [11,-11,-4,-4,-1,4,4,1]
	flv_real (:,8) = [11,-11,-4,-2,-2,2,2,4]
	flv_real (:,9) = [11,-11,-4,-2,2,4,21,21]
	flv_real (:,10) = [11,-11,-4,-2,-5,2,4,5]
	flv_real (:,11) = [11,-11,-4,-2,-3,2,4,3]
	flv_real (:,12) = [11,-11,-4,-2,-3,4,4,1]
	flv_real (:,13) = [11,-11,-4,-2,-1,2,2,3]
	flv_real (:,14) = [11,-11,-4,-2,-1,2,4,1]
	flv_real (:,15) = [11,-11,-4,4,21,21,21,21]
	flv_real (:,16) = [11,-11,-4,-5,4,5,21,21]
	flv_real (:,17) = [11,-11,-4,-5,-5,4,5,5]
	flv_real (:,18) = [11,-11,-4,-5,-3,4,3,5]
	flv_real (:,19) = [11,-11,-4,-5,-1,2,3,5]
	flv_real (:,20) = [11,-11,-4,-5,-1,4,1,5]
	flv_real (:,21) = [11,-11,-4,-3,4,3,21,21]
	flv_real (:,22) = [11,-11,-4,-3,-3,4,3,3]
	flv_real (:,23) = [11,-11,-4,-3,-1,2,3,3]
	flv_real (:,24) = [11,-11,-4,-3,-1,4,1,3]
	flv_real (:,25) = [11,-11,-4,-1,2,3,21,21]
	flv_real (:,26) = [11,-11,-4,-1,4,1,21,21]
	flv_real (:,27) = [11,-11,-4,-1,-1,2,1,3]
	flv_real (:,28) = [11,-11,-4,-1,-1,4,1,1]
	flv_real (:,29) = [11,-11,-2,-2,-2,2,2,2]
	flv_real (:,30) = [11,-11,-2,-2,2,2,21,21]
	flv_real (:,31) = [11,-11,-2,-2,-5,2,2,5]
	flv_real (:,32) = [11,-11,-2,-2,-3,2,2,3]
	flv_real (:,33) = [11,-11,-2,-2,-3,2,4,1]
	flv_real (:,34) = [11,-11,-2,-2,-1,2,2,1]
	flv_real (:,35) = [11,-11,-2,2,21,21,21,21]
	flv_real (:,36) = [11,-11,-2,-5,2,5,21,21]
	flv_real (:,37) = [11,-11,-2,-5,-5,2,5,5]
	flv_real (:,38) = [11,-11,-2,-5,-3,2,3,5]
	flv_real (:,39) = [11,-11,-2,-5,-3,4,1,5]
	flv_real (:,40) = [11,-11,-2,-5,-1,2,1,5]
	flv_real (:,41) = [11,-11,-2,-3,2,3,21,21]
	flv_real (:,42) = [11,-11,-2,-3,4,1,21,21]
	flv_real (:,43) = [11,-11,-2,-3,-3,2,3,3]
	flv_real (:,44) = [11,-11,-2,-3,-3,4,1,3]
	flv_real (:,45) = [11,-11,-2,-3,-1,2,1,3]
	flv_real (:,46) = [11,-11,-2,-3,-1,4,1,1]
	flv_real (:,47) = [11,-11,-2,-1,2,1,21,21]
	flv_real (:,48) = [11,-11,-2,-1,-1,2,1,1]
	flv_real (:,49) = [11,-11,-5,-5,-5,5,5,5]
	flv_real (:,50) = [11,-11,-5,-5,-3,3,5,5]
	flv_real (:,51) = [11,-11,-5,-5,-1,1,5,5]
	flv_real (:,52) = [11,-11,-5,-5,5,5,21,21]
	flv_real (:,53) = [11,-11,-5,-3,-3,3,3,5]
	flv_real (:,54) = [11,-11,-5,-3,-1,1,3,5]
	flv_real (:,55) = [11,-11,-5,-3,3,5,21,21]
	flv_real (:,56) = [11,-11,-5,-1,-1,1,1,5]
	flv_real (:,57) = [11,-11,-5,-1,1,5,21,21]
	flv_real (:,58) = [11,-11,-5,5,21,21,21,21]
	flv_real (:,59) = [11,-11,-3,-3,-3,3,3,3]
	flv_real (:,60) = [11,-11,-3,-3,-1,1,3,3]
	flv_real (:,61) = [11,-11,-3,-3,3,3,21,21]
	flv_real (:,62) = [11,-11,-3,-1,-1,1,1,3]
	flv_real (:,63) = [11,-11,-3,-1,1,3,21,21]
	flv_real (:,64) = [11,-11,-3,3,21,21,21,21]
	flv_real (:,65) = [11,-11,-1,-1,-1,1,1,1]
	flv_real (:,66) = [11,-11,-1,-1,1,1,21,21]
	flv_real (:,67) = [11,-11,-1,1,21,21,21,21]

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 3)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()

	end subroutine fks_regions_5

	@ %def fks_regions_5
	@
	<<FKS regions: test declarations>>=
	public :: fks_regions_6
	<<FKS regions: tests>>=
	subroutine fks_regions_6 (u)
	integer, intent(in) :: u
	integer :: n_flv_born, n_flv_real
	integer :: n_legs_born, n_legs_real
	integer :: n_in
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	type(region_data_t) :: reg_data
	integer :: i, j
	integer, dimension(10) :: flavors
	write (u, "(A)") "* Test output: fks_regions_6"
	write (u, "(A)") "* Create table of singular regions for Drell Yan"
	write (u, "(A)")

	n_flv_born = 10; n_flv_real = 30
	n_legs_born = 4; n_legs_real = 5
	n_in = 2
	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))
	flavors = [-5, -4, -3, -2, -1, 1, 2, 3, 4, 5]
	do i = 1, n_flv_born
	flv_born (3:4, i) = [11, -11]
	end do
	do j = 1, n_flv_born
	flv_born (1, j) = flavors (j)
	flv_born (2, j) = -flavors (j)
	end do

	do i = 1, n_flv_real
	flv_real (3:4, i) = [11, -11]
	end do
	i = 1
	do j = 1, n_flv_real
	if (mod (j, 3) == 1) then
	flv_real (1, j) = flavors (i)
	flv_real (2, j) = -flavors (i)
	flv_real (5, j) = 21
	else if (mod (j, 3) == 2) then
	flv_real (1, j) = flavors (i)
	flv_real (2, j) = 21
	flv_real (5, j) = flavors (i)
	else
	flv_real (1, j) = 21
	flv_real (2, j) = -flavors (i)
	flv_real (5, j) = -flavors (i)
	i = i + 1
	end if
	end do

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 0)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	call write_separator (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()

	write (u, "(A)") "* Create table of singular regions for hadronic top decay"
	write (u, "(A)")
	n_flv_born = 1; n_flv_real = 1
	n_legs_born = 4; n_legs_real = 5
	n_in = 1
	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))

	flv_born (:, 1) = [6, -5, 2, -1]
	flv_real (:, 1) = [6, -5, 2, -1, 21]

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 0, 2)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)

	call write_separator (u)

	deallocate (flv_born, flv_real)
	call reg_data%final ()

	write (u, "(A)") "* Create table of singular regions for dijet s sbar -> jet jet"
	write (u, "(A)") "* With jet = u:d:gl"
	write (u, "(A)")

	n_flv_born = 3; n_flv_real = 3
	n_legs_born = 4; n_legs_real = 5
	n_in = 2
	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))
	do i = 1, n_flv_born
	flv_born (1:2, i) = [3, -3]
	end do
	flv_born (3, :) = [1, 2, 21]
	flv_born (4, :) = [-1, -2, 21]

	do i = 1, n_flv_real
	flv_real (1:2, i) = [3, -3]
	end do
	flv_real (3, :) = [1, 2, 21]
	flv_real (4, :) = [-1, -2, 21]
	flv_real (5, :) = [21, 21, 21]

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 0, 2)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)
	call reg_data%final ()

	end subroutine fks_regions_6

	@ %def fks_regions_6
	@
	<<FKS regions: test declarations>>=
	public :: fks_regions_7
	<<FKS regions: tests>>=
	subroutine fks_regions_7 (u)
	integer, intent(in) :: u
	integer :: n_flv_born, n_flv_real
	integer :: n_legs_born, n_legs_real
	integer :: n_in
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	type(region_data_t) :: reg_data
	write (u, "(A)") "* Test output: fks_regions_7"
	write (u, "(A)") "* Create table of singular regions for ee -> qq"
	write (u, "(A)")

	n_flv_born = 1; n_flv_real = 1
	n_legs_born = 4; n_legs_real = 5
	n_in = 2

	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))
	flv_born (:, 1) = [11, -11, 2, -2]
	flv_real (:, 1) = [11, -11, 2, -2, 21]
	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("QCD"), 2, 0)
	call reg_data%write_latex (u)
	call reg_data%final ()

	end subroutine fks_regions_7

	@ %def fks_regions_7
	@
	<<FKS regions: test declarations>>=
	public :: fks_regions_8
	<<FKS regions: tests>>=
	subroutine fks_regions_8 (u)
	integer, intent(in) :: u
	integer :: n_flv_born, n_flv_real
	integer :: n_legs_born, n_legs_real
	integer :: n_in
	integer, dimension(:,:), allocatable :: flv_born, flv_real
	type(region_data_t) :: reg_data
	integer :: i, j
	integer, dimension(10) :: flavors
	write (u, "(A)") "* Test output: fks_regions_8"
	write (u, "(A)") "* Create table of singular regions for ee -> ee"
	write (u, "(A)")

	n_flv_born = 1; n_flv_real = 3
	n_legs_born = 4; n_legs_real = 5
	n_in = 2
	allocate (flv_born (n_legs_born, n_flv_born))
	allocate (flv_real (n_legs_real, n_flv_real))
	flv_born (:, 1) = [11, -11, -11, 11]

	flv_real (:, 1) = [11, -11, -11, 11, 22]
	flv_real (:, 2) = [11, 22, -11, 11, 11]
	flv_real (:, 3) = [22, -11, 11, -11, -11]

	call setup_region_data_for_test (n_in, flv_born, flv_real, reg_data, var_str ("EW"), 2, 0)
	call reg_data%check_consistency (.false., u)
	call reg_data%write (u)
	call reg_data%final ()

	end subroutine fks_regions_8

	@ %def fks_regions_8
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{NLO infrastructure and data}

	This module contains the settings and data infrastructure.
	<<[[nlo_data.f90]]>>=
	<<File header>>

	module nlo_data

	<<Use kinds>>
	<<Use strings>>
	use constants, only: zero
	use lorentz
	use variables, only: var_list_t
	use physics_defs, only: NO_FACTORIZATION, FACTORIZATION_THRESHOLD

	<<Standard module head>>

	<<NLO data: public>>

	<<NLO data: parameters>>

	<<NLO data: types>>

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

	end module nlo_data

	@ %def nlo_data
	@
	<<[[nlo_data_sub.f90]]>>=
	<<File header>>

	submodule (nlo_data) nlo_data_s

	use diagnostics
	use string_utils, only: split_string, read_ival, string_contains_word
	use io_units
	use format_defs, only: FMT_15
	use physics_defs, only: THR_POS_WP, THR_POS_WM
	use physics_defs, only: THR_POS_B, THR_POS_BBAR

	implicit none

	contains

	<<NLO data: procedures>>

	end submodule nlo_data_s

	@ %def nlo_data_s
	@
	<<NLO data: parameters>>=
	integer, parameter, public :: FKS_DEFAULT = 1
	integer, parameter, public :: FKS_RESONANCES = 2

	integer, dimension(2), parameter, public :: ASSOCIATED_LEG_PAIR = [1, 3]

	@ %def parameters
	@
	<<NLO data: public>>=
	public :: fks_template_t
	<<NLO data: types>>=
	type :: fks_template_t
	logical :: subtraction_disabled = .false.
	integer :: mapping_type = FKS_DEFAULT
	logical :: count_kinematics = .false.
	real(default) :: fks_dij_exp1
	real(default) :: fks_dij_exp2
	real(default) :: xi_min
	real(default) :: y_max
	real(default) :: xi_cut, delta_o, delta_i
	type(string_t), dimension(:), allocatable :: excluded_resonances
	integer :: n_f
	contains
	<<NLO data: fks template: TBP>>
	end type fks_template_t

	@ %def fks_template_t
	@
	<<NLO data: fks template: TBP>>=
	procedure :: write => fks_template_write
	<<NLO data: sub interfaces>>=
	module subroutine fks_template_write (template, unit)
	class(fks_template_t), intent(in) :: template
	integer, intent(in), optional :: unit
	end subroutine fks_template_write
	<<NLO data: procedures>>=
	module subroutine fks_template_write (template, unit)
	class(fks_template_t), intent(in) :: template
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u,'(1x,A)') 'FKS Template: '
	write (u,'(1x,A)', advance = 'no') 'Mapping Type: '
	select case (template%mapping_type)
	case (FKS_DEFAULT)
	write (u,'(A)') 'Default'
	case (FKS_RESONANCES)
	write (u,'(A)') 'Resonances'
	case default
	write (u,'(A)') 'Unkown'
	end select
	write (u,'(1x,A,ES4.3,ES4.3)') 'd_ij exponentials: ', &
	template%fks_dij_exp1, template%fks_dij_exp2
	write (u, '(1x,A,ES4.3,ES4.3)') 'xi_cut: ', &
	template%xi_cut
	write (u, '(1x,A,ES4.3,ES4.3)') 'delta_o: ', &
	template%delta_o
	write (u, '(1x,A,ES4.3,ES4.3)') 'delta_i: ', &
	template%delta_i
	end subroutine fks_template_write

	@ %def fks_template_write
	@ Set FKS parameters. $\xi_{\text{cut}}, \delta_o$ and
	$\delta_{\mathrm{I}}$ steer the ratio of the integrated and real
	subtraction.
	<<NLO data: fks template: TBP>>=
	procedure :: set_parameters => fks_template_set_parameters
	<<NLO data: sub interfaces>>=
	module subroutine fks_template_set_parameters (template, &
	exp1, exp2, xi_min, y_max, xi_cut, delta_o, delta_i)
	class(fks_template_t), intent(inout) :: template
	real(default), intent(in) :: exp1, exp2
	real(default), intent(in) :: xi_min, y_max, &
	xi_cut, delta_o, delta_i
	end subroutine fks_template_set_parameters
	<<NLO data: procedures>>=
	module subroutine fks_template_set_parameters (template, &
	exp1, exp2, xi_min, y_max, xi_cut, delta_o, delta_i)
	class(fks_template_t), intent(inout) :: template
	real(default), intent(in) :: exp1, exp2
	real(default), intent(in) :: xi_min, y_max, &
	xi_cut, delta_o, delta_i
	template%fks_dij_exp1 = exp1
	template%fks_dij_exp2 = exp2
	template%xi_min = xi_min
	template%y_max = y_max
	template%xi_cut = xi_cut
	template%delta_o = delta_o
	template%delta_i = delta_i
	end subroutine fks_template_set_parameters

	@ %def fks_template_set_parameters
	<<NLO data: fks template: TBP>>=
	procedure :: set_mapping_type => fks_template_set_mapping_type
	<<NLO data: sub interfaces>>=
	module subroutine fks_template_set_mapping_type (template, val)
	class(fks_template_t), intent(inout) :: template
	integer, intent(in) :: val
	end subroutine fks_template_set_mapping_type
	<<NLO data: procedures>>=
	module subroutine fks_template_set_mapping_type (template, val)
	class(fks_template_t), intent(inout) :: template
	integer, intent(in) :: val
	template%mapping_type = val
	end subroutine fks_template_set_mapping_type

	@ %def fks_template_set_mapping_type
	@
	<<NLO data: fks template: TBP>>=
	procedure :: set_counter => fks_template_set_counter
	<<NLO data: sub interfaces>>=
	module subroutine fks_template_set_counter (template)
	class(fks_template_t), intent(inout) :: template
	end subroutine fks_template_set_counter
	<<NLO data: procedures>>=
	module subroutine fks_template_set_counter (template)
	class(fks_template_t), intent(inout) :: template
	template%count_kinematics = .true.
	end subroutine fks_template_set_counter

	@ %def fks_template_set_counter
	@
	<<NLO data: public>>=
	public :: get_threshold_momenta
	<<NLO data: sub interfaces>>=
	module function get_threshold_momenta (p) result (p_thr)
	type(vector4_t), dimension(4) :: p_thr
	type(vector4_t), intent(in), dimension(:) :: p
	end function get_threshold_momenta
	<<NLO data: procedures>>=
	module function get_threshold_momenta (p) result (p_thr)
	type(vector4_t), dimension(4) :: p_thr
	type(vector4_t), intent(in), dimension(:) :: p
	p_thr(1) = p(THR_POS_WP) + p(THR_POS_B)
	p_thr(2) = p(THR_POS_B)
	p_thr(3) = p(THR_POS_WM) + p(THR_POS_BBAR)
	p_thr(4) = p(THR_POS_BBAR)
	end function get_threshold_momenta

	@ %def get_threshold_momenta
	@
	\subsection{NLO settings and steering}
	<<NLO data: public>>=
	public :: nlo_settings_t
	<<NLO data: types>>=
	type :: nlo_settings_t
	logical :: use_internal_color_correlations = .true.
	logical :: use_internal_spin_correlations = .false.
	logical :: use_resonance_mappings = .false.
	logical :: combined_integration = .false.
	logical :: fixed_order_nlo = .false.
	logical :: test_soft_limit = .false.
	logical :: test_coll_limit = .false.
	logical :: test_anti_coll_limit = .false.
	integer, dimension(:), allocatable :: selected_alr
	integer :: factorization_mode = NO_FACTORIZATION
	!!! Probably not the right place for this. Revisit after refactoring
	real(default) :: powheg_damping_scale = zero
	type(fks_template_t) :: fks_template
	type(string_t) :: virtual_selection
	logical :: virtual_resonance_aware_collinear = .true.
	logical :: use_born_scale = .false.
	logical :: cut_all_real_sqmes = .false.
	type(string_t) :: nlo_correction_type
	logical :: reuse_amplitudes_fks = .false.
	contains
	<<NLO data: nlo settings: TBP>>
	end type nlo_settings_t

	@ %def nlo_settings_t
	@
	<<NLO data: nlo settings: TBP>>=
	procedure :: init => nlo_settings_init
	<<NLO data: sub interfaces>>=
	module subroutine nlo_settings_init (nlo_settings, var_list, fks_template)
	class(nlo_settings_t), intent(inout) :: nlo_settings
	type(var_list_t), intent(in) :: var_list
	type(fks_template_t), intent(in), optional :: fks_template
	end subroutine nlo_settings_init
	<<NLO data: procedures>>=
	module subroutine nlo_settings_init (nlo_settings, var_list, fks_template)
	class(nlo_settings_t), intent(inout) :: nlo_settings
	type(var_list_t), intent(in) :: var_list
	type(fks_template_t), intent(in), optional :: fks_template
	type(string_t) :: color_method
	if (present (fks_template)) nlo_settings%fks_template = fks_template
	color_method = var_list%get_sval (var_str ('$correlation_me_method'))
	if (color_method == "") &
	color_method = var_list%get_sval (var_str ('$method'))
	nlo_settings%use_internal_color_correlations = color_method == 'omega' &
	.or. color_method == 'threshold'
	nlo_settings%combined_integration = var_list%get_lval &
	(var_str ("?combined_nlo_integration"))
	nlo_settings%fixed_order_nlo = var_list%get_lval &
	(var_str ("?fixed_order_nlo_events"))
	nlo_settings%test_soft_limit = &
	var_list%get_lval (var_str ('?test_soft_limit'))
	nlo_settings%test_coll_limit = &
	var_list%get_lval (var_str ('?test_coll_limit'))
	nlo_settings%test_anti_coll_limit = &
	var_list%get_lval (var_str ('?test_anti_coll_limit'))
	call setup_alr_selection ()
	nlo_settings%virtual_selection = &
	var_list%get_sval (var_str ('$virtual_selection'))
	nlo_settings%virtual_resonance_aware_collinear = &
	var_list%get_lval (var_str ('?virtual_collinear_resonance_aware'))
	nlo_settings%powheg_damping_scale = &
	var_list%get_rval (var_str ('powheg_damping_scale'))
	nlo_settings%use_born_scale = &
	var_list%get_lval (var_str ("?nlo_use_born_scale"))
	nlo_settings%cut_all_real_sqmes = &
	var_list%get_lval (var_str ("?nlo_cut_all_real_sqmes"))
	nlo_settings%nlo_correction_type = &
	var_list%get_sval (var_str ('$nlo_correction_type'))
	nlo_settings%reuse_amplitudes_fks = &
	var_list%get_lval (var_str ('?nlo_reuse_amplitudes_fks'))
	contains
	subroutine setup_alr_selection ()
	type(string_t) :: alr_selection
	type(string_t), dimension(:), allocatable :: alr_split
	integer :: i, i1, i2
	alr_selection = var_list%get_sval (var_str ('$select_alpha_regions'))
	if (string_contains_word (alr_selection, var_str (","))) then
	call split_string (alr_selection, var_str (","), alr_split)
	allocate (nlo_settings%selected_alr (size (alr_split)))
	do i = 1, size (alr_split)
	nlo_settings%selected_alr(i) = read_ival(alr_split(i))
	end do
	else if (string_contains_word (alr_selection, var_str (":"))) then
	call split_string (alr_selection, var_str (":"), alr_split)
	if (size (alr_split) == 2) then
	i1 = read_ival (alr_split(1))
	i2 = read_ival (alr_split(2))
	allocate (nlo_settings%selected_alr (i2 - i1 + 1))
	do i = 1, i2 - i1 + 1
	nlo_settings%selected_alr(i) = read_ival (alr_split(i))
	end do
	else
	call msg_fatal ("select_alpha_regions: ':' specifies a range!")
	end if
	else if (len(alr_selection) == 1) then
	allocate (nlo_settings%selected_alr (1))
	nlo_settings%selected_alr(1) = read_ival (alr_selection)
	end if
	if (allocated (alr_split)) deallocate (alr_split)
	end subroutine setup_alr_selection
	end subroutine nlo_settings_init

	@ %def nlo_settings_init
	@
	<<NLO data: nlo settings: TBP>>=
	procedure :: write => nlo_settings_write
	<<NLO data: sub interfaces>>=
	module subroutine nlo_settings_write (nlo_settings, unit)
	class(nlo_settings_t), intent(in) :: nlo_settings
	integer, intent(in), optional :: unit
	end subroutine nlo_settings_write
	<<NLO data: procedures>>=
	module subroutine nlo_settings_write (nlo_settings, unit)
	class(nlo_settings_t), intent(in) :: nlo_settings
	integer, intent(in), optional :: unit
	integer :: i, u
	u = given_output_unit (unit); if (u < 0) return
	write (u, '(A)') 'nlo_settings:'
	write (u, '(3X,A,L1)') 'internal_color_correlations = ', &
	nlo_settings%use_internal_color_correlations
	write (u, '(3X,A,L1)') 'internal_spin_correlations = ', &
	nlo_settings%use_internal_spin_correlations
	write (u, '(3X,A,L1)') 'use_resonance_mappings = ', &
	nlo_settings%use_resonance_mappings
	write (u, '(3X,A,L1)') 'combined_integration = ', &
	nlo_settings%combined_integration
	write (u, '(3X,A,L1)') 'test_soft_limit = ', &
	nlo_settings%test_soft_limit
	write (u, '(3X,A,L1)') 'test_coll_limit = ', &
	nlo_settings%test_coll_limit
	write (u, '(3X,A,L1)') 'test_anti_coll_limit = ', &
	nlo_settings%test_anti_coll_limit
	if (allocated (nlo_settings%selected_alr)) then
	write (u, '(3x,A)', advance = "no") 'selected alpha regions = ['
	do i = 1, size (nlo_settings%selected_alr)
	write (u, '(A,I0)', advance = "no") ",", &
	nlo_settings%selected_alr(i)
	end do
	write (u, '(A)') "]"
	end if
	write (u, '(3X,A,' // FMT_15 // ')') 'powheg_damping_scale = ', &
	nlo_settings%powheg_damping_scale
	write (u, '(3X,A,A)') 'virtual_selection = ', &
	char (nlo_settings%virtual_selection)
	write (u, '(3X,A,A)') 'Real factorization mode = ', &
	char (factorization_mode (nlo_settings%factorization_mode))
	contains
	function factorization_mode (fm)
	type(string_t) :: factorization_mode
	integer, intent(in) :: fm
	select case (fm)
	case (NO_FACTORIZATION)
	factorization_mode = var_str ("None")
	case (FACTORIZATION_THRESHOLD)
	factorization_mode = var_str ("Threshold")
	case default
	factorization_mode = var_str ("Undefined!")
	end select
	end function factorization_mode
	end subroutine nlo_settings_write

	@ %def nlo_settings_write
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Virtual contribution to the cross section}

	This module implements the UV-finite virtual contribution of an NLO
	calculation together with the integrated (FKS) subtraction terms.
	<<[[virtual.f90]]>>=
	<<File header>>

	module virtual

	<<Use kinds>>
	<<Use strings>>
	use pdg_arrays
	use models
	use model_data, only: model_data_t, field_data_t
	use lorentz
	use nlo_data, only: nlo_settings_t
	use fks_regions

	<<Standard module head>>

	<<Virtual: public>>

	<<Virtual: types>>

	interface
	<<Virtual: sub interfaces>>
	end interface

	end module virtual
	@ %def virtual
	@
	<<[[virtual_sub.f90]]>>=
	<<File header>>

	submodule (virtual) virtual_s

	<<Use debug>>
	use constants
	use numeric_utils
	use diagnostics
	use physics_defs
	use sm_physics
	use flavors
	use nlo_data, only: ASSOCIATED_LEG_PAIR, get_threshold_momenta

	implicit none

	contains

	<<Virtual: procedures>>

	end submodule virtual_s

	@ %def virtual_s
	@
	<<Virtual: public>>=
	public :: virtual_t
	<<Virtual: types>>=
	type :: virtual_t
	type(nlo_settings_t) :: settings
	real(default), dimension(:,:,:), allocatable :: gamma_0, gamma_p, c_flv
	real(default) :: fac_scale
	real(default), allocatable :: ren_scale
	real(default), allocatable :: es_scale2
	integer, dimension(:), allocatable :: n_is_neutrinos
	integer :: n_in, n_legs, n_flv
	logical :: bad_point = .false.
	type(string_t) :: selection
	real(default), dimension(:), allocatable :: sqme_born
	real(default), dimension(:), allocatable :: sqme_virt_fin
	real(default), dimension(:,:,:), allocatable :: sqme_color_c
	real(default), dimension(:,:,:), allocatable :: sqme_charge_c
	logical :: has_pdfs = .false.
	contains
	<<Virtual: virtual: TBP>>
	end type virtual_t

	@ %def virtual_t
	@
	<<Virtual: virtual: TBP>>=
	procedure :: init => virtual_init
	<<Virtual: sub interfaces>>=
	module subroutine virtual_init &
	(virt, flv_born, n_in, settings, model, has_pdfs)
	class(virtual_t), intent(inout) :: virt
	integer, intent(in), dimension(:,:) :: flv_born
	integer, intent(in) :: n_in
	type(nlo_settings_t), intent(in) :: settings
	class(model_data_t), intent(in) :: model
	logical, intent(in) :: has_pdfs
	end subroutine virtual_init
	<<Virtual: procedures>>=
	module subroutine virtual_init &
	(virt, flv_born, n_in, settings, model, has_pdfs)
	class(virtual_t), intent(inout) :: virt
	integer, intent(in), dimension(:,:) :: flv_born
	integer, intent(in) :: n_in
	type(nlo_settings_t), intent(in) :: settings
	class(model_data_t), intent(in) :: model
	logical, intent(in) :: has_pdfs
	integer :: i_flv, n_corr
	n_corr = 2
	virt%n_legs = size (flv_born, 1); virt%n_flv = size (flv_born, 2)
	virt%n_in = n_in
	allocate (virt%sqme_born (virt%n_flv))
	allocate (virt%sqme_virt_fin (virt%n_flv))
	allocate (virt%sqme_color_c (virt%n_legs, virt%n_legs, virt%n_flv))
	allocate (virt%sqme_charge_c (virt%n_legs, virt%n_legs, virt%n_flv))
	allocate (virt%gamma_0 (virt%n_legs, virt%n_flv, n_corr), &
	virt%gamma_p (virt%n_legs, virt%n_flv, n_corr), &
	virt%c_flv (virt%n_legs, virt%n_flv, n_corr))
	call virt%init_constants (flv_born, settings%fks_template%n_f, model)
	allocate (virt%n_is_neutrinos (virt%n_flv))
	virt%n_is_neutrinos = 0
	do i_flv = 1, virt%n_flv
	if (is_neutrino (flv_born(1, i_flv))) &
	virt%n_is_neutrinos(i_flv) = virt%n_is_neutrinos(i_flv) + 1
	if (is_neutrino (flv_born(2, i_flv))) &
	virt%n_is_neutrinos(i_flv) = virt%n_is_neutrinos(i_flv) + 1
	end do
	select case (char (settings%virtual_selection))
	case ("Full", "OLP", "Subtraction")
	virt%selection = settings%virtual_selection
	case default
	call msg_fatal ('Virtual selection: Possible values are "Full", "OLP" or "Subtraction')
	end select
	virt%settings = settings
	virt%has_pdfs = has_pdfs
	contains

	function is_neutrino (flv) result (neutrino)
	integer, intent(in) :: flv
	logical :: neutrino
	neutrino = (abs(flv) == 12 .or. abs(flv) == 14 .or. abs(flv) == 16)
	end function is_neutrino

	end subroutine virtual_init

	@ %def virtual_init
	@ The virtual subtraction terms contain Casimir operators and derived
	constants, listed below:
	\begin{align}
	\label{eqn:C(q)}
	C(q) = C(\bar{q}) &= C_F, \\
	\label{eqn:C(g)}
	C(g) &= C_A,\\
	\label{eqn:gamma(q)}
	\gamma(q) = \gamma(\bar{q}) &= \frac{3}{2} C_F,\\
	\label{eqn:gamma(g)}
	\gamma(g) &= \frac{11}{6} C_A - \frac{2}{3} T_F N_f,\\
	\label{eqn:gammap(q)}
	\gamma'(q) = \gamma'(\bar{q}) &= \left(\frac{13}{2} -
	\frac{2\pi^2}{3}\right) C_F, \\
	\label{eqn:gammap(g)}
	\gamma'(g) &= \left(\frac{67}{9} - \frac{2\pi^2}{3}\right) C_A -
	\frac{23}{9} T_F N_f.
	\end{align}
	For uncolored particles, [[virtual_init_constants]] sets $C$, $\gamma$ and $\gamma'$ to zero.
	<<Virtual: virtual: TBP>>=
	procedure :: init_constants => virtual_init_constants
	<<Virtual: sub interfaces>>=
	module subroutine virtual_init_constants (virt, flv_born, nf_input, model)
	class(virtual_t), intent(inout) :: virt
	integer, intent(in), dimension(:,:) :: flv_born
	integer, intent(in) :: nf_input
	type(string_t), dimension(2) :: corr_type
	class(model_data_t), intent(in) :: model
	end subroutine virtual_init_constants
	<<Virtual: procedures>>=
	module subroutine virtual_init_constants (virt, flv_born, nf_input, model)
	class(virtual_t), intent(inout) :: virt
	integer, intent(in), dimension(:,:) :: flv_born
	integer, intent(in) :: nf_input
	type(string_t), dimension(2) :: corr_type
	class(model_data_t), intent(in) :: model
	type(field_data_t), pointer :: field
	integer :: i_part, i_flv, pdg, i_corr
	real(default) :: nf, CA_factor, TR_sum
	real(default), dimension(:,:), allocatable :: CF_factor, TR_factor
	type(flavor_t) :: flv
	allocate (CF_factor (size (flv_born, 1), size (flv_born, 2)), &
	TR_factor (size (flv_born, 1), size (flv_born, 2)))
	corr_type (1) = "QCD"; corr_type (2) = "EW"
	do i_corr = 1, 2
	TR_sum = 0
	if (i_corr == 1) then
	CA_factor = CA; CF_factor = CF; TR_factor = TR
	nf = real(nf_input, default)
	TR_sum = nf * TR
	else
	CA_factor = zero
	do i_flv = 1, size (flv_born, 2)
	do i_part = 1, size (flv_born, 1)
	call flv%init (flv_born(i_part, i_flv), model)
	CF_factor(i_part, i_flv) = (flv%get_charge ())**2
	TR_factor(i_part, i_flv) = (flv%get_charge ())**2
	if (is_quark (flv_born (i_part, i_flv))) &
	TR_factor(i_part, i_flv) = NC * TR_factor(i_part, i_flv)
	end do
	end do
	do pdg = 1, nf_input
	field => model%get_field_ptr (pdg)
	TR_sum = TR_sum + NCfield%get_charge()*2
	end do
	do pdg = 11, 15, 2
	field => model%get_field_ptr (pdg)
	if (field%get_mass() > 0) exit
	TR_sum = TR_sum + field%get_charge()**2
	end do
	end if
	do i_flv = 1, size (flv_born, 2)
	do i_part = 1, size (flv_born, 1)
	if (is_massless_vectorboson (flv_born(i_part, i_flv), corr_type (i_corr))) then
	virt%gamma_0(i_part, i_flv, i_corr) = 11._default / 6._default * CA_factor &
	- two / three * TR_sum
	virt%gamma_p(i_part, i_flv, i_corr) = (67._default / 9._default &
	- two * pi*2 / three) CA_factor &
	- 23._default / 9._default * TR_sum
	virt%c_flv(i_part, i_flv, i_corr) = CA_factor
	else if (is_corresponding_fermion (flv_born(i_part, i_flv), corr_type (i_corr))) then
	virt%gamma_0(i_part, i_flv, i_corr) = 1.5_default * CF_factor(i_part, i_flv)
	virt%gamma_p(i_part, i_flv, i_corr) = (6.5_default - two * pi*2 / three) CF_factor(i_part, i_flv)
	virt%c_flv(i_part, i_flv, i_corr) = CF_factor(i_part, i_flv)
	else if (is_massive_vectorboson (flv_born(i_part, i_flv), corr_type (i_corr))) then
	virt%gamma_0(i_part, i_flv, i_corr) = zero
	virt%gamma_p(i_part, i_flv, i_corr) = zero
	virt%c_flv(i_part, i_flv, i_corr) = CF_factor(i_part, i_flv)
	else
	virt%gamma_0(i_part, i_flv, i_corr) = zero
	virt%gamma_p(i_part, i_flv, i_corr) = zero
	virt%c_flv(i_part, i_flv, i_corr) = zero
	end if
	end do
	end do
	end do
	contains
	function is_massless_vectorboson (pdg_nr, nlo_corr_type)
	logical :: is_massless_vectorboson
	integer, intent(in) :: pdg_nr
	type(string_t), intent(in) :: nlo_corr_type
	is_massless_vectorboson = .false.
	if (nlo_corr_type == "QCD") then
	is_massless_vectorboson = is_gluon (pdg_nr)
	else if (nlo_corr_type == "EW") then
	is_massless_vectorboson = is_photon (pdg_nr)
	end if
	end function is_massless_vectorboson
	function is_corresponding_fermion (pdg_nr, nlo_corr_type)
	logical :: is_corresponding_fermion
	integer, intent(in) :: pdg_nr
	type(string_t), intent(in) :: nlo_corr_type
	is_corresponding_fermion = .false.
	if (nlo_corr_type == "QCD") then
	is_corresponding_fermion = is_quark (pdg_nr)
	else if (nlo_corr_type == "EW") then
	is_corresponding_fermion = is_fermion (pdg_nr)
	end if
	end function is_corresponding_fermion
	function is_massive_vectorboson (pdg_nr, nlo_corr_type)
	logical :: is_massive_vectorboson
	integer, intent(in) :: pdg_nr
	type(string_t), intent(in) :: nlo_corr_type
	is_massive_vectorboson = .false.
	if (nlo_corr_type == "EW") then
	is_massive_vectorboson = is_massive_vector (pdg_nr)
	end if
	end function is_massive_vectorboson
	end subroutine virtual_init_constants

	@ %def virtual_init_constants
	@ Set the renormalization scale. If the input is zero, use the
	center-of-mass energy.
	<<Virtual: virtual: TBP>>=
	procedure :: set_ren_scale => virtual_set_ren_scale
	<<Virtual: sub interfaces>>=
	module subroutine virtual_set_ren_scale (virt, ren_scale)
	class(virtual_t), intent(inout) :: virt
	real(default), allocatable, intent(in) :: ren_scale
	end subroutine virtual_set_ren_scale
	<<Virtual: procedures>>=
	module subroutine virtual_set_ren_scale (virt, ren_scale)
	class(virtual_t), intent(inout) :: virt
	real(default), allocatable, intent(in) :: ren_scale
	if (allocated (ren_scale)) then
	if (allocated (virt%ren_scale)) then
	virt%ren_scale = ren_scale
	else
	allocate (virt%ren_scale, source=ren_scale)
	end if
	end if
	end subroutine virtual_set_ren_scale

	@ %def virtual_set_ren_scale
	@
	<<Virtual: virtual: TBP>>=
	procedure :: set_fac_scale => virtual_set_fac_scale
	<<Virtual: sub interfaces>>=
	module subroutine virtual_set_fac_scale (virt, p, fac_scale)
	class(virtual_t), intent(inout) :: virt
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in), optional :: fac_scale
	end subroutine virtual_set_fac_scale
	<<Virtual: procedures>>=
	module subroutine virtual_set_fac_scale (virt, p, fac_scale)
	class(virtual_t), intent(inout) :: virt
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), intent(in), optional :: fac_scale
	if (present (fac_scale)) then
	virt%fac_scale = fac_scale
	else
	virt%fac_scale = (p(1) + p(2))**1
	end if
	end subroutine virtual_set_fac_scale

	@ %def virtual_set_fac_scale
	<<Virtual: virtual: TBP>>=
	procedure :: set_ellis_sexton_scale => virtual_set_ellis_sexton_scale
	<<Virtual: sub interfaces>>=
	module subroutine virtual_set_ellis_sexton_scale (virt, Q)
	class(virtual_t), intent(inout) :: virt
	real(default), allocatable, intent(in) :: Q
	end subroutine virtual_set_ellis_sexton_scale
	<<Virtual: procedures>>=
	module subroutine virtual_set_ellis_sexton_scale (virt, Q)
	class(virtual_t), intent(inout) :: virt
	real(default), allocatable, intent(in) :: Q
	if (allocated (Q)) then
	if (allocated (virt%es_scale2)) then
	virt%es_scale2 = Q * Q
	else
	allocate (virt%es_scale2, source=Q*Q)
	end if
	end if
	end subroutine virtual_set_ellis_sexton_scale

	@ %def virtual_set_ellis_sexton_scale
	@ The virtual-subtracted matrix element is given by the equation
	\begin{equation}
	\label{eqn:virt_sub}
	\mathcal{V} = \frac{\alpha_s}{2\pi}\left(\mathcal{Q}\mathcal{B} +
	\sum \mathcal{I}_{ij}\mathcal{B}_{ij} + \mathcal{V}_{fin}\right),
	\end{equation}
	The expressions for $\mathcal{Q}$ can be found in equations
	\ref{eqn:virt_Q_isr} and \ref{eqn:virt_Q_fsr}.
	The expressions for $\mathcal{I}_{ij}$ can be found in equations
	(\ref{I_00}), (\ref{I_mm}), (\ref{I_0m}), depending on whether the
	particles involved in the radiation process are massive or massless.

	If two or more flavor structures would produce the same amplitude we
	only compute one and use the [[eqv_index]] to copy the result to the
	others (if [[reuse_amplitudes_fks]] is true).

	The Ellis-Sexton scale is set when explicitly allocated; if not it
	first is set to the renormalization scale; if that it is not set it
	will be set to the factorization scale which is the scale used for the
	virtual corrections.
	<<Virtual: virtual: TBP>>=
	procedure :: evaluate => virtual_evaluate
	<<Virtual: sub interfaces>>=
	module subroutine virtual_evaluate (virt, reg_data, alpha_coupling, &
	p_born, separate_uborns, sqme_virt)
	class(virtual_t), intent(inout) :: virt
	type(region_data_t), intent(in) :: reg_data
	real(default), dimension(2), intent(in) :: alpha_coupling
	type(vector4_t), intent(in), dimension(:) :: p_born
	logical, intent(in) :: separate_uborns
	real(default), dimension(:), intent(inout) :: sqme_virt
	end subroutine virtual_evaluate
	<<Virtual: procedures>>=
	module subroutine virtual_evaluate (virt, reg_data, alpha_coupling, &
	p_born, separate_uborns, sqme_virt)
	class(virtual_t), intent(inout) :: virt
	type(region_data_t), intent(in) :: reg_data
	real(default), dimension(2), intent(in) :: alpha_coupling
	type(vector4_t), intent(in), dimension(:) :: p_born
	logical, intent(in) :: separate_uborns
	real(default), dimension(:), intent(inout) :: sqme_virt
	integer, dimension(:), allocatable :: eqv_flv_index
	real(default), dimension(:), allocatable :: sqme_virt_arr
	real(default) :: s, s_o_Q2, es_scale2
	real(default), dimension(reg_data%n_flv_born) :: QB, BI
	integer :: i_flv, ii_flv, alr, i_corr
	logical, dimension(:), allocatable :: flv_evaluated
	integer, dimension(:), allocatable :: corr_index
	logical :: alr_qcd, alr_ew
	allocate (flv_evaluated(reg_data%n_flv_born))
	allocate (sqme_virt_arr(reg_data%n_flv_born))
	sqme_virt_arr = zero
	flv_evaluated = .false.
	if (virt%bad_point) return
	if (allocated (virt%es_scale2)) then
	es_scale2 = virt%es_scale2
	else
	if (allocated (virt%ren_scale)) then
	es_scale2 = virt%ren_scale**2
	else
	es_scale2 = virt%fac_scale**2
	end if
	end if
	if (debug2_active (D_VIRTUAL)) then
	print *, 'Compute virtual component using alpha = ', alpha_coupling
	print *, 'Virtual selection: ', char (virt%selection)
	print *, 'virt%es_scale2 = ', es_scale2 !!! Debugging
	end if
	s = sum (p_born(1 : virt%n_in))**2
	if (virt%settings%factorization_mode == FACTORIZATION_THRESHOLD) &
	call set_s_for_threshold ()
	s_o_Q2 = s / es_scale2 * virt%settings%fks_template%xi_cut**2
	eqv_flv_index = reg_data%eqv_flv_index_born
	do i_flv = 1, reg_data%n_flv_born
	alr_qcd = .false.; alr_ew = .false.
	do alr = 1, reg_data%n_regions
	if (i_flv == reg_data%regions(alr)%uborn_index) then
	if (reg_data%regions(alr)%nlo_correction_type == "QCD") then
	alr_qcd = .true.
	else if (reg_data%regions(alr)%nlo_correction_type == "EW") then
	alr_ew = .true.
	end if
	end if
	end do
	if (alr_qcd .and. alr_ew) then
	allocate (corr_index (2))
	corr_index (1) = 1; corr_index (2) = 2
	else
	allocate (corr_index (1))
	corr_index (1) = 0
	if (alr_qcd) then
	corr_index (1) = 1
	else if (alr_ew) then
	corr_index (1) = 2
	end if
	end if
	if (.not. flv_evaluated(eqv_flv_index(i_flv)) .and. corr_index(1) > 0) then
	if (virt%selection == var_str ("Full") .or. virt%selection == var_str ("OLP")) then
	!!! A factor of alpha_coupling/twopi is assumed to be included in vfin
	sqme_virt_arr(i_flv) = sqme_virt_arr(i_flv) + virt%sqme_virt_fin(i_flv)
	end if
	do i_corr = 1, size (corr_index)
	QB = zero; BI = zero
	if (virt%selection == var_str ("Full") .or. &
	virt%selection == var_str ("Subtraction")) then
	call virt%evaluate_initial_state (i_flv, corr_index (i_corr), reg_data, QB)
	call virt%compute_collinear_contribution &
	(i_flv, corr_index (i_corr), p_born, sqrt(s), reg_data, QB)
	select case (virt%settings%factorization_mode)
	case (FACTORIZATION_THRESHOLD)
	call virt%compute_eikonals_threshold (i_flv, p_born, s_o_Q2, QB, BI)
	case default
	call virt%compute_massive_self_eikonals &
	(i_flv, corr_index (i_corr), p_born, s_o_Q2, reg_data, QB)
	call virt%compute_eikonals &
	(i_flv, corr_index (i_corr), p_born, s_o_Q2, reg_data, BI)
	end select
	if (debug2_active (D_VIRTUAL)) then
	if (corr_index (i_corr) == 1) then
	print *, 'Correction type: QCD'
	else
	print *, 'Correction type: EW'
	end if
	print *, 'Evaluate i_flv: ', i_flv
	print *, 'sqme_born: ', virt%sqme_born (i_flv)
	print , 'Q sqme_born: ', alpha_coupling / twopi * QB(i_flv)
	print , 'BI: ', alpha_coupling / twopi BI(i_flv)
	print *, 'vfin: ', virt%sqme_virt_fin (i_flv)
	end if
	sqme_virt_arr(i_flv) = sqme_virt_arr(i_flv) &
	+ alpha_coupling (corr_index (i_corr))/ twopi * (QB(i_flv) + BI(i_flv))
	end if
	end do
	if (.not. (debug_active (D_VIRTUAL) .or. &
	debug2_active (D_VIRTUAL))) flv_evaluated(eqv_flv_index(i_flv)) = .true.
	else
	sqme_virt_arr(i_flv) = sqme_virt_arr(eqv_flv_index(i_flv))
	end if
	if (separate_uborns) then
	sqme_virt(i_flv) = sqme_virt(i_flv) + sqme_virt_arr(i_flv)
	else
	sqme_virt(1) = sqme_virt(1) + sqme_virt_arr(i_flv)
	end if
	deallocate (corr_index)
	end do
	if (debug2_active (D_VIRTUAL)) then
	call msg_debug2 (D_VIRTUAL, "virtual-subtracted matrix element(s): ")
	print *, sqme_virt
	end if
	do i_flv = 1, reg_data%n_flv_born
	if (virt%n_is_neutrinos(i_flv) > 0) &
	sqme_virt = sqme_virt * virt%n_is_neutrinos(i_flv) * two
	end do
	contains
	subroutine set_s_for_threshold ()
	use ttv_formfactors, only: m1s_to_mpole
	real(default) :: mtop2
	mtop2 = m1s_to_mpole (sqrt(s))**2
	if (s < four * mtop2) s = four * mtop2
	end subroutine set_s_for_threshold

	end subroutine virtual_evaluate

	@ %def virtual_evaluate
	@
	<<Virtual: virtual: TBP>>=
	procedure :: compute_eikonals => virtual_compute_eikonals
	<<Virtual: sub interfaces>>=
	module subroutine virtual_compute_eikonals (virtual, i_flv, i_corr, &
	p_born, s_o_Q2, reg_data, BI)
	class(virtual_t), intent(inout) :: virtual
	integer, intent(in) :: i_flv, i_corr
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in) :: s_o_Q2
	type(region_data_t), intent(in) :: reg_data
	real(default), intent(inout), dimension(:) :: BI
	end subroutine virtual_compute_eikonals
	<<Virtual: procedures>>=
	module subroutine virtual_compute_eikonals (virtual, i_flv, i_corr, &
	p_born, s_o_Q2, reg_data, BI)
	class(virtual_t), intent(inout) :: virtual
	integer, intent(in) :: i_flv, i_corr
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in) :: s_o_Q2
	type(region_data_t), intent(in) :: reg_data
	real(default), intent(inout), dimension(:) :: BI
	integer :: i, j
	real(default) :: I_ij, BI_tmp
	BI_tmp = zero
	! TODO vincent_r: Split the procedure into one computing QCD eikonals
	! and one computing QED eikonals.
	! TODO vincent_r: In the best case, remove the dependency on
	! reg_data completely.
	associate (flst_born => reg_data%flv_born(i_flv))
	do i = 1, virtual%n_legs
	do j = 1, virtual%n_legs
	if (i /= j) then
	if (i_corr == 1) then
	if (flst_born%colored(i) .and. flst_born%colored(j)) then
	I_ij = compute_eikonal_factor &
	(p_born, flst_born%massive, i, j, s_o_Q2)
	BI_tmp = BI_tmp + &
	virtual%sqme_color_c (i, j, i_flv) * I_ij
	if (debug2_active (D_VIRTUAL)) &
	print *, 'b_ij: ', i, j, &
	virtual%sqme_color_c (i, j, i_flv), 'I_ij: ', I_ij
	end if
	else if (i_corr == 2) then
	if (flst_born%charge (i) /= 0 .and. flst_born%charge(j) /= 0) then
	I_ij = compute_eikonal_factor (p_born, flst_born%massive, &
	i, j, s_o_Q2)
	BI_tmp = BI_tmp + virtual%sqme_charge_c (i, j, i_flv) * I_ij
	if (debug2_active (D_VIRTUAL)) &
	print *, 'b_ij: ', &
	virtual%sqme_charge_c (i, j, i_flv), 'I_ij: ', I_ij
	end if
	end if
	else if (debug2_active (D_VIRTUAL)) then
	if (i_corr == 1) then
	print *, 'b_ij: ', i, j, &
	virtual%sqme_color_c (i, j, i_flv), 'I_ij: ', I_ij
	else if (i_corr == 2) then
	print *, 'b_ij: ', i, j, &
	virtual%sqme_charge_c (i, j, i_flv), 'I_ij: ', I_ij
	end if
	end if
	end do
	end do
	if (virtual%settings%use_internal_color_correlations .or. i_corr == 2) &
	BI_tmp = BI_tmp * virtual%sqme_born (i_flv)
	end associate
	BI(i_flv) = BI(i_flv) + BI_tmp
	end subroutine virtual_compute_eikonals

	@ %def virtual_compute_eikonals
	@
	<<Virtual: virtual: TBP>>=
	procedure :: compute_eikonals_threshold => virtual_compute_eikonals_threshold
	<<Virtual: sub interfaces>>=
	module subroutine virtual_compute_eikonals_threshold (virtual, i_flv, &
	p_born, s_o_Q2, QB, BI)
	class(virtual_t), intent(in) :: virtual
	integer, intent(in) :: i_flv
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in) :: s_o_Q2
	real(default), intent(inout), dimension(:) :: QB
	real(default), intent(inout), dimension(:) :: BI
	end subroutine virtual_compute_eikonals_threshold
	<<Virtual: procedures>>=
	module subroutine virtual_compute_eikonals_threshold (virtual, i_flv, &
	p_born, s_o_Q2, QB, BI)
	class(virtual_t), intent(in) :: virtual
	integer, intent(in) :: i_flv
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in) :: s_o_Q2
	real(default), intent(inout), dimension(:) :: QB
	real(default), intent(inout), dimension(:) :: BI
	type(vector4_t), dimension(4) :: p_thr
	integer :: leg
	BI = zero; p_thr = get_threshold_momenta (p_born)
	call compute_massive_self_eikonals (virtual%sqme_born(i_flv), QB(i_flv))
	do leg = 1, 2
	BI(i_flv) = BI(i_flv) + evaluate_leg_pair (ASSOCIATED_LEG_PAIR(leg), i_flv)
	end do
	contains
	subroutine compute_massive_self_eikonals (sqme_born, QB)
	real(default), intent(in) :: sqme_born
	real(default), intent(inout) :: QB
	integer :: i
	if (debug_on) call msg_debug2 (D_VIRTUAL, "compute_massive_self_eikonals")
	if (debug_on) call msg_debug2 (D_VIRTUAL, "s_o_Q2", s_o_Q2)
	if (debug_on) call msg_debug2 (D_VIRTUAL, "log (s_o_Q2)", log (s_o_Q2))
	do i = 1, 4
	QB = QB - (cf * (log (s_o_Q2) - 0.5_default * I_m_eps (p_thr(i)))) &
	* sqme_born
	end do
	end subroutine compute_massive_self_eikonals

	function evaluate_leg_pair (i_start, i_flv) result (b_ij_times_I)
	real(default) :: b_ij_times_I
	integer, intent(in) :: i_start, i_flv
	real(default) :: I_ij
	integer :: i, j
	b_ij_times_I = zero
	do i = i_start, i_start + 1
	do j = i_start, i_start + 1
	if (i /= j) then
	I_ij = compute_eikonal_factor &
	(p_thr, [.true., .true., .true., .true.], i, j, s_o_Q2)
	b_ij_times_I = b_ij_times_I + &
	virtual%sqme_color_c (i, j, i_flv) * I_ij
	if (debug2_active (D_VIRTUAL)) &
	print *, 'b_ij: ', virtual%sqme_color_c (i, j, i_flv), 'I_ij: ', I_ij
	end if
	end do
	end do
	if (virtual%settings%use_internal_color_correlations) &
	b_ij_times_I = b_ij_times_I * virtual%sqme_born (i_flv)
	if (debug2_active (D_VIRTUAL)) then
	print *, 'internal color: ', virtual%settings%use_internal_color_correlations
	print *, 'b_ij_times_I = ', b_ij_times_I
	print *, 'QB = ', QB
	end if
	end function evaluate_leg_pair
	end subroutine virtual_compute_eikonals_threshold

	@ %def virtual_compute_eikonals_threshold
	@
	<<Virtual: virtual: TBP>>=
	procedure :: set_bad_point => virtual_set_bad_point
	<<Virtual: sub interfaces>>=
	module subroutine virtual_set_bad_point (virt, value)
	class(virtual_t), intent(inout) :: virt
	logical, intent(in) :: value
	end subroutine virtual_set_bad_point
	<<Virtual: procedures>>=
	module subroutine virtual_set_bad_point (virt, value)
	class(virtual_t), intent(inout) :: virt
	logical, intent(in) :: value
	virt%bad_point = value
	end subroutine virtual_set_bad_point

	@ %def virtual_set_bad_point
	@ The collinear limit of $\tilde{\mathcal{R}}$ can be integrated over
	the radiation degrees of freedom, giving the collinear contribution to
	the virtual component. Its general structure is $\mathcal{Q} \cdot
	\mathcal{B}$. The initial-state contribution to $\mathcal{Q}$ is
	simply given by
	\begin{equation}
	\label{eqn:virt_Q_isr}
	\mathcal{Q} = -\log\frac{\mu_F^2}{Q^2} \left(\gamma(\mathcal{I}_1) + 2 C
	(\mathcal{I}_1) \log(\xi_{\text{cut}}) + \gamma(\mathcal{I}_2) + 2 C (\mathcal{I}_2)
	\log(\xi_{\text{cut}}) \right),
	\end{equation}
	where $Q^2$ is the Ellis-Sexton scale and $\gamma$ is as in eqns. \ref{eqn:gamma(q)}
	and \ref{eqn:gamma(g)}.\\
	[[virtual_evaluate_initial_state]] computes this quantity. The loop over the
	initial-state particles is only executed if we are
	dealing with a scattering process, because for decays there are no virtual
	initial-initial interactions.
	<<Virtual: virtual: TBP>>=
	procedure :: evaluate_initial_state => virtual_evaluate_initial_state
	<<Virtual: sub interfaces>>=
	module subroutine virtual_evaluate_initial_state &
	(virt, i_flv, i_corr, reg_data, QB)
	class(virtual_t), intent(inout) :: virt
	type(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_flv, i_corr
	real(default), intent(inout), dimension(:) :: QB
	end subroutine virtual_evaluate_initial_state
	<<Virtual: procedures>>=
	module subroutine virtual_evaluate_initial_state &
	(virt, i_flv, i_corr, reg_data, QB)
	class(virtual_t), intent(inout) :: virt
	type(region_data_t), intent(in) :: reg_data
	integer, intent(in) :: i_flv, i_corr
	real(default), intent(inout), dimension(:) :: QB
	real(default) :: sqme_born_virt, es_scale2
	integer :: i
	if (allocated (virt%es_scale2)) then
	es_scale2 = virt%es_scale2
	else
	if (allocated (virt%ren_scale)) then
	es_scale2 = virt%ren_scale**2
	else
	es_scale2 = virt%fac_scale**2
	end if
	end if
	sqme_born_virt = zero
	if (reg_data%nlo_correction_type == "EW" .and. i_corr == 1 &
	.and. qcd_ew_interferences (reg_data%flv_born(i_flv)%flst)) then
	do i = 1, size (reg_data%flv_born(i_flv)%flst)
	if (is_quark (reg_data%flv_born(i_flv)%flst (i))) then
	sqme_born_virt = -virt%sqme_color_c (i, i, i_flv)/CF
	exit
	end if
	end do
	else
	sqme_born_virt = virt%sqme_born (i_flv)
	end if
	if (virt%n_in == 2) then
	do i = 1, virt%n_in
	QB(i_flv) = QB(i_flv) - (virt%gamma_0 (i, i_flv, i_corr) &
	+ two * virt%c_flv(i, i_flv, i_corr) &
	* log (virt%settings%fks_template%xi_cut)) &
	* log(virt%fac_scale*2 / es_scale2) sqme_born_virt
	end do
	end if
	end subroutine virtual_evaluate_initial_state

	@ %def virtual_evaluate_initial_state
	@ Same as above, but for final-state particles. The collinear limit
	for final-state particles follows from the integral
	\begin{equation*}
	I_{+,\alpha_r} = \int d\Phi_{n+1}
	\frac{\xi_+^{-1-2\epsilon}}{\xi^{-1-2\epsilon}}
	\mathcal{R}_{\alpha_r}.
	\end{equation*}
	We can distinguish three situations:
	\begin{enumerate}
	\item $\alpha_r$ contains a massive emitter. In this case, no
	collinear subtraction term is required and the integral above is
	irrelevant.
	\item $\alpha_r$ contains a massless emitter, but resonances are not
	taken into account in the subtraction. Here, $\xi_{max} =
	\frac{2E_{em}}{\sqrt{s}}$ is the upper bound on $\xi$.
	\item $\alpha_r$ contains a massless emitter and resonance-aware
	subtraction is used. Here, $\xi_{max} =
	\frac{2E_{em}}{\sqrt{k_{res}^2}}$.
	\end{enumerate}
	Before version 2.4, only situations 1 and 2 were covered. The
	difference between situation 2 and 3 comes from the expansion of the
	plus-distribution in the integral above,
	\begin{equation*}
	\xi_+^{-1-2\epsilon} = \xi^{-1-2\epsilon} +
	\frac{1}{2\epsilon}\delta(\xi) =
	\xi_{max}^{-1-2\epsilon}\left[(1-z)^{-1-2\epsilon} +
	\frac{\xi_{max}^{2\epsilon}}{2\epsilon}\delta(1-z)\right].
	\end{equation*}
	The expression from the standard FKS literature is given by
	$\mathcal{Q}$ is given by
	\begin{equation}
	\label{eqn:virt_Q_fsr_old}
	\begin{split}
	\mathcal{Q} = \sum_{k=n_{in}}^{n_L^{(B)}} \left[\gamma'(\mathcal{I}_k)
	- \log\frac{s\delta_o}{2Q^2}\left(\gamma(\mathcal{I}_k)
	- 2C(\mathcal{I}_k)
	\log\frac{2E_k}{\xi_{\text{cut}}\sqrt{s}}\right) \right.\\
	+ \left. 2C(\mathcal{I}_k) \left( \log^2\frac{2E_k}{\sqrt{s}} -
	\log^2 \xi_{\text{cut}} \right)
	- 2\gamma(\mathcal{I}_k)\log\frac{2E_k}{\sqrt{s}}\right].
	\end{split}
	\end{equation}
	$n_L^{(B)}$ is the number of legs at Born level. Here, $\xi_{max}$ is
	implicitly present in the ratios in the logarithms. Using the
	resonance-aware $\xi_{max}$ yields
	\begin{equation}
	\label{eqn:virt_Q_fsr}
	\begin{split}
	\mathcal{Q} = \sum_{k=n_{in}}^{n_L^{(B)}} \left[\gamma'(\mathcal{I}_k)
	+ 2\left(\log\frac{\sqrt{s}}{2E_{em}} + \log\xi_{max}\right)
	\left(\log\frac{\sqrt{s}}{2E_{em}} + \log\xi_{max} +
	\log\frac{Q^2}{s}\right) C(\mathcal{I}_k) \right.\\
	+ \left. 2 \log\xi_{max} \left(\log\xi_{max} -
	\log\frac{Q^2}{k_{res}^2}\right) C(\mathcal{I}_k)
	+ \left(\log\frac{Q^2}{k_{res}^2} - 2 \log\xi_{max}\right)
	\gamma(\mathcal{I}_k)\right].
	\end{split}
	\end{equation}
	Equation \ref{eqn:virt_Q_fsr} leads to \ref{eqn:virt_Q_fsr_old} with
	the substitutions $\xi_{max} \rightarrow \frac{2E_{em}}{\sqrt{s}}$ and
	$k_{res}^2 \rightarrow s$. [[virtual_compute_collinear_contribution]]
	only implements the second one.
	<<Virtual: virtual: TBP>>=
	procedure :: compute_collinear_contribution &
	=> virtual_compute_collinear_contribution
	<<Virtual: sub interfaces>>=
	module subroutine virtual_compute_collinear_contribution &
	(virt, i_flv, i_corr, p_born, sqrts, reg_data, QB)
	class(virtual_t), intent(inout) :: virt
	integer, intent(in) :: i_flv, i_corr
	type(vector4_t), dimension(:), intent(in) :: p_born
	real(default), intent(in) :: sqrts
	type(region_data_t), intent(in) :: reg_data
	real(default), intent(inout), dimension(:) :: QB
	end subroutine virtual_compute_collinear_contribution
	<<Virtual: procedures>>=
	module subroutine virtual_compute_collinear_contribution &
	(virt, i_flv, i_corr, p_born, sqrts, reg_data, QB)
	class(virtual_t), intent(inout) :: virt
	integer, intent(in) :: i_flv, i_corr
	type(vector4_t), dimension(:), intent(in) :: p_born
	real(default), intent(in) :: sqrts
	type(region_data_t), intent(in) :: reg_data
	real(default), intent(inout), dimension(:) :: QB
	real(default) :: s1, s2, s3, s4, s5
	real(default) :: sqme_born_virt
	integer :: alr, em, i
	real(default) :: E_em, xi_max, log_xi_max, E_tot2, es_scale2
	logical, dimension(virt%n_flv, virt%n_legs) :: evaluated
	integer :: i_contr
	type(vector4_t) :: k_res
	type(lorentz_transformation_t) :: L_to_resonance
	evaluated = .false.
	if (allocated (virt%es_scale2)) then
	es_scale2 = virt%es_scale2
	else
	if (allocated (virt%ren_scale)) then
	es_scale2 = virt%ren_scale**2
	else
	es_scale2 = virt%fac_scale**2
	end if
	end if
	sqme_born_virt = zero
	if (reg_data%nlo_correction_type == "EW" .and. i_corr == 1 &
	.and. qcd_ew_interferences (reg_data%flv_born(i_flv)%flst)) then
	do i = 1, size (reg_data%flv_born(i_flv)%flst)
	if (is_quark (reg_data%flv_born(i_flv)%flst (i))) then
	sqme_born_virt = -virt%sqme_color_c (i, i, i_flv)/CF
	exit
	end if
	end do
	else
	sqme_born_virt = virt%sqme_born (i_flv)
	end if
	do alr = 1, reg_data%n_regions
	if (i_flv /= reg_data%regions(alr)%uborn_index) cycle
	em = reg_data%regions(alr)%emitter
	if (em <= virt%n_in) cycle
	if (evaluated(i_flv, em)) cycle
	!!! Collinear terms only for massless particles
	if (reg_data%regions(alr)%flst_uborn%massive(em)) cycle
	E_em = p_born(em)%p(0)
	if (allocated (reg_data%alr_contributors)) then
	i_contr = reg_data%alr_to_i_contributor (alr)
	k_res = get_resonance_momentum (p_born, reg_data%alr_contributors(i_contr)%c)
	E_tot2 = k_res%p(0)**2
	L_to_resonance = inverse (boost (k_res, k_res**1))
	xi_max = two * space_part_norm (L_to_resonance * p_born(em)) / k_res%p(0)
	else
	E_tot2 = sqrts**2
	xi_max = two * E_em / sqrts
	end if
	log_xi_max = log (xi_max)
	associate (xi_cut => virt%settings%fks_template%xi_cut, delta_o => virt%settings%fks_template%delta_o)
	if (virt%settings%virtual_resonance_aware_collinear) then
	if (debug_active (D_VIRTUAL)) &
	call msg_debug (D_VIRTUAL, "Using resonance-aware collinear subtraction")
	s1 = virt%gamma_p(em, i_flv, i_corr)
	s2 = two * (log (sqrts / (two * E_em)) + log_xi_max) * &
	(log (sqrts / (two * E_em)) + log_xi_max + log (es_scale2 / sqrts**2)) &
	* virt%c_flv(em, i_flv, i_corr)
	s3 = two * log_xi_max * &
	(log_xi_max - log (es_scale2 / E_tot2)) * virt%c_flv(em, i_flv, i_corr)
	s4 = (log (es_scale2 / E_tot2) - two * log_xi_max) &
	* virt%gamma_0(em, i_flv, i_corr)
	QB(i_flv) = QB(i_flv) + (s1 + s2 + s3 + s4) * sqme_born_virt
	else
	if (debug_active (D_VIRTUAL)) &
	call msg_debug (D_VIRTUAL, "Using old-fashioned collinear subtraction")
	s1 = virt%gamma_p(em, i_flv, i_corr)
	s2 = log (delta_o * sqrts*2 / (two es_scale2)) &
	* virt%gamma_0(em,i_flv, i_corr)
	s3 = log (delta_o * sqrts*2 / (two es_scale2)) * two &
	* virt%c_flv(em,i_flv, i_corr) * log (two * E_em / (xi_cut * sqrts))
	! s4 = two * virt%c_flv(em,i_flv, i_corr) * (log (two * E_em / sqrts)2 - log (xi_cut)2)
	s4 = two * virt%c_flv(em,i_flv, i_corr) * & ! a2 - b2 = (a - b) * (a + b), for better numerical performance
	(log (two * E_em / sqrts) + log (xi_cut)) * (log (two * E_em / sqrts) - log (xi_cut))
	s5 = two * virt%gamma_0(em,i_flv, i_corr) * log (two * E_em / sqrts)
	QB(i_flv) = QB(i_flv) + (s1 - s2 + s3 + s4 - s5) * sqme_born_virt
	end if
	end associate
	evaluated(i_flv, em) = .true.
	end do
	end subroutine virtual_compute_collinear_contribution

	@ %def virtual_compute_collinear_contribution
	@ For the massless-massive case and $i = j$ we get the massive
	self-eikonal of (A.10) in arXiv:0908.4272, given as
	\begin{equation}
	\mathcal{I}_{ii} = \log \frac{\xi^2_{\text{cut}}s}{Q^2} -
	\frac{1}{\beta} \log \frac{1 + \beta}{1 - \beta}.
	\end{equation}
	<<Virtual: virtual: TBP>>=
	procedure :: compute_massive_self_eikonals => &
	virtual_compute_massive_self_eikonals
	<<Virtual: sub interfaces>>=
	module subroutine virtual_compute_massive_self_eikonals (virt, &
	i_flv, i_corr, p_born, s_over_Q2, reg_data, QB)
	class(virtual_t), intent(inout) :: virt
	integer, intent(in) :: i_flv, i_corr
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in) :: s_over_Q2
	type(region_data_t), intent(in) :: reg_data
	real(default), intent(inout), dimension(:) :: QB
	end subroutine virtual_compute_massive_self_eikonals
	<<Virtual: procedures>>=
	module subroutine virtual_compute_massive_self_eikonals (virt, &
	i_flv, i_corr, p_born, s_over_Q2, reg_data, QB)
	class(virtual_t), intent(inout) :: virt
	integer, intent(in) :: i_flv, i_corr
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in) :: s_over_Q2
	type(region_data_t), intent(in) :: reg_data
	real(default), intent(inout), dimension(:) :: QB
	real(default) :: sqme_born_virt
	integer :: i
	logical :: massive
	sqme_born_virt = zero
	if (reg_data%nlo_correction_type == "EW" .and. i_corr == 1 &
	.and. qcd_ew_interferences (reg_data%flv_born(i_flv)%flst)) then
	do i = 1, size (reg_data%flv_born(i_flv)%flst)
	if (is_quark (reg_data%flv_born(i_flv)%flst (i))) then
	sqme_born_virt = -virt%sqme_color_c (i, i, i_flv)/CF
	exit
	end if
	end do
	else
	sqme_born_virt = virt%sqme_born (i_flv)
	end if
	do i = 1, virt%n_legs
	massive = reg_data%flv_born(i_flv)%massive(i)
	if (massive) then
	if (virt%c_flv (i, i_flv, i_corr) /= 0) then
	QB(i_flv) = QB(i_flv) - (virt%c_flv (i, i_flv, i_corr) &
	* (log (s_over_Q2) - 0.5_default * I_m_eps (p_born(i)))) &
	* sqme_born_virt
	end if
	end if
	end do
	end subroutine virtual_compute_massive_self_eikonals

	@ %def virtual_compute_massive_self_eikonals
	@ The following code implements the $\mathcal{I}_{ij}$-function.
	The complete formulas can be found in arXiv:0908.4272 (A.1-A.17) and are also discussed in arXiv:1002.2581 in Appendix A.
	The implementation may differ in the detail from the formulas presented in the above paper.
	The parameter $\xi_{\text{cut}}$ is unphysically and cancels with appropriate factors in the real subtraction.
	We keep the additional parameter for debug usage.
	The implemented formulas are then defined as follows:
	\begin{itemize}
	\item[massless-massless case]
	$p^2 = 0, k^2 = 0,$
	\begin{equation}
	\begin{split}
	\mathcal{I}_{ij} &= \frac{1}{2}\log^2\frac{\xi^2_{\text{cut}}s}{Q^2} + \log\frac{\xi^2_{\text{cut}}s}{Q^2}\log\frac{k_ik_j}{2E_iE_j} - \rm{Li}_2\left(\frac{k_ik_j}{2E_iE_j}\right) \\
	&+ \frac{1}{2}\log^2\frac{k_ik_j}{2E_iE_j} - \log\left(1-\frac{k_ik_j}{2E_iE_j}\right) \log\frac{k_ik_j}{2E_iE_j}.
	\end{split}
	\label{I_00}
	\end{equation}
	\item[massive-massive case]
	$p^2 \neq 0, k^2 \neq 0,$
	\begin{equation}
	\mathcal{I}_{ij} = \frac{1}{2}I_0(k_i, k_j)\log\frac{\xi^2_{\text{cut}}s}{Q^2} - \frac{1}{2}I_\epsilon(k_i,k_j)
	\label{I_mm}
	\end{equation}
	with
	\begin{equation}
	I_0(k_i, k_j) = \frac{1}{\beta}\log\frac{1+\beta}{1-\beta}, \qquad \beta = \sqrt{1-\frac{k_i^2k_j^2}{(k_i \cdot k_j)^2}}
	\end{equation}
	and a rather involved expression for $I_\epsilon$:
	\begin{align}
	\allowdisplaybreaks
	I_\epsilon(k_i, k_j) &= \left(K(z_j)-K(z_i)\right) \frac{1-\vec{\beta_i}\cdot\vec{\beta_j}}{\sqrt{a(1-b)}}, \\
	\vec{\beta_i} &= \frac{\vec{k}_i}{k_i^0}, \\
	a &= \beta_i^2 + \beta_j^2 - 2\vec{\beta}_i \cdot \vec{\beta}_j, \\
	x_i &= \frac{\beta_i^2 -\vec{\beta}_i \cdot \vec{\beta}_j}{a}, \\
	x_j &= \frac{\beta_j^2 -\vec{\beta}_i \cdot \vec{\beta}_j}{a} = 1-x_j, \\
	b &= \frac{\beta_i^2\beta_j^2 - (\vec{\beta}_i\cdot\vec{\beta}_j)^2}{a}, \\
	c &= \sqrt{\frac{b}{4a}}, \\
	z_+ &= \frac{1+\sqrt{1-b}}{\sqrt{b}}, \\
	z_- &= \frac{1-\sqrt{1-b}}{\sqrt{b}}, \\
	z_i &= \frac{\sqrt{x_i^2 + 4c^2} - x_i}{2c}, \\
	z_j &= \frac{\sqrt{x_j^2 + 4c^2} + x_j}{2c}, \\
	K(z) = &-\frac{1}{2}\log^2\frac{(z-z_-)(z_+-z)}{(z_++z)(z_-+z)} - 2Li_2\left(\frac{2z_-(z_+-z)}{(z_+-z_-)(z_-+z)}\right) \\
	&-2Li_2\left(-\frac{2z_+(z_-+z)}{(z_+-z_-)(z_+-z)}\right)
	\end{align}

	\item[massless-massive case]
	$p^2 = 0, k^2 \neq 0,$
	\begin{equation}
	\mathcal{I}_{ij} = \frac{1}{2}\left[\frac{1}{2}\log^2\frac{\xi^2_{\text{cut}}s}{Q^2} - \frac{\pi^2}{6}\right] + \frac{1}{2}I_0(k_i,k_j)\log\frac{\xi^2_{\text{cut}}s}{Q^2} - \frac{1}{2}I_\epsilon(k_i,k_j)
	\label{I_0m}
	\end{equation}
	with
	\begin{align}
	I_0(p,k) &= \log\frac{(\hat{p}\cdot\hat{k})^2}{\hat{k}^2}, \\
	I_\varepsilon(p,k) &= -2\left[\frac{1}{4}\log^2\frac{1-\beta}{1+\beta} + \log\frac{\hat{p}\cdot\hat{k}}{1+\beta}\log\frac{\hat{p}\cdot\hat{k}}{1-\beta} + \rm{Li}_2\left(1-\frac{\hat{p}\cdot\hat{k}}{1+\beta}\right) + \rm{Li}_2\left(1-\frac{\hat{p}\cdot\hat{k}}{1-\beta}\right)\right],
	\end{align}
	using
	\begin{align}
	\hat{p} = \frac{p}{p^0}, \quad \hat{k} = \frac{k}{k^0}, \quad \beta = \frac{\|\vec{k}\|}{k_0}, \\
	\rm{Li}_2(1 - x) + \rm{Li}_2(1 - x^{-1}) = -\frac{1}{2} \log^2 x.
	\end{align}

	\end{itemize}

	<<Virtual: procedures>>=
	function compute_eikonal_factor (p_born, massive, i, j, s_o_Q2) result (I_ij)
	real(default) :: I_ij
	type(vector4_t), intent(in), dimension(:) :: p_born
	logical, dimension(:), intent(in) :: massive
	integer, intent(in) :: i, j
	real(default), intent(in) :: s_o_Q2
	if (massive(i) .and. massive(j)) then
	I_ij = compute_Imm (p_born(i), p_born(j), s_o_Q2)
	else if (.not. massive(i) .and. massive(j)) then
	I_ij = compute_I0m (p_born(i), p_born(j), s_o_Q2)
	else if (massive(i) .and. .not. massive(j)) then
	I_ij = compute_I0m (p_born(j), p_born(i), s_o_Q2)
	else
	I_ij = compute_I00 (p_born(i), p_born(j), s_o_Q2)
	end if
	end function compute_eikonal_factor

	function compute_I00 (pi, pj, s_o_Q2) result (I)
	type(vector4_t), intent(in) :: pi, pj
	real(default), intent(in) :: s_o_Q2
	real(default) :: I
	real(default) :: Ei, Ej
	real(default) :: pij, Eij
	real(default) :: s1, s2, s3, s4, s5
	real(default) :: arglog
	real(default), parameter :: tiny_value = epsilon(1.0)
	s1 = 0; s2 = 0; s3 = 0; s4 = 0; s5 = 0
	Ei = pi%p(0); Ej = pj%p(0)
	pij = pi * pj; Eij = Ei * Ej
	s1 = 0.5_default * log(s_o_Q2)**2
	s2 = log(s_o_Q2) * log(pij / (two * Eij))
	s3 = Li2 (pij / (two * Eij))
	s4 = 0.5_default * log (pij / (two * Eij))**2
	arglog = one - pij / (two * Eij)
	if (arglog > tiny_value) then
	s5 = log(arglog) * log(pij / (two * Eij))
	else
	s5 = zero
	end if
	I = s1 + s2 - s3 + s4 - s5
	end function compute_I00

	function compute_I0m (ki, kj, s_o_Q2) result (I)
	type(vector4_t), intent(in) :: ki, kj
	real(default), intent(in) :: s_o_Q2
	real(default) :: I
	real(default) :: logsomu
	real(default) :: s1, s2, s3
	s1 = 0; s2 = 0; s3 = 0
	logsomu = log(s_o_Q2)
	s1 = 0.5 * (0.5 * logsomu2 - pi2 / 6)
	s2 = 0.5 * I_0m_0 (ki, kj) * logsomu
	s3 = 0.5 * I_0m_eps (ki, kj)
	I = s1 + s2 - s3
	end function compute_I0m

	function compute_Imm (pi, pj, s_o_Q2) result (I)
	type(vector4_t), intent(in) :: pi, pj
	real(default), intent(in) :: s_o_Q2
	real(default) :: I
	real(default) :: s1, s2
	s1 = 0.5 * log(s_o_Q2) * I_mm_0(pi, pj)
	s2 = 0.5 * I_mm_eps(pi, pj)
	I = s1 - s2
	end function compute_Imm

	function I_m_eps (p) result (I)
	type(vector4_t), intent(in) :: p
	real(default) :: I
	real(default) :: beta
	beta = space_part_norm (p)/p%p(0)
	if (beta < tiny_07) then
	I = four * (one + beta2/3 + beta4/5 + beta**6/7)
	else
	I = two * log((one + beta) / (one - beta)) / beta
	end if
	end function I_m_eps

	function I_0m_eps (p, k) result (I)
	type(vector4_t), intent(in) :: p, k
	real(default) :: I
	type(vector4_t) :: pp, kp
	real(default) :: beta

	pp = p / p%p(0); kp = k / k%p(0)

	beta = sqrt (one - kp*kp)
	I = -2(log((one - beta) / (one + beta))2/4 + log((ppkp) / (one + beta))log((ppkp) / (one - beta)) &
	+ Li2(one - (ppkp) / (one + beta)) + Li2(one - (ppkp) / (one - beta)))
	end function I_0m_eps

	function I_0m_0 (p, k) result (I)
	type(vector4_t), intent(in) :: p, k
	real(default) :: I
	type(vector4_t) :: pp, kp

	pp = p / p%p(0); kp = k / k%p(0)
	I = log((ppkp)2 / kp*2)
	end function I_0m_0

	function I_mm_eps (p1, p2) result (I)
	type(vector4_t), intent(in) :: p1, p2
	real(default) :: I
	type(vector4_t) :: q1, q2
	type(vector3_t) :: beta1, beta2
	real(default) :: a, b
	real(default) :: zp, zm, z1, z2, x1, x2
	real(default) :: zmb, z1b
	real(default) :: K1, K2, b1, b2
	real(default) :: nu, a_kl, m12, m22
	beta1 = space_part (p1) / energy(p1)
	beta2 = space_part (p2) / energy(p2)
	if (min (one - beta11, one - beta21) < tiny_07) then
	if (beta11 < beta21) then
	call switch_beta (beta1, beta2)
	q1 = p2
	q2 = p1
	else
	q1 = p1
	q2 = p2
	end if
	b1 = beta1**1
	b2 = beta2**1
	m12 = q1**2
	m22 = q2**2
	a_kl = ((q1q2) + sqrt((q1q2)2 - q12q2*2))/m12
	nu = (a_kl*2 m12 - m22) / two / (a_kl * p1%p(0) - q2%p(0))
	K1 = 0.5_default * log ((one - b1) / (one + b1))**2 &
	+ two * Li2 (one - (one - b1)(a_klq1%p(0)/nu)) &
	+ two * Li2 (one - (one + b1)(a_klq1%p(0)/nu))
	K2 = 0.5_default * log((one - b2) / (one + b2))**2 &
	+ two * Li2 (one - (one - b2)*(q2%p(0)/nu)) &
	+ two * Li2 (one - (one + b2)*(q2%p(0)/nu))
	I = (K2 - K1) / sqrt(one - m12m22/(q1q2)**2)
	else
	a = beta12 + beta22 - 2 * beta1 * beta2
	b = beta1*2 beta2*2 - (beta1 beta2)**2
	if (beta11 > beta21) call switch_beta (beta1, beta2)
	b2 = beta2**1
	if (beta1 == vector3_null) then
	I = (-0.5 * log ((one - b2) / (one + b2))*2 - two Li2 (-two * b2 / (one - b2))) &
	* one / sqrt (a - b)
	return
	end if
	x1 = beta1*2 - beta1 beta2
	x2 = beta2*2 - beta1 beta2
	zp = sqrt (a) + sqrt (a - b)
	zm = sqrt (a) - sqrt (a - b)
	zmb = one / zp
	z1 = sqrt (x1**2 + b) - x1
	z2 = sqrt (x2**2 + b) + x2
	z1b = one / (sqrt (x1**2 + b) + x1)
	K1 = - 0.5_default * log (((z1b - zmb) * (zp - z1)) / ((zp + z1) * (z1b + zmb)))**2 &
	- two * Li2 ((two * zmb * (zp - z1)) / ((zp - zm) * (zmb + z1b))) &
	- two * Li2 ((-two * zp * (zm + z1)) / ((zp - zm) * (zp - z1)))
	K2 = - 0.5_default * log ((( z2 - zm) * (zp - z2)) / ((zp + z2) * (z2 + zm)))**2 &
	- two * Li2 ((two * zm * (zp - z2)) / ((zp - zm) * (zm + z2))) &
	- two * Li2 ((-two * zp * (zm + z2)) / ((zp - zm) * (zp - z2)))
	I = (K2 - K1) * (one - beta1 * beta2) / sqrt (a - b)
	end if
	contains
	subroutine switch_beta (beta1, beta2)
	type(vector3_t), intent(inout) :: beta1, beta2
	type(vector3_t) :: beta_tmp
	beta_tmp = beta1
	beta1 = beta2
	beta2 = beta_tmp
	end subroutine switch_beta
	end function I_mm_eps

	function I_mm_0 (k1, k2) result (I)
	type(vector4_t), intent(in) :: k1, k2
	real(default) :: I
	real(default) :: beta, kquotient
	kquotient = k1*2 k2*2 / (k1 k2)**2
	if (kquotient > tiny_13) then
	beta = sqrt (one - kquotient)
	I = log ((one + beta) / (one - beta)) / beta
	else
	beta = one - kquotient / two
	I = log (two * (one + beta) / kquotient) / beta
	end if
	end function I_mm_0

	@ %def I_mm_0
	@
	<<Virtual: virtual: TBP>>=
	procedure :: final => virtual_final
	<<Virtual: sub interfaces>>=
	module subroutine virtual_final (virtual)
	class(virtual_t), intent(inout) :: virtual
	end subroutine virtual_final
	<<Virtual: procedures>>=
	module subroutine virtual_final (virtual)
	class(virtual_t), intent(inout) :: virtual
	if (allocated (virtual%gamma_0)) deallocate (virtual%gamma_0)
	if (allocated (virtual%gamma_p)) deallocate (virtual%gamma_p)
	if (allocated (virtual%c_flv)) deallocate (virtual%c_flv)
	if (allocated (virtual%n_is_neutrinos)) deallocate (virtual%n_is_neutrinos)
	end subroutine virtual_final

	@ %def virtual_final
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Real Subtraction}
	<<[[real_subtraction.f90]]>>=
	<<File header>>

	module real_subtraction

	<<Use kinds with double>>
	<<Use strings>>
	use physics_defs
	use lorentz
	use flavors
	use phs_fks, only: real_kinematics_t, isr_kinematics_t
	use phs_fks, only: I_PLUS, I_MINUS
	use phs_fks, only: SQRTS_VAR, SQRTS_FIXED
	use phs_fks, only: phs_point_set_t

	use fks_regions
	use nlo_data

	<<Standard module head>>

	<<Real subtraction: public>>

	<<Real subtraction: parameters>>

	<<Real subtraction: types>>

	<<Real subtraction: interfaces>>

	interface
	<<Real subtraction: sub interfaces>>
	end interface

	end module real_subtraction
	@ %def real_subtraction
	@
	<<[[real_subtraction_sub.f90]]>>=
	<<File header>>

	submodule (real_subtraction) real_subtraction_s

	<<Use debug>>
	use io_units
	use format_defs, only: FMT_15
	use string_utils
	use constants
	use numeric_utils
	use diagnostics
	use pdg_arrays
	use sm_physics
	use models
	use ttv_formfactors, only: m1s_to_mpole

	implicit none

	contains

	<<Real subtraction: procedures>>

	end submodule real_subtraction_s

	@ %def real_subtraction_s
	@
	\subsubsection{Soft subtraction terms}
	<<Real subtraction: parameters>>=
	integer, parameter, public :: INTEGRATION = 0
	integer, parameter, public :: FIXED_ORDER_EVENTS = 1

	@ %def real subtraction parameters
	@ Translates the NLO purpose into a string. However, this purpose is
	never set and this routine is nowhere used.
	<<Real subtraction: procedures>>=
	function nlo_purpose (purpose) result (of_purpose)
	type(string_t) :: of_purpose
	integer, intent(in) :: purpose
	select case (purpose)
	case (INTEGRATION)
	of_purpose = var_str ("Integration")
	case (FIXED_ORDER_EVENTS)
	of_purpose = var_str ("Fixed order NLO events")
	case default
	of_purpose = var_str ("Undefined!")
	end select
	end function nlo_purpose

	@ %def nlo_purpose
	@
	In the soft limit, the real matrix element behaves as
	\begin{equation*}
	\mathcal{R}_{\rm{soft}} = 4\pi\alpha_s \left[\sum_{i \neq j}
	\mathcal{B}_{ij} \frac{k_i \cdot k_j}{(k_i \cdot k)(k_j \cdot k)}
	- \mathcal{B} \sum_{i} \frac{k_i^2}{(k_i \cdot k)^2}C_i\right],
	\end{equation*}
	where $k$ denotes the momentum of the emitted parton. The quantity $\mathcal{B}_{ij}$ is called the color-correlated Born matrix element defined as
	\begin{equation*}
	\mathcal{B}_{ij} = \frac{1}{2s} \sum_{\stackrel{colors}{spins}} \mathcal{M}_{\{c_k\}}\left(\mathcal{M}^\dagger_{\{c_k\}}\right)_{\stackrel{c_i \rightarrow c_i'}{c_j \rightarrow c_j'}} T^a_{c_i,c_i'} T^a_{c_j,c_j'}.
	\end{equation*}
	<<Real subtraction: types>>=
	type :: soft_subtraction_t
	type(region_data_t), pointer :: reg_data => null ()
	real(default), dimension(:,:), allocatable :: momentum_matrix
	logical :: use_resonance_mappings = .false.
	type(vector4_t) :: p_soft = vector4_null
	logical :: use_internal_color_correlations = .true.
	logical :: use_internal_spin_correlations = .false.
	logical :: xi2_expanded = .true.
	integer :: factorization_mode = NO_FACTORIZATION
	contains
	<<Real subtraction: soft sub: TBP>>
	end type soft_subtraction_t

	@ %def soft_subtraction_t
	@
	<<Real subtraction: soft sub: TBP>>=
	procedure :: init => soft_subtraction_init
	<<Real subtraction: sub interfaces>>=
	module subroutine soft_subtraction_init (sub_soft, reg_data)
	class(soft_subtraction_t), intent(inout) :: sub_soft
	type(region_data_t), intent(in), target :: reg_data
	end subroutine soft_subtraction_init
	<<Real subtraction: procedures>>=
	module subroutine soft_subtraction_init (sub_soft, reg_data)
	class(soft_subtraction_t), intent(inout) :: sub_soft
	type(region_data_t), intent(in), target :: reg_data
	sub_soft%reg_data => reg_data
	allocate (sub_soft%momentum_matrix (reg_data%n_legs_born, &
	reg_data%n_legs_born))
	end subroutine soft_subtraction_init

	@ %def soft_subtraction_init
	@
	<<Real subtraction: soft sub: TBP>>=
	procedure :: requires_boost => soft_subtraction_requires_boost
	<<Real subtraction: sub interfaces>>=
	module function soft_subtraction_requires_boost &
	(sub_soft, sqrts) result (requires_boost)
	logical :: requires_boost
	class(soft_subtraction_t), intent(in) :: sub_soft
	real(default), intent(in) :: sqrts
	end function soft_subtraction_requires_boost
	<<Real subtraction: procedures>>=
	module function soft_subtraction_requires_boost &
	(sub_soft, sqrts) result (requires_boost)
	logical :: requires_boost
	class(soft_subtraction_t), intent(in) :: sub_soft
	real(default), intent(in) :: sqrts
	real(default) :: mtop
	logical :: above_threshold
	if (sub_soft%factorization_mode == FACTORIZATION_THRESHOLD) then
	mtop = m1s_to_mpole (sqrts)
	above_threshold = sqrts*2 - four mtop**2 > zero
	else
	above_threshold = .false.
	end if
	requires_boost = sub_soft%use_resonance_mappings .or. above_threshold
	end function soft_subtraction_requires_boost

	@ %def soft_subtraction_requires_boost
	@ The treatment of the momentum $k$ follows the discussion about the
	soft limit of the partition functions (see [1002.2581], p. 29 and
	C. Weiss' PhD Thesis, p. 24). The parton momentum is
	pulled out, $k = E \hat{k}$. In fact, we will substitute $\hat{k}$ for
	$k$ throughout the code, because the energy will factor out of the
	equation when the soft $\mathcal{S}$-function is multiplied. The
	momentum [[p_soft]] represents the soft limit of the radiated particle
	divided by its energy. It is a unit vector, because
	$k^2 = \left(k^0\right)^2 - \left(k^0\right)^2\hat{\vec{k}}^2 = 0$.

	The soft momentum is constructed by first creating a unit vector
	parallel to the emitter's Born momentum. This unit vector is then
	rotated about the corresponding angles $y$ and $\phi$ to match
	the direction of the real radiation in the soft limit.
	<<Real subtraction: soft sub: TBP>>=
	procedure :: create_softvec_fsr => soft_subtraction_create_softvec_fsr
	<<Real subtraction: sub interfaces>>=
	module subroutine soft_subtraction_create_softvec_fsr &
	(sub_soft, p_born, y, phi, emitter, xi_ref_momentum)
	class(soft_subtraction_t), intent(inout) :: sub_soft
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in) :: y, phi
	integer, intent(in) :: emitter
	type(vector4_t), intent(in) :: xi_ref_momentum
	end subroutine soft_subtraction_create_softvec_fsr
	<<Real subtraction: procedures>>=
	module subroutine soft_subtraction_create_softvec_fsr &
	(sub_soft, p_born, y, phi, emitter, xi_ref_momentum)
	class(soft_subtraction_t), intent(inout) :: sub_soft
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in) :: y, phi
	integer, intent(in) :: emitter
	type(vector4_t), intent(in) :: xi_ref_momentum
	type(vector3_t) :: dir
	type(vector4_t) :: p_em
	type(lorentz_transformation_t) :: rot
	type(lorentz_transformation_t) :: boost_to_rest_frame
	logical :: requires_boost
	associate (p_soft => sub_soft%p_soft)
	p_soft%p(0) = one
	requires_boost = sub_soft%requires_boost (two * p_born(1)%p(0))
	if (requires_boost) then
	boost_to_rest_frame = inverse (boost (xi_ref_momentum, xi_ref_momentum**1))
	p_em = boost_to_rest_frame * p_born(emitter)
	else
	p_em = p_born(emitter)
	end if
	p_soft%p(1:3) = p_em%p(1:3) / space_part_norm (p_em)
	dir = create_orthogonal (space_part (p_em))
	rot = rotation (y, sqrt(one - y**2), dir)
	p_soft = rot * p_soft
	if (.not. vanishes (phi)) then
	dir = space_part (p_em) / space_part_norm (p_em)
	rot = rotation (cos(phi), sin(phi), dir)
	p_soft = rot * p_soft
	end if
	if (requires_boost) p_soft = inverse (boost_to_rest_frame) * p_soft
	end associate
	end subroutine soft_subtraction_create_softvec_fsr

	@ %def soft_subtraction_create_softvec_fsr
	@ For initial-state emissions, the soft vector is just a unit vector
	with the same direction as the radiated particle.
	As $y$ for ISR is defined independently of the emitter, also [[p_soft]]
	is the same for all initial state emitters.
	<<Real subtraction: soft sub: TBP>>=
	procedure :: create_softvec_isr => soft_subtraction_create_softvec_isr
	<<Real subtraction: sub interfaces>>=
	module subroutine soft_subtraction_create_softvec_isr (sub_soft, y, phi)
	class(soft_subtraction_t), intent(inout) :: sub_soft
	real(default), intent(in) :: y, phi
	end subroutine soft_subtraction_create_softvec_isr
	<<Real subtraction: procedures>>=
	module subroutine soft_subtraction_create_softvec_isr (sub_soft, y, phi)
	class(soft_subtraction_t), intent(inout) :: sub_soft
	real(default), intent(in) :: y, phi
	real(default) :: sin_theta
	sin_theta = sqrt(one - y**2)
	associate (p => sub_soft%p_soft%p)
	p(0) = one
	p(1) = sin_theta * sin(phi)
	p(2) = sin_theta * cos(phi)
	p(3) = y
	end associate
	end subroutine soft_subtraction_create_softvec_isr

	@ %def soft_subtraction_create_softvec_isr
	@ The soft vector for the real mismatch is basically the same as for
	usual FSR, except for the scaling with the total gluon
	energy. Moreover, the resulting vector is rotated into the frame where
	the 3-axis points along the direction of the emitter. This is
	necessary because in the collinear limit, the approximation
	\begin{equation*}
	k_i = \frac{k_i^0}{\bar{k}_j^0} \bar{k}_j =
	\frac{\xi\sqrt{s}}{2\bar{k}_j^0}\bar{k}_j
	\end{equation*}
	is used. The collinear limit is not included in the soft mismatch yet,
	but we keep the rotation for future usage here already (the
	performance loss is negligible).
	<<Real subtraction: soft sub: TBP>>=
	procedure :: create_softvec_mismatch => &
	soft_subtraction_create_softvec_mismatch
	<<Real subtraction: sub interfaces>>=
	module subroutine soft_subtraction_create_softvec_mismatch &
	(sub_soft, E, y, phi, p_em)
	class(soft_subtraction_t), intent(inout) :: sub_soft
	real(default), intent(in) :: E, phi, y
	type(vector4_t), intent(in) :: p_em
	end subroutine soft_subtraction_create_softvec_mismatch
	<<Real subtraction: procedures>>=
	module subroutine soft_subtraction_create_softvec_mismatch &
	(sub_soft, E, y, phi, p_em)
	class(soft_subtraction_t), intent(inout) :: sub_soft
	real(default), intent(in) :: E, phi, y
	type(vector4_t), intent(in) :: p_em
	real(default) :: sin_theta
	type(lorentz_transformation_t) :: rot_em_off_3_axis
	sin_theta = sqrt (one - y**2)
	associate (p => sub_soft%p_soft%p)
	p(0) = E
	p(1) = E * sin_theta * sin(phi)
	p(2) = E * sin_theta * cos(phi)
	p(3) = E * y
	end associate
	rot_em_off_3_axis = rotation_to_2nd (3, space_part (p_em))
	sub_soft%p_soft = rot_em_off_3_axis * sub_soft%p_soft
	end subroutine soft_subtraction_create_softvec_mismatch

	@ %def soft_subtraction_create_softvec_mismatch
	@ Computation of the soft limit of $R_\alpha$. Note that what we are
	actually integrating (in the case of final-state radiation) is the
	quantity $f(0,y) / \xi$, where
	\begin{equation*}
	f(\xi,y) = \frac{J(\xi,y,\phi)}{\xi} \xi^2 R_\alpha.
	\end{equation*}
	$J/\xi$ is computed by the phase space generator. The additional factor
	of $\xi^{-1}$ is supplied in the [[evaluate_region_fsr]]-routine. Thus,
	we are left with a factor of $\xi^2$. A look on the expression for the
	soft limit of $R_\alpha$ below reveals that we are factoring out the gluon
	energy $E_i$ in the denominator. Therefore, we have a factor
	$\xi^2 / E_i^2 = 4 / q^2$.

	Note that the same routine is used also for the computation of the soft
	mismatch. There, the gluon energy is not factored out from the soft vector,
	so that we are left with the $\xi^2$-factor, which will eventually be
	cancelled out again. So, we just multiply with 1. Both cases are
	distinguished by the flag [[xi2_expanded]].

	Note that for the soft subtraction term, also the S functions are
	computed in the soft limit. The input momenta are thus the real
	momenta in the soft limit, i.e. the Born momenta given by [[p_born]].
	<<Real subtraction: soft sub: TBP>>=
	procedure :: compute => soft_subtraction_compute
	<<Real subtraction: sub interfaces>>=
	module function soft_subtraction_compute (sub_soft, p_born, &
	born_ij, y, q2, alpha_coupling, alr, emitter, i_res) result (sqme)
	real(default) :: sqme
	class(soft_subtraction_t), intent(inout) :: sub_soft
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in), dimension(:,:) :: born_ij
	real(default), intent(in) :: y
	real(default), intent(in) :: q2, alpha_coupling
	integer, intent(in) :: alr, emitter, i_res
	end function soft_subtraction_compute
	<<Real subtraction: procedures>>=
	module function soft_subtraction_compute (sub_soft, p_born, &
	born_ij, y, q2, alpha_coupling, alr, emitter, i_res) result (sqme)
	real(default) :: sqme
	class(soft_subtraction_t), intent(inout) :: sub_soft
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in), dimension(:,:) :: born_ij
	real(default), intent(in) :: y
	real(default), intent(in) :: q2, alpha_coupling
	integer, intent(in) :: alr, emitter, i_res
	real(default) :: s_alpha_soft
	real(default) :: kb
	real(default) :: xi2_factor

	if (.not. vector_set_is_cms (p_born, sub_soft%reg_data%n_in)) then
	call vector4_write_set (p_born, show_mass = .true., &
	check_conservation = .true.)
	call msg_fatal ("Soft subtraction: phase space point must be in CMS")
	end if
	if (debug2_active (D_SUBTRACTION)) then
	select case (char (sub_soft%reg_data%regions(alr)%nlo_correction_type))
	case ("QCD")
	print *, 'Compute soft subtraction using alpha_s = ', alpha_coupling
	case ("EW")
	print *, 'Compute soft subtraction using alpha_qed = ', alpha_coupling
	end select
	end if

	s_alpha_soft = sub_soft%reg_data%get_svalue_soft (p_born, &
	sub_soft%p_soft, alr, emitter, i_res)
	if (s_alpha_soft > one + tiny_07) call msg_fatal ("s_alpha_soft > 1!")
	if (debug2_active (D_SUBTRACTION)) &
	call msg_print_color ('s_alpha_soft', s_alpha_soft, COL_YELLOW)
	select case (sub_soft%factorization_mode)
	case (NO_FACTORIZATION)
	kb = sub_soft%evaluate_factorization_default (p_born, born_ij)
	case (FACTORIZATION_THRESHOLD)
	kb = sub_soft%evaluate_factorization_threshold (thr_leg(emitter), p_born, born_ij)
	end select
	if (debug_on) call msg_debug2 (D_SUBTRACTION, 'KB', kb)
	sqme = four * pi * alpha_coupling * s_alpha_soft * kb
	if (sub_soft%xi2_expanded) then
	xi2_factor = four / q2
	else
	xi2_factor = one
	end if
	if (emitter <= sub_soft%reg_data%n_in) then
	sqme = xi2_factor * (one - y*2) sqme
	else
	sqme = xi2_factor * (one - y) * sqme
	end if
	if (sub_soft%reg_data%regions(alr)%double_fsr) sqme = sqme * two
	end function soft_subtraction_compute

	@ %def soft_subtraction_compute
	@ We loop over all external legs and do not take care to leave out non-colored
	ones because [[born_ij]] is constructed in such a way that it is only
	non-zero for colored entries.
	<<Real subtraction: soft sub: TBP>>=
	procedure :: evaluate_factorization_default => &
	soft_subtraction_evaluate_factorization_default
	<<Real subtraction: sub interfaces>>=
	module function soft_subtraction_evaluate_factorization_default &
	(sub_soft, p, born_ij) result (kb)
	real(default) :: kb
	class(soft_subtraction_t), intent(inout) :: sub_soft
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in), dimension(:,:) :: born_ij
	end function soft_subtraction_evaluate_factorization_default
	<<Real subtraction: procedures>>=
	module function soft_subtraction_evaluate_factorization_default &
	(sub_soft, p, born_ij) result (kb)
	real(default) :: kb
	class(soft_subtraction_t), intent(inout) :: sub_soft
	type(vector4_t), intent(in), dimension(:) :: p
	real(default), intent(in), dimension(:,:) :: born_ij
	integer :: i, j
	kb = zero
	call sub_soft%compute_momentum_matrix (p)
	do i = 1, size (p)
	do j = 1, size (p)
	kb = kb + sub_soft%momentum_matrix (i, j) * born_ij (i, j)
	end do
	end do
	end function soft_subtraction_evaluate_factorization_default

	@ %def soft_subtraction_evaluate_factorization_default
	@ We have to multiply this with $\xi^2(1-y)$. Further, when applying
	the soft $\mathcal{S}$-function, the energy of the radiated particle
	is factored out. Thus we have $\xi^2/E_{em}^2(1-y) = 4/q_0^2(1-y)$.
	Computes the quantity $\mathcal{K}_{ij} = \frac{k_i \cdot
	k_j}{(k_i\cdot k)(k_j\cdot k)}$.
	<<Real subtraction: soft sub: TBP>>=
	procedure :: compute_momentum_matrix => &
	soft_subtraction_compute_momentum_matrix
	<<Real subtraction: sub interfaces>>=
	module subroutine soft_subtraction_compute_momentum_matrix &
	(sub_soft, p_born)
	class(soft_subtraction_t), intent(inout) :: sub_soft
	type(vector4_t), intent(in), dimension(:) :: p_born
	end subroutine soft_subtraction_compute_momentum_matrix
	<<Real subtraction: procedures>>=
	module subroutine soft_subtraction_compute_momentum_matrix &
	(sub_soft, p_born)
	class(soft_subtraction_t), intent(inout) :: sub_soft
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default) :: num, deno1, deno2
	integer :: i, j
	do i = 1, sub_soft%reg_data%n_legs_born
	do j = 1, sub_soft%reg_data%n_legs_born
	if (i <= j) then
	num = p_born(i) * p_born(j)
	deno1 = p_born(i) * sub_soft%p_soft
	deno2 = p_born(j) * sub_soft%p_soft
	sub_soft%momentum_matrix(i, j) = num / (deno1 * deno2)
	else
	!!! momentum matrix is symmetric.
	sub_soft%momentum_matrix(i, j) = sub_soft%momentum_matrix(j, i)
	end if
	end do
	end do
	end subroutine soft_subtraction_compute_momentum_matrix

	@ %def soft_subtraction_compute_momentum_matrx
	@
	<<Real subtraction: soft sub: TBP>>=
	procedure :: evaluate_factorization_threshold => &
	soft_subtraction_evaluate_factorization_threshold
	<<Real subtraction: sub interfaces>>=
	module function soft_subtraction_evaluate_factorization_threshold &
	(sub_soft, leg, p_born, born_ij) result (kb)
	real(default) :: kb
	class(soft_subtraction_t), intent(inout) :: sub_soft
	integer, intent(in) :: leg
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in), dimension(:,:) :: born_ij
	end function soft_subtraction_evaluate_factorization_threshold
	<<Real subtraction: procedures>>=
	module function soft_subtraction_evaluate_factorization_threshold &
	(sub_soft, leg, p_born, born_ij) result (kb)
	real(default) :: kb
	class(soft_subtraction_t), intent(inout) :: sub_soft
	integer, intent(in) :: leg
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in), dimension(:,:) :: born_ij
	type(vector4_t), dimension(4) :: p
	p = get_threshold_momenta (p_born)
	kb = evaluate_leg_pair (ASSOCIATED_LEG_PAIR (leg))
	if (debug2_active (D_SUBTRACTION)) call show_debug ()

	contains

	function evaluate_leg_pair (i_start) result (kbb)
	real(default) :: kbb
	integer, intent(in) :: i_start
	integer :: i1, i2
	real(default) :: numerator, deno1, deno2
	kbb = zero
	do i1 = i_start, i_start + 1
	do i2 = i_start, i_start + 1
	numerator = p(i1) * p(i2)
	deno1 = p(i1) * sub_soft%p_soft
	deno2 = p(i2) * sub_soft%p_soft
	kbb = kbb + numerator * born_ij (i1, i2) / deno1 / deno2
	end do
	end do
	if (debug2_active (D_SUBTRACTION)) then
	do i1 = i_start, i_start + 1
	do i2 = i_start, i_start + 1
	call msg_print_color('i1', i1, COL_PEACH)
	call msg_print_color('i2', i2, COL_PEACH)
	call msg_print_color('born_ij (i1,i2)', born_ij (i1,i2), &
	COL_PINK)
	print *, 'Top momentum: ', p(1)%p
	end do
	end do
	end if
	end function evaluate_leg_pair

	subroutine show_debug ()
	integer :: i
	call msg_print_color &
	('soft_subtraction_evaluate_factorization_threshold', COL_GREEN)
	do i = 1, 4
	print , 'sqrt(p(i)2) = ', sqrt(p(i)*2)
	end do
	end subroutine show_debug

	end function soft_subtraction_evaluate_factorization_threshold

	@ %def soft_subtraction_evaluate_factorization_threshold
	@
	<<Real subtraction: soft sub: TBP>>=
	procedure :: i_xi_ref => soft_subtraction_i_xi_ref
	<<Real subtraction: sub interfaces>>=
	module function soft_subtraction_i_xi_ref &
	(sub_soft, alr, i_phs) result (i_xi_ref)
	integer :: i_xi_ref
	class(soft_subtraction_t), intent(in) :: sub_soft
	integer, intent(in) :: alr, i_phs
	end function soft_subtraction_i_xi_ref
	<<Real subtraction: procedures>>=
	module function soft_subtraction_i_xi_ref &
	(sub_soft, alr, i_phs) result (i_xi_ref)
	integer :: i_xi_ref
	class(soft_subtraction_t), intent(in) :: sub_soft
	integer, intent(in) :: alr, i_phs
	if (sub_soft%use_resonance_mappings) then
	i_xi_ref = sub_soft%reg_data%alr_to_i_contributor (alr)
	else if (sub_soft%factorization_mode == FACTORIZATION_THRESHOLD) then
	i_xi_ref = i_phs
	else
	i_xi_ref = 1
	end if
	end function soft_subtraction_i_xi_ref

	@ %def soft_subtraction_i_xi_ref
	@
	<<Real subtraction: soft sub: TBP>>=
	procedure :: final => soft_subtraction_final
	<<Real subtraction: sub interfaces>>=
	module subroutine soft_subtraction_final (sub_soft)
	class(soft_subtraction_t), intent(inout) :: sub_soft
	end subroutine soft_subtraction_final
	<<Real subtraction: procedures>>=
	module subroutine soft_subtraction_final (sub_soft)
	class(soft_subtraction_t), intent(inout) :: sub_soft
	if (associated (sub_soft%reg_data)) nullify (sub_soft%reg_data)
	if (allocated (sub_soft%momentum_matrix)) &
	deallocate (sub_soft%momentum_matrix)
	end subroutine soft_subtraction_final

	@ %def soft_subtraction_final
	@
	\subsection{Soft mismatch}
	<<Real subtraction: public>>=
	public :: soft_mismatch_t
	<<Real subtraction: types>>=
	type :: soft_mismatch_t
	type(region_data_t), pointer :: reg_data => null ()
	real(default), dimension(:), allocatable :: sqme_born
	real(default), dimension(:,:,:), allocatable :: sqme_born_color_c
	real(default), dimension(:,:,:), allocatable :: sqme_born_charge_c
	type(real_kinematics_t), pointer :: real_kinematics => null ()
	type(soft_subtraction_t) :: sub_soft
	contains
	<<Real subtraction: soft mismatch: TBP>>
	end type soft_mismatch_t

	@ %def soft_mismatch_t
	@
	<<Real subtraction: soft mismatch: TBP>>=
	procedure :: init => soft_mismatch_init
	<<Real subtraction: sub interfaces>>=
	module subroutine soft_mismatch_init (soft_mismatch, reg_data, &
	real_kinematics, factorization_mode)
	class(soft_mismatch_t), intent(inout) :: soft_mismatch
	type(region_data_t), intent(in), target :: reg_data
	type(real_kinematics_t), intent(in), target :: real_kinematics
	integer, intent(in) :: factorization_mode
	end subroutine soft_mismatch_init
	<<Real subtraction: procedures>>=
	module subroutine soft_mismatch_init (soft_mismatch, reg_data, &
	real_kinematics, factorization_mode)
	class(soft_mismatch_t), intent(inout) :: soft_mismatch
	type(region_data_t), intent(in), target :: reg_data
	type(real_kinematics_t), intent(in), target :: real_kinematics
	integer, intent(in) :: factorization_mode
	soft_mismatch%reg_data => reg_data
	allocate (soft_mismatch%sqme_born (reg_data%n_flv_born))
	allocate (soft_mismatch%sqme_born_color_c (reg_data%n_legs_born, &
	reg_data%n_legs_born, reg_data%n_flv_born))
	allocate (soft_mismatch%sqme_born_charge_c (reg_data%n_legs_born, &
	reg_data%n_legs_born, reg_data%n_flv_born))
	call soft_mismatch%sub_soft%init (reg_data)
	soft_mismatch%sub_soft%xi2_expanded = .false.
	soft_mismatch%real_kinematics => real_kinematics
	soft_mismatch%sub_soft%factorization_mode = factorization_mode
	end subroutine soft_mismatch_init

	@ %def soft_mismatch_init
	@ Main routine to compute the soft mismatch. Loops over all singular
	regions. There, it first creates the soft vector, then the necessary
	soft real matrix element. These inputs are then used to get the
	numerical value of the soft mismatch.
	<<Real subtraction: soft mismatch: TBP>>=
	procedure :: evaluate => soft_mismatch_evaluate
	<<Real subtraction: sub interfaces>>=
	module function soft_mismatch_evaluate &
	(soft_mismatch, alpha_s) result (sqme_mismatch)
	real(default) :: sqme_mismatch
	class(soft_mismatch_t), intent(inout) :: soft_mismatch
	real(default), intent(in) :: alpha_s
	end function soft_mismatch_evaluate
	<<Real subtraction: procedures>>=
	module function soft_mismatch_evaluate &
	(soft_mismatch, alpha_s) result (sqme_mismatch)
	real(default) :: sqme_mismatch
	class(soft_mismatch_t), intent(inout) :: soft_mismatch
	real(default), intent(in) :: alpha_s
	integer :: alr, i_born, emitter, i_res, i_phs, i_con
	real(default) :: xi, y, q2, s
	real(default) :: E_gluon
	type(vector4_t) :: p_em
	real(default) :: sqme_alr, sqme_soft
	type(vector4_t), dimension(:), allocatable :: p_born
	sqme_mismatch = zero
	associate (real_kinematics => soft_mismatch%real_kinematics)
	xi = real_kinematics%xi_mismatch
	y = real_kinematics%y_mismatch
	s = real_kinematics%cms_energy2
	E_gluon = sqrt (s) * xi / two

	if (debug_active (D_MISMATCH)) then
	print *, 'Evaluating soft mismatch: '
	print *, 'Phase space: '
	call vector4_write_set (real_kinematics%p_born_cms%get_momenta(1), &
	show_mass = .true.)
	print *, 'xi: ', xi, 'y: ', y, 's: ', s, 'E_gluon: ', E_gluon
	end if

	allocate (p_born (soft_mismatch%reg_data%n_legs_born))

	do alr = 1, soft_mismatch%reg_data%n_regions

	i_phs = real_kinematics%alr_to_i_phs (alr)
	if (soft_mismatch%reg_data%has_pseudo_isr ()) then
	i_con = 1
	p_born = &
	soft_mismatch%real_kinematics%p_born_onshell%get_momenta(1)
	else
	i_con = soft_mismatch%reg_data%alr_to_i_contributor (alr)
	p_born = soft_mismatch%real_kinematics%p_born_cms%get_momenta(1)
	end if
	q2 = real_kinematics%xi_ref_momenta(i_con)**2
	emitter = soft_mismatch%reg_data%regions(alr)%emitter
	p_em = p_born (emitter)
	i_res = soft_mismatch%reg_data%regions(alr)%i_res
	i_born = soft_mismatch%reg_data%regions(alr)%uborn_index

	call print_debug_alr ()

	call soft_mismatch%sub_soft%create_softvec_mismatch &
	(E_gluon, y, real_kinematics%phi, p_em)
	if (debug_active (D_MISMATCH)) &
	print *, 'Created soft vector: ', &
	soft_mismatch%sub_soft%p_soft%p

	select type (fks_mapping => soft_mismatch%reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	call fks_mapping%set_resonance_momentum &
	(real_kinematics%xi_ref_momenta(i_con))
	end select

	sqme_soft = soft_mismatch%sub_soft%compute &
	(p_born, soft_mismatch%sqme_born_color_c(:,:,i_born), y, &
	q2, alpha_s, alr, emitter, i_res)

	sqme_alr = soft_mismatch%compute (alr, xi, y, p_em, &
	real_kinematics%xi_ref_momenta(i_con), &
	soft_mismatch%sub_soft%p_soft, &
	soft_mismatch%sqme_born(i_born), sqme_soft, &
	alpha_s, s)

	if (debug_on) call msg_debug (D_MISMATCH, 'sqme_alr: ', sqme_alr)
	sqme_mismatch = sqme_mismatch + sqme_alr

	end do
	end associate
	contains
	subroutine print_debug_alr ()
	if (debug_active (D_MISMATCH)) then
	print *, 'alr: ', alr
	print *, 'i_phs: ', i_phs, 'i_con: ', i_con, 'i_res: ', i_res
	print *, 'emitter: ', emitter, 'i_born: ', i_born
	print *, 'emitter momentum: ', p_em%p
	print *, 'resonance momentum: ', &
	soft_mismatch%real_kinematics%xi_ref_momenta(i_con)%p
	print *, 'q2: ', q2
	end if
	end subroutine print_debug_alr
	end function soft_mismatch_evaluate

	@ %def soft_mismatch_evaluate
	@ Computes the soft mismatch in a given $\alpha_r$,
	\begin{align*}
	I_{s+,\alpha_r} &= \int d\Phi_B \int_0^\infty d\xi \int_{-1}^1 dy
	\int_0^{2\pi} d\phi
	\frac{s\xi}{(4\pi)^3} \\
	&\times \left\lbrace\tilde{R}_{\alpha_r}
	\left(e^{-\frac{2k_\gamma \cdot k_{res}}{k_{res}}^2} - e^{-\xi}\right)
	- \frac{32 \pi \alpha_s C_{em}}{s\xi^2} B_{f_b(\alpha_r)} (1-y)^{-1}
	\left[e^{-\frac{2\bar{k}_{em} \cdot k_{res}}{k_{res}^2}
	\frac{k_\gamma^0}{k_{em}^0}} - e^{-\xi}\right]\right\rbrace.
	\end{align*}
	<<Real subtraction: soft mismatch: TBP>>=
	procedure :: compute => soft_mismatch_compute
	<<Real subtraction: sub interfaces>>=
	module function soft_mismatch_compute &
	(soft_mismatch, alr, xi, y, p_em, p_res, p_soft, &
	sqme_born, sqme_soft, alpha_s, s) result (sqme_mismatch)
	real(default) :: sqme_mismatch
	class(soft_mismatch_t), intent(in) :: soft_mismatch
	integer, intent(in) :: alr
	real(default), intent(in) :: xi, y
	type(vector4_t), intent(in) :: p_em, p_res, p_soft
	real(default), intent(in) :: sqme_born, sqme_soft
	real(default), intent(in) :: alpha_s, s
	end function soft_mismatch_compute
	<<Real subtraction: procedures>>=
	module function soft_mismatch_compute &
	(soft_mismatch, alr, xi, y, p_em, p_res, p_soft, &
	sqme_born, sqme_soft, alpha_s, s) result (sqme_mismatch)
	real(default) :: sqme_mismatch
	class(soft_mismatch_t), intent(in) :: soft_mismatch
	integer, intent(in) :: alr
	real(default), intent(in) :: xi, y
	type(vector4_t), intent(in) :: p_em, p_res, p_soft
	real(default), intent(in) :: sqme_born, sqme_soft
	real(default), intent(in) :: alpha_s, s
	real(default) :: q2, expo, sm1, sm2, jacobian

	q2 = p_res**2
	expo = - two * p_soft * p_res / q2
	!!! Divide by 1 - y to factor out the corresponding
	!!! factor in the soft matrix element
	sm1 = sqme_soft / (one - y) * ( exp(expo) - exp(- xi) )
	if (debug_on) call msg_debug2 &
	(D_MISMATCH, 'sqme_soft in mismatch ', sqme_soft)

	sm2 = zero
	if (soft_mismatch%reg_data%regions(alr)%has_collinear_divergence ()) then
	expo = - two * p_em * p_res / q2 * &
	p_soft%p(0) / p_em%p(0)
	sm2 = 32 * pi * alpha_s * cf / (s * xi*2) sqme_born * &
	( exp(expo) - exp(- xi) ) / (one - y)
	end if

	jacobian = soft_mismatch%real_kinematics%jac_mismatch * &
	s * xi / (8 * twopi3)
	sqme_mismatch = (sm1 - sm2) * jacobian

	end function soft_mismatch_compute

	@ %def soft_mismatch_compute
	@
	<<Real subtraction: soft mismatch: TBP>>=
	procedure :: final => soft_mismatch_final
	<<Real subtraction: sub interfaces>>=
	module subroutine soft_mismatch_final (soft_mismatch)
	class(soft_mismatch_t), intent(inout) :: soft_mismatch
	end subroutine soft_mismatch_final
	<<Real subtraction: procedures>>=
	module subroutine soft_mismatch_final (soft_mismatch)
	class(soft_mismatch_t), intent(inout) :: soft_mismatch
	call soft_mismatch%sub_soft%final ()
	if (associated (soft_mismatch%reg_data)) nullify (soft_mismatch%reg_data)
	if (allocated (soft_mismatch%sqme_born)) &
	deallocate (soft_mismatch%sqme_born)
	if (allocated (soft_mismatch%sqme_born_color_c)) &
	deallocate (soft_mismatch%sqme_born_color_c)
	if (allocated (soft_mismatch%sqme_born_charge_c)) &
	deallocate (soft_mismatch%sqme_born_charge_c)
	if (associated (soft_mismatch%real_kinematics)) &
	nullify (soft_mismatch%real_kinematics)
	end subroutine soft_mismatch_final

	@ %def soft_mismatch_final
	@
	\subsection{Collinear and soft-collinear subtraction terms}
	This data type deals with the calculation of the collinear and
	soft-collinear contribution to the cross section.
	<<Real subtraction: public>>=
	public :: coll_subtraction_t
	<<Real subtraction: types>>=
	type :: coll_subtraction_t
	integer :: n_in, n_alr
	logical :: use_resonance_mappings = .false.
	real(default) :: CA = 0, CF = 0, TR = 0
	contains
	<<Real subtraction: coll sub: TBP>>
	end type coll_subtraction_t

	@ %def coll_subtraction_t
	@
	<<Real subtraction: coll sub: TBP>>=
	procedure :: init => coll_subtraction_init
	<<Real subtraction: sub interfaces>>=
	module subroutine coll_subtraction_init (coll_sub, n_alr, n_in)
	class(coll_subtraction_t), intent(inout) :: coll_sub
	integer, intent(in) :: n_alr, n_in
	end subroutine coll_subtraction_init
	<<Real subtraction: procedures>>=
	module subroutine coll_subtraction_init (coll_sub, n_alr, n_in)
	class(coll_subtraction_t), intent(inout) :: coll_sub
	integer, intent(in) :: n_alr, n_in
	coll_sub%n_in = n_in
	coll_sub%n_alr = n_alr
	end subroutine coll_subtraction_init

	@ %def coll_subtraction_init
	@ Set the corresponding algebra parameters of the underlying gauge group of the correction.
	<<Real subtraction: coll sub: TBP>>=
	procedure :: set_parameters => coll_subtraction_set_parameters
	<<Real subtraction: sub interfaces>>=
	module subroutine coll_subtraction_set_parameters (coll_sub, CA, CF, TR)
	class(coll_subtraction_t), intent(inout) :: coll_sub
	real(default), intent(in) :: CA, CF, TR
	end subroutine coll_subtraction_set_parameters
	<<Real subtraction: procedures>>=
	module subroutine coll_subtraction_set_parameters (coll_sub, CA, CF, TR)
	class(coll_subtraction_t), intent(inout) :: coll_sub
	real(default), intent(in) :: CA, CF, TR
	coll_sub%CA = CA
	coll_sub%CF = CF
	coll_sub%TR = TR
	end subroutine coll_subtraction_set_parameters

	@ %def coll_subtraction_set_parameters
	@ This subroutine computes the collinear limit of $g^\alpha(\xi,y)$ introduced
	in eq.~\ref{fks: sub: real}. Care is given to also enable the usage for
	the soft-collinear limit. This, we write all formulas in terms of soft-finite
	quantities.

	We have to compute
	\begin{equation*}
	\frac{J(\Phi_n,\xi,y,\phi)}{\xi}
	\left[(1-y)\xi^2\mathcal{R}^\alpha(\Phi_{n+1})\right]\|_{y = 1}.
	\end{equation*}
	The Jacobian $J$ is proportional to $\xi$, due to the $d^3 k_{n+1} /
	k_{n+1}^0$ factor in the integration measure. It cancels the factor of
	$\xi$ in the denominator. The remaining part of the Jacobian is
	multiplied in [[evaluate_region_fsr]] and is not relevant here.
	Inserting the splitting functions exemplarily for $q \to qg$ yields
	\begin{equation*}
	g^\alpha = \frac{8\pi\alpha_s}{k_{\mathrm{em}}^2} C_F (1-y) \xi^2
	\frac{1+(1-z)^2}{z} \mathcal{B},
	\end{equation*}
	where we have chosen $z = E_\mathrm{rad} / \bar{E}_\mathrm{em}$ and
	$\bar{E}_\mathrm{em}$ denotes the emitter energy in the Born frame.
	The collinear final state imposes $\bar{k}_n = k_{n} + k_{n + 1}$ for the
	connection between $\Phi_n$- and $\Phi_{n+1}$-phasepace and we get $1
	- z = E_\mathrm{em} / \bar{E}_\mathrm{em}$. The denominator can be
	rewritten by the constraint $\bar{k}_n^2 = (k_n + k_{n+1})^2 = 0$ to
	\begin{equation*}
	k_{\mathrm{em}}^2 = 2 E_\mathrm{rad} E_\mathrm{em} (1-y)
	\end{equation*}
	which cancels the $(1-y)$ factor in the numerator, thus showing that
	the whole expression is indeed collinear-finite. We can further transform
	\begin{equation*}
	E_\mathrm{rad} E_\mathrm{em} = z (1-z) \bar{E}_\mathrm{em}^2
	\end{equation*}
	so that in total we have
	\begin{equation*}
	g^\alpha = \frac{4\pi\alpha_s}{1-z} \frac{1}{\bar{k}_{\text{em}}^2}
	C_F \left(\frac{\xi}{z}\right)^2
	(1 + (1-z)^2) \mathcal{B}
	\end{equation*}
	Follow up calculations give us
	\begin{align*}
	g^{\alpha, g \rightarrow gg} & =
	\frac{4\pi\alpha_s}{1-z}\frac{1}{\bar{k}_{\text{em}}^2}
	C_{\mathrm{A}} \frac{\xi}{z} \left\lbrace 2 \left( \frac{z}{1 - z}
	\xi + \frac{1 - z}{\frac{z}{\xi}} \right) \mathcal{B} + 4\xi z(1 -
	z) \hat{k}_{\perp}^{\mu} \hat{k}_{\perp}^{\nu} \mathcal{B}_{\mu\nu}
	\right\rbrace, \\
	g^{\alpha, g \rightarrow qq} & = \frac{4\pi\alpha_s}{1-z}
	\frac{1}{\bar{k}_{\text{em}}^2} T_{\mathrm{R}}
	\frac{\xi}{z} \left\lbrace \xi
	\mathcal{B} - 4\xi z(1 - z)
	\hat{k}_{\perp}^{\mu}
	\hat{k}_{\perp}^{\nu}
	\mathcal{B}_{\mu\nu} \right\rbrace.
	\end{align*}
	The ratio $z / \xi$ is finite in the soft limit
	\begin{equation*}
	\frac{z}{\xi} = \frac{q^0}{2\bar{E}_\mathrm{em}}
	\end{equation*}
	so that $\xi$ does not appear explicitly in the computation.

	The argumentation above is valid for $q \to qg$--splittings, but the
	general factorization is valid for general splittings, also for those
	involving spin correlations and QED splittings. Note that care has to
	be given to the definition of $z$. Further, we have factored out a
	factor of $z$ to include in the ratio $z/\xi$, which has to be taken
	into account in the implementation of the splitting functions.
	<<Real subtraction: coll sub: TBP>>=
	procedure :: compute_fsr => coll_subtraction_compute_fsr
	<<Real subtraction: sub interfaces>>=
	module function coll_subtraction_compute_fsr (coll_sub, emitter, &
	flst, p_res, p_born, sqme_born, mom_times_sqme_spin_c, &
	xi, alpha_coupling, double_fsr) result (sqme)
	real(default) :: sqme
	class(coll_subtraction_t), intent(in) :: coll_sub
	integer, intent(in) :: emitter
	integer, dimension(:), intent(in) :: flst
	type(vector4_t), intent(in) :: p_res
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in) :: sqme_born, mom_times_sqme_spin_c
	real(default), intent(in) :: xi, alpha_coupling
	logical, intent(in) :: double_fsr
	end function coll_subtraction_compute_fsr
	<<Real subtraction: procedures>>=
	module function coll_subtraction_compute_fsr (coll_sub, emitter, &
	flst, p_res, p_born, sqme_born, mom_times_sqme_spin_c, &
	xi, alpha_coupling, double_fsr) result (sqme)
	real(default) :: sqme
	class(coll_subtraction_t), intent(in) :: coll_sub
	integer, intent(in) :: emitter
	integer, dimension(:), intent(in) :: flst
	type(vector4_t), intent(in) :: p_res
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in) :: sqme_born, mom_times_sqme_spin_c
	real(default), intent(in) :: xi, alpha_coupling
	logical, intent(in) :: double_fsr
	real(default) :: q0, z, p0, z_o_xi, onemz
	integer :: nlegs, flv_em, flv_rad
	nlegs = size (flst)
	flv_rad = flst(nlegs); flv_em = flst(emitter)
	q0 = p_res**1
	p0 = p_res * p_born(emitter) / q0
	!!! Here, z corresponds to 1-z in the formulas of arXiv:1002.2581;
	!!! the integrand is symmetric under this variable change
	z_o_xi = q0 / (two * p0)
	z = xi * z_o_xi; onemz = one - z
	if (is_gluon (flv_em) .and. is_gluon (flv_rad)) then
	sqme = coll_sub%CA * ( two * ( z / onemz * xi + onemz / z_o_xi ) * sqme_born &
	+ four * xi * z * onemz * mom_times_sqme_spin_c )
	else if (is_fermion (flv_em) .and. is_fermion (flv_rad)) then
	sqme = coll_sub%TR * xi * (sqme_born - four * z * onemz * mom_times_sqme_spin_c)
	else if (is_fermion (flv_em) .and. is_massless_vector (flv_rad)) then
	sqme = sqme_born * coll_sub%CF * (one + onemz**2) / z_o_xi
	else
	sqme = zero
	end if
	sqme = sqme / (p0*2 onemz * z_o_xi)
	sqme = sqme * four * pi * alpha_coupling
	if (double_fsr) sqme = sqme * onemz * two
	end function coll_subtraction_compute_fsr

	@ %def coll_subtraction_compute_fsr
	@ Like in the context of [[coll_subtraction_compute_fsr]] we compute
	the quantity
	\begin{equation*}
	\lim_{y\to\pm1}{\left\{\frac{J(\Phi_n,\xi,y,\phi)}{\xi}
	\left[(1-y^2)\xi^2\mathcal{R}^\alpha(\Phi_{n+1})\right]\right\}},
	\end{equation*}
	where the $(1-y^2)$ accounts for both $y=\pm1$. Again, the Jacobian is proportional to $\xi$, so we
	drop the $J / \xi$ factor. Note that it is important to take into account this missing
	factor of $\xi$ in the computation of the Jacobian during phase-space generation
	both for fixed-beam and structure ISR. We consider only a $q \to qg$ splitting
	arguing that other splittings are identical in terms of the
	factors which cancel. It is given by
	\begin{equation*}
	g^\alpha = \frac{8\pi\alpha_s}{-k_{\mathrm{em}}^2} C_F (1-y^2) \xi^2
	\frac{1+z^2}{1-z} \mathcal{B},
	\end{equation*}
	where $g^\alpha$ is defined akin to the one for FSR in eq.~\ref{fks: sub: real}.
	Note the negative sign of $k_\mathrm{em}^2$ to compensate the negative
	virtuality of the initial-state emitter. For ISR, $z$ is defined with
	respect to the emitter energy entering the hard interaction, i.e.
	\begin{equation*}
	z = \frac{E_\mathrm{beam} - E_\mathrm{rad}}{E_\mathrm{beam}} =
	1 - \frac{E_\mathrm{rad}}{E_\mathrm{beam}}.
	\end{equation*}
	Because $E_\mathrm{rad} = E_\mathrm{beam} \cdot \xi$, it is
	$z = 1 - \xi$, thus one factor of $\xi$ is cancelled by $(1-z)$ in the
	denominator of $g^\alpha$. The factor $k_\mathrm{em}^2$ in the
	denominator is rewritten as
	\begin{equation*}
	k_\mathrm{em}^2 = \left(p_\mathrm{beam} - p_\mathrm{rad}\right)^2
	= - 2 p_\mathrm{beam} \cdot p_\mathrm{rad}
	= - 2 E_\mathrm{beam} E_\mathrm{rad} (1\pm y)
	= - 2 E_\mathrm{beam}^2 (1-z) (1\pm y),
	\end{equation*}
	where we used
	\begin{equation*}
	E_\mathrm{beam} E_\mathrm{rad} = E_\mathrm{beam}^2 (1-z).
	\end{equation*}
	This leads to the cancellation of the corresponding $(1\pm y)$ factor in
	$(1-y^2)$, with the other factor becoming a simple factor of $2$, and
	the remaining factor of $\xi$ in the numerator. We thus end up with
	\begin{equation*}
	g^\alpha = \frac{8\pi\alpha_s}{E_\mathrm{beam}^2} C_F \left(1 +
	z^2\right)\mathcal{B},
	\end{equation*}
	which is soft-finite.

	Note that here in [[compute_isr]], [[sqme_born]] is supposed to be
	the squared Born matrix element convoluted with the real PDF.
	<<Real subtraction: coll sub: TBP>>=
	procedure :: compute_isr => coll_subtraction_compute_isr
	<<Real subtraction: sub interfaces>>=
	module function coll_subtraction_compute_isr &
	(coll_sub, emitter, flst, p_born, sqme_born, mom_times_sqme_spin_c, &
	xi, alpha_coupling, isr_mode) result (sqme)
	real(default) :: sqme
	class(coll_subtraction_t), intent(in) :: coll_sub
	integer, intent(in) :: emitter
	integer, dimension(:), intent(in) :: flst
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in) :: sqme_born
	real(default), intent(in) :: mom_times_sqme_spin_c
	real(default), intent(in) :: xi, alpha_coupling
	integer, intent(in) :: isr_mode
	end function coll_subtraction_compute_isr
	<<Real subtraction: procedures>>=
	module function coll_subtraction_compute_isr &
	(coll_sub, emitter, flst, p_born, sqme_born, mom_times_sqme_spin_c, &
	xi, alpha_coupling, isr_mode) result (sqme)
	real(default) :: sqme
	class(coll_subtraction_t), intent(in) :: coll_sub
	integer, intent(in) :: emitter
	integer, dimension(:), intent(in) :: flst
	type(vector4_t), intent(in), dimension(:) :: p_born
	real(default), intent(in) :: sqme_born
	real(default), intent(in) :: mom_times_sqme_spin_c
	real(default), intent(in) :: xi, alpha_coupling
	integer, intent(in) :: isr_mode
	real(default) :: z, onemz, p02
	integer :: nlegs, flv_em, flv_rad
	!!! p_born must be in lab frame.
	nlegs = size (flst)
	flv_rad = flst(nlegs); flv_em = flst(emitter)
	!!! No need to pay attention to n_in = 1, because this case always has a
	!!! massive initial-state particle and thus no collinear divergence.
	p02 = p_born(1)%p(0) * p_born(2)%p(0) / two
	z = one - xi; onemz = xi
	if (is_massless_vector (flv_em) .and. is_massless_vector (flv_rad)) then
	sqme = coll_sub%CA * (two * (z + z * onemz*2) sqme_born + four * onemz**2 &
	/ z * mom_times_sqme_spin_c)
	else if (is_fermion (flv_em) .and. is_massless_vector (flv_rad)) then
	sqme = coll_sub%CF * (one + z*2) sqme_born
	else if (is_fermion (flv_em) .and. is_fermion (flv_rad)) then
	sqme = coll_sub%CF * (z * onemz * sqme_born + four * onemz*2 / z mom_times_sqme_spin_c)
	else if (is_massless_vector (flv_em) .and. is_fermion (flv_rad)) then
	sqme = coll_sub%TR * (z2 + onemz2) * onemz * sqme_born
	else
	sqme = zero
	end if
	if (isr_mode == SQRTS_VAR) then
	sqme = sqme / p02 * z
	else
	!!! We have no idea why this seems to work as there should be no factor
	!!! of z for the fixed-beam settings. This should definitely be understood in the
	!!! future!
	sqme = sqme / p02 / z
	end if
	sqme = sqme * four * pi * alpha_coupling
	end function coll_subtraction_compute_isr

	@ %def coll_subtraction_compute_isr
	@
	<<Real subtraction: coll sub: TBP>>=
	procedure :: final => coll_subtraction_final
	<<Real subtraction: sub interfaces>>=
	module subroutine coll_subtraction_final (sub_coll)
	class(coll_subtraction_t), intent(inout) :: sub_coll
	end subroutine coll_subtraction_final
	<<Real subtraction: procedures>>=
	module subroutine coll_subtraction_final (sub_coll)
	class(coll_subtraction_t), intent(inout) :: sub_coll
	sub_coll%use_resonance_mappings = .false.
	end subroutine coll_subtraction_final

	@ %def coll_subtraction_final
	@
	\subsection{Real Subtraction}

	We store a pointer to the [[nlo_settings_t]] object which holds tuning parameters, e.g. cutoffs for the subtraction terms.
	<<Real subtraction: public>>=
	public :: real_subtraction_t
	<<Real subtraction: types>>=
	type :: real_subtraction_t
	type(nlo_settings_t), pointer :: settings => null ()
	type(region_data_t), pointer :: reg_data => null ()
	type(real_kinematics_t), pointer :: real_kinematics => null ()
	type(isr_kinematics_t), pointer :: isr_kinematics => null ()
	real(default), dimension(:,:), allocatable :: sqme_real_non_sub
	real(default), dimension(:), allocatable :: sqme_born
	real(default), dimension(:,:), allocatable :: sf_factors
	+ real(default), dimension(:), allocatable :: sqme_real_arr
	real(default), dimension(:,:,:), allocatable :: sqme_born_color_c
	real(default), dimension(:,:,:), allocatable :: sqme_born_charge_c
	real(default), dimension(:,:,:,:), allocatable :: sqme_born_spin_c
	type(soft_subtraction_t) :: sub_soft
	type(coll_subtraction_t) :: sub_coll
	logical, dimension(:), allocatable :: sc_required
	logical :: subtraction_deactivated = .false.
	integer :: purpose = INTEGRATION
	logical :: radiation_event = .true.
	logical :: subtraction_event = .false.
	integer, dimension(:), allocatable :: selected_alr
	contains
	<<Real subtraction: real subtraction: TBP>>
	end type real_subtraction_t

	@ %def real_subtraction_t
	@ Initializer
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: init => real_subtraction_init
	<<Real subtraction: sub interfaces>>=
	module subroutine real_subtraction_init (rsub, reg_data, settings)
	class(real_subtraction_t), intent(inout), target :: rsub
	type(region_data_t), intent(in), target :: reg_data
	type(nlo_settings_t), intent(in), target :: settings
	end subroutine real_subtraction_init
	<<Real subtraction: procedures>>=
	module subroutine real_subtraction_init (rsub, reg_data, settings)
	class(real_subtraction_t), intent(inout), target :: rsub
	type(region_data_t), intent(in), target :: reg_data
	type(nlo_settings_t), intent(in), target :: settings
	integer :: alr
	if (debug_on) call msg_debug (D_SUBTRACTION, "real_subtraction_init")
	if (debug_on) call msg_debug (D_SUBTRACTION, "n_in", reg_data%n_in)
	if (debug_on) call msg_debug &
	(D_SUBTRACTION, "nlegs_born", reg_data%n_legs_born)
	if (debug_on) call msg_debug &
	(D_SUBTRACTION, "nlegs_real", reg_data%n_legs_real)
	if (debug_on) call msg_debug &
	(D_SUBTRACTION, "reg_data%n_regions", reg_data%n_regions)
	if (debug2_active (D_SUBTRACTION)) call reg_data%write ()
	rsub%reg_data => reg_data
	allocate (rsub%sqme_born (reg_data%n_flv_born))
	rsub%sqme_born = zero
	allocate (rsub%sf_factors (reg_data%n_regions, 0:reg_data%n_in))
	rsub%sf_factors = zero
	+ allocate (rsub%sqme_real_arr (reg_data%n_regions))
	+ rsub%sqme_real_arr = zero
	allocate (rsub%sqme_born_color_c &
	(reg_data%n_legs_born, reg_data%n_legs_born, reg_data%n_flv_born))
	rsub%sqme_born_color_c = zero
	allocate (rsub%sqme_born_charge_c &
	(reg_data%n_legs_born, reg_data%n_legs_born, reg_data%n_flv_born))
	rsub%sqme_born_charge_c = zero
	allocate (rsub%sqme_real_non_sub (reg_data%n_flv_real, reg_data%n_phs))
	rsub%sqme_real_non_sub = zero
	allocate (rsub%sc_required (reg_data%n_regions))
	do alr = 1, reg_data%n_regions
	rsub%sc_required(alr) = reg_data%regions(alr)%sc_required
	end do
	if (rsub%requires_spin_correlations ()) then
	allocate (rsub%sqme_born_spin_c &
	(1:3, 1:3, reg_data%n_legs_born, reg_data%n_flv_born))
	rsub%sqme_born_spin_c = zero
	end if
	call rsub%sub_soft%init (reg_data)
	call rsub%sub_coll%init (reg_data%n_regions, reg_data%n_in)
	rsub%settings => settings
	rsub%sub_soft%use_resonance_mappings = settings%use_resonance_mappings
	rsub%sub_coll%use_resonance_mappings = settings%use_resonance_mappings
	rsub%sub_soft%factorization_mode = settings%factorization_mode
	end subroutine real_subtraction_init

	@ %def real_subtraction_init
	@
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: set_real_kinematics => real_subtraction_set_real_kinematics
	<<Real subtraction: sub interfaces>>=
	module subroutine real_subtraction_set_real_kinematics &
	(rsub, real_kinematics)
	class(real_subtraction_t), intent(inout) :: rsub
	type(real_kinematics_t), intent(in), target :: real_kinematics
	end subroutine real_subtraction_set_real_kinematics
	<<Real subtraction: procedures>>=
	module subroutine real_subtraction_set_real_kinematics (rsub, real_kinematics)
	class(real_subtraction_t), intent(inout) :: rsub
	type(real_kinematics_t), intent(in), target :: real_kinematics
	rsub%real_kinematics => real_kinematics
	end subroutine real_subtraction_set_real_kinematics

	@ %def real_subtraction_set_real_kinematics
	@
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: set_isr_kinematics => real_subtraction_set_isr_kinematics
	<<Real subtraction: sub interfaces>>=
	module subroutine real_subtraction_set_isr_kinematics (rsub, fractions)
	class(real_subtraction_t), intent(inout) :: rsub
	type(isr_kinematics_t), intent(in), target :: fractions
	end subroutine real_subtraction_set_isr_kinematics
	<<Real subtraction: procedures>>=
	module subroutine real_subtraction_set_isr_kinematics (rsub, fractions)
	class(real_subtraction_t), intent(inout) :: rsub
	type(isr_kinematics_t), intent(in), target :: fractions
	rsub%isr_kinematics => fractions
	end subroutine real_subtraction_set_isr_kinematics

	@ %def real_subtraction_set_isr_kinematics
	@
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: get_i_res => real_subtraction_get_i_res
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_get_i_res (rsub, alr) result (i_res)
	integer :: i_res
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr
	end function real_subtraction_get_i_res
	<<Real subtraction: procedures>>=
	module function real_subtraction_get_i_res (rsub, alr) result (i_res)
	integer :: i_res
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr
	select type (fks_mapping => rsub%reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	i_res = fks_mapping%res_map%alr_to_i_res (alr)
	class default
	i_res = 0
	end select
	end function real_subtraction_get_i_res

	@ %def real_subtraction_get_i_res
	@
	\subsection{The real contribution to the cross section}
	In each singular region $\alpha$, the real contribution to $\sigma$ is
	given by the second summand of eqn. \ref{fks: sub: complete},
	\begin{equation}
	\label{fks: sub: real}
	\sigma^\alpha_{\text{real}} = \int d\Phi_n \int_0^{2\pi} d\phi
	\int_{-1}^1 dy \int_0^{\xi_{\text{max}}} d\xi
	\left(\frac{1}{\xi}\right)_+ \left(\frac{1}{1-y}\right)_+
	\underbrace{\frac{J(\Phi_n, \xi, y, \phi)}{\xi}
	\left[(1-y)\xi^2\mathcal{R}^\alpha(\Phi_{n+1})\right]}_{g^\alpha(\xi,y)}.
	\end{equation}
	Writing out the plus-distribution and introducing $\tilde{\xi} =
	\xi/\xi_{\text{max}}$ to set the upper integration limit to 1, this
	turns out to be equal to
	\begin{equation}
	\begin{split}
	\sigma^\alpha_{\rm{real}} &= \int d\Phi_n \int_0^{2\pi}d\phi
	\int_{-1}^1 \frac{dy}{1-y} \Bigg\{\int_0^1
	d\tilde{\xi}\Bigg[\frac{g^\alpha(\tilde{\xi}\xi_{\rm{max}},y)}{\tilde{\xi}}
	- \underbrace{\frac{g^\alpha(0,y)}{\tilde{\xi}}}_{\text{soft}} -
	\underbrace{\frac{g^\alpha(\tilde{\xi}\xi_{\rm{max}},1)}{\tilde{\xi}}}_{\text{coll.}}
	+
	\underbrace{\frac{g^\alpha(0,1)}{\tilde{\xi}}}_{\text{coll.+soft}}\Bigg]
	\\
	&+ \left[\log\xi_{\rm{max}}(y)g^\alpha(0,y) - \log\xi_{\rm{max}}(1)g^\alpha(0,1)\right]\Bigg\}.
	\end{split}
	\end{equation}
	This formula is implemented in \texttt{compute\_sqme\_real\_fin}

	If two or more singular regions would produce the same amplitude we only compute
	one and use the [[eqv_index]] to copy the result to the others (if [[reuse_amplitudes_fks]]
	is true).
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: compute => real_subtraction_compute
	<<Real subtraction: sub interfaces>>=
	module subroutine real_subtraction_compute (rsub, emitter, &
	i_phs, alpha_s, alpha_qed, separate_alrs, sqme)
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: emitter, i_phs
	logical, intent(in) :: separate_alrs
	real(default), intent(inout), dimension(:) :: sqme
	real(default), intent(in) :: alpha_s, alpha_qed
	end subroutine real_subtraction_compute
	<<Real subtraction: procedures>>=
	module subroutine real_subtraction_compute (rsub, emitter, &
	i_phs, alpha_s, alpha_qed, separate_alrs, sqme)
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: emitter, i_phs
	logical, intent(in) :: separate_alrs
	real(default), intent(inout), dimension(:) :: sqme
	real(default), dimension(:), allocatable :: sqme_alr_arr
	real(default), intent(in) :: alpha_s, alpha_qed
	real(default) :: sqme_alr, alpha_coupling
	integer :: alr, i_con, i_res, this_emitter
	logical :: same_emitter
	logical, dimension(:), allocatable :: alr_evaluated
	allocate (alr_evaluated(rsub%reg_data%n_regions))
	allocate (sqme_alr_arr(rsub%reg_data%n_regions))
	sqme_alr_arr = zero
	alr_evaluated = .false.
	do alr = 1, rsub%reg_data%n_regions
	if (.not. alr_evaluated(rsub%reg_data%regions(alr)%eqv_index)) then
	if (allocated (rsub%selected_alr)) then
	if (.not. any (rsub%selected_alr == alr)) cycle
	end if
	sqme_alr = zero
	if (emitter > rsub%isr_kinematics%n_in) then
	same_emitter = emitter == rsub%reg_data%regions(alr)%emitter
	else
	same_emitter = rsub%reg_data%regions(alr)%emitter <= rsub%isr_kinematics%n_in
	end if
	select case (char(rsub%reg_data%regions(alr)%nlo_correction_type))
	case ("QCD")
	alpha_coupling = alpha_s
	case ("EW")
	alpha_coupling = alpha_qed
	end select
	if (same_emitter .and. i_phs == rsub%real_kinematics%alr_to_i_phs (alr)) then
	i_res = rsub%get_i_res (alr)
	this_emitter = rsub%reg_data%regions(alr)%emitter
	sqme_alr = rsub%evaluate_emitter_region (alr, this_emitter, i_phs, &
	i_res, alpha_coupling)
	i_con = rsub%get_i_contributor (alr)
	sqme_alr = sqme_alr * rsub%get_phs_factor (i_con)
	end if
	sqme_alr_arr(alr) = sqme_alr_arr(alr) + sqme_alr
	if (.not. (debug_active (D_SUBTRACTION) .or. debug2_active (D_SUBTRACTION))) then
	if (.not. allocated (rsub%selected_alr)) &
	alr_evaluated(rsub%reg_data%regions(alr)%eqv_index) = .true.
	end if
	else
	sqme_alr_arr(alr) = sqme_alr_arr(rsub%reg_data%regions(alr)%eqv_index)
	end if
	+ if (rsub%radiation_event .and. sqme_alr_arr(alr) /= zero) then
	+ rsub%sqme_real_arr(alr) = sqme_alr_arr(alr)
	+ end if
	if (separate_alrs) then
	sqme(alr) = sqme(alr) + sqme_alr_arr(alr)
	else
	sqme(1) = sqme(1) + sqme_alr_arr(alr)
	end if
	end do
	if (debug_on) then
	if (debug2_active (D_SUBTRACTION)) call check_s_alpha_consistency ()
	end if
	contains
	subroutine check_s_alpha_consistency ()
	real(default) :: sum_s_alpha, sum_s_alpha_soft
	integer :: i_ftuple
	if (debug_on) call msg_debug2 (D_SUBTRACTION, "Check consistency of s_alpha: ")
	do alr = 1, rsub%reg_data%n_regions
	sum_s_alpha = rsub%sum_up_s_alpha(alr, i_phs)
	call msg_debug2 (D_SUBTRACTION, 'sum_s_alpha', sum_s_alpha)
	if (.not. nearly_equal(sum_s_alpha, one)) then
	call msg_bug ("The sum of all S functions should be equal to one!")
	end if
	sum_s_alpha_soft = rsub%sum_up_s_alpha_soft(alr, i_phs)
	call msg_debug2 (D_SUBTRACTION, 'sum_s_alpha_soft', sum_s_alpha_soft)
	if (.not. nearly_equal(sum_s_alpha_soft, one)) then
	call msg_bug ("The sum of all soft S functions should be equal to one!")
	end if
	end do
	end subroutine check_s_alpha_consistency
	end subroutine real_subtraction_compute

	@ %def real_subtraction_compute
	@ The emitter is fixed. We now have to decide whether we evaluate in
	ISR or FSR region, and also if resonances are used.
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: evaluate_emitter_region => &
	real_subtraction_evaluate_emitter_region
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_evaluate_emitter_region (rsub, alr, &
	emitter, i_phs, i_res, alpha_coupling) result (sqme)
	real(default) :: sqme
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, emitter, i_phs, i_res
	real(default), intent(in) :: alpha_coupling
	end function real_subtraction_evaluate_emitter_region
	<<Real subtraction: procedures>>=
	module function real_subtraction_evaluate_emitter_region (rsub, alr, &
	emitter, i_phs, i_res, alpha_coupling) result (sqme)
	real(default) :: sqme
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, emitter, i_phs, i_res
	real(default), intent(in) :: alpha_coupling
	if (emitter <= rsub%isr_kinematics%n_in) then
	sqme = rsub%evaluate_region_isr &
	(alr, emitter, i_phs, i_res, alpha_coupling)
	else
	select type (fks_mapping => rsub%reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	call fks_mapping%set_resonance_momenta &
	(rsub%real_kinematics%xi_ref_momenta)
	end select
	sqme = rsub%evaluate_region_fsr (alr, emitter, i_phs, i_res, alpha_coupling)
	end if
	end function real_subtraction_evaluate_emitter_region

	@ %def real_subtraction_evaluate_emitter_region
	@ Sums up $\sum_{i_1, i_2} S_{i_1 i_2}$ for the given [[alr]].
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: sum_up_s_alpha => real_subtraction_sum_up_s_alpha
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_sum_up_s_alpha &
	(rsub, alr, i_phs) result (sum_s_alpha)
	real(default) :: sum_s_alpha
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, i_phs
	end function real_subtraction_sum_up_s_alpha
	<<Real subtraction: procedures>>=
	module function real_subtraction_sum_up_s_alpha &
	(rsub, alr, i_phs) result (sum_s_alpha)
	real(default) :: sum_s_alpha
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, i_phs
	type(vector4_t), dimension(:), allocatable :: p_real
	integer :: i_res, i_ftuple, i1, i2
	allocate (p_real (rsub%reg_data%n_legs_real))
	if (rsub%reg_data%has_pseudo_isr ()) then
	p_real = rsub%real_kinematics%p_real_onshell(i_phs)%get_momenta (i_phs)
	else
	p_real = rsub%real_kinematics%p_real_cms%get_momenta (i_phs)
	end if
	i_res = rsub%get_i_res (alr)
	sum_s_alpha = zero
	do i_ftuple = 1, rsub%reg_data%regions(alr)%nregions
	call rsub%reg_data%regions(alr)%ftuples(i_ftuple)%get (i1, i2)
	sum_s_alpha = sum_s_alpha + rsub%reg_data%get_svalue (p_real, alr, i1, i2, i_res)
	end do
	end function real_subtraction_sum_up_s_alpha

	@ %def real_subtraction_sum_up_s_alpha
	@ Sums up $\sum_{i_1, i_2} S_{i_1 i_2}$ for the given [[alr]]. The
	soft S functions take the real momenta in the soft limit, i.e. the
	Born momenta. For each summand of [[sum_s_alpha_soft]] we take
	[[p_soft]] constructed from the emitter of the given alpha region also
	for ftuples in which the first integer [[i1]] does not coincide with
	the emitter. This is necessary because only if we keep [[p_soft]]
	fixed, all soft S functions are computed with the same denominator and
	thus add up to 1.
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: sum_up_s_alpha_soft => real_subtraction_sum_up_s_alpha_soft
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_sum_up_s_alpha_soft &
	(rsub, alr, i_phs) result (sum_s_alpha_soft)
	real(default) :: sum_s_alpha_soft
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, i_phs
	end function real_subtraction_sum_up_s_alpha_soft
	<<Real subtraction: procedures>>=
	module function real_subtraction_sum_up_s_alpha_soft &
	(rsub, alr, i_phs) result (sum_s_alpha_soft)
	real(default) :: sum_s_alpha_soft
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, i_phs
	type(vector4_t), dimension(:), allocatable :: p_born
	integer :: i_res, i_ftuple, i1, i2, emitter, nlegs
	allocate (p_born (rsub%reg_data%n_legs_born))
	if (rsub%reg_data%has_pseudo_isr ()) then
	p_born = rsub%real_kinematics%p_born_onshell%get_momenta (1)
	else
	p_born = rsub%real_kinematics%p_born_cms%get_momenta (1)
	end if
	i_res = rsub%get_i_res (alr)
	emitter = rsub%reg_data%regions(alr)%emitter
	associate (r => rsub%real_kinematics)
	if (emitter > rsub%sub_soft%reg_data%n_in) then
	call rsub%sub_soft%create_softvec_fsr (p_born, r%y_soft(i_phs), r%phi, &
	emitter, r%xi_ref_momenta(rsub%sub_soft%i_xi_ref (alr, i_phs)))
	else
	call rsub%sub_soft%create_softvec_isr (r%y_soft(i_phs), r%phi)
	end if
	end associate
	nlegs = rsub%reg_data%n_legs_real
	sum_s_alpha_soft = zero
	do i_ftuple = 1, rsub%reg_data%regions(alr)%nregions
	call rsub%reg_data%regions(alr)%ftuples(i_ftuple)%get (i1, i2)
	if (i2 == nlegs) then
	sum_s_alpha_soft = sum_s_alpha_soft + rsub%reg_data%get_svalue_soft &
	(p_born, rsub%sub_soft%p_soft, alr, i1, i_res)
	end if
	end do
	end function real_subtraction_sum_up_s_alpha_soft

	@ %def real_subtraction_sum_up_s_alpha_soft
	@ This subroutine computes the finite part of the real matrix element in
	an individual singular region.
	First, the radiation variables are fetched and $\mathcal{R}$ is
	multiplied by the appropriate $S_\alpha$-factors,
	region multiplicities and double-FSR factors.
	Then, it computes the soft, collinear, soft-collinear and remnant matrix
	elements and supplies the corresponding factor $1/\xi/(1-y)$ as well as
	the corresponding Jacobians.
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: evaluate_region_fsr => real_subtraction_evaluate_region_fsr
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_evaluate_region_fsr (rsub, alr, &
	emitter, i_phs, i_res, alpha_coupling) result (sqme_tot)
	real(default) :: sqme_tot
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, emitter, i_phs, i_res
	real(default), intent(in) :: alpha_coupling
	end function real_subtraction_evaluate_region_fsr
	<<Real subtraction: procedures>>=
	module function real_subtraction_evaluate_region_fsr (rsub, alr, &
	emitter, i_phs, i_res, alpha_coupling) result (sqme_tot)
	real(default) :: sqme_tot
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, emitter, i_phs, i_res
	real(default), intent(in) :: alpha_coupling
	real(default) :: sqme_rad, sqme_soft, sqme_coll, sqme_cs, sqme_remn
	sqme_rad = zero; sqme_soft = zero; sqme_coll = zero
	sqme_cs = zero; sqme_remn = zero
	associate (region => rsub%reg_data%regions(alr), &
	template => rsub%settings%fks_template)
	if (rsub%radiation_event) then
	sqme_rad = rsub%sqme_real_non_sub &
	(rsub%reg_data%get_matrix_element_index (alr), i_phs)
	call evaluate_fks_factors (sqme_rad, rsub%reg_data, &
	rsub%real_kinematics, alr, i_phs, emitter, i_res)
	call apply_kinematic_factors_radiation (sqme_rad, &
	rsub%real_kinematics, i_phs)
	end if
	if (rsub%subtraction_event .and. .not. (rsub%subtraction_deactivated &
	.or. region%nlo_correction_type == "none")) then
	if (debug2_active (D_SUBTRACTION)) then
	print *, "[real_subtraction_evaluate_region_fsr]"
	print , "xi: ", rsub%real_kinematics%xi_max(i_phs) &
	rsub%real_kinematics%xi_tilde
	print *, "y: ", rsub%real_kinematics%y(i_phs)
	end if
	call rsub%evaluate_subtraction_terms_fsr (alr, emitter, i_phs, &
	i_res, alpha_coupling, sqme_soft, sqme_coll, sqme_cs)
	call apply_kinematic_factors_subtraction_fsr (sqme_soft, &
	sqme_coll, sqme_cs, rsub%real_kinematics, i_phs)
	associate (symm_factor_fs => &
	rsub%reg_data%born_to_real_symm_factor_fs (alr))
	sqme_soft = sqme_soft * symm_factor_fs
	sqme_coll = sqme_coll * symm_factor_fs
	sqme_cs = sqme_cs * symm_factor_fs
	end associate
	sqme_remn = compute_sqme_remnant_fsr (sqme_soft, sqme_cs, &
	rsub%real_kinematics%xi_max(i_phs), template%xi_cut, &
	rsub%real_kinematics%xi_tilde)
	sqme_tot = - sqme_soft - sqme_coll + sqme_cs + sqme_remn
	else
	sqme_tot = sqme_rad
	end if
	sqme_tot = sqme_tot * rsub%real_kinematics%jac_rand(i_phs)
	sqme_tot = sqme_tot * rsub%reg_data%regions(alr)%mult
	end associate
	if (debug_active (D_SUBTRACTION) .and. .not. &
	debug2_active (D_SUBTRACTION)) then
	call real_subtraction_register_debug_sqme (rsub, alr, emitter, &
	i_phs, sqme_rad, sqme_soft, sqme_coll=sqme_coll, sqme_cs=sqme_cs)
	else if (debug2_active (D_SUBTRACTION)) then
	call write_computation_status_fsr ()
	end if
	contains
	<<Real subtraction: real subtraction evaluate region fsr: procedures>>
	subroutine write_computation_status_fsr (passed, total, region_type, full)
	integer, intent(in), optional :: passed, total
	character(*), intent(in), optional :: region_type
	integer :: i_born
	integer :: u
	real(default) :: xi
	logical :: yorn
	logical, intent(in), optional :: full
	yorn = .true.
	if (present (full)) yorn = full
	if (debug_on) call msg_debug &
	(D_SUBTRACTION, "real_subtraction_evaluate_region_fsr")
	u = given_output_unit (); if (u < 0) return
	i_born = rsub%reg_data%regions(alr)%uborn_index
	xi = rsub%real_kinematics%xi_max (i_phs) * rsub%real_kinematics%xi_tilde
	write (u,'(A,I2)') 'rsub%purpose: ', rsub%purpose
	write (u,'(A,I4)') 'alr: ', alr
	write (u,'(A,I3)') 'emitter: ', emitter
	write (u,'(A,I3)') 'i_phs: ', i_phs
	write (u,'(A,F6.4)') 'xi_max: ', rsub%real_kinematics%xi_max (i_phs)
	write (u,'(A,F6.4)') 'xi_cut: ', rsub%real_kinematics%xi_max(i_phs) * &
	rsub%settings%fks_template%xi_cut
	write (u,'(A,F6.4,2X,A,F6.4)') 'xi: ', xi, 'y: ', &
	rsub%real_kinematics%y (i_phs)
	if (yorn) then
	write (u,'(A,ES16.9)') 'sqme_born: ', rsub%sqme_born(i_born)
	write (u,'(A,ES16.9)') 'sqme_real: ', sqme_rad
	write (u,'(A,ES16.9)') 'sqme_soft: ', sqme_soft
	write (u,'(A,ES16.9)') 'sqme_coll: ', sqme_coll
	write (u,'(A,ES16.9)') 'sqme_coll-soft: ', sqme_cs
	write (u,'(A,ES16.9)') 'sqme_remn: ', sqme_remn
	write (u,'(A,ES16.9)') 'sqme_tot: ', sqme_tot
	if (present (passed) .and. present (total) .and. &
	present (region_type)) &
	write (u,'(A)') char (str (passed) // " of " // str (total) // &
	" " // region_type // " points passed in total")
	end if
	write (u,'(A,ES16.9)') 'jacobian - real: ', &
	rsub%real_kinematics%jac(i_phs)%jac(1)
	write (u,'(A,ES16.9)') 'jacobian - soft: ', &
	rsub%real_kinematics%jac(i_phs)%jac(2)
	write (u,'(A,ES16.9)') 'jacobian - coll: ', &
	rsub%real_kinematics%jac(i_phs)%jac(3)
	end subroutine write_computation_status_fsr
	end function real_subtraction_evaluate_region_fsr

	@ %def real_subtraction_evalute_region_fsr
	@ Compares the real matrix element to the subtraction terms in the soft, the collinear
	or the soft-collinear limits. Used for debug purposes if [[?test_anti_coll_limit]],
	[[?test_coll_limit]] and/or [[?test_soft_limit]] are set in the Sindarin.
	[[sqme_soft]] and [[sqme_cs]] need to be provided if called for FSR and [[sqme_coll_plus]],
	[[sqme_coll_minus]], [[sqme_cs_plus]] as well as [[sqme_cs_minus]] need to be provided if called for ISR.
	<<Real subtraction: procedures>>=
	subroutine real_subtraction_register_debug_sqme (rsub, alr, emitter, i_phs, sqme_rad, sqme_soft,&
	sqme_coll, sqme_cs, sqme_coll_plus, sqme_coll_minus, sqme_cs_plus, sqme_cs_minus)
	class(real_subtraction_t), intent(in) :: rsub
	integer, intent(in) :: alr, emitter, i_phs
	real(default), intent(in) :: sqme_rad, sqme_soft
	real(default), intent(in), optional :: sqme_coll, sqme_cs, sqme_coll_plus, sqme_coll_minus, sqme_cs_plus, sqme_cs_minus
	real(default), dimension(:), allocatable, save :: sqme_rad_store
	logical :: is_soft, is_collinear_plus, is_collinear_minus, is_fsr
	real(default), parameter :: soft_threshold = 0.001_default
	real(default), parameter :: coll_threshold = 0.99_default
	real(default), parameter :: rel_smallness = 0.01_default
	real(default) :: sqme_dummy, this_sqme_rad, y, xi_tilde
	logical, dimension(:), allocatable, save :: count_alr

	if (.not. allocated (sqme_rad_store)) then
	allocate (sqme_rad_store (rsub%reg_data%n_regions))
	sqme_rad_store = zero
	end if
	if (rsub%radiation_event) then
	sqme_rad_store(alr) = sqme_rad
	else
	if (.not. allocated (count_alr)) then
	allocate (count_alr (rsub%reg_data%n_regions))
	count_alr = .false.
	end if

	if (is_massless_vector (rsub%reg_data%regions(alr)%flst_real%flst(rsub%reg_data%n_legs_real))) then
	xi_tilde = rsub%real_kinematics%xi_tilde
	is_soft = xi_tilde < soft_threshold
	else
	is_soft = .false.
	end if
	y = rsub%real_kinematics%y(i_phs)
	is_collinear_plus = y > coll_threshold .and. &
	rsub%reg_data%regions(alr)%has_collinear_divergence()
	is_collinear_minus = -y > coll_threshold .and. &
	rsub%reg_data%regions(alr)%has_collinear_divergence()

	is_fsr = emitter > rsub%isr_kinematics%n_in

	if (is_fsr) then
	if (.not. present(sqme_coll) .or. .not. present(sqme_cs)) &
	call msg_error ("real_subtraction_register_debug_sqme: Wrong arguments for FSR")
	else
	if (.not. present(sqme_coll_plus) .or. .not. present(sqme_coll_minus) &
	.or. .not. present(sqme_cs_plus) .or. .not. present(sqme_cs_minus)) &
	call msg_error ("real_subtraction_register_debug_sqme: Wrong arguments for ISR")
	end if

	this_sqme_rad = sqme_rad_store(alr)
	if (is_soft .and. .not. is_collinear_plus .and. .not. is_collinear_minus) then
	if ( .not. nearly_equal (this_sqme_rad, sqme_soft, &
	abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
	call msg_print_color (char ("Soft MEs do not match in region " // str (alr)), COL_RED)
	else
	call msg_print_color (char ("sqme_soft OK in region " // str (alr)), COL_GREEN)
	end if
	print *, 'this_sqme_rad, sqme_soft = ', this_sqme_rad, sqme_soft
	end if

	if (is_collinear_plus .and. .not. is_soft) then
	if (is_fsr) then
	if ( .not. nearly_equal (this_sqme_rad, sqme_coll, &
	abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
	call msg_print_color (char ("Collinear MEs do not match in region " // str (alr)), COL_RED)
	else
	call msg_print_color (char ("sqme_coll OK in region " // str (alr)), COL_GREEN)
	end if
	print *, 'this_sqme_rad, sqme_coll = ', this_sqme_rad, sqme_coll
	else
	if ( .not. nearly_equal (this_sqme_rad, sqme_coll_plus, &
	abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
	call msg_print_color (char ("Collinear MEs do not match in region " // str (alr)), COL_RED)
	else
	call msg_print_color (char ("sqme_coll_plus OK in region " // str (alr)), COL_GREEN)
	end if
	print *, 'this_sqme_rad, sqme_coll_plus = ', this_sqme_rad, sqme_coll_plus
	end if
	end if

	if (is_collinear_minus .and. .not. is_soft) then
	if (.not. is_fsr) then
	if ( .not. nearly_equal (this_sqme_rad, sqme_coll_minus, &
	abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
	call msg_print_color (char ("Collinear MEs do not match in region " // str (alr)), COL_RED)
	else
	call msg_print_color (char ("sqme_coll_minus OK in region " // str (alr)), COL_GREEN)
	end if
	print *, 'this_sqme_rad, sqme_coll_minus = ', this_sqme_rad, sqme_coll_minus
	end if
	end if

	if (is_soft .and. is_collinear_plus) then
	if (is_fsr) then
	if ( .not. nearly_equal (this_sqme_rad, sqme_cs, &
	abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
	call msg_print_color (char ("Soft-collinear MEs do not match in region " // str (alr)), COL_RED)
	else
	call msg_print_color (char ("sqme_cs OK in region " // str (alr)), COL_GREEN)
	end if
	print *, 'this_sqme_rad, sqme_cs = ', this_sqme_rad, sqme_cs
	else
	if ( .not. nearly_equal (this_sqme_rad, sqme_cs_plus, &
	abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
	call msg_print_color (char ("Soft-collinear MEs do not match in region " // str (alr)), COL_RED)
	else
	call msg_print_color (char ("sqme_cs_plus OK in region " // str (alr)), COL_GREEN)
	end if
	print *, 'this_sqme_rad, sqme_cs_plus = ', this_sqme_rad, sqme_cs_plus
	end if
	end if

	if (is_soft .and. is_collinear_minus) then
	if (.not. is_fsr) then
	if ( .not. nearly_equal (this_sqme_rad, sqme_cs_minus, &
	abs_smallness=tiny(1._default), rel_smallness=rel_smallness)) then
	call msg_print_color (char ("Soft-collinear MEs do not match in region " // str (alr)), COL_RED)
	else
	call msg_print_color (char ("sqme_cs_minus OK in region " // str (alr)), COL_GREEN)
	end if
	print *, 'this_sqme_rad, sqme_cs_minus = ', this_sqme_rad, sqme_cs_minus
	end if
	end if

	count_alr (alr) = .true.
	if (all (count_alr)) then
	deallocate (count_alr)
	deallocate (sqme_rad_store)
	end if
	end if
	end subroutine real_subtraction_register_debug_sqme

	@ %def real_subtraction_register_debug_sqme
	@ For final state radiation, the subtraction remnant cross section is
	\begin{equation}
	\sigma_{\text{remn}} = \left(\sigma_{\text{soft}} - \sigma_{\text{soft-coll}}\right)
	\log (\xi_{\text{max}}) \cdot \frac{\tilde{\xi}}{\xi_{\text{cut}}}.
	\end{equation}
	There is only one factor of $\log (\xi_{\text{max}})$ for both limits
	as $\xi_{\text{max}}$ does not depend on $y$ in the case of FSR.
	We use the already computed [[sqme_soft]] and [[sqme_cs]] with a factor of
	$\tilde{\xi}$ which we have to compensate. We also need a factor $1/\xi_{\text{cut}}$ here
	to assure that the cross section is independent of this free cutoff parameter.
	However, it still remains to be motivated analytically.
	<<Real subtraction: real subtraction evaluate region fsr: procedures>>=
	function compute_sqme_remnant_fsr (sqme_soft, sqme_cs, xi_max, xi_cut, xi_tilde) result (sqme_remn)
	real(default) :: sqme_remn
	real(default), intent(in) :: sqme_soft, sqme_cs, xi_max, xi_cut, xi_tilde
	if (debug_on) call msg_debug (D_SUBTRACTION, "compute_sqme_remnant_fsr")
	sqme_remn = (sqme_soft - sqme_cs) * log (xi_max) * xi_tilde / xi_cut
	end function compute_sqme_remnant_fsr

	@ %def compute_sqme_remnant_fsr
	@
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: evaluate_region_isr => real_subtraction_evaluate_region_isr
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_evaluate_region_isr (rsub, alr, &
	emitter, i_phs, i_res, alpha_coupling) result (sqme_tot)
	real(default) :: sqme_tot
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, emitter, i_phs, i_res
	real(default), intent(in) :: alpha_coupling
	end function real_subtraction_evaluate_region_isr
	<<Real subtraction: procedures>>=
	module function real_subtraction_evaluate_region_isr (rsub, alr, &
	emitter, i_phs, i_res, alpha_coupling) result (sqme_tot)
	real(default) :: sqme_tot
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, emitter, i_phs, i_res
	real(default), intent(in) :: alpha_coupling
	real(default) :: sqme_rad, sqme_soft, sqme_coll_plus, sqme_coll_minus
	real(default) :: sqme_cs_plus, sqme_cs_minus
	real(default) :: sqme_remn
	sqme_rad = zero; sqme_soft = zero;
	sqme_coll_plus = zero; sqme_coll_minus = zero
	sqme_cs_plus = zero; sqme_cs_minus = zero
	sqme_remn = zero
	associate (region => rsub%reg_data%regions(alr), template => rsub%settings%fks_template)
	if (rsub%radiation_event) then
	sqme_rad = rsub%sqme_real_non_sub (rsub%reg_data%get_matrix_element_index (alr), i_phs)
	call evaluate_fks_factors (sqme_rad, rsub%reg_data, rsub%real_kinematics, &
	alr, i_phs, emitter, i_res)
	call apply_kinematic_factors_radiation (sqme_rad, rsub%real_kinematics, i_phs)
	end if
	if (rsub%subtraction_event .and. .not. (rsub%subtraction_deactivated &
	.or. region%nlo_correction_type == "none")) then
	call rsub%evaluate_subtraction_terms_isr (alr, emitter, i_phs, i_res, alpha_coupling, &
	sqme_soft, sqme_coll_plus, sqme_coll_minus, sqme_cs_plus, sqme_cs_minus)
	call apply_kinematic_factors_subtraction_isr (sqme_soft, sqme_coll_plus, &
	sqme_coll_minus, sqme_cs_plus, sqme_cs_minus, rsub%real_kinematics, i_phs)
	associate (symm_factor_fs => rsub%reg_data%born_to_real_symm_factor_fs (alr))
	sqme_soft = sqme_soft * symm_factor_fs
	sqme_coll_plus = sqme_coll_plus * symm_factor_fs
	sqme_coll_minus = sqme_coll_minus * symm_factor_fs
	sqme_cs_plus = sqme_cs_plus * symm_factor_fs
	sqme_cs_minus = sqme_cs_minus * symm_factor_fs
	end associate
	sqme_remn = compute_sqme_remnant_isr (rsub%isr_kinematics%isr_mode, &
	sqme_soft, sqme_cs_plus, sqme_cs_minus, &
	rsub%isr_kinematics, rsub%real_kinematics, i_phs, template%xi_cut)
	sqme_tot = - sqme_soft - sqme_coll_plus - sqme_coll_minus &
	+ sqme_cs_plus + sqme_cs_minus + sqme_remn
	else
	sqme_tot = sqme_rad
	end if
	end associate
	sqme_tot = sqme_tot * rsub%real_kinematics%jac_rand (i_phs)
	sqme_tot = sqme_tot * rsub%reg_data%regions(alr)%mult
	if (debug_active (D_SUBTRACTION) .and. .not. debug2_active (D_SUBTRACTION)) then
	call real_subtraction_register_debug_sqme (rsub, alr, emitter, i_phs, sqme_rad,&
	sqme_soft, sqme_coll_plus=sqme_coll_plus, sqme_coll_minus=sqme_coll_minus,&
	sqme_cs_plus=sqme_cs_plus, sqme_cs_minus=sqme_cs_minus)
	else if (debug2_active (D_SUBTRACTION)) then
	call write_computation_status_isr ()
	end if
	contains
	<<Real subtraction: evaluate region isr: procedures>>
	subroutine write_computation_status_isr (unit)
	integer, intent(in), optional :: unit
	integer :: i_born
	integer :: u
	real(default) :: xi
	u = given_output_unit (unit); if (u < 0) return
	i_born = rsub%reg_data%regions(alr)%uborn_index
	xi = rsub%real_kinematics%xi_max (i_phs) * rsub%real_kinematics%xi_tilde
	write (u,'(A,I4)') 'alr: ', alr
	write (u,'(A,I2)') 'emitter: ', emitter
	write (u,'(A,F4.2)') 'xi_max: ', rsub%real_kinematics%xi_max (i_phs)
	print *, 'xi: ', xi, 'y: ', rsub%real_kinematics%y (i_phs)
	print *, 'xb1: ', rsub%isr_kinematics%x(1), 'xb2: ', rsub%isr_kinematics%x(2)
	print *, 'random jacobian: ', rsub%real_kinematics%jac_rand (i_phs)
	write (u,'(A,ES16.9)') 'sqme_born: ', rsub%sqme_born(i_born)
	write (u,'(A,ES16.9)') 'sqme_real: ', sqme_rad
	write (u,'(A,ES16.9)') 'sqme_soft: ', sqme_soft
	write (u,'(A,ES16.9)') 'sqme_coll_plus: ', sqme_coll_plus
	write (u,'(A,ES16.9)') 'sqme_coll_minus: ', sqme_coll_minus
	write (u,'(A,ES16.9)') 'sqme_cs_plus: ', sqme_cs_plus
	write (u,'(A,ES16.9)') 'sqme_cs_minus: ', sqme_cs_minus
	write (u,'(A,ES16.9)') 'sqme_remn: ', sqme_remn
	write (u,'(A,ES16.9)') 'sqme_tot: ', sqme_tot
	write (u,'(A,ES16.9)') 'jacobian - real: ', rsub%real_kinematics%jac(i_phs)%jac(1)
	write (u,'(A,ES16.9)') 'jacobian - soft: ', rsub%real_kinematics%jac(i_phs)%jac(2)
	write (u,'(A,ES16.9)') 'jacobian - collplus: ', rsub%real_kinematics%jac(i_phs)%jac(3)
	write (u,'(A,ES16.9)') 'jacobian - collminus: ', rsub%real_kinematics%jac(i_phs)%jac(4)
	end subroutine write_computation_status_isr
	end function real_subtraction_evaluate_region_isr

	@ %def real_subtraction_evaluate_region_isr
	@ Computes the soft remnant for ISR. The formulas can be found in arXiv:1002.2581, eq. 4.21.
	and arXiv:0709.2092, sec. 5.1.2.
	This results in
	\begin{equation}
	\sigma_{\text{remn}}^{\text{ISR}} = \log(\xi_{\text{max}}(y)) \sigma_{\text{soft}}
	- \frac{1}{2} \log(\xi_{\text{max}}(1)) \sigma^{\text{soft-coll}}_{\oplus}
	- \frac{1}{2} \log(\xi_{\text{max}}(-1)) \sigma^{\text{soft-coll}}_{\ominus}
	\end{equation}
	where for ISR, $\xi_{\text{max}}$ does explicitly depend on $y$
	due to the rescaling of the $x$ values from the Born to the real partonic system according to
	\begin{equation}
	x_\oplus = \frac{\overline{x}_\oplus}{\sqrt{1-\xi}} \sqrt{\frac{2-\xi(1-y)}{2-\xi(1+y)}}
	, \qquad
	x_\ominus = \frac{\overline{x}_\ominus}{\sqrt{1-\xi}} \sqrt{\frac{2-\xi(1+y)}{2-\xi(1-y)}}
	\end{equation}
	As $\xi_{\text{max}}$ is determined by the fact that the real $x_\oplus,x_\ominus$ have to
	stay in a physically meaningful regime, i.e. $x_\oplus,x_\ominus < 1$, this leads to
	\begin{align}
	\label{eqn:xi_max_isr}
	\xi_\text{max} = 1 - \text{max}
	&\left\{\frac{2(1+y)\overline{x}_\oplus^2}{\sqrt{(1+\overline{x}_\oplus^2)^2(1-y)^2 + 16y\overline{x}_\oplus^2} + (1-y)(1-\overline{x}_\oplus^2)}\right., \\
	&\left.\frac{2(1-y)\overline{x}_\oplus^2}{\sqrt{(1+\overline{x}_\oplus^2)^2(1+y)^2 - 16y\overline{x}_\oplus^2} + (1+y)(1-\overline{x}_\oplus^2)}\right\}
	\end{align}
	and thus
	\begin{align}
	\xi_{\text{max}}(y=1) &= 1 - \overline{x}_\oplus \\
	\xi_{\text{max}}(y=-1) &= 1 - \overline{x}_\ominus
	\end{align}
	So we need to use the unrescaled $\overline{x}_\oplus,\overline{x}_\ominus$ here.
	Factors of $\frac{1}{2}$ and $\frac{1}{\tilde{\xi}}$
	are already included in the matrix elements from [[apply_kinematic_factors_subtraction_isr]].
	We keep the former and remove the latter by multiplying with $\tilde{\xi}$.
	The factor $1/\xi_{\text{cut}}$ is probably needed to assure that the cross section is
	independent of this free cutoff parameter in analogy to the FSR case.
	However, it still remains to be motivated analytically and to be validated.
	<<Real subtraction: evaluate region isr: procedures>>=
	function compute_sqme_remnant_isr (isr_mode, sqme_soft, sqme_cs_plus, sqme_cs_minus, &
	isr_kinematics, real_kinematics, i_phs, xi_cut) result (sqme_remn)
	real(default) :: sqme_remn
	integer, intent(in) :: isr_mode
	real(default), intent(in) :: sqme_soft, sqme_cs_plus, sqme_cs_minus
	type(isr_kinematics_t), intent(in) :: isr_kinematics
	type(real_kinematics_t), intent(in) :: real_kinematics
	integer, intent(in) :: i_phs
	real(default), intent(in) :: xi_cut
	real(default) :: xi_tilde, xi_max, xi_max_plus, xi_max_minus, xb_plus, xb_minus
	xi_max = real_kinematics%xi_max (i_phs)
	xi_tilde = real_kinematics%xi_tilde
	select case (isr_mode)
	case (SQRTS_VAR)
	xb_plus = isr_kinematics%x(I_PLUS)
	xb_minus = isr_kinematics%x(I_MINUS)
	xi_max_plus = one - xb_plus
	xi_max_minus = one - xb_minus
	case (SQRTS_FIXED)
	xi_max_plus = real_kinematics%xi_max (i_phs)
	xi_max_minus = real_kinematics%xi_max (i_phs)
	end select
	sqme_remn = log (xi_max) * xi_tilde * sqme_soft &
	- log (xi_max_plus) * xi_tilde * sqme_cs_plus &
	- log (xi_max_minus) * xi_tilde * sqme_cs_minus
	sqme_remn = sqme_remn / xi_cut
	end function compute_sqme_remnant_isr

	@ %def compute_sqme_remnant_isr
	@
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: evaluate_subtraction_terms_fsr => &
	real_subtraction_evaluate_subtraction_terms_fsr
	<<Real subtraction: sub interfaces>>=
	module subroutine real_subtraction_evaluate_subtraction_terms_fsr &
	(rsub, alr, emitter, i_phs, i_res, alpha_coupling, sqme_soft, &
	sqme_coll, sqme_cs)
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, emitter, i_phs, i_res
	real(default), intent(in) :: alpha_coupling
	real(default), intent(out) :: sqme_soft, sqme_coll, sqme_cs
	end subroutine real_subtraction_evaluate_subtraction_terms_fsr
	<<Real subtraction: procedures>>=
	module subroutine real_subtraction_evaluate_subtraction_terms_fsr &
	(rsub, alr, emitter, i_phs, i_res, alpha_coupling, sqme_soft, &
	sqme_coll, sqme_cs)
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, emitter, i_phs, i_res
	real(default), intent(in) :: alpha_coupling
	real(default), intent(out) :: sqme_soft, sqme_coll, sqme_cs
	if (debug_on) call msg_debug &
	(D_SUBTRACTION, "real_subtraction_evaluate_subtraction_terms_fsr")
	sqme_soft = zero; sqme_coll = zero; sqme_cs = zero
	associate (xi_tilde => rsub%real_kinematics%xi_tilde, &
	y => rsub%real_kinematics%y(i_phs), &
	template => rsub%settings%fks_template)
	if (template%xi_cut > xi_tilde) &
	sqme_soft = rsub%compute_sub_soft &
	(alr, emitter, i_phs, i_res, alpha_coupling)
	if (y - 1 + template%delta_o > 0) &
	sqme_coll = rsub%compute_sub_coll &
	(alr, emitter, i_phs, alpha_coupling)
	if (template%xi_cut > xi_tilde .and. y - 1 + template%delta_o > 0) &
	sqme_cs = rsub%compute_sub_coll_soft &
	(alr, emitter, i_phs, alpha_coupling)
	if (debug2_active (D_SUBTRACTION)) then
	print *, "FSR Cutoff:"
	print *, "sub_soft: ", &
	template%xi_cut > xi_tilde, "(ME: ", sqme_soft, ")"
	print *, "sub_coll: ", &
	(y - 1 + template%delta_o) > 0, "(ME: ", sqme_coll, ")"
	print *, "sub_coll_soft: ", &
	template%xi_cut > xi_tilde .and. (y - 1 + template%delta_o) > 0, &
	"(ME: ", sqme_cs, ")"
	end if
	end associate
	end subroutine real_subtraction_evaluate_subtraction_terms_fsr

	@ %def real_subtraction_evaluate_subtraction_terms_fsr
	@
	<<Real subtraction: procedures>>=
	subroutine evaluate_fks_factors (sqme, reg_data, real_kinematics, &
	alr, i_phs, emitter, i_res)
	real(default), intent(inout) :: sqme
	type(region_data_t), intent(inout) :: reg_data
	type(real_kinematics_t), intent(in), target :: real_kinematics
	integer, intent(in) :: alr, i_phs, emitter, i_res
	real(default) :: s_alpha
	type(phs_point_set_t), pointer :: p_real => null ()
	if (reg_data%has_pseudo_isr ()) then
	p_real => real_kinematics%p_real_onshell (i_phs)
	else
	p_real => real_kinematics%p_real_cms
	end if
	s_alpha = reg_data%get_svalue (p_real%get_momenta(i_phs), alr, emitter, i_res)
	if (debug2_active (D_SUBTRACTION)) call msg_print_color('s_alpha', s_alpha, COL_YELLOW)
	if (s_alpha > one + tiny_07) call msg_fatal ("s_alpha > 1!")
	sqme = sqme * s_alpha
	associate (region => reg_data%regions(alr))
	if (emitter > reg_data%n_in) then
	if (debug2_active (D_SUBTRACTION)) &
	print *, 'Double FSR: ', region%double_fsr_factor (p_real%get_momenta(i_phs))
	sqme = sqme * region%double_fsr_factor (p_real%get_momenta(i_phs))
	end if
	end associate
	end subroutine evaluate_fks_factors

	@ %def evaluate_fks_factors
	@ Applies the kinematic dependent part of the Jacobian
	to the squared matrix element. During integration and when generating
	fixed order events, the non-kinematic part $\frac{s}{(4\pi)^3}$ is applied
	in [[real_subtraction_compute]] via [[get_phs_factor]].
	The additional factor $\frac{\xi}{\tilde\xi}$ comes from
	eq.~(4.19f) in arXiv:1002.2581.
	<<Real subtraction: procedures>>=
	subroutine apply_kinematic_factors_radiation (sqme, &
	real_kinematics, i_phs)
	real(default), intent(inout) :: sqme
	type(real_kinematics_t), intent(in) :: real_kinematics
	integer, intent(in) :: i_phs
	real(default) :: xi, xi_tilde, s_b
	xi_tilde = real_kinematics%xi_tilde
	xi = xi_tilde * real_kinematics%xi_max (i_phs)
	sqme = sqme * xi*2 / xi_tilde real_kinematics%jac(i_phs)%jac(1)
	end subroutine apply_kinematic_factors_radiation

	@ %def apply_kinematic_factors_radiation
	@ This routine applies the factors in the integrand of eq. 4.20
	in arXiv:1002.2581 to the matrix elements.
	<<Real subtraction: procedures>>=
	subroutine apply_kinematic_factors_subtraction_fsr &
	(sqme_soft, sqme_coll, sqme_cs, real_kinematics, i_phs)
	real(default), intent(inout) :: sqme_soft, sqme_coll, sqme_cs
	type(real_kinematics_t), intent(in) :: real_kinematics
	integer, intent(in) :: i_phs
	real(default) :: xi_tilde, onemy
	xi_tilde = real_kinematics%xi_tilde
	onemy = one - real_kinematics%y(i_phs)
	sqme_soft = sqme_soft / onemy / xi_tilde
	sqme_coll = sqme_coll / onemy / xi_tilde
	sqme_cs = sqme_cs / onemy / xi_tilde
	associate (jac => real_kinematics%jac(i_phs)%jac)
	sqme_soft = sqme_soft * jac(2)
	sqme_coll = sqme_coll * jac(3)
	sqme_cs = sqme_cs * jac(2)
	end associate
	end subroutine apply_kinematic_factors_subtraction_fsr

	@ %def apply_kinematic_factors_subtraction_fsr
	@ This routine applies the factors in the integrand of eq. 4.21
	in arXiv:1002.2581 to the matrix elements.
	<<Real subtraction: procedures>>=
	subroutine apply_kinematic_factors_subtraction_isr &
	(sqme_soft, sqme_coll_plus, sqme_coll_minus, sqme_cs_plus, &
	sqme_cs_minus, real_kinematics, i_phs)
	real(default), intent(inout) :: sqme_soft, sqme_coll_plus, sqme_coll_minus
	real(default), intent(inout) :: sqme_cs_plus, sqme_cs_minus
	type(real_kinematics_t), intent(in) :: real_kinematics
	integer, intent(in) :: i_phs
	real(default) :: xi_tilde, y, onemy, onepy
	xi_tilde = real_kinematics%xi_tilde
	y = real_kinematics%y (i_phs)
	onemy = one - y; onepy = one + y
	associate (jac => real_kinematics%jac(i_phs)%jac)
	sqme_soft = sqme_soft / (one - y*2) / xi_tilde jac(2)
	sqme_coll_plus = sqme_coll_plus / onemy / xi_tilde / two * jac(3)
	sqme_coll_minus = sqme_coll_minus / onepy / xi_tilde / two * jac(4)
	sqme_cs_plus = sqme_cs_plus / onemy / xi_tilde / two * jac(2)
	sqme_cs_minus = sqme_cs_minus / onepy / xi_tilde / two * jac(2)
	end associate
	end subroutine apply_kinematic_factors_subtraction_isr

	@ %def apply_kinematic_factors_subtraction_isr
	@ This subroutine evaluates the soft and collinear subtraction terms for ISR.
	References:
	\begin{itemize}
	\item arXiv:0709.2092, sec. 2.4.2
	\item arXiv:0908.4272, sec. 4.2
	\end{itemize}
	For the collinear terms, the procedure is as follows:

	If the emitter is 0, then a gluon was radiated from one of the
	incoming partons. Gluon emissions require two counter terms:
	One for emission in the direction of the first incoming parton
	$\oplus$ and a second for emission in the direction of the second
	incoming parton $\ominus$ because in both cases, there are divergent
	diagrams contributing to the matrix element. So in this case both,
	[[sqme_coll_plus]] and [[sqme_coll_minus]], are non-zero.

	If the emitter is 1 or 2, then a quark was emitted instead of a
	gluon. This only leads to a divergence collinear to the emitter
	because for anti-collinear quark emission, there are simply no
	divergent diagrams in the same region as two collinear quarks that
	cannot originate in the same splitting are non-divergent. This means
	that in case the emitter is 1, we need non-zero [[sqme_coll_plus]]
	and in case the emitter is 2, we need non-zero [[sqme_coll_minus]].

	At this point, we want to remind ourselves that in case of initial
	state divergences, $y$ is just the polar angle, so the
	[[sqme_coll_minus]] terms are there to counter emissions in the
	direction of the second incoming parton $\ominus$ and {\em not} to
	counter in general anti-collinear divergences.
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: evaluate_subtraction_terms_isr => &
	real_subtraction_evaluate_subtraction_terms_isr
	<<Real subtraction: sub interfaces>>=
	module subroutine real_subtraction_evaluate_subtraction_terms_isr (rsub, &
	alr, emitter, i_phs, i_res, alpha_coupling, sqme_soft, sqme_coll_plus, &
	sqme_coll_minus, sqme_cs_plus, sqme_cs_minus)
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, emitter, i_phs, i_res
	real(default), intent(in) :: alpha_coupling
	real(default), intent(out) :: sqme_soft
	real(default), intent(out) :: sqme_coll_plus, sqme_coll_minus
	real(default), intent(out) :: sqme_cs_plus, sqme_cs_minus
	end subroutine real_subtraction_evaluate_subtraction_terms_isr
	<<Real subtraction: procedures>>=
	module subroutine real_subtraction_evaluate_subtraction_terms_isr (rsub, &
	alr, emitter, i_phs, i_res, alpha_coupling, sqme_soft, sqme_coll_plus, &
	sqme_coll_minus, sqme_cs_plus, sqme_cs_minus)
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, emitter, i_phs, i_res
	real(default), intent(in) :: alpha_coupling
	real(default), intent(out) :: sqme_soft
	real(default), intent(out) :: sqme_coll_plus, sqme_coll_minus
	real(default), intent(out) :: sqme_cs_plus, sqme_cs_minus
	sqme_coll_plus = zero; sqme_cs_plus = zero
	sqme_coll_minus = zero; sqme_cs_minus = zero
	associate (xi_tilde => rsub%real_kinematics%xi_tilde, &
	y => rsub%real_kinematics%y(i_phs), &
	template => rsub%settings%fks_template)
	if (template%xi_cut > xi_tilde) &
	sqme_soft = rsub%compute_sub_soft &
	(alr, emitter, i_phs, i_res, alpha_coupling)
	if (emitter /= 2) then
	if (y - 1 + template%delta_i > 0) then
	sqme_coll_plus = &
	rsub%compute_sub_coll (alr, 1, i_phs, alpha_coupling)
	if (template%xi_cut > xi_tilde) then
	sqme_cs_plus = &
	rsub%compute_sub_coll_soft (alr, 1, i_phs, alpha_coupling)
	end if
	end if
	end if
	if (emitter /= 1) then
	if (-y - 1 + template%delta_i > 0) then
	sqme_coll_minus = &
	rsub%compute_sub_coll (alr, 2, i_phs, alpha_coupling)
	if (template%xi_cut > xi_tilde) then
	sqme_cs_minus = &
	rsub%compute_sub_coll_soft (alr, 2, i_phs, alpha_coupling)
	end if
	end if
	end if
	if (debug2_active (D_SUBTRACTION)) then
	print *, "ISR Cutoff:"
	print *, "y: ", y
	print *, "delta_i: ", template%delta_i
	print *, "emitter: ", emitter
	print *, "sub_soft: ", &
	template%xi_cut > xi_tilde, "(ME: ", sqme_soft, ")"
	print *, "sub_coll_plus: ", &
	(y - 1 + template%delta_i) > 0, "(ME: ", sqme_coll_plus, ")"
	print *, "sub_coll_minus: ", &
	(-y - 1 + template%delta_i) > 0, "(ME: ", sqme_coll_minus, ")"
	print *, "sub_coll_soft_plus: ", template%xi_cut > xi_tilde .and. &
	(y - 1 + template%delta_i) > 0, "(ME: ", sqme_cs_plus, ")"
	print *, "sub_coll_soft_minus: ", template%xi_cut > xi_tilde .and. &
	(-y - 1 + template%delta_i) > 0, "(ME: ", sqme_cs_minus, ")"
	end if
	end associate
	end subroutine real_subtraction_evaluate_subtraction_terms_isr

	@ %def real_subtraction_evaluate_subtraction_terms_isr
	@ This is basically the global part of the real Jacobian corresponding to
	\begin{equation*}
	\frac{q^2}{8 (2\pi)^3}.
	\end{equation*}
	We interpret it as the additional phase space factor of the real component,
	to be more consistent with the evaluation of the Born phase space.

	We specifically use the Born center-of-mass energy here.
	The real center-of-mass energy is only different from the Born center-of-mass
	energy in case of ISR. The missing factor $\frac{1}{1 - \xi}$ for this
	conversion is supplied in [[phs_fks_generator_generate_isr]].
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: get_phs_factor => real_subtraction_get_phs_factor
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_get_phs_factor &
	(rsub, i_con) result (factor)
	real(default) :: factor
	class(real_subtraction_t), intent(in) :: rsub
	integer, intent(in) :: i_con
	end function real_subtraction_get_phs_factor
	<<Real subtraction: procedures>>=
	module function real_subtraction_get_phs_factor (rsub, i_con) result (factor)
	real(default) :: factor
	class(real_subtraction_t), intent(in) :: rsub
	integer, intent(in) :: i_con
	real(default) :: s
	s = rsub%real_kinematics%xi_ref_momenta (i_con)**2
	factor = s / (8 * twopi3)
	end function real_subtraction_get_phs_factor

	@ %def real_subtraction_get_phs_factor
	@
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: get_i_contributor => real_subtraction_get_i_contributor
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_get_i_contributor &
	(rsub, alr) result (i_con)
	integer :: i_con
	class(real_subtraction_t), intent(in) :: rsub
	integer, intent(in) :: alr
	end function real_subtraction_get_i_contributor
	<<Real subtraction: procedures>>=
	module function real_subtraction_get_i_contributor (rsub, alr) result (i_con)
	integer :: i_con
	class(real_subtraction_t), intent(in) :: rsub
	integer, intent(in) :: alr
	if (allocated (rsub%reg_data%alr_to_i_contributor)) then
	i_con = rsub%reg_data%alr_to_i_contributor (alr)
	else
	i_con = 1
	end if
	end function real_subtraction_get_i_contributor

	@ %def real_subtraction_get_i_contributor
	@ Computes the soft subtraction term.
	If there is an initial state emission having a soft divergence, then a gluon
	has to have been emitted. A gluon can always be emitted from both IS partons
	and thus, we can take the [[sf_factor]] for emitter $0$ in this case.
	Be aware that this approach will not work for $pe$ collisions.
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: compute_sub_soft => real_subtraction_compute_sub_soft
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_compute_sub_soft (rsub, alr, emitter, &
	i_phs, i_res, alpha_coupling) result (sqme_soft)
	real(default) :: sqme_soft
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, emitter, i_phs, i_res
	real(default), intent(in) :: alpha_coupling
	end function real_subtraction_compute_sub_soft
	<<Real subtraction: procedures>>=
	module function real_subtraction_compute_sub_soft (rsub, alr, emitter, &
	i_phs, i_res, alpha_coupling) result (sqme_soft)
	real(default) :: sqme_soft
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, emitter, i_phs, i_res
	real(default), intent(in) :: alpha_coupling
	integer :: i_xi_ref, i_born
	real(default) :: q2, sf_factor
	type(vector4_t), dimension(:), allocatable :: p_born
	associate (real_kinematics => rsub%real_kinematics, &
	nlo_corr_type => rsub%reg_data%regions(alr)%nlo_correction_type, &
	sregion => rsub%reg_data%regions(alr))
	sqme_soft = zero
	if (sregion%has_soft_divergence ()) then
	i_xi_ref = rsub%sub_soft%i_xi_ref (alr, i_phs)
	q2 = real_kinematics%xi_ref_momenta (i_xi_ref)**2
	allocate (p_born (rsub%reg_data%n_legs_born))
	if (rsub%reg_data%has_pseudo_isr ()) then
	p_born = real_kinematics%p_born_onshell%get_momenta (1)
	else
	p_born = real_kinematics%p_born_cms%get_momenta (1)
	end if
	if (emitter > rsub%sub_soft%reg_data%n_in) then
	call rsub%sub_soft%create_softvec_fsr &
	(p_born, real_kinematics%y_soft(i_phs), &
	real_kinematics%phi, emitter, &
	real_kinematics%xi_ref_momenta(i_xi_ref))
	sf_factor = one
	else
	call rsub%sub_soft%create_softvec_isr &
	(real_kinematics%y_soft(i_phs), real_kinematics%phi)
	sf_factor = rsub%sf_factors(alr, 0)
	end if
	i_born = sregion%uborn_index
	select case (char (nlo_corr_type))
	case ("QCD")
	sqme_soft = rsub%sub_soft%compute &
	(p_born, rsub%sqme_born_color_c(:,:,i_born) * &
	sf_factor, real_kinematics%y(i_phs), &
	q2, alpha_coupling, alr, emitter, i_res)
	case ("EW")
	sqme_soft = rsub%sub_soft%compute &
	(p_born, rsub%sqme_born_charge_c(:,:,i_born) * &
	sf_factor, real_kinematics%y(i_phs), &
	q2, alpha_coupling, alr, emitter, i_res)
	end select
	end if
	end associate
	if (debug2_active (D_SUBTRACTION)) call check_soft_vector ()
	contains
	subroutine check_soft_vector ()
	!!! p_soft = p_gluon / E_gluon only in the soft limit
	!!! This check only has to be passed for ISR or for FSR if ?test_soft_limit = true is set.
	type(vector4_t) :: p_gluon
	if (debug_on) call msg_debug2 (D_SUBTRACTION, "Compare soft vector: ")
	print *, 'p_soft: ', rsub%sub_soft%p_soft%p
	print *, 'Normalized gluon momentum: '
	if (rsub%reg_data%has_pseudo_isr ()) then
	p_gluon = rsub%real_kinematics%p_real_onshell(thr_leg(emitter))%get_momentum &
	(i_phs, rsub%reg_data%n_legs_real)
	else
	p_gluon = rsub%real_kinematics%p_real_cms%get_momentum &
	(i_phs, rsub%reg_data%n_legs_real)
	end if
	call vector4_write (p_gluon / p_gluon%p(0), show_mass = .true.)
	end subroutine check_soft_vector
	end function real_subtraction_compute_sub_soft

	@ %def real_subtraction_compute_sub_soft
	@
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: get_spin_correlation_term => &
	real_subtraction_get_spin_correlation_term
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_get_spin_correlation_term &
	(rsub, alr, i_born, emitter) result (mom_times_sqme)
	real(default) :: mom_times_sqme
	class(real_subtraction_t), intent(in) :: rsub
	integer, intent(in) :: alr, i_born, emitter
	end function real_subtraction_get_spin_correlation_term
	<<Real subtraction: procedures>>=
	module function real_subtraction_get_spin_correlation_term &
	(rsub, alr, i_born, emitter) result (mom_times_sqme)
	real(default) :: mom_times_sqme
	class(real_subtraction_t), intent(in) :: rsub
	integer, intent(in) :: alr, i_born, emitter
	real(default), dimension(0:3) :: k_perp
	integer :: mu, nu
	if (rsub%sc_required(alr)) then
	if (debug2_active(D_SUBTRACTION)) call check_me_consistency ()
	associate (real_kin => rsub%real_kinematics)
	if (emitter > rsub%reg_data%n_in) then
	k_perp = real_subtraction_compute_k_perp_fsr ( &
	real_kin%p_born_lab%get_momentum(1, emitter), &
	rsub%real_kinematics%phi)
	else
	k_perp = real_subtraction_compute_k_perp_isr ( &
	real_kin%p_born_lab%get_momentum(1, emitter), &
	rsub%real_kinematics%phi)
	end if
	end associate
	mom_times_sqme = zero
	do mu = 1, 3
	do nu = 1, 3
	mom_times_sqme = mom_times_sqme + &
	k_perp(mu) * k_perp(nu) * rsub%sqme_born_spin_c (mu, nu, emitter, i_born)
	end do
	end do
	else
	mom_times_sqme = zero
	end if
	contains
	subroutine check_me_consistency ()
	real(default) :: sqme_sum
	if (debug_on) call msg_debug2 (D_SUBTRACTION, "Spin-correlation: Consistency check")
	sqme_sum = &
	- rsub%sqme_born_spin_c(1,1,emitter,i_born) &
	- rsub%sqme_born_spin_c(2,2,emitter,i_born) &
	- rsub%sqme_born_spin_c(3,3,emitter,i_born)
	if (.not. nearly_equal (sqme_sum, -rsub%sqme_born(i_born))) then
	print *, 'Spin-correlated matrix elements are not consistent: '
	print *, 'emitter: ', emitter
	print *, 'g^{mu,nu} B_{mu,nu}: ', -sqme_sum
	print *, 'all Born matrix elements: ', rsub%sqme_born
	call msg_fatal ("FAIL")
	else
	call msg_print_color ("Success", COL_GREEN)
	end if
	end subroutine check_me_consistency
	end function real_subtraction_get_spin_correlation_term

	@ %def real_subtraction_get_spin_correlation_term
	@ Construct a normalised momentum perpendicular to momentum [[p]] and
	rotate by an arbitrary angle [[phi]]. The angular conventions we use
	here are equivalent to those used by POWHEG.
	<<Real subtraction: public>>=
	public :: real_subtraction_compute_k_perp_fsr
	public :: real_subtraction_compute_k_perp_isr
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_compute_k_perp_fsr &
	(p, phi) result (k_perp_fsr)
	real(default), dimension(0:3) :: k_perp_fsr
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: phi
	end function real_subtraction_compute_k_perp_fsr
	module function real_subtraction_compute_k_perp_isr &
	(p, phi) result (k_perp_isr)
	real(default), dimension(0:3) :: k_perp_isr
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: phi
	end function real_subtraction_compute_k_perp_isr
	<<Real subtraction: procedures>>=
	module function real_subtraction_compute_k_perp_fsr &
	(p, phi) result (k_perp_fsr)
	real(default), dimension(0:3) :: k_perp_fsr
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: phi
	type(vector4_t) :: k
	type(vector3_t) :: vec
	type(lorentz_transformation_t) :: rot
	vec = p%p(1:3) / p%p(0)
	k%p(0) = zero
	k%p(1) = p%p(1); k%p(2) = p%p(2)
	k%p(3) = - (p%p(1)2 + p%p(2)2) / p%p(3)
	rot = rotation (cos(phi), sin(phi), vec)
	k = rot * k
	k%p(1:3) = k%p(1:3) / space_part_norm (k)
	k_perp_fsr = k%p
	end function real_subtraction_compute_k_perp_fsr

	module function real_subtraction_compute_k_perp_isr &
	(p, phi) result (k_perp_isr)
	real(default), dimension(0:3) :: k_perp_isr
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: phi
	k_perp_isr(0) = zero
	k_perp_isr(1) = sin(phi)
	k_perp_isr(2) = cos(phi)
	k_perp_isr(3) = zero
	end function real_subtraction_compute_k_perp_isr

	@ %def real_subtraction_compute_k_perp_fsr, real_subtraction_compute_k_perp_isr
	@
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: compute_sub_coll => real_subtraction_compute_sub_coll
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_compute_sub_coll &
	(rsub, alr, em, i_phs, alpha_coupling) result (sqme_coll)
	real(default) :: sqme_coll
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, em, i_phs
	real(default), intent(in) :: alpha_coupling
	end function real_subtraction_compute_sub_coll
	<<Real subtraction: procedures>>=
	module function real_subtraction_compute_sub_coll &
	(rsub, alr, em, i_phs, alpha_coupling) result (sqme_coll)
	real(default) :: sqme_coll
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, em, i_phs
	real(default), intent(in) :: alpha_coupling
	real(default) :: xi, xi_max
	real(default) :: mom_times_sqme_spin_c, sqme_born_coll
	real(default) :: N_col
	integer :: i_con, i
	real(default) :: pfr
	associate (sregion => rsub%reg_data%regions(alr))
	sqme_coll = zero
	sqme_born_coll = zero
	N_col = 1
	if (sregion%has_collinear_divergence ()) then
	xi = rsub%real_kinematics%xi_tilde * rsub%real_kinematics%xi_max(i_phs)
	if (rsub%sub_coll%use_resonance_mappings) then
	i_con = rsub%reg_data%alr_to_i_contributor (alr)
	else
	i_con = 1
	end if
	mom_times_sqme_spin_c = &
	rsub%get_spin_correlation_term (alr, sregion%uborn_index, em)
	if (rsub%reg_data%nlo_correction_type == "EW" .and. &
	sregion%nlo_correction_type == "QCD" .and. &
	qcd_ew_interferences (sregion%flst_uborn%flst)) then
	do i = 1, size (sregion%flst_uborn%flst)
	if (is_quark (sregion%flst_uborn%flst (i))) then
	sqme_born_coll = &
	-rsub%sqme_born_color_c (i, i, sregion%uborn_index)/CF
	exit
	end if
	end do
	else
	sqme_born_coll = rsub%sqme_born(sregion%uborn_index)
	end if
	if (em <= rsub%sub_coll%n_in) then
	select case (rsub%isr_kinematics%isr_mode)
	case (SQRTS_FIXED)
	xi_max = rsub%real_kinematics%xi_max(i_phs)
	case (SQRTS_VAR)
	xi_max = one - rsub%isr_kinematics%x(em)
	end select
	xi = rsub%real_kinematics%xi_tilde * xi_max
	if (sregion%nlo_correction_type == "QCD") then
	call rsub%sub_coll%set_parameters (CA = CA, CF = CF, TR = TR)
	else if (sregion%nlo_correction_type == "EW") then
	if (is_quark (sregion%flst_real%flst(size(sregion%flst_real%flst)))) N_col = 3
	call rsub%sub_coll%set_parameters (CA = zero, &
	CF = sregion%flst_real%charge(em)**2, &
	TR = N_colsregion%flst_real%charge(size(sregion%flst_real%flst))*2)
	end if
	sqme_coll = rsub%sub_coll%compute_isr (em, sregion%flst_real%flst, &
	rsub%real_kinematics%p_born_lab%phs_point(1)%get (), &
	sqme_born_coll * rsub%sf_factors(alr, em), &
	mom_times_sqme_spin_c * rsub%sf_factors(alr, em), &
	xi, alpha_coupling, rsub%isr_kinematics%isr_mode)
	else
	if (sregion%nlo_correction_type == "QCD") then
	call rsub%sub_coll%set_parameters (CA = CA, CF = CF, TR = TR)
	else if (sregion%nlo_correction_type == "EW") then
	if (is_quark (sregion%flst_real%flst(sregion%emitter))) N_col = 3
	call rsub%sub_coll%set_parameters (CA = zero, &
	CF = sregion%flst_real%charge(sregion%emitter)**2, &
	TR = N_colsregion%flst_real%charge(sregion%emitter)*2)
	end if
	sqme_coll = rsub%sub_coll%compute_fsr (sregion%emitter, &
	sregion%flst_real%flst, &
	rsub%real_kinematics%xi_ref_momenta (i_con), &
	rsub%real_kinematics%p_born_lab%get_momenta(1), &
	sqme_born_coll, &
	mom_times_sqme_spin_c, &
	xi, alpha_coupling, sregion%double_fsr)
	if (rsub%sub_coll%use_resonance_mappings) then
	select type (fks_mapping => rsub%reg_data%fks_mapping)
	type is (fks_mapping_resonances_t)
	pfr = fks_mapping%get_resonance_weight (alr, &
	rsub%real_kinematics%p_born_cms%get_momenta(1))
	end select
	sqme_coll = sqme_coll * pfr
	end if
	end if
	end if
	end associate
	end function real_subtraction_compute_sub_coll

	@ %def real_subtraction_compute_sub_coll
	@ Computes the soft-collinear subtraction term. For alpha regions with emitter
	$0$, this routine is called with [[em == 1]] and [[em == 2]] separately.
	To still be able to use the unrescaled pdf factors stored in [[sf_factors(alr, 0)]]
	in this case, we need to differentiate between [[em]] and [[em_pdf = 0]].
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: compute_sub_coll_soft => real_subtraction_compute_sub_coll_soft
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_compute_sub_coll_soft &
	(rsub, alr, em, i_phs, alpha_coupling) result (sqme_cs)
	real(default) :: sqme_cs
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, em, i_phs
	real(default), intent(in) :: alpha_coupling
	end function real_subtraction_compute_sub_coll_soft
	<<Real subtraction: procedures>>=
	module function real_subtraction_compute_sub_coll_soft &
	(rsub, alr, em, i_phs, alpha_coupling) result (sqme_cs)
	real(default) :: sqme_cs
	class(real_subtraction_t), intent(inout) :: rsub
	integer, intent(in) :: alr, em, i_phs
	real(default), intent(in) :: alpha_coupling
	real(default) :: mom_times_sqme_spin_c, sqme_born_coll
	real(default) :: N_col
	integer :: i_con, em_pdf, i
	associate (sregion => rsub%reg_data%regions(alr))
	sqme_cs = zero
	sqme_born_coll = zero
	N_col = 1
	if (sregion%has_collinear_divergence ()) then
	if (rsub%sub_coll%use_resonance_mappings) then
	i_con = rsub%reg_data%alr_to_i_contributor (alr)
	else
	i_con = 1
	end if
	mom_times_sqme_spin_c = rsub%get_spin_correlation_term (alr, sregion%uborn_index, em)
	if (rsub%reg_data%nlo_correction_type == "EW" .and. &
	sregion%nlo_correction_type == "QCD" .and. &
	qcd_ew_interferences (sregion%flst_uborn%flst)) then
	do i = 1, size (sregion%flst_uborn%flst)
	if (is_quark (sregion%flst_uborn%flst (i))) then
	sqme_born_coll = -rsub%sqme_born_color_c (i, i, sregion%uborn_index)/CF
	exit
	end if
	end do
	else
	sqme_born_coll = rsub%sqme_born(sregion%uborn_index)
	end if
	if (em <= rsub%sub_coll%n_in) then
	em_pdf = 0
	if (sregion%nlo_correction_type == "QCD") then
	call rsub%sub_coll%set_parameters (CA = CA, CF = CF, TR = TR)
	else if (sregion%nlo_correction_type == "EW") then
	if (is_quark (sregion%flst_real%flst(size(sregion%flst_real%flst)))) N_col = 3
	call rsub%sub_coll%set_parameters (CA = zero, &
	CF = sregion%flst_real%charge(em)**2, &
	TR = N_colsregion%flst_real%charge(size(sregion%flst_real%flst))*2)
	end if
	sqme_cs = rsub%sub_coll%compute_isr (em, sregion%flst_real%flst, &
	rsub%real_kinematics%p_born_lab%phs_point(1)%get (), &
	sqme_born_coll * rsub%sf_factors(alr, em_pdf), &
	mom_times_sqme_spin_c * rsub%sf_factors(alr, em_pdf), &
	zero, alpha_coupling, rsub%isr_kinematics%isr_mode)
	else
	if (sregion%nlo_correction_type == "QCD") then
	call rsub%sub_coll%set_parameters (CA = CA, CF = CF, TR = TR)
	else if (sregion%nlo_correction_type == "EW") then
	if (is_quark (sregion%flst_real%flst(sregion%emitter))) N_col = 3
	call rsub%sub_coll%set_parameters (CA = zero, &
	CF = sregion%flst_real%charge(sregion%emitter)**2, &
	TR = N_colsregion%flst_real%charge(sregion%emitter)*2)
	end if
	sqme_cs = rsub%sub_coll%compute_fsr (sregion%emitter, sregion%flst_real%flst, &
	rsub%real_kinematics%xi_ref_momenta(i_con), &
	rsub%real_kinematics%p_born_lab%phs_point(1)%get (), &
	sqme_born_coll, &
	mom_times_sqme_spin_c, &
	zero, alpha_coupling, sregion%double_fsr)
	end if
	end if
	end associate
	end function real_subtraction_compute_sub_coll_soft

	@ %def real_subtraction_compute_sub_coll_soft
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: requires_spin_correlations => &
	real_subtraction_requires_spin_correlations
	<<Real subtraction: sub interfaces>>=
	module function real_subtraction_requires_spin_correlations &
	(rsub) result (val)
	logical :: val
	class(real_subtraction_t), intent(in) :: rsub
	end function real_subtraction_requires_spin_correlations
	<<Real subtraction: procedures>>=
	module function real_subtraction_requires_spin_correlations &
	(rsub) result (val)
	logical :: val
	class(real_subtraction_t), intent(in) :: rsub
	val = any (rsub%sc_required)
	end function real_subtraction_requires_spin_correlations

	@ %def real_subtraction_requires_spin_correlations
	@
	<<Real subtraction: real subtraction: TBP>>=
	procedure :: final => real_subtraction_final
	<<Real subtraction: sub interfaces>>=
	module subroutine real_subtraction_final (rsub)
	class(real_subtraction_t), intent(inout) :: rsub
	end subroutine real_subtraction_final
	<<Real subtraction: procedures>>=
	module subroutine real_subtraction_final (rsub)
	class(real_subtraction_t), intent(inout) :: rsub
	call rsub%sub_soft%final ()
	call rsub%sub_coll%final ()
	!!! Finalization of region data is done in pcm_nlo_final
	if (associated (rsub%reg_data)) nullify (rsub%reg_data)
	!!! Finalization of real kinematics is done in pcm_instance_nlo_final
	if (associated (rsub%real_kinematics)) nullify (rsub%real_kinematics)
	if (associated (rsub%isr_kinematics)) nullify (rsub%isr_kinematics)
	if (allocated (rsub%sqme_real_non_sub)) deallocate (rsub%sqme_real_non_sub)
	if (allocated (rsub%sqme_born)) deallocate (rsub%sqme_born)
	if (allocated (rsub%sf_factors)) deallocate (rsub%sf_factors)
	+ if (allocated (rsub%sqme_real_arr)) deallocate (rsub%sqme_real_arr)
	if (allocated (rsub%sqme_born_color_c)) deallocate (rsub%sqme_born_color_c)
	if (allocated (rsub%sqme_born_charge_c)) deallocate (rsub%sqme_born_charge_c)
	if (allocated (rsub%sc_required)) deallocate (rsub%sc_required)
	if (allocated (rsub%selected_alr)) deallocate (rsub%selected_alr)
	end subroutine real_subtraction_final

	@ %def real_subtraction_final
	@ \subsubsection{Partitions of the real matrix element and Powheg damping}
	<<Real subtraction: public>>=
	public :: real_partition_t
	<<Real subtraction: types>>=
	type, abstract :: real_partition_t
	contains
	<<Real subtraction: real partition: TBP>>
	end type real_partition_t

	@ %def real partition_t
	@
	<<Real subtraction: real partition: TBP>>=
	procedure (real_partition_init), deferred :: init
	<<Real subtraction: interfaces>>=
	abstract interface
	subroutine real_partition_init (partition, scale, reg_data)
	import
	class(real_partition_t), intent(out) :: partition
	real(default), intent(in) :: scale
	type(region_data_t), intent(in) :: reg_data
	end subroutine real_partition_init
	end interface

	@ %def real_partition_init
	@
	<<Real subtraction: real partition: TBP>>=
	procedure (real_partition_write), deferred :: write
	<<Real subtraction: interfaces>>=
	abstract interface
	subroutine real_partition_write (partition, unit)
	import
	class(real_partition_t), intent(in) :: partition
	integer, intent(in), optional :: unit
	end subroutine real_partition_write
	end interface

	@ %def real_partition_write
	@ To allow really arbitrary damping functions, [[get_f]] should get the
	full real phase space as argument and not just some [[pt2]] that is
	extracted higher up.
	<<Real subtraction: real partition: TBP>>=
	procedure (real_partition_get_f), deferred :: get_f
	<<Real subtraction: interfaces>>=
	abstract interface
	function real_partition_get_f (partition, p) result (f)
	import
	real(default) :: f
	class(real_partition_t), intent(in) :: partition
	type(vector4_t), intent(in), dimension(:) :: p
	end function real_partition_get_f
	end interface

	@ %def real_partition_get_f
	@
	<<Real subtraction: public>>=
	public :: powheg_damping_simple_t
	<<Real subtraction: types>>=
	type, extends (real_partition_t) :: powheg_damping_simple_t
	real(default) :: h2 = 5._default
	integer :: emitter
	contains
	<<Real subtraction: powheg damping simple: TBP>>
	end type powheg_damping_simple_t

	@ %def powheg_damping_simple_t
	@
	<<Real subtraction: powheg damping simple: TBP>>=
	procedure :: get_f => powheg_damping_simple_get_f
	<<Real subtraction: sub interfaces>>=
	module function powheg_damping_simple_get_f (partition, p) result (f)
	real(default) :: f
	class(powheg_damping_simple_t), intent(in) :: partition
	type(vector4_t), intent(in), dimension(:) :: p
	end function powheg_damping_simple_get_f
	<<Real subtraction: procedures>>=
	module function powheg_damping_simple_get_f (partition, p) result (f)
	real(default) :: f
	class(powheg_damping_simple_t), intent(in) :: partition
	type(vector4_t), intent(in), dimension(:) :: p
	!!! real(default) :: pt2
	f = 1
	call msg_bug ("Simple damping currently not available")
	!!! TODO (cw-2017-03-01) Compute pt2 from emitter)
	!!! f = partition%h2 / (pt2 + partition%h2)
	end function powheg_damping_simple_get_f

	@ %def powheg_damping_simple_get_f
	@
	<<Real subtraction: powheg damping simple: TBP>>=
	procedure :: init => powheg_damping_simple_init
	<<Real subtraction: sub interfaces>>=
	module subroutine powheg_damping_simple_init (partition, scale, reg_data)
	class(powheg_damping_simple_t), intent(out) :: partition
	real(default), intent(in) :: scale
	type(region_data_t), intent(in) :: reg_data
	end subroutine powheg_damping_simple_init
	<<Real subtraction: procedures>>=
	module subroutine powheg_damping_simple_init (partition, scale, reg_data)
	class(powheg_damping_simple_t), intent(out) :: partition
	real(default), intent(in) :: scale
	type(region_data_t), intent(in) :: reg_data
	partition%h2 = scale**2
	end subroutine powheg_damping_simple_init

	@ %def powheg_damping_simple_init
	@
	<<Real subtraction: powheg damping simple: TBP>>=
	procedure :: write => powheg_damping_simple_write
	<<Real subtraction: sub interfaces>>=
	module subroutine powheg_damping_simple_write (partition, unit)
	class(powheg_damping_simple_t), intent(in) :: partition
	integer, intent(in), optional :: unit
	end subroutine powheg_damping_simple_write
	<<Real subtraction: procedures>>=
	module subroutine powheg_damping_simple_write (partition, unit)
	class(powheg_damping_simple_t), intent(in) :: partition
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "Powheg damping simple: "
	write (u, "(1x,A, "// FMT_15 // ")") "scale h2: ", partition%h2
	end subroutine powheg_damping_simple_write

	@ %def powheg_damping_simple_write
	@
	<<Real subtraction: public>>=
	public :: real_partition_fixed_order_t
	<<Real subtraction: types>>=
	type, extends (real_partition_t) :: real_partition_fixed_order_t
	real(default) :: scale
	type(ftuple_t), dimension(:), allocatable :: fks_pairs
	contains
	<<Real subtraction: real partition fixed order: TBP>>
	end type real_partition_fixed_order_t

	@ %def real_partition_fixed_order_t
	@
	<<Real subtraction: real partition fixed order: TBP>>=
	procedure :: init => real_partition_fixed_order_init
	<<Real subtraction: sub interfaces>>=
	module subroutine real_partition_fixed_order_init &
	(partition, scale, reg_data)
	class(real_partition_fixed_order_t), intent(out) :: partition
	real(default), intent(in) :: scale
	type(region_data_t), intent(in) :: reg_data
	end subroutine real_partition_fixed_order_init
	<<Real subtraction: procedures>>=
	module subroutine real_partition_fixed_order_init (partition, scale, reg_data)
	class(real_partition_fixed_order_t), intent(out) :: partition
	real(default), intent(in) :: scale
	type(region_data_t), intent(in) :: reg_data
	end subroutine real_partition_fixed_order_init

	@ %def real_partition_fixed_order_init
	@
	<<Real subtraction: real partition fixed order: TBP>>=
	procedure :: write => real_partition_fixed_order_write
	<<Real subtraction: sub interfaces>>=
	module subroutine real_partition_fixed_order_write (partition, unit)
	class(real_partition_fixed_order_t), intent(in) :: partition
	integer, intent(in), optional :: unit
	end subroutine real_partition_fixed_order_write
	<<Real subtraction: procedures>>=
	module subroutine real_partition_fixed_order_write (partition, unit)
	class(real_partition_fixed_order_t), intent(in) :: partition
	integer, intent(in), optional :: unit
	end subroutine real_partition_fixed_order_write

	@ %def real_partition_fixed_order_write
	@ Implements the suppression factor
	\begin{equation}
	F(\Phi_{n+1}) = 1 - \prod_{(i,j) \in P_{FKS}} \theta \left[ m_i + m_j + h - \sqrt{(p_j + p_j)^2} \right]
	\end{equation}
	to split the real matrix element into singular and finite part.
	<<Real subtraction: real partition fixed order: TBP>>=
	procedure :: get_f => real_partition_fixed_order_get_f
	<<Real subtraction: sub interfaces>>=
	module function real_partition_fixed_order_get_f (partition, p) result (f)
	real(default) :: f
	class(real_partition_fixed_order_t), intent(in) :: partition
	type(vector4_t), intent(in), dimension(:) :: p
	end function real_partition_fixed_order_get_f
	<<Real subtraction: procedures>>=
	module function real_partition_fixed_order_get_f (partition, p) result (f)
	real(default) :: f
	class(real_partition_fixed_order_t), intent(in) :: partition
	type(vector4_t), intent(in), dimension(:) :: p
	integer :: i, em
	f = zero
	PAIRS: do i = 1, size (partition%fks_pairs)
	associate (ii => partition%fks_pairs(i)%ireg)
	if (ii(1) == 0) then
	IS: do em = 1, 2
	if ((p(em) + p(ii(2)))1 < p(em)1 + p(ii(2))**1 + &
	partition%scale) then
	f = one
	exit PAIRS
	end if
	end do IS
	else
	if ((p(ii(1)) + p(ii(2)))1 < p(ii(1))1 + p(ii(2))**1 + &
	partition%scale) then
	f = one
	exit PAIRS
	end if
	end if
	end associate
	end do PAIRS
	end function real_partition_fixed_order_get_f

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

	module real_subtraction_ut
	use unit_tests
	use real_subtraction_uti

	<<Standard module head>>

	<<Real subtraction: public test>>

	contains

	<<Real subtraction: test driver>>

	end module real_subtraction_ut
	@ %def real_subtraction_ut
	@
	<<[[real_subtraction_uti.f90]]>>=
	<<File header>>

	module real_subtraction_uti
	<<Use kinds>>

	use physics_defs
	use lorentz
	use numeric_utils
	use real_subtraction

	<<Standard module head>>

	<<Real subtraction: test declarations>>

	contains

	<<Real subtraction: tests>>

	end module real_subtraction_uti
	@ %def real_subtraction_ut
	@ API: driver for the unit tests below.
	<<Real subtraction: public test>>=
	public :: real_subtraction_test
	<<Real subtraction: test driver>>=
	subroutine real_subtraction_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Real subtraction: execute tests>>
	end subroutine real_subtraction_test

	@ %def real_subtraction_test
	@ Test the final-state collinear subtraction.
	<<Real subtraction: execute tests>>=
	call test (real_subtraction_1, "real_subtraction_1", &
	"final-state collinear subtraction", &
	u, results)
	<<Real subtraction: test declarations>>=
	public :: real_subtraction_1
	<<Real subtraction: tests>>=
	subroutine real_subtraction_1 (u)
	integer, intent(in) :: u

	type(coll_subtraction_t) :: coll_sub
	real(default) :: sqme_coll
	type(vector4_t) :: p_res
	type(vector4_t), dimension(5) :: p_born
	real(default), dimension(4) :: k_perp
	real(default), dimension(4,4) :: b_munu
	integer :: mu, nu
	real(default) :: born, born_c
	integer, dimension(6) :: flst

	p_born(1)%p = [500, 0, 0, 500]
	p_born(2)%p = [500, 0, 0, -500]
	p_born(3)%p = [3.7755E+02, 2.2716E+02, -95.4172, 2.8608E+02]
	p_born(4)%p = [4.9529E+02, -2.739E+02, 84.8535, -4.0385E+02]
	p_born(5)%p = [1.2715E+02, 46.7375, 10.5637, 1.1778E+02]
	p_res = p_born(1) + p_born(2)
	flst = [11, -11 , -2, 2, -2, 2]

	b_munu(1, :) = [0., 0., 0., 0.]
	b_munu(2, :) = [0., 1., 1., 1.]
	b_munu(3, :) = [0., 1., 1., 1.]
	b_munu(4, :) = [0., 1., 1., 1.]

	k_perp = real_subtraction_compute_k_perp_fsr (p = p_born(5), phi = 0.5_default)
	born = - b_munu(1, 1) + b_munu(2, 2) + b_munu(3, 3) + b_munu(4, 4)
	born_c = 0.
	do mu = 1, 4
	do nu = 1, 4
	born_c = born_c + k_perp(mu) * k_perp(nu) * b_munu(mu, nu)
	end do
	end do

	write (u, "(A)") "* Test output: real_subtraction_1"
	write (u, "(A)") "* Purpose: final-state collinear subtraction"
	write (u, "(A)")

	write (u, "(A, L1)") "* vanishing scalar-product of 3-momenta k_perp and p_born(emitter): ", &
	nearly_equal (dot_product (p_born(5)%p(1:3), k_perp(2:4)), 0._default)

	call coll_sub%init (n_alr = 1, n_in = 2)
	call coll_sub%set_parameters (CA, CF, TR)

	write (u, "(A)")
	write (u, "(A)") "* g -> qq splitting"
	write (u, "(A)")

	sqme_coll = coll_sub%compute_fsr(5, flst, p_res, p_born, &
	born, born_c, 0.5_default, 0.25_default, .false.)

	write (u, "(A,F15.12)") "ME: ", sqme_coll

	write (u, "(A)")
	write (u, "(A)") "* g -> gg splitting"
	write (u, "(A)")

	b_munu(1, :) = [0., 0., 0., 0.]
	b_munu(2, :) = [0., 0., 0., 1.]
	b_munu(3, :) = [0., 0., 1., 1.]
	b_munu(4, :) = [0., 0., 1., 1.]

	k_perp = real_subtraction_compute_k_perp_fsr (p = p_born(5), phi = 0.5_default)
	born = - b_munu(1, 1) + b_munu(2, 2) + b_munu(3, 3) + b_munu(4, 4)
	born_c = 0.
	do mu = 1, 4
	do nu = 1, 4
	born_c = born_c + k_perp(mu) * k_perp(nu) * b_munu(mu, nu)
	end do
	end do

	flst = [11, -11, 2, -2, 21, 21]
	sqme_coll = coll_sub%compute_fsr(5, flst, p_res, p_born, &
	born, born_c, 0.5_default, 0.25_default, .true.)

	write (u, "(A,F15.12)") "ME: ", sqme_coll

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

	@ %def real_subtraction_1
	@

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Contribution of divergencies due to PDF Evolution}

	References:
	\begin{itemize}
	\item arXiv:hep-ph/9512328, (2.1)-(2.5), (4.29)-(4.53)
	\item arXiv:0709.2092, (2.102)-(2.106)
	\end{itemize}

	The parton distrubition densities have to be evaluated at NLO, too.
	The NLO PDF evolution is given by
	\begin{equation}
	\label{eqn:pdf_nlo}
	f (\bar{x}) = \int_0^1 \int_0^1 dx dz f(x) \Gamma(z) \delta (\bar{x} - x z),
	\end{equation}
	where $\Gamma$ are the DGLAP evolution kernels for an $a \to d$ splitting,
	\begin{equation}
	\label{eqn:dglap}
	\Gamma_a^{(d)} = \delta_{ad}\delta(1-x) - \frac{\alpha_s}{2\pi}
	\left(\frac{1}{\epsilon} P_{ad}(x,0) - K_{ad}(x)\right) +
	\mathcal{O}(\alpha_s^2).
	\end{equation}
	$K_{ad}$ is a renormalization scheme matching factor, which is exactly
	zero in $\overline{\text{MS}}$. Let the leading-order hadronic cross
	section be given by
	\begin{equation}
	\label{eqn:xsec_hadro_lo}
	d\sigma^{(0)}(s) = \int dx_\oplus dx_\ominus f_\oplus (x_\oplus)
	f_\ominus (x_\ominus) d\tilde{\sigma}^{(0)} (x_\oplus x_\ominus s),
	\end{equation}
	then the NLO hadronic cross section is
	\begin{equation}
	\label{eqn:xsec_hadro_nlo}
	d\sigma^{(1)}(s) = \int dx_\oplus dx_\ominus dz_\oplus dz_\ominus
	f_\oplus (x_\oplus) f_\ominus (x_\ominus)
	\underbrace{\Gamma_\oplus (z_\oplus) \Gamma_\ominus (z_\ominus)
	d\tilde{\sigma}^{(1)} (z_\oplus z_\ominus
	s)}_{d\hat{\sigma}^{(1)}}.
	\end{equation}
	$d\hat{\sigma}$ is called the subtracted partonic cross
	section. Expanding in $\alpha_s$ we find
	\begin{align}
	d\hat{\sigma}^{(0)}_{ab}(k_1, k_2) &= d\tilde{\sigma}_{ab}^{(0)} (k_1, k_2), \\
	d\hat{\sigma}^{(1)}_{ab}(k_1, k_2) &= d\tilde{\sigma}_{ab}^{(1)} (k_1, k_2) \\
	&+ \frac{\alpha_s}{2\pi} \sum_d
	\int dx \left (\frac{1}{\epsilon} P_{da}(x,0) - K_{da}(x)\right)
	d\tilde{\sigma}_{db}^{(0)}(xk_1, k_2)\\
	&+ \frac{\alpha_s}{2\pi} \sum_d \int \left (\frac{1}{\epsilon}
	P_{db} (x, 0) - K_{db}(x)\right) d\tilde{\sigma}_{ad}^{(0)}(k_1,
	xk_2).\\
	&= d\tilde{\sigma}_{ab}^{(1)} + d\tilde{\sigma}_{ab}^{(cnt,+)} +
	d\tilde{\sigma}_{ab}^{(cnt,-)}
	\end{align}

	Let us now turn to the soft-subtracted real part of the cross
	section. For ease of notation, it is constrained to one singular
	region,
	\begin{align*}
	\label{eqn:R-in}
	d\sigma^{(in)}_\alpha &= \left[\left(\frac{1}{\xi}\right)_{c} -
	2\epsilon\left(\frac{\log \xi}{\xi}\right)_{c}\right] (1-y^2)\xi^2
	\mathcal{R}_\alpha \mathcal{S}_\alpha \\
	&\times \frac{1}{2(2\pi)^{3-2\epsilon}}
	\left(\frac{\sqrt{s}}{2}\right)^{2-2\epsilon} \left( 1 -
	y^2\right)^{-1-\epsilon} d\phi d\xi dy d\Omega^{2-2\epsilon},
	\end{align*}
	where we regularize collinear divergencies using the identity
	\begin{equation*}
	\left (1 - y^2 \right)^{-1-\epsilon} =
	-\frac{2^{-\epsilon}}{2\epsilon} \left (\delta(1-y) +
	\delta(1+y)\right)
	+ \underbrace{\frac{1}{2} \left[ \left (\frac {1}{1-y}\right)_{c}
	+ \left (\frac{1}{1+y}\right)_{c} \right]}_{\mathcal{P}(y)}.
	\end{equation*}
	This enables us to split the cross section into a finite and a
	singular part. The latter can further be separated into a contribution
	of the incoming and of the outgoing particles,
	\begin{equation*}
	d\sigma^{(in)}_\alpha = d\sigma^{(in,+)}_\alpha +
	d\sigma^{(in,-)}_\alpha + d\sigma^{(in,f)}_\alpha.
	\end{equation*}
	They are given by
	\begin{align}
	d\sigma^{(in,f)}_\alpha = & \mathcal{P}(y)
	\left[\left(\frac{1}{\xi}\right)_{c} - 2\epsilon
	\left(\frac{\log\xi}{\xi}\right)_{c}\right]
	\frac{1}{2(2\pi)^{3-2\epsilon}}
	\left(\frac{\sqrt{s}}{2}\right)^{2-2\epsilon} \nonumber\\
	& \times (1-y^2)\xi^2 \mathcal{R}_\alpha \mathcal{S}_\alpha d\phi
	d\xi dy d\Omega^{2-2\epsilon}
	\label{eqn:sigma-f}
	\end{align}
	and
	\begin{align}
	d\sigma^{(in,\pm)}_\alpha &= -\frac{2^{-\epsilon}}{2\epsilon} \delta
	(1 \mp y) \left[ \left( \frac{1}{\xi}\right)_{c} - 2\epsilon
	\left(\frac{\log\xi}{\xi}\right)_{c}\right] \nonumber\\
	& \times \frac{1}{2(2\pi)^{3-2\epsilon}} \left(
	\frac{\sqrt{s}}{2}\right)^{2-2\epsilon} (1-y^2)\xi^2
	\mathcal{R}_\alpha \mathcal{S}_\alpha d\phi d\xi dy
	d\Omega^{2-2\epsilon}.
	\label{eqn:sigma-pm}
	\end{align}
	Equation \ref{eqn:sigma-f} is the contribution to the real cross
	section which is computed in [[evaluate_region_isr]]. It is
	regularized both in the soft and collinear limit via the plus
	distributions. Equation \ref{eqn:sigma-pm} is a different
	contribution. It is only present exactly in the collinear limit, due
	to the delta function. The divergences present in this term do not
	completely cancel out divergences in the virtual matrix element,
	because the beam axis is distinguished. Thus, the conditions in which
	the KLN theorem applies are not met. To see this, we carry out the
	collinear limit, obtaining
	\begin{equation*}
	\lim_{y \to 1} (1-y^2)\xi^2\mathcal{R}_\alpha = 8\pi\alpha_s
	\mu^{2\epsilon} \left(\frac{2}{\sqrt{s}}\right)^2 \xi P^<(1-\xi,
	\epsilon) \mathcal{R}_\alpha,
	\end{equation*}
	with the Altarelli-Parisi splitting kernel for $z < 1$,
	$P^<(z,\epsilon)$. Moreover, $\lim_{\vec{k} \parallel \vec{k}_1} d\phi
	= d\phi_3$ violates spatial averaging. The integration over the
	spherical angle $d\Omega$ can be carried out easily, yielding a factor
	of $2\pi^{1-\epsilon} / \Gamma(1-\epsilon)$. This allows us to
	redefine $\epsilon$,
	\begin{equation}
	\frac{1}{\epsilon} - \gamma_E + \log(4\pi) \to \frac{1}{\epsilon}.
	\end{equation}
	Coming back to $d\tilde{\sigma}_{ab}^{(cnt,+)}$ in order to make a
	connection to $d{\sigma}^{(in,+)}_\alpha$, we relate $P_{ab}(z,0)$ to
	$P^<_{ab}(z,0)$ via the equation
	\begin{equation*}
	P_{ab}(z,0) = (1-z)P_{ab}^<(z,0)\left(\frac{1}{1-z}\right)_+ +
	\gamma(a)\delta_{ab}\delta(1-z),
	\end{equation*}
	which yields
	\begin{equation} \label{eqn:sigma-cnt}
	d\tilde{\sigma}^{(cnt,+)}_{\alpha} = \frac{\alpha_s}{2\pi} \sum_d
	\left\lbrace -K_{da}(1-\xi) + \frac{1}{\epsilon}
	\left[\left(\frac{1}{\xi}\right)_+ \xi P_{da}^<(1-\xi,0)
	+ \delta_{da}\delta(\xi)\gamma(d)\right]\right\rbrace
	\mathcal{R}_\alpha \mathcal{S}_\alpha d\phi d\xi dy.
	\end{equation}
	This term has the same pole structure as eqn. \ref{eqn:sigma-pm}. This
	makes clear that the quantity
	\begin{equation}
	d\hat{\sigma}^{(in,+)} = d\tilde{\sigma}^{(in,+)} +
	d\tilde{\sigma}^{(cnt,+)}
	\end{equation}
	has no collinear poles. Therefore, our task is to add up
	eqns. \ref{eqn:sigma-pm} and \ref{eqn:sigma-cnt} in order to compute
	the finite remainder. This is the integrand which is evaluated in the
	[[dglap_remnant]] component.

	So, we have to perform an expansion of $d\hat{\sigma}^{(in,+)}$ in
	$\epsilon$. Hereby, we must not neglect the implicit
	$\epsilon$-dependence of $P^<$, which leads to additional terms
	involving the first derivative,
	\begin{equation*}
	P_{ab}^<(z,\epsilon) = P_{ab}^<(z,0) + \epsilon \frac{\partial
	P_{ab}^<(z,\epsilon)}{\partial \epsilon}\|_{\epsilon = 0} +
	\mathcal{O}(\alpha_s^2).
	\end{equation*}
	This finally gives us the equation for the collinear remnant. Note
	that there is still one soft $1/\epsilon$-pole, which cancels out with
	the corresponding expression in the soft-virtual terms.
	\begin{align} \label{eqn:sigma-in-p-final}
	d\hat{\sigma}^{(in,+)} &= \frac{\alpha_s}{2\pi} \frac{1}{\epsilon}
	\gamma(a) \mathcal{R}_\alpha \mathcal{S}_\alpha \nonumber\\
	&+ \frac{\alpha_s}{2\pi} \sum_d \left\lbrace (1-z)
	P_{da}^<(z,0)\left[\left(\frac{1}{1-z}\right)_{c}
	\log\frac{s\delta_{\mathrm{I}}}{2\mu^2} + 2
	\left(\frac{\log(1-z)}{1-z}\right)_{c}\right] \right. \nonumber\\
	&\left . -(1-z)\frac{\partial P_{da}^<(z,\epsilon)}{\partial
	\epsilon} \left(\frac{1}{1-z}\right)_{c} - K_{da}(z)\right\rbrace
	\mathcal{R}_\alpha \mathcal{S}_\alpha d\phi d\xi dy
	\end{align}


	<<[[dglap_remnant.f90]]>>=
	<<File header>>

	module dglap_remnant

	<<Use kinds with double>>
	<<Use strings>>
	use phs_fks, only: isr_kinematics_t
	use fks_regions, only: region_data_t

	use nlo_data

	<<Standard module head>>

	<<DGLAP remnant: public>>

	<<DGLAP remnant: types>>

	interface
	<<DGLAP remnant: sub interfaces>>
	end interface

	end module dglap_remnant

	@ %def module dglap_remnant
	@
	<<[[dglap_remnant_sub.f90]]>>=
	<<File header>>

	submodule (dglap_remnant) dglap_remnant_s

	use numeric_utils
	use diagnostics
	use constants
	use physics_defs
	use pdg_arrays

	implicit none

	contains

	<<DGLAP remnant: procedures>>

	end submodule dglap_remnant_s

	@ %def dglap_remnant_s
	@
	<<DGLAP remnant: public>>=
	public :: dglap_remnant_t
	<<DGLAP remnant: types>>=
	type :: dglap_remnant_t
	type(nlo_settings_t), pointer :: settings => null ()
	type(region_data_t), pointer :: reg_data => null ()
	type(isr_kinematics_t), pointer :: isr_kinematics => null ()
	real(default) :: CA = 0, CF = 0, TR = 0
	real(default), dimension(:), allocatable :: sqme_born
	real(default), dimension(:,:), allocatable :: sf_factors
	real(default), dimension(:,:,:), allocatable :: sqme_color_c_extra
	contains
	<<DGLAP remnant: dglap remnant: TBP>>
	end type dglap_remnant_t

	@ %def dglap_remnant_t
	@
	<<DGLAP remnant: dglap remnant: TBP>>=
	procedure :: init => dglap_remnant_init
	<<DGLAP remnant: sub interfaces>>=
	module subroutine dglap_remnant_init &
	(dglap, settings, reg_data, isr_kinematics)
	class(dglap_remnant_t), intent(inout) :: dglap
	type(nlo_settings_t), intent(in), target :: settings
	type(region_data_t), intent(in), target :: reg_data
	type(isr_kinematics_t), intent(in), target :: isr_kinematics
	end subroutine dglap_remnant_init
	<<DGLAP remnant: procedures>>=
	module subroutine dglap_remnant_init &
	(dglap, settings, reg_data, isr_kinematics)
	class(dglap_remnant_t), intent(inout) :: dglap
	type(nlo_settings_t), intent(in), target :: settings
	type(region_data_t), intent(in), target :: reg_data
	integer :: n_flv_born
	type(isr_kinematics_t), intent(in), target :: isr_kinematics
	dglap%reg_data => reg_data
	n_flv_born = reg_data%get_n_flv_born ()
	allocate (dglap%sf_factors (reg_data%n_regions, 0:reg_data%n_in))
	dglap%sf_factors = zero
	dglap%settings => settings
	allocate (dglap%sqme_born(n_flv_born))
	dglap%sqme_born = zero
	allocate (dglap%sqme_color_c_extra (reg_data%n_legs_born, &
	reg_data%n_legs_born, reg_data%n_flv_born))
	dglap%sqme_color_c_extra = zero
	dglap%isr_kinematics => isr_kinematics
	end subroutine dglap_remnant_init

	@ %def dglap_remnant_init
	<<DGLAP remnant: dglap remnant: TBP>>=
	procedure :: set_parameters => dglap_remnant_set_parameters
	<<DGLAP remnant: sub interfaces>>=
	module subroutine dglap_remnant_set_parameters (dglap, CA, CF, TR)
	class(dglap_remnant_t), intent(inout) :: dglap
	real(default), intent(in) :: CA, CF, TR
	end subroutine dglap_remnant_set_parameters
	<<DGLAP remnant: procedures>>=
	module subroutine dglap_remnant_set_parameters (dglap, CA, CF, TR)
	class(dglap_remnant_t), intent(inout) :: dglap
	real(default), intent(in) :: CA, CF, TR
	dglap%CA = CA
	dglap%CF = CF
	dglap%TR = TR
	end subroutine dglap_remnant_set_parameters

	@ %def dglap_remnant_set_parameters
	@ Evaluates formula \ref{eqn:sigma-in-p-final}. Note that, as also in
	the case for the real subtraction, we have to take into account an
	additional term, occuring because the integral the plus distribution
	is evaluated over is not constrained on the interval $[0,1]$.
	Explicitly, this means (see JHEP 06(2010)043, (4.11)-(4.12))
	\begin{align}
	\int_{\bar{x}_\oplus}^1 dz \left( \frac{1}{1-z} \right)_{\xi_{\text{cut}}} & =
	\log \frac{1-\bar{x}_\oplus}{\xi_{\text{cut}}} f(1) + \int_{\bar{x}_\oplus}^1
	\frac{f(z) - f(1)}{1-z}, \\
	\int_{\bar{x}_\oplus}^1 dz
	\left(\frac{\log(1-z)}{1-z}\right)_{\xi_{\text{cut}}} f(z) & =
	\frac{1}{2}\left( \log^2(1-\bar{x}_\oplus) - \log^2
	(\xi_{\text{cut}}) \right)f(1) +
	\int_{\bar{x}_\oplus}^1 \frac{\log(1-z)[f(z) - f(1)]}{1-z},
	\end{align}
	and the same of course for $\bar{x}_\ominus$. These two terms are
	stored in the [[plus_dist_remnant]] variable below.

	The option [[separate_uborns]] allows to compute the contribution of
	the DGLAP remnant separately for each underlying Born flavor
	structure. We need this option during event generation to generate
	counter events with a specific Born flavor structure.
	<<DGLAP remnant: dglap remnant: TBP>>=
	procedure :: evaluate => dglap_remnant_evaluate
	<<DGLAP remnant: sub interfaces>>=
	module subroutine dglap_remnant_evaluate &
	(dglap, alpha_coupling, separate_uborns, sqme_dglap)
	class(dglap_remnant_t), intent(inout) :: dglap
	real(default), dimension(2), intent(in) :: alpha_coupling
	logical, intent(in) :: separate_uborns
	real(default), intent(inout), dimension(:) :: sqme_dglap
	end subroutine dglap_remnant_evaluate
	<<DGLAP remnant: procedures>>=
	module subroutine dglap_remnant_evaluate &
	(dglap, alpha_coupling, separate_uborns, sqme_dglap)
	class(dglap_remnant_t), intent(inout) :: dglap
	real(default), dimension(2), intent(in) :: alpha_coupling
	logical, intent(in) :: separate_uborns
	real(default), intent(inout), dimension(:) :: sqme_dglap
	integer :: alr, emitter, i_corr
	real(default) :: sqme_alr
	logical, dimension(:,:,:), allocatable :: evaluated
	real(default) :: sb, fac_scale2
	sb = dglap%isr_kinematics%sqrts_born**2
	fac_scale2 = dglap%isr_kinematics%fac_scale**2
	allocate (evaluated(dglap%reg_data%get_n_flv_born (), &
	dglap%reg_data%get_n_flv_real (), dglap%reg_data%n_in))
	evaluated = .false.
	do alr = 1, dglap%reg_data%n_regions
	i_corr = 0
	if (dglap%reg_data%regions(alr)%nlo_correction_type == "QCD") then
	i_corr = 1
	else if (dglap%reg_data%regions(alr)%nlo_correction_type == "EW") then
	i_corr = 2
	end if
	if (allocated (dglap%settings%selected_alr)) then
	if (.not. any (dglap%settings%selected_alr == alr)) cycle
	end if
	sqme_alr = zero
	emitter = dglap%reg_data%regions(alr)%emitter
	if (emitter > dglap%reg_data%n_in .or. i_corr == 0) cycle
	associate (i_flv_born => dglap%reg_data%regions(alr)%uborn_index, &
	i_flv_real => dglap%reg_data%regions(alr)%real_index)
	if (emitter == 0) then
	do emitter = 1, 2
	if (evaluated(i_flv_born, i_flv_real, emitter)) cycle
	call evaluate_alr (alr, emitter, i_flv_born, &
	i_flv_real, sqme_alr, evaluated)
	end do
	else if (emitter > 0) then
	if (evaluated(i_flv_born, i_flv_real, emitter)) cycle
	call evaluate_alr (alr, emitter, i_flv_born, &
	i_flv_real, sqme_alr, evaluated)
	end if
	if (separate_uborns) then
	sqme_dglap(i_flv_born) = sqme_dglap(i_flv_born) &
	+ alpha_coupling (i_corr)/ twopi * sqme_alr
	else
	sqme_dglap(1) = sqme_dglap(1) &
	+ alpha_coupling (i_corr) / twopi * sqme_alr
	end if
	end associate
	end do

	contains
	<<DGLAP remnant: dglap remnant evaluate: procedures>>
	end subroutine dglap_remnant_evaluate

	@ %def dglap_remnant_evaluate
	@ We introduce $\hat{P}(z, \epsilon) = (1 - z) P(z, \epsilon)$ and have
	\begin{align}
	\hat{P}_{g\to gg}(z) & = 2C_A \left[z + \frac{(1-z)^2}{z} + z(1-z)^2\right], \\
	\hat{P}_{g\to qq}(z) & = C_F (1-z) \frac{1 + (1-z)^2}{z}, \\
	\hat{P}_{q\to gq}(z) & = T_F (1 - z - 2z(1-z)^2), \\
	\hat{P}_{q\to qg}(z) & = C_F (1 + z^2).
	\end{align}
	<<DGLAP remnant: dglap remnant evaluate: procedures>>=
	function p_hat_gtogg (z)
	real(default) :: p_hat_gtogg
	<<p variables>>
	p_hat_gtogg = two * dglap%CA * (z + onemz*2 / z + z onemz**2)
	end function p_hat_gtogg

	function p_hat_gtoqq (z)
	real(default) :: p_hat_gtoqq
	<<p variables>>
	p_hat_gtoqq = dglap%CF * onemz / z * (one + onemz**2)
	end function p_hat_gtoqq

	function p_hat_qtogq (z)
	real(default) :: p_hat_qtogq
	<<p variables>>
	p_hat_qtogq = dglap%TR * (onemz - two * z * onemz**2)
	end function p_hat_qtogq

	function p_hat_qtoqg (z)
	real(default) :: p_hat_qtoqg
	real(default), intent(in) :: z
	p_hat_qtoqg = dglap%CF * (one + z**2)
	end function p_hat_qtoqg

	@ %def p_hat_qtoqg, p_hat_qtogq, p_hat_gtoqq, p_hat_gtogg
	@
	\begin{align}
	\frac{\partial P_{g\to gg}(z,\epsilon)}{\partial \epsilon}\|_{\epsilon = 0} & = 0, \\
	\frac{\partial P_{g\to qq}(z,\epsilon)}{\partial \epsilon}\|_{\epsilon = 0} & = -C_F z, \\
	\frac{\partial P_{q\to gq}(z,\epsilon)}{\partial \epsilon}\|_{\epsilon = 0} & = -
	2 T_F z (1-z), \\
	\frac{\partial P_{q\to qg}(z,\epsilon)}{\partial \epsilon}\|_{\epsilon = 0} & = -C_F (1-z).\\
	\end{align}
	<<DGLAP remnant: dglap remnant evaluate: procedures>>=
	function p_derived_gtogg (z)
	real(default) :: p_derived_gtogg
	real(default), intent(in) :: z
	p_derived_gtogg = zero
	end function p_derived_gtogg

	function p_derived_gtoqq (z)
	real(default) :: p_derived_gtoqq
	real(default), intent(in) :: z
	p_derived_gtoqq = -dglap%CF * z
	end function p_derived_gtoqq

	function p_derived_qtogq (z)
	real(default) :: p_derived_qtogq
	<<p variables>>
	p_derived_qtogq = -two * dglap%TR * z * onemz
	end function p_derived_qtogq

	function p_derived_qtoqg (z)
	real(default) :: p_derived_qtoqg
	<<p variables>>
	p_derived_qtoqg = -dglap%CF * onemz
	end function p_derived_qtoqg

	@ %def p_derived_gtogg, p_derived_gtoqq, p_derived_qtogq, p_derived_qtoqg
	@
	<<DGLAP remnant: dglap remnant evaluate: procedures>>=
	subroutine evaluate_alr (alr, emitter, i_flv_born, i_flv_real, sqme_alr, evaluated)
	integer, intent(in) :: alr, emitter, i_flv_born, i_flv_real
	real(default), intent(inout) :: sqme_alr
	logical, intent(inout), dimension(:,:,:) :: evaluated
	real(default) :: z, jac
	real(default) :: factor, factor_soft, plus_dist_remnant
	real(default) :: xb, onemz
	real(default) :: sqme_scaled, sqme_born_dglap
	real(default) :: charge_rad2, charge_em2
	integer :: flv_em, flv_rad, N_col, i
	N_col = 1
	sqme_born_dglap = zero
	associate (template => dglap%settings%fks_template)
	z = dglap%isr_kinematics%z(emitter)
	flv_rad = dglap%reg_data%regions(alr)%flst_real%flst(dglap%reg_data%n_legs_real)
	flv_em = dglap%reg_data%regions(alr)%flst_real%flst(emitter)
	charge_rad2 = dglap%reg_data%regions(alr)%flst_real%charge(dglap%reg_data%n_legs_real)**2
	charge_em2 = dglap%reg_data%regions(alr)%flst_real%charge(emitter)**2
	if (dglap%reg_data%regions(alr)%nlo_correction_type == "QCD") then
	call dglap%set_parameters (CA = CA, CF = CF, TR = TR)
	else if (dglap%reg_data%regions(alr)%nlo_correction_type == "EW") then
	if (is_quark(flv_rad)) N_col = NC
	call dglap%set_parameters (CA = zero, CF = charge_em2, TR = N_col*charge_rad2)
	end if
	jac = dglap%isr_kinematics%jacobian(emitter)
	onemz = one - z
	factor = log (sb * template%delta_i / two / z / fac_scale2) / &
	onemz + two * log (onemz) / onemz
	factor_soft = log (sb * template%delta_i / two / fac_scale2) / &
	onemz + two * log (onemz) / onemz
	xb = dglap%isr_kinematics%x(emitter)
	plus_dist_remnant = log ((one - xb) / template%xi_cut) * log (sb * template%delta_i / &
	two / fac_scale2) + (log (one - xb)2 - log (template%xi_cut)2)
	end associate
	if (dglap%reg_data%nlo_correction_type == "EW" .and. &
	dglap%reg_data%regions(alr)%nlo_correction_type == "QCD" .and. &
	qcd_ew_interferences (dglap%reg_data%regions(alr)%flst_uborn%flst)) then
	do i = 1, size (dglap%reg_data%regions(alr)%flst_uborn%flst)
	if (is_quark (dglap%reg_data%regions(alr)%flst_uborn%flst (i))) then
	sqme_born_dglap = -dglap%sqme_color_c_extra (i, i, i_flv_born)/CF
	exit
	end if
	end do
	else
	sqme_born_dglap = dglap%sqme_born(i_flv_born)
	end if
	sqme_scaled = sqme_born_dglap * dglap%sf_factors(alr, emitter)
	if (is_massless_vector (flv_em) .and. is_massless_vector (flv_rad)) then
	sqme_alr = sqme_alr + p_hat_gtogg(z) * factor / z * sqme_scaled * jac &
	- p_hat_gtogg(one) * factor_soft * sqme_born_dglap * jac &
	+ p_hat_gtogg(one) * plus_dist_remnant * sqme_born_dglap
	else if (is_fermion (flv_em) .and. is_massless_vector (flv_rad)) then
	sqme_alr = sqme_alr + p_hat_qtoqg(z) * factor / z * sqme_scaled * jac &
	- p_derived_qtoqg(z) / z * sqme_scaled * jac &
	- p_hat_qtoqg(one) * factor_soft * sqme_born_dglap * jac &
	+ p_hat_qtoqg(one) * plus_dist_remnant * sqme_born_dglap
	else if (is_fermion (flv_em) .and. is_fermion (flv_rad)) then
	sqme_alr = sqme_alr + (p_hat_gtoqq(z) * factor - p_derived_gtoqq(z)) / z * jac * &
	sqme_scaled
	else if (is_massless_vector (flv_em) .and. is_fermion (flv_rad)) then
	sqme_alr = sqme_alr + (p_hat_qtogq(z) * factor - p_derived_qtogq(z)) / z * sqme_scaled * jac
	else
	sqme_alr = sqme_alr + zero
	end if
	evaluated(i_flv_born, i_flv_real, emitter) = .true.
	end subroutine evaluate_alr
	@ %dglap_remnant_evaluate_alr
	@
	<<p variables>>=
	real(default), intent(in) :: z
	real(default) :: onemz
	onemz = one - z

	@ %def variables
	@
	<<DGLAP remnant: dglap remnant: TBP>>=
	procedure :: final => dglap_remnant_final
	<<DGLAP remnant: sub interfaces>>=
	module subroutine dglap_remnant_final (dglap)
	class(dglap_remnant_t), intent(inout) :: dglap
	end subroutine dglap_remnant_final
	<<DGLAP remnant: procedures>>=
	module subroutine dglap_remnant_final (dglap)
	class(dglap_remnant_t), intent(inout) :: dglap
	if (associated (dglap%isr_kinematics)) nullify (dglap%isr_kinematics)
	if (associated (dglap%reg_data)) nullify (dglap%reg_data)
	if (associated (dglap%settings)) nullify (dglap%settings)
	if (allocated (dglap%sqme_born)) deallocate (dglap%sqme_born)
	if (allocated (dglap%sf_factors)) deallocate (dglap%sf_factors)
	end subroutine dglap_remnant_final

	@ %def dglap_remnant_final
	@
	\section{Dispatch}
	@
	<<[[dispatch_fks.f90]]>>=
	<<File header>>

	module dispatch_fks

	<<Use kinds>>
	<<Use strings>>
	use variables, only: var_list_t
	use nlo_data, only: fks_template_t, FKS_DEFAULT, FKS_RESONANCES

	<<Standard module head>>

	<<Dispatch fks: public>>

	interface
	<<Dispatch fks: sub interfaces>>
	end interface

	end module dispatch_fks
	@ %def dispatch_fks
	@
	<<[[dispatch_fks_sub.f90]]>>=
	<<File header>>

	submodule (dispatch_fks) dispatch_fks_s

	use string_utils, only: split_string

	implicit none

	contains

	<<Dispatch fks: procedures>>

	end submodule dispatch_fks_s

	@ %def dispatch_fks_s
	@ Initialize parameters used to optimize FKS calculations.
	<<Dispatch fks: public>>=
	public :: dispatch_fks_setup
	<<Dispatch fks: sub interfaces>>=
	module subroutine dispatch_fks_setup (fks_template, var_list)
	type(fks_template_t), intent(inout) :: fks_template
	type(var_list_t), intent(in) :: var_list
	end subroutine dispatch_fks_setup
	<<Dispatch fks: procedures>>=
	module subroutine dispatch_fks_setup (fks_template, var_list)
	type(fks_template_t), intent(inout) :: fks_template
	type(var_list_t), intent(in) :: var_list
	real(default) :: fks_dij_exp1, fks_dij_exp2
	type(string_t) :: fks_mapping_type
	logical :: subtraction_disabled
	type(string_t) :: exclude_from_resonance
	fks_dij_exp1 = &
	var_list%get_rval (var_str ("fks_dij_exp1"))
	fks_dij_exp2 = &
	var_list%get_rval (var_str ("fks_dij_exp2"))
	fks_mapping_type = &
	var_list%get_sval (var_str ("$fks_mapping_type"))
	subtraction_disabled = &
	var_list%get_lval (var_str ("?disable_subtraction"))
	exclude_from_resonance = &
	var_list%get_sval (var_str ("$resonances_exclude_particles"))
	if (exclude_from_resonance /= var_str ("default")) &
	call split_string (exclude_from_resonance, var_str (":"), &
	fks_template%excluded_resonances)
	call fks_template%set_parameters ( &
	exp1 = fks_dij_exp1, exp2 = fks_dij_exp2, &
	xi_min = var_list%get_rval (var_str ("fks_xi_min")), &
	y_max = var_list%get_rval (var_str ("fks_y_max")), &
	xi_cut = var_list%get_rval (var_str ("fks_xi_cut")), &
	delta_o = var_list%get_rval (var_str ("fks_delta_o")), &
	delta_i = var_list%get_rval (var_str ("fks_delta_i")))
	select case (char (fks_mapping_type))
	case ("default")
	call fks_template%set_mapping_type (FKS_DEFAULT)
	case ("resonances")
	call fks_template%set_mapping_type (FKS_RESONANCES)
	end select
	fks_template%subtraction_disabled = subtraction_disabled
	fks_template%n_f = var_list%get_ival (var_str ("alphas_nf"))
	end subroutine dispatch_fks_setup

	@ %def dispatch_fks_setup
	@
	Index: trunk/src/particles/particles.nw
	===================================================================
	--- trunk/src/particles/particles.nw (revision 8835)
	+++ trunk/src/particles/particles.nw (revision 8836)
	@@ -1,9663 +1,9688 @@
	%% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: particle objects
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Particles}
	\includemodulegraph{particles}

	This chapter collects modules that implement particle objects, for use in
	event records.

	While within interactions, all correlations are
	manifest, a particle array is derived by selecting a particular
	quantum number set. This involves tracing over all other particles,
	as far as polarization is concerned. Thus, a particle has definite
	flavor, color, and a single-particle density matrix for polarization.
	\begin{description}
	\item[su\_algebra]
	We make use of $su(N)$ generators as the basis for representing
	polarization matrices. This module defines the basis and provides
	the necessary transformation routines.
	\item[bloch\_vectors]
	This defines polarization objects in Bloch representation. The
	object describes the spin density matrix of a particle,
	currently restricted to spin $0\ldots 2$.
	\item[polarizations]
	This extends the basic polarization object such that it supports
	properties of physical particles and appropriate constructors.
	\item[particles]
	Particle objects and particle lists, as the base of event records.
	\end{description}

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{$su(N)$ Algebra}
	We need a specific choice of basis for a well-defined component
	representation. The matrix elements of $T^a$ are
	ordered as $m=\ell,\ell-1,\ldots -\ell$, i.e., from highest down to
	lowest weight, for both row and column.

	We list first the generators of the $su(2)$ subalgebras which leave
	$\|m\|$ invariant ($\|m\|\neq 0$):
	\begin{equation}
	T^{b+1,b+2,b+3} \equiv \sigma^{1,2,3}
	\end{equation}
	acting on the respective subspace $\|m\|=\ell,\ell-1,\ldots$ for
	$b=0,1,\ldots$. This defines generators $T^a$ for $a=1,\ldots 3N/2$
	($\ldots 3(N-1)/2$) for $N$ even (odd), respectively.

	The following generators successively extend this to $su(4)$, $su(6)$,
	\ldots until $su(N)$ by adding first the missing off-diagonal and then
	diagonal generators. The phase conventions are analogous.

	(It should be possible to code these conventions for generic spin, but
	in the current implementation we restrict ourselves to $s\leq 2$, i.e.,
	$N\leq 5$.)
	<<[[su_algebra.f90]]>>=
	<<File header>>

	module su_algebra

	<<Use kinds>>

	<<Standard module head>>

	<<SU algebra: public>>

	interface
	<<SU algebra: sub interfaces>>
	end interface

	end module su_algebra
	@ %def su_algebra
	@
	<<[[su_algebra_sub.f90]]>>=
	<<File header>>

	submodule (su_algebra) su_algebra_s

	use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR

	implicit none

	contains

	<<SU algebra: procedures>>

	end submodule su_algebra_s

	@ %def su_algbra_s
	@
	\subsection{$su(N)$ fundamental representation}
	The dimension of the basis for a given spin type. consecutively, starting at
	[[SCALAR=1]].
	<<SU algebra: public>>=
	public :: algebra_dimension
	<<SU algebra: sub interfaces>>=
	module function algebra_dimension (s) result (n)
	integer :: n
	integer, intent(in) :: s
	end function algebra_dimension
	<<SU algebra: procedures>>=
	module function algebra_dimension (s) result (n)
	integer :: n
	integer, intent(in) :: s
	n = fundamental_dimension (s) ** 2 - 1
	end function algebra_dimension

	@ %def algebra_dimension
	@ The dimension of the fundamental (defining) representation that we
	use. This implementation assumes that the spin type is numerically
	equal to the fundamental dimension.
	<<SU algebra: public>>=
	public :: fundamental_dimension
	<<SU algebra: sub interfaces>>=
	module function fundamental_dimension (s) result (d)
	integer :: d
	integer, intent(in) :: s
	end function fundamental_dimension
	<<SU algebra: procedures>>=
	module function fundamental_dimension (s) result (d)
	integer :: d
	integer, intent(in) :: s
	d = s
	end function fundamental_dimension

	@ %def fundamental_dimension
	@
	\subsection{Mapping between helicity and matrix index}
	Return the helicity that corresponds to a particular entry in the
	polarization matrix representation. Helicities are counted downwards,
	in integers, and zero helicity is included (omitted) for odd (even)
	spin, respectively.
	<<SU algebra: public>>=
	public :: helicity_value
	<<SU algebra: sub interfaces>>=
	module function helicity_value (s, i) result (h)
	integer :: h
	integer, intent(in) :: s, i
	end function helicity_value
	<<SU algebra: procedures>>=
	module function helicity_value (s, i) result (h)
	integer :: h
	integer, intent(in) :: s, i
	integer, dimension(1), parameter :: hh1 = [0]
	integer, dimension(2), parameter :: hh2 = [1, -1]
	integer, dimension(3), parameter :: hh3 = [1, 0, -1]
	integer, dimension(4), parameter :: hh4 = [2, 1, -1, -2]
	integer, dimension(5), parameter :: hh5 = [2, 1, 0, -1, -2]
	h = 0
	select case (s)
	case (SCALAR)
	select case (i)
	case (1:1); h = hh1(i)
	end select
	case (SPINOR)
	select case (i)
	case (1:2); h = hh2(i)
	end select
	case (VECTOR)
	select case (i)
	case (1:3); h = hh3(i)
	end select
	case (VECTORSPINOR)
	select case (i)
	case (1:4); h = hh4(i)
	end select
	case (TENSOR)
	select case (i)
	case (1:5); h = hh5(i)
	end select
	end select
	end function helicity_value

	@ %def helicity_value
	@ Inverse: return the index that corresponds to a certain
	helicity value in the chosen representation.
	<<SU algebra: public>>=
	public :: helicity_index
	<<SU algebra: sub interfaces>>=
	module function helicity_index (s, h) result (i)
	integer, intent(in) :: s, h
	integer :: i
	end function helicity_index
	<<SU algebra: procedures>>=
	module function helicity_index (s, h) result (i)
	integer, intent(in) :: s, h
	integer :: i
	integer, dimension(0:0), parameter :: hi1 = [1]
	integer, dimension(-1:1), parameter :: hi2 = [2, 0, 1]
	integer, dimension(-1:1), parameter :: hi3 = [3, 2, 1]
	integer, dimension(-2:2), parameter :: hi4 = [4, 3, 0, 2, 1]
	integer, dimension(-2:2), parameter :: hi5 = [5, 4, 3, 2, 1]
	select case (s)
	case (SCALAR)
	i = hi1(h)
	case (SPINOR)
	i = hi2(h)
	case (VECTOR)
	i = hi3(h)
	case (VECTORSPINOR)
	i = hi4(h)
	case (TENSOR)
	i = hi5(h)
	end select
	end function helicity_index

	@ %def helicity_index
	@
	\subsection{Generator Basis: Cartan Generators}
	For each supported spin type, we return specific properties of the
	set of generators via inquiry functions. This is equivalent to using
	explicit representations of the generators.

	For easy access, the properties are hard-coded and selected via case
	expressions.

	Return true if the generator \#[[i]] is in the Cartan subalgebra,
	i.e., a diagonal matrix for spin type [[s]].
	<<SU algebra: public>>=
	public :: is_cartan_generator
	<<SU algebra: sub interfaces>>=
	elemental module function is_cartan_generator (s, i) result (cartan)
	logical :: cartan
	integer, intent(in) :: s, i
	end function is_cartan_generator
	<<SU algebra: procedures>>=
	elemental module function is_cartan_generator (s, i) result (cartan)
	logical :: cartan
	integer, intent(in) :: s, i
	select case (s)
	case (SCALAR)
	case (SPINOR)
	select case (i)
	case (3); cartan = .true.
	case default
	cartan = .false.
	end select
	case (VECTOR)
	select case (i)
	case (3,8); cartan = .true.
	case default
	cartan = .false.
	end select
	case (VECTORSPINOR)
	select case (i)
	case (3,6,15); cartan = .true.
	case default
	cartan = .false.
	end select
	case (TENSOR)
	select case (i)
	case (3,6,15,24); cartan = .true.
	case default
	cartan = .false.
	end select
	case default
	cartan = .false.
	end select
	end function is_cartan_generator

	@ %def is_cartan_generator
	@ Return the index of Cartan generator \#[[k]] in the chosen
	representation. This has to conform to [[cartan]] above.
	<<SU algebra: public>>=
	public :: cartan_index
	<<SU algebra: sub interfaces>>=
	elemental module function cartan_index (s, k) result (ci)
	integer :: ci
	integer, intent(in) :: s, k
	end function cartan_index
	<<SU algebra: procedures>>=
	elemental module function cartan_index (s, k) result (ci)
	integer :: ci
	integer, intent(in) :: s, k
	integer, dimension(1), parameter :: ci2 = [3]
	integer, dimension(2), parameter :: ci3 = [3,8]
	integer, dimension(3), parameter :: ci4 = [3,6,15]
	integer, dimension(4), parameter :: ci5 = [3,6,15,24]
	select case (s)
	case (SPINOR)
	ci = ci2(k)
	case (VECTOR)
	ci = ci3(k)
	case (VECTORSPINOR)
	ci = ci4(k)
	case (TENSOR)
	ci = ci5(k)
	case default
	ci = 0
	end select
	end function cartan_index

	@ %def cartan_index
	@ The element \#[[k]] of the result vector [[a]] is equal to the
	$(h,h)$ diagonal entry of the generator matrix $T^k$. That is,
	evaluating this for all allowed values of [[h]], we recover the set of
	Cartan generator matrices.
	<<SU algebra: public>>=
	public :: cartan_element
	<<SU algebra: sub interfaces>>=
	module function cartan_element (s, h) result (a)
	real(default), dimension(:), allocatable :: a
	integer, intent(in) :: s, h
	end function cartan_element
	<<SU algebra: procedures>>=
	module function cartan_element (s, h) result (a)
	real(default), dimension(:), allocatable :: a
	integer, intent(in) :: s, h
	real(default), parameter :: sqrt2 = sqrt (2._default)
	real(default), parameter :: sqrt3 = sqrt (3._default)
	real(default), parameter :: sqrt10 = sqrt (10._default)
	allocate (a (algebra_dimension (s)), source = 0._default)
	select case (s)
	case (SCALAR)
	case (SPINOR)
	select case (h)
	case (1)
	a(3) = 1._default / 2
	case (-1)
	a(3) = -1._default / 2
	end select
	case (VECTOR)
	select case (h)
	case (1)
	a(3) = 1._default / 2
	a(8) = 1._default / (2 * sqrt3)
	case (-1)
	a(3) = -1._default / 2
	a(8) = 1._default / (2 * sqrt3)
	case (0)
	a(8) = -1._default / sqrt3
	end select
	case (VECTORSPINOR)
	select case (h)
	case (2)
	a(3) = 1._default / 2
	a(15) = 1._default / (2 * sqrt2)
	case (-2)
	a(3) = -1._default / 2
	a(15) = 1._default / (2 * sqrt2)
	case (1)
	a(6) = 1._default / 2
	a(15) = -1._default / (2 * sqrt2)
	case (-1)
	a(6) = -1._default / 2
	a(15) = -1._default / (2 * sqrt2)
	end select
	case (TENSOR)
	select case (h)
	case (2)
	a(3) = 1._default / 2
	a(15) = 1._default / (2 * sqrt2)
	a(24) = 1._default / (2 * sqrt10)
	case (-2)
	a(3) = -1._default / 2
	a(15) = 1._default / (2 * sqrt2)
	a(24) = 1._default / (2 * sqrt10)
	case (1)
	a(6) = 1._default / 2
	a(15) = -1._default / (2 * sqrt2)
	a(24) = 1._default / (2 * sqrt10)
	case (-1)
	a(6) = -1._default / 2
	a(15) = -1._default / (2 * sqrt2)
	a(24) = 1._default / (2 * sqrt10)
	case (0)
	a(24) = -4._default / (2 * sqrt10)
	end select
	end select
	end function cartan_element

	@ %def cartan_element
	@ Given an array of diagonal matrix elements [[rd]] of a generator,
	compute the array [[a]] of basis coefficients. The array must be
	ordered as defined by [[helicity_value]], i.e., highest weight first.
	The calculation is organized such that the trace of the generator,
	i.e., the sum of [[rd]] values, drops out. The result array [[a]] has
	coefficients for all basis generators, but only Cartan generators can
	get a nonzero coefficient.
	<<SU algebra: public>>=
	public :: cartan_coeff
	<<SU algebra: sub interfaces>>=
	module function cartan_coeff (s, rd) result (a)
	real(default), dimension(:), allocatable :: a
	integer, intent(in) :: s
	real(default), dimension(:), intent(in) :: rd
	end function cartan_coeff
	<<SU algebra: procedures>>=
	module function cartan_coeff (s, rd) result (a)
	real(default), dimension(:), allocatable :: a
	integer, intent(in) :: s
	real(default), dimension(:), intent(in) :: rd
	real(default), parameter :: sqrt2 = sqrt (2._default)
	real(default), parameter :: sqrt3 = sqrt (3._default)
	real(default), parameter :: sqrt10 = sqrt (10._default)
	integer :: n
	n = algebra_dimension (s)
	allocate (a (n), source = 0._default)
	select case (s)
	case (SPINOR)
	a(3) = rd(1) - rd(2)
	case (VECTOR)
	a(3) = rd(1) - rd(3)
	a(8) = (rd(1) - 2 * rd(2) + rd(3)) / sqrt3
	case (VECTORSPINOR)
	a(3) = rd(1) - rd(4)
	a(6) = rd(2) - rd(3)
	a(15) = (rd(1) - rd(2) - rd(3) + rd(4)) / sqrt2
	case (TENSOR)
	a(3) = rd(1) - rd(5)
	a(6) = rd(2) - rd(4)
	a(15) = (rd(1) - rd(2) - rd(4) + rd(5)) / sqrt2
	a(24) = (rd(1) + rd(2) - 4 * rd(3) + rd(4) + rd(5)) / sqrt10
	end select
	end function cartan_coeff

	@ %def cartan_coeff
	@
	\subsection{Roots (Off-Diagonal Generators)}
	Return the appropriate generator index for a given off-diagonal helicity
	combination. We require $h_1>h_2$. We return the index of the
	appropriate real-valued generator if [[r]] is true, else the
	complex-valued one.

	This is separate from the [[cartan_coeff]] function above. The reason
	is that the off-diagonal generators have only a single nonzero matrix
	element, so there is a one-to-one correspondence of helicity and index.
	<<SU algebra: public>>=
	public :: root_index
	<<SU algebra: sub interfaces>>=
	module function root_index (s, h1, h2, r) result (ai)
	integer :: ai
	integer, intent(in) :: s, h1, h2
	logical :: r
	end function root_index
	<<SU algebra: procedures>>=
	module function root_index (s, h1, h2, r) result (ai)
	integer :: ai
	integer, intent(in) :: s, h1, h2
	logical :: r
	ai = 0
	select case (s)
	case (SCALAR)
	case (SPINOR)
	select case (h1)
	case (1)
	select case (h2)
	case (-1); ai = 1
	end select
	end select
	case (VECTOR)
	select case (h1)
	case (1)
	select case (h2)
	case (-1); ai = 1
	case (0); ai = 4
	end select
	case (0)
	select case (h2)
	case (-1); ai = 6
	end select
	end select
	case (VECTORSPINOR)
	select case (h1)
	case (2)
	select case (h2)
	case (-2); ai = 1
	case (1); ai = 7
	case (-1); ai = 11
	end select
	case (1)
	select case (h2)
	case (-1); ai = 4
	case (-2); ai = 13
	end select
	case (-1)
	select case (h2)
	case (-2); ai = 9
	end select
	end select
	case (TENSOR)
	select case (h1)
	case (2)
	select case (h2)
	case (-2); ai = 1
	case (1); ai = 7
	case (-1); ai = 11
	case (0); ai = 16
	end select
	case (1)
	select case (h2)
	case (-1); ai = 4
	case (-2); ai = 13
	case (0); ai = 20
	end select
	case (-1)
	select case (h2)
	case (-2); ai = 9
	end select
	case (0)
	select case (h2)
	case (-2); ai = 18
	case (-1); ai = 22
	end select
	end select
	end select
	if (ai /= 0 .and. .not. r) ai = ai + 1
	end function root_index

	@ %def root_index
	@ Inverse: return the helicity values ($h_2>h_1$) for an off-diagonal
	generator. The flag [[r]] tells whether this is a real or diagonal
	generator. The others are Cartan generators.
	<<SU algebra: public>>=
	public :: root_helicity
	<<SU algebra: sub interfaces>>=
	module subroutine root_helicity (s, i, h1, h2, r)
	integer, intent(in) :: s, i
	integer, intent(out) :: h1, h2
	logical, intent(out) :: r
	end subroutine root_helicity
	<<SU algebra: procedures>>=
	module subroutine root_helicity (s, i, h1, h2, r)
	integer, intent(in) :: s, i
	integer, intent(out) :: h1, h2
	logical, intent(out) :: r
	h1 = 0
	h2 = 0
	r = .false.
	select case (s)
	case (SCALAR)
	case (SPINOR)
	select case (i)
	case ( 1, 2); h1 = 1; h2 = -1; r = i == 1
	end select
	case (VECTOR)
	select case (i)
	case ( 1, 2); h1 = 1; h2 = -1; r = i == 1
	case ( 4, 5); h1 = 1; h2 = 0; r = i == 4
	case ( 6, 7); h1 = 0; h2 = -1; r = i == 6
	end select
	case (VECTORSPINOR)
	select case (i)
	case ( 1, 2); h1 = 2; h2 = -2; r = i == 1
	case ( 4, 5); h1 = 1; h2 = -1; r = i == 4
	case ( 7, 8); h1 = 2; h2 = 1; r = i == 7
	case ( 9,10); h1 = -1; h2 = -2; r = i == 9
	case (11,12); h1 = 2; h2 = -1; r = i ==11
	case (13,14); h1 = 1; h2 = -2; r = i ==13
	end select
	case (TENSOR)
	select case (i)
	case ( 1, 2); h1 = 2; h2 = -2; r = i == 1
	case ( 4, 5); h1 = 1; h2 = -1; r = i == 4
	case ( 7, 8); h1 = 2; h2 = 1; r = i == 7
	case ( 9,10); h1 = -1; h2 = -2; r = i == 9
	case (11,12); h1 = 2; h2 = -1; r = i ==11
	case (13,14); h1 = 1; h2 = -2; r = i ==13
	case (16,17); h1 = 2; h2 = 0; r = i ==16
	case (18,19); h1 = 0; h2 = -2; r = i ==18
	case (20,21); h1 = 1; h2 = 0; r = i ==20
	case (22,23); h1 = 0; h2 = -1; r = i ==22
	end select
	end select
	end subroutine root_helicity

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

	module su_algebra_ut
	use unit_tests
	use su_algebra_uti

	<<Standard module head>>

	<<SU algebra: public test>>

	contains

	<<SU algebra: test driver>>

	end module su_algebra_ut
	@ %def su_algebra_ut
	@
	<<[[su_algebra_uti.f90]]>>=
	<<File header>>

	module su_algebra_uti

	<<Use kinds>>
	use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
	use su_algebra

	<<Standard module head>>

	<<SU algebra: test declarations>>

	contains

	<<SU algebra: tests>>

	end module su_algebra_uti
	@ %def su_algebra_ut
	@ API: driver for the unit tests below.
	<<SU algebra: public test>>=
	public :: su_algebra_test
	<<SU algebra: test driver>>=
	subroutine su_algebra_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SU algebra: execute tests>>
	end subroutine su_algebra_test

	@ %def su_algebra_test
	@
	\subsubsection{Generator Ordering}
	Show the position of Cartan generators in the sequence of basis generators.
	<<SU algebra: execute tests>>=
	call test (su_algebra_1, "su_algebra_1", &
	"generator ordering", &
	u, results)
	<<SU algebra: test declarations>>=
	public :: su_algebra_1
	<<SU algebra: tests>>=
	subroutine su_algebra_1 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: su_algebra_1"
	write (u, "(A)") "* Purpose: test su(N) algebra implementation"
	write (u, "(A)")

	write (u, "(A)") "* su(N) generators: &
	&list and mark Cartan subalgebra"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call cartan_check (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call cartan_check (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call cartan_check (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call cartan_check (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call cartan_check (TENSOR)

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

	contains

	subroutine cartan_check (s)
	integer, intent(in) :: s
	integer :: i
	write (u, *)
	do i = 1, algebra_dimension (s)
	write (u, "(1x,L1)", advance="no") is_cartan_generator (s, i)
	end do
	write (u, *)

	end subroutine cartan_check

	end subroutine su_algebra_1

	@ %def su_algebra_1
	@
	\subsubsection{Cartan Generator Basis}
	Show the explicit matrix representation for all Cartan generators and
	check their traces and Killing products.

	Also test helicity index mappings.
	<<SU algebra: execute tests>>=
	call test (su_algebra_2, "su_algebra_2", &
	"Cartan generator representation", &
	u, results)
	<<SU algebra: test declarations>>=
	public :: su_algebra_2
	<<SU algebra: tests>>=
	subroutine su_algebra_2 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: su_algebra_2"
	write (u, "(A)") "* Purpose: test su(N) algebra implementation"
	write (u, "(A)")

	write (u, "(A)") "* diagonal su(N) generators: &
	&show explicit representation"
	write (u, "(A)") "* and check trace and Killing form"

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call cartan_show (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call cartan_show (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call cartan_show (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call cartan_show (TENSOR)

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

	contains

	subroutine cartan_show (s)
	integer, intent(in) :: s
	real(default), dimension(:,:), allocatable :: rd
	integer, dimension(:), allocatable :: ci
	integer :: n, d, h, i, j, k, l

	n = algebra_dimension (s)
	d = fundamental_dimension (s)

	write (u, *)
	write (u, "(A2,5X)", advance="no") "h:"
	do i = 1, d
	j = helicity_index (s, helicity_value (s, i))
	write (u, "(1x,I2,5X)", advance="no") helicity_value (s, j)
	end do
	write (u, "(8X)", advance="no")
	write (u, "(1X,A)") "tr"

	allocate (rd (n,d), source = 0._default)
	do i = 1, d
	h = helicity_value (s, i)
	rd(:,i) = cartan_element (s, h)
	end do

	allocate (ci (d-1), source = 0)
	do k = 1, d-1
	ci(k) = cartan_index (s, k)
	end do

	write (u, *)
	do k = 1, d-1
	write (u, "('T',I2,':',1X)", advance="no") ci(k)
	do i = 1, d
	write (u, 1, advance="no") rd(ci(k),i)
	end do
	write (u, "(8X)", advance="no")
	write (u, 1) sum (rd(ci(k),:))
	end do

	write (u, *)
	write (u, "(6X)", advance="no")
	do k = 1, d-1
	write (u, "(2X,'T',I2,3X)", advance="no") ci(k)
	end do
	write (u, *)

	do k = 1, d-1
	write (u, "('T',I2,2X)", advance="no") ci(k)
	do l = 1, d-1
	write (u, 1, advance="no") dot_product (rd(ci(k),:), rd(ci(l),:))
	end do
	write (u, *)
	end do

	1 format (1x,F7.4)

	end subroutine cartan_show

	end subroutine su_algebra_2

	@ %def su_algebra_2
	@
	\subsubsection{Bloch Representation: Cartan Generators}
	Transform from Bloch vectors to matrix and back, considering Cartan
	generators only.
	<<SU algebra: execute tests>>=
	call test (su_algebra_3, "su_algebra_3", &
	"Cartan generator mapping", &
	u, results)
	<<SU algebra: test declarations>>=
	public :: su_algebra_3
	<<SU algebra: tests>>=
	subroutine su_algebra_3 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: su_algebra_3"
	write (u, "(A)") "* Purpose: test su(N) algebra implementation"
	write (u, "(A)")

	write (u, "(A)") "* diagonal su(N) generators: &
	&transform to matrix and back"

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call cartan_expand (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call cartan_expand (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call cartan_expand (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call cartan_expand (TENSOR)

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

	contains

	subroutine cartan_expand (s)
	integer, intent(in) :: s
	real(default), dimension(:,:), allocatable :: rd
	integer, dimension(:), allocatable :: ci
	real(default), dimension(:), allocatable :: a
	logical, dimension(:), allocatable :: mask
	integer :: n, d, h, i, k, l

	n = algebra_dimension (s)
	d = fundamental_dimension (s)

	allocate (rd (n,d), source = 0._default)
	do i = 1, d
	h = helicity_value (s, i)
	rd(:,i) = cartan_element (s, h)
	end do

	allocate (ci (d-1), source = 0)
	do k = 1, d-1
	ci(k) = cartan_index (s, k)
	end do

	allocate (a (n))

	write (u, *)
	do k = 1, d-1
	a(:) = cartan_coeff (s, rd(ci(k),:))
	write (u, "('T',I2,':',1X)", advance="no") ci(k)
	do i = 1, n
	if (is_cartan_generator (s, i)) then
	write (u, 1, advance="no") a(i)
	else if (a(i) /= 0) then
	! this should not happen (nonzero non-Cartan entry)
	write (u, "(1X,':',I2,':',3X)", advance="no") i
	end if
	end do
	write (u, *)
	end do

	1 format (1X,F7.4)

	end subroutine cartan_expand

	end subroutine su_algebra_3

	@ %def su_algebra_3
	@
	\subsubsection{Bloch Representation: Roots}
	List the mapping between helicity transitions and (real) off-diagonal
	generators.
	<<SU algebra: execute tests>>=
	call test (su_algebra_4, "su_algebra_4", &
	"Root-helicity mapping", &
	u, results)
	<<SU algebra: test declarations>>=
	public :: su_algebra_4
	<<SU algebra: tests>>=
	subroutine su_algebra_4 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: su_algebra_4"
	write (u, "(A)") "* Purpose: test su(N) algebra implementation"
	write (u, "(A)")

	write (u, "(A)") "* off-diagonal su(N) generators: &
	&mapping from/to helicity pair"

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call root_expand (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call root_expand (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call root_expand (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call root_expand (TENSOR)

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

	contains

	subroutine root_expand (s)
	integer, intent(in) :: s
	integer :: n, d, i, j, h1, h2
	logical :: r

	n = algebra_dimension (s)

	write (u, *)
	do i = 1, n
	if (is_cartan_generator (s, i)) cycle
	call root_helicity (s, i, h1, h2, r)
	j = root_index (s, h1, h2, r)
	write (u, "('T',I2,':')", advance="no") j
	write (u, "(2(1x,I2))", advance="no") h1, h2
	if (r) then
	write (u, *)
	else
	write (u, "('*')")
	end if
	end do

	end subroutine root_expand

	end subroutine su_algebra_4

	@ %def su_algebra_4
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Bloch Representation}
	Particle polarization is determined by a particular quantum state
	which has just helicity information. Physically, this is the spin
	density matrix $\rho$, where we do not restrict ourselves to pure
	states.

	We adopt the phase convention for a spin-1/2 particle that
	\begin{equation}
	\rho = \tfrac12(1 + \vec\alpha\cdot\vec\sigma)
	\end{equation}
	with the polarization axis $\vec\alpha$. For a particle with
	arbitrary spin $s$, and thus $N=2s+1$ spin states, we extend the above
	definition to generalized Bloch form
	\begin{equation}
	\rho = \frac1N\left(1 + \sqrt{2N(N-1)}\alpha^aT^a\right)
	\end{equation}
	where the $T^a$ ($a=1,\ldots N^2-1$) are a basis of $su(N)$ algebra
	generators. These $N\times N$ matrices are hermitean, traceless, and
	orthogonal via
	\begin{equation}
	\mathop{\rm Tr}T^aT^b = \frac12 \delta^{ab}
	\end{equation}
	In the spin-1/2 case, this reduces to the above (standard Bloch)
	representation since $T^a = \sigma^a/2$, $a=1,2,3$. For the spin-1
	case, we could use $T^a = \lambda^a/2$ with the Gell-Mann matrices,
	\begin{equation}
	\rho = \frac13\left(1 + \sqrt{3}\alpha^a\lambda^a\right),
	\end{equation}
	The normalization is chosen that $\|alpha\|\leq 1$ for allowed density
	matrix, where $\|\alpha\|=1$ is a necessary, but not sufficient,
	condition for a pure state.

	We need a specific choice of basis for a well-defined component
	representation. The matrix elements of $T^a$ are
	ordered as $m=\ell,\ell-1,\ldots -\ell$, i.e., from highest down to
	lowest weight, for both row and column.

	We list first the generators of the $su(2)$ subalgebras which leave
	$\|m\|$ invariant ($\|m\|\neq 0$):
	\begin{equation}
	T^{b+1,b+2,b+3} \equiv \sigma^{1,2,3}
	\end{equation}
	acting on the respective subspace $\|m\|=\ell,\ell-1,\ldots$ for
	$b=0,1,\ldots$. This defines generators $T^a$ for $a=1,\ldots 3N/2$
	($\ldots 3(N-1)/2$) for $N$ even (odd), respectively.

	The following generators successively extend this to $su(4)$, $su(6)$,
	\ldots until $su(N)$ by adding first the missing off-diagonal and then
	diagonal generators. The phase conventions are analogous.

	(It should be possible to code these conventions for generic spin, but
	in the current implementation we restrict ourselves to $s\leq 2$, i.e.,
	$N\leq 5$.)

	Particle polarization is determined by a particular quantum state
	which has just helicity information. Physically, this is the spin
	density matrix $\rho$, where we do not restrict ourselves to pure
	states.

	We adopt the phase convention for a spin-1/2 particle that
	\begin{equation}
	\rho = \tfrac12(1 + \vec\alpha\cdot\vec\sigma)
	\end{equation}
	with the polarization axis $\vec\alpha$. For a particle with
	arbitrary spin $s$, and thus $N=2s+1$ spin states, we extend the above
	definition to generalized Bloch form
	\begin{equation}
	\rho = \frac1N\left(1 + \sqrt{2N(N-1)}\alpha^aT^a\right)
	\end{equation}
	where the $T^a$ ($a=1,\ldots N^2-1$) are a basis of $su(N)$ algebra
	generators. These $N\times N$ matrices are hermitean, traceless, and
	orthogonal via
	\begin{equation}
	\mathop{\rm Tr}T^aT^b = \frac12 \delta^{ab}
	\end{equation}
	In the spin-1/2 case, this reduces to the above (standard Bloch)
	representation since $T^a = \sigma^a/2$, $a=1,2,3$. For the spin-1
	case, we could use $T^a = \lambda^a/2$ with the Gell-Mann matrices,
	\begin{equation}
	\rho = \frac13\left(1 + \sqrt{3}\alpha^a\lambda^a\right),
	\end{equation}
	The normalization is chosen that $\|alpha\|\leq 1$ for allowed density
	matrix, where $\|\alpha\|=1$ is a necessary, but not sufficient,
	condition for a pure state.
	<<[[bloch_vectors.f90]]>>=
	<<File header>>

	module bloch_vectors

	<<Use kinds>>
	use physics_defs, only: UNKNOWN

	<<Standard module head>>

	<<Bloch vectors: public>>

	<<Bloch vectors: types>>

	interface
	<<Bloch vectors: sub interfaces>>
	end interface

	end module bloch_vectors
	@ %def bloch_vectors
	@
	<<[[bloch_vectors_sub.f90]]>>=
	<<File header>>

	submodule (bloch_vectors) bloch_vectors_s

	use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
	use su_algebra

	implicit none

	contains

	<<Bloch vectors: procedures>>

	end submodule bloch_vectors_s

	@ %def bloch_vectors_s
	@
	\subsection{Preliminaries}
	The normalization factor $\sqrt{2N(N-1)}/N$ that enters the Bloch
	representation.
	<<Bloch vectors: procedures>>=
	function bloch_factor (s) result (f)
	real(default) :: f
	integer, intent(in) :: s
	select case (s)
	case (SCALAR)
	f = 0
	case (SPINOR)
	f = 1
	case (VECTOR)
	f = 2 * sqrt (3._default) / 3
	case (VECTORSPINOR)
	f = 2 * sqrt (6._default) / 4
	case (TENSOR)
	f = 2 * sqrt (10._default) / 5
	case default
	f = 0
	end select
	end function bloch_factor

	@ %def bloch_factor
	@
	\subsection{The basic polarization type}
	The basic polarization object holds just the entries of the Bloch
	vector as an allocatable array.

	Bloch is active whenever the coefficient array is allocated.
	For convenience, we store the spin type ($2s$) and the multiplicity
	($N$) together with the coefficient array ($\alpha$). We have to allow for
	the massless case where $s$ is arbitrary $>0$ but $N=2$, and
	furthermore the chiral massless case where $N=1$. In the latter case,
	the array remains deallocated but the chirality is set to $\pm 1$.

	In the Bloch vector implementation, we do not distinguish between
	particle and antiparticle. If the distinction applies, it must be
	made by the caller when transforming between density matrix and Bloch vector.
	<<Bloch vectors: public>>=
	public :: bloch_vector_t
	<<Bloch vectors: types>>=
	type :: bloch_vector_t
	private
	integer :: spin_type = UNKNOWN
	real(default), dimension(:), allocatable :: a
	contains
	<<Bloch vectors: bloch vector: TBP>>
	end type bloch_vector_t

	@ %def bloch_vector_t
	@
	\subsection{Direct Access}
	This basic initializer just sets the spin type, leaving the Bloch vector
	unallocated. The object therefore does not support nonzero polarization.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: init_unpolarized => bloch_vector_init_unpolarized
	<<Bloch vectors: sub interfaces>>=
	module subroutine bloch_vector_init_unpolarized (pol, spin_type)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	end subroutine bloch_vector_init_unpolarized
	<<Bloch vectors: procedures>>=
	module subroutine bloch_vector_init_unpolarized (pol, spin_type)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	pol%spin_type = spin_type
	end subroutine bloch_vector_init_unpolarized

	@ %def bloch_vector_init_unpolarized
	@ The standard initializer allocates the Bloch vector and initializes
	with zeros, so we can define a polarization later. We make sure that
	this works only for the supported spin type. Initializing with
	[[UNKNOWN]] spin type resets the Bloch vector to undefined, i.e.,
	unpolarized state.
	<<Bloch vectors: bloch vector: TBP>>=
	generic :: init => bloch_vector_init
	procedure, private :: bloch_vector_init
	<<Bloch vectors: sub interfaces>>=
	module subroutine bloch_vector_init (pol, spin_type)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	end subroutine bloch_vector_init
	<<Bloch vectors: procedures>>=
	module subroutine bloch_vector_init (pol, spin_type)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	pol%spin_type = spin_type
	select case (spin_type)
	case (SCALAR,SPINOR,VECTOR,VECTORSPINOR,TENSOR)
	allocate (pol%a (algebra_dimension (spin_type)), source = 0._default)
	end select
	end subroutine bloch_vector_init

	@ %def bloch_vector_init
	@
	Fill the Bloch vector from an array, no change of normalization. No
	initialization and no check, we assume that the shapes do match.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: from_array => bloch_vector_from_array
	<<Bloch vectors: sub interfaces>>=
	module subroutine bloch_vector_from_array (pol, a)
	class(bloch_vector_t), intent(inout) :: pol
	real(default), dimension(:), allocatable, intent(in) :: a
	end subroutine bloch_vector_from_array
	<<Bloch vectors: procedures>>=
	module subroutine bloch_vector_from_array (pol, a)
	class(bloch_vector_t), intent(inout) :: pol
	real(default), dimension(:), allocatable, intent(in) :: a
	pol%a(:) = a
	end subroutine bloch_vector_from_array

	@ %def bloch_vector_from_array
	@
	Transform to an array of reals, i.e., extract the Bloch vector as-is.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: to_array => bloch_vector_to_array
	<<Bloch vectors: sub interfaces>>=
	module subroutine bloch_vector_to_array (pol, a)
	class(bloch_vector_t), intent(in) :: pol
	real(default), dimension(:), allocatable, intent(out) :: a
	end subroutine bloch_vector_to_array
	<<Bloch vectors: procedures>>=
	module subroutine bloch_vector_to_array (pol, a)
	class(bloch_vector_t), intent(in) :: pol
	real(default), dimension(:), allocatable, intent(out) :: a
	if (pol%is_defined ()) allocate (a (size (pol%a)), source = pol%a)
	end subroutine bloch_vector_to_array

	@ %def bloch_vector_to_array
	@
	\subsection{Raw I/O}
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: write_raw => bloch_vector_write_raw
	procedure :: read_raw => bloch_vector_read_raw
	<<Bloch vectors: sub interfaces>>=
	module subroutine bloch_vector_write_raw (pol, u)
	class(bloch_vector_t), intent(in) :: pol
	integer, intent(in) :: u
	end subroutine bloch_vector_write_raw
	module subroutine bloch_vector_read_raw (pol, u, iostat)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: u
	integer, intent(out) :: iostat
	end subroutine bloch_vector_read_raw
	<<Bloch vectors: procedures>>=
	module subroutine bloch_vector_write_raw (pol, u)
	class(bloch_vector_t), intent(in) :: pol
	integer, intent(in) :: u
	write (u) pol%spin_type
	write (u) allocated (pol%a)
	if (allocated (pol%a)) then
	write (u) pol%a
	end if
	end subroutine bloch_vector_write_raw

	module subroutine bloch_vector_read_raw (pol, u, iostat)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: u
	integer, intent(out) :: iostat
	integer :: s
	logical :: polarized
	read (u, iostat=iostat) s
	read (u, iostat=iostat) polarized
	if (iostat /= 0) return
	if (polarized) then
	call pol%init (s)
	read (u, iostat=iostat) pol%a
	else
	call pol%init_unpolarized (s)
	end if
	end subroutine bloch_vector_read_raw

	@ %def bloch_vector_write_raw
	@ %def bloch_vector_read_raw
	@
	\subsection{Properties}
	Re-export algebra functions that depend on the spin type. These
	functions do not depend on the Bloch vector being allocated.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: get_n_states
	procedure :: get_length
	procedure :: hel_index => bv_helicity_index
	procedure :: hel_value => bv_helicity_value
	procedure :: bloch_factor => bv_factor
	<<Bloch vectors: sub interfaces>>=
	module function get_n_states (pol) result (n)
	class(bloch_vector_t), intent(in) :: pol
	integer :: n
	end function get_n_states
	module function get_length (pol) result (n)
	class(bloch_vector_t), intent(in) :: pol
	integer :: n
	end function get_length
	module function bv_helicity_index (pol, h) result (i)
	class(bloch_vector_t), intent(in) :: pol
	integer, intent(in) :: h
	integer :: i
	end function bv_helicity_index
	module function bv_helicity_value (pol, i) result (h)
	class(bloch_vector_t), intent(in) :: pol
	integer, intent(in) :: i
	integer :: h
	end function bv_helicity_value
	module function bv_factor (pol) result (f)
	class(bloch_vector_t), intent(in) :: pol
	real(default) :: f
	end function bv_factor
	<<Bloch vectors: procedures>>=
	module function get_n_states (pol) result (n)
	class(bloch_vector_t), intent(in) :: pol
	integer :: n
	n = fundamental_dimension (pol%spin_type)
	end function get_n_states

	module function get_length (pol) result (n)
	class(bloch_vector_t), intent(in) :: pol
	integer :: n
	n = algebra_dimension (pol%spin_type)
	end function get_length

	module function bv_helicity_index (pol, h) result (i)
	class(bloch_vector_t), intent(in) :: pol
	integer, intent(in) :: h
	integer :: i
	i = helicity_index (pol%spin_type, h)
	end function bv_helicity_index

	module function bv_helicity_value (pol, i) result (h)
	class(bloch_vector_t), intent(in) :: pol
	integer, intent(in) :: i
	integer :: h
	h = helicity_value (pol%spin_type, i)
	end function bv_helicity_value

	module function bv_factor (pol) result (f)
	class(bloch_vector_t), intent(in) :: pol
	real(default) :: f
	f = bloch_factor (pol%spin_type)
	end function bv_factor

	@ %def get_n_states
	@ %def helicity_index
	@ %def helicity_value
	@ If the Bloch vector object is defined, the spin type is anything else but
	[[UNKNOWN]]. This allows us the provide the representation-specific
	functions above.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: is_defined => bloch_vector_is_defined
	<<Bloch vectors: sub interfaces>>=
	module function bloch_vector_is_defined (pol) result (flag)
	class(bloch_vector_t), intent(in) :: pol
	logical :: flag
	end function bloch_vector_is_defined
	<<Bloch vectors: procedures>>=
	module function bloch_vector_is_defined (pol) result (flag)
	class(bloch_vector_t), intent(in) :: pol
	logical :: flag
	flag = pol%spin_type /= UNKNOWN
	end function bloch_vector_is_defined

	@ %def bloch_vector_is_defined
	@ If the Bloch vector object is (technically) polarized, it is
	defined, and the vector coefficient array has been allocated.
	However, the vector value may be zero.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: is_polarized => bloch_vector_is_polarized
	<<Bloch vectors: sub interfaces>>=
	module function bloch_vector_is_polarized (pol) result (flag)
	class(bloch_vector_t), intent(in) :: pol
	logical :: flag
	end function bloch_vector_is_polarized
	<<Bloch vectors: procedures>>=
	module function bloch_vector_is_polarized (pol) result (flag)
	class(bloch_vector_t), intent(in) :: pol
	logical :: flag
	flag = allocated (pol%a)
	end function bloch_vector_is_polarized

	@ %def bloch_vector_is_polarized
	@ Return true if the polarization is diagonal, i.e., all entries in
	the density matrix are on the diagonal. This is equivalent to
	requiring that only Cartan generator coefficients are nonzero in the
	Bloch vector.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: is_diagonal => bloch_vector_is_diagonal
	<<Bloch vectors: sub interfaces>>=
	module function bloch_vector_is_diagonal (pol) result (diagonal)
	class(bloch_vector_t), intent(in) :: pol
	logical :: diagonal
	end function bloch_vector_is_diagonal
	<<Bloch vectors: procedures>>=
	module function bloch_vector_is_diagonal (pol) result (diagonal)
	class(bloch_vector_t), intent(in) :: pol
	logical :: diagonal
	integer :: s, i
	s = pol%spin_type
	diagonal = .true.
	if (pol%is_polarized ()) then
	do i = 1, size (pol%a)
	if (is_cartan_generator (s, i)) cycle
	if (pol%a(i) /= 0) then
	diagonal = .false.
	return
	end if
	end do
	end if
	end function bloch_vector_is_diagonal

	@ %def bloch_vector_is_diagonal
	@
	Return the Euclidean norm of the Bloch vector. This is equal to the
	Killing form value of the corresponding algebra generator. We assume
	that the polarization object has been initialized.

	For a pure state, the norm is unity. All other allowed states have a
	norm less than unity. (For $s\geq 1$, this is a necessary but not
	sufficient condition.)
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: get_norm => bloch_vector_get_norm
	<<Bloch vectors: sub interfaces>>=
	module function bloch_vector_get_norm (pol) result (norm)
	class(bloch_vector_t), intent(in) :: pol
	real(default) :: norm
	end function bloch_vector_get_norm
	<<Bloch vectors: procedures>>=
	module function bloch_vector_get_norm (pol) result (norm)
	class(bloch_vector_t), intent(in) :: pol
	real(default) :: norm
	select case (pol%spin_type)
	case (SPINOR,VECTOR,VECTORSPINOR,TENSOR)
	norm = sqrt (dot_product (pol%a, pol%a))
	case default
	norm = 1
	end select
	end function bloch_vector_get_norm

	@ %def bloch_vector_get_norm
	@
	\subsection{Diagonal density matrix}
	This initializer takes a diagonal density matrix, represented by a
	real-valued array. We assume that the trace is unity, and that the
	array has the correct shape for the given [[spin_type]].

	The [[bloch_factor]] renormalization is necessary such that a pure
	state maps to a Bloch vector with unit norm.
	<<Bloch vectors: bloch vector: TBP>>=
	generic :: init => bloch_vector_init_diagonal
	procedure, private :: bloch_vector_init_diagonal
	<<Bloch vectors: sub interfaces>>=
	module subroutine bloch_vector_init_diagonal (pol, spin_type, rd)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	real(default), dimension(:), intent(in) :: rd
	end subroutine bloch_vector_init_diagonal
	<<Bloch vectors: procedures>>=
	module subroutine bloch_vector_init_diagonal (pol, spin_type, rd)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	real(default), dimension(:), intent(in) :: rd
	call pol%init (spin_type)
	call pol%set (rd)
	end subroutine bloch_vector_init_diagonal

	@ %def bloch_vector_init_diagonal
	@ Set a Bloch vector, given a diagonal density matrix as a real array.
	The Bloch vector must be initialized with correct characteristics.
	<<Bloch vectors: bloch vector: TBP>>=
	generic :: set => bloch_vector_set_diagonal
	procedure, private :: bloch_vector_set_diagonal
	<<Bloch vectors: sub interfaces>>=
	module subroutine bloch_vector_set_diagonal (pol, rd)
	class(bloch_vector_t), intent(inout) :: pol
	real(default), dimension(:), intent(in) :: rd
	end subroutine bloch_vector_set_diagonal
	<<Bloch vectors: procedures>>=
	module subroutine bloch_vector_set_diagonal (pol, rd)
	class(bloch_vector_t), intent(inout) :: pol
	real(default), dimension(:), intent(in) :: rd
	integer :: s
	s = pol%spin_type
	select case (s)
	case (SCALAR,SPINOR,VECTOR,VECTORSPINOR,TENSOR)
	pol%a(:) = cartan_coeff (s, rd) / bloch_factor (s)
	end select
	end subroutine bloch_vector_set_diagonal

	@ %def bloch_vector_set_diagonal
	@
	@
	\subsection{Massless density matrix}
	This is a specific variant which initializes an equipartition for
	the maximum helicity, corresponding to an unpolarized massless particle.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: init_max_weight => bloch_vector_init_max_weight
	<<Bloch vectors: sub interfaces>>=
	module subroutine bloch_vector_init_max_weight (pol, spin_type)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	end subroutine bloch_vector_init_max_weight
	<<Bloch vectors: procedures>>=
	module subroutine bloch_vector_init_max_weight (pol, spin_type)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	call pol%init (spin_type)
	select case (spin_type)
	case (VECTOR)
	call pol%set ([0.5_default, 0._default, 0.5_default])
	case (VECTORSPINOR)
	call pol%set ([0.5_default, 0._default, 0._default, 0.5_default])
	case (TENSOR)
	call pol%set ([0.5_default, 0._default, 0._default, 0._default, 0.5_default])
	end select
	end subroutine bloch_vector_init_max_weight

	@ %def bloch_vector_init_max_weight
	@ Initialize the maximum-weight submatrix with a three-component Bloch
	vector. This is not as trivial as it seems because we need the above
	initialization for the generalized Bloch in order to remove the lower
	weights from the density matrix.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: init_vector => bloch_vector_init_vector
	procedure :: to_vector => bloch_vector_to_vector
	<<Bloch vectors: sub interfaces>>=
	module subroutine bloch_vector_init_vector (pol, s, a)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: s
	real(default), dimension(3), intent(in) :: a
	end subroutine bloch_vector_init_vector
	module subroutine bloch_vector_to_vector (pol, a)
	class(bloch_vector_t), intent(in) :: pol
	real(default), dimension(3), intent(out) :: a
	end subroutine bloch_vector_to_vector
	<<Bloch vectors: procedures>>=
	module subroutine bloch_vector_init_vector (pol, s, a)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: s
	real(default), dimension(3), intent(in) :: a
	call pol%init_max_weight (s)
	select case (s)
	case (SPINOR, VECTOR, VECTORSPINOR, TENSOR)
	pol%a(1:3) = a / bloch_factor (s)
	end select
	end subroutine bloch_vector_init_vector

	module subroutine bloch_vector_to_vector (pol, a)
	class(bloch_vector_t), intent(in) :: pol
	real(default), dimension(3), intent(out) :: a
	integer :: s
	s = pol%spin_type
	select case (s)
	case (SPINOR, VECTOR, VECTORSPINOR, TENSOR)
	a = pol%a(1:3) * bloch_factor (s)
	case default
	a = 0
	end select
	end subroutine bloch_vector_to_vector

	@ %def bloch_vector_init_vector
	@ %def bloch_vector_to_vector
	@
	\subsection{Arbitrary density matrix}
	Initialize the Bloch vector from a density matrix. We assume that the
	density is valid. In particular, the shape should match, the matrix
	should be hermitian, and the trace should be unity.

	We first fill the diagonal, then add the off-diagonal parts.
	<<Bloch vectors: bloch vector: TBP>>=
	generic :: init => bloch_vector_init_matrix
	procedure, private :: bloch_vector_init_matrix
	<<Bloch vectors: sub interfaces>>=
	module subroutine bloch_vector_init_matrix (pol, spin_type, r)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	complex(default), dimension(:,:), intent(in) :: r
	end subroutine bloch_vector_init_matrix
	<<Bloch vectors: procedures>>=
	module subroutine bloch_vector_init_matrix (pol, spin_type, r)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	complex(default), dimension(:,:), intent(in) :: r
	select case (spin_type)
	case (SCALAR,SPINOR,VECTOR,VECTORSPINOR,TENSOR)
	call pol%init (spin_type)
	call pol%set (r)
	case default
	call pol%init (UNKNOWN)
	end select
	end subroutine bloch_vector_init_matrix

	@ %def bloch_vector_init_matrix
	@ Set a Bloch vector, given an arbitrary density matrix as a real
	array. The Bloch vector must be initialized with correct
	characteristics.
	<<Bloch vectors: bloch vector: TBP>>=
	generic :: set => bloch_vector_set_matrix
	procedure, private :: bloch_vector_set_matrix
	<<Bloch vectors: sub interfaces>>=
	module subroutine bloch_vector_set_matrix (pol, r)
	class(bloch_vector_t), intent(inout) :: pol
	complex(default), dimension(:,:), intent(in) :: r
	end subroutine bloch_vector_set_matrix
	<<Bloch vectors: procedures>>=
	module subroutine bloch_vector_set_matrix (pol, r)
	class(bloch_vector_t), intent(inout) :: pol
	complex(default), dimension(:,:), intent(in) :: r
	real(default), dimension(:), allocatable :: rd
	integer :: s, d, i, j, h1, h2, ir, ii
	s = pol%spin_type
	select case (s)
	case (SCALAR,SPINOR,VECTOR,VECTORSPINOR,TENSOR)
	d = fundamental_dimension (s)
	allocate (rd (d))
	do i = 1, d
	rd(i) = r(i,i)
	end do
	call pol%set (rd)
	do i = 1, d
	h1 = helicity_value (s, i)
	do j = i+1, d
	h2 = helicity_value (s, j)
	ir = root_index (s, h1, h2, .true.)
	ii = root_index (s, h1, h2, .false.)
	pol%a(ir) = real (r(j,i) + r(i,j)) / bloch_factor (s)
	pol%a(ii) = aimag (r(j,i) - r(i,j)) / bloch_factor (s)
	end do
	end do
	end select
	end subroutine bloch_vector_set_matrix

	@ %def bloch_vector_set_matrix
	@ Allocate and fill the density matrix [[r]] (with the index ordering as
	defined in [[su_algebra]]) that corresponds to a given Bloch vector.

	If the optional [[only_max_weight]] is set, the resulting matrix has
	entries only for $\pm h_\text{max}$, as appropriate for a massless
	particle (for spin $\geq 1$). Note that we always add the unit
	matrix, as this is part of the Bloch-vector definition.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: to_matrix => bloch_vector_to_matrix
	<<Bloch vectors: sub interfaces>>=
	module subroutine bloch_vector_to_matrix (pol, r, only_max_weight)
	class(bloch_vector_t), intent(in) :: pol
	complex(default), dimension(:,:), intent(out), allocatable :: r
	logical, intent(in), optional :: only_max_weight
	end subroutine bloch_vector_to_matrix
	<<Bloch vectors: procedures>>=
	module subroutine bloch_vector_to_matrix (pol, r, only_max_weight)
	class(bloch_vector_t), intent(in) :: pol
	complex(default), dimension(:,:), intent(out), allocatable :: r
	logical, intent(in), optional :: only_max_weight
	integer :: d, s, h0, ng, ai, h, h1, h2, i, j
	logical :: is_real, only_max
	complex(default) :: val
	if (.not. pol%is_polarized ()) return
	s = pol%spin_type
	only_max = .false.
	select case (s)
	case (VECTOR, VECTORSPINOR, TENSOR)
	if (present (only_max_weight)) only_max = only_max_weight
	end select
	if (only_max) then
	ng = 2
	h0 = helicity_value (s, 1)
	else
	ng = algebra_dimension (s)
	h0 = 0
	end if
	d = fundamental_dimension (s)
	allocate (r (d, d), source = (0._default, 0._default))
	do i = 1, d
	h = helicity_value (s, i)
	if (abs (h) < h0) cycle
	r(i,i) = 1._default / d &
	+ dot_product (cartan_element (s, h), pol%a) * bloch_factor (s)
	end do
	do ai = 1, ng
	if (is_cartan_generator (s, ai)) cycle
	call root_helicity (s, ai, h1, h2, is_real)
	i = helicity_index (s, h1)
	j = helicity_index (s, h2)
	if (is_real) then
	val = cmplx (pol%a(ai) / 2 * bloch_factor (s), 0._default, &
	kind=default)
	r(i,j) = r(i,j) + val
	r(j,i) = r(j,i) + val
	else
	val = cmplx (0._default, pol%a(ai) / 2 * bloch_factor (s), &
	kind=default)
	r(i,j) = r(i,j) - val
	r(j,i) = r(j,i) + val
	end if
	end do
	end subroutine bloch_vector_to_matrix

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

	module bloch_vectors_ut
	use unit_tests
	use bloch_vectors_uti

	<<Standard module head>>

	<<Bloch vectors: public test>>

	contains

	<<Bloch vectors: test driver>>

	end module bloch_vectors_ut
	@ %def bloch_vectors_ut
	@
	<<[[bloch_vectors_uti.f90]]>>=
	<<File header>>

	module bloch_vectors_uti

	<<Use kinds>>
	use physics_defs, only: UNKNOWN, SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
	use su_algebra, only: algebra_dimension, fundamental_dimension, helicity_value

	use bloch_vectors

	<<Standard module head>>

	<<Bloch vectors: test declarations>>

	contains

	<<Bloch vectors: tests>>

	end module bloch_vectors_uti
	@ %def bloch_vectors_ut
	@ API: driver for the unit tests below.
	<<Bloch vectors: public test>>=
	public :: bloch_vectors_test
	<<Bloch vectors: test driver>>=
	subroutine bloch_vectors_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Bloch vectors: execute tests>>
	end subroutine bloch_vectors_test

	@ %def bloch_vectors_test
	@
	\subsubsection{Initialization}
	Initialize the Bloch vector for any spin type. First as unpolarized
	(no array), then as polarized but with zero polarization.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_1, "bloch_vectors_1", &
	"initialization", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_1
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_1 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_1"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

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

	write (u, "(A)")
	write (u, "(A)") "* unknown"
	call bloch_init (UNKNOWN)

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_init (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_init (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_init (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_init (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_init (TENSOR)

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

	contains

	subroutine bloch_init (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	real(default), dimension(:), allocatable :: a
	integer :: i
	write (u, *)
	write (u, "(1X,L1,L1)", advance="no") &
	pol%is_defined (), pol%is_polarized ()
	call pol%init_unpolarized (s)
	write (u, "(1X,L1,L1)", advance="no") &
	pol%is_defined (), pol%is_polarized ()
	call pol%init (s)
	write (u, "(1X,L1,L1)", advance="no") &
	pol%is_defined (), pol%is_polarized ()
	write (u, *)
	call pol%to_array (a)
	if (allocated (a)) then
	write (u, "(*(F7.4))") a
	a(:) = [(real (mod (i, 10), kind=default), i = 1, size (a))]
	call pol%from_array (a)
	call pol%to_array (a)
	write (u, "(*(F7.4))") a
	else
	write (u, *)
	write (u, *)
	end if
	end subroutine bloch_init

	end subroutine bloch_vectors_1

	@ %def bloch_vectors_1
	@
	\subsubsection{Pure state (diagonal)}
	Initialize the Bloch vector with a pure state of definite helicity and
	check the normalization.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_2, "bloch_vectors_2", &
	"pure state (diagonal)", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_2
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_2 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_2"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Initialization (polarized, diagonal): &
	&display vector and norm"
	write (u, "(A)") "* transform back"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_diagonal (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_diagonal (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_diagonal (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_diagonal (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_diagonal (TENSOR)

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

	contains

	subroutine bloch_diagonal (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	real(default), dimension(:), allocatable :: a
	real(default), dimension(:), allocatable :: rd
	complex(default), dimension(:,:), allocatable :: r
	integer :: i, j, d
	real(default) :: rj
	real, parameter :: tolerance = 1.E-14_default
	d = fundamental_dimension (s)
	do i = 1, d
	allocate (rd (d), source = 0._default)
	rd(i) = 1
	call pol%init (s, rd)
	call pol%to_array (a)
	write (u, *)
	write (u, "(A,1X,I2)") "h:", helicity_value (s, i)
	write (u, 1, advance="no") a
	write (u, "(1X,L1)") pol%is_diagonal ()
	write (u, 1) pol%get_norm ()
	call pol%to_matrix (r)
	do j = 1, d
	rj = real (r(j,j))
	if (abs (rj) < tolerance) rj = 0
	write (u, 1, advance="no") rj
	end do
	write (u, "(1X,L1)") matrix_is_diagonal (r)
	deallocate (a, rd, r)
	end do
	1 format (99(1X,F7.4,:))
	end subroutine bloch_diagonal

	function matrix_is_diagonal (r) result (diagonal)
	complex(default), dimension(:,:), intent(in) :: r
	logical :: diagonal
	integer :: i, j
	diagonal = .true.
	do j = 1, size (r, 2)
	do i = 1, size (r, 1)
	if (i == j) cycle
	if (r(i,j) /= 0) then
	diagonal = .false.
	return
	end if
	end do
	end do
	end function matrix_is_diagonal

	end subroutine bloch_vectors_2

	@ %def bloch_vectors_2
	@
	\subsubsection{Pure state (arbitrary)}
	Initialize the Bloch vector with an arbitrarily chosen pure state,
	check the normalization, and transform back to the density matrix.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_3, "bloch_vectors_3", &
	"pure state (arbitrary)", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_3
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_3 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_3"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Initialization (pure polarized, arbitrary):"
	write (u, "(A)") "* input matrix, transform, display norm, transform back"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_arbitrary (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_arbitrary (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_arbitrary (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_arbitrary (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_arbitrary (TENSOR)

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

	contains

	subroutine bloch_arbitrary (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	complex(default), dimension(:,:), allocatable :: r
	integer :: d
	d = fundamental_dimension (s)
	write (u, *)
	call init_matrix (d, r)
	call write_matrix (d, r)
	call pol%init (s, r)
	write (u, *)
	write (u, 2) pol%get_norm (), pol%is_diagonal ()
	write (u, *)
	call pol%to_matrix (r)
	call write_matrix (d, r)
	2 format (1X,F7.4,1X,L1)
	end subroutine bloch_arbitrary

	subroutine init_matrix (d, r)
	integer, intent(in) :: d
	complex(default), dimension(:,:), allocatable, intent(out) :: r
	complex(default), dimension(:), allocatable :: a
	real(default) :: norm
	integer :: i, j
	allocate (a (d))
	norm = 0
	do i = 1, d
	a(i) = cmplx (2i-1, 2i, kind=default)
	norm = norm + conjg (a(i)) * a(i)
	end do
	a = a / sqrt (norm)
	allocate (r (d,d))
	do i = 1, d
	do j = 1, d
	r(i,j) = conjg (a(i)) * a(j)
	end do
	end do
	end subroutine init_matrix

	subroutine write_matrix (d, r)
	integer, intent(in) :: d
	complex(default), dimension(:,:), intent(in) :: r
	integer :: i, j
	do i = 1, d
	do j = 1, d
	write (u, 1, advance="no") r(i,j)
	end do
	write (u, *)
	end do
	1 format (99(1X,'(',F7.4,',',F7.4,')',:))
	end subroutine write_matrix

	end subroutine bloch_vectors_3

	@ %def bloch_vectors_3
	@
	\subsubsection{Raw I/O}
	Check correct input/output in raw format.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_4, "bloch_vectors_4", &
	"raw I/O", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_4
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_4 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_4"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Raw I/O"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_io (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_io (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_io (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_io (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_io (TENSOR)

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

	contains

	subroutine bloch_io (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	real(default), dimension(:), allocatable :: a
	integer :: n, i, utmp, iostat
	n = algebra_dimension (s)
	allocate (a (n))
	a(:) = [(real (mod (i, 10), kind=default), i = 1, size (a))]
	write (u, *)
	write (u, "(*(F7.4))") a
	call pol%init (s)
	call pol%from_array (a)
	open (newunit = utmp, status = "scratch", action = "readwrite", &
	form = "unformatted")
	call pol%write_raw (utmp)
	rewind (utmp)
	call pol%read_raw (utmp, iostat=iostat)
	close (utmp)
	call pol%to_array (a)
	write (u, "(*(F7.4))") a
	end subroutine bloch_io

	end subroutine bloch_vectors_4

	@ %def bloch_vectors_4
	@
	\subsubsection{Convenience Methods}
	Check some further TBP that are called by the [[polarizations]]
	module.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_5, "bloch_vectors_5", &
	"massless state (unpolarized)", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_5
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_5 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_5"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Massless states: equipartition"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_massless_unpol (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_massless_unpol (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_massless_unpol (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_massless_unpol (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_massless_unpol (TENSOR)

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

	contains

	subroutine bloch_massless_unpol (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	complex(default), dimension(:,:), allocatable :: r
	real(default), dimension(:), allocatable :: a
	integer :: d
	d = fundamental_dimension (s)
	call pol%init_max_weight (s)
	call pol%to_matrix (r, only_max_weight = .false.)
	write (u, *)
	where (abs (r) < 1.e-14_default) r = 0
	call write_matrix (d, r)
	call pol%to_matrix (r, only_max_weight = .true.)
	write (u, *)
	call write_matrix (d, r)
	end subroutine bloch_massless_unpol

	subroutine write_matrix (d, r)
	integer, intent(in) :: d
	complex(default), dimension(:,:), intent(in) :: r
	integer :: i, j
	do i = 1, d
	do j = 1, d
	write (u, 1, advance="no") r(i,j)
	end do
	write (u, *)
	end do
	1 format (99(1X,'(',F7.4,',',F7.4,')',:))
	end subroutine write_matrix

	end subroutine bloch_vectors_5

	@ %def bloch_vectors_5
	@
	\subsubsection{Massless state (arbitrary)}
	Initialize the Bloch vector with an arbitrarily chosen pure state
	which consists only of highest-weight components. Transform back to
	the density matrix.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_6, "bloch_vectors_6", &
	"massless state (arbitrary)", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_6
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_6 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_6"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Initialization (pure polarized massless, arbitrary):"
	write (u, "(A)") "* input matrix, transform, display norm, transform back"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_massless (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_massless (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_massless (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_massless (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_massless (TENSOR)

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

	contains

	subroutine bloch_massless (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	complex(default), dimension(:,:), allocatable :: r
	integer :: d
	d = fundamental_dimension (s)
	write (u, *)
	call init_matrix (d, r)
	call write_matrix (d, r)
	call pol%init (s, r)
	write (u, *)
	write (u, 2) pol%get_norm (), pol%is_diagonal ()
	write (u, *)
	call pol%to_matrix (r, only_max_weight = .true.)
	call write_matrix (d, r)
	2 format (1X,F7.4,1X,L1)
	end subroutine bloch_massless

	subroutine init_matrix (d, r)
	integer, intent(in) :: d
	complex(default), dimension(:,:), allocatable, intent(out) :: r
	complex(default), dimension(:), allocatable :: a
	real(default) :: norm
	integer :: i, j
	allocate (a (d), source = (0._default, 0._default))
	norm = 0
	do i = 1, d, max (d-1, 1)
	a(i) = cmplx (2i-1, 2i, kind=default)
	norm = norm + conjg (a(i)) * a(i)
	end do
	a = a / sqrt (norm)
	allocate (r (d,d), source = (0._default, 0._default))
	do i = 1, d, max (d-1, 1)
	do j = 1, d, max (d-1, 1)
	r(i,j) = conjg (a(i)) * a(j)
	end do
	end do
	end subroutine init_matrix

	subroutine write_matrix (d, r)
	integer, intent(in) :: d
	complex(default), dimension(:,:), intent(in) :: r
	integer :: i, j
	do i = 1, d
	do j = 1, d
	write (u, 1, advance="no") r(i,j)
	end do
	write (u, *)
	end do
	1 format (99(1X,'(',F7.4,',',F7.4,')',:))
	end subroutine write_matrix

	end subroutine bloch_vectors_6

	@ %def bloch_vectors_6
	@
	\subsubsection{Massless state (Bloch vector)}
	Initialize the (generalized) Bloch vector with an ordinary
	three-component Bloch vector that applies to the highest-weight part only.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_7, "bloch_vectors_7", &
	"massless state (vector)", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_7
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_7 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_7"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Initialization &
	&(pure polarized massless, arbitrary Bloch vector):"
	write (u, "(A)") "* input vector, transform, display norm, &
	&transform back"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_massless_vector (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_massless_vector (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_massless_vector (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_massless_vector (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_massless_vector (TENSOR)

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

	contains

	subroutine bloch_massless_vector (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	real(default), dimension(3) :: a
	complex(default), dimension(:,:), allocatable :: r
	write (u, *)
	a = [1._default, 2._default, 4._default]
	a = a / sqrt (sum (a ** 2))
	write (u, 2) a
	call pol%init_vector (s, a)
	write (u, 2) pol%get_norm ()
	call pol%to_vector (a)
	write (u, 2) a
	call pol%to_matrix (r, only_max_weight = .false.)
	write (u, *)
	where (abs (r) < 1.e-14_default) r = 0
	call write_matrix (r)
	call pol%to_matrix (r, only_max_weight = .true.)
	write (u, *)
	call write_matrix (r)
	2 format (99(1X,F7.4,:))
	end subroutine bloch_massless_vector

	subroutine write_matrix (r)
	complex(default), dimension(:,:), intent(in) :: r
	integer :: i, j
	do i = 1, size (r, 1)
	do j = 1, size (r, 2)
	write (u, 1, advance="no") r(i,j)
	end do
	write (u, *)
	end do
	1 format (99(1X,'(',F7.4,',',F7.4,')',:))
	end subroutine write_matrix

	end subroutine bloch_vectors_7

	@ %def bloch_vectors_7
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Polarization}
	Using generalized Bloch vectors and the $su(N)$ algebra (see above)
	for the internal representation, we can define various modes of
	polarization. For
	spin-1/2, and analogously for massless spin-$s$ particles, we introduce
	\begin{enumerate}
	\item Trivial polarization: $\vec\alpha=0$. [This is unpolarized, but
	distinct from the particular undefined polarization matrix which has
	the same meaning.]
	\item Circular polarization: $\vec\alpha$ points in $\pm z$ direction.
	\item Transversal polarization: $\vec\alpha$ points orthogonal to the
	$z$ direction, with a phase $\phi$ that is $0$ for the $x$ axis, and
	$\pi/2=90^\circ$ for the $y$ axis. For antiparticles, the phase
	switches sign, corresponding to complex conjugation.
	\item Axis polarization, where we explicitly give $\vec\alpha$.
	\end{enumerate}
	For higher spin, we retain this definition, but apply it to the two
	components with maximum and minimum weight. In effect, we concentrate
	on the first three entries in the $\alpha^a$ array. For massless
	particles, this is sufficient. For massive particles, we then add the
	possibilities:
	\begin{enumerate}\setcounter{enumi}{4}
	\item Longitudinal polarization: Only the 0-component is set. This is
	possible only for bosons.
	\item Diagonal polarization: Explicitly specify all components in the
	helicity basis. The $su(N)$ representation consists of diagonal
	generators only, the Cartan subalgebra.
	\end{enumerate}
	Obviously, this does not exhaust the possible density matrices for
	higher spin, but it should cover practical applications.
	<<[[polarizations.f90]]>>=
	<<File header>>

	module polarizations

	<<Use kinds>>
	use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
	use flavors
	use quantum_numbers
	use state_matrices
	use bloch_vectors

	<<Standard module head>>

	<<Polarizations: public>>

	<<Polarizations: types>>

	<<Polarizations: interfaces>>

	interface
	<<Polarizations: sub interfaces>>
	end interface

	end module polarizations
	@ %def polarizations
	@
	<<[[polarizations_sub.f90]]>>=
	<<File header>>

	submodule (polarizations) polarizations_s

	use io_units
	use format_defs, only: FMT_19
	use diagnostics
	use helicities

	implicit none

	contains

	<<Polarizations: procedures>>

	end submodule polarizations_s

	@ %def polarizations_s
	@
	\subsection{The polarization type}
	Polarization is active whenever the coefficient array is allocated.
	For convenience, we store the spin type ($2s$) and the multiplicity
	($N$) together with the coefficient array ($\alpha$). We have to allow for
	the massless case where $s$ is arbitrary $>0$ but $N=2$, and
	furthermore the chiral massless case where $N=1$. In the latter case,
	the array remains deallocated but the chirality is set to $\pm 1$.

	There is a convention that an antiparticle transforms according to the
	complex conjugate representation. We apply this only when
	transforming from/to polarization defined by a three-vector. For
	antiparticles, the two-component flips sign in that case. When
	transforming from/to a state matrix or [[pmatrix]] representation, we
	do not apply this sign flip.
	<<Polarizations: public>>=
	public :: polarization_t
	<<Polarizations: types>>=
	type :: polarization_t
	private
	integer :: spin_type = SCALAR
	integer :: multiplicity = 1
	integer :: chirality = 0
	logical :: anti = .false.
	type(bloch_vector_t) :: bv
	contains
	<<Polarizations: polarization: TBP>>
	end type polarization_t

	@ %def polarization_t
	@
	\subsection{Basic initializer and finalizer}
	We need the particle flavor for determining the allowed helicity
	values. The Bloch vector is left undefined, so this initializer (in
	two versions) creates an unpolarized particle. Exception: a chiral
	particle is always polarized with definite helicity, it doesn't need a
	Bloch vector.

	This is private.
	<<Polarizations: polarization: TBP>>=
	generic, private :: init => polarization_init, polarization_init_flv
	procedure, private :: polarization_init
	procedure, private :: polarization_init_flv
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_init (pol, spin_type, multiplicity, &
	anti, left_handed, right_handed)
	class(polarization_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	integer, intent(in) :: multiplicity
	logical, intent(in) :: anti
	logical, intent(in) :: left_handed
	logical, intent(in) :: right_handed
	end subroutine polarization_init
	module subroutine polarization_init_flv (pol, flv)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	end subroutine polarization_init_flv
	<<Polarizations: procedures>>=
	module subroutine polarization_init (pol, spin_type, multiplicity, &
	anti, left_handed, right_handed)
	class(polarization_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	integer, intent(in) :: multiplicity
	logical, intent(in) :: anti
	logical, intent(in) :: left_handed
	logical, intent(in) :: right_handed
	pol%spin_type = spin_type
	pol%multiplicity = multiplicity
	pol%anti = anti
	select case (pol%multiplicity)
	case (1)
	if (left_handed) then
	pol%chirality = -1
	else if (right_handed) then
	pol%chirality = 1
	end if
	end select
	select case (pol%chirality)
	case (0)
	call pol%bv%init_unpolarized (spin_type)
	end select
	end subroutine polarization_init

	module subroutine polarization_init_flv (pol, flv)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	call pol%init ( &
	spin_type = flv%get_spin_type (), &
	multiplicity = flv%get_multiplicity (), &
	anti = flv%is_antiparticle (), &
	left_handed = flv%is_left_handed (), &
	right_handed = flv%is_right_handed ())
	end subroutine polarization_init_flv

	@ %def polarization_init polarization_init_flv
	@ Generic polarization: as before, but create a polarized particle
	(Bloch vector defined) with initial polarization zero.
	<<Polarizations: polarization: TBP>>=
	generic :: init_generic => &
	polarization_init_generic, &
	polarization_init_generic_flv
	procedure, private :: polarization_init_generic
	procedure, private :: polarization_init_generic_flv
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_init_generic (pol, spin_type, multiplicity, &
	anti, left_handed, right_handed)
	class(polarization_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	integer, intent(in) :: multiplicity
	logical, intent(in) :: anti
	logical, intent(in) :: left_handed
	logical, intent(in) :: right_handed
	end subroutine polarization_init_generic
	module subroutine polarization_init_generic_flv (pol, flv)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	end subroutine polarization_init_generic_flv
	<<Polarizations: procedures>>=
	module subroutine polarization_init_generic (pol, spin_type, multiplicity, &
	anti, left_handed, right_handed)
	class(polarization_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	integer, intent(in) :: multiplicity
	logical, intent(in) :: anti
	logical, intent(in) :: left_handed
	logical, intent(in) :: right_handed
	call pol%init (spin_type, multiplicity, &
	anti, left_handed, right_handed)
	select case (pol%chirality)
	case (0)
	if (pol%multiplicity == pol%bv%get_n_states ()) then
	call pol%bv%init (spin_type)
	else
	call pol%bv%init_max_weight (spin_type)
	end if
	end select
	end subroutine polarization_init_generic

	module subroutine polarization_init_generic_flv (pol, flv)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	call pol%init_generic ( &
	spin_type = flv%get_spin_type (), &
	multiplicity = flv%get_multiplicity (), &
	anti = flv%is_antiparticle (), &
	left_handed = flv%is_left_handed (), &
	right_handed = flv%is_right_handed ())
	end subroutine polarization_init_generic_flv

	@ %def polarization_init_generic
	@ A finalizer is no longer necessary.

	\subsection{I/O}
	The default setting produces a tabular output of the polarization
	vector entries. Optionally, we can create a state matrix and write
	its contents, emulating the obsolete original implementation.

	If [[all_states]] is true (default), we generate all helity
	combinations regardless of the matrix-element value. Otherwise, skip
	helicities with zero entry, or absolute value less than [[tolerance]],
	if also given.
	<<Polarizations: polarization: TBP>>=
	procedure :: write => polarization_write
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_write (pol, unit, state_matrix, all_states, tolerance)
	class(polarization_t), intent(in) :: pol
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: state_matrix, all_states
	real(default), intent(in), optional :: tolerance
	end subroutine polarization_write
	<<Polarizations: procedures>>=
	module subroutine polarization_write (pol, unit, state_matrix, all_states, tolerance)
	class(polarization_t), intent(in) :: pol
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: state_matrix, all_states
	real(default), intent(in), optional :: tolerance
	logical :: state_m
	type(state_matrix_t) :: state
	real(default), dimension(:), allocatable :: a
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	state_m = .false.; if (present (state_matrix)) state_m = state_matrix
	if (pol%anti) then
	write (u, "(1x,A,I1,A,I1,A,L1,A)") &
	"Polarization: [spin_type = ", pol%spin_type, &
	", mult = ", pol%multiplicity, ", anti = ", pol%anti, "]"
	else
	write (u, "(1x,A,I1,A,I1,A)") &
	"Polarization: [spin_type = ", pol%spin_type, &
	", mult = ", pol%multiplicity, "]"
	end if
	if (state_m) then
	call pol%to_state (state, all_states, tolerance)
	call state%write (unit=unit)
	call state%final ()
	else if (pol%chirality == 1) then
	write (u, "(1x,A)") "chirality = +"
	else if (pol%chirality == -1) then
	write (u, "(1x,A)") "chirality = -"
	else if (pol%bv%is_polarized ()) then
	call pol%bv%to_array (a)
	do i = 1, size (a)
	write (u, "(1x,I2,':',1x,F10.7)") i, a(i)
	end do
	else
	write (u, "(1x,A)") "[unpolarized]"
	end if
	end subroutine polarization_write

	@ %def polarization_write
	@ Binary I/O.
	<<Polarizations: polarization: TBP>>=
	procedure :: write_raw => polarization_write_raw
	procedure :: read_raw => polarization_read_raw
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_write_raw (pol, u)
	class(polarization_t), intent(in) :: pol
	integer, intent(in) :: u
	end subroutine polarization_write_raw
	module subroutine polarization_read_raw (pol, u, iostat)
	class(polarization_t), intent(out) :: pol
	integer, intent(in) :: u
	integer, intent(out), optional :: iostat
	end subroutine polarization_read_raw
	<<Polarizations: procedures>>=
	module subroutine polarization_write_raw (pol, u)
	class(polarization_t), intent(in) :: pol
	integer, intent(in) :: u
	write (u) pol%spin_type
	write (u) pol%multiplicity
	write (u) pol%chirality
	write (u) pol%anti
	call pol%bv%write_raw (u)
	end subroutine polarization_write_raw

	module subroutine polarization_read_raw (pol, u, iostat)
	class(polarization_t), intent(out) :: pol
	integer, intent(in) :: u
	integer, intent(out), optional :: iostat
	read (u, iostat=iostat) pol%spin_type
	read (u, iostat=iostat) pol%multiplicity
	read (u, iostat=iostat) pol%chirality
	read (u, iostat=iostat) pol%anti
	call pol%bv%read_raw (u, iostat)
	end subroutine polarization_read_raw

	@ %def polarization_read_raw
	@
	\subsection{Accessing contents}
	Return true if the particle is technically polarized. The particle
	is either chiral, or its Bloch vector has been defined. The
	function returns true even if the Bloch vector is zero or the particle
	is scalar.
	<<Polarizations: polarization: TBP>>=
	procedure :: is_polarized => polarization_is_polarized
	<<Polarizations: sub interfaces>>=
	module function polarization_is_polarized (pol) result (polarized)
	class(polarization_t), intent(in) :: pol
	logical :: polarized
	end function polarization_is_polarized
	<<Polarizations: procedures>>=
	module function polarization_is_polarized (pol) result (polarized)
	class(polarization_t), intent(in) :: pol
	logical :: polarized
	polarized = pol%chirality /= 0 .or. pol%bv%is_polarized ()
	end function polarization_is_polarized

	@ %def polarization_is_polarized
	@ Return true if the polarization is diagonal, i.e., all entries in
	the density matrix are diagonal. For an unpolarized particle, we also
	return [[.true.]] since the density matrix is proportional to the unit
	matrix.
	<<Polarizations: polarization: TBP>>=
	procedure :: is_diagonal => polarization_is_diagonal
	<<Polarizations: sub interfaces>>=
	module function polarization_is_diagonal (pol) result (diagonal)
	class(polarization_t), intent(in) :: pol
	logical :: diagonal
	end function polarization_is_diagonal
	<<Polarizations: procedures>>=
	module function polarization_is_diagonal (pol) result (diagonal)
	class(polarization_t), intent(in) :: pol
	logical :: diagonal
	select case (pol%chirality)
	case (0)
	diagonal = pol%bv%is_diagonal ()
	case default
	diagonal = .true.
	end select
	end function polarization_is_diagonal

	@ %def polarization_is_diagonal
	@
	\subsection{Mapping between polarization and state matrix}
	Create the polarization object that corresponds to a state matrix. The state
	matrix is not necessarily normalized. The result will be either unpolarized,
	or a generalized Bloch vector that we compute in terms of the appropriate spin
	generator basis. To this end, we first construct the complete density
	matrix, then set the Bloch vector with this input.

	For a naturally chiral particle (i.e., neutrino), we do not set the
	polarization vector, it is implied.

	Therefore, we cannot account for any sign flip and transform as-is.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_state_matrix => polarization_init_state_matrix
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_init_state_matrix (pol, state)
	class(polarization_t), intent(out) :: pol
	type(state_matrix_t), intent(in), target :: state
	end subroutine polarization_init_state_matrix
	<<Polarizations: procedures>>=
	module subroutine polarization_init_state_matrix (pol, state)
	class(polarization_t), intent(out) :: pol
	type(state_matrix_t), intent(in), target :: state
	type(state_iterator_t) :: it
	type(flavor_t) :: flv
	type(helicity_t) :: hel
	integer :: d, h1, h2, i, j
	complex(default), dimension(:,:), allocatable :: r
	complex(default) :: me
	real(default) :: trace
	call it%init (state)
	flv = it%get_flavor (1)
	hel = it%get_helicity (1)
	if (hel%is_defined ()) then
	call pol%init_generic (flv)
	select case (pol%chirality)
	case (0)
	trace = 0
	d = pol%bv%get_n_states ()
	allocate (r (d, d), source = (0._default, 0._default))
	do while (it%is_valid ())
	hel = it%get_helicity (1)
	call hel%get_indices (h1, h2)
	i = pol%bv%hel_index (h1)
	j = pol%bv%hel_index (h2)
	me = it%get_matrix_element ()
	r(i,j) = me
	if (i == j) trace = trace + real (me)
	call it%advance ()
	end do
	if (trace /= 0) call pol%bv%set (r / trace)
	end select
	else
	call pol%init (flv)
	end if
	end subroutine polarization_init_state_matrix

	@ %def polarization_init_state_matrix
	@ Create the state matrix that corresponds to a given polarization. We make
	use of the polarization iterator as defined below, which should iterate
	according to the canonical helicity ordering.
	<<Polarizations: polarization: TBP>>=
	procedure :: to_state => polarization_to_state_matrix
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_to_state_matrix (pol, state, all_states, tolerance)
	class(polarization_t), intent(in), target :: pol
	type(state_matrix_t), intent(out) :: state
	logical, intent(in), optional :: all_states
	real(default), intent(in), optional :: tolerance
	end subroutine polarization_to_state_matrix
	<<Polarizations: procedures>>=
	module subroutine polarization_to_state_matrix (pol, state, all_states, tolerance)
	class(polarization_t), intent(in), target :: pol
	type(state_matrix_t), intent(out) :: state
	logical, intent(in), optional :: all_states
	real(default), intent(in), optional :: tolerance
	type(polarization_iterator_t) :: it
	type(quantum_numbers_t), dimension(1) :: qn
	complex(default) :: value
	call it%init (pol, all_states, tolerance)
	call state%init (store_values = .true.)
	do while (it%is_valid ())
	value = it%get_value ()
	qn(1) = it%get_quantum_numbers ()
	call state%add_state (qn, value = value)
	call it%advance ()
	end do
	call state%freeze ()
	end subroutine polarization_to_state_matrix

	@ %def polarization_to_state_matrix
	@
	\subsection{Specific initializers}
	Unpolarized particle, no nontrivial entries in the density matrix. This
	is the default initialization mode.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_unpolarized => polarization_init_unpolarized
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_init_unpolarized (pol, flv)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	end subroutine polarization_init_unpolarized
	<<Polarizations: procedures>>=
	module subroutine polarization_init_unpolarized (pol, flv)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	call pol%init (flv)
	end subroutine polarization_init_unpolarized

	@ %def polarization_init_unpolarized
	@ The following three modes are useful mainly for spin-1/2 particle
	and massless particles of any nonzero spin. Only the highest-weight
	components are filled.

	Circular polarization: The density matrix of the two highest-weight
	states is
	\begin{equation*}
	\rho(f) =
	\frac{1-\|f\|}{2}\mathbf{1} +
	\|f\| \times
	\begin{cases}
	\begin{pmatrix} 1 & 0 \\ 0 & 0 \end{pmatrix}, & f > 0; \\[6pt]
	\begin{pmatrix} 0 & 0 \\ 0 & 1 \end{pmatrix}, & f < 0,
	\end{cases}
	\end{equation*}
	In the generalized Bloch representation, this is an entry for the $T^3$
	generator only, regardless of the spin representation.

	A chiral particle is not affected.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_circular => polarization_init_circular
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_init_circular (pol, flv, f)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), intent(in) :: f
	end subroutine polarization_init_circular
	<<Polarizations: procedures>>=
	module subroutine polarization_init_circular (pol, flv, f)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), intent(in) :: f
	call pol%init (flv)
	select case (pol%chirality)
	case (0)
	call pol%bv%init_vector (pol%spin_type, &
	[0._default, 0._default, f])
	end select
	end subroutine polarization_init_circular

	@ %def polarization_init_circular
	@ Transversal polarization is analogous to circular, but we get a
	density matrix
	\begin{equation*}
	\rho(f,\phi) =
	\frac{1-\|f\|}{2}\mathbf{1}
	+ \frac{\|f\|}{2} \begin{pmatrix} 1 & e^{-i\phi} \\ e^{i\phi} & 1
	\end{pmatrix}.
	\end{equation*}
	for the highest-weight subspace. The lower weights are unaffected.
	The phase is $\phi=0$ for the $x$-axis, $\phi=90^\circ$ for the $y$
	axis as polarization vector.

	For an antiparticle, the phase switches sign, and for $f<0$, the
	off-diagonal elements switch sign.

	A chiral particle is not affected.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_transversal => polarization_init_transversal
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_init_transversal (pol, flv, phi, f)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), intent(in) :: phi, f
	end subroutine polarization_init_transversal
	<<Polarizations: procedures>>=
	module subroutine polarization_init_transversal (pol, flv, phi, f)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), intent(in) :: phi, f
	call pol%init (flv)
	select case (pol%chirality)
	case (0)
	if (pol%anti) then
	call pol%bv%init_vector (pol%spin_type, &
	[f * cos (phi), f * sin (phi), 0._default])
	else
	call pol%bv%init_vector (pol%spin_type, &
	[f * cos (phi),-f * sin (phi), 0._default])
	end if
	end select
	end subroutine polarization_init_transversal

	@ %def polarization_init_transversal
	@ For axis polarization, we again set only the entries with maximum weight,
	which for spin $1/2$ means
	\begin{equation*}
	\rho(f,\phi) =
	\frac{1}{2} \begin{pmatrix}
	1 + \alpha_3 & \alpha_1 - i\alpha_2 \\
	\alpha_1 + i\alpha_2 & 1 - \alpha_3
	\end{pmatrix}.
	\end{equation*}
	For an antiparticle, the imaginary part proportional to $\alpha_2$ switches
	sign (complex conjugate). A chiral particle is not affected.

	In the generalized Bloch representation, this translates into coefficients for
	$T^{1,2,3}$, all others stay zero.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_axis => polarization_init_axis
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_init_axis (pol, flv, alpha)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), dimension(3), intent(in) :: alpha
	end subroutine polarization_init_axis
	<<Polarizations: procedures>>=
	module subroutine polarization_init_axis (pol, flv, alpha)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), dimension(3), intent(in) :: alpha
	call pol%init (flv)
	select case (pol%chirality)
	case (0)
	if (pol%anti) then
	call pol%bv%init_vector (pol%spin_type, &
	[alpha(1), alpha(2), alpha(3)])
	else
	call pol%bv%init_vector (pol%spin_type, &
	[alpha(1),-alpha(2), alpha(3)])
	end if
	end select
	end subroutine polarization_init_axis

	@ %def polarization_init_axis
	@ This version specifies the polarization axis in terms of $r$
	(polarization degree) and $\theta,\phi$ (polar and azimuthal angles).

	If one of the angles is a nonzero multiple of $\pi$, roundoff errors
	typically will result in tiny contributions to unwanted components.
	Therefore, include a catch for small numbers.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_angles => polarization_init_angles
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_init_angles (pol, flv, r, theta, phi)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), intent(in) :: r, theta, phi
	end subroutine polarization_init_angles
	<<Polarizations: procedures>>=
	module subroutine polarization_init_angles (pol, flv, r, theta, phi)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), intent(in) :: r, theta, phi
	real(default), dimension(3) :: alpha
	real(default), parameter :: eps = 10 * epsilon (1._default)

	alpha(1) = r * sin (theta) * cos (phi)
	alpha(2) = r * sin (theta) * sin (phi)
	alpha(3) = r * cos (theta)
	where (abs (alpha) < eps) alpha = 0
	call pol%init_axis (flv, alpha)
	end subroutine polarization_init_angles

	@ %def polarization_init_angles
	@ Longitudinal polarization is defined only for massive bosons. Only
	the zero component is filled. Otherwise, unpolarized.

	In the generalized Bloch representation, the zero component corresponds to a
	linear combination of all diagonal (Cartan) generators.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_longitudinal => polarization_init_longitudinal
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_init_longitudinal (pol, flv, f)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), intent(in) :: f
	end subroutine polarization_init_longitudinal
	<<Polarizations: procedures>>=
	module subroutine polarization_init_longitudinal (pol, flv, f)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), intent(in) :: f
	real(default), dimension(:), allocatable :: rd
	integer :: s, d
	s = flv%get_spin_type ()
	select case (s)
	case (VECTOR, TENSOR)
	call pol%init_generic (flv)
	if (pol%bv%is_polarized ()) then
	d = pol%bv%get_n_states ()
	allocate (rd (d), source = 0._default)
	rd(pol%bv%hel_index (0)) = f
	call pol%bv%set (rd)
	end if
	case default
	call pol%init_unpolarized (flv)
	end select
	end subroutine polarization_init_longitudinal

	@ %def polarization_init_longitudinal
	@ This is diagonal polarization: we specify all components explicitly.
	[[rd]] is the array of diagonal elements of the density matrix. We
	assume that the length of [[rd]] is equal to the particle
	multiplicity.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_diagonal => polarization_init_diagonal
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_init_diagonal (pol, flv, rd)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), dimension(:), intent(in) :: rd
	end subroutine polarization_init_diagonal
	<<Polarizations: procedures>>=
	module subroutine polarization_init_diagonal (pol, flv, rd)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), dimension(:), intent(in) :: rd
	real(default) :: trace
	call pol%init_generic (flv)
	if (pol%bv%is_polarized ()) then
	trace = sum (rd)
	if (trace /= 0) call pol%bv%set (rd / trace)
	end if
	end subroutine polarization_init_diagonal

	@ %def polarization_init_diagonal
	@
	\subsection{Operations}
	Combine polarization states by computing the outer product of the
	state matrices.
	<<Polarizations: public>>=
	public :: combine_polarization_states
	<<Polarizations: sub interfaces>>=
	module subroutine combine_polarization_states (pol, state)
	type(polarization_t), dimension(:), intent(in), target :: pol
	type(state_matrix_t), intent(out) :: state
	end subroutine combine_polarization_states
	<<Polarizations: procedures>>=
	module subroutine combine_polarization_states (pol, state)
	type(polarization_t), dimension(:), intent(in), target :: pol
	type(state_matrix_t), intent(out) :: state
	type(state_matrix_t), dimension(size(pol)), target :: pol_state
	integer :: i
	do i = 1, size (pol)
	call pol(i)%to_state (pol_state(i))
	end do
	call outer_multiply (pol_state, state)
	do i = 1, size (pol)
	call pol_state(i)%final ()
	end do
	end subroutine combine_polarization_states

	@ %def combine_polarization_states
	@ Transform a polarization density matrix into a polarization vector. This is
	possible without information loss only for spin-1/2 and for massless
	particles. To get a unique answer in all cases, we consider only the
	components with highest weight. Obviously, this loses the longitudinal
	component of a massive vector, for instance. The norm of the returned axis is
	the polarization fraction for the highest-weight subspace. For a scalar
	particle, we return a zero vector. The same result applies if the
	highest-weight component vanishes.

	This is the inverse operation of [[polarization_init_axis]] above,
	where the polarization fraction is set to unity.

	For an antiparticle, the [[alpha(2)]] coefficient flips sign.
	<<Polarizations: polarization: TBP>>=
	procedure :: get_axis => polarization_get_axis
	<<Polarizations: sub interfaces>>=
	module function polarization_get_axis (pol) result (alpha)
	class(polarization_t), intent(in), target :: pol
	real(default), dimension(3) :: alpha
	end function polarization_get_axis
	<<Polarizations: procedures>>=
	module function polarization_get_axis (pol) result (alpha)
	class(polarization_t), intent(in), target :: pol
	real(default), dimension(3) :: alpha
	select case (pol%chirality)
	case (0)
	call pol%bv%to_vector (alpha)
	if (.not. pol%anti) alpha(2) = - alpha(2)
	case (-1)
	alpha = [0._default, 0._default, -1._default]
	case (1)
	alpha = [0._default, 0._default, 1._default]
	end select
	end function polarization_get_axis

	@ %def polarization_get_axis
	@ This function returns polarization degree and polar and azimuthal
	angles ($\theta,\phi$) of the polarization axis. The same restrictions apply
	as above.

	Since we call the [[get_axis]] method, the phase flips sign for an
	antiparticle.
	<<Polarizations: polarization: TBP>>=
	procedure :: to_angles => polarization_to_angles
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_to_angles (pol, r, theta, phi)
	class(polarization_t), intent(in) :: pol
	real(default), intent(out) :: r, theta, phi
	end subroutine polarization_to_angles
	<<Polarizations: procedures>>=
	module subroutine polarization_to_angles (pol, r, theta, phi)
	class(polarization_t), intent(in) :: pol
	real(default), intent(out) :: r, theta, phi
	real(default), dimension(3) :: alpha
	real(default) :: norm, r12
	alpha = pol%get_axis ()
	norm = sum (alpha**2)
	r = sqrt (norm)
	if (norm > 0) then
	r12 = sqrt (alpha(1)2 + alpha(2)2)
	theta = atan2 (r12, alpha(3))
	if (any (alpha(1:2) /= 0)) then
	phi = atan2 (alpha(2), alpha(1))
	else
	phi = 0
	end if
	else
	theta = 0
	phi = 0
	end if
	end subroutine polarization_to_angles

	@ %def polarization_to_angles
	@
	\subsection{Polarization Iterator}
	The iterator acts like a state matrix iterator, i.e., it points to one
	helicity combination at a time and can return the corresponding helicity
	object and matrix-element value.

	Since the polarization is stored as a Bloch vector, we recover the
	whole density matrix explicitly upon initialization, store it inside
	the iterator object, and then just return its elements one at a time.

	For an unpolarized particle, the iterator returns a single state with
	undefined helicity. The value is the value of any diagonal density
	matrix element, $1/n$ where $n$ is the multiplicity.
	<<Polarizations: public>>=
	public :: polarization_iterator_t
	<<Polarizations: types>>=
	type :: polarization_iterator_t
	private
	type(polarization_t), pointer :: pol => null ()
	logical :: polarized = .false.
	integer :: h1 = 0
	integer :: h2 = 0
	integer :: i = 0
	integer :: j = 0
	complex(default), dimension(:,:), allocatable :: r
	complex(default) :: value = 1._default
	real(default) :: tolerance = -1._default
	logical :: valid = .false.
	contains
	<<Polarizations: polarization iterator: TBP>>
	end type polarization_iterator_t

	@ %def polarization_iterator_t
	@ Output for debugging purposes only, therefore no format for real/complex.
	<<Polarizations: polarization iterator: TBP>>=
	procedure :: write => polarization_iterator_write
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_iterator_write (it, unit)
	class(polarization_iterator_t), intent(in) :: it
	integer, intent(in), optional :: unit
	end subroutine polarization_iterator_write
	<<Polarizations: procedures>>=
	module subroutine polarization_iterator_write (it, unit)
	class(polarization_iterator_t), intent(in) :: it
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1X,A)") "Polarization iterator:"
	write (u, "(3X,A,L1)") "assigned = ", associated (it%pol)
	write (u, "(3X,A,L1)") "valid = ", it%valid
	if (it%valid) then
	write (u, "(3X,A,2(1X,I2))") "i, j = ", it%i, it%j
	write (u, "(3X,A,2(1X,I2))") "h1, h2 = ", it%h1, it%h2
	write (u, "(3X,A)", advance="no") "value = "
	write (u, *) it%value
	if (allocated (it%r)) then
	do i = 1, size (it%r, 2)
	write (u, *) it%r(i,:)
	end do
	end if
	end if
	end subroutine polarization_iterator_write

	@ %def polarization_iterator_write
	@ Initialize, i.e., (virtually) point to the first helicity state
	supported by the polarization object. If the density matrix is
	nontrivial, we calculate it here.

	Following the older state-matrix
	conventions, the iterator sequence starts at the lowest helicity
	value. In the current internal representation, this corresponds to
	the highest index value.

	If the current matrix-element value is zero, advance the iterator.
	Advancing will stop at a nonzero value or if the iterator becomes
	invalid.

	If [[tolerance]] is given, any state matrix entry less or equal will
	be treated as zero, causing the iterator to skip an entry. By
	default, the value is negative, so no entry is skipped.
	<<Polarizations: polarization iterator: TBP>>=
	procedure :: init => polarization_iterator_init
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_iterator_init (it, pol, all_states, tolerance)
	class(polarization_iterator_t), intent(out) :: it
	type(polarization_t), intent(in), target :: pol
	logical, intent(in), optional :: all_states
	real(default), intent(in), optional :: tolerance
	end subroutine polarization_iterator_init
	<<Polarizations: procedures>>=
	module subroutine polarization_iterator_init (it, pol, all_states, tolerance)
	class(polarization_iterator_t), intent(out) :: it
	type(polarization_t), intent(in), target :: pol
	logical, intent(in), optional :: all_states
	real(default), intent(in), optional :: tolerance
	integer :: d
	logical :: only_max_weight
	it%pol => pol
	if (present (all_states)) then
	if (.not. all_states) then
	if (present (tolerance)) then
	it%tolerance = tolerance
	else
	it%tolerance = 0
	end if
	end if
	end if
	select case (pol%chirality)
	case (0)
	d = pol%bv%get_n_states ()
	only_max_weight = pol%multiplicity < d
	it%polarized = pol%bv%is_polarized ()
	if (it%polarized) then
	it%i = d
	it%j = it%i
	it%h1 = pol%bv%hel_value (it%i)
	it%h2 = it%h1
	call pol%bv%to_matrix (it%r, only_max_weight)
	it%value = it%r(it%i, it%j)
	else
	it%value = 1._default / d
	end if
	it%valid = .true.
	case (1,-1)
	it%polarized = .true.
	select case (pol%spin_type)
	case (SPINOR)
	it%h1 = pol%chirality
	case (VECTORSPINOR)
	it%h1 = 2 * pol%chirality
	end select
	it%h2 = it%h1
	it%valid = .true.
	end select
	if (it%valid .and. abs (it%value) <= it%tolerance) call it%advance ()
	end subroutine polarization_iterator_init

	@ %def polarization_iterator_init
	@ Advance to the next valid helicity state. Repeat if the returned value is
	zero.

	For an unpolarized object, we iterate through the diagonal helicity
	states with a constant value.
	<<Polarizations: polarization iterator: TBP>>=
	procedure :: advance => polarization_iterator_advance
	<<Polarizations: sub interfaces>>=
	recursive module subroutine polarization_iterator_advance (it)
	class(polarization_iterator_t), intent(inout) :: it
	end subroutine polarization_iterator_advance
	<<Polarizations: procedures>>=
	recursive module subroutine polarization_iterator_advance (it)
	class(polarization_iterator_t), intent(inout) :: it
	if (it%valid) then
	select case (it%pol%chirality)
	case (0)
	if (it%polarized) then
	if (it%j > 1) then
	it%j = it%j - 1
	it%h2 = it%pol%bv%hel_value (it%j)
	it%value = it%r(it%i, it%j)
	else if (it%i > 1) then
	it%j = it%pol%bv%get_n_states ()
	it%h2 = it%pol%bv%hel_value (it%j)
	it%i = it%i - 1
	it%h1 = it%pol%bv%hel_value (it%i)
	it%value = it%r(it%i, it%j)
	else
	it%valid = .false.
	end if
	else
	it%valid = .false.
	end if
	case default
	it%valid = .false.
	end select
	if (it%valid .and. abs (it%value) <= it%tolerance) call it%advance ()
	end if
	end subroutine polarization_iterator_advance

	@ %def polarization_iterator_advance
	@ This is true as long as the iterator points to a valid helicity state.
	<<Polarizations: polarization iterator: TBP>>=
	procedure :: is_valid => polarization_iterator_is_valid
	<<Polarizations: sub interfaces>>=
	module function polarization_iterator_is_valid (it) result (is_valid)
	logical :: is_valid
	class(polarization_iterator_t), intent(in) :: it
	end function polarization_iterator_is_valid
	<<Polarizations: procedures>>=
	module function polarization_iterator_is_valid (it) result (is_valid)
	logical :: is_valid
	class(polarization_iterator_t), intent(in) :: it
	is_valid = it%valid
	end function polarization_iterator_is_valid

	@ %def polarization_iterator_is_valid
	@ Return the matrix element value for the helicity that we are currently
	pointing at.
	<<Polarizations: polarization iterator: TBP>>=
	procedure :: get_value => polarization_iterator_get_value
	<<Polarizations: sub interfaces>>=
	module function polarization_iterator_get_value (it) result (value)
	complex(default) :: value
	class(polarization_iterator_t), intent(in) :: it
	end function polarization_iterator_get_value
	<<Polarizations: procedures>>=
	module function polarization_iterator_get_value (it) result (value)
	complex(default) :: value
	class(polarization_iterator_t), intent(in) :: it
	if (it%valid) then
	value = it%value
	else
	value = 0
	end if
	end function polarization_iterator_get_value

	@ %def polarization_iterator_get_value
	@ Return a quantum number object for the helicity that we are currently
	pointing at. This is a single quantum number object, not an array.

	Note that the [[init]] method of the helicity object has the order reversed.
	<<Polarizations: polarization iterator: TBP>>=
	procedure :: get_quantum_numbers => polarization_iterator_get_quantum_numbers
	<<Polarizations: sub interfaces>>=
	module function polarization_iterator_get_quantum_numbers (it) result (qn)
	class(polarization_iterator_t), intent(in) :: it
	type(quantum_numbers_t) :: qn
	end function polarization_iterator_get_quantum_numbers
	<<Polarizations: procedures>>=
	module function polarization_iterator_get_quantum_numbers (it) result (qn)
	class(polarization_iterator_t), intent(in) :: it
	type(helicity_t) :: hel
	type(quantum_numbers_t) :: qn
	if (it%polarized) then
	call hel%init (it%h2, it%h1)
	end if
	call qn%init (hel)
	end function polarization_iterator_get_quantum_numbers

	@ %def polarization_iterator_get_quantum_numbers
	@
	\subsection{Sparse Matrix}
	We introduce a simple implementation of a sparse matrix that can represent
	polarization (or similar concepts) for transfer to I/O within the
	program. It consists of an integer array that represents the index
	values, and a complex array that represents the nonvanishing entries. The
	number of nonvanishing entries must be known for initialization, but the
	entries are filled one at a time.

	Here is a base type without the special properties of a spin-density matrix.
	<<Polarizations: public>>=
	public :: smatrix_t
	<<Polarizations: types>>=
	type :: smatrix_t
	private
	integer :: dim = 0
	integer :: n_entry = 0
	integer, dimension(:,:), allocatable :: index
	complex(default), dimension(:), allocatable :: value
	contains
	<<Polarizations: smatrix: TBP>>
	end type smatrix_t

	@ %def smatrix_t
	@ Output.
	<<Polarizations: smatrix: TBP>>=
	procedure :: write => smatrix_write
	<<Polarizations: sub interfaces>>=
	module subroutine smatrix_write (object, unit, indent)
	class(smatrix_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	end subroutine smatrix_write
	<<Polarizations: procedures>>=
	module subroutine smatrix_write (object, unit, indent)
	class(smatrix_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	integer :: u, i, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	if (allocated (object%value)) then
	if (size (object%value) > 0) then
	do i = 1, object%n_entry
	write (u, "(1x,A,'@(')", advance="no") repeat (" ", ind)
	write (u, "(SP,9999(I2.1,':',1x))", advance="no") &
	object%index(:,i)
	write (u, "('('," // FMT_19 // ",','," // FMT_19 // &
	",'))')") object%value(i)
	end do
	else
	write (u, "(1x,A)", advance="no") repeat (" ", ind)
	write (u, "(A)") "[empty matrix]"
	end if
	else
	write (u, "(1x,A)", advance="no") repeat (" ", ind)
	write (u, "(A)") "[undefined matrix]"
	end if
	end subroutine smatrix_write

	@ %def smatrix_write
	@ Initialization: allocate arrays to the correct size. We specify both the
	dimension of the matrix (if different from two, this is rather a generic
	tensor) and the number of nonvanishing entries.
	<<Polarizations: smatrix: TBP>>=
	procedure :: init => smatrix_init
	<<Polarizations: sub interfaces>>=
	module subroutine smatrix_init (smatrix, dim, n_entry)
	class(smatrix_t), intent(out) :: smatrix
	integer, intent(in) :: dim
	integer, intent(in) :: n_entry
	end subroutine smatrix_init
	<<Polarizations: procedures>>=
	module subroutine smatrix_init (smatrix, dim, n_entry)
	class(smatrix_t), intent(out) :: smatrix
	integer, intent(in) :: dim
	integer, intent(in) :: n_entry
	smatrix%dim = dim
	smatrix%n_entry = n_entry
	allocate (smatrix%index (dim, n_entry))
	allocate (smatrix%value (n_entry))
	end subroutine smatrix_init

	@ %def smatrix_init
	@ Fill: one entry at a time.
	<<Polarizations: smatrix: TBP>>=
	procedure :: set_entry => smatrix_set_entry
	<<Polarizations: sub interfaces>>=
	module subroutine smatrix_set_entry (smatrix, i, index, value)
	class(smatrix_t), intent(inout) :: smatrix
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: index
	complex(default), intent(in) :: value
	end subroutine smatrix_set_entry
	<<Polarizations: procedures>>=
	module subroutine smatrix_set_entry (smatrix, i, index, value)
	class(smatrix_t), intent(inout) :: smatrix
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: index
	complex(default), intent(in) :: value
	smatrix%index(:,i) = index
	smatrix%value(i) = value
	end subroutine smatrix_set_entry

	@ %def smatrix_set_entry
	@
	<<Polarizations: smatrix: TBP>>=
	procedure :: exists => smatrix_exists
	<<Polarizations: sub interfaces>>=
	elemental module function smatrix_exists (smatrix) result (exist)
	logical :: exist
	class(smatrix_t), intent(in) :: smatrix
	end function smatrix_exists
	<<Polarizations: procedures>>=
	elemental module function smatrix_exists (smatrix) result (exist)
	logical :: exist
	class(smatrix_t), intent(in) :: smatrix
	exist = .not. all (smatrix%value == 0)
	end function smatrix_exists

	@ %def smatrix_exists
	@
	\subsection{Polarization Matrix}
	As an extension of the more generic [[smatrix]] type, we implement a proper
	spin-density matrix. After the matrix has been filled, we can fix spin type
	and multiplicity for a particle, check the matrix for consistency, and
	normalize it if necessary.

	This implementation does not have an antiparticle flag, just
	like the state matrix object. We therefore cannot account for sign
	flips when using this object.

	TODO: The [[pure]] flag is for informational purposes only, and it
	only represents a necessary condition if spin is greater than $1/2$.
	We may either check purity for all spins or drop this.
	<<Polarizations: public>>=
	public :: pmatrix_t
	<<Polarizations: types>>=
	type, extends (smatrix_t) :: pmatrix_t
	private
	integer :: spin_type = 0
	integer :: multiplicity = 0
	logical :: massive = .true.
	integer :: chirality = 0
	real(default) :: degree = 1
	logical :: pure = .false.
	contains
	<<Polarizations: pmatrix: TBP>>
	end type pmatrix_t

	@ %def pmatrix_t
	@ Output, including extra data. (The [[indent]] argument is ignored.)
	<<Polarizations: pmatrix: TBP>>=
	procedure :: write => pmatrix_write
	<<Polarizations: sub interfaces>>=
	module subroutine pmatrix_write (object, unit, indent)
	class(pmatrix_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	end subroutine pmatrix_write
	<<Polarizations: procedures>>=
	module subroutine pmatrix_write (object, unit, indent)
	class(pmatrix_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Polarization: spin density matrix"
	write (u, "(3x,A,I0)") "spin type = ", object%spin_type
	write (u, "(3x,A,I0)") "multiplicity = ", object%multiplicity
	write (u, "(3x,A,L1)") "massive = ", object%massive
	write (u, "(3x,A,I0)") "chirality = ", object%chirality
	write (u, "(3x,A,F10.7)") "pol.degree =", object%degree
	write (u, "(3x,A,L1)") "pure state = ", object%pure
	call object%smatrix_t%write (u, 1)
	end subroutine pmatrix_write

	@ %def pmatrix_write
	@ This assignment is trivial, but must be coded explicitly.
	<<Polarizations: pmatrix: TBP>>=
	generic :: assignment(=) => pmatrix_assign_from_smatrix
	procedure, private :: pmatrix_assign_from_smatrix
	<<Polarizations: sub interfaces>>=
	module subroutine pmatrix_assign_from_smatrix (pmatrix, smatrix)
	class(pmatrix_t), intent(out) :: pmatrix
	type(smatrix_t), intent(in) :: smatrix
	end subroutine pmatrix_assign_from_smatrix
	<<Polarizations: procedures>>=
	module subroutine pmatrix_assign_from_smatrix (pmatrix, smatrix)
	class(pmatrix_t), intent(out) :: pmatrix
	type(smatrix_t), intent(in) :: smatrix
	pmatrix%smatrix_t = smatrix
	end subroutine pmatrix_assign_from_smatrix

	@ %def pmatrix_assign_from_smatrix
	@ Declare spin, multiplicity, and polarization degree. Check whether all
	entries fit, and whether this is a valid matrix.

	The required properties are:
	\begin{enumerate}
	\item all entries apply to the given spin and mass type
	\item the diagonal is real
	\item only the upper of corresponding off-diagonal elements is specified,
	i.e., the row index is less than the column index
	\item the trace is nonnegative and equal to the polarization degree (the
	remainder, proportional to the unit matrix, is understood to be present)
	\item the trace of the matrix square is positive and less or equal
	to the trace of the matrix itself, which is the polarization degree.
	\item If the trace of the matrix square and the trace of the matrix are unity,
	we may have a pure state. (For spin up to $1/2$, this is actually
	sufficient.)
	\end{enumerate}
	<<Polarizations: pmatrix: TBP>>=
	procedure :: normalize => pmatrix_normalize
	<<Polarizations: sub interfaces>>=
	module subroutine pmatrix_normalize (pmatrix, flv, degree, tolerance)
	class(pmatrix_t), intent(inout) :: pmatrix
	type(flavor_t), intent(in) :: flv
	real(default), intent(in), optional :: degree
	real(default), intent(in), optional :: tolerance
	end subroutine pmatrix_normalize
	<<Polarizations: procedures>>=
	module subroutine pmatrix_normalize (pmatrix, flv, degree, tolerance)
	class(pmatrix_t), intent(inout) :: pmatrix
	type(flavor_t), intent(in) :: flv
	real(default), intent(in), optional :: degree
	real(default), intent(in), optional :: tolerance
	integer :: i, hmax
	logical :: fermion, ok
	real(default) :: trace, trace_sq
	real(default) :: tol
	tol = 0; if (present (tolerance)) tol = tolerance
	pmatrix%spin_type = flv%get_spin_type ()
	pmatrix%massive = flv%get_mass () /= 0
	if (.not. pmatrix%massive) then
	if (flv%is_left_handed ()) then
	pmatrix%chirality = -1
	else if (flv%is_right_handed ()) then
	pmatrix%chirality = +1
	end if
	end if
	if (pmatrix%spin_type == SCALAR) then
	pmatrix%multiplicity = 1
	else if (pmatrix%massive) then
	pmatrix%multiplicity = pmatrix%spin_type
	else if (pmatrix%chirality == 0) then
	pmatrix%multiplicity = 2
	else
	pmatrix%multiplicity = 1
	end if
	if (present (degree)) then
	if (degree < 0 .or. degree > 1) &
	call msg_error ("polarization degree must be between 0 and 1")
	pmatrix%degree = degree
	end if
	if (size (pmatrix%index, 1) /= 2) call error ("wrong array rank")
	fermion = mod (pmatrix%spin_type, 2) == 0
	hmax = pmatrix%spin_type / 2
	if (pmatrix%n_entry > 0) then
	if (fermion) then
	if (pmatrix%massive) then
	ok = all (pmatrix%index /= 0) &
	.and. all (abs (pmatrix%index) <= hmax)
	else if (pmatrix%chirality == -1) then
	ok = all (pmatrix%index == -hmax)
	else if (pmatrix%chirality == +1) then
	ok = all (pmatrix%index == +hmax)
	else
	ok = all (abs (pmatrix%index) == hmax)
	end if
	else
	if (pmatrix%massive) then
	ok = all (abs (pmatrix%index) <= hmax)
	else
	ok = all (abs (pmatrix%index) == hmax)
	end if
	end if
	if (.not. ok) call error ("illegal index value")
	else
	pmatrix%degree = 0
	pmatrix%pure = pmatrix%multiplicity == 1
	return
	end if
	trace = 0
	do i = 1, pmatrix%n_entry
	associate (index => pmatrix%index(:,i), value => pmatrix%value(i))
	if (index(1) == index(2)) then
	if (abs (aimag (value)) > tol) call error ("diagonal must be real")
	value = real (value, kind=default)
	trace = trace + value

	else if (any (pmatrix%index(1,:) == index(2) &
	.and. pmatrix%index(2,:) == index(1))) then
	call error ("redundant off-diagonal entry")
	else if (index(2) < index (1)) then
	index = index([2,1])
	value = conjg (value)
	end if
	end associate
	end do
	if (abs (trace) <= tol) call error ("trace must not vanish")
	trace = real (trace, kind=default)
	pmatrix%value = pmatrix%value / trace * pmatrix%degree
	trace_sq = (1 - pmatrix%degree ** 2) / pmatrix%multiplicity
	do i = 1, pmatrix%n_entry
	associate (index => pmatrix%index(:,i), value => pmatrix%value(i))
	if (index(1) == index(2)) then
	trace_sq = trace_sq + abs (value) ** 2
	else
	trace_sq = trace_sq + 2 * abs (value) ** 2
	end if
	end associate
	end do
	if (pmatrix%multiplicity == 1) then
	pmatrix%pure = .true.
	else if (abs (trace_sq - 1) <= tol) then
	pmatrix%pure = .true.
	else if (trace_sq - 1 > tol .or. trace_sq < -tol) then
	print *, "Trace of matrix square = ", trace_sq
	call error ("not permissible as density matrix")
	end if
	contains
	subroutine error (msg)
	character(*), intent(in) :: msg
	call pmatrix%write ()
	call msg_fatal ("Spin density matrix: " // msg)
	end subroutine error
	end subroutine pmatrix_normalize

	@ %def pmatrix_normalize
	@
	A polarized matrix is defined as one with a positive polarization degree, even
	if the actual matrix is trivial.
	<<Polarizations: pmatrix: TBP>>=
	procedure :: is_polarized => pmatrix_is_polarized
	<<Polarizations: sub interfaces>>=
	elemental module function pmatrix_is_polarized (pmatrix) result (flag)
	class(pmatrix_t), intent(in) :: pmatrix
	logical :: flag
	end function pmatrix_is_polarized
	<<Polarizations: procedures>>=
	elemental module function pmatrix_is_polarized (pmatrix) result (flag)
	class(pmatrix_t), intent(in) :: pmatrix
	logical :: flag
	flag = pmatrix%degree > 0
	end function pmatrix_is_polarized

	@ %def pmatrix_is_polarized
	@
	Check if there are only diagonal entries.
	<<Polarizations: pmatrix: TBP>>=
	procedure :: is_diagonal => pmatrix_is_diagonal
	<<Polarizations: sub interfaces>>=
	elemental module function pmatrix_is_diagonal (pmatrix) result (flag)
	class(pmatrix_t), intent(in) :: pmatrix
	logical :: flag
	end function pmatrix_is_diagonal
	<<Polarizations: procedures>>=
	elemental module function pmatrix_is_diagonal (pmatrix) result (flag)
	class(pmatrix_t), intent(in) :: pmatrix
	logical :: flag
	flag = all (pmatrix%index(1,:) == pmatrix%index(2,:))
	end function pmatrix_is_diagonal

	@ %def pmatrix_is_diagonal
	@
	Check if there are only diagonal entries.
	<<Polarizations: pmatrix: TBP>>=
	procedure :: get_simple_pol => pmatrix_get_simple_pol
	<<Polarizations: sub interfaces>>=
	elemental module function pmatrix_get_simple_pol (pmatrix) result (pol)
	class(pmatrix_t), intent(in) :: pmatrix
	real(default) :: pol
	end function pmatrix_get_simple_pol
	<<Polarizations: procedures>>=
	elemental module function pmatrix_get_simple_pol (pmatrix) result (pol)
	class(pmatrix_t), intent(in) :: pmatrix
	real(default) :: pol
	if (pmatrix%is_polarized ()) then
	select case (size (pmatrix%value))
	case (0)
	pol = 0
	case (1)
	pol = pmatrix%index (1,1) * pmatrix%degree
	case (2)
	pol = 42
	end select
	else
	pol = 0
	end if
	end function pmatrix_get_simple_pol

	@ %def pmatrix_get_simple_pol
	@
	\subsection{Data Transformation}
	Create a [[polarization_t]] object from the contents of a normalized
	[[pmatrix_t]] object. We scan the entries as present in [[pmatrix]] and
	transform them into a density matrix, if necessary. The density
	matrix then initializes the Bloch vector. This is
	analogous to [[polarization_init_state_matrix]].

	There is a subtlety associated with massless particles. Since the
	[[pmatrix]] doesn't contain the full density matrix but just the
	nontrivial part, we have to initialize the polarization object with
	the massless equipartion, which contains nonzero entries for the
	Cartan generators. The [[set]] method therefore should not erase
	those initial contents. This is a constraint for the implementation
	of [[set]], as applied to the Bloch vector.

	As mentioned above, [[pmatrix_t]] does not support an
	antiparticle flag.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_pmatrix => polarization_init_pmatrix
	<<Polarizations: sub interfaces>>=
	module subroutine polarization_init_pmatrix (pol, pmatrix)
	class(polarization_t), intent(out) :: pol
	type(pmatrix_t), intent(in) :: pmatrix
	end subroutine polarization_init_pmatrix
	<<Polarizations: procedures>>=
	module subroutine polarization_init_pmatrix (pol, pmatrix)
	class(polarization_t), intent(out) :: pol
	type(pmatrix_t), intent(in) :: pmatrix
	integer :: d, i, j, k, h1, h2
	complex(default), dimension(:,:), allocatable :: r
	call pol%init_generic ( &
	spin_type = pmatrix%spin_type, &
	multiplicity = pmatrix%multiplicity, &
	anti = .false., & !!! SUFFICIENT?
	left_handed = pmatrix%chirality < 0, &
	right_handed = pmatrix%chirality > 0)
	if (pol%bv%is_polarized ()) then
	d = pol%bv%get_n_states ()
	allocate (r (d, d), source = (0._default, 0._default))
	if (d == pmatrix%multiplicity) then
	do i = 1, d
	r(i,i) = (1 - pmatrix%degree) / d
	end do
	else if (d > pmatrix%multiplicity) then
	r(1,1) = (1 - pmatrix%degree) / 2
	r(d,d) = r(1,1)
	end if
	do k = 1, size (pmatrix%value)
	h1 = pmatrix%index(1,k)
	h2 = pmatrix%index(2,k)
	i = pol%bv%hel_index (h1)
	j = pol%bv%hel_index (h2)
	r(i,j) = r(i,j) + pmatrix%value(k)
	r(j,i) = conjg (r(i,j))
	end do
	call pol%bv%set (r)
	end if
	end subroutine polarization_init_pmatrix

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

	module polarizations_ut
	use unit_tests
	use polarizations_uti

	<<Standard module head>>

	<<Polarizations: public test>>

	contains

	<<Polarizations: test driver>>

	end module polarizations_ut
	@ %def polarizations_ut
	@
	<<[[polarizations_uti.f90]]>>=
	<<File header>>

	module polarizations_uti

	<<Use kinds>>
	use flavors
	use model_data

	use polarizations

	<<Standard module head>>

	<<Polarizations: test declarations>>

	contains

	<<Polarizations: tests>>

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

	@ %def polarizations_test
	@
	\subsubsection{Polarization type}
	Checking the setup for polarization.
	<<Polarizations: execute tests>>=
	call test (polarization_1, "polarization_1", &
	"check polarization setup", &
	u, results)
	<<Polarizations: test declarations>>=
	public :: polarization_1
	<<Polarizations: tests>>=
	subroutine polarization_1 (u)
	use os_interface
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(polarization_t) :: pol
	type(flavor_t) :: flv
	real(default), dimension(3) :: alpha
	real(default) :: r, theta, phi
	real(default), parameter :: tolerance = 1.E-14_default

	write (u, "(A)") "* Test output: polarization_1"
	write (u, "(A)") "* Purpose: test polarization setup"
	write (u, "(A)")

	write (u, "(A)") "* Reading model file"
	write (u, "(A)")

	call model%init_sm_test ()

	write (u, "(A)") "* Unpolarized fermion"
	write (u, "(A)")

	call flv%init (1, model)
	call pol%init_unpolarized (flv)
	call pol%write (u, state_matrix = .true.)
	write (u, "(A,L1)") " diagonal =", pol%is_diagonal ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized fermion"
	write (u, "(A)")

	call pol%init_circular (flv, 0._default)
	call pol%write (u, state_matrix = .true., all_states = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Transversally polarized fermion, phi=0"
	write (u, "(A)")

	call pol%init_transversal (flv, 0._default, 1._default)
	call pol%write (u, state_matrix = .true.)
	write (u, "(A,L1)") " diagonal =", pol%is_diagonal ()

	write (u, "(A)")
	write (u, "(A)") "* Transversally polarized fermion, phi=0.9, frac=0.8"
	write (u, "(A)")

	call pol%init_transversal (flv, 0.9_default, 0.8_default)
	call pol%write (u, state_matrix = .true.)
	write (u, "(A,L1)") " diagonal =", pol%is_diagonal ()

	write (u, "(A)")
	write (u, "(A)") "* All polarization directions of a fermion"
	write (u, "(A)")

	call pol%init_generic (flv)
	call pol%write (u, state_matrix = .true.)


	call flv%init (21, model)

	write (u, "(A)")
	write (u, "(A)") "* Circularly polarized gluon, frac=0.3"
	write (u, "(A)")

	call pol%init_circular (flv, 0.3_default)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)


	call flv%init (23, model)

	write (u, "(A)")
	write (u, "(A)") "* Circularly polarized massive vector, frac=-0.7"
	write (u, "(A)")

	call pol%init_circular (flv, -0.7_default)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(A)") "* Circularly polarized massive vector"
	write (u, "(A)")

	call pol%init_circular (flv, 1._default)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(A)") "* Longitudinally polarized massive vector, frac=0.4"
	write (u, "(A)")

	call pol%init_longitudinal (flv, 0.4_default)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(A)") "* Longitudinally polarized massive vector"
	write (u, "(A)")

	call pol%init_longitudinal (flv, 1._default)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(A)") "* Diagonally polarized massive vector"
	write (u, "(A)")

	call pol%init_diagonal &
	(flv, [2._default, 1._default, 0._default])
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(A)") "* All polarization directions of a massive vector"
	write (u, "(A)")

	call pol%init_generic (flv)
	call pol%write (u, state_matrix = .true.)
	call flv%init (21, model)

	write (u, "(A)")
	write (u, "(A)") "* Axis polarization (0.2, 0.4, 0.6)"
	write (u, "(A)")

	alpha = [0.2_default, 0.4_default, 0.6_default]
	call pol%init_axis (flv, alpha)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(1X,A)") "Recovered axis:"
	alpha = pol%get_axis ()
	write (u, "(3(1X,F10.7))") alpha

	write (u, "(A)")
	write (u, "(A)") "* Angle polarization (0.5, 0.6, -1)"
	r = 0.5_default
	theta = 0.6_default
	phi = -1._default
	call pol%init_angles (flv, r, theta, phi)
	write (u, "(A)")
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(1X,A)") "Recovered parameters (r, theta, phi):"
	call pol%to_angles (r, theta, phi)
	write (u, "(3(1x,F10.7))") r, theta, phi

	call model%final ()

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

	end subroutine polarization_1

	@ %def polarization_1
	@
	\subsubsection{Sparse-Matrix type}
	Use a sparse density matrix universally as the input for setting up
	polarization.
	<<Polarizations: execute tests>>=
	call test (polarization_2, "polarization_2", &
	"matrix polarization setup", &
	u, results)
	<<Polarizations: test declarations>>=
	public :: polarization_2
	<<Polarizations: tests>>=
	subroutine polarization_2 (u)
	use os_interface
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(polarization_t) :: pol
	real(default), dimension(3) :: alpha
	type(pmatrix_t) :: pmatrix
	real(default), parameter :: tolerance = 1e-8_default

	write (u, "(A)") "* Test output: polarization_2"
	write (u, "(A)") "* Purpose: matrix polarization setup"
	write (u, "(A)")

	write (u, "(A)") "* Reading model file"
	write (u, "(A)")

	call model%init_sm_test ()

	write (u, "(A)") "* Unpolarized fermion"
	write (u, "(A)")

	call flv%init (1, model)
	call pmatrix%init (2, 0)
	call pmatrix%normalize (flv, 0._default, tolerance)
	call pmatrix%write (u)
	write (u, *)
	write (u, "(1x,A,L1)") "polarized = ", pmatrix%is_polarized ()
	write (u, "(1x,A,L1)") "diagonal = ", pmatrix%is_diagonal ()
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Transversally polarized fermion, phi=0"
	write (u, "(A)")

	call pmatrix%init (2, 3)
	call pmatrix%set_entry (1, [-1,-1], (1._default, 0._default))
	call pmatrix%set_entry (2, [+1,+1], (1._default, 0._default))
	call pmatrix%set_entry (3, [-1,+1], (1._default, 0._default))
	call pmatrix%normalize (flv, 1._default, tolerance)
	call pmatrix%write (u)
	write (u, *)
	write (u, "(1x,A,L1)") "polarized = ", pmatrix%is_polarized ()
	write (u, "(1x,A,L1)") "diagonal = ", pmatrix%is_diagonal ()
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Transversally polarized fermion, phi=0.9, frac=0.8"
	write (u, "(A)")

	call pmatrix%init (2, 3)
	call pmatrix%set_entry (1, [-1,-1], (1._default, 0._default))
	call pmatrix%set_entry (2, [+1,+1], (1._default, 0._default))
	call pmatrix%set_entry (3, [-1,+1], exp ((0._default, -0.9_default)))
	call pmatrix%normalize (flv, 0.8_default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true.)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Left-handed massive fermion, frac=1"
	write (u, "(A)")

	call flv%init (11, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [-1,-1], (1._default, 0._default))
	call pmatrix%normalize (flv, 1._default, tolerance)
	call pmatrix%write (u)
	write (u, *)
	write (u, "(1x,A,L1)") "polarized = ", pmatrix%is_polarized ()
	write (u, "(1x,A,L1)") "diagonal = ", pmatrix%is_diagonal ()
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Left-handed massive fermion, frac=0.8"
	write (u, "(A)")

	call flv%init (11, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [-1,-1], (1._default, 0._default))
	call pmatrix%normalize (flv, 0.8_default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Left-handed massless fermion"
	write (u, "(A)")

	call flv%init (12, model)
	call pmatrix%init (2, 0)
	call pmatrix%normalize (flv, 1._default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true.)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Right-handed massless fermion, frac=0.5"
	write (u, "(A)")

	call flv%init (-12, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [1,1], (1._default, 0._default))
	call pmatrix%normalize (flv, 0.5_default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true.)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Circularly polarized gluon, frac=0.3"
	write (u, "(A)")

	call flv%init (21, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [1,1], (1._default, 0._default))
	call pmatrix%normalize (flv, 0.3_default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Circularly polarized massive vector, frac=0.7"
	write (u, "(A)")

	call flv%init (23, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [1,1], (1._default, 0._default))
	call pmatrix%normalize (flv, 0.7_default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Circularly polarized massive vector"
	write (u, "(A)")

	call flv%init (23, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [1,1], (1._default, 0._default))
	call pmatrix%normalize (flv, 1._default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Longitudinally polarized massive vector, frac=0.4"
	write (u, "(A)")

	call flv%init (23, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [0,0], (1._default, 0._default))
	call pmatrix%normalize (flv, 0.4_default, tolerance)
	call pmatrix%write (u)
	write (u, *)
	write (u, "(1x,A,L1)") "polarized = ", pmatrix%is_polarized ()
	write (u, "(1x,A,L1)") "diagonal = ", pmatrix%is_diagonal ()
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Longitudinally polarized massive vector"
	write (u, "(A)")

	call flv%init (23, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [0,0], (1._default, 0._default))
	call pmatrix%normalize (flv, 1._default, tolerance)
	call pmatrix%write (u)
	write (u, *)
	write (u, "(1x,A,L1)") "polarized = ", pmatrix%is_polarized ()
	write (u, "(1x,A,L1)") "diagonal = ", pmatrix%is_diagonal ()
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Axis polarization (0.2, 0.4, 0.6)"
	write (u, "(A)")

	call flv%init (11, model)
	alpha = [0.2_default, 0.4_default, 0.6_default]
	alpha = alpha / sqrt (sum (alpha**2))
	call pmatrix%init (2, 3)
	call pmatrix%set_entry (1, [-1,-1], cmplx (1 - alpha(3), kind=default))
	call pmatrix%set_entry (2, [1,-1], &
	cmplx (alpha(1),-alpha(2), kind=default))
	call pmatrix%set_entry (3, [1,1], cmplx (1 + alpha(3), kind=default))
	call pmatrix%normalize (flv, 1._default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true.)
	! call pol%final ()

	call model%final ()

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

	end subroutine polarization_2

	@ %def polarization_2
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Particles}
	This module defines the [[particle_t]] object type, and the methods
	and operations that deal with it.
	<<[[particles.f90]]>>=
	<<File header>>

	module particles

	<<Use kinds with double>>
	<<Use strings>>
	<<Use debug>>
	use lorentz
	use phs_points, only: phs_point_t, assignment(=)
	use model_data
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use state_matrices
	use interactions
	use subevents
	use polarizations

	<<Standard module head>>

	<<Particles: public>>

	<<Particles: parameters>>

	<<Particles: types>>

	<<Particles: interfaces>>

	interface
	<<Particles: sub interfaces>>
	end interface

	end module particles
	@ %def particles
	@
	<<[[particles_sub.f90]]>>=
	<<File header>>

	submodule (particles) particles_s

	use io_units
	use format_utils, only: write_compressed_integer_array, write_separator
	use format_utils, only: pac_fmt
	use format_defs, only: FMT_16, FMT_19
	use numeric_utils
	use diagnostics
	use pdg_arrays, only: is_quark, is_gluon

	implicit none

	contains

	<<Particles: procedures>>

	end submodule particles_s

	@ %def particles_s
	@
	\subsection{The particle type}
	\subsubsection{Particle status codes}
	The overall status codes (incoming/outgoing etc.) are inherited from
	the module [[subevents]].

	Polarization status:
	<<Particles: parameters>>=
	integer, parameter, public :: PRT_UNPOLARIZED = 0
	integer, parameter, public :: PRT_DEFINITE_HELICITY = 1
	integer, parameter, public :: PRT_GENERIC_POLARIZATION = 2

	@ %def PRT_UNPOLARIZED PRT_DEFINITE_HELICITY PRT_GENERIC_POLARIZATION
	@
	\subsubsection{Definition}
	The quantum numbers are flavor (from which invariant particle
	properties can be derived), color, and polarization. The particle may
	be unpolarized. In this case, [[hel]] and [[pol]] are unspecified.
	If it has a definite helicity, the [[hel]] component is defined. If
	it has a generic polarization, the [[pol]] component is defined. For
	each particle we store the four-momentum and the invariant mass
	squared, i.e., the squared norm of the four-momentum. There is also
	an optional list of parent and child particles, for bookkeeping in
	physical events. The [[vertex]] is an optional component that consists of
	a Lorentz 4-vector, denoting the position and time of the vertex
	(displaced vertex/time). [[lifetime]] is an optional component that
	accounts for the finite lifetime $\tau$ of a decaying particle. In
	case there is no magnetic field etc., the true decay vertex of a
	particle in the detector would be $\vec{v}^\prime = \vec{v} + \tau
	\times \vec{p}/p^0$, where $p^0$ and $\vec{p}$ are the energy and
	3-momentum of the particle.

	<<Particles: public>>=
	public :: particle_t
	<<Particles: types>>=
	type :: particle_t
	!private
	integer :: status = PRT_UNDEFINED
	integer :: polarization = PRT_UNPOLARIZED
	type(flavor_t) :: flv
	type(color_t) :: col
	type(helicity_t) :: hel
	type(polarization_t) :: pol
	type(vector4_t) :: p = vector4_null
	real(default) :: p2 = 0
	type(vector4_t), allocatable :: vertex
	real(default), allocatable :: lifetime
	integer, dimension(:), allocatable :: parent
	integer, dimension(:), allocatable :: child
	contains
	<<Particles: particle: TBP>>
	end type particle_t

	@ %def particle_t
	@ Copy a particle. (Deep copy) This excludes the parent-child
	relations.
	<<Particles: particle: TBP>>=
	generic :: init => init_particle
	procedure :: init_particle => particle_init_particle
	<<Particles: sub interfaces>>=
	module subroutine particle_init_particle (prt_out, prt_in)
	class(particle_t), intent(out) :: prt_out
	type(particle_t), intent(in) :: prt_in
	end subroutine particle_init_particle
	<<Particles: procedures>>=
	module subroutine particle_init_particle (prt_out, prt_in)
	class(particle_t), intent(out) :: prt_out
	type(particle_t), intent(in) :: prt_in
	prt_out%status = prt_in%status
	prt_out%polarization = prt_in%polarization
	prt_out%flv = prt_in%flv
	prt_out%col = prt_in%col
	prt_out%hel = prt_in%hel
	prt_out%pol = prt_in%pol
	prt_out%p = prt_in%p
	prt_out%p2 = prt_in%p2
	if (allocated (prt_in%vertex)) &
	allocate (prt_out%vertex, source=prt_in%vertex)
	if (allocated (prt_in%lifetime)) &
	allocate (prt_out%lifetime, source=prt_in%lifetime)
	end subroutine particle_init_particle

	@ %def particle_init_particle
	@ Initialize a particle using external information.
	<<Particles: particle: TBP>>=
	generic :: init => init_external
	procedure :: init_external => particle_init_external
	<<Particles: sub interfaces>>=
	module subroutine particle_init_external &
	(particle, status, pdg, model, col, anti_col, mom)
	class(particle_t), intent(out) :: particle
	integer, intent(in) :: status, pdg, col, anti_col
	class(model_data_t), pointer, intent(in) :: model
	type(vector4_t), intent(in) :: mom
	end subroutine particle_init_external
	<<Particles: procedures>>=
	module subroutine particle_init_external &
	(particle, status, pdg, model, col, anti_col, mom)
	class(particle_t), intent(out) :: particle
	integer, intent(in) :: status, pdg, col, anti_col
	class(model_data_t), pointer, intent(in) :: model
	type(vector4_t), intent(in) :: mom
	type(flavor_t) :: flavor
	type(color_t) :: color
	call flavor%init (pdg, model)
	call particle%set_flavor (flavor)
	call color%init_col_acl (col, anti_col)
	call particle%set_color (color)
	call particle%set_status (status)
	call particle%set_momentum (mom)
	end subroutine particle_init_external

	@ %def particle_init_external
	@ Initialize a particle using a single-particle state matrix which
	determines flavor, color, and polarization. The state matrix must
	have unique flavor and color. The factorization mode determines
	whether the particle is unpolarized, has definite helicity, or generic
	polarization. This mode is translated into the polarization status.
	<<Particles: particle: TBP>>=
	generic :: init => init_state
	procedure :: init_state => particle_init_state
	<<Particles: sub interfaces>>=
	module subroutine particle_init_state (prt, state, status, mode)
	class(particle_t), intent(out) :: prt
	type(state_matrix_t), intent(in), target :: state
	integer, intent(in) :: status, mode
	end subroutine particle_init_state
	<<Particles: procedures>>=
	module subroutine particle_init_state (prt, state, status, mode)
	class(particle_t), intent(out) :: prt
	type(state_matrix_t), intent(in), target :: state
	integer, intent(in) :: status, mode
	type(state_iterator_t) :: it
	prt%status = status
	call it%init (state)
	prt%flv = it%get_flavor (1)
	if (prt%flv%is_radiated ()) prt%status = PRT_BEAM_REMNANT
	prt%col = it%get_color (1)
	select case (mode)
	case (FM_SELECT_HELICITY)
	prt%hel = it%get_helicity (1)
	if (prt%hel%is_defined ()) then
	prt%polarization = PRT_DEFINITE_HELICITY
	end if
	case (FM_FACTOR_HELICITY)
	call prt%pol%init_state_matrix (state)
	prt%polarization = PRT_GENERIC_POLARIZATION
	end select
	end subroutine particle_init_state

	@ %def particle_init_state
	@ Finalizer.
	<<Particles: particle: TBP>>=
	procedure :: final => particle_final
	<<Particles: sub interfaces>>=
	module subroutine particle_final (prt)
	class(particle_t), intent(inout) :: prt
	end subroutine particle_final
	<<Particles: procedures>>=
	module subroutine particle_final (prt)
	class(particle_t), intent(inout) :: prt
	if (allocated (prt%vertex)) deallocate (prt%vertex)
	if (allocated (prt%lifetime)) deallocate (prt%lifetime)
	end subroutine particle_final

	@ %def particle_final
	@
	\subsubsection{I/O}
	<<Particles: particle: TBP>>=
	procedure :: write => particle_write
	<<Particles: sub interfaces>>=
	module subroutine particle_write (prt, unit, testflag, compressed, polarization)
	class(particle_t), intent(in) :: prt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag, compressed, polarization
	end subroutine particle_write
	<<Particles: procedures>>=
	module subroutine particle_write (prt, unit, testflag, compressed, polarization)
	class(particle_t), intent(in) :: prt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag, compressed, polarization
	logical :: comp, pacified, pol
	integer :: u, h1, h2
	real(default) :: pp2
	character(len=7) :: fmt
	character(len=20) :: buffer
	comp = .false.; if (present (compressed)) comp = compressed
	pacified = .false.; if (present (testflag)) pacified = testflag
	pol = .true.; if (present (polarization)) pol = polarization
	call pac_fmt (fmt, FMT_19, FMT_16, testflag)
	u = given_output_unit (unit); if (u < 0) return
	pp2 = prt%p2
	if (pacified) call pacify (pp2, tolerance = 1E-10_default)
	select case (prt%status)
	case (PRT_UNDEFINED); write (u, "(1x, A)", advance="no") "[-]"
	case (PRT_BEAM); write (u, "(1x, A)", advance="no") "[b]"
	case (PRT_INCOMING); write (u, "(1x, A)", advance="no") "[i]"
	case (PRT_OUTGOING); write (u, "(1x, A)", advance="no") "[o]"
	case (PRT_VIRTUAL); write (u, "(1x, A)", advance="no") "[v]"
	case (PRT_RESONANT); write (u, "(1x, A)", advance="no") "[r]"
	case (PRT_BEAM_REMNANT); write (u, "(1x, A)", advance="no") "[x]"
	end select
	write (u, "(1x)", advance="no")
	if (comp) then
	write (u, "(A7,1X)", advance="no") char (prt%flv%get_name ())
	if (pol) then
	select case (prt%polarization)
	case (PRT_DEFINITE_HELICITY)
	! Integer helicity, assumed diagonal
	call prt%hel%get_indices (h1, h2)
	write (u, "(I2,1X)", advance="no") h1
	case (PRT_GENERIC_POLARIZATION)
	! No space for full density matrix here
	write (u, "(A2,1X)", advance="no") "*"
	case default
	! Blank entry if helicity is undefined
	write (u, "(A2,1X)", advance="no") " "
	end select
	end if
	write (u, "(2(I4,1X))", advance="no") &
	prt%col%get_col (), prt%col%get_acl ()
	call write_compressed_integer_array (buffer, prt%parent)
	write (u, "(A,1X)", advance="no") buffer
	call write_compressed_integer_array (buffer, prt%child)
	write (u, "(A,1X)", advance="no") buffer
	call prt%p%write(u, testflag = testflag, compressed = comp)
	write (u, "(F12.3)") pp2
	else
	call prt%flv%write (unit)
	if (prt%col%is_nonzero ()) then
	call color_write (prt%col, unit)
	end if
	if (pol) then
	select case (prt%polarization)
	case (PRT_DEFINITE_HELICITY)
	call prt%hel%write (unit)
	write (u, *)
	case (PRT_GENERIC_POLARIZATION)
	write (u, *)
	call prt%pol%write (unit, state_matrix = .true.)
	case default
	write (u, *)
	end select
	else
	write (u, *)
	end if
	call prt%p%write (unit, testflag = testflag)
	write (u, "(1x,A,1x," // fmt // ")") "T = ", pp2
	if (allocated (prt%parent)) then
	if (size (prt%parent) /= 0) then
	write (u, "(1x,A,40(1x,I0))") "Parents: ", prt%parent
	end if
	end if
	if (allocated (prt%child)) then
	if (size (prt%child) /= 0) then
	write (u, "(1x,A,40(1x,I0))") "Children:", prt%child
	end if
	end if
	if (allocated (prt%vertex)) then
	write (u, "(1x,A,1x," // fmt // ")") "Vtx t = ", prt%vertex%p(0)
	write (u, "(1x,A,1x," // fmt // ")") "Vtx x = ", prt%vertex%p(1)
	write (u, "(1x,A,1x," // fmt // ")") "Vtx y = ", prt%vertex%p(2)
	write (u, "(1x,A,1x," // fmt // ")") "Vtx z = ", prt%vertex%p(3)
	end if
	if (allocated (prt%lifetime)) then
	write (u, "(1x,A,1x," // fmt // ")") "Lifetime = ", &
	prt%lifetime
	end if
	end if
	end subroutine particle_write

	@ %def particle_write
	@ Binary I/O:
	<<Particles: particle: TBP>>=
	procedure :: write_raw => particle_write_raw
	procedure :: read_raw => particle_read_raw
	<<Particles: sub interfaces>>=
	module subroutine particle_write_raw (prt, u)
	class(particle_t), intent(in) :: prt
	integer, intent(in) :: u
	end subroutine particle_write_raw
	module subroutine particle_read_raw (prt, u, iostat)
	class(particle_t), intent(out) :: prt
	integer, intent(in) :: u
	integer, intent(out) :: iostat
	end subroutine particle_read_raw
	<<Particles: procedures>>=
	module subroutine particle_write_raw (prt, u)
	class(particle_t), intent(in) :: prt
	integer, intent(in) :: u
	write (u) prt%status, prt%polarization
	call prt%flv%write_raw (u)
	call prt%col%write_raw (u)
	select case (prt%polarization)
	case (PRT_DEFINITE_HELICITY)
	call prt%hel%write_raw (u)
	case (PRT_GENERIC_POLARIZATION)
	call prt%pol%write_raw (u)
	end select
	call vector4_write_raw (prt%p, u)
	write (u) prt%p2
	write (u) allocated (prt%parent)
	if (allocated (prt%parent)) then
	write (u) size (prt%parent)
	write (u) prt%parent
	end if
	write (u) allocated (prt%child)
	if (allocated (prt%child)) then
	write (u) size (prt%child)
	write (u) prt%child
	end if
	write (u) allocated (prt%vertex)
	if (allocated (prt%vertex)) then
	call vector4_write_raw (prt%vertex, u)
	end if
	write (u) allocated (prt%lifetime)
	if (allocated (prt%lifetime)) then
	write (u) prt%lifetime
	end if
	end subroutine particle_write_raw

	module subroutine particle_read_raw (prt, u, iostat)
	class(particle_t), intent(out) :: prt
	integer, intent(in) :: u
	integer, intent(out) :: iostat
	logical :: allocated_parent, allocated_child
	logical :: allocated_vertex, allocated_lifetime
	integer :: size_parent, size_child
	read (u, iostat=iostat) prt%status, prt%polarization
	call prt%flv%read_raw (u, iostat=iostat)
	call prt%col%read_raw (u, iostat=iostat)
	select case (prt%polarization)
	case (PRT_DEFINITE_HELICITY)
	call prt%hel%read_raw (u, iostat=iostat)
	case (PRT_GENERIC_POLARIZATION)
	call prt%pol%read_raw (u, iostat=iostat)
	end select
	call vector4_read_raw (prt%p, u, iostat=iostat)
	read (u, iostat=iostat) prt%p2
	read (u, iostat=iostat) allocated_parent
	if (allocated_parent) then
	read (u, iostat=iostat) size_parent
	allocate (prt%parent (size_parent))
	read (u, iostat=iostat) prt%parent
	end if
	read (u, iostat=iostat) allocated_child
	if (allocated_child) then
	read (u, iostat=iostat) size_child
	allocate (prt%child (size_child))
	read (u, iostat=iostat) prt%child
	end if
	read (u, iostat=iostat) allocated_vertex
	if (allocated_vertex) then
	allocate (prt%vertex)
	read (u, iostat=iostat) prt%vertex%p
	end if
	read (u, iostat=iostat) allocated_lifetime
	if (allocated_lifetime) then
	allocate (prt%lifetime)
	read (u, iostat=iostat) prt%lifetime
	end if
	end subroutine particle_read_raw

	@ %def particle_write_raw particle_read_raw
	@
	\subsubsection{Setting contents}
	Reset the status code. Where applicable, set $p^2$ assuming that the
	particle is on-shell.
	<<Particles: particle: TBP>>=
	procedure :: reset_status => particle_reset_status
	<<Particles: sub interfaces>>=
	elemental module subroutine particle_reset_status (prt, status)
	class(particle_t), intent(inout) :: prt
	integer, intent(in) :: status
	end subroutine particle_reset_status
	<<Particles: procedures>>=
	elemental module subroutine particle_reset_status (prt, status)
	class(particle_t), intent(inout) :: prt
	integer, intent(in) :: status
	prt%status = status
	select case (status)
	case (PRT_BEAM, PRT_INCOMING, PRT_OUTGOING)
	prt%p2 = prt%flv%get_mass () ** 2
	end select
	end subroutine particle_reset_status

	@ %def particle_reset_status
	@ The color can be given explicitly.
	<<Particles: particle: TBP>>=
	procedure :: set_color => particle_set_color
	<<Particles: sub interfaces>>=
	elemental module subroutine particle_set_color (prt, col)
	class(particle_t), intent(inout) :: prt
	type(color_t), intent(in) :: col
	end subroutine particle_set_color
	<<Particles: procedures>>=
	elemental module subroutine particle_set_color (prt, col)
	class(particle_t), intent(inout) :: prt
	type(color_t), intent(in) :: col
	prt%col = col
	end subroutine particle_set_color

	@ %def particle_set_color
	@ The flavor can be given explicitly.
	<<Particles: particle: TBP>>=
	procedure :: set_flavor => particle_set_flavor
	<<Particles: sub interfaces>>=
	module subroutine particle_set_flavor (prt, flv)
	class(particle_t), intent(inout) :: prt
	type(flavor_t), intent(in) :: flv
	end subroutine particle_set_flavor
	<<Particles: procedures>>=
	module subroutine particle_set_flavor (prt, flv)
	class(particle_t), intent(inout) :: prt
	type(flavor_t), intent(in) :: flv
	prt%flv = flv
	end subroutine particle_set_flavor

	@ %def particle_set_flavor
	@ As can the helicity.
	<<Particles: particle: TBP>>=
	procedure :: set_helicity => particle_set_helicity
	<<Particles: sub interfaces>>=
	module subroutine particle_set_helicity (prt, hel)
	class(particle_t), intent(inout) :: prt
	type(helicity_t), intent(in) :: hel
	end subroutine particle_set_helicity
	<<Particles: procedures>>=
	module subroutine particle_set_helicity (prt, hel)
	class(particle_t), intent(inout) :: prt
	type(helicity_t), intent(in) :: hel
	prt%hel = hel
	end subroutine particle_set_helicity

	@ %def particle_set_helicity
	@ And the polarization.
	<<Particles: particle: TBP>>=
	procedure :: set_pol => particle_set_pol
	<<Particles: sub interfaces>>=
	module subroutine particle_set_pol (prt, pol)
	class(particle_t), intent(inout) :: prt
	type(polarization_t), intent(in) :: pol
	end subroutine particle_set_pol
	<<Particles: procedures>>=
	module subroutine particle_set_pol (prt, pol)
	class(particle_t), intent(inout) :: prt
	type(polarization_t), intent(in) :: pol
	prt%pol = pol
	end subroutine particle_set_pol

	@ %def particle_set_pol
	@ Manually set the model for the particle flavor. This is required, e.g., if
	the particle has been read from file.
	<<Particles: particle: TBP>>=
	procedure :: set_model => particle_set_model
	<<Particles: sub interfaces>>=
	module subroutine particle_set_model (prt, model)
	class(particle_t), intent(inout) :: prt
	class(model_data_t), intent(in), target :: model
	end subroutine particle_set_model
	<<Particles: procedures>>=
	module subroutine particle_set_model (prt, model)
	class(particle_t), intent(inout) :: prt
	class(model_data_t), intent(in), target :: model
	call prt%flv%set_model (model)
	end subroutine particle_set_model

	@ %def particle_set_model
	@ The momentum is set independent of the quantum numbers.
	<<Particles: particle: TBP>>=
	procedure :: set_momentum => particle_set_momentum
	<<Particles: sub interfaces>>=
	elemental module subroutine particle_set_momentum (prt, p, p2, on_shell)
	class(particle_t), intent(inout) :: prt
	type(vector4_t), intent(in) :: p
	real(default), intent(in), optional :: p2
	logical, intent(in), optional :: on_shell
	end subroutine particle_set_momentum
	<<Particles: procedures>>=
	elemental module subroutine particle_set_momentum (prt, p, p2, on_shell)
	class(particle_t), intent(inout) :: prt
	type(vector4_t), intent(in) :: p
	real(default), intent(in), optional :: p2
	logical, intent(in), optional :: on_shell
	prt%p = p
	if (present (on_shell)) then
	if (on_shell) then
	if (prt%flv%is_associated ()) then
	prt%p2 = prt%flv%get_mass () ** 2
	return
	end if
	end if
	end if
	if (present (p2)) then
	prt%p2 = p2
	else
	prt%p2 = p ** 2
	end if
	end subroutine particle_set_momentum

	@ %def particle_set_momentum
	@ Set resonance information. This should be done after momentum
	assignment, because we need to know wheter the particle is spacelike
	or timelike. The resonance flag is defined only for virtual
	particles.
	<<Particle: particle: TBP>>=
	procedure :: set_resonance_flag => particle_set_resonance_flag
	<<Particles: procedures>>=
	elemental subroutine particle_set_resonance_flag (prt, resonant)
	class(particle_t), intent(inout) :: prt
	logical, intent(in) :: resonant
	select case (prt%status)
	case (PRT_VIRTUAL)
	if (resonant) prt%status = PRT_RESONANT
	end select
	end subroutine particle_set_resonance_flag

	@ %def particle_set_resonance_flag
	@ Set children and parents information.
	<<Particles: particle: TBP>>=
	procedure :: set_children => particle_set_children
	procedure :: set_parents => particle_set_parents
	<<Particles: sub interfaces>>=
	module subroutine particle_set_children (prt, idx)
	class(particle_t), intent(inout) :: prt
	integer, dimension(:), intent(in) :: idx
	end subroutine particle_set_children
	module subroutine particle_set_parents (prt, idx)
	class(particle_t), intent(inout) :: prt
	integer, dimension(:), intent(in) :: idx
	end subroutine particle_set_parents
	<<Particles: procedures>>=
	module subroutine particle_set_children (prt, idx)
	class(particle_t), intent(inout) :: prt
	integer, dimension(:), intent(in) :: idx
	if (allocated (prt%child)) deallocate (prt%child)
	allocate (prt%child (count (idx /= 0)))
	prt%child = pack (idx, idx /= 0)
	end subroutine particle_set_children

	module subroutine particle_set_parents (prt, idx)
	class(particle_t), intent(inout) :: prt
	integer, dimension(:), intent(in) :: idx
	if (allocated (prt%parent)) deallocate (prt%parent)
	allocate (prt%parent (count (idx /= 0)))
	prt%parent = pack (idx, idx /= 0)
	end subroutine particle_set_parents

	@ %def particle_set_children particle_set_parents
	@
	<<Particles: particle: TBP>>=
	procedure :: add_child => particle_add_child
	<<Particles: sub interfaces>>=
	module subroutine particle_add_child (prt, new_child)
	class(particle_t), intent(inout) :: prt
	integer, intent(in) :: new_child
	end subroutine particle_add_child
	<<Particles: procedures>>=
	module subroutine particle_add_child (prt, new_child)
	class(particle_t), intent(inout) :: prt
	integer, intent(in) :: new_child
	integer, dimension(:), allocatable :: idx
	integer :: n, i
	n = prt%get_n_children()
	if (n == 0) then
	call prt%set_children ([new_child])
	else
	do i = 1, n
	if (prt%child(i) == new_child) then
	return
	end if
	end do
	allocate (idx (1:n+1))
	idx(1:n) = prt%get_children ()
	idx(n+1) = new_child
	call prt%set_children (idx)
	end if
	end subroutine particle_add_child

	@ %def particle_add_child
	@
	<<Particles: particle: TBP>>=
	procedure :: add_children => particle_add_children
	<<Particles: sub interfaces>>=
	module subroutine particle_add_children (prt, new_child)
	class(particle_t), intent(inout) :: prt
	integer, dimension(:), intent(in) :: new_child
	end subroutine particle_add_children
	<<Particles: procedures>>=
	module subroutine particle_add_children (prt, new_child)
	class(particle_t), intent(inout) :: prt
	integer, dimension(:), intent(in) :: new_child
	integer, dimension(:), allocatable :: idx
	integer :: n
	n = prt%get_n_children()
	if (n == 0) then
	call prt%set_children (new_child)
	else
	allocate (idx (1:n+size(new_child)))
	idx(1:n) = prt%get_children ()
	idx(n+1:n+size(new_child)) = new_child
	call prt%set_children (idx)
	end if
	end subroutine particle_add_children

	@ %def particle_add_children
	@
	<<Particles: particle: TBP>>=
	procedure :: set_status => particle_set_status
	<<Particles: sub interfaces>>=
	elemental module subroutine particle_set_status (prt, status)
	class(particle_t), intent(inout) :: prt
	integer, intent(in) :: status
	end subroutine particle_set_status
	<<Particles: procedures>>=
	elemental module subroutine particle_set_status (prt, status)
	class(particle_t), intent(inout) :: prt
	integer, intent(in) :: status
	prt%status = status
	end subroutine particle_set_status

	@ %def particle_set_status
	@
	<<Particles: particle: TBP>>=
	procedure :: set_polarization => particle_set_polarization
	<<Particles: sub interfaces>>=
	module subroutine particle_set_polarization (prt, polarization)
	class(particle_t), intent(inout) :: prt
	integer, intent(in) :: polarization
	end subroutine particle_set_polarization
	<<Particles: procedures>>=
	module subroutine particle_set_polarization (prt, polarization)
	class(particle_t), intent(inout) :: prt
	integer, intent(in) :: polarization
	prt%polarization = polarization
	end subroutine particle_set_polarization

	@ %def particle_set_polarization
	@
	<<Particles: particle: TBP>>=
	generic :: set_vertex => set_vertex_from_vector3, set_vertex_from_xyz, &
	set_vertex_from_vector4, set_vertex_from_xyzt
	procedure :: set_vertex_from_vector4 => particle_set_vertex_from_vector4
	procedure :: set_vertex_from_vector3 => particle_set_vertex_from_vector3
	procedure :: set_vertex_from_xyzt => particle_set_vertex_from_xyzt
	procedure :: set_vertex_from_xyz => particle_set_vertex_from_xyz
	<<Particles: sub interfaces>>=
	module subroutine particle_set_vertex_from_vector4 (prt, vertex)
	class(particle_t), intent(inout) :: prt
	type(vector4_t), intent(in) :: vertex
	end subroutine particle_set_vertex_from_vector4
	module subroutine particle_set_vertex_from_vector3 (prt, vertex)
	class(particle_t), intent(inout) :: prt
	type(vector3_t), intent(in) :: vertex
	end subroutine particle_set_vertex_from_vector3
	module subroutine particle_set_vertex_from_xyzt (prt, vx, vy, vz, t)
	class(particle_t), intent(inout) :: prt
	real(default), intent(in) :: vx, vy, vz, t
	end subroutine particle_set_vertex_from_xyzt
	module subroutine particle_set_vertex_from_xyz (prt, vx, vy, vz)
	class(particle_t), intent(inout) :: prt
	real(default), intent(in) :: vx, vy, vz
	end subroutine particle_set_vertex_from_xyz
	<<Particles: procedures>>=
	module subroutine particle_set_vertex_from_vector4 (prt, vertex)
	class(particle_t), intent(inout) :: prt
	type(vector4_t), intent(in) :: vertex
	if (allocated (prt%vertex)) deallocate (prt%vertex)
	allocate (prt%vertex, source=vertex)
	end subroutine particle_set_vertex_from_vector4

	module subroutine particle_set_vertex_from_vector3 (prt, vertex)
	class(particle_t), intent(inout) :: prt
	type(vector3_t), intent(in) :: vertex
	type(vector4_t) :: vtx
	vtx = vector4_moving (0._default, vertex)
	if (allocated (prt%vertex)) deallocate (prt%vertex)
	allocate (prt%vertex, source=vtx)
	end subroutine particle_set_vertex_from_vector3

	module subroutine particle_set_vertex_from_xyzt (prt, vx, vy, vz, t)
	class(particle_t), intent(inout) :: prt
	real(default), intent(in) :: vx, vy, vz, t
	type(vector4_t) :: vertex
	if (allocated (prt%vertex)) deallocate (prt%vertex)
	vertex = vector4_moving (t, vector3_moving ([vx, vy, vz]))
	allocate (prt%vertex, source=vertex)
	end subroutine particle_set_vertex_from_xyzt

	module subroutine particle_set_vertex_from_xyz (prt, vx, vy, vz)
	class(particle_t), intent(inout) :: prt
	real(default), intent(in) :: vx, vy, vz
	type(vector4_t) :: vertex
	if (allocated (prt%vertex)) deallocate (prt%vertex)
	vertex = vector4_moving (0._default, vector3_moving ([vx, vy, vz]))
	allocate (prt%vertex, source=vertex)
	end subroutine particle_set_vertex_from_xyz

	@ %def particle_set_vertex_from_vector3
	@ %def particle_set_vertex_from_vector4
	@ %def particle_set_vertex_from_xyz
	@ %def particle_set_vertex_from_xyzt
	@ Set the lifetime of a particle.
	<<Particles: particle: TBP>>=
	procedure :: set_lifetime => particle_set_lifetime
	<<Particles: sub interfaces>>=
	elemental module subroutine particle_set_lifetime (prt, lifetime)
	class(particle_t), intent(inout) :: prt
	real(default), intent(in) :: lifetime
	end subroutine particle_set_lifetime
	<<Particles: procedures>>=
	elemental module subroutine particle_set_lifetime (prt, lifetime)
	class(particle_t), intent(inout) :: prt
	real(default), intent(in) :: lifetime
	if (allocated (prt%lifetime)) deallocate (prt%lifetime)
	allocate (prt%lifetime, source=lifetime)
	end subroutine particle_set_lifetime

	@ %def particle_set_lifetime
	@
	\subsubsection{Accessing contents}
	The status code.
	<<Particles: particle: TBP>>=
	procedure :: get_status => particle_get_status
	<<Particles: sub interfaces>>=
	elemental module function particle_get_status (prt) result (status)
	integer :: status
	class(particle_t), intent(in) :: prt
	end function particle_get_status
	<<Particles: procedures>>=
	elemental module function particle_get_status (prt) result (status)
	integer :: status
	class(particle_t), intent(in) :: prt
	status = prt%status
	end function particle_get_status

	@ %def particle_get_status
	@ Return true if the status is either [[INCOMING]],
	[[OUTGOING]] or [[RESONANT]]. [[BEAM]] is kept, if
	[[keep_beams]] is set true.
	<<Particles: particle: TBP>>=
	procedure :: is_real => particle_is_real
	<<Particles: sub interfaces>>=
	elemental module function particle_is_real (prt, keep_beams) result (flag)
	logical :: flag, kb
	class(particle_t), intent(in) :: prt
	logical, intent(in), optional :: keep_beams
	end function particle_is_real
	<<Particles: procedures>>=
	elemental module function particle_is_real (prt, keep_beams) result (flag)
	logical :: flag, kb
	class(particle_t), intent(in) :: prt
	logical, intent(in), optional :: keep_beams
	kb = .false.
	if (present (keep_beams)) kb = keep_beams
	select case (prt%status)
	case (PRT_INCOMING, PRT_OUTGOING, PRT_RESONANT)
	flag = .true.
	case (PRT_BEAM)
	flag = kb
	case default
	flag = .false.
	end select
	end function particle_is_real

	@ %def particle_is_real
	@
	<<Particles: particle: TBP>>=
	procedure :: is_colored => particle_is_colored
	<<Particles: sub interfaces>>=
	elemental module function particle_is_colored (particle) result (flag)
	logical :: flag
	class(particle_t), intent(in) :: particle
	end function particle_is_colored
	<<Particles: procedures>>=
	elemental module function particle_is_colored (particle) result (flag)
	logical :: flag
	class(particle_t), intent(in) :: particle
	flag = particle%col%is_nonzero ()
	end function particle_is_colored

	@ %def particle_is_colored
	@ $[90,100]$ hopefully catches all of them and not too many.
	<<Particles: particle: TBP>>=
	procedure :: is_hadronic_beam_remnant => particle_is_hadronic_beam_remnant
	<<Particles: sub interfaces>>=
	elemental module function particle_is_hadronic_beam_remnant (particle) result (flag)
	class(particle_t), intent(in) :: particle
	logical :: flag
	end function particle_is_hadronic_beam_remnant
	<<Particles: procedures>>=
	elemental module function particle_is_hadronic_beam_remnant (particle) result (flag)
	class(particle_t), intent(in) :: particle
	logical :: flag
	integer :: pdg
	pdg = particle%flv%get_pdg ()
	flag = particle%status == PRT_BEAM_REMNANT .and. &
	abs(pdg) >= 90 .and. abs(pdg) <= 100
	end function particle_is_hadronic_beam_remnant

	@ %def particle_is_hadronic_beam_remnant
	@
	<<Particles: particle: TBP>>=
	procedure :: is_beam_remnant => particle_is_beam_remnant
	<<Particles: sub interfaces>>=
	elemental module function particle_is_beam_remnant (particle) result (flag)
	class(particle_t), intent(in) :: particle
	logical :: flag
	end function particle_is_beam_remnant
	<<Particles: procedures>>=
	elemental module function particle_is_beam_remnant (particle) result (flag)
	class(particle_t), intent(in) :: particle
	logical :: flag
	flag = particle%status == PRT_BEAM_REMNANT
	end function particle_is_beam_remnant

	@ %def particle_is_beam_remnant
	@ Polarization status.
	<<Particles: particle: TBP>>=
	procedure :: get_polarization_status => particle_get_polarization_status
	<<Particles: sub interfaces>>=
	elemental module function particle_get_polarization_status (prt) result (status)
	integer :: status
	class(particle_t), intent(in) :: prt
	end function particle_get_polarization_status
	<<Particles: procedures>>=
	elemental module function particle_get_polarization_status (prt) result (status)
	integer :: status
	class(particle_t), intent(in) :: prt
	status = prt%polarization
	end function particle_get_polarization_status

	@ %def particle_get_polarization_status
	@ Return the PDG code from the flavor component directly.
	<<Particles: particle: TBP>>=
	procedure :: get_pdg => particle_get_pdg
	<<Particles: sub interfaces>>=
	elemental module function particle_get_pdg (prt) result (pdg)
	integer :: pdg
	class(particle_t), intent(in) :: prt
	end function particle_get_pdg
	<<Particles: procedures>>=
	elemental module function particle_get_pdg (prt) result (pdg)
	integer :: pdg
	class(particle_t), intent(in) :: prt
	pdg = prt%flv%get_pdg ()
	end function particle_get_pdg

	@ %def particle_get_pdg
	@ Return the color and anticolor quantum numbers.
	<<Particles: particle: TBP>>=
	procedure :: get_color => particle_get_color
	<<Particles: sub interfaces>>=
	pure module function particle_get_color (prt) result (col)
	integer, dimension(2) :: col
	class(particle_t), intent(in) :: prt
	end function particle_get_color
	<<Particles: procedures>>=
	pure module function particle_get_color (prt) result (col)
	integer, dimension(2) :: col
	class(particle_t), intent(in) :: prt
	col(1) = prt%col%get_col ()
	col(2) = prt%col%get_acl ()
	end function particle_get_color

	@ %def particle_get_color
	@ Return a copy of the polarization density matrix.
	<<Particles: particle: TBP>>=
	procedure :: get_polarization => particle_get_polarization
	<<Particles: sub interfaces>>=
	module function particle_get_polarization (prt) result (pol)
	class(particle_t), intent(in) :: prt
	type(polarization_t) :: pol
	end function particle_get_polarization
	<<Particles: procedures>>=
	module function particle_get_polarization (prt) result (pol)
	class(particle_t), intent(in) :: prt
	type(polarization_t) :: pol
	pol = prt%pol
	end function particle_get_polarization

	@ %def particle_get_polarization
	@ Return the flavor, color and helicity.
	<<Particles: particle: TBP>>=
	procedure :: get_flv => particle_get_flv
	procedure :: get_col => particle_get_col
	procedure :: get_hel => particle_get_hel
	<<Particles: sub interfaces>>=
	module function particle_get_flv (prt) result (flv)
	class(particle_t), intent(in) :: prt
	type(flavor_t) :: flv
	end function particle_get_flv
	module function particle_get_col (prt) result (col)
	class(particle_t), intent(in) :: prt
	type(color_t) :: col
	end function particle_get_col
	module function particle_get_hel (prt) result (hel)
	class(particle_t), intent(in) :: prt
	type(helicity_t) :: hel
	end function particle_get_hel
	<<Particles: procedures>>=
	module function particle_get_flv (prt) result (flv)
	class(particle_t), intent(in) :: prt
	type(flavor_t) :: flv
	flv = prt%flv
	end function particle_get_flv

	module function particle_get_col (prt) result (col)
	class(particle_t), intent(in) :: prt
	type(color_t) :: col
	col = prt%col
	end function particle_get_col

	module function particle_get_hel (prt) result (hel)
	class(particle_t), intent(in) :: prt
	type(helicity_t) :: hel
	hel = prt%hel
	end function particle_get_hel

	@ %def particle_get_flv particle_get_col particle_get_hel
	@ Return the helicity (if defined and diagonal).
	<<Particles: particle: TBP>>=
	procedure :: get_helicity => particle_get_helicity
	<<Particles: sub interfaces>>=
	elemental module function particle_get_helicity (prt) result (hel)
	integer :: hel
	class(particle_t), intent(in) :: prt
	end function particle_get_helicity
	<<Particles: procedures>>=
	elemental module function particle_get_helicity (prt) result (hel)
	integer :: hel
	integer, dimension(2) :: hel_arr
	class(particle_t), intent(in) :: prt
	hel = 0
	if (prt%hel%is_defined () .and. prt%hel%is_diagonal ()) then
	hel_arr = prt%hel%to_pair ()
	hel = hel_arr (1)
	end if
	end function particle_get_helicity

	@ %def particle_get_helicity
	@ Return the number of children/parents
	<<Particles: particle: TBP>>=
	procedure :: get_n_parents => particle_get_n_parents
	procedure :: get_n_children => particle_get_n_children
	<<Particles: sub interfaces>>=
	elemental module function particle_get_n_parents (prt) result (n)
	integer :: n
	class(particle_t), intent(in) :: prt
	end function particle_get_n_parents
	elemental module function particle_get_n_children (prt) result (n)
	integer :: n
	class(particle_t), intent(in) :: prt
	end function particle_get_n_children
	<<Particles: procedures>>=
	elemental module function particle_get_n_parents (prt) result (n)
	integer :: n
	class(particle_t), intent(in) :: prt
	if (allocated (prt%parent)) then
	n = size (prt%parent)
	else
	n = 0
	end if
	end function particle_get_n_parents

	elemental module function particle_get_n_children (prt) result (n)
	integer :: n
	class(particle_t), intent(in) :: prt
	if (allocated (prt%child)) then
	n = size (prt%child)
	else
	n = 0
	end if
	end function particle_get_n_children

	@ %def particle_get_n_parents particle_get_n_children
	@ Return the array of parents/children.
	<<Particles: particle: TBP>>=
	procedure :: get_parents => particle_get_parents
	procedure :: get_children => particle_get_children
	<<Particles: sub interfaces>>=
	module function particle_get_parents (prt) result (parent)
	class(particle_t), intent(in) :: prt
	integer, dimension(:), allocatable :: parent
	end function particle_get_parents
	module function particle_get_children (prt) result (child)
	class(particle_t), intent(in) :: prt
	integer, dimension(:), allocatable :: child
	end function particle_get_children
	<<Particles: procedures>>=
	module function particle_get_parents (prt) result (parent)
	class(particle_t), intent(in) :: prt
	integer, dimension(:), allocatable :: parent
	if (allocated (prt%parent)) then
	allocate (parent (size (prt%parent)))
	parent = prt%parent
	else
	allocate (parent (0))
	end if
	end function particle_get_parents

	module function particle_get_children (prt) result (child)
	class(particle_t), intent(in) :: prt
	integer, dimension(:), allocatable :: child
	if (allocated (prt%child)) then
	allocate (child (size (prt%child)))
	child = prt%child
	else
	allocate (child (0))
	end if
	end function particle_get_children

	@ %def particle_get_children
	@
	<<Particles: particle: TBP>>=
	procedure :: has_children => particle_has_children
	<<Particles: sub interfaces>>=
	elemental module function particle_has_children (prt) result (has_children)
	logical :: has_children
	class(particle_t), intent(in) :: prt
	end function particle_has_children
	<<Particles: procedures>>=
	elemental module function particle_has_children (prt) result (has_children)
	logical :: has_children
	class(particle_t), intent(in) :: prt
	has_children = .false.
	if (allocated (prt%child)) then
	has_children = size (prt%child) > 0
	end if
	end function particle_has_children

	@ %def particle_has_children
	@
	<<Particles: particle: TBP>>=
	procedure :: has_parents => particle_has_parents
	<<Particles: sub interfaces>>=
	elemental module function particle_has_parents (prt) result (has_parents)
	logical :: has_parents
	class(particle_t), intent(in) :: prt
	end function particle_has_parents
	<<Particles: procedures>>=
	elemental module function particle_has_parents (prt) result (has_parents)
	logical :: has_parents
	class(particle_t), intent(in) :: prt
	has_parents = .false.
	if (allocated (prt%parent)) then
	has_parents = size (prt%parent) > 0
	end if
	end function particle_has_parents

	@ %def particle_has_parents
	@ Return momentum and momentum squared.
	<<Particles: particle: TBP>>=
	procedure :: get_momentum => particle_get_momentum
	procedure :: get_p2 => particle_get_p2
	<<Particles: sub interfaces>>=
	elemental module function particle_get_momentum (prt) result (p)
	type(vector4_t) :: p
	class(particle_t), intent(in) :: prt
	end function particle_get_momentum
	elemental module function particle_get_p2 (prt) result (p2)
	real(default) :: p2
	class(particle_t), intent(in) :: prt
	end function particle_get_p2
	<<Particles: procedures>>=
	elemental module function particle_get_momentum (prt) result (p)
	type(vector4_t) :: p
	class(particle_t), intent(in) :: prt
	p = prt%p
	end function particle_get_momentum

	elemental module function particle_get_p2 (prt) result (p2)
	real(default) :: p2
	class(particle_t), intent(in) :: prt
	p2 = prt%p2
	end function particle_get_p2

	@ %def particle_get_momentum particle_get_p2
	@ Return the particle vertex, if allocated.
	<<Particles: particle: TBP>>=
	procedure :: get_vertex => particle_get_vertex
	<<Particles: sub interfaces>>=
	elemental module function particle_get_vertex (prt) result (vtx)
	type(vector4_t) :: vtx
	class(particle_t), intent(in) :: prt
	end function particle_get_vertex
	<<Particles: procedures>>=
	elemental module function particle_get_vertex (prt) result (vtx)
	type(vector4_t) :: vtx
	class(particle_t), intent(in) :: prt
	if (allocated (prt%vertex)) then
	vtx = prt%vertex
	else
	vtx = vector4_null
	end if
	end function particle_get_vertex

	@ %def particle_get_vertex
	@ Return the lifetime of a particle.
	<<Particles: particle: TBP>>=
	procedure :: get_lifetime => particle_get_lifetime
	<<Particles: sub interfaces>>=
	elemental module function particle_get_lifetime (prt) result (lifetime)
	real(default) :: lifetime
	class(particle_t), intent(in) :: prt
	end function particle_get_lifetime
	<<Particles: procedures>>=
	elemental module function particle_get_lifetime (prt) result (lifetime)
	real(default) :: lifetime
	class(particle_t), intent(in) :: prt
	if (allocated (prt%lifetime)) then
	lifetime = prt%lifetime
	else
	lifetime = 0
	end if
	end function particle_get_lifetime

	@ %def particle_get_lifetime
	@
	<<Particles: particle: TBP>>=
	procedure :: momentum_to_pythia6 => particle_momentum_to_pythia6
	<<Particles: sub interfaces>>=
	pure module function particle_momentum_to_pythia6 (prt) result (p)
	real(double), dimension(1:5) :: p
	class(particle_t), intent(in) :: prt
	end function particle_momentum_to_pythia6
	<<Particles: procedures>>=
	pure module function particle_momentum_to_pythia6 (prt) result (p)
	real(double), dimension(1:5) :: p
	class(particle_t), intent(in) :: prt
	p = prt%p%to_pythia6 (sqrt (prt%p2))
	end function particle_momentum_to_pythia6

	@ %def particle_momentum_to_pythia6
	@
	\subsection{Particle sets}
	A particle set is what is usually called an event: an array of
	particles. The individual particle entries carry momentum, quantum
	numbers, polarization, and optionally connections. There is (also
	optionally) a correlated state-density matrix that maintains spin
	correlations that are lost in the individual particle entries.
	<<Particles: public>>=
	public :: particle_set_t
	<<Particles: types>>=
	type :: particle_set_t
	! private !!!
	integer :: n_beam = 0
	integer :: n_in = 0
	integer :: n_vir = 0
	integer :: n_out = 0
	integer :: n_tot = 0
	integer :: factorization_mode = FM_IGNORE_HELICITY
	type(particle_t), dimension(:), allocatable :: prt
	type(state_matrix_t) :: correlated_state
	contains
	<<Particles: particle set: TBP>>
	end type particle_set_t

	@ %def particle_set_t
	@ A particle set can be initialized from an interaction or from a
	HepMC event record.
	<<Particles: particle set: TBP>>=
	generic :: init => init_interaction
	procedure :: init_interaction => particle_set_init_interaction
	@ When a particle set is initialized from a given interaction, we have
	to determine the branch within the original state matrix that fixes
	the particle quantum numbers. This is done with the appropriate
	probabilities, based on a random number [[x]]. The [[mode]]
	determines whether the individual particles become unpolarized, or
	take a definite (diagonal) helicity, or acquire single-particle
	polarization matrices. The flag [[keep_correlations]] tells whether
	the spin-correlation matrix is to be calculated and stored in addition
	to the particles. The flag [[keep_virtual]] tells whether virtual
	particles should be dropped. Note that if virtual particles are
	dropped, the spin-correlation matrix makes no sense, and parent-child
	relations are not set.

	For a correct disentangling of color and flavor (in the presence of
	helicity), we consider two interactions. [[int]] has no color
	information, and is used to select a flavor state. Consequently, we
	trace over helicities here. [[int_flows]] contains color-flow and
	potentially helicity information, but is useful only after the flavor
	combination has been chosen. So this interaction is used to select
	helicity and color, but restricted to the selected flavor combination.

	[[int]] and [[int_flows]] may be identical if there is only a single
	(or no) color flow. If there is just a single flavor combination,
	[[x(1)]] can be set to zero.

	The current algorithm of evaluator convolution requires that the beam
	particles are assumed outgoing (in the beam interaction) and become
	virtual in all derived interactions. In the particle set they should
	be re-identified as incoming. The optional integer [[n_incoming]]
	can be used to perform this correction.

	The flag [[is_valid]] is false if factorization of the state is not
	possible, in particular if the squared matrix element is zero.
	<<Particles: sub interfaces>>=
	module subroutine particle_set_init_interaction &
	(particle_set, is_valid, int, int_flows, mode, x, &
	keep_correlations, keep_virtual, n_incoming, qn_select)
	class(particle_set_t), intent(out) :: particle_set
	logical, intent(out) :: is_valid
	type(interaction_t), intent(in), target :: int, int_flows
	integer, intent(in) :: mode
	real(default), dimension(2), intent(in) :: x
	logical, intent(in) :: keep_correlations, keep_virtual
	integer, intent(in), optional :: n_incoming
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_select
	end subroutine particle_set_init_interaction
	<<Particles: procedures>>=
	module subroutine particle_set_init_interaction &
	(particle_set, is_valid, int, int_flows, mode, x, &
	keep_correlations, keep_virtual, n_incoming, qn_select)
	class(particle_set_t), intent(out) :: particle_set
	logical, intent(out) :: is_valid
	type(interaction_t), intent(in), target :: int, int_flows
	integer, intent(in) :: mode
	real(default), dimension(2), intent(in) :: x
	logical, intent(in) :: keep_correlations, keep_virtual
	integer, intent(in), optional :: n_incoming
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_select
	type(state_matrix_t), dimension(:), allocatable, target :: flavor_state
	type(state_matrix_t), dimension(:), allocatable, target :: single_state
	integer :: n_in, n_vir, n_out, n_tot
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	logical :: ok
	integer :: i, j
	if (present (n_incoming)) then
	n_in = n_incoming
	n_vir = int%get_n_vir () - n_incoming
	else
	n_in = int%get_n_in ()
	n_vir = int%get_n_vir ()
	end if
	n_out = int%get_n_out ()
	n_tot = int%get_n_tot ()
	particle_set%n_in = n_in
	particle_set%n_out = n_out
	if (keep_virtual) then
	particle_set%n_vir = n_vir
	particle_set%n_tot = n_tot
	else
	particle_set%n_vir = 0
	particle_set%n_tot = n_in + n_out
	end if
	particle_set%factorization_mode = mode
	allocate (qn (n_tot, 1))
	if (.not. present (qn_select)) then
	call int%factorize &
	(FM_IGNORE_HELICITY, x(1), is_valid, flavor_state)
	do i = 1, n_tot
	qn(i,:) = flavor_state(i)%get_quantum_number (1)
	end do
	else
	do i = 1, n_tot
	qn(i,:) = qn_select(i)
	end do
	is_valid = .true.
	end if
	if (keep_correlations .and. keep_virtual) then
	call particle_set%correlated_state%final ()
	call int_flows%factorize (mode, x(2), ok, &
	single_state, particle_set%correlated_state, qn(:,1))
	else
	call int_flows%factorize (mode, x(2), ok, &
	single_state, qn_in=qn(:,1))
	end if
	is_valid = is_valid .and. ok
	allocate (particle_set%prt (particle_set%n_tot))
	j = 1
	do i = 1, n_tot
	if (i <= n_in) then
	call particle_set%prt(j)%init (single_state(i), PRT_INCOMING, mode)
	call particle_set%prt(j)%set_momentum (int%get_momentum (i))
	else if (i <= n_in + n_vir) then
	if (.not. keep_virtual) cycle
	call particle_set%prt(j)%init &
	(single_state(i), PRT_VIRTUAL, mode)
	call particle_set%prt(j)%set_momentum (int%get_momentum (i))
	else
	call particle_set%prt(j)%init (single_state(i), PRT_OUTGOING, mode)
	call particle_set%prt(j)%set_momentum &
	(int%get_momentum (i), on_shell = .true.)
	end if
	if (keep_virtual) then
	call particle_set%prt(j)%set_children (int%get_children (i))
	call particle_set%prt(j)%set_parents (int%get_parents (i))
	end if
	j = j + 1
	end do
	if (keep_virtual) then
	call particle_set_resonance_flag &
	(particle_set%prt, int%get_resonance_flags ())
	end if
	if (allocated (flavor_state)) then
	do i = 1, size(flavor_state)
	call flavor_state(i)%final ()
	end do
	end if
	do i = 1, size(single_state)
	call single_state(i)%final ()
	end do
	end subroutine particle_set_init_interaction

	@ %def particle_set_init_interaction
	@ Duplicate generic binding, to make sure that assignment works as it should.
	<<Particles: particle set: TBP>>=
	generic :: assignment(=) => init_particle_set
	generic :: init => init_particle_set
	procedure :: init_particle_set => particle_set_init_particle_set
	<<Particles: sub interfaces>>=
	module subroutine particle_set_init_particle_set (pset_out, pset_in)
	class(particle_set_t), intent(out) :: pset_out
	type(particle_set_t), intent(in) :: pset_in
	end subroutine particle_set_init_particle_set
	<<Particles: procedures>>=
	module subroutine particle_set_init_particle_set (pset_out, pset_in)
	class(particle_set_t), intent(out) :: pset_out
	type(particle_set_t), intent(in) :: pset_in
	integer :: i
	pset_out%n_beam = pset_in%n_beam
	pset_out%n_in = pset_in%n_in
	pset_out%n_vir = pset_in%n_vir
	pset_out%n_out = pset_in%n_out
	pset_out%n_tot = pset_in%n_tot
	pset_out%factorization_mode = pset_in%factorization_mode
	if (allocated (pset_in%prt)) then
	allocate (pset_out%prt (size (pset_in%prt)))
	do i = 1, size (pset_in%prt)
	pset_out%prt(i) = pset_in%prt(i)
	end do
	end if
	pset_out%correlated_state = pset_in%correlated_state
	end subroutine particle_set_init_particle_set

	@ %def particle_set_init_particle_set
	@ Manually set the model for the stored particles.
	<<Particles: particle set: TBP>>=
	procedure :: set_model => particle_set_set_model
	<<Particles: sub interfaces>>=
	module subroutine particle_set_set_model (particle_set, model)
	class(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	end subroutine particle_set_set_model
	<<Particles: procedures>>=
	module subroutine particle_set_set_model (particle_set, model)
	class(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	integer :: i
	do i = 1, particle_set%n_tot
	call particle_set%prt(i)%set_model (model)
	end do
	call particle_set%correlated_state%set_model (model)
	end subroutine particle_set_set_model

	@ %def particle_set_set_model
	@ Pointer components are hidden inside the particle polarization, and
	in the correlated state matrix.
	<<Particles: particle set: TBP>>=
	procedure :: final => particle_set_final
	<<Particles: sub interfaces>>=
	module subroutine particle_set_final (particle_set)
	class(particle_set_t), intent(inout) :: particle_set
	end subroutine particle_set_final
	<<Particles: procedures>>=
	module subroutine particle_set_final (particle_set)
	class(particle_set_t), intent(inout) :: particle_set
	integer :: i
	if (allocated (particle_set%prt)) then
	do i = 1, size(particle_set%prt)
	call particle_set%prt(i)%final ()
	end do
	deallocate (particle_set%prt)
	end if
	call particle_set%correlated_state%final ()
	end subroutine particle_set_final

	@ %def particle_set_final
	@
	\subsection{Manual build}
	Basic initialization. Just allocate with a given number of beam, incoming,
	virtual, and outgoing particles.
	<<Particles: particle set: TBP>>=
	procedure :: basic_init => particle_set_basic_init
	<<Particles: sub interfaces>>=
	module subroutine particle_set_basic_init (particle_set, n_beam, n_in, n_vir, n_out)
	class(particle_set_t), intent(out) :: particle_set
	integer, intent(in) :: n_beam, n_in, n_vir, n_out
	end subroutine particle_set_basic_init
	<<Particles: procedures>>=
	module subroutine particle_set_basic_init (particle_set, n_beam, n_in, n_vir, n_out)
	class(particle_set_t), intent(out) :: particle_set
	integer, intent(in) :: n_beam, n_in, n_vir, n_out
	particle_set%n_beam = n_beam
	particle_set%n_in = n_in
	particle_set%n_vir = n_vir
	particle_set%n_out = n_out
	particle_set%n_tot = n_beam + n_in + n_vir + n_out
	allocate (particle_set%prt (particle_set%n_tot))
	end subroutine particle_set_basic_init

	@ %def particle_set_basic_init
	@
	Build a particle set from scratch. This is used for testing
	purposes. The ordering of particles in the result is
	beam-incoming-remnant-virtual-outgoing.

	Parent-child relations:
	\begin{itemize}
	\item
	Beams are parents of incoming and beam remnants. The assignment is
	alternating (first beam, second beam).
	\item
	Incoming are parents of virtual and outgoing, collectively.
	\end{itemize}
	More specific settings, such as resonance histories, cannot be set
	this way.

	Beam-remnant particles are counted as virtual, but have a different
	status code.

	We assume that the [[pdg]] array has the correct size.
	<<Particles: particle set: TBP>>=
	procedure :: init_direct => particle_set_init_direct
	<<Particles: sub interfaces>>=
	module subroutine particle_set_init_direct (particle_set, &
	n_beam, n_in, n_rem, n_vir, n_out, pdg, model)
	class(particle_set_t), intent(out) :: particle_set
	integer, intent(in) :: n_beam
	integer, intent(in) :: n_in
	integer, intent(in) :: n_rem
	integer, intent(in) :: n_vir
	integer, intent(in) :: n_out
	integer, dimension(:), intent(in) :: pdg
	class(model_data_t), intent(in), target :: model
	end subroutine particle_set_init_direct
	<<Particles: procedures>>=
	module subroutine particle_set_init_direct (particle_set, &
	n_beam, n_in, n_rem, n_vir, n_out, pdg, model)
	class(particle_set_t), intent(out) :: particle_set
	integer, intent(in) :: n_beam
	integer, intent(in) :: n_in
	integer, intent(in) :: n_rem
	integer, intent(in) :: n_vir
	integer, intent(in) :: n_out
	integer, dimension(:), intent(in) :: pdg
	class(model_data_t), intent(in), target :: model
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: i, k, n
	call particle_set%basic_init (n_beam, n_in, n_rem+n_vir, n_out)
	n = 0
	call particle_set%prt(n+1:n+n_beam)%reset_status (PRT_BEAM)
	do i = n+1, n+n_beam
	call particle_set%prt(i)%set_children &
	([(k, k=i+n_beam, n+n_beam+n_in+n_rem, 2)])
	end do
	n = n + n_beam
	call particle_set%prt(n+1:n+n_in)%reset_status (PRT_INCOMING)
	do i = n+1, n+n_in
	if (n_beam > 0) then
	call particle_set%prt(i)%set_parents &
	([i-n_beam])
	end if
	call particle_set%prt(i)%set_children &
	([(k, k=n+n_in+n_rem+1, n+n_in+n_rem+n_vir+n_out)])
	end do
	n = n + n_in
	call particle_set%prt(n+1:n+n_rem)%reset_status (PRT_BEAM_REMNANT)
	do i = n+1, n+n_rem
	if (n_beam > 0) then
	call particle_set%prt(i)%set_parents &
	([i-n_in-n_beam])
	end if
	end do
	n = n + n_rem
	call particle_set%prt(n+1:n+n_vir)%reset_status (PRT_VIRTUAL)
	do i = n+1, n+n_vir
	call particle_set%prt(i)%set_parents &
	([(k, k=n-n_rem-n_in+1, n-n_rem)])
	end do
	n = n + n_vir
	call particle_set%prt(n+1:n+n_out)%reset_status (PRT_OUTGOING)
	do i = n+1, n+n_out
	call particle_set%prt(i)%set_parents &
	([(k, k=n-n_vir-n_rem-n_in+1, n-n_vir-n_rem)])
	end do
	allocate (flv (particle_set%n_tot))
	call flv%init (pdg, model)
	do k = n_beam+n_in+1, n_beam+n_in+n_rem
	call flv(k)%tag_radiated ()
	end do
	do i = 1, particle_set%n_tot
	call particle_set%prt(i)%set_flavor (flv(i))
	end do
	end subroutine particle_set_init_direct

	@ %def particle_set_init_direct
	@ Copy a particle set into a new, extended one. Use the mapping array to
	determine the new positions of particles. The new set contains [[n_new]]
	additional entries. Count the new, undefined particles as
	virtual.
	<<Particles: particle set: TBP>>=
	procedure :: transfer => particle_set_transfer
	<<Particles: sub interfaces>>=
	module subroutine particle_set_transfer (pset, source, n_new, map)
	class(particle_set_t), intent(out) :: pset
	class(particle_set_t), intent(in) :: source
	integer, intent(in) :: n_new
	integer, dimension(:), intent(in) :: map
	end subroutine particle_set_transfer
	<<Particles: procedures>>=
	module subroutine particle_set_transfer (pset, source, n_new, map)
	class(particle_set_t), intent(out) :: pset
	class(particle_set_t), intent(in) :: source
	integer, intent(in) :: n_new
	integer, dimension(:), intent(in) :: map
	integer :: i
	call pset%basic_init &
	(source%n_beam, source%n_in, source%n_vir + n_new, source%n_out)
	pset%factorization_mode = source%factorization_mode
	do i = 1, source%n_tot
	call pset%prt(map(i))%reset_status (source%prt(i)%get_status ())
	call pset%prt(map(i))%set_flavor (source%prt(i)%get_flv ())
	call pset%prt(map(i))%set_color (source%prt(i)%get_col ())
	call pset%prt(map(i))%set_parents (map (source%prt(i)%get_parents ()))
	call pset%prt(map(i))%set_children (map (source%prt(i)%get_children ()))
	call pset%prt(map(i))%set_polarization &
	(source%prt(i)%get_polarization_status ())
	select case (source%prt(i)%get_polarization_status ())
	case (PRT_DEFINITE_HELICITY)
	call pset%prt(map(i))%set_helicity (source%prt(i)%get_hel ())
	case (PRT_GENERIC_POLARIZATION)
	call pset%prt(map(i))%set_pol (source%prt(i)%get_polarization ())
	end select
	end do
	end subroutine particle_set_transfer

	@ %def particle_set_transfer
	@ Insert a new particle as an intermediate into a previously empty position.

	Flavor and status are just set. Color is not set (but see below).
	The complicated part is reassigning parent-child relations. The
	inserted particle comes with an array [[child]] of its children which
	are supposed to be existing particles.

	We first scan all particles that come before the new insertion.
	Whenever a particle has children that coincide with the children of
	the new particle, those child entries are removed. (a) If the new
	particle has no parent entry yet, those child entries are replaced by
	the index of the new particle and simultaneously, the particle is
	registered as a parent of the new particle. (b) If the current particle
	already has a parent entry, those child entries are removed.

	When this is done, the new particle is registered as the (only) parent of its
	children.
	<<Particles: particle set: TBP>>=
	procedure :: insert => particle_set_insert
	<<Particles: sub interfaces>>=
	module subroutine particle_set_insert (pset, i, status, flv, child)
	class(particle_set_t), intent(inout) :: pset
	integer, intent(in) :: i
	integer, intent(in) :: status
	type(flavor_t), intent(in) :: flv
	integer, dimension(:), intent(in) :: child
	end subroutine particle_set_insert
	<<Particles: procedures>>=
	module subroutine particle_set_insert (pset, i, status, flv, child)
	class(particle_set_t), intent(inout) :: pset
	integer, intent(in) :: i
	integer, intent(in) :: status
	type(flavor_t), intent(in) :: flv
	integer, dimension(:), intent(in) :: child
	integer, dimension(:), allocatable :: p_child, parent
	integer :: j, k, c, n_parent
	logical :: no_match
	call pset%prt(i)%reset_status (status)
	call pset%prt(i)%set_flavor (flv)
	call pset%prt(i)%set_children (child)
	n_parent = pset%prt(i)%get_n_parents ()
	do j = 1, i - 1
	p_child = pset%prt(j)%get_children ()
	no_match = .true.
	do k = 1, size (p_child)
	if (any (p_child(k) == child)) then
	if (n_parent == 0 .and. no_match) then
	if (.not. allocated (parent)) then
	parent = [j]
	else
	parent = [parent, j]
	end if
	p_child(k) = i
	else
	p_child(k) = 0
	end if
	no_match = .false.
	end if
	end do
	if (.not. no_match) then
	p_child = pack (p_child, p_child /= 0)
	call pset%prt(j)%set_children (p_child)
	end if
	end do
	if (n_parent == 0) then
	call pset%prt(i)%set_parents (parent)
	end if
	do j = 1, size (child)
	c = child(j)
	call pset%prt(c)%set_parents ([i])
	end do
	end subroutine particle_set_insert

	@ %def particle_set_insert
	@ This should be done after completing all insertions: recover color
	assignments for the inserted particles, working backwards from
	children to parents. A single call to the routine recovers the color
	and anticolor line indices for a single particle.
	<<Particles: particle set: TBP>>=
	procedure :: recover_color => particle_set_recover_color
	<<Particles: sub interfaces>>=
	module subroutine particle_set_recover_color (pset, i)
	class(particle_set_t), intent(inout) :: pset
	integer, intent(in) :: i
	end subroutine particle_set_recover_color
	<<Particles: procedures>>=
	module subroutine particle_set_recover_color (pset, i)
	class(particle_set_t), intent(inout) :: pset
	integer, intent(in) :: i
	type(color_t) :: col
	integer, dimension(:), allocatable :: child
	integer :: j
	child = pset%prt(i)%get_children ()
	if (size (child) > 0) then
	col = pset%prt(child(1))%get_col ()
	do j = 2, size (child)
	col = col .fuse. pset%prt(child(j))%get_col ()
	end do
	call pset%prt(i)%set_color (col)
	end if
	end subroutine particle_set_recover_color

	@ %def particle_set_recover_color
	@
	\subsection{Extract/modify contents}
	<<Particles: particle set: TBP>>=
	generic :: get_color => get_color_all
	generic :: get_color => get_color_indices
	procedure :: get_color_all => particle_set_get_color_all
	procedure :: get_color_indices => particle_set_get_color_indices
	<<Particles: sub interfaces>>=
	module function particle_set_get_color_all (particle_set) result (col)
	class(particle_set_t), intent(in) :: particle_set
	type(color_t), dimension(:), allocatable :: col
	end function particle_set_get_color_all
	<<Particles: procedures>>=
	module function particle_set_get_color_all (particle_set) result (col)
	class(particle_set_t), intent(in) :: particle_set
	type(color_t), dimension(:), allocatable :: col
	allocate (col (size (particle_set%prt)))
	col = particle_set%prt%col
	end function particle_set_get_color_all

	@ %def particle_set_get_color_all
	@
	<<Particles: sub interfaces>>=
	module function particle_set_get_color_indices (particle_set, indices) result (col)
	type(color_t), dimension(:), allocatable :: col
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in), dimension(:), allocatable :: indices
	end function particle_set_get_color_indices
	<<Particles: procedures>>=
	module function particle_set_get_color_indices (particle_set, indices) result (col)
	type(color_t), dimension(:), allocatable :: col
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in), dimension(:), allocatable :: indices
	integer :: i
	allocate (col (size (indices)))
	do i = 1, size (indices)
	col(i) = particle_set%prt(indices(i))%col
	end do
	end function particle_set_get_color_indices

	@ %def particle_set_get_color_indices
	@ Set a single or all color components. This is a wrapper around the
	corresponding [[particle_t]] method, with the same options. We assume
	that the particle array is allocated.
	<<Particles: particle set: TBP>>=
	generic :: set_color => set_color_single
	generic :: set_color => set_color_indices
	generic :: set_color => set_color_all
	procedure :: set_color_single => particle_set_set_color_single
	procedure :: set_color_indices => particle_set_set_color_indices
	procedure :: set_color_all => particle_set_set_color_all
	<<Particles: sub interfaces>>=
	module subroutine particle_set_set_color_single (particle_set, i, col)
	class(particle_set_t), intent(inout) :: particle_set
	integer, intent(in) :: i
	type(color_t), intent(in) :: col
	end subroutine particle_set_set_color_single
	module subroutine particle_set_set_color_indices (particle_set, indices, col)
	class(particle_set_t), intent(inout) :: particle_set
	integer, dimension(:), intent(in) :: indices
	type(color_t), dimension(:), intent(in) :: col
	end subroutine particle_set_set_color_indices
	module subroutine particle_set_set_color_all (particle_set, col)
	class(particle_set_t), intent(inout) :: particle_set
	type(color_t), dimension(:), intent(in) :: col
	end subroutine particle_set_set_color_all
	<<Particles: procedures>>=
	module subroutine particle_set_set_color_single (particle_set, i, col)
	class(particle_set_t), intent(inout) :: particle_set
	integer, intent(in) :: i
	type(color_t), intent(in) :: col
	call particle_set%prt(i)%set_color (col)
	end subroutine particle_set_set_color_single

	module subroutine particle_set_set_color_indices (particle_set, indices, col)
	class(particle_set_t), intent(inout) :: particle_set
	integer, dimension(:), intent(in) :: indices
	type(color_t), dimension(:), intent(in) :: col
	integer :: i
	do i = 1, size (indices)
	call particle_set%prt(indices(i))%set_color (col(i))
	end do
	end subroutine particle_set_set_color_indices

	module subroutine particle_set_set_color_all (particle_set, col)
	class(particle_set_t), intent(inout) :: particle_set
	type(color_t), dimension(:), intent(in) :: col
	call particle_set%prt%set_color (col)
	end subroutine particle_set_set_color_all

	@ %def particle_set_set_color
	@ Assigning particles manually may result in color mismatches. This is
	checked here for all particles in the set. The color object is
	compared against the color type that belongs to the flavor object.
	The return value is an allocatable array which consists of the particles
	with invalid color assignments. If the array size is zero, all is fine.
	<<Particles: particle set: TBP>>=
	procedure :: find_prt_invalid_color => particle_set_find_prt_invalid_color
	<<Particles: sub interfaces>>=
	module subroutine particle_set_find_prt_invalid_color (particle_set, index, prt)
	class(particle_set_t), intent(in) :: particle_set
	integer, dimension(:), allocatable, intent(out) :: index
	type(particle_t), dimension(:), allocatable, intent(out), optional :: prt
	end subroutine particle_set_find_prt_invalid_color
	<<Particles: procedures>>=
	module subroutine particle_set_find_prt_invalid_color (particle_set, index, prt)
	class(particle_set_t), intent(in) :: particle_set
	integer, dimension(:), allocatable, intent(out) :: index
	type(particle_t), dimension(:), allocatable, intent(out), optional :: prt
	type(flavor_t) :: flv
	type(color_t) :: col
	logical, dimension(:), allocatable :: mask
	integer :: i, n, n_invalid
	n = size (particle_set%prt)
	allocate (mask (n))
	do i = 1, n
	associate (prt => particle_set%prt(i))
	flv = prt%get_flv ()
	col = prt%get_col ()
	mask(i) = flv%get_color_type () /= col%get_type ()
	end associate
	end do
	index = pack ([(i, i = 1, n)], mask)
	if (present (prt)) prt = pack (particle_set%prt, mask)
	end subroutine particle_set_find_prt_invalid_color

	@ %def particle_set_find_prt_invalid_color
	@
	<<Particles: particle set: TBP>>=
	generic :: get_momenta => get_momenta_all
	generic :: get_momenta => get_momenta_indices
	procedure :: get_momenta_all => particle_set_get_momenta_all
	procedure :: get_momenta_indices => particle_set_get_momenta_indices
	<<Particles: sub interfaces>>=
	module function particle_set_get_momenta_all (particle_set) result (p)
	class(particle_set_t), intent(in) :: particle_set
	type(vector4_t), dimension(:), allocatable :: p
	end function particle_set_get_momenta_all
	<<Particles: procedures>>=
	module function particle_set_get_momenta_all (particle_set) result (p)
	class(particle_set_t), intent(in) :: particle_set
	type(vector4_t), dimension(:), allocatable :: p
	allocate (p (size (particle_set%prt)))
	p = particle_set%prt%p
	end function particle_set_get_momenta_all

	@ %def particle_set_get_momenta_all
	@
	<<Particles: sub interfaces>>=
	module function particle_set_get_momenta_indices (particle_set, indices) result (p)
	type(vector4_t), dimension(:), allocatable :: p
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in), dimension(:), allocatable :: indices
	end function particle_set_get_momenta_indices
	<<Particles: procedures>>=
	module function particle_set_get_momenta_indices (particle_set, indices) result (p)
	type(vector4_t), dimension(:), allocatable :: p
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in), dimension(:), allocatable :: indices
	integer :: i
	allocate (p (size (indices)))
	do i = 1, size (indices)
	p(i) = particle_set%prt(indices(i))%p
	end do
	end function particle_set_get_momenta_indices

	@ %def particle_set_get_momenta_indices
	@ Replace a single or all momenta. This is a wrapper around the
	corresponding [[particle_t]] method, with the same options. We assume
	that the particle array is allocated.
	<<Particles: particle set: TBP>>=
	generic :: set_momentum => set_momentum_single
	generic :: set_momentum => set_momentum_indices
	generic :: set_momentum => set_momentum_all
	procedure :: set_momentum_single => particle_set_set_momentum_single
	procedure :: set_momentum_indices => particle_set_set_momentum_indices
	procedure :: set_momentum_all => particle_set_set_momentum_all
	<<Particles: sub interfaces>>=
	module subroutine particle_set_set_momentum_single &
	(particle_set, i, p, p2, on_shell)
	class(particle_set_t), intent(inout) :: particle_set
	integer, intent(in) :: i
	type(vector4_t), intent(in) :: p
	real(default), intent(in), optional :: p2
	logical, intent(in), optional :: on_shell
	end subroutine particle_set_set_momentum_single
	module subroutine particle_set_set_momentum_indices &
	(particle_set, indices, p, p2, on_shell)
	class(particle_set_t), intent(inout) :: particle_set
	integer, dimension(:), intent(in) :: indices
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), dimension(:), intent(in), optional :: p2
	logical, intent(in), optional :: on_shell
	end subroutine particle_set_set_momentum_indices
	module subroutine particle_set_set_momentum_all (particle_set, p, p2, on_shell)
	class(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), dimension(:), intent(in), optional :: p2
	logical, intent(in), optional :: on_shell
	end subroutine particle_set_set_momentum_all
	<<Particles: procedures>>=
	module subroutine particle_set_set_momentum_single &
	(particle_set, i, p, p2, on_shell)
	class(particle_set_t), intent(inout) :: particle_set
	integer, intent(in) :: i
	type(vector4_t), intent(in) :: p
	real(default), intent(in), optional :: p2
	logical, intent(in), optional :: on_shell
	call particle_set%prt(i)%set_momentum (p, p2, on_shell)
	end subroutine particle_set_set_momentum_single

	module subroutine particle_set_set_momentum_indices &
	(particle_set, indices, p, p2, on_shell)
	class(particle_set_t), intent(inout) :: particle_set
	integer, dimension(:), intent(in) :: indices
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), dimension(:), intent(in), optional :: p2
	logical, intent(in), optional :: on_shell
	integer :: i
	if (present (p2)) then
	do i = 1, size (indices)
	call particle_set%prt(indices(i))%set_momentum (p(i), p2(i), on_shell)
	end do
	else
	do i = 1, size (indices)
	call particle_set%prt(indices(i))%set_momentum &
	(p(i), on_shell=on_shell)
	end do
	end if
	end subroutine particle_set_set_momentum_indices

	module subroutine particle_set_set_momentum_all (particle_set, p, p2, on_shell)
	class(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), dimension(:), intent(in), optional :: p2
	logical, intent(in), optional :: on_shell
	call particle_set%prt%set_momentum (p, p2, on_shell)
	end subroutine particle_set_set_momentum_all

	@ %def particle_set_set_momentum
	@ Recover a momentum by recombining from children, assuming that this
	is possible. The reconstructed momentum is not projected on-shell.
	<<Particles: particle set: TBP>>=
	procedure :: recover_momentum => particle_set_recover_momentum
	<<Particles: sub interfaces>>=
	module subroutine particle_set_recover_momentum (particle_set, i)
	class(particle_set_t), intent(inout) :: particle_set
	integer, intent(in) :: i
	end subroutine particle_set_recover_momentum
	<<Particles: procedures>>=
	module subroutine particle_set_recover_momentum (particle_set, i)
	class(particle_set_t), intent(inout) :: particle_set
	integer, intent(in) :: i
	type(vector4_t), dimension(:), allocatable :: p
	integer, dimension(:), allocatable :: index
	index = particle_set%prt(i)%get_children ()
	p = particle_set%get_momenta (index)
	call particle_set%set_momentum (i, sum (p))
	end subroutine particle_set_recover_momentum

	@ %def particle_set_recover_momentum
	@
	<<Particles: particle set: TBP>>=
	procedure :: replace_incoming_momenta => particle_set_replace_incoming_momenta
	<<Particles: sub interfaces>>=
	module subroutine particle_set_replace_incoming_momenta (particle_set, p)
	class(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), intent(in), dimension(:) :: p
	end subroutine particle_set_replace_incoming_momenta
	<<Particles: procedures>>=
	module subroutine particle_set_replace_incoming_momenta (particle_set, p)
	class(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), intent(in), dimension(:) :: p
	integer :: i, j
	i = 1
	do j = 1, particle_set%get_n_tot ()
	if (particle_set%prt(j)%get_status () == PRT_INCOMING) then
	particle_set%prt(j)%p = p(i)
	i = i + 1
	if (i > particle_set%n_in) exit
	end if
	end do
	end subroutine particle_set_replace_incoming_momenta

	@ %def particle_set_replace_incoming_momenta
	@
	<<Particles: particle set: TBP>>=
	procedure :: replace_outgoing_momenta => particle_set_replace_outgoing_momenta
	<<Particles: sub interfaces>>=
	module subroutine particle_set_replace_outgoing_momenta (particle_set, p)
	class(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), intent(in), dimension(:) :: p
	end subroutine particle_set_replace_outgoing_momenta
	<<Particles: procedures>>=
	module subroutine particle_set_replace_outgoing_momenta (particle_set, p)
	class(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), intent(in), dimension(:) :: p
	integer :: i, j
	i = particle_set%n_in + 1
	do j = 1, particle_set%n_tot
	if (particle_set%prt(j)%get_status () == PRT_OUTGOING) then
	particle_set%prt(j)%p = p(i)
	i = i + 1
	end if
	end do
	end subroutine particle_set_replace_outgoing_momenta

	@ %def particle_set_replace_outgoing_momenta
	@
	<<Particles: particle set: TBP>>=
	procedure :: get_outgoing_momenta => particle_set_get_outgoing_momenta
	<<Particles: sub interfaces>>=
	module function particle_set_get_outgoing_momenta (particle_set) result (p)
	class(particle_set_t), intent(in) :: particle_set
	type(vector4_t), dimension(:), allocatable :: p
	end function particle_set_get_outgoing_momenta
	<<Particles: procedures>>=
	module function particle_set_get_outgoing_momenta (particle_set) result (p)
	class(particle_set_t), intent(in) :: particle_set
	type(vector4_t), dimension(:), allocatable :: p
	integer :: i, k
	allocate (p (count (particle_set%prt%get_status () == PRT_OUTGOING)))
	k = 0
	do i = 1, size (particle_set%prt)
	if (particle_set%prt(i)%get_status () == PRT_OUTGOING) then
	k = k + 1
	p(k) = particle_set%prt(i)%get_momentum ()
	end if
	end do
	end function particle_set_get_outgoing_momenta

	@ %def particle_set_get_outgoing_momenta
	@
	<<Particles: particle set: TBP>>=
	procedure :: parent_add_child => particle_set_parent_add_child
	<<Particles: sub interfaces>>=
	module subroutine particle_set_parent_add_child (particle_set, parent, child)
	class(particle_set_t), intent(inout) :: particle_set
	integer, intent(in) :: parent, child
	end subroutine particle_set_parent_add_child
	<<Particles: procedures>>=
	module subroutine particle_set_parent_add_child (particle_set, parent, child)
	class(particle_set_t), intent(inout) :: particle_set
	integer, intent(in) :: parent, child
	call particle_set%prt(child)%set_parents ([parent])
	call particle_set%prt(parent)%add_child (child)
	end subroutine particle_set_parent_add_child

	@ %def particle_set_parent_add_child
	@ Given the [[particle_set]] before radiation, the new momenta
	[[p_radiated]], the [[emitter]] and the [[flv_radiated]] as well as the
	[[model]] and a random number [[r_color]] for chosing a color in
	ambiguous cases, we update the [[particle_set]].
	The reference for this procedure is [0709.2092], Sec. 4.5.1.
	+We do not (yet) account for helicities and polarisations here nor do we
	+update the beam remnant color and momenta.
	<<Particles: particle set: TBP>>=
	procedure :: build_radiation => particle_set_build_radiation
	<<Particles: sub interfaces>>=
	module subroutine particle_set_build_radiation (particle_set, p_radiated, &
	emitter, flv_radiated, model, r_color)
	class(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), intent(in), dimension(:) :: p_radiated
	integer, intent(in) :: emitter
	integer, intent(in), dimension(:) :: flv_radiated
	class(model_data_t), intent(in), target :: model
	real(default), intent(in) :: r_color
	end subroutine particle_set_build_radiation
	<<Particles: procedures>>=
	module subroutine particle_set_build_radiation (particle_set, p_radiated, &
	emitter, flv_radiated, model, r_color)
	class(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), intent(in), dimension(:) :: p_radiated
	integer, intent(in) :: emitter
	integer, intent(in), dimension(:) :: flv_radiated
	class(model_data_t), intent(in), target :: model
	real(default), intent(in) :: r_color
	type(particle_set_t) :: new_particle_set
	type(particle_t) :: new_particle
	- integer :: i, pdg_index_emitter, pdg_index_radiation
	+ integer :: i, j, pdg_index_emitter, pdg_index_radiation, new_color_index
	integer, dimension(:), allocatable :: parents, children
	+ type(vector4_t) :: mom_sum_children
	type(flavor_t) :: new_flv, real_emitter_flavor
	logical, dimension(:), allocatable :: status_mask
	integer, dimension(:), allocatable :: &
	- i_in1, i_beam1, i_remnant1, i_virt1, i_out1
	+ i_in1, i_beam1, i_remnant1, i_virt1, i_res1, i_out1
	integer, dimension(:), allocatable :: &
	- i_in2, i_beam2, i_remnant2, i_virt2, i_out2
	- integer :: n_in1, n_beam1, n_remnant1, n_virt1, n_out1
	- integer :: n_in2, n_beam2, n_remnant2, n_virt2, n_out2
	+ i_in2, i_beam2, i_remnant2, i_virt2, i_res2, i_out2
	+ integer :: n_in1, n_beam1, n_remnant1, n_virt1, n_res1, n_out1
	+ integer :: n_in2, n_beam2, n_remnant2, n_virt2, n_res2, n_out2
	integer :: n, n_tot, i_emitter
	logical :: is_fsr

	n = particle_set%get_n_tot ()
	allocate (status_mask (n))
	do i = 1, n
	status_mask(i) = particle_set%prt(i)%get_status () == PRT_INCOMING
	end do
	n_in1 = count (status_mask)
	allocate (i_in1 (n_in1))
	i_in1 = particle_set%get_indices (status_mask)
	do i = 1, n
	status_mask(i) = particle_set%prt(i)%get_status () == PRT_BEAM
	end do
	n_beam1 = count (status_mask)
	allocate (i_beam1 (n_beam1))
	i_beam1 = particle_set%get_indices (status_mask)
	do i = 1, n
	status_mask(i) = particle_set%prt(i)%get_status () == PRT_BEAM_REMNANT
	end do
	n_remnant1 = count (status_mask)
	allocate (i_remnant1 (n_remnant1))
	i_remnant1 = particle_set%get_indices (status_mask)
	do i = 1, n
	status_mask(i) = particle_set%prt(i)%get_status () == PRT_VIRTUAL
	end do
	n_virt1 = count (status_mask)
	allocate (i_virt1 (n_virt1))
	i_virt1 = particle_set%get_indices (status_mask)
	do i = 1, n
	+ status_mask(i) = particle_set%prt(i)%get_status () == PRT_RESONANT
	+ end do
	+ n_res1 = count (status_mask)
	+ allocate (i_res1 (n_res1))
	+ i_res1 = particle_set%get_indices (status_mask)
	+ do i = 1, n
	status_mask(i) = particle_set%prt(i)%get_status () == PRT_OUTGOING
	end do
	n_out1 = count (status_mask)
	allocate (i_out1 (n_out1))
	i_out1 = particle_set%get_indices (status_mask)

	- n_in2 = n_in1; n_beam2 = n_beam1; n_remnant2 = n_remnant1
	- n_virt2 = n_virt1 + n_out1
	+ n_in2 = n_in1; n_beam2 = n_beam1; n_remnant2 = n_remnant1; n_res2 = n_res1
	+ n_virt2 = n_virt1
	n_out2 = n_out1 + 1
	- n_tot = n_in2 + n_beam2 + n_remnant2 + n_virt2 + n_out2
	+ n_tot = n_in2 + n_beam2 + n_remnant2 + n_virt2 + n_res2 + n_out2

	- allocate (i_in2 (n_in2), i_beam2 (n_beam2), i_remnant2 (n_remnant2))
	- i_in2 = i_in1; i_beam2 = i_beam1; i_remnant2 = i_remnant1
	+ allocate (i_in2 (n_in2), i_beam2 (n_beam2), i_remnant2 (n_remnant2), i_res2 (n_res2))
	+ i_in2 = i_in1; i_beam2 = i_beam1; i_remnant2 = i_remnant1; i_res2 = i_res1

	allocate (i_virt2 (n_virt2))
	i_virt2(1 : n_virt1) = i_virt1
	- i_virt2(n_virt1 + 1 : n_virt2) = i_out1

	allocate (i_out2 (n_out2))
	- i_out2(1 : n_out1) = i_out1(1 : n_out1) + n_out1
	+ i_out2(1 : n_out1) = i_out1(1 : n_out1)
	i_out2(n_out2) = n_tot

	new_particle_set%n_beam = n_beam2
	new_particle_set%n_in = n_in2
	- new_particle_set%n_vir = n_virt2
	+ new_particle_set%n_vir = n_virt2 + n_res2
	new_particle_set%n_out = n_out2
	new_particle_set%n_tot = n_tot
	new_particle_set%correlated_state = particle_set%correlated_state
	allocate (new_particle_set%prt (n_tot))
	if (size (i_beam1) > 0) new_particle_set%prt(i_beam2) = particle_set%prt(i_beam1)
	if (size (i_remnant1) > 0) new_particle_set%prt(i_remnant2) = particle_set%prt(i_remnant1)
	+ if (size (i_res1) > 0) new_particle_set%prt(i_res2) = particle_set%prt(i_res1)
	do i = 1, n_virt1
	new_particle_set%prt(i_virt2(i)) = particle_set%prt(i_virt1(i))
	end do

	- do i = n_virt1 + 1, n_virt2
	- new_particle_set%prt(i_virt2(i)) = particle_set%prt(i_out1(i - n_virt1))
	- call new_particle_set%prt(i_virt2(i))%reset_status (PRT_VIRTUAL)
	- end do
	-
	do i = 1, n_in2
	new_particle_set%prt(i_in2(i)) = particle_set%prt(i_in1(i))
	new_particle_set%prt(i_in2(i))%p = p_radiated (i)
	end do

	do i = 1, n_out2 - 1
	new_particle_set%prt(i_out2(i)) = particle_set%prt(i_out1(i))
	new_particle_set%prt(i_out2(i))%p = p_radiated(i + n_in2)
	call new_particle_set%prt(i_out2(i))%reset_status (PRT_OUTGOING)
	end do

	call new_particle%reset_status (PRT_OUTGOING)
	call new_particle%set_momentum (p_radiated (n_in2 + n_out2))

	!!! Helicity and polarization handling is missing at this point
	!!! Also, no helicities or polarizations yet
	pdg_index_emitter = flv_radiated (emitter)
	pdg_index_radiation = flv_radiated (n_in2 + n_out2)
	call new_flv%init (pdg_index_radiation, model)
	is_fsr = emitter > n_in1
	if (is_fsr) then
	- i_emitter = emitter + n_virt2 + n_remnant2 + n_beam2
	+ i_emitter = emitter + n_virt2 + n_res2 + n_remnant2 + n_beam2
	else
	i_emitter = emitter + n_beam2
	end if

	call real_emitter_flavor%init (pdg_index_emitter, model)
	call new_particle_set%prt(i_emitter)%set_flavor(real_emitter_flavor)

	+ new_color_index = 0
	+ do i = 1, n_tot - 1
	+ new_color_index = max(maxval(abs(particle_set%prt(i)%get_color())), new_color_index)
	+ end do
	+ new_color_index = new_color_index + 1
	call reassign_colors (new_particle, new_particle_set%prt(i_emitter), &
	- pdg_index_radiation, pdg_index_emitter, is_fsr, r_color)
	+ pdg_index_radiation, pdg_index_emitter, new_color_index, is_fsr, r_color)

	call new_particle%set_flavor (new_flv)
	new_particle_set%prt(n_tot) = new_particle

	- allocate (children (n_out2))
	- children = i_out2
	- do i = n_in2 + n_beam2 + n_remnant2 + n_virt1 + 1, n_in2 + n_beam2 + n_remnant2 + n_virt2
	- call new_particle_set%prt(i)%set_children (children)
	- end do
	-
	!!! Set proper parents for outgoing particles
	- allocate (parents (n_out1))
	- parents = i_out1
	- do i = n_in2 + n_beam2 + n_remnant2 + n_virt2 + 1, n_tot
	- call new_particle_set%prt(i)%set_parents (parents)
	+ if (is_fsr) then
	+ call new_particle_set%prt(n_tot)%set_parents ( &
	+ new_particle_set%prt(i_emitter)%get_parents ())
	+ else
	+ call new_particle_set%prt(n_tot)%set_parents (i_in2)
	+ end if
	+
	+ do i = n_in2 + n_beam2 + n_remnant2 + n_virt1 + 1, &
	+ n_in2 + n_beam2 + n_remnant2 + n_virt2 + n_res2
	+ allocate(children(0))
	+ mom_sum_children = vector4_null
	+ do j = n_in2 + n_beam2 + n_remnant2, n_tot
	+ if (any(new_particle_set%prt(j)%get_parents() == i)) then
	+ children = [children, j]
	+ if (new_particle_set%prt(j)%get_status () == PRT_OUTGOING) then
	+ mom_sum_children = mom_sum_children &
	+ + new_particle_set%prt(j)%get_momentum ()
	+ end if
	+ end if
	+ end do
	+ call new_particle_set%prt(i)%set_children (children)
	+ if (mom_sum_children /= vector4_null) then
	+ call new_particle_set%set_momentum (i, mom_sum_children)
	+ end if
	+ deallocate(children)
	end do
	call particle_set%init (new_particle_set)
	contains

	<<build radiation: set color offset>>
	- subroutine reassign_colors (prt_radiated, prt_emitter, flv_rad, flv_em, is_fsr, r_col)
	+ subroutine reassign_colors (prt_radiated, prt_emitter, flv_rad, flv_em, &
	+ new_color_index, is_fsr, r_col)
	type(particle_t), intent(inout) :: prt_radiated, prt_emitter
	- integer, intent(in) :: flv_rad, flv_em
	+ integer, intent(in) :: flv_rad, flv_em, new_color_index
	logical, intent(in) :: is_fsr
	real(default), intent(in) :: r_col
	type(color_t) :: col_rad, col_em
	if (is_fsr) then
	if (is_quark (flv_em) .and. is_gluon (flv_rad)) then
	- call reassign_colors_q_to_qg_fsr (prt_emitter, col_rad, col_em)
	+ call reassign_colors_q_to_qg_fsr (prt_emitter, new_color_index, col_rad, col_em)
	else if (is_gluon (flv_em) .and. is_gluon (flv_rad)) then
	- call reassign_colors_g_to_gg_fsr (prt_emitter, r_col, col_rad, col_em)
	+ call reassign_colors_g_to_gg_fsr (prt_emitter, r_col, new_color_index, col_rad, col_em)
	else if (is_quark (flv_em) .and. is_quark (flv_rad)) then
	call reassign_colors_g_to_qq_fsr (prt_emitter, flv_em, col_rad, col_em)
	else
	call msg_fatal ("reassign_colors: invalid splitting")
	end if
	else
	if (is_quark (flv_em) .and. is_gluon (flv_rad)) then
	- call reassign_colors_q_to_qg_isr (prt_emitter, col_rad, col_em)
	+ call reassign_colors_q_to_qg_isr (prt_emitter, new_color_index, col_rad, col_em)
	else if (is_quark (flv_em) .and. is_quark (flv_rad)) then
	call reassign_colors_g_to_qq_isr (prt_emitter, flv_rad, col_rad, col_em)
	else if (is_gluon (flv_em) .and. is_quark (flv_rad)) then
	- call reassign_colors_q_to_gq_isr (prt_emitter, col_rad, col_em)
	+ call reassign_colors_q_to_gq_isr (prt_emitter, flv_rad, new_color_index, col_rad, col_em)
	else if (is_gluon (flv_em) .and. is_gluon (flv_rad)) then
	- call reassign_colors_g_to_gg_isr (prt_emitter, r_col, col_rad, col_em)
	+ call reassign_colors_g_to_gg_isr (prt_emitter, r_col, new_color_index, col_rad, col_em)
	else
	call msg_fatal ("reassign_colors: invalid splitting")
	end if
	end if
	call prt_emitter%set_color (col_em)
	call prt_radiated%set_color (col_rad)
	end subroutine reassign_colors

	- subroutine reassign_colors_q_to_qg_fsr (prt_emitter, col_rad, col_em)
	+ subroutine reassign_colors_q_to_qg_fsr (prt_emitter, new_color_index, &
	+ col_rad, col_em)
	type(particle_t), intent(in) :: prt_emitter
	+ integer, intent(in) :: new_color_index
	type(color_t), intent(out) :: col_rad, col_em
	integer, dimension(2) :: color_rad, color_em
	integer :: i1, i2
	- integer :: new_color_index
	logical :: is_anti_quark

	color_em = prt_emitter%get_color ()
	i1 = 1; i2 = 2
	is_anti_quark = color_em(2) /= 0
	if (is_anti_quark) then
	i1 = 2; i2 = 1
	end if
	- new_color_index = color_em(i1)+1
	color_rad(i1) = color_em(i1)
	color_rad(i2) = new_color_index
	color_em(i1) = new_color_index
	call col_em%init_col_acl (color_em(1), color_em(2))
	call col_rad%init_col_acl (color_rad(1), color_rad(2))
	end subroutine reassign_colors_q_to_qg_fsr

	- subroutine reassign_colors_g_to_gg_fsr (prt_emitter, random, col_rad, col_em)
	+ subroutine reassign_colors_g_to_gg_fsr (prt_emitter, random, new_color_index, &
	+ col_rad, col_em)
	type(particle_t), intent(in) :: prt_emitter
	real(default), intent(in) :: random
	+ integer, intent(in) :: new_color_index
	type(color_t), intent(out) :: col_rad, col_em
	integer, dimension(2) :: color_rad, color_em
	integer :: i1, i2
	- integer :: new_color_index

	color_em = prt_emitter%get_color ()
	- new_color_index = maxval (abs (color_em))+1
	i1 = 1; i2 = 2
	if (random < 0.5) then
	i1 = 2; i2 = 1
	end if
	color_rad(i1) = new_color_index
	color_rad(i2) = color_em(i2)
	color_em(i2) = new_color_index
	call col_em%init_col_acl (color_em(1), color_em(2))
	call col_rad%init_col_acl (color_rad(1), color_rad(2))
	end subroutine reassign_colors_g_to_gg_fsr

	subroutine reassign_colors_g_to_qq_fsr (prt_emitter, pdg_emitter, col_rad, col_em)
	type(particle_t), intent(in) :: prt_emitter
	integer, intent(in) :: pdg_emitter
	type(color_t), intent(out) :: col_rad, col_em
	integer, dimension(2) :: color_rad, color_em
	integer :: i1, i2
	logical :: is_anti_quark

	color_em = prt_emitter%get_color ()
	i1 = 1; i2 = 2
	is_anti_quark = pdg_emitter < 0
	if (is_anti_quark) then
	i1 = 2; i1 = 1
	end if
	color_em(i2) = 0
	color_rad(i1) = 0
	color_rad(i2) = color_em(i1)
	call col_em%init_col_acl (color_em(1), color_em(2))
	call col_rad%init_col_acl (color_rad(1), color_rad(2))
	end subroutine reassign_colors_g_to_qq_fsr

	- subroutine reassign_colors_q_to_qg_isr (prt_emitter, col_rad, col_em)
	+ subroutine reassign_colors_q_to_qg_isr (prt_emitter, new_color_index, &
	+ col_rad, col_em)
	type(particle_t), intent(in) :: prt_emitter
	+ integer, intent(in) :: new_color_index
	type(color_t), intent(out) :: col_rad, col_em
	integer, dimension(2) :: color_rad, color_em
	integer :: i1, i2
	- integer :: new_color_index
	logical :: is_anti_quark

	color_em = prt_emitter%get_color ()
	i1 = 1; i2 = 2
	is_anti_quark = color_em(2) /= 0
	if (is_anti_quark) then
	i1 = 2; i2 = 1
	end if
	- new_color_index = color_em(i1)+1
	color_rad(i2) = color_em(i1)
	color_rad(i1) = new_color_index
	color_em(i1) = new_color_index
	call col_em%init_col_acl (color_em(1), color_em(2))
	call col_rad%init_col_acl (color_rad(1), color_rad(2))
	end subroutine reassign_colors_q_to_qg_isr

	subroutine reassign_colors_g_to_qq_isr (prt_emitter, pdg_rad, col_rad, col_em)
	type(particle_t), intent(in) :: prt_emitter
	integer, intent(in) :: pdg_rad
	type(color_t), intent(out) :: col_rad, col_em
	integer, dimension(2) :: color_rad, color_em
	integer :: i1, i2
	logical :: is_anti_quark

	color_em = prt_emitter%get_color ()
	i1 = 1; i2 = 2
	is_anti_quark = pdg_rad < 0
	if (is_anti_quark) then
	- i1 = 2; i1 = 1
	+ i1 = 2; i2 = 1
	end if
	color_rad(i1) = color_em(i2)
	color_rad(i2) = 0
	color_em(i2) = 0
	call col_em%init_col_acl (color_em(1), color_em(2))
	call col_rad%init_col_acl (color_rad(1), color_rad(2))
	end subroutine reassign_colors_g_to_qq_isr

	- subroutine reassign_colors_q_to_gq_isr (prt_emitter, col_rad, col_em)
	+ subroutine reassign_colors_q_to_gq_isr (prt_emitter, pdg_rad, new_color_index, &
	+ col_rad, col_em)
	type(particle_t), intent(in) :: prt_emitter
	+ integer, intent(in) :: pdg_rad, new_color_index
	type(color_t), intent(out) :: col_rad, col_em
	integer, dimension(2) :: color_rad, color_em
	integer :: i1, i2
	- integer :: new_color_index
	- logical :: is_anti_quark
	+ logical :: rad_is_quark

	color_em = prt_emitter%get_color ()
	i1 = 1; i2 = 2
	- is_anti_quark = color_em(2) /= 0
	- if (is_anti_quark) then
	+ rad_is_quark = pdg_rad > 0
	+ if (rad_is_quark) then
	i1 = 2; i2 = 1
	end if
	- new_color_index = color_em(i1)+1
	color_rad(i1) = 0
	color_rad(i2) = new_color_index
	color_em(i2) = new_color_index
	call col_em%init_col_acl (color_em(1), color_em(2))
	call col_rad%init_col_acl (color_rad(1), color_rad(2))
	end subroutine reassign_colors_q_to_gq_isr

	- subroutine reassign_colors_g_to_gg_isr (prt_emitter, random, col_rad, col_em)
	+ subroutine reassign_colors_g_to_gg_isr (prt_emitter, random, new_color_index, &
	+ col_rad, col_em)
	type(particle_t), intent(in) :: prt_emitter
	real(default), intent(in) :: random
	+ integer, intent(in) :: new_color_index
	type(color_t), intent(out) :: col_rad, col_em
	integer, dimension(2) :: color_rad, color_em
	integer :: i1, i2
	- integer :: new_color_index

	color_em = prt_emitter%get_color ()
	- new_color_index = maxval (abs (color_em))+1
	i1 = 1; i2 = 2
	if (random < 0.5) then
	i1 = 2; i2 = 1
	end if
	color_rad(i2) = new_color_index
	color_rad(i1) = color_em(i2)
	color_em(i2) = new_color_index
	call col_em%init_col_acl (color_em(1), color_em(2))
	call col_rad%init_col_acl (color_rad(1), color_rad(2))
	end subroutine reassign_colors_g_to_gg_isr
	end subroutine particle_set_build_radiation

	@ %def particle_set_build_radiation
	@ Increments the color indices of all particles by their maximal value to distinguish them
	from the record-keeping Born particles in the LHE-output if the virtual entries are kept.
	<<build radiation: set color offset>>=
	subroutine set_color_offset (particle_set)
	type(particle_set_t), intent(inout) :: particle_set
	integer, dimension(2) :: color
	integer :: i, i_color_max
	type(color_t) :: new_color

	i_color_max = 0
	do i = 1, size (particle_set%prt)
	associate (prt => particle_set%prt(i))
	if (prt%get_status () <= PRT_INCOMING) cycle
	color = prt%get_color ()
	i_color_max = maxval([i_color_max, color(1), color(2)])
	end associate
	end do


	do i = 1, size (particle_set%prt)
	associate (prt => particle_set%prt(i))
	if (prt%get_status () /= PRT_OUTGOING) cycle
	color = prt%get_color ()
	where (color /= 0) color = color + i_color_max
	call new_color%init_col_acl (color(1), color(2))
	call prt%set_color (new_color)
	end associate
	end do
	end subroutine set_color_offset

	@ %def set_color_offset
	@ Output (default format)
	<<Particles: particle set: TBP>>=
	procedure :: write => particle_set_write
	<<Particles: sub interfaces>>=
	module subroutine particle_set_write &
	(particle_set, unit, testflag, summary, compressed)
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag, summary, compressed
	end subroutine particle_set_write
	<<Particles: procedures>>=
	module subroutine particle_set_write &
	(particle_set, unit, testflag, summary, compressed)
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag, summary, compressed
	logical :: summ, comp, pol
	type(vector4_t) :: sum_vec
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	summ = .false.; if (present (summary)) summ = summary
	comp = .false.; if (present (compressed)) comp = compressed
	pol = particle_set%factorization_mode /= FM_IGNORE_HELICITY
	write (u, "(1x,A)") "Particle set:"
	call write_separator (u)
	if (comp) then
	if (pol) then
	write (u, &
	"((A4,1X),(A6,1X),(A7,1X),(A3),2(A4,1X),2(A20,1X),5(A12,1X))") &
	"Nr", "Status", "Flavor", "Hel", "Col", "ACol", &
	"Parents", "Children", &
	"P(0)", "P(1)", "P(2)", "P(3)", "P^2"
	else
	write (u, &
	"((A4,1X),(A6,1X),(A7,1X),2(A4,1X),2(A20,1X),5(A12,1X))") &
	"Nr", "Status", "Flavor", "Col", "ACol", &
	"Parents", "Children", &
	"P(0)", "P(1)", "P(2)", "P(3)", "P^2"
	end if
	end if
	if (particle_set%n_tot /= 0) then
	do i = 1, particle_set%n_tot
	if (comp) then
	write (u, "(I4,1X,2X)", advance="no") i
	else
	write (u, "(1x,A,1x,I0)", advance="no") "Particle", i
	end if
	call particle_set%prt(i)%write (u, testflag = testflag, &
	compressed = comp, polarization = pol)
	end do
	if (particle_set%correlated_state%is_defined ()) then
	call write_separator (u)
	write (u, *) "Correlated state density matrix:"
	call particle_set%correlated_state%write (u)
	end if
	if (summ) then
	call write_separator (u)
	write (u, "(A)", advance="no") &
	"Sum of incoming momenta: p(0:3) = "
	sum_vec = sum (particle_set%prt%p, &
	mask=particle_set%prt%get_status () == PRT_INCOMING)
	call pacify (sum_vec, tolerance = 1E-3_default)
	call sum_vec%write (u, compressed=.true.)
	write (u, *)
	write (u, "(A)", advance="no") &
	"Sum of beam remnant momenta: p(0:3) = "
	sum_vec = sum (particle_set%prt%p, &
	mask=particle_set%prt%get_status () == PRT_BEAM_REMNANT)
	call pacify (sum_vec, tolerance = 1E-3_default)
	call sum_vec%write (u, compressed=.true.)
	write (u, *)
	write (u, "(A)", advance="no") &
	"Sum of outgoing momenta: p(0:3) = "
	sum_vec = sum (particle_set%prt%p, &
	mask=particle_set%prt%get_status () == PRT_OUTGOING)
	call pacify (sum_vec, tolerance = 1E-3_default)
	call sum_vec%write (u, compressed=.true.)
	write (u, "(A)") ""
	end if
	else
	write (u, "(3x,A)") "[empty]"
	end if
	end subroutine particle_set_write

	@ %def particle_set_write
	@
	\subsection{I/O formats}
	Here, we define input/output of particle sets in various formats.
	This is the right place since particle sets contain most of the event
	information.

	All write/read routines take as first argument the object, as second
	argument the I/O unit which in this case is a mandatory argument.
	Then follow further event data.

	\subsubsection{Internal binary format}
	This format is supposed to contain the complete information, so
	the particle data set can be fully reconstructed. The exception is
	the model part of the particle flavors; this is unassigned for the
	flavor values read from file.
	<<Particles: particle set: TBP>>=
	procedure :: write_raw => particle_set_write_raw
	procedure :: read_raw => particle_set_read_raw
	<<Particles: sub interfaces>>=
	module subroutine particle_set_write_raw (particle_set, u)
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in) :: u
	end subroutine particle_set_write_raw
	module subroutine particle_set_read_raw (particle_set, u, iostat)
	class(particle_set_t), intent(out) :: particle_set
	integer, intent(in) :: u
	integer, intent(out) :: iostat
	end subroutine particle_set_read_raw
	<<Particles: procedures>>=
	module subroutine particle_set_write_raw (particle_set, u)
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in) :: u
	integer :: i
	write (u) &
	particle_set%n_beam, particle_set%n_in, &
	particle_set%n_vir, particle_set%n_out
	write (u) particle_set%factorization_mode
	write (u) particle_set%n_tot
	do i = 1, particle_set%n_tot
	call particle_set%prt(i)%write_raw (u)
	end do
	call particle_set%correlated_state%write_raw (u)
	end subroutine particle_set_write_raw

	module subroutine particle_set_read_raw (particle_set, u, iostat)
	class(particle_set_t), intent(out) :: particle_set
	integer, intent(in) :: u
	integer, intent(out) :: iostat
	integer :: i
	read (u, iostat=iostat) &
	particle_set%n_beam, particle_set%n_in, &
	particle_set%n_vir, particle_set%n_out
	read (u, iostat=iostat) particle_set%factorization_mode
	read (u, iostat=iostat) particle_set%n_tot
	allocate (particle_set%prt (particle_set%n_tot))
	do i = 1, size (particle_set%prt)
	call particle_set%prt(i)%read_raw (u, iostat=iostat)
	end do
	call particle_set%correlated_state%read_raw (u, iostat=iostat)
	end subroutine particle_set_read_raw

	@ %def particle_set_write_raw particle_set_read_raw
	@
	\subsubsection{Get contents}
	Find parents/children of a particular particle recursively; the
	search terminates if a parent/child has status [[BEAM]], [[INCOMING]],
	[[OUTGOING]] or [[RESONANT]].
	<<Particles: particle set: TBP>>=
	procedure :: get_real_parents => particle_set_get_real_parents
	procedure :: get_real_children => particle_set_get_real_children
	<<Particles: sub interfaces>>=
	module function particle_set_get_real_parents (pset, i, keep_beams) result (parent)
	integer, dimension(:), allocatable :: parent
	class(particle_set_t), intent(in) :: pset
	integer, intent(in) :: i
	logical, intent(in), optional :: keep_beams
	end function particle_set_get_real_parents
	module function particle_set_get_real_children (pset, i, keep_beams) result (child)
	integer, dimension(:), allocatable :: child
	class(particle_set_t), intent(in) :: pset
	integer, intent(in) :: i
	logical, intent(in), optional :: keep_beams
	end function particle_set_get_real_children
	<<Particles: procedures>>=
	module function particle_set_get_real_parents (pset, i, keep_beams) result (parent)
	integer, dimension(:), allocatable :: parent
	class(particle_set_t), intent(in) :: pset
	integer, intent(in) :: i
	logical, intent(in), optional :: keep_beams
	logical, dimension(:), allocatable :: is_real
	logical, dimension(:), allocatable :: is_parent, is_real_parent
	logical :: kb
	integer :: j, k
	kb = .false.
	if (present (keep_beams)) kb = keep_beams
	allocate (is_real (pset%n_tot))
	is_real = pset%prt%is_real (kb)
	allocate (is_parent (pset%n_tot), is_real_parent (pset%n_tot))
	is_real_parent = .false.
	is_parent = .false.
	is_parent(pset%prt(i)%get_parents()) = .true.
	do while (any (is_parent))
	where (is_real .and. is_parent)
	is_real_parent = .true.
	is_parent = .false.
	end where
	mark_next_parent: do j = size (is_parent), 1, -1
	if (is_parent(j)) then
	is_parent(pset%prt(j)%get_parents()) = .true.
	is_parent(j) = .false.
	exit mark_next_parent
	end if
	end do mark_next_parent
	end do
	allocate (parent (count (is_real_parent)))
	j = 0
	do k = 1, size (is_parent)
	if (is_real_parent(k)) then
	j = j + 1
	parent(j) = k
	end if
	end do
	end function particle_set_get_real_parents

	module function particle_set_get_real_children (pset, i, keep_beams) result (child)
	integer, dimension(:), allocatable :: child
	class(particle_set_t), intent(in) :: pset
	integer, intent(in) :: i
	logical, dimension(:), allocatable :: is_real
	logical, dimension(:), allocatable :: is_child, is_real_child
	logical, intent(in), optional :: keep_beams
	integer :: j, k
	logical :: kb
	kb = .false.
	if (present (keep_beams)) kb = keep_beams
	allocate (is_real (pset%n_tot))
	is_real = pset%prt%is_real (kb)
	is_real = pset%prt%is_real (kb)
	allocate (is_child (pset%n_tot), is_real_child (pset%n_tot))
	is_real_child = .false.
	is_child = .false.
	is_child(pset%prt(i)%get_children()) = .true.
	do while (any (is_child))
	where (is_real .and. is_child)
	is_real_child = .true.
	is_child = .false.
	end where
	mark_next_child: do j = 1, size (is_child)
	if (is_child(j)) then
	is_child(pset%prt(j)%get_children()) = .true.
	is_child(j) = .false.
	exit mark_next_child
	end if
	end do mark_next_child
	end do
	allocate (child (count (is_real_child)))
	j = 0
	do k = 1, size (is_child)
	if (is_real_child(k)) then
	j = j + 1
	child(j) = k
	end if
	end do
	end function particle_set_get_real_children

	@ %def particle_set_get_real_parents
	@ %def particle_set_get_real_children
	@ Get the [[n_tot]], [[n_in]], and [[n_out]] values out of the
	particle set.
	<<Particles: particle set: TBP>>=
	procedure :: get_n_beam => particle_set_get_n_beam
	procedure :: get_n_in => particle_set_get_n_in
	procedure :: get_n_vir => particle_set_get_n_vir
	procedure :: get_n_out => particle_set_get_n_out
	procedure :: get_n_tot => particle_set_get_n_tot
	procedure :: get_n_remnants => particle_set_get_n_remnants
	<<Particles: sub interfaces>>=
	module function particle_set_get_n_beam (pset) result (n_beam)
	class(particle_set_t), intent(in) :: pset
	integer :: n_beam
	end function particle_set_get_n_beam
	module function particle_set_get_n_in (pset) result (n_in)
	class(particle_set_t), intent(in) :: pset
	integer :: n_in
	end function particle_set_get_n_in
	module function particle_set_get_n_vir (pset) result (n_vir)
	class(particle_set_t), intent(in) :: pset
	integer :: n_vir
	end function particle_set_get_n_vir
	module function particle_set_get_n_out (pset) result (n_out)
	class(particle_set_t), intent(in) :: pset
	integer :: n_out
	end function particle_set_get_n_out
	module function particle_set_get_n_tot (pset) result (n_tot)
	class(particle_set_t), intent(in) :: pset
	integer :: n_tot
	end function particle_set_get_n_tot
	module function particle_set_get_n_remnants (pset) result (n_remn)
	class(particle_set_t), intent(in) :: pset
	integer :: n_remn
	end function particle_set_get_n_remnants
	<<Particles: procedures>>=
	module function particle_set_get_n_beam (pset) result (n_beam)
	class(particle_set_t), intent(in) :: pset
	integer :: n_beam
	n_beam = pset%n_beam
	end function particle_set_get_n_beam

	module function particle_set_get_n_in (pset) result (n_in)
	class(particle_set_t), intent(in) :: pset
	integer :: n_in
	n_in = pset%n_in
	end function particle_set_get_n_in

	module function particle_set_get_n_vir (pset) result (n_vir)
	class(particle_set_t), intent(in) :: pset
	integer :: n_vir
	n_vir = pset%n_vir
	end function particle_set_get_n_vir

	module function particle_set_get_n_out (pset) result (n_out)
	class(particle_set_t), intent(in) :: pset
	integer :: n_out
	n_out = pset%n_out
	end function particle_set_get_n_out

	module function particle_set_get_n_tot (pset) result (n_tot)
	class(particle_set_t), intent(in) :: pset
	integer :: n_tot
	n_tot = pset%n_tot
	end function particle_set_get_n_tot

	module function particle_set_get_n_remnants (pset) result (n_remn)
	class(particle_set_t), intent(in) :: pset
	integer :: n_remn
	if (allocated (pset%prt)) then
	n_remn = count (pset%prt%get_status () == PRT_BEAM_REMNANT)
	else
	n_remn = 0
	end if
	end function particle_set_get_n_remnants

	@ %def particle_set_get_n_beam
	@ %def particle_set_get_n_in
	@ %def particle_set_get_n_vir
	@ %def particle_set_get_n_out
	@ %def particle_set_get_n_tot
	@ %def particle_set_get_n_remnants
	@ Return a pointer to the particle corresponding to the number
	<<Particles: particle set: TBP>>=
	procedure :: get_particle => particle_set_get_particle
	<<Particles: sub interfaces>>=
	module function particle_set_get_particle (pset, index) result (particle)
	class(particle_set_t), intent(in) :: pset
	integer, intent(in) :: index
	type(particle_t) :: particle
	end function particle_set_get_particle
	<<Particles: procedures>>=
	module function particle_set_get_particle (pset, index) result (particle)
	class(particle_set_t), intent(in) :: pset
	integer, intent(in) :: index
	type(particle_t) :: particle
	particle = pset%prt(index)
	end function particle_set_get_particle

	@ %def particle_set_get_particle
	@
	<<Particles: particle set: TBP>>=
	procedure :: get_indices => particle_set_get_indices
	<<Particles: sub interfaces>>=
	pure module function particle_set_get_indices (pset, mask) result (finals)
	integer, dimension(:), allocatable :: finals
	class(particle_set_t), intent(in) :: pset
	logical, dimension(:), intent(in) :: mask
	end function particle_set_get_indices
	<<Particles: procedures>>=
	pure module function particle_set_get_indices (pset, mask) result (finals)
	integer, dimension(:), allocatable :: finals
	class(particle_set_t), intent(in) :: pset
	logical, dimension(:), intent(in) :: mask
	integer, dimension(size(mask)) :: indices
	integer :: i
	allocate (finals (count (mask)))
	indices = [(i, i=1, pset%n_tot)]
	finals = pack (indices, mask)
	end function particle_set_get_indices

	@ %def particle_set_get_indices
	@ Copy the subset of physical momenta to a [[phs_point]] container.
	<<Particles: particle set: TBP>>=
	procedure :: get_in_and_out_momenta => particle_set_get_in_and_out_momenta
	<<Particles: sub interfaces>>=
	module function particle_set_get_in_and_out_momenta (pset) result (phs_point)
	type(phs_point_t) :: phs_point
	class(particle_set_t), intent(in) :: pset
	end function particle_set_get_in_and_out_momenta
	<<Particles: procedures>>=
	module function particle_set_get_in_and_out_momenta (pset) result (phs_point)
	type(phs_point_t) :: phs_point
	class(particle_set_t), intent(in) :: pset
	logical, dimension(:), allocatable :: mask
	integer, dimension(:), allocatable :: indices
	type(vector4_t), dimension(:), allocatable :: p
	allocate (mask (pset%get_n_tot ()))
	allocate (p (size (pset%prt)))
	mask = pset%prt%status == PRT_INCOMING .or. &
	pset%prt%status == PRT_OUTGOING
	allocate (indices (count (mask)))
	indices = pset%get_indices (mask)
	phs_point = pset%get_momenta (indices)
	end function particle_set_get_in_and_out_momenta

	@ %def particle_set_get_in_and_out_momenta
	@
	\subsubsection{Tools}
	Build a new particles array without hadronic remnants but with
	[[n_extra]] additional spots. We also update the mother-daughter
	relations assuming the ordering [[b]], [[i]], [[r]], [[x]], [[o]].
	<<Particles: particle set: TBP>>=
	procedure :: without_hadronic_remnants => &
	particle_set_without_hadronic_remnants
	<<Particles: sub interfaces>>=
	module subroutine particle_set_without_hadronic_remnants &
	(particle_set, particles, n_particles, n_extra)
	class(particle_set_t), intent(inout) :: particle_set
	type(particle_t), dimension(:), allocatable, intent(out) :: particles
	integer, intent(out) :: n_particles
	integer, intent(in) :: n_extra
	end subroutine particle_set_without_hadronic_remnants
	<<Particles: procedures>>=
	module subroutine particle_set_without_hadronic_remnants &
	(particle_set, particles, n_particles, n_extra)
	class(particle_set_t), intent(inout) :: particle_set
	type(particle_t), dimension(:), allocatable, intent(out) :: particles
	integer, intent(out) :: n_particles
	integer, intent(in) :: n_extra
	logical, dimension(:), allocatable :: no_hadronic_remnants, &
	no_hadronic_children
	integer, dimension(:), allocatable :: children, new_children
	integer :: i, j, k, first_remnant
	first_remnant = particle_set%n_tot
	do i = 1, particle_set%n_tot
	if (particle_set%prt(i)%is_hadronic_beam_remnant ()) then
	first_remnant = i
	exit
	end if
	end do
	n_particles = count (.not. particle_set%prt%is_hadronic_beam_remnant ())
	allocate (no_hadronic_remnants (particle_set%n_tot))
	no_hadronic_remnants = .not. particle_set%prt%is_hadronic_beam_remnant ()
	allocate (particles (n_particles + n_extra))
	k = 1
	do i = 1, particle_set%n_tot
	if (no_hadronic_remnants(i)) then
	particles(k) = particle_set%prt(i)
	k = k + 1
	end if
	end do
	if (n_particles /= particle_set%n_tot) then
	do i = 1, n_particles
	select case (particles(i)%get_status ())
	case (PRT_BEAM)
	if (allocated (children)) deallocate (children)
	allocate (children (particles(i)%get_n_children ()))
	children = particles(i)%get_children ()
	if (allocated (no_hadronic_children)) &
	deallocate (no_hadronic_children)
	allocate (no_hadronic_children (particles(i)%get_n_children ()))
	no_hadronic_children = .not. &
	particle_set%prt(children)%is_hadronic_beam_remnant ()
	if (allocated (new_children)) deallocate (new_children)
	allocate (new_children (count (no_hadronic_children)))
	new_children = pack (children, no_hadronic_children)
	call particles(i)%set_children (new_children)
	case (PRT_INCOMING, PRT_RESONANT)
	<<update children after remnant>>
	case (PRT_OUTGOING, PRT_BEAM_REMNANT)
	case default
	end select
	end do
	end if
	end subroutine particle_set_without_hadronic_remnants

	@ %def particle_set_without_hadronic_remnants
	<<update children after remnant>>=
	if (allocated (children)) deallocate (children)
	allocate (children (particles(i)%get_n_children ()))
	children = particles(i)%get_children ()
	do j = 1, size (children)
	if (children(j) > first_remnant) then
	children(j) = children (j) - &
	(particle_set%n_tot - n_particles)
	end if
	end do
	call particles(i)%set_children (children)
	@
	Build a new particles array without remnants but with
	[[n_extra]] additional spots. We also update the mother-daughter
	relations assuming the ordering [[b]], [[i]], [[r]], [[x]], [[o]].
	<<Particles: particle set: TBP>>=
	procedure :: without_remnants => particle_set_without_remnants
	<<Particles: sub interfaces>>=
	module subroutine particle_set_without_remnants &
	(particle_set, particles, n_particles, n_extra)
	class(particle_set_t), intent(inout) :: particle_set
	type(particle_t), dimension(:), allocatable, intent(out) :: particles
	integer, intent(in) :: n_extra
	integer, intent(out) :: n_particles
	end subroutine particle_set_without_remnants
	<<Particles: procedures>>=
	module subroutine particle_set_without_remnants &
	(particle_set, particles, n_particles, n_extra)
	class(particle_set_t), intent(inout) :: particle_set
	type(particle_t), dimension(:), allocatable, intent(out) :: particles
	integer, intent(in) :: n_extra
	integer, intent(out) :: n_particles
	logical, dimension(:), allocatable :: no_remnants, no_children
	integer, dimension(:), allocatable :: children, new_children
	integer :: i,j, k, first_remnant
	first_remnant = particle_set%n_tot
	do i = 1, particle_set%n_tot
	if (particle_set%prt(i)%is_beam_remnant ()) then
	first_remnant = i
	exit
	end if
	end do
	allocate (no_remnants (particle_set%n_tot))
	no_remnants = .not. (particle_set%prt%is_beam_remnant ())
	n_particles = count (no_remnants)
	allocate (particles (n_particles + n_extra))
	k = 1
	do i = 1, particle_set%n_tot
	if (no_remnants(i)) then
	particles(k) = particle_set%prt(i)
	k = k + 1
	end if
	end do
	if (n_particles /= particle_set%n_tot) then
	do i = 1, n_particles
	select case (particles(i)%get_status ())
	case (PRT_BEAM)
	if (allocated (children)) deallocate (children)
	allocate (children (particles(i)%get_n_children ()))
	children = particles(i)%get_children ()
	if (allocated (no_children)) deallocate (no_children)
	allocate (no_children (particles(i)%get_n_children ()))
	no_children = .not. (particle_set%prt(children)%is_beam_remnant ())
	if (allocated (new_children)) deallocate (new_children)
	allocate (new_children (count (no_children)))
	new_children = pack (children, no_children)
	call particles(i)%set_children (new_children)
	case (PRT_INCOMING, PRT_RESONANT)
	<<update children after remnant>>
	case (PRT_OUTGOING, PRT_BEAM_REMNANT)
	case default
	end select
	end do
	end if
	end subroutine particle_set_without_remnants

	@ %def particle_set_without_remnants
	@
	<<Particles: particle set: TBP>>=
	procedure :: find_particle => particle_set_find_particle
	<<Particles: sub interfaces>>=
	pure module function particle_set_find_particle (particle_set, pdg, &
	momentum, abs_smallness, rel_smallness) result (idx)
	integer :: idx
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: momentum
	real(default), intent(in), optional :: abs_smallness, rel_smallness
	end function particle_set_find_particle
	<<Particles: procedures>>=
	pure module function particle_set_find_particle (particle_set, pdg, &
	momentum, abs_smallness, rel_smallness) result (idx)
	integer :: idx
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: momentum
	real(default), intent(in), optional :: abs_smallness, rel_smallness
	integer :: i
	logical, dimension(0:3) :: equals
	idx = 0
	do i = 1, size (particle_set%prt)
	if (particle_set%prt(i)%flv%get_pdg () == pdg) then
	equals = nearly_equal (particle_set%prt(i)%p%p, momentum%p, &
	abs_smallness, rel_smallness)
	if (all (equals)) then
	idx = i
	return
	end if
	end if
	end do
	end function particle_set_find_particle

	@ %def particle_set_find_particle
	<<Particles: particle set: TBP>>=
	procedure :: reverse_find_particle => particle_set_reverse_find_particle
	<<Particles: sub interfaces>>=
	pure module function particle_set_reverse_find_particle &
	(particle_set, pdg, momentum, abs_smallness, rel_smallness) result (idx)
	integer :: idx
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: momentum
	real(default), intent(in), optional :: abs_smallness, rel_smallness
	end function particle_set_reverse_find_particle
	<<Particles: procedures>>=
	pure module function particle_set_reverse_find_particle &
	(particle_set, pdg, momentum, abs_smallness, rel_smallness) result (idx)
	integer :: idx
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: momentum
	real(default), intent(in), optional :: abs_smallness, rel_smallness
	integer :: i
	idx = 0
	do i = size (particle_set%prt), 1, -1
	if (particle_set%prt(i)%flv%get_pdg () == pdg) then
	if (all (nearly_equal (particle_set%prt(i)%p%p, momentum%p, &
	abs_smallness, rel_smallness))) then
	idx = i
	return
	end if
	end if
	end do
	end function particle_set_reverse_find_particle

	@ %def particle_set_reverse_find_particle
	@ This connects broken links of the form
	$\text{something} \to i \to \text{none or} j$ and
	$\text{none} \to j \to \text{something or none}$ where the particles $i$ and $j$
	are \emph{identical}. It also works if $i \to j$, directly, and thus
	removes duplicates. We are removing $j$ and connect the possible
	daughters to $i$.
	<<Particles: particle set: TBP>>=
	procedure :: remove_duplicates => particle_set_remove_duplicates
	<<Particles: sub interfaces>>=
	module subroutine particle_set_remove_duplicates (particle_set, smallness)
	class(particle_set_t), intent(inout) :: particle_set
	real(default), intent(in) :: smallness
	end subroutine particle_set_remove_duplicates
	<<Particles: procedures>>=
	module subroutine particle_set_remove_duplicates (particle_set, smallness)
	class(particle_set_t), intent(inout) :: particle_set
	real(default), intent(in) :: smallness
	integer :: n_removals
	integer, dimension(particle_set%n_tot) :: to_remove
	type(particle_t), dimension(:), allocatable :: particles
	type(vector4_t) :: p_i
	integer, dimension(:), allocatable :: map
	to_remove = 0
	call find_duplicates ()
	n_removals = count (to_remove > 0)
	if (n_removals > 0) then
	call strip_duplicates (particles)
	call particle_set%replace (particles)
	end if

	contains

	<<Particles: remove duplicates: procedures>>

	end subroutine particle_set_remove_duplicates

	@ %def particle_set_remove_duplicates
	@ This does not catch all cases. Missing are splittings of the type
	$i \to \text{something and} j$.
	<<Particles: remove duplicates: procedures>>=
	subroutine find_duplicates ()
	integer :: pdg_i, child_i, i, j
	OUTER: do i = 1, particle_set%n_tot
	if (particle_set%prt(i)%status == PRT_OUTGOING .or. &
	particle_set%prt(i)%status == PRT_VIRTUAL .or. &
	particle_set%prt(i)%status == PRT_RESONANT) then
	if (allocated (particle_set%prt(i)%child)) then
	if (size (particle_set%prt(i)%child) > 1) cycle OUTER
	if (size (particle_set%prt(i)%child) == 1) then
	child_i = particle_set%prt(i)%child(1)
	else
	child_i = 0
	end if
	else
	child_i = 0
	end if
	pdg_i = particle_set%prt(i)%flv%get_pdg ()
	p_i = particle_set%prt(i)%p
	do j = i + 1, particle_set%n_tot
	if (pdg_i == particle_set%prt(j)%flv%get_pdg ()) then
	if (all (nearly_equal (particle_set%prt(j)%p%p, p_i%p, &
	abs_smallness = smallness, &
	rel_smallness = 1E4_default * smallness))) then
	if (child_i == 0 .or. j == child_i) then
	to_remove(j) = i
	if (debug_on) call msg_debug2 (D_PARTICLES, &
	"Particles: Will remove duplicate of i", i)
	if (debug_on) call msg_debug2 (D_PARTICLES, &
	"Particles: j", j)
	end if
	cycle OUTER
	end if
	end if
	end do
	end if
	end do OUTER
	end subroutine find_duplicates

	@
	<<Particles: remove duplicates: procedures>>=
	recursive function get_alive_index (try) result (alive)
	integer :: alive
	integer :: try
	if (map(try) > 0) then
	alive = map(try)
	else
	alive = get_alive_index (to_remove(try))
	end if
	end function get_alive_index

	@
	<<Particles: remove duplicates: procedures>>=
	subroutine strip_duplicates (particles)
	type(particle_t), dimension(:), allocatable, intent(out) :: particles
	integer :: kept, removed, i, j
	integer, dimension(:), allocatable :: old_children
	logical, dimension(:), allocatable :: parent_set
	if (debug_on) call msg_debug (D_PARTICLES, "Particles: Removing duplicates")
	if (debug_on) call msg_debug (D_PARTICLES, "Particles: n_removals", n_removals)
	if (debug2_active (D_PARTICLES)) then
	call msg_debug2 (D_PARTICLES, "Particles: Given set before removing:")
	call particle_set%write (summary=.true., compressed=.true.)
	end if
	allocate (particles (particle_set%n_tot - n_removals))
	allocate (map (particle_set%n_tot))
	allocate (parent_set (particle_set%n_tot))
	parent_set = .false.
	map = 0
	j = 0
	do i = 1, particle_set%n_tot
	if (to_remove(i) == 0) then
	j = j + 1
	map(i) = j
	call particles(j)%init (particle_set%prt(i))
	end if
	end do
	do i = 1, particle_set%n_tot
	if (map(i) /= 0) then
	if (.not. parent_set(map(i))) then
	call particles(map(i))%set_parents &
	(map (particle_set%prt(i)%get_parents ()))
	end if
	call particles(map(i))%set_children &
	(map (particle_set%prt(i)%get_children ()))
	else
	removed = i
	kept = to_remove(i)
	if (particle_set%prt(removed)%has_children ()) then
	old_children = particle_set%prt(removed)%get_children ()
	do j = 1, size (old_children)
	if (map(old_children(j)) > 0) then
	call particles(map(old_children(j)))%set_parents &
	([get_alive_index (kept)])
	parent_set(map(old_children(j))) = .true.
	call particles(get_alive_index (kept))%add_child &
	(map(old_children(j)))
	end if
	end do
	particles(get_alive_index (kept))%status = PRT_RESONANT
	else
	particles(get_alive_index (kept))%status = PRT_OUTGOING
	end if
	end if
	end do
	end subroutine strip_duplicates

	@ Given a subevent, reset status codes. If the new status is beam,
	incoming, or outgoing, we also make sure that the stored $p^2$ value
	is equal to the on-shell mass squared.
	<<Particles: particle set: TBP>>=
	procedure :: reset_status => particle_set_reset_status
	<<Particles: sub interfaces>>=
	module subroutine particle_set_reset_status (particle_set, index, status)
	class(particle_set_t), intent(inout) :: particle_set
	integer, dimension(:), intent(in) :: index
	integer, intent(in) :: status
	end subroutine particle_set_reset_status
	<<Particles: procedures>>=
	module subroutine particle_set_reset_status (particle_set, index, status)
	class(particle_set_t), intent(inout) :: particle_set
	integer, dimension(:), intent(in) :: index
	integer, intent(in) :: status
	integer :: i
	if (allocated (particle_set%prt)) then
	do i = 1, size (index)
	call particle_set%prt(index(i))%reset_status (status)
	end do
	end if
	particle_set%n_beam = &
	count (particle_set%prt%get_status () == PRT_BEAM)
	particle_set%n_in = &
	count (particle_set%prt%get_status () == PRT_INCOMING)
	particle_set%n_out = &
	count (particle_set%prt%get_status () == PRT_OUTGOING)
	particle_set%n_vir = particle_set%n_tot &
	- particle_set%n_beam - particle_set%n_in - particle_set%n_out
	end subroutine particle_set_reset_status

	@ %def particle_set_reset_status
	@ Reduce a particle set to the essential entries. The entries kept
	are those with status [[INCOMING]], [[OUTGOING]] or
	[[RESONANT]]. [[BEAM]] is kept if [[keep_beams]] is true. Other
	entries are skipped. The correlated state matrix, if any, is also
	ignored.
	<<Particles: particle set: TBP>>=
	procedure :: reduce => particle_set_reduce
	<<Particles: sub interfaces>>=
	module subroutine particle_set_reduce (pset_in, pset_out, keep_beams)
	class(particle_set_t), intent(in) :: pset_in
	type(particle_set_t), intent(out) :: pset_out
	logical, intent(in), optional :: keep_beams
	end subroutine particle_set_reduce
	<<Particles: procedures>>=
	module subroutine particle_set_reduce (pset_in, pset_out, keep_beams)
	class(particle_set_t), intent(in) :: pset_in
	type(particle_set_t), intent(out) :: pset_out
	logical, intent(in), optional :: keep_beams
	integer, dimension(:), allocatable :: status, map
	integer :: i, j
	logical :: kb
	kb = .false.; if (present (keep_beams)) kb = keep_beams
	allocate (status (pset_in%n_tot))
	pset_out%factorization_mode = pset_in%factorization_mode
	status = pset_in%prt%get_status ()
	if (kb) pset_out%n_beam = count (status == PRT_BEAM)
	pset_out%n_in = count (status == PRT_INCOMING)
	pset_out%n_vir = count (status == PRT_RESONANT)
	pset_out%n_out = count (status == PRT_OUTGOING)
	pset_out%n_tot = &
	pset_out%n_beam + pset_out%n_in + pset_out%n_vir + pset_out%n_out
	allocate (pset_out%prt (pset_out%n_tot))
	allocate (map (pset_in%n_tot))
	map = 0
	j = 0
	if (kb) call copy_particles (PRT_BEAM)
	call copy_particles (PRT_INCOMING)
	call copy_particles (PRT_RESONANT)
	call copy_particles (PRT_OUTGOING)
	do i = 1, pset_in%n_tot
	if (map(i) == 0) cycle
	call pset_out%prt(map(i))%set_parents &
	(pset_in%get_real_parents (i, kb))
	call pset_out%prt(map(i))%set_parents &
	(map (pset_out%prt(map(i))%parent))
	call pset_out%prt(map(i))%set_children &
	(pset_in%get_real_children (i, kb))
	call pset_out%prt(map(i))%set_children &
	(map (pset_out%prt(map(i))%child))
	end do
	contains
	subroutine copy_particles (stat)
	integer, intent(in) :: stat
	integer :: i
	do i = 1, pset_in%n_tot
	if (status(i) == stat) then
	j = j + 1
	map(i) = j
	call particle_init_particle (pset_out%prt(j), pset_in%prt(i))
	end if
	end do
	end subroutine copy_particles
	end subroutine particle_set_reduce

	@ %def particles_set_reduce
	@ Remove the beam particles and beam remnants from the particle set if the
	keep beams flag is false. If keep beams is not given, the beam particles
	and the beam remnants are removed.
	The correlated state matrix, if any, is also ignored.
	<<Particles: particle set: TBP>>=
	procedure :: filter_particles => particle_set_filter_particles
	<<Particles: sub interfaces>>=
	module subroutine particle_set_filter_particles &
	(pset_in, pset_out, keep_beams, real_parents, keep_virtuals)
	class(particle_set_t), intent(in) :: pset_in
	type(particle_set_t), intent(out) :: pset_out
	logical, intent(in), optional :: keep_beams, real_parents, keep_virtuals
	end subroutine particle_set_filter_particles
	<<Particles: procedures>>=
	module subroutine particle_set_filter_particles &
	(pset_in, pset_out, keep_beams, real_parents, keep_virtuals)
	class(particle_set_t), intent(in) :: pset_in
	type(particle_set_t), intent(out) :: pset_out
	logical, intent(in), optional :: keep_beams, real_parents, keep_virtuals
	integer, dimension(:), allocatable :: status, map
	logical, dimension(:), allocatable :: filter
	integer :: i, j
	logical :: kb, rp, kv
	kb = .false.; if (present (keep_beams)) kb = keep_beams
	rp = .false.; if (present (real_parents)) rp = real_parents
	kv = .true.; if (present (keep_virtuals)) kv = keep_virtuals
	if (debug_on) call msg_debug (D_PARTICLES, "filter_particles")
	if (debug2_active (D_PARTICLES)) then
	print *, 'keep_beams = ', kb
	print *, 'real_parents = ', rp
	print *, 'keep_virtuals = ', kv
	print *, '>>> pset_in : '
	call pset_in%write(compressed=.true.)
	end if
	call count_and_allocate()
	map = 0
	j = 0
	filter = .false.
	if (.not. kb) filter = status == PRT_BEAM .or. status == PRT_BEAM_REMNANT
	if (.not. kv) filter = filter .or. status == PRT_VIRTUAL
	call copy_particles ()
	do i = 1, pset_in%n_tot
	if (map(i) == 0) cycle
	if (rp) then
	call pset_out%prt(map(i))%set_parents &
	(map (pset_in%get_real_parents (i, kb)))
	call pset_out%prt(map(i))%set_children &
	(map (pset_in%get_real_children (i, kb)))
	else
	call pset_out%prt(map(i))%set_parents &
	(map (pset_in%prt(i)%get_parents ()))
	call pset_out%prt(map(i))%set_children &
	(map (pset_in%prt(i)%get_children ()))
	end if
	end do
	if (debug2_active (D_PARTICLES)) then
	print *, '>>> pset_out : '
	call pset_out%write(compressed=.true.)
	end if
	contains
	<<filter particles: procedures>>
	end subroutine particle_set_filter_particles

	@ %def particles_set_filter_particles
	<<filter particles: procedures>>=
	subroutine copy_particles ()
	integer :: i
	do i = 1, pset_in%n_tot
	if (.not. filter(i)) then
	j = j + 1
	map(i) = j
	call particle_init_particle (pset_out%prt(j), pset_in%prt(i))
	end if
	end do
	end subroutine copy_particles

	<<filter particles: procedures>>=
	subroutine count_and_allocate
	allocate (status (pset_in%n_tot))
	status = particle_get_status (pset_in%prt)
	if (kb) pset_out%n_beam = count (status == PRT_BEAM)
	pset_out%n_in = count (status == PRT_INCOMING)
	if (kb .and. kv) then
	pset_out%n_vir = count (status == PRT_VIRTUAL) + &
	count (status == PRT_RESONANT) + &
	count (status == PRT_BEAM_REMNANT)
	else if (kb .and. .not. kv) then
	pset_out%n_vir = count (status == PRT_RESONANT) + &
	count (status == PRT_BEAM_REMNANT)
	else if (.not. kb .and. kv) then
	pset_out%n_vir = count (status == PRT_VIRTUAL) + &
	count (status == PRT_RESONANT)
	else
	pset_out%n_vir = count (status == PRT_RESONANT)
	end if
	pset_out%n_out = count (status == PRT_OUTGOING)
	pset_out%n_tot = &
	pset_out%n_beam + pset_out%n_in + pset_out%n_vir + pset_out%n_out
	allocate (pset_out%prt (pset_out%n_tot))
	allocate (map (pset_in%n_tot))
	allocate (filter (pset_in%n_tot))
	end subroutine count_and_allocate

	@ Transform a particle set into HEPEVT-compatible form. In this form, for each
	particle, the parents and the children are contiguous in the particle array.
	Usually, this requires to clone some particles.

	We do not know in advance how many particles the canonical form will have.
	To be on the safe side, allocate four times the original size.
	<<Particles: types>>=
	type :: particle_entry_t
	integer :: src = 0
	integer :: status = 0
	integer :: orig = 0
	integer :: copy = 0
	end type particle_entry_t

	<<Particles: particle set: TBP>>=
	procedure :: to_hepevt_form => particle_set_to_hepevt_form
	<<Particles: sub interfaces>>=
	module subroutine particle_set_to_hepevt_form (pset_in, pset_out)
	class(particle_set_t), intent(in) :: pset_in
	type(particle_set_t), intent(out) :: pset_out
	end subroutine particle_set_to_hepevt_form
	<<Particles: procedures>>=
	module subroutine particle_set_to_hepevt_form (pset_in, pset_out)
	class(particle_set_t), intent(in) :: pset_in
	type(particle_set_t), intent(out) :: pset_out
	type(particle_entry_t), dimension(:), allocatable :: prt
	integer, dimension(:), allocatable :: map1, map2
	integer, dimension(:), allocatable :: parent, child
	integer :: n_tot, n_parents, n_children, i, j, c, n

	n_tot = pset_in%n_tot
	allocate (prt (4 * n_tot))
	allocate (map1(4 * n_tot))
	allocate (map2(4 * n_tot))
	map1 = 0
	map2 = 0
	allocate (child (n_tot))
	allocate (parent (n_tot))
	n = 0
	do i = 1, n_tot
	if (pset_in%prt(i)%get_n_parents () == 0) then
	call append (i)
	end if
	end do
	do i = 1, n_tot
	n_children = pset_in%prt(i)%get_n_children ()
	if (n_children > 0) then
	child(1:n_children) = pset_in%prt(i)%get_children ()
	c = child(1)
	if (map1(c) == 0) then
	n_parents = pset_in%prt(c)%get_n_parents ()
	if (n_parents > 1) then
	parent(1:n_parents) = pset_in%prt(c)%get_parents ()
	if (i == parent(1) .and. &
	any( [(map1(i)+j-1, j=1,n_parents)] /= &
	map1(parent(1:n_parents)))) then
	do j = 1, n_parents
	call append (parent(j))
	end do
	end if
	else if (map1(i) == 0) then
	call append (i)
	end if
	do j = 1, n_children
	call append (child(j))
	end do
	end if
	else if (map1(i) == 0) then
	call append (i)
	end if
	end do
	do i = n, 1, -1
	if (prt(i)%status /= PRT_OUTGOING) then
	do j = 1, i-1
	if (prt(j)%status == PRT_OUTGOING) then
	call append(prt(j)%src)
	end if
	end do
	exit
	end if
	end do
	pset_out%n_beam = count (prt(1:n)%status == PRT_BEAM)
	pset_out%n_in = count (prt(1:n)%status == PRT_INCOMING)
	pset_out%n_vir = count (prt(1:n)%status == PRT_RESONANT)
	pset_out%n_out = count (prt(1:n)%status == PRT_OUTGOING)
	pset_out%n_tot = n
	allocate (pset_out%prt (n))
	do i = 1, n
	call particle_init_particle (pset_out%prt(i), pset_in%prt(prt(i)%src))
	call pset_out%prt(i)%reset_status (prt(i)%status)
	if (prt(i)%orig == 0) then
	call pset_out%prt(i)%set_parents &
	(map2 (pset_in%prt(prt(i)%src)%get_parents ()))
	else
	call pset_out%prt(i)%set_parents ([ prt(i)%orig ])
	end if
	if (prt(i)%copy == 0) then
	call pset_out%prt(i)%set_children &
	(map1 (pset_in%prt(prt(i)%src)%get_children ()))
	else
	call pset_out%prt(i)%set_children ([ prt(i)%copy ])
	end if
	end do
	contains
	subroutine append (i)
	integer, intent(in) :: i
	n = n + 1
	if (n > size (prt)) &
	call msg_bug ("Particle set transform to HEPEVT: insufficient space")
	prt(n)%src = i
	prt(n)%status = pset_in%prt(i)%get_status ()
	if (map1(i) == 0) then
	map1(i) = n
	else
	prt(map2(i))%status = PRT_VIRTUAL
	prt(map2(i))%copy = n
	prt(n)%orig = map2(i)
	end if
	map2(i) = n
	end subroutine append
	end subroutine particle_set_to_hepevt_form

	@ %def particle_set_to_hepevt_form
	@ This procedure aims at reconstructing the momenta of an interaction,
	given a particle set. The main task is to find the original hard process, by
	following the event history.

	In-state: take those particles which are flagged as [[PRT_INCOMING]]

	Out-state: try to be smart by checking the immediate children of the incoming
	particles. If the [[state_flv]] table is present, check any [[PRT_RESONANT]]
	particles that we get this way, whether they are potential out-particles by
	their PDG codes. If not, replace them by their children, recursively.
	(Resonances may have been inserted by the corresponding event transform.)

	[WK 21-02-16] Revised the algorithm for the case [[recover_beams]] = false,
	i.e., the particle set contains beams and radiation. This does not mean that
	the particle set contains the complete radiation history. To make up for
	missing information, we follow the history in the interaction one step
	backwards and do a bit of guesswork to match this to the possibly incomplete
	history in the particle set. [The current implementation allows only for one
	stage of radiation; this could be improved by iterating the procedure!]

	[WK 21-03-21] Amended the [[find_hard_process_in_pset]] algorithm as follows:
	Occasionally, PYTHIA adds a stepchild to the decay of a resonance that WHIZARD
	has inserted, a shower object that also has other particles in the event as
	parents. Such objects must not enter the hard-process record. Therefore,
	resonance child particle objects are ignored if they have more than one
	parent.
	<<Particles: particle set: TBP>>=
	procedure :: fill_interaction => particle_set_fill_interaction
	<<Particles: sub interfaces>>=
	module subroutine particle_set_fill_interaction &
	(pset, int, n_in, recover_beams, check_match, state_flv, success)
	class(particle_set_t), intent(in) :: pset
	type(interaction_t), intent(inout) :: int
	integer, intent(in) :: n_in
	logical, intent(in), optional :: recover_beams, check_match
	type(state_flv_content_t), intent(in), optional :: state_flv
	logical, intent(out), optional :: success
	end subroutine particle_set_fill_interaction
	<<Particles: procedures>>=
	module subroutine particle_set_fill_interaction &
	(pset, int, n_in, recover_beams, check_match, state_flv, success)
	class(particle_set_t), intent(in) :: pset
	type(interaction_t), intent(inout) :: int
	integer, intent(in) :: n_in
	logical, intent(in), optional :: recover_beams, check_match
	type(state_flv_content_t), intent(in), optional :: state_flv
	logical, intent(out), optional :: success
	integer, dimension(:), allocatable :: map, pdg
	integer, dimension(:), allocatable :: i_in, i_out, p_in, p_out
	logical, dimension(:), allocatable :: i_set
	integer :: n_out, i, p
	logical :: r_beams, check
	r_beams = .false.; if (present (recover_beams)) r_beams = recover_beams
	check = .true.; if (present (check_match)) check = check_match
	if (check) then
	call find_hard_process_in_int (i_in, i_out)
	call find_hard_process_in_pset (p_in, p_out, state_flv, success)
	if (present (success)) then
	if (size (i_in) /= n_in) success = .false.
	if (size (p_in) /= n_in) success = .false.
	if (size (p_out) /= n_out) success = .false.
	if (.not. success) return
	else
	if (size (i_in) /= n_in) call err_int_n_in
	if (size (p_in) /= n_in) call err_pset_n_in
	if (size (p_out) /= n_out) call err_pset_n_out
	end if
	call extract_hard_process_from_pset (pdg)
	call determine_map_for_hard_process (map, state_flv, success)
	if (present (success)) then
	if (.not. success) return
	end if
	call map_handle_duplicates (map)
	if (.not. r_beams) then
	call determine_map_for_beams (map)
	call map_handle_duplicates (map)
	call determine_map_for_radiation (map, i_in, p_in)
	call map_handle_duplicates (map)
	end if
	else
	allocate (map (int%get_n_tot ()))
	map = [(i, i = 1, size (map))]
	r_beams = .false.
	end if
	allocate (i_set (int%get_n_tot ()), source = .false.)
	do p = 1, size (map)
	if (map(p) /= 0) then
	if (.not. i_set(map(p))) then
	call int%set_momentum (pset%prt(p)%get_momentum (), map(p))
	i_set(map(p)) = .true.
	end if
	end if
	end do
	if (r_beams) then
	do i = 1, n_in
	call reconstruct_beam_and_radiation (i, i_set)
	end do
	else
	do i = int%get_n_tot (), 1, -1
	if (.not. i_set(i)) call reconstruct_missing (i, i_set)
	end do
	end if
	if (any (.not. i_set)) then
	if (present (success)) then
	success = .false.
	else
	call err_map
	end if
	end if
	contains
	subroutine find_hard_process_in_int (i_in, i_out)
	integer, dimension(:), allocatable, intent(out) :: i_in, i_out
	integer :: n_in_i
	integer :: i
	i = int%get_n_tot ()
	n_in_i = int%get_n_parents (i)
	if (n_in_i /= n_in) call err_int_n_in
	allocate (i_in (n_in))
	i_in = int%get_parents (i)
	i = i_in(1)
	n_out = int%get_n_children (i)
	allocate (i_out (n_out))
	i_out = int%get_children (i)
	end subroutine find_hard_process_in_int
	subroutine find_hard_process_in_pset (p_in, p_out, state_flv, success)
	integer, dimension(:), allocatable, intent(out) :: p_in, p_out
	type(state_flv_content_t), intent(in), optional :: state_flv
	logical, intent(out), optional :: success
	integer, dimension(:), allocatable :: p_status, p_idx, p_child
	integer :: n_out_p, n_child, n_shift
	integer :: i, k, c
	allocate (p_status (pset%n_tot), p_idx (pset%n_tot), p_child (pset%n_tot))
	p_status = pset%prt%get_status ()
	p_idx = [(i, i = 1, pset%n_tot)]
	allocate (p_in (n_in))
	p_in = pack (p_idx, p_status == PRT_INCOMING)
	if (size (p_in) == 0) call err_pset_hard
	i = p_in(1)
	allocate (p_out (n_out))
	n_out_p = pset%prt(i)%get_n_children ()
	p_out(1:n_out_p) = particle_get_children (pset%prt(i))
	do k = 1, size (p_out)
	i = p_out(k)
	if (present (state_flv)) then
	do while (pset%prt(i)%get_status () == PRT_RESONANT)
	if (state_flv%contains (pset%prt(i)%get_pdg ())) exit
	n_child = pset%prt(i)%get_n_children ()
	p_child(1:n_child) = particle_get_children (pset%prt(i))
	n_shift = -1
	do c = 1, n_child
	if (pset%prt(p_child(c))%get_n_parents () == 1) then
	n_shift = n_shift + 1
	else
	p_child(c) = 0
	end if
	end do
	if (n_shift < 0) then
	if (present (success)) then
	success = .false.
	return
	else
	call err_mismatch
	end if
	end if
	p_out(k+1+n_shift:n_out_p+n_shift) = p_out(k+1:n_out_p)
	n_out_p = n_out_p + n_shift
	do c = 1, n_child
	if (p_child(c) /= 0) then
	p_out(k+c-1) = p_child(c)
	end if
	end do
	i = p_out(k)
	end do
	end if
	end do
	if (present (success)) success = .true.
	end subroutine find_hard_process_in_pset
	subroutine extract_hard_process_from_pset (pdg)
	integer, dimension(:), allocatable, intent(out) :: pdg
	integer, dimension(:), allocatable :: pdg_p
	logical, dimension(:), allocatable :: mask_p
	integer :: i
	allocate (pdg_p (pset%n_tot))
	pdg_p = pset%prt%get_pdg ()
	allocate (mask_p (pset%n_tot), source = .false.)
	mask_p (p_in) = .true.
	mask_p (p_out) = .true.
	allocate (pdg (n_in + n_out))
	pdg = pack (pdg_p, mask_p)
	end subroutine extract_hard_process_from_pset
	subroutine determine_map_for_hard_process (map, state_flv, success)
	integer, dimension(:), allocatable, intent(out) :: map
	type(state_flv_content_t), intent(in), optional :: state_flv
	logical, intent(out), optional :: success
	integer, dimension(:), allocatable :: pdg_i, map_i
	integer :: n_tot
	logical, dimension(:), allocatable :: mask_i, mask_p
	logical :: match
	n_tot = int%get_n_tot ()
	if (present (state_flv)) then
	allocate (mask_i (n_tot), source = .false.)
	mask_i (i_in) = .true.
	mask_i (i_out) = .true.
	allocate (pdg_i (n_tot), map_i (n_tot))
	pdg_i = unpack (pdg, mask_i, 0)
	call state_flv%match (pdg_i, match, map_i)
	if (present (success)) then
	success = match
	end if
	if (.not. match) then
	if (present (success)) then
	return
	else
	call err_mismatch
	end if
	end if
	allocate (mask_p (pset%n_tot), source = .false.)
	mask_p (p_in) = .true.
	mask_p (p_out) = .true.
	allocate (map (size (mask_p)), &
	source = unpack (pack (map_i, mask_i), mask_p, 0))
	else
	allocate (map (n_tot), source = 0)
	map(p_in) = i_in
	map(p_out) = i_out
	end if
	end subroutine determine_map_for_hard_process
	subroutine map_handle_duplicates (map)
	integer, dimension(:), intent(inout) :: map
	integer, dimension(1) :: p_parent, p_child
	integer :: p
	do p = 1, pset%n_tot
	if (map(p) == 0) then
	if (pset%prt(p)%get_n_parents () == 1) then
	p_parent = pset%prt(p)%get_parents ()
	if (map(p_parent(1)) /= 0) then
	if (pset%prt(p_parent(1))%get_n_children () == 1) then
	map(p) = map(p_parent(1))
	end if
	end if
	end if
	end if
	end do
	do p = pset%n_tot, 1, -1
	if (map(p) == 0) then
	if (pset%prt(p)%get_n_children () == 1) then
	p_child = pset%prt(p)%get_children ()
	if (map(p_child(1)) /= 0) then
	if (pset%prt(p_child(1))%get_n_parents () == 1) then
	map(p) = map(p_child(1))
	end if
	end if
	end if
	end if
	end do
	end subroutine map_handle_duplicates
	subroutine determine_map_for_beams (map)
	integer, dimension(:), intent(inout) :: map
	select case (n_in)
	case (1); map(1) = 1
	case (2); map(1:2) = [1,2]
	end select
	end subroutine determine_map_for_beams
	subroutine determine_map_for_radiation (map, i_in, p_in)
	integer, dimension(:), intent(inout) :: map
	integer, dimension(:), intent(in) :: i_in
	integer, dimension(:), intent(in) :: p_in
	integer, dimension(:), allocatable :: i_cur, p_cur
	integer, dimension(:), allocatable :: i_par, p_par, i_rad, p_rad
	integer :: i, p
	integer :: b, r
	i_cur = i_in
	p_cur = p_in
	do b = 1, n_in
	i = i_cur(b)
	p = p_cur(b)
	i_par = int%get_parents (i)
	p_par = pset%prt(p)%get_parents ()
	if (size (i_par) == 0 .or. size (p_par) == 0) cycle
	if (size (p_par) == 1) then
	if (pset%prt(p_par(1))%get_n_children () == 1) then
	p_par = pset%prt(p_par(1))%get_parents () ! copy of entry
	end if
	end if
	i_rad = int%get_children (i_par(1))
	p_rad = pset%prt(p_par(1))%get_children ()
	do r = 1, size (i_rad)
	if (any (map == i_rad(r))) i_rad(r) = 0
	end do
	i_rad = pack (i_rad, i_rad /= 0)
	do r = 1, size (p_rad)
	if (map(p_rad(r)) /= 0) p_rad(r) = 0
	end do
	p_rad = pack (p_rad, p_rad /= 0)
	do r = 1, min (size (i_rad), size (p_rad))
	map(p_rad(r)) = i_rad(r)
	end do
	end do
	do b = 1, min (size (p_par), size (i_par))
	if (map(p_par(b)) == 0 .and. all (map /= i_par(b))) then
	map(p_par(b)) = i_par(b)
	end if
	end do
	end subroutine determine_map_for_radiation
	subroutine reconstruct_beam_and_radiation (k, i_set)
	integer, intent(in) :: k
	logical, dimension(:), intent(inout) :: i_set
	integer :: k_src, k_pre, k_in, k_rad
	type(interaction_t), pointer :: int_src
	integer, dimension(2) :: i_child
	logical, dimension(2) :: is_final
	integer :: i
	call int%find_source (k, int_src, k_src)
	k_pre = 0
	k_in = k
	do while (.not. i_set (k_in))
	if (k_pre == 0) then
	call int%set_momentum (int_src%get_momentum (k_src), k_in)
	else
	call int%set_momentum (int%get_momentum (k_pre), k_in)
	end if
	i_set(k_in) = .true.
	if (n_in == 2) then
	k_pre = k_in
	i_child = int%get_children (k_pre)
	do i = 1, 2
	is_final(i) = int%get_n_children (i_child(i)) == 0
	end do
	if (all (.not. is_final)) then
	k_in = i_child(k); k_rad = 0
	else if (is_final(2)) then
	k_in = i_child(1); k_rad = i_child(2)
	else if (is_final(1)) then
	k_in = i_child(2); k_rad = i_child(1)
	else
	call err_beams
	end if
	if (k_rad /= 0) then
	if (i_set (k_in)) then
	call int%set_momentum &
	(int%get_momentum (k) - int%get_momentum (k_in), k_rad)
	i_set(k_rad) = .true.
	else
	call err_beams_norad
	end if
	end if
	end if
	end do
	end subroutine reconstruct_beam_and_radiation
	subroutine reconstruct_missing (i, i_set)
	integer, intent(in) :: i
	logical, dimension(:), intent(inout) :: i_set
	integer, dimension(:), allocatable :: i_child, i_parent, i_sibling
	integer :: s
	i_child = int%get_children (i)
	i_parent = int%get_parents (i)
	if (size (i_child) > 0 .and. all (i_set(i_child))) then
	call int%set_momentum (sum (int%get_momenta (i_child)), i)
	else if (size (i_parent) > 0 .and. all (i_set(i_parent))) then
	i_sibling = int%get_children (i_parent(1))
	call int%set_momentum (sum (int%get_momenta (i_parent)), i)
	do s = 1, size (i_sibling)
	if (i_sibling(s) == i) cycle
	if (i_set(i_sibling(s))) then
	call int%set_momentum (int%get_momentum (i) &
	- int%get_momentum (i_sibling(s)), i)
	else
	call err_beams_norad
	end if
	end do
	else
	call err_beams_norad
	end if
	i_set(i) = .true.
	end subroutine reconstruct_missing
	subroutine err_pset_hard
	call msg_fatal ("Reading particle set: no particles marked as incoming")
	end subroutine err_pset_hard
	subroutine err_int_n_in
	integer :: n
	if (allocated (i_in)) then
	n = size (i_in)
	else
	n = 0
	end if
	write (msg_buffer, "(A,I0,A,I0)") &
	"Filling hard process from particle set: expect ", n_in, &
	" incoming particle(s), found ", n
	call msg_bug
	end subroutine err_int_n_in
	subroutine err_pset_n_in
	write (msg_buffer, "(A,I0,A,I0)") &
	"Reading hard-process particle set: should contain ", n_in, &
	" incoming particle(s), found ", size (p_in)
	call msg_fatal
	end subroutine err_pset_n_in
	subroutine err_pset_n_out
	write (msg_buffer, "(A,I0,A,I0)") &
	"Reading hard-process particle set: should contain ", n_out, &
	" outgoing particle(s), found ", size (p_out)
	call msg_fatal
	end subroutine err_pset_n_out
	subroutine err_mismatch
	call pset%write ()
	call state_flv%write ()
	call msg_fatal ("Reading particle set: Flavor combination " &
	// "does not match requested process")
	end subroutine err_mismatch
	subroutine err_map
	call pset%write ()
	call int%basic_write ()
	call msg_fatal ("Reading hard-process particle set: " &
	// "Incomplete mapping from particle set to interaction")
	end subroutine err_map
	subroutine err_beams
	call pset%write ()
	call int%basic_write ()
	call msg_fatal ("Reading particle set: Beam structure " &
	// "does not match requested process")
	end subroutine err_beams
	subroutine err_beams_norad
	call pset%write ()
	call int%basic_write ()
	call msg_fatal ("Reading particle set: Beam structure " &
	// "cannot be reconstructed for this configuration")
	end subroutine err_beams_norad
	subroutine err_radiation
	call int%basic_write ()
	call msg_bug ("Reading particle set: Interaction " &
	// "contains inconsistent radiation pattern.")
	end subroutine err_radiation
	end subroutine particle_set_fill_interaction

	@ %def particle_set_fill_interaction
	@
	This procedure reconstructs an array of vertex indices from the
	parent-child information in the particle entries, according to the
	HepMC scheme. For each particle, we determine which vertex it comes
	from and which vertex it goes to. We return the two arrays and the
	maximum vertex index.

	For each particle in the list, we first check its parents. If for any
	parent the vertex where it goes to is already known, this vertex index
	is assigned as the current 'from' vertex. Otherwise, a new index is
	created, assigned as the current 'from' vertex, and as the 'to' vertex
	for all parents.

	Then, the analogous procedure is done for the children.

	Furthermore, we assign to each vertex the vertex position from the
	parent(s). We check that these vertex positions coincide, and if not
	return a null vector.
	<<Particles: particle set: TBP>>=
	procedure :: assign_vertices => particle_set_assign_vertices
	<<Particles: sub interfaces>>=
	module subroutine particle_set_assign_vertices &
	(particle_set, v_from, v_to, n_vertices)
	class(particle_set_t), intent(in) :: particle_set
	integer, dimension(:), intent(out) :: v_from, v_to
	integer, intent(out) :: n_vertices
	end subroutine particle_set_assign_vertices
	<<Particles: procedures>>=
	module subroutine particle_set_assign_vertices &
	(particle_set, v_from, v_to, n_vertices)
	class(particle_set_t), intent(in) :: particle_set
	integer, dimension(:), intent(out) :: v_from, v_to
	integer, intent(out) :: n_vertices
	integer, dimension(:), allocatable :: parent, child
	integer :: n_parents, n_children, vf, vt
	integer :: i, j, v
	v_from = 0
	v_to = 0
	vf = 0
	vt = 0
	do i = 1, particle_set%n_tot
	n_parents = particle_set%prt(i)%get_n_parents ()
	if (n_parents /= 0) then
	allocate (parent (n_parents))
	parent = particle_set%prt(i)%get_parents ()
	SCAN_PARENTS: do j = 1, size (parent)
	v = v_to(parent(j))
	if (v /= 0) then
	v_from(i) = v; exit SCAN_PARENTS
	end if
	end do SCAN_PARENTS
	if (v_from(i) == 0) then
	vf = vf + 1; v_from(i) = vf
	v_to(parent) = vf
	end if
	deallocate (parent)
	end if
	n_children = particle_set%prt(i)%get_n_children ()
	if (n_children /= 0) then
	allocate (child (n_children))
	child = particle_set%prt(i)%get_children ()
	SCAN_CHILDREN: do j = 1, size (child)
	v = v_from(child(j))
	if (v /= 0) then
	v_to(i) = v; exit SCAN_CHILDREN
	end if
	end do SCAN_CHILDREN
	if (v_to(i) == 0) then
	vt = vt + 1; v_to(i) = vt
	v_from(child) = vt
	end if
	deallocate (child)
	end if
	end do
	n_vertices = max (vf, vt)
	end subroutine particle_set_assign_vertices

	@ %def particle_set_assign_vertices
	@
	\subsection{Expression interface}
	This converts a [[particle_set]] object as defined here to a more
	concise [[subevt]] object that can be used as the event root of an
	expression. In particular, the latter lacks virtual particles, spin
	correlations and parent-child relations.

	We keep beam particles, incoming partons, and outgoing partons.
	Furthermore, we keep radiated particles (a.k.a.\ beam remnants) if
	they have no children in the current particle set, and mark them as
	outgoing particles.

	If [[colorize]] is set and true, mark all particles in the subevent as
	colorized, and set color/anticolor flow indices where they are defined.
	Colorless particles do not get indices but are still marked as colorized, for
	consistency.
	<<Particles: particle set: TBP>>=
	procedure :: to_subevt => particle_set_to_subevt
	<<Particles: sub interfaces>>=
	module subroutine particle_set_to_subevt (particle_set, subevt, colorize)
	class(particle_set_t), intent(in) :: particle_set
	type(subevt_t), intent(out) :: subevt
	logical, intent(in), optional :: colorize
	end subroutine particle_set_to_subevt
	<<Particles: procedures>>=
	module subroutine particle_set_to_subevt (particle_set, subevt, colorize)
	class(particle_set_t), intent(in) :: particle_set
	type(subevt_t), intent(out) :: subevt
	logical, intent(in), optional :: colorize
	integer :: n_tot, n_beam, n_in, n_out, n_rad
	integer :: i, k, n_active
	integer, dimension(2) :: hel
	logical :: keep
	n_tot = particle_set_get_n_tot (particle_set)
	n_beam = particle_set_get_n_beam (particle_set)
	n_in = particle_set_get_n_in (particle_set)
	n_out = particle_set_get_n_out (particle_set)
	n_rad = particle_set_get_n_remnants (particle_set)
	call subevt_init (subevt, n_beam + n_rad + n_in + n_out)
	k = 0
	do i = 1, n_tot
	associate (prt => particle_set%prt(i))
	keep = .false.
	select case (particle_get_status (prt))
	case (PRT_BEAM)
	k = k + 1
	call subevt%set_beam (k, &
	particle_get_pdg (prt), &
	particle_get_momentum (prt), &
	particle_get_p2 (prt))
	keep = .true.
	case (PRT_INCOMING)
	k = k + 1
	call subevt%set_incoming (k, &
	particle_get_pdg (prt), &
	particle_get_momentum (prt), &
	particle_get_p2 (prt))
	keep = .true.
	case (PRT_OUTGOING)
	k = k + 1
	call subevt%set_outgoing (k, &
	particle_get_pdg (prt), &
	particle_get_momentum (prt), &
	particle_get_p2 (prt))
	keep = .true.
	case (PRT_BEAM_REMNANT)
	if (prt%get_n_children () == 0) then
	k = k + 1
	call subevt%set_outgoing (k, &
	particle_get_pdg (prt), &
	particle_get_momentum (prt), &
	particle_get_p2 (prt))
	keep = .true.
	end if
	end select
	if (keep) then
	if (prt%polarization == PRT_DEFINITE_HELICITY) then
	if (prt%hel%is_diagonal ()) then
	hel = prt%hel%to_pair ()
	call subevt_polarize (subevt, k, hel(1))
	end if
	end if
	end if
	if (present (colorize)) then
	if (colorize) then
	call subevt_colorize &
	(subevt, i, prt%col%get_col (), prt%col%get_acl ())
	end if
	end if
	end associate
	n_active = k
	end do
	call subevt%reset (n_active)
	end subroutine particle_set_to_subevt

	@ %def particle_set_to_subevt
	@
	This replaces the [[particle\_set\%prt array]] with a given array of particles
	<<Particles: particle set: TBP>>=
	procedure :: replace => particle_set_replace
	<<Particles: sub interfaces>>=
	module subroutine particle_set_replace (particle_set, newprt)
	class(particle_set_t), intent(inout) :: particle_set
	type(particle_t), intent(in), dimension(:), allocatable :: newprt
	end subroutine particle_set_replace
	<<Particles: procedures>>=
	module subroutine particle_set_replace (particle_set, newprt)
	class(particle_set_t), intent(inout) :: particle_set
	type(particle_t), intent(in), dimension(:), allocatable :: newprt
	if (allocated (particle_set%prt)) deallocate (particle_set%prt)
	allocate (particle_set%prt(size (newprt)))
	particle_set%prt = newprt
	particle_set%n_tot = size (newprt)
	particle_set%n_beam = count (particle_get_status (newprt) == PRT_BEAM)
	particle_set%n_in = count (particle_get_status (newprt) == PRT_INCOMING)
	particle_set%n_out = count (particle_get_status (newprt) == PRT_OUTGOING)
	particle_set%n_vir = particle_set%n_tot &
	- particle_set%n_beam - particle_set%n_in - particle_set%n_out
	end subroutine particle_set_replace

	@ %def particle_set_replace
	@ This routines orders the outgoing particles into clusters of
	colorless particles and such of particles ordered corresponding to the
	indices of the color lines. All outgoing particles in the ordered set
	appear as child of the corresponding outgoing particle in the
	unordered set, including colored beam remnants. We always start
	continue via the anti-color line, such that color flows within each
	Lund string system is always continued from the anticolor of one
	particle to the identical color index of another particle.
	<<Particles: particle set: TBP>>=
	procedure :: order_color_lines => particle_set_order_color_lines
	<<Particles: sub interfaces>>=
	module subroutine particle_set_order_color_lines (pset_out, pset_in)
	class(particle_set_t), intent(inout) :: pset_out
	type(particle_set_t), intent(in) :: pset_in
	end subroutine particle_set_order_color_lines
	<<Particles: procedures>>=
	module subroutine particle_set_order_color_lines (pset_out, pset_in)
	class(particle_set_t), intent(inout) :: pset_out
	type(particle_set_t), intent(in) :: pset_in
	integer :: i, n, n_col_rem
	n_col_rem = 0
	do i = 1, pset_in%n_tot
	if (pset_in%prt(i)%get_status () == PRT_BEAM_REMNANT .and. &
	any (pset_in%prt(i)%get_color () /= 0)) then
	n_col_rem = n_col_rem + 1
	end if
	end do
	pset_out%n_beam = pset_in%n_beam
	pset_out%n_in = pset_in%n_in
	pset_out%n_vir = pset_in%n_vir + pset_in%n_out + n_col_rem
	pset_out%n_out = pset_in%n_out
	pset_out%n_tot = pset_in%n_tot + pset_in%n_out + n_col_rem
	pset_out%correlated_state = pset_in%correlated_state
	pset_out%factorization_mode = pset_in%factorization_mode
	allocate (pset_out%prt (pset_out%n_tot))
	do i = 1, pset_in%n_tot
	call pset_out%prt(i)%init (pset_in%prt(i))
	call pset_out%prt(i)%set_children (pset_in%prt(i)%child)
	call pset_out%prt(i)%set_parents (pset_in%prt(i)%parent)
	end do
	n = pset_in%n_tot
	do i = 1, pset_in%n_tot
	if (pset_out%prt(i)%get_status () == PRT_OUTGOING .and. &
	all (pset_out%prt(i)%get_color () == 0) .and. &
	.not. pset_out%prt(i)%has_children ()) then
	n = n + 1
	call pset_out%prt(n)%init (pset_out%prt(i))
	call pset_out%prt(i)%reset_status (PRT_VIRTUAL)
	call pset_out%prt(i)%add_child (n)
	call pset_out%prt(i)%set_parents ([i])
	end if
	end do
	if (n_col_rem > 0) then
	do i = 1, n_col_rem
	end do
	end if
	end subroutine particle_set_order_color_lines

	@ %def particle_set_order_color_lines
	@
	Eliminate numerical noise
	<<Particles: public>>=
	public :: pacify
	<<Particles: interfaces>>=
	interface pacify
	module procedure pacify_particle
	module procedure pacify_particle_set
	end interface pacify

	<<Particles: sub interfaces>>=
	module subroutine pacify_particle (prt)
	class(particle_t), intent(inout) :: prt
	end subroutine pacify_particle
	module subroutine pacify_particle_set (pset)
	class(particle_set_t), intent(inout) :: pset
	end subroutine pacify_particle_set
	<<Particles: procedures>>=
	module subroutine pacify_particle (prt)
	class(particle_t), intent(inout) :: prt
	real(default) :: e
	e = epsilon (1._default) * energy (prt%p)
	call pacify (prt%p, 10 * e)
	call pacify (prt%p2, 1e4 * e)
	end subroutine pacify_particle

	module subroutine pacify_particle_set (pset)
	class(particle_set_t), intent(inout) :: pset
	integer :: i
	do i = 1, pset%n_tot
	call pacify (pset%prt(i))
	end do
	end subroutine pacify_particle_set

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

	module particles_ut
	use unit_tests
	use particles_uti

	<<Standard module head>>

	<<Particles: public test>>

	contains

	<<Particles: test driver>>

	end module particles_ut
	@ %def particles_ut
	@
	<<[[particles_uti.f90]]>>=
	<<File header>>

	module particles_uti

	<<Use kinds>>
	use io_units
	use numeric_utils
	use constants, only: one, tiny_07
	use lorentz
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use state_matrices
	use interactions
	use evaluators
	use model_data
	use subevents

	use particles

	<<Standard module head>>

	<<Particles: test declarations>>

	contains

	<<Particles: tests>>

	<<Particles: test auxiliary>>

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

	@ %def particles_test
	@
	Check the basic setup of the [[particle_set_t]] type:
	Set up a chain of production and decay and factorize the result into
	particles. The process is $d\bar d \to Z \to q\bar q$.
	<<Particles: execute tests>>=
	call test (particles_1, "particles_1", &
	"check particle_set routines", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_1
	<<Particles: tests>>=
	subroutine particles_1 (u)
	use os_interface
	integer, intent(in) :: u
	type(model_data_t), target :: model
	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
	type(vector4_t), dimension(3) :: p
	type(interaction_t), target :: int1, int2
	type(quantum_numbers_mask_t) :: qn_mask_conn
	type(evaluator_t), target :: eval
	type(interaction_t) :: int
	type(particle_set_t) :: particle_set1, particle_set2
	type(particle_set_t) :: particle_set3, particle_set4
	type(subevt_t) :: subevt
	logical :: ok
	integer :: unit, iostat

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: test particle_set routines"
	write (u, "(A)")

	write (u, "(A)") "* Reading model file"

	call model%init_sm_test ()

	write (u, "(A)")
	write (u, "(A)") "* Initializing production process"

	call int1%basic_init (2, 0, 1, set_relations=.true.)
	call flv%init ([1, -1, 23], model)
	call col%init_col_acl ([0, 0, 0], [0, 0, 0])
	call hel(3)%init (1, 1)
	call qn%init (flv, col, hel)
	call int1%add_state (qn, value=(0.25_default, 0._default))
	call hel(3)%init (1,-1)
	call qn%init (flv, col, hel)
	call int1%add_state (qn, value=(0._default, 0.25_default))
	call hel(3)%init (-1, 1)
	call qn%init (flv, col, hel)
	call int1%add_state (qn, value=(0._default,-0.25_default))
	call hel(3)%init (-1,-1)
	call qn%init (flv, col, hel)
	call int1%add_state (qn, value=(0.25_default, 0._default))
	call hel(3)%init (0, 0)
	call qn%init (flv, col, hel)
	call int1%add_state (qn, value=(0.5_default, 0._default))
	call int1%freeze ()
	p(1) = vector4_moving (45._default, 45._default, 3)
	p(2) = vector4_moving (45._default,-45._default, 3)
	p(3) = p(1) + p(2)
	call int1%set_momenta (p)

	write (u, "(A)")
	write (u, "(A)") "* Setup decay process"

	call int2%basic_init (1, 0, 2, set_relations=.true.)
	call flv%init ([23, 1, -1], model)
	call col%init_col_acl ([0, 501, 0], [0, 0, 501])
	call hel%init ([1, 1, 1], [1, 1, 1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(1._default, 0._default))
	call hel%init ([1, 1, 1], [-1,-1,-1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(0._default, 0.1_default))
	call hel%init ([-1,-1,-1], [1, 1, 1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(0._default,-0.1_default))
	call hel%init ([-1,-1,-1], [-1,-1,-1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(1._default, 0._default))
	call hel%init ([0, 1,-1], [0, 1,-1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(4._default, 0._default))
	call hel%init ([0,-1, 1], [0, 1,-1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(2._default, 0._default))
	call hel%init ([0, 1,-1], [0,-1, 1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(2._default, 0._default))
	call hel%init ([0,-1, 1], [0,-1, 1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(4._default, 0._default))
	call flv%init ([23, 2, -2], model)
	call hel%init ([0, 1,-1], [0, 1,-1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(0.5_default, 0._default))
	call hel%init ([0,-1, 1], [0,-1, 1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(0.5_default, 0._default))
	call int2%freeze ()
	p(2) = vector4_moving (45._default, 45._default, 2)
	p(3) = vector4_moving (45._default,-45._default, 2)
	call int2%set_momenta (p)
	call int2%set_source_link (1, int1, 3)
	call int1%basic_write (u)
	call int2%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Concatenate production and decay"

	call eval%init_product (int1, int2, qn_mask_conn, &
	connections_are_resonant=.true.)
	call eval%receive_momenta ()
	call eval%evaluate ()
	call eval%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Factorize as subevent (complete, polarized)"
	write (u, "(A)")

	int = eval%interaction_t
	call particle_set1%init &
	(ok, int, int, FM_FACTOR_HELICITY, &
	[0.2_default, 0.2_default], .false., .true.)
	call particle_set1%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Factorize as subevent (in/out only, selected helicity)"
	write (u, "(A)")

	int = eval%interaction_t
	call particle_set2%init &
	(ok, int, int, FM_SELECT_HELICITY, &
	[0.9_default, 0.9_default], .false., .false.)
	call particle_set2%write (u)
	call particle_set2%final ()

	write (u, "(A)")
	write (u, "(A)") "* Factorize as subevent (complete, selected helicity)"
	write (u, "(A)")

	int = eval%interaction_t
	call particle_set2%init &
	(ok, int, int, FM_SELECT_HELICITY, &
	[0.7_default, 0.7_default], .false., .true.)
	call particle_set2%write (u)

	write (u, "(A)")
	write (u, "(A)") &
	"* Factorize (complete, polarized, correlated); write and read again"
	write (u, "(A)")

	int = eval%interaction_t
	call particle_set3%init &
	(ok, int, int, FM_FACTOR_HELICITY, &
	[0.7_default, 0.7_default], .true., .true.)
	call particle_set3%write (u)

	unit = free_unit ()
	open (unit, action="readwrite", form="unformatted", status="scratch")
	call particle_set3%write_raw (unit)
	rewind (unit)
	call particle_set4%read_raw (unit, iostat=iostat)
	call particle_set4%set_model (model)
	close (unit)

	write (u, "(A)")
	write (u, "(A)") "* Result from reading"
	write (u, "(A)")

	call particle_set4%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Transform to a subevt object"
	write (u, "(A)")

	call particle_set4%to_subevt (subevt)
	call subevt%write (u)

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

	call particle_set1%final ()
	call particle_set2%final ()
	call particle_set3%final ()
	call particle_set4%final ()
	call eval%final ()
	call int1%final ()
	call int2%final ()

	call model%final ()

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

	end subroutine particles_1

	@ %def particles_1
	@
	Reconstruct a hard interaction from a particle set.
	<<Particles: execute tests>>=
	call test (particles_2, "particles_2", &
	"reconstruct hard interaction", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_2
	<<Particles: tests>>=
	subroutine particles_2 (u)

	integer, intent(in) :: u
	type(interaction_t) :: int
	type(state_flv_content_t) :: state_flv
	type(particle_set_t) :: pset
	type(flavor_t), dimension(:), allocatable :: flv
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: i, j

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: reconstruct simple interaction"
	write (u, "(A)")

	write (u, "(A)") "* Set up a 2 -> 3 interaction"
	write (u, "(A)") " + incoming partons marked as virtual"
	write (u, "(A)") " + no quantum numbers"
	write (u, "(A)")

	call reset_interaction_counter ()
	call int%basic_init (0, 2, 3)
	do i = 1, 2
	do j = 3, 5
	call int%relate (i, j)
	end do
	end do

	allocate (qn (5))
	call int%add_state (qn)
	call int%freeze ()

	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set up a flavor-content record"
	write (u, "(A)")

	call state_flv%init (1, &
	mask = [.false., .false., .true., .true., .true.])
	call state_flv%set_entry (1, &
	pdg = [11, 12, 3, 4, 5], &
	map = [1, 2, 3, 4, 5])

	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually create a matching particle set"
	write (u, "(A)")

	pset%n_beam = 0
	pset%n_in = 2
	pset%n_vir = 0
	pset%n_out = 3
	pset%n_tot = 5
	allocate (pset%prt (pset%n_tot))
	do i = 1, 2
	call pset%prt(i)%reset_status (PRT_INCOMING)
	call pset%prt(i)%set_children ([3,4,5])
	end do
	do i = 3, 5
	call pset%prt(i)%reset_status (PRT_OUTGOING)
	call pset%prt(i)%set_parents ([1,2])
	end do
	call pset%prt(1)%set_momentum (vector4_at_rest (1._default))
	call pset%prt(2)%set_momentum (vector4_at_rest (2._default))
	call pset%prt(3)%set_momentum (vector4_at_rest (5._default))
	call pset%prt(4)%set_momentum (vector4_at_rest (4._default))
	call pset%prt(5)%set_momentum (vector4_at_rest (3._default))

	allocate (flv (5))
	call flv%init ([11,12,5,4,3])
	do i = 1, 5
	call pset%prt(i)%set_flavor (flv(i))
	end do

	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill interaction from particle set"
	write (u, "(A)")

	call pset%fill_interaction (int, 2, state_flv=state_flv)
	call int%basic_write (u)

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

	call int%final ()
	call pset%final ()

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

	end subroutine particles_2

	@ %def particles_2
	@
	Reconstruct an interaction with beam structure, e.g., a hadronic
	interaction, from a particle set.
	<<Particles: execute tests>>=
	call test (particles_3, "particles_3", &
	"reconstruct interaction with beam structure", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_3
	<<Particles: tests>>=
	subroutine particles_3 (u)

	integer, intent(in) :: u
	type(interaction_t) :: int
	type(state_flv_content_t) :: state_flv
	type(particle_set_t) :: pset
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: i, j

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: reconstruct simple interaction"
	write (u, "(A)")

	write (u, "(A)") "* Set up a 2 -> 2 -> 3 interaction with radiation"
	write (u, "(A)") " + no quantum numbers"
	write (u, "(A)")

	call reset_interaction_counter ()
	call int%basic_init (0, 6, 3)
	call int%relate (1, 3)
	call int%relate (1, 4)
	call int%relate (2, 5)
	call int%relate (2, 6)
	do i = 4, 6, 2
	do j = 7, 9
	call int%relate (i, j)
	end do
	end do

	allocate (qn (9))
	call int%add_state (qn)
	call int%freeze ()

	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set up a flavor-content record"
	write (u, "(A)")

	call state_flv%init (1, &
	mask = [.false., .false., .false., .false., .false., .false., &
	.true., .true., .true.])
	call state_flv%set_entry (1, &
	pdg = [2011, 2012, 91, 11, 92, 12, 3, 4, 5], &
	map = [1, 2, 3, 4, 5, 6, 7, 8, 9])

	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually create a matching particle set"
	write (u, "(A)")

	call create_test_particle_set_1 (pset)

	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill interaction from particle set"
	write (u, "(A)")

	call pset%fill_interaction (int, 2, state_flv=state_flv)
	call int%basic_write (u)

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

	call int%final ()
	call pset%final ()

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

	end subroutine particles_3

	@ %def particles_3
	@
	<<Particles: test auxiliary>>=
	subroutine create_test_particle_set_1 (pset)
	type(particle_set_t), intent(out) :: pset
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: i
	pset%n_beam = 2
	pset%n_in = 2
	pset%n_vir = 2
	pset%n_out = 3
	pset%n_tot = 9

	allocate (pset%prt (pset%n_tot))
	call pset%prt(1)%reset_status (PRT_BEAM)
	call pset%prt(2)%reset_status (PRT_BEAM)
	call pset%prt(3)%reset_status (PRT_INCOMING)
	call pset%prt(4)%reset_status (PRT_INCOMING)
	call pset%prt(5)%reset_status (PRT_BEAM_REMNANT)
	call pset%prt(6)%reset_status (PRT_BEAM_REMNANT)
	call pset%prt(7)%reset_status (PRT_OUTGOING)
	call pset%prt(8)%reset_status (PRT_OUTGOING)
	call pset%prt(9)%reset_status (PRT_OUTGOING)

	call pset%prt(1)%set_children ([3,5])
	call pset%prt(2)%set_children ([4,6])
	call pset%prt(3)%set_children ([7,8,9])
	call pset%prt(4)%set_children ([7,8,9])

	call pset%prt(3)%set_parents ([1])
	call pset%prt(4)%set_parents ([2])
	call pset%prt(5)%set_parents ([1])
	call pset%prt(6)%set_parents ([2])
	call pset%prt(7)%set_parents ([3,4])
	call pset%prt(8)%set_parents ([3,4])
	call pset%prt(9)%set_parents ([3,4])

	call pset%prt(1)%set_momentum (vector4_at_rest (1._default))
	call pset%prt(2)%set_momentum (vector4_at_rest (2._default))
	call pset%prt(3)%set_momentum (vector4_at_rest (4._default))
	call pset%prt(4)%set_momentum (vector4_at_rest (6._default))
	call pset%prt(5)%set_momentum (vector4_at_rest (3._default))
	call pset%prt(6)%set_momentum (vector4_at_rest (5._default))
	call pset%prt(7)%set_momentum (vector4_at_rest (7._default))
	call pset%prt(8)%set_momentum (vector4_at_rest (8._default))
	call pset%prt(9)%set_momentum (vector4_at_rest (9._default))

	allocate (flv (9))
	call flv%init ([2011, 2012, 11, 12, 91, 92, 3, 4, 5])
	do i = 1, 9
	call pset%prt(i)%set_flavor (flv(i))
	end do
	end subroutine create_test_particle_set_1

	@ %def create_test_particle_set_1

	@
	Reconstruct an interaction with beam structure, e.g., a hadronic
	interaction, from a particle set that is missing the beam information.
	<<Particles: execute tests>>=
	call test (particles_4, "particles_4", &
	"reconstruct interaction with missing beams", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_4
	<<Particles: tests>>=
	subroutine particles_4 (u)

	integer, intent(in) :: u
	type(interaction_t) :: int
	type(interaction_t), target :: int_beams
	type(state_flv_content_t) :: state_flv
	type(particle_set_t) :: pset
	type(flavor_t), dimension(:), allocatable :: flv
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: i, j

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: reconstruct beams"
	write (u, "(A)")

	call reset_interaction_counter ()

	write (u, "(A)") "* Set up an interaction that contains beams only"
	write (u, "(A)")

	call int_beams%basic_init (0, 0, 2)
	call int_beams%set_momentum (vector4_at_rest (1._default), 1)
	call int_beams%set_momentum (vector4_at_rest (2._default), 2)
	allocate (qn (2))
	call int_beams%add_state (qn)
	call int_beams%freeze ()

	call int_beams%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Set up a 2 -> 2 -> 3 interaction with radiation"
	write (u, "(A)") " + no quantum numbers"
	write (u, "(A)")

	call int%basic_init (0, 6, 3)
	call int%relate (1, 3)
	call int%relate (1, 4)
	call int%relate (2, 5)
	call int%relate (2, 6)
	do i = 4, 6, 2
	do j = 7, 9
	call int%relate (i, j)
	end do
	end do
	do i = 1, 2
	call int%set_source_link (i, int_beams, i)
	end do

	deallocate (qn)
	allocate (qn (9))
	call int%add_state (qn)
	call int%freeze ()

	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set up a flavor-content record"
	write (u, "(A)")

	call state_flv%init (1, &
	mask = [.false., .false., .false., .false., .false., .false., &
	.true., .true., .true.])
	call state_flv%set_entry (1, &
	pdg = [2011, 2012, 91, 11, 92, 12, 3, 4, 5], &
	map = [1, 2, 3, 4, 5, 6, 7, 8, 9])

	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually create a matching particle set"
	write (u, "(A)")

	pset%n_beam = 0
	pset%n_in = 2
	pset%n_vir = 0
	pset%n_out = 3
	pset%n_tot = 5

	allocate (pset%prt (pset%n_tot))
	call pset%prt(1)%reset_status (PRT_INCOMING)
	call pset%prt(2)%reset_status (PRT_INCOMING)
	call pset%prt(3)%reset_status (PRT_OUTGOING)
	call pset%prt(4)%reset_status (PRT_OUTGOING)
	call pset%prt(5)%reset_status (PRT_OUTGOING)

	call pset%prt(1)%set_children ([3,4,5])
	call pset%prt(2)%set_children ([3,4,5])

	call pset%prt(3)%set_parents ([1,2])
	call pset%prt(4)%set_parents ([1,2])
	call pset%prt(5)%set_parents ([1,2])

	call pset%prt(1)%set_momentum (vector4_at_rest (6._default))
	call pset%prt(2)%set_momentum (vector4_at_rest (6._default))
	call pset%prt(3)%set_momentum (vector4_at_rest (3._default))
	call pset%prt(4)%set_momentum (vector4_at_rest (4._default))
	call pset%prt(5)%set_momentum (vector4_at_rest (5._default))

	allocate (flv (5))
	call flv%init ([11, 12, 3, 4, 5])
	do i = 1, 5
	call pset%prt(i)%set_flavor (flv(i))
	end do

	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill interaction from particle set"
	write (u, "(A)")

	call pset%fill_interaction (int, 2, state_flv=state_flv, &
	recover_beams = .true.)
	call int%basic_write (u)

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

	call int%final ()
	call pset%final ()

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

	end subroutine particles_4

	@ %def particles_4
	@
	Reconstruct an interaction with beam structure and cloned particles
	(radiated particles repeated in the event record, to maintain some
	canonical ordering).
	<<Particles: execute tests>>=
	call test (particles_5, "particles_5", &
	"reconstruct interaction with beams and duplicate entries", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_5
	<<Particles: tests>>=
	subroutine particles_5 (u)

	integer, intent(in) :: u
	type(interaction_t) :: int
	type(state_flv_content_t) :: state_flv
	type(particle_set_t) :: pset
	type(flavor_t), dimension(:), allocatable :: flv
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: i, j

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: reconstruct event with duplicate entries"
	write (u, "(A)")

	write (u, "(A)") "* Set up a 2 -> 2 -> 3 interaction with radiation"
	write (u, "(A)") " + no quantum numbers"
	write (u, "(A)")

	call reset_interaction_counter ()
	call int%basic_init (0, 6, 3)
	call int%relate (1, 3)
	call int%relate (1, 4)
	call int%relate (2, 5)
	call int%relate (2, 6)
	do i = 4, 6, 2
	do j = 7, 9
	call int%relate (i, j)
	end do
	end do

	allocate (qn (9))
	call int%add_state (qn)
	call int%freeze ()

	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set up a flavor-content record"
	write (u, "(A)")

	call state_flv%init (1, &
	mask = [.false., .false., .false., .false., .false., .false., &
	.true., .true., .true.])
	call state_flv%set_entry (1, &
	pdg = [2011, 2012, 91, 11, 92, 12, 3, 4, 5], &
	map = [1, 2, 3, 4, 5, 6, 7, 8, 9])

	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually create a matching particle set"
	write (u, "(A)")

	pset%n_beam = 2
	pset%n_in = 2
	pset%n_vir = 4
	pset%n_out = 5
	pset%n_tot = 13

	allocate (pset%prt (pset%n_tot))
	call pset%prt(1)%reset_status (PRT_BEAM)
	call pset%prt(2)%reset_status (PRT_BEAM)
	call pset%prt(3)%reset_status (PRT_VIRTUAL)
	call pset%prt(4)%reset_status (PRT_VIRTUAL)
	call pset%prt(5)%reset_status (PRT_VIRTUAL)
	call pset%prt(6)%reset_status (PRT_VIRTUAL)
	call pset%prt(7)%reset_status (PRT_INCOMING)
	call pset%prt(8)%reset_status (PRT_INCOMING)
	call pset%prt( 9)%reset_status (PRT_OUTGOING)
	call pset%prt(10)%reset_status (PRT_OUTGOING)
	call pset%prt(11)%reset_status (PRT_OUTGOING)
	call pset%prt(12)%reset_status (PRT_OUTGOING)
	call pset%prt(13)%reset_status (PRT_OUTGOING)

	call pset%prt(1)%set_children ([3,4])
	call pset%prt(2)%set_children ([5,6])
	call pset%prt(3)%set_children ([ 7])
	call pset%prt(4)%set_children ([ 9])
	call pset%prt(5)%set_children ([ 8])
	call pset%prt(6)%set_children ([10])
	call pset%prt(7)%set_children ([11,12,13])
	call pset%prt(8)%set_children ([11,12,13])

	call pset%prt(3)%set_parents ([1])
	call pset%prt(4)%set_parents ([1])
	call pset%prt(5)%set_parents ([2])
	call pset%prt(6)%set_parents ([2])
	call pset%prt( 7)%set_parents ([3])
	call pset%prt( 8)%set_parents ([5])
	call pset%prt( 9)%set_parents ([4])
	call pset%prt(10)%set_parents ([6])
	call pset%prt(11)%set_parents ([7,8])
	call pset%prt(12)%set_parents ([7,8])
	call pset%prt(13)%set_parents ([7,8])

	call pset%prt(1)%set_momentum (vector4_at_rest (1._default))
	call pset%prt(2)%set_momentum (vector4_at_rest (2._default))
	call pset%prt(3)%set_momentum (vector4_at_rest (4._default))
	call pset%prt(4)%set_momentum (vector4_at_rest (3._default))
	call pset%prt(5)%set_momentum (vector4_at_rest (6._default))
	call pset%prt(6)%set_momentum (vector4_at_rest (5._default))
	call pset%prt(7)%set_momentum (vector4_at_rest (4._default))
	call pset%prt(8)%set_momentum (vector4_at_rest (6._default))
	call pset%prt( 9)%set_momentum (vector4_at_rest (3._default))
	call pset%prt(10)%set_momentum (vector4_at_rest (5._default))
	call pset%prt(11)%set_momentum (vector4_at_rest (7._default))
	call pset%prt(12)%set_momentum (vector4_at_rest (8._default))
	call pset%prt(13)%set_momentum (vector4_at_rest (9._default))

	allocate (flv (13))
	call flv%init ([2011, 2012, 11, 91, 12, 92, 11, 12, 91, 92, 3, 4, 5])
	do i = 1, 13
	call pset%prt(i)%set_flavor (flv(i))
	end do

	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill interaction from particle set"
	write (u, "(A)")

	call pset%fill_interaction (int, 2, state_flv=state_flv)
	call int%basic_write (u)

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

	call int%final ()
	call pset%final ()

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

	end subroutine particles_5

	@ %def particles_5
	@
	Reconstruct an interaction with pair spectrum, e.g., beamstrahlung from a
	particle set.
	<<Particles: execute tests>>=
	call test (particles_6, "particles_6", &
	"reconstruct interaction with pair spectrum", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_6
	<<Particles: tests>>=
	subroutine particles_6 (u)

	integer, intent(in) :: u
	type(interaction_t) :: int
	type(state_flv_content_t) :: state_flv
	type(particle_set_t) :: pset
	type(flavor_t), dimension(:), allocatable :: flv
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: i, j

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: reconstruct interaction with pair spectrum"
	write (u, "(A)")

	write (u, "(A)") "* Set up a 2 -> 2 -> 3 interaction with radiation"
	write (u, "(A)") " + no quantum numbers"
	write (u, "(A)")

	call reset_interaction_counter ()
	call int%basic_init (0, 6, 3)
	do i = 1, 2
	do j = 3, 6
	call int%relate (i, j)
	end do
	end do
	do i = 5, 6
	do j = 7, 9
	call int%relate (i, j)
	end do
	end do

	allocate (qn (9))
	call int%add_state (qn)
	call int%freeze ()

	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set up a flavor-content record"
	write (u, "(A)")

	call state_flv%init (1, &
	mask = [.false., .false., .false., .false., .false., .false., &
	.true., .true., .true.])
	call state_flv%set_entry (1, &
	pdg = [1011, 1012, 21, 22, 11, 12, 3, 4, 5], &
	map = [1, 2, 3, 4, 5, 6, 7, 8, 9])

	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually create a matching particle set"
	write (u, "(A)")

	pset%n_beam = 2
	pset%n_in = 2
	pset%n_vir = 2
	pset%n_out = 3
	pset%n_tot = 9

	allocate (pset%prt (pset%n_tot))
	call pset%prt(1)%reset_status (PRT_BEAM)
	call pset%prt(2)%reset_status (PRT_BEAM)
	call pset%prt(3)%reset_status (PRT_INCOMING)
	call pset%prt(4)%reset_status (PRT_INCOMING)
	call pset%prt(5)%reset_status (PRT_OUTGOING)
	call pset%prt(6)%reset_status (PRT_OUTGOING)
	call pset%prt(7)%reset_status (PRT_OUTGOING)
	call pset%prt(8)%reset_status (PRT_OUTGOING)
	call pset%prt(9)%reset_status (PRT_OUTGOING)

	call pset%prt(1)%set_children ([3,4,5,6])
	call pset%prt(2)%set_children ([3,4,5,6])
	call pset%prt(3)%set_children ([7,8,9])
	call pset%prt(4)%set_children ([7,8,9])

	call pset%prt(3)%set_parents ([1,2])
	call pset%prt(4)%set_parents ([1,2])
	call pset%prt(5)%set_parents ([1,2])
	call pset%prt(6)%set_parents ([1,2])
	call pset%prt(7)%set_parents ([3,4])
	call pset%prt(8)%set_parents ([3,4])
	call pset%prt(9)%set_parents ([3,4])

	call pset%prt(1)%set_momentum (vector4_at_rest (1._default))
	call pset%prt(2)%set_momentum (vector4_at_rest (2._default))
	call pset%prt(3)%set_momentum (vector4_at_rest (5._default))
	call pset%prt(4)%set_momentum (vector4_at_rest (6._default))
	call pset%prt(5)%set_momentum (vector4_at_rest (3._default))
	call pset%prt(6)%set_momentum (vector4_at_rest (4._default))
	call pset%prt(7)%set_momentum (vector4_at_rest (7._default))
	call pset%prt(8)%set_momentum (vector4_at_rest (8._default))
	call pset%prt(9)%set_momentum (vector4_at_rest (9._default))

	allocate (flv (9))
	call flv%init ([1011, 1012, 11, 12, 21, 22, 3, 4, 5])
	do i = 1, 9
	call pset%prt(i)%set_flavor (flv(i))
	end do

	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill interaction from particle set"
	write (u, "(A)")

	call pset%fill_interaction (int, 2, state_flv=state_flv)
	call int%basic_write (u)

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

	call int%final ()
	call pset%final ()

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

	end subroutine particles_6

	@ %def particles_6
	@
	Reconstruct a hard decay interaction from a shuffled particle set.
	<<Particles: execute tests>>=
	call test (particles_7, "particles_7", &
	"reconstruct decay interaction with reordering", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_7
	<<Particles: tests>>=
	subroutine particles_7 (u)

	integer, intent(in) :: u
	type(interaction_t) :: int
	type(state_flv_content_t) :: state_flv
	type(particle_set_t) :: pset
	type(flavor_t), dimension(:), allocatable :: flv
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: i, j

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: reconstruct decay interaction with reordering"
	write (u, "(A)")

	write (u, "(A)") "* Set up a 1 -> 3 interaction"
	write (u, "(A)") " + no quantum numbers"
	write (u, "(A)")

	call reset_interaction_counter ()
	call int%basic_init (0, 1, 3)
	do j = 2, 4
	call int%relate (1, j)
	end do

	allocate (qn (4))
	call int%add_state (qn)
	call int%freeze ()

	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set up a flavor-content record"
	write (u, "(A)") "* assumed interaction: 6 12 5 -11"
	write (u, "(A)")

	call state_flv%init (1, &
	mask = [.false., .true., .true., .true.])
	call state_flv%set_entry (1, &
	pdg = [6, 5, -11, 12], &
	map = [1, 4, 2, 3])

	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually create a matching particle set"
	write (u, "(A)")

	pset%n_beam = 0
	pset%n_in = 1
	pset%n_vir = 0
	pset%n_out = 3
	pset%n_tot = 4
	allocate (pset%prt (pset%n_tot))
	do i = 1, 1
	call pset%prt(i)%reset_status (PRT_INCOMING)
	call pset%prt(i)%set_children ([2,3,4])
	end do
	do i = 2, 4
	call pset%prt(i)%reset_status (PRT_OUTGOING)
	call pset%prt(i)%set_parents ([1])
	end do
	call pset%prt(1)%set_momentum (vector4_at_rest (1._default))
	call pset%prt(2)%set_momentum (vector4_at_rest (3._default))
	call pset%prt(3)%set_momentum (vector4_at_rest (2._default))
	call pset%prt(4)%set_momentum (vector4_at_rest (4._default))

	allocate (flv (4))
	call flv%init ([6,5,12,-11])
	do i = 1, 4
	call pset%prt(i)%set_flavor (flv(i))
	end do

	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill interaction from particle set"
	write (u, "(A)")

	call pset%fill_interaction (int, 1, state_flv=state_flv)
	call int%basic_write (u)

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

	call int%final ()
	call pset%final ()

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

	end subroutine particles_7

	@ %def particles_7
	@
	<<Particles: execute tests>>=
	call test (particles_8, "particles_8", &
	"Test functions on particle sets", u, results)
	<<Particles: test declarations>>=
	public :: particles_8
	<<Particles: tests>>=
	subroutine particles_8 (u)
	integer, intent(in) :: u
	type(particle_set_t) :: particle_set
	type(particle_t), dimension(:), allocatable :: particles
	integer, allocatable, dimension(:) :: children, parents
	integer :: n_particles, i
	write (u, "(A)") "* Test output: particles_8"
	write (u, "(A)") "* Purpose: Test functions on particle sets"
	write (u, "(A)")

	call create_test_particle_set_1 (particle_set)
	call particle_set%write (u)
	call assert_equal (u, particle_set%n_tot, 9)
	call assert_equal (u, particle_set%n_beam, 2)
	allocate (children (particle_set%prt(3)%get_n_children ()))
	children = particle_set%prt(3)%get_children()
	call assert_equal (u, particle_set%prt(children(1))%get_pdg (), 3)
	call assert_equal (u, size (particle_set%prt(1)%get_children ()), 2)
	call assert_equal (u, size (particle_set%prt(2)%get_children ()), 2)

	call particle_set%without_hadronic_remnants &
	(particles, n_particles, 3)
	call particle_set%replace (particles)
	write (u, "(A)")
	call particle_set%write (u)

	call assert_equal (u, n_particles, 7)
	call assert_equal (u, size(particles), 10)
	call assert_equal (u, particle_set%n_tot, 10)
	call assert_equal (u, particle_set%n_beam, 2)
	do i = 3, 4
	if (allocated (children)) deallocate (children)
	allocate (children (particle_set%prt(i)%get_n_children ()))
	children = particle_set%prt(i)%get_children()
	call assert_equal (u, particle_set%prt(children(1))%get_pdg (), 3)
	call assert_equal (u, particle_set%prt(children(2))%get_pdg (), 4)
	call assert_equal (u, particle_set%prt(children(3))%get_pdg (), 5)
	end do
	do i = 5, 7
	if (allocated (parents)) deallocate (parents)
	allocate (parents (particle_set%prt(i)%get_n_parents ()))
	parents = particle_set%prt(i)%get_parents()
	call assert_equal (u, particle_set%prt(parents(1))%get_pdg (), 11)
	call assert_equal (u, particle_set%prt(parents(2))%get_pdg (), 12)
	end do
	call assert_equal (u, size (particle_set%prt(1)%get_children ()), &
	1, "get children of 1")
	call assert_equal (u, size (particle_set%prt(2)%get_children ()), &
	1, "get children of 2")

	call assert_equal (u, particle_set%find_particle &
	(particle_set%prt(1)%get_pdg (), particle_set%prt(1)%p), &
	1, "find 1st particle")
	call assert_equal (u, particle_set%find_particle &
	(particle_set%prt(2)%get_pdg (), particle_set%prt(2)%p * &
	(one + tiny_07), rel_smallness=1.0E-6_default), &
	2, "find 2nd particle fuzzy")

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

	@ %def particles_8
	@
	Order color lines into Lund string systems, without colored beam
	remnants first.
	<<Particles: execute tests>>=
	call test (particles_9, "particles_9", &
	"order into Lund strings, uncolored beam remnants", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_9
	<<Particles: tests>>=
	subroutine particles_9 (u)
	integer, intent(in) :: u
	write (u, "(A)") "* Test output: particles_9"
	write (u, "(A)") "* Purpose: Order into Lund strings, "
	write (u, "(A)") "* uncolored beam remnants"
	write (u, "(A)")
	end subroutine particles_9

	@ %def particles_9
	Index: trunk/src/lhapdf/LHAPDFWrap.cpp
	===================================================================
	--- trunk/src/lhapdf/LHAPDFWrap.cpp (revision 8835)
	+++ trunk/src/lhapdf/LHAPDFWrap.cpp (revision 8836)
	@@ -1,77 +1,82 @@
	#include "LHAPDF/LHAPDF.h"
	#include "LHAPDF/Info.h"
	#include "LHAPDF/Exceptions.h"

	using namespace LHAPDF;
	using namespace std;

	extern "C" {

	- LHAPDF::PDF* lhapdf_init_pdf (char* setname, const int imem) {
	+ LHAPDF::PDF* lhapdf_init_pdf (char* setname, const int imem) {
	LHAPDF::PDF* pdf = LHAPDF::mkPDF(setname, imem);
	return pdf;
	}

	void lhapdf_pdf_delete (LHAPDF::PDF* pdf) {
	delete pdf;
	}

	double lhapdf_pdf_getxmin (LHAPDF::PDF* pdf) {
	return pdf->xMin();
	}

	double lhapdf_pdf_getxmax (LHAPDF::PDF* pdf) {
	return pdf->xMax();
	}

	double lhapdf_pdf_getq2min (LHAPDF::PDF* pdf) {
	return pdf->q2Min();
	}

	double lhapdf_pdf_getq2max (LHAPDF::PDF* pdf) {
	return pdf->q2Max();
	}
	-
	+
	bool lhapdf_has_photon (const LHAPDF::PDF* pdf) {
	return pdf->hasFlavor(22);
	}

	/// Get xf(x) values for common partons from PDF pdf
	// Evaluate for the 13 LHAPDF5 standard partons
	void lhapdf_evolvepdfm (const LHAPDF::PDF* pdf, const double x, const double q, double* fxq) {
	for (size_t i = 0; i < 13; ++i) {
	fxq[i] = pdf->xfxQ(i-6, x, q);
	}
	}
	-
	+
	/// Get xfx values from current PDF, including an extra photon flavor
	void lhapdf_evolvepdfphotonm (const LHAPDF::PDF* pdf, const double x, const double q, double* fxq, double &photonfxq) {
	lhapdf_evolvepdfm (pdf, x, q, fxq);
	photonfxq = pdf->xfxQ(22, x, q);
	}
	-
	+
	void lhapdf_evolvepdfpm (const LHAPDF::PDF* pdf, const double x, const double q, const double s, const int scheme, double fxq) {
	throw LHAPDF::NotImplementedError("Photon structure function are not yet supported");
	}

	double lhapdf_getqmass (const LHAPDF::PDF* pdf, const int nf) {
	if (nf*nf == 1) return pdf->info().get_entry_as<double>("MDown");
	else if (nf*nf == 4) return pdf->info().get_entry_as<double>("MUp");
	else if (nf*nf == 9) return pdf->info().get_entry_as<double>("MStrange");
	else if (nf*nf == 16) return pdf->info().get_entry_as<double>("MCharm");
	else if (nf*nf == 25) return pdf->info().get_entry_as<double>("MBottom");
	else if (nf*nf == 36) return pdf->info().get_entry_as<double>("MTop");
	else throw LHAPDF::UserError("Trying to get quark mass for invalid quark ID #" + LHAPDF::to_str(nf));
	}

	int lhapdf_numpdfm (const LHAPDF::PDF* pdf, int numpdf) {
	numpdf = pdf->info().get_entry_as<int>("NumMembers");
	if (numpdf > 1) numpdf-=1;
	return numpdf;
	}

	double lhapdf_alphaspdf (const LHAPDF::PDF* pdf, const double q) {
	return pdf->alphasQ(q);
	}

	+ int lhapdf_getorder (const LHAPDF::PDF* pdf, int order) {
	+ order = pdf->info().get_entry_as<int>("OrderQCD");
	+ return order;
	+ }
	+
	}
	Index: trunk/src/lhapdf/lhapdf.f90
	===================================================================
	--- trunk/src/lhapdf/lhapdf.f90 (revision 8835)
	+++ trunk/src/lhapdf/lhapdf.f90 (revision 8836)
	@@ -1,302 +1,317 @@
	!$Id: lhapdf.f90 6133 2014-09-17 14:42:33Z kilian $

	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	!
	! Copyright (C) 1999-2022 by
	! Wolfgang Kilian <kilian@physik.uni-siegen.de>
	! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
	! Juergen Reuter <juergen.reuter@desy.de>
	! with contributions from
	! Bijan Chokoufe <bijan.chokoufe@desy.de>
	! Fabian Bach <fabian.bach@t-online.de>
	! Christian Speckner <cnspeckn@googlemail.com>
	!
	! WHIZARD is free software; you can redistribute it and/or modify it
	! under the terms of the GNU General Public License as published by
	! the Free Software Foundation; either version 2, or (at your option)
	! any later version.
	!
	! WHIZARD is distributed in the hope that it will be useful, but
	! WITHOUT ANY WARRANTY; without even the implied warranty of
	! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	! GNU General Public License for more details.
	!
	! You should have received a copy of the GNU General Public License
	! along with this program; if not, write to the Free Software
	! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
	!
	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

	module lhapdf

	use, intrinsic :: iso_c_binding
	use kinds

	implicit none
	private

	! Public types
	public :: lhapdf_pdf_t

	public :: lhapdf_copy_pointer

	type :: lhapdf_pdf_t
	private
	type(c_ptr) :: cptr
	contains
	procedure :: init => lhapdf_pdf_init
	procedure :: is_associated => lhapdf_is_associated
	procedure :: getxmin => lhapdf_getxmin
	procedure :: getxmax => lhapdf_getxmax
	procedure :: getq2min => lhapdf_getq2min
	procedure :: getq2max => lhapdf_getq2max
	procedure :: has_photon => lhapdf_hasphoton
	procedure :: evolve_pdfm => lhapdf_evolve_pdfm
	procedure :: evolve_pdfphotonm => lhapdf_evolve_pdfphotonm
	procedure :: evolve_pdfpm => lhapdf_evolve_pdfpm
	procedure :: get_qmass => lhapdf_get_qmass
	+ procedure :: get_order => lhapdf_get_order
	procedure :: num_pdfm => lhapdf_num_pdfm
	procedure :: alphas_pdf => lhapdf_alphas_pdf
	procedure :: final => lhapdf_final
	end type lhapdf_pdf_t

	! Interface for generic operators

	interface
	function lhapdf_init_pdf (setname, imem) bind (C) result (pdf)
	import
	integer(c_int), intent(in), value :: imem
	character(len=1, kind=c_char), dimension(*), intent(in) :: setname
	type(c_ptr) :: pdf
	end function lhapdf_init_pdf
	end interface

	interface
	subroutine lhapdf_pdf_delete (pdf) bind (C)
	import
	type(c_ptr), value :: pdf
	end subroutine lhapdf_pdf_delete
	end interface

	interface
	function lhapdf_pdf_getxmin (pdf) bind (C) result (xmin)
	import
	type(c_ptr), intent(in), value :: pdf
	real(c_double) :: xmin
	end function lhapdf_pdf_getxmin
	end interface

	interface
	function lhapdf_pdf_getxmax (pdf) bind (C) result (xmax)
	import
	type(c_ptr), intent(in), value :: pdf
	real(c_double) :: xmax
	end function lhapdf_pdf_getxmax
	end interface

	interface
	function lhapdf_pdf_getq2min (pdf) bind (C) result (q2min)
	import
	type(c_ptr), intent(in), value :: pdf
	real(c_double) :: q2min
	end function lhapdf_pdf_getq2min
	end interface

	interface
	function lhapdf_pdf_getq2max (pdf) bind (C) result (q2max)
	import
	type(c_ptr), intent(in), value :: pdf
	real(c_double) :: q2max
	end function lhapdf_pdf_getq2max
	end interface

	interface
	function lhapdf_has_photon (pdf) bind (C) result (flag)
	import
	type(c_ptr), intent(in), value :: pdf
	logical(c_bool) :: flag
	end function lhapdf_has_photon
	end interface

	interface
	subroutine lhapdf_evolvepdfm (pdf, x, q, ff) bind (C)
	import
	type(c_ptr), intent(in), value :: pdf
	real(c_double), intent(in), value :: x, q
	real(c_double), dimension(-6:6), intent(out) :: ff
	end subroutine lhapdf_evolvepdfm
	end interface

	interface
	subroutine lhapdf_evolvepdfphotonm (pdf, x, q, ff, fphot) bind (C)
	import
	type(c_ptr), intent(in), value :: pdf
	real(c_double), intent(in), value :: x, q
	real(c_double), dimension(-6:6), intent(out) :: ff
	real(c_double), intent(out) :: fphot
	end subroutine lhapdf_evolvepdfphotonm
	end interface

	interface
	subroutine lhapdf_evolvepdfpm (pdf, x, q, s, scheme, ff) bind (C)
	import
	type(c_ptr), intent(in), value :: pdf
	integer(c_int), intent(in), value :: scheme
	real(c_double), intent(in), value :: x, q, s
	real(c_double), dimension(-6:6), intent(out) :: ff
	end subroutine lhapdf_evolvepdfpm
	end interface

	interface
	function lhapdf_getqmass (pdf, nf) bind (C) result (mass)
	import
	type(c_ptr), intent(in), value :: pdf
	integer(c_int), intent(in), value :: nf
	real(c_double) :: mass
	end function lhapdf_getqmass
	end interface

	interface
	+ function lhapdf_getorder (pdf) bind (C) result (order)
	+ import
	+ type(c_ptr), intent(in), value :: pdf
	+ integer(c_int) :: order
	+ end function lhapdf_getorder
	+ end interface
	+
	+ interface
	function lhapdf_numpdfm (pdf) bind (C) result (numpdf)
	import
	type(c_ptr), intent(in), value :: pdf
	integer(c_int) :: numpdf
	end function lhapdf_numpdfm
	end interface

	interface
	function lhapdf_alphaspdf (pdf, q) bind (C) result (as)
	import
	type(c_ptr), intent(in), value :: pdf
	real(c_double), intent(in), value :: q
	real(c_double) :: as
	end function lhapdf_alphaspdf
	end interface

	contains

	subroutine lhapdf_pdf_init (pdf, setname, imem)
	class(lhapdf_pdf_t), intent(out) :: pdf
	character(*), intent(in) :: setname
	integer, intent(in) :: imem
	character(len=1, kind=c_char), dimension(len(setname)+1) :: pdf_setname
	integer(c_int) :: pdf_imem
	integer :: i, strlen
	strlen = len(setname)
	forall (i=1:strlen)
	pdf_setname(i) = setname(i:i)
	end forall
	pdf_setname(strlen+1) = c_null_char
	pdf_imem = imem
	pdf%cptr = lhapdf_init_pdf (pdf_setname, pdf_imem)
	end subroutine lhapdf_pdf_init

	function lhapdf_is_associated (pdf) result (flag)
	class(lhapdf_pdf_t), intent(in) :: pdf
	logical :: flag
	flag = c_associated (pdf%cptr)
	end function lhapdf_is_associated

	function lhapdf_getxmin (pdf) result (xmin)
	class(lhapdf_pdf_t), intent(in) :: pdf
	real(double) :: xmin
	xmin = lhapdf_pdf_getxmin (pdf%cptr)
	end function lhapdf_getxmin

	function lhapdf_getxmax (pdf) result (xmax)
	class(lhapdf_pdf_t), intent(in) :: pdf
	real(double) :: xmax
	xmax = lhapdf_pdf_getxmax (pdf%cptr)
	end function lhapdf_getxmax

	function lhapdf_getq2min (pdf) result (q2min)
	class(lhapdf_pdf_t), intent(in) :: pdf
	real(double) :: q2min
	q2min = lhapdf_pdf_getq2min (pdf%cptr)
	end function lhapdf_getq2min

	function lhapdf_getq2max (pdf) result (q2max)
	class(lhapdf_pdf_t), intent(in) :: pdf
	real(double) :: q2max
	q2max = lhapdf_pdf_getq2max (pdf%cptr)
	end function lhapdf_getq2max

	function lhapdf_hasphoton (pdf) result (flag)
	class(lhapdf_pdf_t), intent(in) :: pdf
	logical :: flag
	flag = lhapdf_has_photon (pdf%cptr)
	end function lhapdf_hasphoton

	subroutine lhapdf_evolve_pdfm (pdf, x, q, ff)
	class(lhapdf_pdf_t), intent(inout) :: pdf
	real(double), intent(in) :: x, q
	real(double), dimension(-6:6), intent(out) :: ff
	real(c_double) :: c_x, c_q
	c_x = x
	c_q = q
	call lhapdf_evolvepdfm (pdf%cptr, c_x, c_q, ff)
	end subroutine lhapdf_evolve_pdfm

	subroutine lhapdf_evolve_pdfphotonm (pdf, x, q, ff, fphot)
	class(lhapdf_pdf_t), intent(inout) :: pdf
	real(double), intent(in) :: x, q
	real(double), dimension(-6:6), intent(out) :: ff
	real(double), intent(out) :: fphot
	real(c_double) :: c_x, c_q
	c_x = x
	c_q = q
	call lhapdf_evolvepdfphotonm &
	(pdf%cptr, c_x, c_q, ff, fphot)
	end subroutine lhapdf_evolve_pdfphotonm

	subroutine lhapdf_evolve_pdfpm (pdf, x, q, s, scheme, ff)
	class(lhapdf_pdf_t), intent(inout) :: pdf
	real(double), intent(in) :: x, q, s
	integer, intent(in) :: scheme
	real(double), dimension(-6:6), intent(out) :: ff
	real(c_double) :: c_x, c_q, c_s
	integer(c_int) :: c_scheme
	c_x = x
	c_q = q
	c_s = s
	c_scheme = scheme
	call lhapdf_evolvepdfpm (pdf%cptr, &
	c_x, c_q, c_s, c_scheme, ff)
	end subroutine lhapdf_evolve_pdfpm

	function lhapdf_get_qmass (pdf, nf) result (mass)
	class(lhapdf_pdf_t), intent(in) :: pdf
	integer, intent(in) :: nf
	real(double) :: mass
	integer(c_int) :: c_nf
	c_nf = nf
	mass = lhapdf_getqmass (pdf%cptr, c_nf)
	end function lhapdf_get_qmass

	+ function lhapdf_get_order (pdf) result (order)
	+ class(lhapdf_pdf_t), intent(in) :: pdf
	+ integer(c_int) :: order
	+ order = lhapdf_getorder (pdf%cptr)
	+ end function lhapdf_get_order
	+
	function lhapdf_num_pdfm (pdf) result (numpdf)
	class(lhapdf_pdf_t), intent(inout) :: pdf
	integer :: numpdf
	numpdf = lhapdf_numpdfm (pdf%cptr)
	end function lhapdf_num_pdfm

	function lhapdf_alphas_pdf (pdf, q) result (as)
	class(lhapdf_pdf_t), intent(in), target :: pdf
	real(double), intent(in) :: q
	real(double) :: as
	real(c_double) :: c_q = 0
	c_q = q
	as = lhapdf_alphaspdf (pdf%cptr, c_q)
	end function lhapdf_alphas_pdf

	subroutine lhapdf_final (pdf)
	class(lhapdf_pdf_t), intent(inout) :: pdf
	call lhapdf_pdf_delete (pdf%cptr)
	end subroutine lhapdf_final

	subroutine lhapdf_copy_pointer (pdf_in, pdf_out)
	type(lhapdf_pdf_t), intent(in), target :: pdf_in
	type(lhapdf_pdf_t), intent(out), target :: pdf_out
	pdf_out%cptr = transfer (pdf_in%cptr, pdf_out%cptr)
	end subroutine lhapdf_copy_pointer

	end module lhapdf
	Index: trunk/src/lhapdf/LHAPDFWrap_dummy.f90
	===================================================================
	--- trunk/src/lhapdf/LHAPDFWrap_dummy.f90 (revision 8835)
	+++ trunk/src/lhapdf/LHAPDFWrap_dummy.f90 (revision 8836)
	@@ -1,85 +1,89 @@
	function lhapdf_init_pdf (setname, imem) bind (C) result (pdf)
	use iso_c_binding
	character(len=1, kind=c_char), dimension(*), intent(in) :: setname
	- integer(c_int), intent(in), value :: imem
	+ integer(c_int), intent(in), value :: imem
	type(c_ptr) :: pdf
	end function lhapdf_init_pdf

	subroutine lhapdf_pdf_delete (pdf) bind (C)
	use iso_c_binding
	type(c_ptr), value :: pdf
	end subroutine lhapdf_pdf_delete

	function lhapdf_pdf_getxmin (pdf) bind (C) result (xmin)
	use iso_c_binding
	type(c_ptr), intent(in), value :: pdf
	real(c_double) :: xmin
	end function lhapdf_pdf_getxmin

	function lhapdf_pdf_getxmax (pdf) bind (C) result (xmax)
	use iso_c_binding
	type(c_ptr), intent(in), value :: pdf
	real(c_double) :: xmax
	end function lhapdf_pdf_getxmax

	function lhapdf_pdf_getq2min (pdf) bind (C) result (q2min)
	use iso_c_binding
	type(c_ptr), intent(in), value :: pdf
	real(c_double) :: q2min
	end function lhapdf_pdf_getq2min

	function lhapdf_pdf_getq2max (pdf) bind (C) result (q2max)
	use iso_c_binding
	type(c_ptr), intent(in), value :: pdf
	real(c_double) :: q2max
	end function lhapdf_pdf_getq2max

	function lhapdf_has_photon (pdf) bind (C) result (flag)
	use iso_c_binding
	type(c_ptr), intent(in), value :: pdf
	logical(c_bool) :: flag
	end function lhapdf_has_photon

	subroutine lhapdf_evolvepdfm (pdf, x, q, ff) bind (C)
	use iso_c_binding
	type(c_ptr), intent(in), value :: pdf
	real(c_double), intent(in), value :: x, q
	real(c_double), dimension(-6:6), intent(out) :: ff
	end subroutine lhapdf_evolvepdfm

	subroutine lhapdf_evolvepdfphotonm (pdf, x, q, ff, fphot) bind (C)
	use iso_c_binding
	type(c_ptr), intent(in), value :: pdf
	real(c_double), intent(in), value :: x, q
	real(c_double), dimension(-6:6), intent(out) :: ff
	real(c_double), intent(out) :: fphot
	end subroutine lhapdf_evolvepdfphotonm

	subroutine lhapdf_evolvepdfpm (pdf, x, q, s, scheme, ff) bind (C)
	use iso_c_binding
	type(c_ptr), intent(in), value :: pdf
	integer(c_int), intent(in), value :: scheme
	real(c_double), intent(in), value :: x, q, s
	real(c_double), dimension(-6:6), intent(out) :: ff
	end subroutine lhapdf_evolvepdfpm

	function lhapdf_getqmass (pdf, nf) bind (C) result (mass)
	use iso_c_binding
	type(c_ptr), intent(in), value :: pdf
	integer(c_int), intent(in), value :: nf
	real(c_double) :: mass
	end function lhapdf_getqmass

	function lhapdf_numpdfm (pdf) bind (C) result (numpdf)
	use iso_c_binding
	type(c_ptr), intent(in), value :: pdf
	integer(c_int) :: numpdf
	end function lhapdf_numpdfm

	function lhapdf_alphaspdf (pdf) bind (C) result (as)
	use iso_c_binding
	type(c_ptr), intent(in), value :: pdf
	real(c_double) :: as
	end function lhapdf_alphaspdf

	-
	+function lhapdf_getorder (pdf) bind (C) result (order)
	+ use iso_c_binding
	+ type(c_ptr), intent(in) :: pdf
	+ integer(c_int) :: order
	+end function lhapdf_getorder
	Index: trunk/src/transforms/transforms.nw
	===================================================================
	--- trunk/src/transforms/transforms.nw (revision 8835)
	+++ trunk/src/transforms/transforms.nw (revision 8836)
	@@ -1,16331 +1,16339 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD event transforms and event API
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Event Implementation}
	\includemodulegraph{transforms}

	With a process object and the associated methods at hand, we can
	generate events for elementary processes and, by subsequent
	transformation, for complete physical processes.

	We have the following modules:
	\begin{description}
	\item[event\_transforms]
	Abstract base type for transforming a physical process with process
	instance and included evaluators, etc., into a new
	object. The following modules extend this base type.
	\item[resonance\_insertion]
	Insert a resonance history into an event record, based on
	kinematical and matrix-element information.
	\item[recoil\_kinematics]
	Common kinematics routines for the ISR and EPA handlers.
	\item[isr\_photon\_handler]
	Transform collinear kinematics, as it results from applying ISR
	radiation, to non-collinear kinematics with a reasonable
	transverse-momentum distribution of the radiated photons, and also
	of the recoiling partonic event.
	\item[epa\_beam\_handler]
	For photon-initiated processes where the effective photon
	approximation is used in integration, to add in beam-particle
	recoil. Analogous to the ISR handler.
	\item[decays]
	Combine the elementary process with elementary decay processes and
	thus transform the elementary event into a decayed event, still at
	the parton level.
	\item[showers]
	Create QED/QCD showers out of the partons that are emitted by
	elementary processes. This should be interleaved with showering of
	radiated particles (structure functions) and multiple interactions.
	\item[hadrons]
	(not implemented yet) Apply hadronization to the partonic events,
	interleaved with hadron decays. (The current setup relies on
	hadronizing partonic events externally.)
	\item[tau\_decays]
	(not implemented yet) Let $\tau$ leptons decay taking full spin
	correlations into account.
	\item[evt\_nlo]
	Handler for fixed-order NLO events.
	\item[events]
	Combine all pieces to generate full events.
	\item[eio\_raw]
	Raw I/O for complete events.
	\end{description}

	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Abstract Event Transforms}
	<<[[event_transforms.f90]]>>=
	<<File header>>

	module event_transforms

	<<Use kinds>>
	<<Use strings>>
	use quantum_numbers, only: quantum_numbers_t
	use interactions
	use particles
	use model_data
	use rng_base
	use process, only: process_t
	use instances, only: process_instance_t
	use process_stacks

	<<Standard module head>>

	<<Event transforms: public>>

	<<Event transforms: types>>

	<<Event transforms: interfaces>>

	interface
	<<Event transforms: sub interfaces>>
	end interface

	end module event_transforms

	@ %def event_transforms
	@
	<<[[event_transforms_sub.f90]]>>=
	<<File header>>

	submodule (event_transforms) event_transforms_s

	use io_units
	use format_utils, only: write_separator
	use diagnostics
	use subevents

	implicit none

	contains

	<<Event transforms: procedures>>

	end submodule event_transforms_s

	@ %def event_transforms_s
	@
	\subsection{Abstract base type}
	Essentially, all methods are abstract, but some get minimal base
	versions. We know that there will be a random-number generator at top
	level, and that we will relate to an elementary process.

	The model is stored separately. It may contain modified settings that differ
	from the model instance stored in the process object.

	Each event transform contains a particle set that it can fill for
	further use. There is a flag that indicates this.

	We will collect event transforms in a list, therefore we include
	[[previous]] and [[next]] pointers.
	<<Event transforms: public>>=
	public :: evt_t
	<<Event transforms: types>>=
	type, abstract :: evt_t
	type(process_t), pointer :: process => null ()
	type(process_instance_t), pointer :: process_instance => null ()
	class(model_data_t), pointer :: model => null ()
	class(rng_t), allocatable :: rng
	integer :: rejection_count = 0
	logical :: particle_set_exists = .false.
	type(particle_set_t) :: particle_set
	class(evt_t), pointer :: previous => null ()
	class(evt_t), pointer :: next => null ()
	logical :: only_weighted_events = .false.
	contains
	<<Event transforms: evt: TBP>>
	end type evt_t

	@ %def evt_t
	@ Finalizer. In any case, we finalize the r.n.g. The process
	instance is a pointer and should not be finalized here.
	<<Event transforms: evt: TBP>>=
	procedure :: final => evt_final
	procedure :: base_final => evt_final
	<<Event transforms: sub interfaces>>=
	module subroutine evt_final (evt)
	class(evt_t), intent(inout) :: evt
	end subroutine evt_final
	<<Event transforms: procedures>>=
	module subroutine evt_final (evt)
	class(evt_t), intent(inout) :: evt
	if (allocated (evt%rng)) call evt%rng%final ()
	if (evt%particle_set_exists) &
	call evt%particle_set%final ()
	end subroutine evt_final

	@ %def evt_final
	@ Print out the type of the [[evt]].
	<<Event transforms: evt: TBP>>=
	procedure (evt_write_name), deferred :: write_name
	<<Event transforms: interfaces>>=
	abstract interface
	subroutine evt_write_name (evt, unit)
	import
	class(evt_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	end subroutine evt_write_name
	end interface

	@ %def evt_write_name
	@
	<<Event transforms: evt: TBP>>=
	procedure (evt_write), deferred :: write
	<<Event transforms: interfaces>>=
	abstract interface
	subroutine evt_write (evt, unit, verbose, more_verbose, testflag)
	import
	class(evt_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	end subroutine evt_write
	end interface

	@ %def evt_write
	@ Output. We can print r.n.g. info.
	<<Event transforms: evt: TBP>>=
	procedure :: base_write => evt_base_write
	<<Event transforms: sub interfaces>>=
	module subroutine evt_base_write (evt, unit, testflag, show_set)
	class(evt_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag, show_set
	end subroutine evt_base_write
	<<Event transforms: procedures>>=
	module subroutine evt_base_write (evt, unit, testflag, show_set)
	class(evt_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag, show_set
	integer :: u
	logical :: show
	u = given_output_unit (unit)
	show = .true.; if (present (show_set)) show = show_set
	if (associated (evt%process)) then
	write (u, "(3x,A,A,A)") "Associated process: '", &
	char (evt%process%get_id ()), "'"
	end if
	if (allocated (evt%rng)) then
	call evt%rng%write (u, 1)
	write (u, "(3x,A,I0)") "Number of tries = ", evt%rejection_count
	end if
	if (show) then
	if (evt%particle_set_exists) then
	call write_separator (u)
	call evt%particle_set%write (u, testflag = testflag)
	end if
	end if
	end subroutine evt_base_write

	@ %def evt_base_write
	@ Connect the transform with a process instance (and thus with the
	associated process). Use this to allocate the master random-number
	generator.

	This is not an initializer; we may initialize the transform by
	implementation-specific methods.
	<<Event transforms: evt: TBP>>=
	procedure :: connect => evt_connect
	procedure :: base_connect => evt_connect
	<<Event transforms: sub interfaces>>=
	module subroutine evt_connect (evt, process_instance, model, process_stack)
	class(evt_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	end subroutine evt_connect
	<<Event transforms: procedures>>=
	module subroutine evt_connect (evt, process_instance, model, process_stack)
	class(evt_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	evt%process => process_instance%process
	evt%process_instance => process_instance
	evt%model => model
	call evt%process%make_rng (evt%rng)
	end subroutine evt_connect

	@ %def evt_connect
	@ Reset internal state.
	<<Event transforms: evt: TBP>>=
	procedure :: reset => evt_reset
	procedure :: base_reset => evt_reset
	<<Event transforms: sub interfaces>>=
	module subroutine evt_reset (evt)
	class(evt_t), intent(inout) :: evt
	end subroutine evt_reset
	<<Event transforms: procedures>>=
	module subroutine evt_reset (evt)
	class(evt_t), intent(inout) :: evt
	evt%rejection_count = 0
	call evt%particle_set%final ()
	evt%particle_set_exists = .false.
	end subroutine evt_reset

	@ %def evt_reset
	@ Prepare for a new event: reset internal state, if necessary. We
	provide MCI and term index of the parent process.
	<<Event transforms: evt: TBP>>=
	procedure (evt_prepare_new_event), deferred :: prepare_new_event
	<<Event transforms: interfaces>>=
	interface
	subroutine evt_prepare_new_event (evt, i_mci, i_term)
	import
	class(evt_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	end subroutine evt_prepare_new_event
	end interface

	@ %def evt_prepare_new_event
	@ Generate a weighted event, using a valid initiator event in the
	process instance, and the random-number generator. The returned event
	probability should be a number between zero and one that we can use for
	rejection.
	<<Event transforms: evt: TBP>>=
	procedure (evt_generate_weighted), deferred :: generate_weighted
	<<Event transforms: interfaces>>=
	abstract interface
	subroutine evt_generate_weighted (evt, probability)
	import
	class(evt_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	end subroutine evt_generate_weighted
	end interface

	@ %def evt_generate_weighted
	@ The unweighted event generation routine is actually implemented. It
	uses the random-number generator for simple rejection. Of course, the
	implementation may override this and implement a different way of
	generating an unweighted event.
	<<Event transforms: evt: TBP>>=
	procedure :: generate_unweighted => evt_generate_unweighted
	procedure :: base_generate_unweighted => evt_generate_unweighted
	<<Event transforms: sub interfaces>>=
	module subroutine evt_generate_unweighted (evt)
	class(evt_t), intent(inout) :: evt
	end subroutine evt_generate_unweighted
	<<Event transforms: procedures>>=
	module subroutine evt_generate_unweighted (evt)
	class(evt_t), intent(inout) :: evt
	real(default) :: p, x
	evt%rejection_count = 0
	REJECTION: do
	evt%rejection_count = evt%rejection_count + 1
	call evt%generate_weighted (p)
	if (signal_is_pending ()) return
	call evt%rng%generate (x)
	if (x < p) exit REJECTION
	end do REJECTION
	end subroutine evt_generate_unweighted

	@ %def evt_generate_unweighted
	@ Make a particle set. This should take the most recent evaluator (or
	whatever stores the event), factorize the density matrix if necessary,
	and store as a particle set.

	If applicable, the factorization should make use of the
	[[factorization_mode]] and [[keep_correlations]] settings.

	The values [[r]], if set, should control the factorization in more
	detail, e.g., bypassing the random-number generator.
	<<Event transforms: evt: TBP>>=
	procedure (evt_make_particle_set), deferred :: make_particle_set
	<<Event transforms: interfaces>>=
	interface
	subroutine evt_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	import
	class(evt_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	end subroutine evt_make_particle_set
	end interface

	@ %def evt_make_particle_set
	@ Copy an existing particle set into the event record. This bypasses
	all methods to evaluate the internal state, but may be sufficient for
	further processing.
	<<Event transforms: evt: TBP>>=
	procedure :: set_particle_set => evt_set_particle_set
	<<Event transforms: sub interfaces>>=
	module subroutine evt_set_particle_set (evt, particle_set, i_mci, i_term)
	class(evt_t), intent(inout) :: evt
	type(particle_set_t), intent(in) :: particle_set
	integer, intent(in) :: i_term, i_mci
	end subroutine evt_set_particle_set
	<<Event transforms: procedures>>=
	module subroutine evt_set_particle_set (evt, particle_set, i_mci, i_term)
	class(evt_t), intent(inout) :: evt
	type(particle_set_t), intent(in) :: particle_set
	integer, intent(in) :: i_term, i_mci
	call evt%prepare_new_event (i_mci, i_term)
	evt%particle_set = particle_set
	evt%particle_set_exists = .true.
	end subroutine evt_set_particle_set

	@ %def evt_set_particle_set
	@ This procedure can help in the previous task, if the particles are
	available in the form of an interaction object.
	We need two interactions, one with color summed over, the [[int_matrix]],
	and one with the probability distributed among flows, the [[int_flows]].

	We use the two values from the random number generator saved in [[r]]
	for factorizing the state.
	For testing purposes, we can provide those numbers explicitly.

	The optional [[qn_select]] allows to limit the number of quantum numbers to
	choose from when factorizing. If only a single set of quantum numbers is given,
	it effectively dictates the quantum numbers chosen for the event.
	<<Event transforms: evt: TBP>>=
	procedure :: factorize_interactions => evt_factorize_interactions
	<<Event transforms: sub interfaces>>=
	module subroutine evt_factorize_interactions &
	(evt, int_matrix, int_flows, factorization_mode, &
	keep_correlations, r, qn_select)
	class(evt_t), intent(inout) :: evt
	type(interaction_t), intent(in), target :: int_matrix, int_flows
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_select
	end subroutine evt_factorize_interactions
	<<Event transforms: procedures>>=
	module subroutine evt_factorize_interactions &
	(evt, int_matrix, int_flows, factorization_mode, &
	keep_correlations, r, qn_select)
	class(evt_t), intent(inout) :: evt
	type(interaction_t), intent(in), target :: int_matrix, int_flows
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_select
	real(default), dimension(2) :: x
	if (present (r)) then
	if (size (r) == 2) then
	x = r
	else
	call msg_bug ("event factorization: size of r array must be 2")
	end if
	else
	call evt%rng%generate (x)
	end if
	call evt%particle_set%init (evt%particle_set_exists, &
	int_matrix, int_flows, factorization_mode, x, &
	keep_correlations, keep_virtual=.true., qn_select = qn_select)
	evt%particle_set_exists = .true.
	end subroutine evt_factorize_interactions

	@ %def evt_factorize_interactions
	@
	<<Event transforms: public>>=
	public :: make_factorized_particle_set
	<<Event transforms: sub interfaces>>=
	module subroutine make_factorized_particle_set (evt, factorization_mode, &
	keep_correlations, r, ii_term, qn_select)
	class(evt_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	integer, intent(in), optional :: ii_term
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_select
	end subroutine make_factorized_particle_set
	<<Event transforms: procedures>>=
	module subroutine make_factorized_particle_set (evt, factorization_mode, &
	keep_correlations, r, ii_term, qn_select)
	class(evt_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	integer, intent(in), optional :: ii_term
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_select
	integer :: i_term
	type(interaction_t), pointer :: int_matrix, int_flows
	if (evt%process_instance%is_complete_event ()) then
	if (present (ii_term)) then
	i_term = ii_term
	else
	i_term = evt%process_instance%select_i_term ()
	end if
	int_matrix => evt%process_instance%get_matrix_int_ptr (i_term)
	int_flows => evt%process_instance%get_flows_int_ptr (i_term)
	call evt%factorize_interactions (int_matrix, int_flows, &
	factorization_mode, keep_correlations, r, qn_select)
	call evt%tag_incoming ()
	else
	call msg_bug ("Event factorization: event is incomplete")
	end if
	end subroutine make_factorized_particle_set

	@ %def make_factorized_particle_set
	@ Mark the incoming particles as incoming in the particle set. This
	is necessary because in the interaction objects they are usually
	marked as virtual.

	In the inquiry functions we set the term index to one; the indices of
	beams and incoming particles should be identical for all process
	terms.

	We use the initial elementary process for obtaining the indices.
	Thus, we implicitly assume that the beam and incoming indices stay the
	same across event transforms. If this is not true for a transform
	(say, MPI), it should override this method.
	<<Event transforms: evt: TBP>>=
	procedure :: tag_incoming => evt_tag_incoming
	<<Event transforms: sub interfaces>>=
	module subroutine evt_tag_incoming (evt)
	class(evt_t), intent(inout) :: evt
	end subroutine evt_tag_incoming
	<<Event transforms: procedures>>=
	module subroutine evt_tag_incoming (evt)
	class(evt_t), intent(inout) :: evt
	integer :: i_term, n_in
	integer, dimension(:), allocatable :: beam_index, in_index
	n_in = evt%process%get_n_in ()
	i_term = 1
	allocate (beam_index (n_in))
	call evt%process_instance%get_beam_index (i_term, beam_index)
	call evt%particle_set%reset_status (beam_index, PRT_BEAM)
	allocate (in_index (n_in))
	call evt%process_instance%get_in_index (i_term, in_index)
	call evt%particle_set%reset_status (in_index, PRT_INCOMING)
	end subroutine evt_tag_incoming

	@ %def evt_tag_incoming
	@
	\subsection{Implementation: Trivial transform}
	This transform contains just a pointer to process and process
	instance. The [[generate]] methods do nothing.
	<<Event transforms: public>>=
	public :: evt_trivial_t
	<<Event transforms: types>>=
	type, extends (evt_t) :: evt_trivial_t
	contains
	<<Event transforms: evt trivial: TBP>>
	end type evt_trivial_t

	@ %def evt_trivial_t
	@
	<<Event transforms: evt trivial: TBP>>=
	procedure :: write_name => evt_trivial_write_name
	<<Event transforms: sub interfaces>>=
	module subroutine evt_trivial_write_name (evt, unit)
	class(evt_trivial_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	end subroutine evt_trivial_write_name
	<<Event transforms: procedures>>=
	module subroutine evt_trivial_write_name (evt, unit)
	class(evt_trivial_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: trivial (hard process)"
	end subroutine evt_trivial_write_name

	@ %def evt_trivial_write_name
	@ The finalizer is trivial. Some output:
	<<Event transforms: evt trivial: TBP>>=
	procedure :: write => evt_trivial_write
	<<Event transforms: sub interfaces>>=
	module subroutine evt_trivial_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_trivial_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	end subroutine evt_trivial_write
	<<Event transforms: procedures>>=
	module subroutine evt_trivial_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_trivial_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u)
	call evt%base_write (u, testflag = testflag)
	!!! More readable but wider output; in line with evt_resonance_write
	! if (verbose .and. evt%particle_set_exists) then
	! call evt%particle_set%write &
	! (u, summary = .true., compressed = .true., testflag = testflag)
	! call write_separator (u)
	! end if
	end subroutine evt_trivial_write

	@ %def evt_trivial_write
	@ Nothing to do here:
	<<Event transforms: evt trivial: TBP>>=
	procedure :: prepare_new_event => evt_trivial_prepare_new_event
	<<Event transforms: sub interfaces>>=
	module subroutine evt_trivial_prepare_new_event (evt, i_mci, i_term)
	class(evt_trivial_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	end subroutine evt_trivial_prepare_new_event
	<<Event transforms: procedures>>=
	module subroutine evt_trivial_prepare_new_event (evt, i_mci, i_term)
	class(evt_trivial_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	call evt%reset ()
	end subroutine evt_trivial_prepare_new_event

	@ %def evt_trivial_prepare_new_event
	@ The weighted generator is, surprisingly, trivial.
	<<Event transforms: evt trivial: TBP>>=
	procedure :: generate_weighted => evt_trivial_generate_weighted
	<<Event transforms: sub interfaces>>=
	module subroutine evt_trivial_generate_weighted (evt, probability)
	class(evt_trivial_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	end subroutine evt_trivial_generate_weighted
	<<Event transforms: procedures>>=
	module subroutine evt_trivial_generate_weighted (evt, probability)
	class(evt_trivial_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	probability = 1
	end subroutine evt_trivial_generate_weighted

	@ %def evt_trivial_generate_weighted
	@ This routine makes a particle set, using the associated process
	instance as-is. Note that it is a potential risk to tolerate a
	non-existent particle set at this point. We should remove it once the
	flavors are determined correctly in all cases. It is currently
	neccessary if we are keeping failed events [[?keep_failed_events = .true.]].
	For these events, we do not compute the matrix elements, so the
	factorization fails trying to determine the quantum
	numbers. Additionally, it is necessary for the trivial event
	transformation preceeding the event transformations required for
	POWHEG matching.
	<<Event transforms: evt trivial: TBP>>=
	procedure :: make_particle_set => evt_trivial_make_particle_set
	<<Event transforms: sub interfaces>>=
	module subroutine evt_trivial_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_trivial_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	end subroutine evt_trivial_make_particle_set
	<<Event transforms: procedures>>=
	module subroutine evt_trivial_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_trivial_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	call make_factorized_particle_set (evt, factorization_mode, &
	keep_correlations, r)
	evt%particle_set_exists = .true.
	end subroutine evt_trivial_make_particle_set

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

	module event_transforms_ut
	use unit_tests
	use event_transforms_uti

	<<Standard module head>>

	<<Event transforms: public test>>

	contains

	<<Event transforms: test driver>>

	end module event_transforms_ut
	@ %def event_transforms_ut
	@
	<<[[event_transforms_uti.f90]]>>=
	<<File header>>

	module event_transforms_uti

	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use os_interface
	use sm_qcd
	use models
	use state_matrices, only: FM_IGNORE_HELICITY
	use interactions, only: reset_interaction_counter
	use process_libraries
	use rng_base
	use mci_base
	use mci_midpoint
	use phs_base
	use phs_single
	use prc_core
	use prc_test, only: prc_test_create_library

	use process, only: process_t
	use instances, only: process_instance_t

	use event_transforms

	use rng_base_ut, only: rng_test_factory_t

	<<Standard module head>>

	<<Event transforms: test declarations>>

	contains

	<<Event transforms: tests>>

	<<Event transforms: test auxiliary>>

	end module event_transforms_uti

	@ %def event_transforms_uti
	@ API: driver for the unit tests below.
	<<Event transforms: public test>>=
	public :: event_transforms_test
	<<Event transforms: test driver>>=
	subroutine event_transforms_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Event transforms: execute tests>>
	end subroutine event_transforms_test

	@ %def event_transforms_test
	@
	\subsubsection{Test trivial event transform}
	The trivial transform, as an instance of the abstract transform, does
	nothing but to trigger event generation for an elementary process.
	<<Event transforms: execute tests>>=
	call test (event_transforms_1, "event_transforms_1", &
	"trivial event transform", &
	u, results)
	<<Event transforms: test declarations>>=
	public :: event_transforms_1
	<<Event transforms: tests>>=
	subroutine event_transforms_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(process_library_t), target :: lib
	type(string_t) :: libname, procname1
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	class(evt_t), allocatable :: evt
	integer :: factorization_mode
	logical :: keep_correlations

	write (u, "(A)") "* Test output: event_transforms_1"
	write (u, "(A)") "* Purpose: handle trivial transform"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment and parent process"
	write (u, "(A)")

	call os_data%init ()

	libname = "event_transforms_1_lib"
	procname1 = "event_transforms_1_p"

	call prc_test_create_library (libname, lib, &
	scattering = .true., procname1 = procname1)
	call reset_interaction_counter ()

	call model%init_test ()

	allocate (process)
	call process%init (procname1, lib, os_data, model)
	call process%setup_test_cores ()

	allocate (phs_single_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_test_midpoint)
	call process%setup_terms ()

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%integrate (1, n_it=1, n_calls=100)
	call process%final_integration (1)
	call process_instance%final ()
	deallocate (process_instance)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	call process_instance%init_simulation (1)

	write (u, "(A)") "* Initialize trivial event transform"
	write (u, "(A)")

	allocate (evt_trivial_t :: evt)
	call evt%connect (process_instance, process%get_model_ptr ())

	write (u, "(A)") "* Generate event and subsequent transform"
	write (u, "(A)")

	call process_instance%generate_unweighted_event (1)
	call process_instance%evaluate_event_data ()

	call evt%prepare_new_event (1, 1)
	call evt%generate_unweighted ()

	call write_separator (u, 2)
	call evt%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Obtain particle set"
	write (u, "(A)")

	factorization_mode = FM_IGNORE_HELICITY
	keep_correlations = .false.

	call evt%make_particle_set (factorization_mode, keep_correlations)

	call write_separator (u, 2)
	call evt%write (u)
	call write_separator (u, 2)

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

	call evt%final ()
	call process_instance%final ()
	deallocate (process_instance)

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

	end subroutine event_transforms_1

	@ %def event_transforms_1
	@ MCI record prepared for midpoint integrator.
	<<Event transforms: test auxiliary>>=
	subroutine dispatch_mci_test_midpoint (mci, var_list, process_id, is_nlo)
	use variables, only: var_list_t
	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
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Hadronization interface}
	<<[[hadrons.f90]]>>=
	<<File header>>

	module hadrons

	<<Use kinds with double>>
	<<Use strings>>
	use event_transforms
	use lorentz
	use model_data
	use models
	use particles
	use physics_defs
	use process, only: process_t
	use instances, only: process_instance_t
	use process_stacks
	use whizard_lha
	use pythia8
	use rng_base, only: rng_t
	use shower_base
	use shower_pythia6
	use sm_qcd
	use variables

	<<Standard module head>>

	<<Hadrons: public>>

	<<Hadrons: parameters>>

	<<Hadrons: types>>

	<<Hadrons: interfaces>>

	interface
	<<Hadrons: sub interfaces>>
	end interface

	end module hadrons
	@ %def hadrons
	@
	<<[[hadrons_sub.f90]]>>=
	<<File header>>

	submodule (hadrons) hadrons_s

	<<Use debug>>
	use constants
	use diagnostics
	use format_utils, only: write_separator
	use helicities
	use hep_common
	use io_units
	use numeric_utils, only: vanishes
	use subevents

	implicit none

	contains

	<<Hadrons: procedures>>

	end submodule hadrons_s

	@ %def hadrons_s
	@
	\subsection{Hadronization implementations}
	<<Hadrons: public>>=
	public :: HADRONS_UNDEFINED, HADRONS_WHIZARD, HADRONS_PYTHIA6, HADRONS_PYTHIA8
	<<Hadrons: parameters>>=
	integer, parameter :: HADRONS_UNDEFINED = 0
	integer, parameter :: HADRONS_WHIZARD = 1
	integer, parameter :: HADRONS_PYTHIA6 = 2
	integer, parameter :: HADRONS_PYTHIA8 = 3
	@ %def HADRONS_UNDEFINED HADRONS_WHIZARD HADRONS_PYTHIA6 HADRONS_PYTHIA8
	@ A dictionary
	<<Hadrons: public>>=
	public :: hadrons_method
	<<Hadrons: interfaces>>=
	interface hadrons_method
	module procedure hadrons_method_of_string
	module procedure hadrons_method_to_string
	end interface
	<<Hadrons: sub interfaces>>=
	elemental module function hadrons_method_of_string (string) result (i)
	integer :: i
	type(string_t), intent(in) :: string
	end function hadrons_method_of_string
	elemental module function hadrons_method_to_string (i) result (string)
	type(string_t) :: string
	integer, intent(in) :: i
	end function hadrons_method_to_string
	<<Hadrons: procedures>>=
	elemental module function hadrons_method_of_string (string) result (i)
	integer :: i
	type(string_t), intent(in) :: string
	select case (char(string))
	case ("WHIZARD")
	i = HADRONS_WHIZARD
	case ("PYTHIA6")
	i = HADRONS_PYTHIA6
	case ("PYTHIA8")
	i = HADRONS_PYTHIA8
	case default
	i = HADRONS_UNDEFINED
	end select
	end function hadrons_method_of_string

	elemental module function hadrons_method_to_string (i) result (string)
	type(string_t) :: string
	integer, intent(in) :: i
	select case (i)
	case (HADRONS_WHIZARD)
	string = "WHIZARD"
	case (HADRONS_PYTHIA6)
	string = "PYTHIA6"
	case (HADRONS_PYTHIA8)
	string = "PYTHIA8"
	case default
	string = "UNDEFINED"
	end select
	end function hadrons_method_to_string

	@ %def hadrons_method
	@
	\subsection{Hadronization settings}
	These are the general settings and parameters for the different shower
	methods.
	<<Hadrons: public>>=
	public :: hadron_settings_t
	<<Hadrons: types>>=
	type :: hadron_settings_t
	logical :: active = .false.
	integer :: method = HADRONS_UNDEFINED
	real(default) :: enhanced_fraction = 0
	real(default) :: enhanced_width = 0
	contains
	<<Hadrons: hadron settings: TBP>>
	end type hadron_settings_t

	@ %def hadron_settings_t
	@ Read in the hadronization settings.
	<<Hadrons: hadron settings: TBP>>=
	procedure :: init => hadron_settings_init
	<<Hadrons: sub interfaces>>=
	module subroutine hadron_settings_init (hadron_settings, var_list)
	class(hadron_settings_t), intent(out) :: hadron_settings
	type(var_list_t), intent(in) :: var_list
	end subroutine hadron_settings_init
	<<Hadrons: procedures>>=
	module subroutine hadron_settings_init (hadron_settings, var_list)
	class(hadron_settings_t), intent(out) :: hadron_settings
	type(var_list_t), intent(in) :: var_list
	hadron_settings%active = &
	var_list%get_lval (var_str ("?hadronization_active"))
	hadron_settings%method = hadrons_method_of_string ( &
	var_list%get_sval (var_str ("$hadronization_method")))
	hadron_settings%enhanced_fraction = &
	var_list%get_rval (var_str ("hadron_enhanced_fraction"))
	hadron_settings%enhanced_width = &
	var_list%get_rval (var_str ("hadron_enhanced_width"))
	end subroutine hadron_settings_init

	@ %def hadron_settings_init
	@
	<<Hadrons: hadron settings: TBP>>=
	procedure :: write => hadron_settings_write
	<<Hadrons: sub interfaces>>=
	module subroutine hadron_settings_write (settings, unit)
	class(hadron_settings_t), intent(in) :: settings
	integer, intent(in), optional :: unit
	end subroutine hadron_settings_write
	<<Hadrons: procedures>>=
	module subroutine hadron_settings_write (settings, unit)
	class(hadron_settings_t), intent(in) :: settings
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "Hadronization settings:"
	call write_separator (u)
	write (u, "(1x,A)") "Master switches:"
	write (u, "(3x,A,1x,L1)") &
	"active = ", settings%active
	write (u, "(1x,A)") "General settings:"
	if (settings%active) then
	write (u, "(3x,A)") &
	"hadron_method = " // &
	char (hadrons_method_to_string (settings%method))
	else
	write (u, "(3x,A)") " [Hadronization off]"
	end if
	write (u, "(1x,A)") "pT generation parameters"
	write (u, "(3x,A,1x,ES19.12)") &
	"enhanced_fraction = ", settings%enhanced_fraction
	write (u, "(3x,A,1x,ES19.12)") &
	"enhanced_width = ", settings%enhanced_width
	end subroutine hadron_settings_write

	@ %def hadron_settings_write
	@
	\subsection{Abstract Hadronization Type}
	The [[model]] is the fallback model including all hadrons
	<<Hadrons: types>>=
	type, abstract :: hadrons_t
	class(rng_t), allocatable :: rng
	type(shower_settings_t) :: shower_settings
	type(hadron_settings_t) :: hadron_settings
	type(model_t), pointer :: model => null()
	contains
	<<Hadrons: hadrons: TBP>>
	end type hadrons_t

	@ %def hadrons_t
	@
	<<Hadrons: hadrons: TBP>>=
	procedure (hadrons_init), deferred :: init
	<<Hadrons: interfaces>>=
	abstract interface
	subroutine hadrons_init &
	(hadrons, shower_settings, hadron_settings, model_hadrons)
	import
	class(hadrons_t), intent(out) :: hadrons
	type(shower_settings_t), intent(in) :: shower_settings
	type(hadron_settings_t), intent(in) :: hadron_settings
	type(model_t), target, intent(in) :: model_hadrons
	end subroutine hadrons_init
	end interface

	@ %def hadrons_init
	@
	<<Hadrons: hadrons: TBP>>=
	procedure (hadrons_hadronize), deferred :: hadronize
	<<Hadrons: interfaces>>=
	abstract interface
	subroutine hadrons_hadronize (hadrons, particle_set, valid)
	import
	class(hadrons_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	logical, intent(out) :: valid
	end subroutine hadrons_hadronize
	end interface
	@ %def hadrons_hadronize
	@
	<<Hadrons: hadrons: TBP>>=
	procedure (hadrons_make_particle_set), deferred :: make_particle_set
	<<Hadrons: interfaces>>=
	abstract interface
	subroutine hadrons_make_particle_set (hadrons, particle_set, &
	model, valid)
	import
	class(hadrons_t), intent(in) :: hadrons
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	logical, intent(out) :: valid
	end subroutine hadrons_make_particle_set
	end interface

	@ %def hadrons_make_particle_set
	@
	<<Hadrons: hadrons: TBP>>=
	procedure :: import_rng => hadrons_import_rng
	<<Hadrons: sub interfaces>>=
	pure module subroutine hadrons_import_rng (hadrons, rng)
	class(hadrons_t), intent(inout) :: hadrons
	class(rng_t), intent(inout), allocatable :: rng
	end subroutine hadrons_import_rng
	<<Hadrons: procedures>>=
	pure module subroutine hadrons_import_rng (hadrons, rng)
	class(hadrons_t), intent(inout) :: hadrons
	class(rng_t), intent(inout), allocatable :: rng
	call move_alloc (from = rng, to = hadrons%rng)
	end subroutine hadrons_import_rng

	@ %def hadrons_import_rng
	@
	\subsection{[[WHIZARD]] Hadronization Type}
	Hadronization can be (incompletely) performed through \whizard's internal
	routine.
	<<Hadrons: public>>=
	public :: hadrons_hadrons_t
	<<Hadrons: types>>=
	type, extends (hadrons_t) :: hadrons_hadrons_t
	contains
	<<Hadrons: hadrons hadrons: TBP>>
	end type hadrons_hadrons_t

	@ %def hadrons_hadrons_t
	@
	<<Hadrons: hadrons hadrons: TBP>>=
	procedure :: init => hadrons_hadrons_init
	<<Hadrons: sub interfaces>>=
	module subroutine hadrons_hadrons_init &
	(hadrons, shower_settings, hadron_settings, model_hadrons)
	class(hadrons_hadrons_t), intent(out) :: hadrons
	type(shower_settings_t), intent(in) :: shower_settings
	type(hadron_settings_t), intent(in) :: hadron_settings
	type(model_t), intent(in), target :: model_hadrons
	end subroutine hadrons_hadrons_init
	<<Hadrons: procedures>>=
	module subroutine hadrons_hadrons_init &
	(hadrons, shower_settings, hadron_settings, model_hadrons)
	class(hadrons_hadrons_t), intent(out) :: hadrons
	type(shower_settings_t), intent(in) :: shower_settings
	type(hadron_settings_t), intent(in) :: hadron_settings
	type(model_t), intent(in), target :: model_hadrons
	hadrons%model => model_hadrons
	hadrons%shower_settings = shower_settings
	hadrons%hadron_settings = hadron_settings
	call msg_message &
	("Hadronization: WHIZARD model for hadronization and decays")
	end subroutine hadrons_hadrons_init

	@ %def hadrons_hadrons_init
	@
	<<Hadrons: hadrons hadrons: TBP>>=
	procedure :: hadronize => hadrons_hadrons_hadronize
	<<Hadrons: sub interfaces>>=
	module subroutine hadrons_hadrons_hadronize (hadrons, particle_set, valid)
	class(hadrons_hadrons_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	logical, intent(out) :: valid
	end subroutine hadrons_hadrons_hadronize
	<<Hadrons: procedures>>=
	module subroutine hadrons_hadrons_hadronize (hadrons, particle_set, valid)
	class(hadrons_hadrons_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	logical, intent(out) :: valid
	integer, dimension(:), allocatable :: cols, acols, octs
	integer :: n
	if (signal_is_pending ()) return
	if (debug_on) call msg_debug (D_TRANSFORMS, "hadrons_hadrons_hadronize")
	call particle_set%write (6, compressed=.true.)
	n = particle_set%get_n_tot ()
	allocate (cols (n), acols (n), octs (n))
	call extract_color_systems (particle_set, cols, acols, octs)
	print *, "size(cols) = ", size (cols)
	if (size(cols) > 0) then
	print *, "cols = ", cols
	end if
	print *, "size(acols) = ", size(acols)
	if (size(acols) > 0) then
	print *, "acols = ", acols
	end if
	print *, "size(octs) = ", size(octs)
	if (size (octs) > 0) then
	print *, "octs = ", octs
	end if
	!!! if all arrays are empty, i.e. zero particles found, nothing to do
	end subroutine hadrons_hadrons_hadronize

	@ %def hadrons_hadrons_hadronize
	@ This type contains a flavor selector for the creation of hadrons,
	including parameters for the special handling of baryons.
	<<Hadrons: public>>=
	public :: had_flav_t
	<<Hadrons: types>>=
	type had_flav_t
	end type had_flav_t

	@ %def had_flav_t
	@ This is the type for the ends of Lund strings.
	<<Hadrons: public>>=
	public :: lund_end
	<<Hadrons: types>>=
	type lund_end
	logical :: from_pos
	integer :: i_end
	integer :: i_max
	integer :: id_had
	integer :: i_pos_old
	integer :: i_neg_old
	integer :: i_pos_new
	integer :: i_neg_new
	real(default) :: px_old
	real(default) :: py_old
	real(default) :: px_new
	real(default) :: py_new
	real(default) :: px_had
	real(default) :: py_had
	real(default) :: m_had
	real(default) :: mT2_had
	real(default) :: z_had
	real(default) :: gamma_old
	real(default) :: gamma_new
	real(default) :: x_pos_old
	real(default) :: x_pos_new
	real(default) :: x_pos_had
	real(default) :: x_neg_old
	real(default) :: x_neg_new
	real(default) :: x_neg_had
	type(had_flav_t) :: old_flav
	type(had_flav_t) :: new_flav
	type(vector4_t) :: p_had
	type(vector4_t) :: p_pre
	end type lund_end

	@ %def lund_end
	@ Generator for transverse momentum for the fragmentation.
	<<Hadrons: public>>=
	public :: lund_pt_t
	<<Hadrons: types>>=
	type lund_pt_t
	real(default) :: sigma_min
	real(default) :: sigma_q
	real(default) :: enhanced_frac
	real(default) :: enhanced_width
	real(default) :: sigma_to_had
	class(rng_t), allocatable :: rng
	contains
	<<Hadrons: lund pT: TBP>>
	end type lund_pt_t

	@ %def lund_pt
	<<Hadrons: lund pT: TBP>>=
	procedure :: init => lund_pt_init
	<<Hadrons: sub interfaces>>=
	module subroutine lund_pt_init (lund_pt, settings)
	class (lund_pt_t), intent(out) :: lund_pt
	type(hadron_settings_t), intent(in) :: settings
	end subroutine lund_pt_init
	<<Hadrons: procedures>>=
	module subroutine lund_pt_init (lund_pt, settings)
	class (lund_pt_t), intent(out) :: lund_pt
	type(hadron_settings_t), intent(in) :: settings
	end subroutine lund_pt_init

	@ %def lund_pt_init
	@
	<<Hadrons: hadrons hadrons: TBP>>=
	procedure :: make_particle_set => hadrons_hadrons_make_particle_set
	<<Hadrons: sub interfaces>>=
	module subroutine hadrons_hadrons_make_particle_set &
	(hadrons, particle_set, model, valid)
	class(hadrons_hadrons_t), intent(in) :: hadrons
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	logical, intent(out) :: valid
	end subroutine hadrons_hadrons_make_particle_set
	<<Hadrons: procedures>>=
	module subroutine hadrons_hadrons_make_particle_set &
	(hadrons, particle_set, model, valid)
	class(hadrons_hadrons_t), intent(in) :: hadrons
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	logical, intent(out) :: valid
	if (signal_is_pending ()) return
	valid = .false.
	if (valid) then
	else
	call msg_fatal ("WHIZARD hadronization not yet implemented")
	end if
	end subroutine hadrons_hadrons_make_particle_set

	@ %def hadrons_hadrons_make_particle_set
	@
	<<Hadrons: procedures>>=
	subroutine extract_color_systems (p_set, cols, acols, octs)
	type(particle_set_t), intent(in) :: p_set
	integer, dimension(:), allocatable, intent(out) :: cols, acols, octs
	logical, dimension(:), allocatable :: mask
	integer :: i, n, n_cols, n_acols, n_octs
	n = p_set%get_n_tot ()
	allocate (mask (n))
	do i = 1, n
	mask(i) = p_set%prt(i)%col%get_col () /= 0 .and. &
	p_set%prt(i)%col%get_acl () == 0 .and. &
	p_set%prt(i)%get_status () == PRT_OUTGOING
	end do
	n_cols = count (mask)
	allocate (cols (n_cols))
	cols = p_set%get_indices (mask)
	do i = 1, n
	mask(i) = p_set%prt(i)%col%get_col () == 0 .and. &
	p_set%prt(i)%col%get_acl () /= 0 .and. &
	p_set%prt(i)%get_status () == PRT_OUTGOING
	end do
	n_acols = count (mask)
	allocate (acols (n_acols))
	acols = p_set%get_indices (mask)
	do i = 1, n
	mask(i) = p_set%prt(i)%col%get_col () /= 0 .and. &
	p_set%prt(i)%col%get_acl () /= 0 .and. &
	p_set%prt(i)%get_status () == PRT_OUTGOING
	end do
	n_octs = count (mask)
	allocate (octs (n_octs))
	octs = p_set%get_indices (mask)
	end subroutine extract_color_systems

	@ %def extract_color_systems
	@
	\subsection{[[PYTHIA6]] Hadronization Type}
	Hadronization via [[PYTHIA6]] is at another option for
	hadronization within \whizard.
	<<Hadrons: public>>=
	public :: hadrons_pythia6_t
	<<Hadrons: types>>=
	type, extends (hadrons_t) :: hadrons_pythia6_t
	contains
	<<Hadrons: hadrons pythia6: TBP>>
	end type hadrons_pythia6_t

	@ %def hadrons_pythia6_t
	<<Hadrons: hadrons pythia6: TBP>>=
	procedure :: init => hadrons_pythia6_init
	<<Hadrons: sub interfaces>>=
	module subroutine hadrons_pythia6_init &
	(hadrons, shower_settings, hadron_settings, model_hadrons)
	class(hadrons_pythia6_t), intent(out) :: hadrons
	type(shower_settings_t), intent(in) :: shower_settings
	type(hadron_settings_t), intent(in) :: hadron_settings
	type(model_t), intent(in), target :: model_hadrons
	end subroutine hadrons_pythia6_init
	<<Hadrons: procedures>>=
	module subroutine hadrons_pythia6_init &
	(hadrons, shower_settings, hadron_settings, model_hadrons)
	class(hadrons_pythia6_t), intent(out) :: hadrons
	type(shower_settings_t), intent(in) :: shower_settings
	type(hadron_settings_t), intent(in) :: hadron_settings
	type(model_t), intent(in), target :: model_hadrons
	logical :: pygive_not_set_by_shower
	hadrons%model => model_hadrons
	hadrons%shower_settings = shower_settings
	hadrons%hadron_settings = hadron_settings
	pygive_not_set_by_shower = .not. (shower_settings%method == PS_PYTHIA6 &
	.and. (shower_settings%isr_active .or. shower_settings%fsr_active))
	if (pygive_not_set_by_shower) then
	call pythia6_set_verbose (shower_settings%verbose)
	call pythia6_set_config (shower_settings%pythia6_pygive)
	end if
	call msg_message &
	("Hadronization: Using PYTHIA6 interface for hadronization and decays")
	end subroutine hadrons_pythia6_init

	@ %def hadrons_pythia6_init
	@ Assume that the event record is still in the PYTHIA COMMON BLOCKS
	transferred there by the WHIZARD or PYTHIA6 shower routines.
	<<Hadrons: hadrons pythia6: TBP>>=
	procedure :: hadronize => hadrons_pythia6_hadronize
	<<Hadrons: sub interfaces>>=
	module subroutine hadrons_pythia6_hadronize (hadrons, particle_set, valid)
	class(hadrons_pythia6_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	logical, intent(out) :: valid
	end subroutine hadrons_pythia6_hadronize
	<<Hadrons: procedures>>=
	module subroutine hadrons_pythia6_hadronize (hadrons, particle_set, valid)
	class(hadrons_pythia6_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	logical, intent(out) :: valid
	integer :: N, NPAD, K
	real(double) :: P, V
	common /PYJETS/ N, NPAD, K(4000,5), P(4000,5), V(4000,5)
	save /PYJETS/
	if (signal_is_pending ()) return
	if (debug_on) call msg_debug (D_TRANSFORMS, "hadrons_pythia6_hadronize")
	call pygive ("MSTP(111)=1") !!! Switch on hadronization and decays
	call pygive ("MSTJ(1)=1") !!! String fragmentation
	call pygive ("MSTJ(21)=2") !!! String fragmentation keeping resonance momentum
	call pygive ("MSTJ(28)=0") !!! Switch off tau decays
	if (debug_active (D_TRANSFORMS)) then
	call msg_debug (D_TRANSFORMS, "N", N)
	call pylist(2)
	print *, ' line 7 : ', k(7,1:5), p(7,1:5)
	end if
	call pyedit (12)
	call pythia6_set_last_treated_line (N)
	call pyexec ()
	call pyedit (12)
	valid = .true.
	end subroutine hadrons_pythia6_hadronize

	@ %def hadrons_pythia6_hadronize
	@
	<<Hadrons: hadrons pythia6: TBP>>=
	procedure :: make_particle_set => hadrons_pythia6_make_particle_set
	<<Hadrons: sub interfaces>>=
	module subroutine hadrons_pythia6_make_particle_set &
	(hadrons, particle_set, model, valid)
	class(hadrons_pythia6_t), intent(in) :: hadrons
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	logical, intent(out) :: valid
	end subroutine hadrons_pythia6_make_particle_set
	<<Hadrons: procedures>>=
	module subroutine hadrons_pythia6_make_particle_set &
	(hadrons, particle_set, model, valid)
	class(hadrons_pythia6_t), intent(in) :: hadrons
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	logical, intent(out) :: valid
	if (signal_is_pending ()) return
	valid = pythia6_handle_errors ()
	if (valid) then
	call pythia6_combine_with_particle_set &
	(particle_set, model, hadrons%model, hadrons%shower_settings)
	end if
	end subroutine hadrons_pythia6_make_particle_set

	@ %def hadrons_pythia6_make_particle_set
	@
	\subsection{[[PYTHIA8]] Hadronization}
	@
	<<Hadrons: public>>=
	public :: hadrons_pythia8_t
	<<Hadrons: types>>=
	type, extends (hadrons_t) :: hadrons_pythia8_t
	type(pythia8_t) :: pythia
	type(whizard_lha_t) :: lhaup
	logical :: user_process_set = .false.
	logical :: pythia_initialized = .false., &
	lhaup_initialized = .false.
	contains
	<<Hadrons: hadrons pythia8: TBP>>
	end type hadrons_pythia8_t

	@ %def hadrons_pythia8_t
	@
	<<Hadrons: hadrons pythia8: TBP>>=
	procedure :: init => hadrons_pythia8_init
	<<Hadrons: sub interfaces>>=
	module subroutine hadrons_pythia8_init &
	(hadrons, shower_settings, hadron_settings, model_hadrons)
	class(hadrons_pythia8_t), intent(out) :: hadrons
	type(shower_settings_t), intent(in) :: shower_settings
	type(hadron_settings_t), intent(in) :: hadron_settings
	type(model_t), intent(in), target :: model_hadrons
	end subroutine hadrons_pythia8_init
	<<Hadrons: procedures>>=
	module subroutine hadrons_pythia8_init &
	(hadrons, shower_settings, hadron_settings, model_hadrons)
	class(hadrons_pythia8_t), intent(out) :: hadrons
	type(shower_settings_t), intent(in) :: shower_settings
	type(hadron_settings_t), intent(in) :: hadron_settings
	type(model_t), intent(in), target :: model_hadrons
	hadrons%model => model_hadrons
	hadrons%shower_settings = shower_settings
	hadrons%hadron_settings = hadron_settings
	call msg_message ("Hadronization: Using PYTHIA8 interface " // &
	"for hadronization and decays.")
	! TODO sbrass which verbose?
	call hadrons%pythia%init (verbose = shower_settings%verbose)
	call hadrons%lhaup%init ()
	end subroutine hadrons_pythia8_init

	@ %def hadrons_pythia8_init
	@ Transfer hadron settings to [[PYTHIA8]].
	<<Hadrons: hadrons pythia8: TBP>>=
	procedure, private :: transfer_settings => hadrons_pythia8_transfer_settings
	<<Hadrons: sub interfaces>>=
	module subroutine hadrons_pythia8_transfer_settings (hadrons)
	class(hadrons_pythia8_t), intent(inout), target :: hadrons
	end subroutine hadrons_pythia8_transfer_settings
	<<Hadrons: procedures>>=
	module subroutine hadrons_pythia8_transfer_settings (hadrons)
	class(hadrons_pythia8_t), intent(inout), target :: hadrons
	real(default) :: r
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "hadrons_pythia8_transfer_settings")
	if (debug_on) call msg_debug2 &
	(D_TRANSFORMS, "pythia_initialized", hadrons%pythia_initialized)
	if (hadrons%pythia_initialized) return
	call hadrons%pythia%import_rng (hadrons%rng)
	call hadrons%pythia%parse_and_set_config &
	(hadrons%shower_settings%pythia8_config)
	if (len (hadrons%shower_settings%pythia8_config_file) > 0) &
	call hadrons%pythia%read_file &
	(hadrons%shower_settings%pythia8_config_file)
	call hadrons%pythia%read_string (var_str ("Beams:frameType = 5"))
	call hadrons%pythia%read_string (var_str ("ProcessLevel:all = off"))
	if (.not. hadrons%shower_settings%verbose) then
	call hadrons%pythia%read_string (var_str ("Print:quiet = on"))
	end if
	call hadrons%pythia%set_lhaup_ptr (hadrons%lhaup)
	call hadrons%pythia%init_pythia ()
	hadrons%pythia_initialized = .true.
	end subroutine hadrons_pythia8_transfer_settings

	@ %def hadrons_pythia8_transfer_settings
	@ Set user process for the LHA interface.
	<<Hadrons: hadrons pythia8: TBP>>=
	procedure, private :: set_user_process => hadrons_pythia8_set_user_process
	<<Hadrons: sub interfaces>>=
	module subroutine hadrons_pythia8_set_user_process (hadrons, pset)
	class(hadrons_pythia8_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: pset
	end subroutine hadrons_pythia8_set_user_process
	<<Hadrons: procedures>>=
	module subroutine hadrons_pythia8_set_user_process (hadrons, pset)
	class(hadrons_pythia8_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: pset
	integer, dimension(2) :: beam_pdg
	real(default), dimension(2) :: beam_energy
	integer, parameter :: process_id = 0, n_processes = 0
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "hadrons_pythia8_set_user_process")
	beam_pdg = [pset%prt(1)%get_pdg (), pset%prt(2)%get_pdg ()]
	beam_energy = [energy(pset%prt(1)%p), energy(pset%prt(2)%p)]
	call hadrons%lhaup%set_init (beam_pdg, beam_energy, &
	n_processes, unweighted = .false., negative_weights = .false.)
	call hadrons%lhaup%set_process_parameters (process_id = process_id, &
	cross_section = one, error = one)
	end subroutine hadrons_pythia8_set_user_process

	@ %def hadrons_pythia8_set_user_process
	@ Import particle set.
	<<Hadrons: hadrons pythia8: TBP>>=
	procedure, private :: import_particle_set => &
	hadrons_pythia8_import_particle_set
	<<Hadrons: sub interfaces>>=
	module subroutine hadrons_pythia8_import_particle_set &
	(hadrons, particle_set)
	class(hadrons_pythia8_t), target, intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	end subroutine hadrons_pythia8_import_particle_set
	<<Hadrons: procedures>>=
	module subroutine hadrons_pythia8_import_particle_set (hadrons, particle_set)
	class(hadrons_pythia8_t), target, intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	type(particle_set_t) :: pset_reduced
	integer, parameter :: PROCESS_ID = 1
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "hadrons_pythia8_import_particle_set")
	if (.not. hadrons%user_process_set) then
	call hadrons%set_user_process (particle_set)
	hadrons%user_process_set = .true.
	end if
	call hadrons%lhaup%set_event_process (process_id = PROCESS_ID, &
	scale = -one, alpha_qcd = -one, alpha_qed = -one, weight = -one)
	call hadrons%lhaup%set_event (process_id = PROCESS_ID, &
	particle_set = particle_set, polarization = .true.)
	if (debug_active (D_TRANSFORMS)) then
	call hadrons%lhaup%list_init ()
	end if
	end subroutine hadrons_pythia8_import_particle_set

	@ %def hadrons_pythia8_import_particle_set
	@
	<<Hadrons: hadrons pythia8: TBP>>=
	procedure :: hadronize => hadrons_pythia8_hadronize
	<<Hadrons: sub interfaces>>=
	module subroutine hadrons_pythia8_hadronize (hadrons, particle_set, valid)
	class(hadrons_pythia8_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	logical, intent(out) :: valid
	end subroutine hadrons_pythia8_hadronize
	<<Hadrons: procedures>>=
	module subroutine hadrons_pythia8_hadronize (hadrons, particle_set, valid)
	class(hadrons_pythia8_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	logical, intent(out) :: valid
	if (signal_is_pending ()) return
	call hadrons%import_particle_set (particle_set)
	if (.not. hadrons%pythia_initialized) &
	call hadrons%transfer_settings ()
	call hadrons%pythia%next (valid)
	if (debug_active (D_TRANSFORMS)) then
	call hadrons%pythia%list_event ()
	call particle_set%write (summary=.true., compressed=.true.)
	end if
	end subroutine hadrons_pythia8_hadronize

	@ %def hadrons_pythia8_hadronize
	@
	<<Hadrons: hadrons pythia8: TBP>>=
	procedure :: make_particle_set => hadrons_pythia8_make_particle_set
	<<Hadrons: sub interfaces>>=
	module subroutine hadrons_pythia8_make_particle_set &
	(hadrons, particle_set, model, valid)
	class(hadrons_pythia8_t), intent(in) :: hadrons
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	logical, intent(out) :: valid
	end subroutine hadrons_pythia8_make_particle_set
	<<Hadrons: procedures>>=
	module subroutine hadrons_pythia8_make_particle_set &
	(hadrons, particle_set, model, valid)
	class(hadrons_pythia8_t), intent(in) :: hadrons
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	logical, intent(out) :: valid
	type(particle_t), dimension(:), allocatable :: beam
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "hadrons_pythia8_make_particle_set")
	if (signal_is_pending ()) return
	associate (settings => hadrons%shower_settings)
	if (debug_active (D_TRANSFORMS)) then
	call msg_debug (D_TRANSFORMS, 'Combine PYTHIA8 with particle set')
	call msg_debug (D_TRANSFORMS, 'Particle set before replacing')
	call particle_set%write (summary=.true., compressed=.true.)
	call hadrons%pythia%list_event ()
	call msg_debug (D_TRANSFORMS, string = "settings%hadron_collision", &
	value = settings%hadron_collision)
	end if
	call hadrons%pythia%get_hadron_particles (&
	model, hadrons%model, particle_set, &
	helicity = PRT_DEFINITE_HELICITY)
	end associate
	if (debug_active (D_TRANSFORMS)) then
	print *, 'Particle set after replacing'
	call particle_set%write (summary=.true., compressed=.true.)
	end if
	valid = .true.
	end subroutine hadrons_pythia8_make_particle_set

	@ %def hadrons_pythia8_make_particle_set
	@
	\subsection{Hadronization Event Transform}
	This is the type for the hadronization event transform. It does not
	depend on the specific hadronization implementation of
	[[hadrons_t]].
	<<Hadrons: public>>=
	public :: evt_hadrons_t
	<<Hadrons: types>>=
	type, extends (evt_t) :: evt_hadrons_t
	class(hadrons_t), allocatable :: hadrons
	type(model_t), pointer :: model_hadrons => null()
	type(qcd_t) :: qcd
	logical :: is_first_event
	contains
	<<Hadrons: evt hadrons: TBP>>
	end type evt_hadrons_t

	@ %def evt_hadrons_t
	@ Initialize the parameters. The [[model_hadrons]] is supposed to be
	the SM variant that contains all hadrons that may be generated in the
	shower.
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: init => evt_hadrons_init
	<<Hadrons: sub interfaces>>=
	module subroutine evt_hadrons_init (evt, model_hadrons)
	class(evt_hadrons_t), intent(out) :: evt
	type(model_t), intent(in), target :: model_hadrons
	end subroutine evt_hadrons_init
	<<Hadrons: procedures>>=
	module subroutine evt_hadrons_init (evt, model_hadrons)
	class(evt_hadrons_t), intent(out) :: evt
	type(model_t), intent(in), target :: model_hadrons
	evt%model_hadrons => model_hadrons
	evt%is_first_event = .true.
	end subroutine evt_hadrons_init

	@ %def evt_hadrons_init
	@
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: write_name => evt_hadrons_write_name
	<<Hadrons: sub interfaces>>=
	module subroutine evt_hadrons_write_name (evt, unit)
	class(evt_hadrons_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	end subroutine evt_hadrons_write_name
	<<Hadrons: procedures>>=
	module subroutine evt_hadrons_write_name (evt, unit)
	class(evt_hadrons_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: hadronization"
	end subroutine evt_hadrons_write_name

	@ %def evt_hadrons_write_name
	@ Output.
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: write => evt_hadrons_write
	<<Hadrons: sub interfaces>>=
	module subroutine evt_hadrons_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_hadrons_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	end subroutine evt_hadrons_write
	<<Hadrons: procedures>>=
	module subroutine evt_hadrons_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_hadrons_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u)
	call evt%base_write (u, testflag = testflag, show_set = .false.)
	if (evt%particle_set_exists) &
	call evt%particle_set%write &
	(u, summary = .true., compressed = .true., testflag = testflag)
	call write_separator (u)
	call evt%hadrons%shower_settings%write (u)
	call write_separator (u)
	call evt%hadrons%hadron_settings%write (u)
	end subroutine evt_hadrons_write

	@ %def evt_hadrons_write
	@
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: first_event => evt_hadrons_first_event
	<<Hadrons: sub interfaces>>=
	module subroutine evt_hadrons_first_event (evt)
	class(evt_hadrons_t), intent(inout) :: evt
	end subroutine evt_hadrons_first_event
	<<Hadrons: procedures>>=
	module subroutine evt_hadrons_first_event (evt)
	class(evt_hadrons_t), intent(inout) :: evt
	if (debug_on) call msg_debug (D_TRANSFORMS, "evt_hadrons_first_event")
	associate (settings => evt%hadrons%shower_settings)
	settings%hadron_collision = .false.
	if (all (evt%particle_set%prt(1:2)%flv%get_pdg_abs () <= 39)) then
	settings%hadron_collision = .false.
	else if (all (evt%particle_set%prt(1:2)%flv%get_pdg_abs () >= 100)) then
	settings%hadron_collision = .true.
	else
	call msg_fatal ("evt_hadrons didn't recognize beams setup")
	end if
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "hadron_collision", settings%hadron_collision)
	if (.not. (settings%isr_active .or. settings%fsr_active)) then
	call msg_fatal ("Hadronization without shower is not supported")
	end if
	end associate
	evt%is_first_event = .false.
	end subroutine evt_hadrons_first_event

	@ %def evt_hadrons_first_event
	@ Here we take the particle set from the previous event transform and
	apply the hadronization. The result is stored in the [[evt%hadrons]]
	object. We always return a probability of unity as we don't have the
	analytic weight of the hadronization. Invalid events have to be
	discarded by the caller which is why we mark the particle set as
	invalid.
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: generate_weighted => evt_hadrons_generate_weighted
	<<Hadrons: sub interfaces>>=
	module subroutine evt_hadrons_generate_weighted (evt, probability)
	class(evt_hadrons_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	end subroutine evt_hadrons_generate_weighted
	<<Hadrons: procedures>>=
	module subroutine evt_hadrons_generate_weighted (evt, probability)
	class(evt_hadrons_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	logical :: valid
	if (signal_is_pending ()) return
	evt%particle_set = evt%previous%particle_set
	if (evt%is_first_event) then
	call evt%first_event ()
	end if
	call evt%hadrons%hadronize (evt%particle_set, valid)
	probability = 1
	evt%particle_set_exists = valid
	end subroutine evt_hadrons_generate_weighted

	@ %def evt_hadrons_generate_weighted
	@ The factorization parameters are irrelevant.
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: make_particle_set => evt_hadrons_make_particle_set
	<<Hadrons: sub interfaces>>=
	module subroutine evt_hadrons_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_hadrons_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	end subroutine evt_hadrons_make_particle_set
	<<Hadrons: procedures>>=
	module subroutine evt_hadrons_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_hadrons_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	logical :: valid
	call evt%hadrons%make_particle_set (evt%particle_set, evt%model, valid)
	evt%particle_set_exists = evt%particle_set_exists .and. valid
	end subroutine evt_hadrons_make_particle_set

	@ %def event_hadrons_make_particle_set
	@ Connect the process with the hadrons object.
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: connect => evt_hadrons_connect
	<<Hadrons: sub interfaces>>=
	module subroutine evt_hadrons_connect &
	(evt, process_instance, model, process_stack)
	class(evt_hadrons_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	end subroutine evt_hadrons_connect
	<<Hadrons: procedures>>=
	module subroutine evt_hadrons_connect &
	(evt, process_instance, model, process_stack)
	class(evt_hadrons_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	call evt%base_connect (process_instance, model, process_stack)
	call evt%make_rng (evt%process)
	end subroutine evt_hadrons_connect

	@ %def evt_hadrons_connect
	@ Create RNG instances, spawned by the process object.
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: make_rng => evt_hadrons_make_rng
	<<Hadrons: sub interfaces>>=
	module subroutine evt_hadrons_make_rng (evt, process)
	class(evt_hadrons_t), intent(inout) :: evt
	type(process_t), intent(inout) :: process
	class(rng_t), allocatable :: rng
	end subroutine evt_hadrons_make_rng
	<<Hadrons: procedures>>=
	module subroutine evt_hadrons_make_rng (evt, process)
	class(evt_hadrons_t), intent(inout) :: evt
	type(process_t), intent(inout) :: process
	class(rng_t), allocatable :: rng
	call process%make_rng (rng)
	call evt%hadrons%import_rng (rng)
	end subroutine evt_hadrons_make_rng

	@ %def evt_hadrons_make_rng
	@
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: prepare_new_event => evt_hadrons_prepare_new_event
	<<Hadrons: sub interfaces>>=
	module subroutine evt_hadrons_prepare_new_event (evt, i_mci, i_term)
	class(evt_hadrons_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	end subroutine evt_hadrons_prepare_new_event
	<<Hadrons: procedures>>=
	module subroutine evt_hadrons_prepare_new_event (evt, i_mci, i_term)
	class(evt_hadrons_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	call evt%reset ()
	end subroutine evt_hadrons_prepare_new_event

	@ %def evt_hadrons_prepare_new_event
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Resonance Insertion}
	<<[[resonance_insertion.f90]]>>=
	<<File header>>

	module resonance_insertion

	<<Use kinds>>
	<<Use strings>>
	use rng_base, only: rng_t
	use selectors, only: selector_t
	use particles, only: particle_t, particle_set_t
	use resonances, only: resonance_history_set_t
	use resonances, only: resonance_tree_t
	use instances, only: process_instance_ptr_t
	use event_transforms

	<<Standard module head>>

	<<Resonance insertion: public>>

	<<Resonance insertion: types>>

	interface
	<<Resonance insertion: sub interfaces>>
	end interface

	end module resonance_insertion
	@ %def resonance_insertion
	@
	<<[[resonance_insertion_sub.f90]]>>=
	<<File header>>

	submodule (resonance_insertion) resonance_insertion_s

	use io_units
	use format_utils, only: write_separator
	use format_defs, only: FMT_12
	use interactions, only: interaction_t
	use subevents, only: PRT_RESONANT

	implicit none

	contains

	<<Resonance insertion: procedures>>

	end submodule resonance_insertion_s

	@ %def resonance_insertion_s
	@
	\subsection{Resonance-Insertion Event Transform}
	This is the type for the event transform that applies resonance insertion.
	The resonance history set describe the resonance histories that we may
	consider. There is a process library with process objects that correspond to
	the resonance histories. Library creation, compilation etc.\ is done outside
	the scope of this module.
	<<Resonance insertion: public>>=
	public :: evt_resonance_t
	<<Resonance insertion: types>>=
	type, extends (evt_t) :: evt_resonance_t
	type(resonance_history_set_t), dimension(:), allocatable :: res_history_set
	integer, dimension(:), allocatable :: index_offset
	integer :: selected_component = 0
	type(string_t) :: libname
	type(string_t), dimension(:), allocatable :: proc_id
	real(default) :: on_shell_limit = 0
	real(default) :: on_shell_turnoff = 0
	real(default) :: background_factor = 1
	logical :: selector_active = .false.
	type(selector_t) :: selector
	integer :: selected_history = 0
	type(process_instance_ptr_t), dimension(:), allocatable :: instance
	contains
	<<Resonance insertion: evt resonance: TBP>>
	end type evt_resonance_t

	@ %def evt_resonance_t
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: write_name => evt_resonance_write_name
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_write_name (evt, unit)
	class(evt_resonance_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	end subroutine evt_resonance_write_name
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_write_name (evt, unit)
	class(evt_resonance_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: resonance insertion"
	end subroutine evt_resonance_write_name

	@ %def evt_resonance_write_name
	@ Output.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: write => evt_resonance_write
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_resonance_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	end subroutine evt_resonance_write
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_resonance_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	integer :: u, i
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u, 2)
	write (u, "(1x,A,A,A)") "Process library = '", char (evt%libname), "'"
	if (allocated (evt%res_history_set)) then
	do i = 1, size (evt%res_history_set)
	if (i == evt%selected_component) then
	write (u, "(1x,A,I0,A)") "Component #", i, ": *"
	else
	write (u, "(1x,A,I0,A)") "Component #", i, ":"
	end if
	call evt%res_history_set(i)%write (u, indent=1)
	end do
	end if
	call write_separator (u)
	if (allocated (evt%instance)) then
	write (u, "(1x,A)") "Subprocess instances: allocated"
	else
	write (u, "(1x,A)") "Subprocess instances: not allocated"
	end if
	if (evt%particle_set_exists) then
	if (evt%selected_history > 0) then
	write (u, "(1x,A,I0)") "Selected: resonance history #", &
	evt%selected_history
	else
	write (u, "(1x,A)") "Selected: no resonance history"
	end if
	else
	write (u, "(1x,A)") "Selected: [none]"
	end if
	write (u, "(1x,A,1x," // FMT_12 // ")") &
	"On-shell limit =", evt%on_shell_limit
	write (u, "(1x,A,1x," // FMT_12 // ")") &
	"On-shell turnoff =", evt%on_shell_turnoff
	write (u, "(1x,A,1x," // FMT_12 // ")") &
	"Background factor =", evt%background_factor
	call write_separator (u)
	if (evt%selector_active) then
	write (u, "(2x)", advance="no")
	call evt%selector%write (u, testflag=testflag)
	call write_separator (u)
	end if
	call evt%base_write (u, testflag = testflag, show_set = .false.)
	call write_separator (u)
	if (evt%particle_set_exists) then
	call evt%particle_set%write &
	(u, summary = .true., compressed = .true., testflag = testflag)
	call write_separator (u)
	end if
	end subroutine evt_resonance_write

	@ %def evt_resonance_write
	@
	\subsection{Set contained data}
	Insert the resonance data, in form of a pre-generated resonance
	history set. Accumulate the number of histories for each set, to
	initialize an array of index offsets for lookup.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: set_resonance_data => evt_resonance_set_resonance_data
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_set_resonance_data (evt, res_history_set)
	class(evt_resonance_t), intent(inout) :: evt
	type(resonance_history_set_t), dimension(:), intent(in) :: res_history_set
	end subroutine evt_resonance_set_resonance_data
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_set_resonance_data (evt, res_history_set)
	class(evt_resonance_t), intent(inout) :: evt
	type(resonance_history_set_t), dimension(:), intent(in) :: res_history_set
	integer :: i
	evt%res_history_set = res_history_set
	allocate (evt%index_offset (size (evt%res_history_set)), source = 0)
	do i = 2, size (evt%res_history_set)
	evt%index_offset(i) = &
	evt%index_offset(i-1) + evt%res_history_set(i-1)%get_n_history ()
	end do
	end subroutine evt_resonance_set_resonance_data

	@ %def evt_resonance_set_resonance_data
	@ Set the library that contains the resonant subprocesses.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: set_library => evt_resonance_set_library
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_set_library (evt, libname)
	class(evt_resonance_t), intent(inout) :: evt
	type(string_t), intent(in) :: libname
	end subroutine evt_resonance_set_library
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_set_library (evt, libname)
	class(evt_resonance_t), intent(inout) :: evt
	type(string_t), intent(in) :: libname
	evt%libname = libname
	end subroutine evt_resonance_set_library

	@ %def evt_resonance_set_library
	@ Assign pointers to subprocess instances. Once a subprocess has been
	selected, the instance is used for generating the particle set with
	valid quantum-number assignments, ready for resonance insertion.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: set_subprocess_instances &
	=> evt_resonance_set_subprocess_instances
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_set_subprocess_instances (evt, instance)
	class(evt_resonance_t), intent(inout) :: evt
	type(process_instance_ptr_t), dimension(:), intent(in) :: instance
	end subroutine evt_resonance_set_subprocess_instances
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_set_subprocess_instances (evt, instance)
	class(evt_resonance_t), intent(inout) :: evt
	type(process_instance_ptr_t), dimension(:), intent(in) :: instance
	evt%instance = instance
	end subroutine evt_resonance_set_subprocess_instances

	@ %def evt_resonance_set_subprocess_instances
	@ Set the on-shell limit, the relative distance from a resonance that
	is still considered to be on-shell. The probability for being
	considered on-shell can be reduced by the turnoff parameter below.
	For details, see the [[resonances]] module.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: set_on_shell_limit => evt_resonance_set_on_shell_limit
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_set_on_shell_limit (evt, on_shell_limit)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), intent(in) :: on_shell_limit
	end subroutine evt_resonance_set_on_shell_limit
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_set_on_shell_limit (evt, on_shell_limit)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), intent(in) :: on_shell_limit
	evt%on_shell_limit = on_shell_limit
	end subroutine evt_resonance_set_on_shell_limit

	@ %def evt_resonance_set_on_shell_limit
	@ Set the Gaussian on-shell turnoff parameter, the width of the
	weighting factor for the resonance squared matrix element. If the
	resonance is off shell, this factor reduces the weight of the matrix
	element in the selector, such that the probability for considered
	resonant is reduced. The factor is applied only if the offshellness
	is less than the [[on_shell_limit]] above. For details, see the
	[[resonances]] module.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: set_on_shell_turnoff => evt_resonance_set_on_shell_turnoff
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_set_on_shell_turnoff (evt, on_shell_turnoff)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), intent(in) :: on_shell_turnoff
	end subroutine evt_resonance_set_on_shell_turnoff
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_set_on_shell_turnoff (evt, on_shell_turnoff)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), intent(in) :: on_shell_turnoff
	evt%on_shell_turnoff = on_shell_turnoff
	end subroutine evt_resonance_set_on_shell_turnoff

	@ %def evt_resonance_set_on_shell_turnoff
	@ Reweight (suppress) the background contribution if there is a resonance
	history that applies. The event will be registered as background if there is
	no applicable resonance history, or if the background configuration has been
	selected based on (reweighted) squared matrix elements.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: set_background_factor => evt_resonance_set_background_factor
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_set_background_factor &
	(evt, background_factor)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), intent(in) :: background_factor
	end subroutine evt_resonance_set_background_factor
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_set_background_factor (evt, background_factor)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), intent(in) :: background_factor
	evt%background_factor = background_factor
	end subroutine evt_resonance_set_background_factor

	@ %def evt_resonance_set_background_factor
	@
	\subsection{Selector}
	Manually import a random-number generator object. This should be
	done only for testing purposes. The standard procedure is to
	[[connect]] a process to an event transform; this will create an
	appropriate [[rng]] from the RNG factory in the process object.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: import_rng => evt_resonance_import_rng
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_import_rng (evt, rng)
	class(evt_resonance_t), intent(inout) :: evt
	class(rng_t), allocatable, intent(inout) :: rng
	end subroutine evt_resonance_import_rng
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_import_rng (evt, rng)
	class(evt_resonance_t), intent(inout) :: evt
	class(rng_t), allocatable, intent(inout) :: rng
	call move_alloc (from = rng, to = evt%rng)
	end subroutine evt_resonance_import_rng

	@ %def evt_resonance_import_rng
	@
	We use a standard selector object to choose from the available resonance
	histories. If the selector is inactive, we do not insert resonances.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: write_selector => evt_resonance_write_selector
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_write_selector (evt, unit, testflag)
	class(evt_resonance_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine evt_resonance_write_selector
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_write_selector (evt, unit, testflag)
	class(evt_resonance_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (evt%selector_active) then
	call evt%selector%write (u, testflag)
	else
	write (u, "(1x,A)") "Selector: [inactive]"
	end if
	end subroutine evt_resonance_write_selector

	@ %def evt_resonance_write_selector
	@
	The selector is initialized with relative weights of
	histories which need not be normalized. Channels with weight zero are
	ignored.

	The [[offset]] will normally be $-1$, so we count from zero, and zero
	is a valid result from the selector. Selecting the zero entry implies
	no resonance insertion. However, this behavior is not hard-coded
	here (without offset, no resonance is not possible as a result).
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: init_selector => evt_resonance_init_selector
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_init_selector (evt, weight, offset)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), dimension(:), intent(in) :: weight
	integer, intent(in), optional :: offset
	end subroutine evt_resonance_init_selector
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_init_selector (evt, weight, offset)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), dimension(:), intent(in) :: weight
	integer, intent(in), optional :: offset
	if (any (weight > 0)) then
	call evt%selector%init (weight, offset = offset)
	evt%selector_active = .true.
	else
	evt%selector_active = .false.
	end if
	end subroutine evt_resonance_init_selector

	@ %def evt_resonance_init_selector
	@ Return all selector weights, for inspection. Note that the index
	counts from zero.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: get_selector_weights => evt_resonance_get_selector_weights
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_get_selector_weights (evt, weight)
	class(evt_resonance_t), intent(in) :: evt
	real(default), dimension(0:), intent(out) :: weight
	end subroutine evt_resonance_get_selector_weights
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_get_selector_weights (evt, weight)
	class(evt_resonance_t), intent(in) :: evt
	real(default), dimension(0:), intent(out) :: weight
	integer :: i
	do i = 0, ubound (weight,1)
	weight(i) = evt%selector%get_weight (i)
	end do
	end subroutine evt_resonance_get_selector_weights

	@ %def evt_resonance_get_selector_weights
	@
	\subsection{Runtime calculations}
	Use the associated master process instance and the subprocess
	instances to distribute the current momentum set, then compute the
	squared matrix elements weights for all subprocesses.

	NOTE: Procedures in this subsection are not covered by unit tests
	in this module, but by unit tests of the [[restricted_subprocesses]]
	module.

	Fill the particle set, so the momentum configuration can be used by
	the subprocess instances. The standard workflow is to copy from the
	previous particle set.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: fill_momenta => evt_resonance_fill_momenta
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_fill_momenta (evt)
	class(evt_resonance_t), intent(inout) :: evt
	end subroutine evt_resonance_fill_momenta
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_fill_momenta (evt)
	class(evt_resonance_t), intent(inout) :: evt
	integer :: i, n
	if (associated (evt%previous)) then
	evt%particle_set = evt%previous%particle_set
	else if (associated (evt%process_instance)) then
	! this branch only for unit test
	call evt%process_instance%get_trace &
	(evt%particle_set, i_term=1, n_incoming=evt%process%get_n_in ())
	end if
	end subroutine evt_resonance_fill_momenta

	@ %def evt_resonance_fill_momenta
	@
	Return the indices of those subprocesses which can be considered
	on-shell. The result depends on the stored particle set (outgoing
	momenta) and on the on-shell limit value.

	The index [[evt%selected_component]] identifies the particular history set that
	corresponds to the given process component. Recall that process
	components may have different external particles, so they have
	distinct history sets.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: determine_on_shell_histories &
	=> evt_resonance_determine_on_shell_histories
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_determine_on_shell_histories &
	(evt, index_array)
	class(evt_resonance_t), intent(in) :: evt
	integer, dimension(:), allocatable, intent(out) :: index_array
	end subroutine evt_resonance_determine_on_shell_histories
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_determine_on_shell_histories &
	(evt, index_array)
	class(evt_resonance_t), intent(in) :: evt
	integer, dimension(:), allocatable, intent(out) :: index_array
	integer :: i
	i = evt%selected_component
	call evt%res_history_set(i)%determine_on_shell_histories &
	(evt%particle_set%get_outgoing_momenta (), &
	evt%on_shell_limit, &
	index_array)
	end subroutine evt_resonance_determine_on_shell_histories

	@ %def evt_resonance_determine_on_shell_histories
	@ Evaluate selected subprocesses. (In actual operation, the ones that
	have been tagged as on-shell.)

	We assume that the MCI, term, and channel indices for the subprocesses
	can all be set to 1.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: evaluate_subprocess => evt_resonance_evaluate_subprocess
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_evaluate_subprocess (evt, index_array)
	class(evt_resonance_t), intent(inout) :: evt
	integer, dimension(:), intent(in) :: index_array
	end subroutine evt_resonance_evaluate_subprocess
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_evaluate_subprocess (evt, index_array)
	class(evt_resonance_t), intent(inout) :: evt
	integer, dimension(:), intent(in) :: index_array
	integer :: k, i
	if (allocated (evt%instance)) then
	do k = 1, size (index_array)
	i = index_array(k)
	associate (instance => evt%instance(i)%p)
	call instance%choose_mci (1)
	call instance%set_trace (evt%particle_set, 1, check_match=.false.)
	call instance%recover (channel = 1, i_term = 1, &
	update_sqme = .true., recover_phs = .false.)
	end associate
	end do
	end if
	end subroutine evt_resonance_evaluate_subprocess

	@ %def evt_resonance_evaluate_subprocess
	@ Return the current squared matrix-element value of the master
	process, and of the selected resonant subprocesses, respectively.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: get_master_sqme => evt_resonance_get_master_sqme
	procedure :: get_subprocess_sqme => evt_resonance_get_subprocess_sqme
	<<Resonance insertion: sub interfaces>>=
	module function evt_resonance_get_master_sqme (evt) result (sqme)
	class(evt_resonance_t), intent(in) :: evt
	real(default) :: sqme
	end function evt_resonance_get_master_sqme
	module subroutine evt_resonance_get_subprocess_sqme (evt, sqme, index_array)
	class(evt_resonance_t), intent(in) :: evt
	real(default), dimension(:), intent(out) :: sqme
	integer, dimension(:), intent(in), optional :: index_array
	end subroutine evt_resonance_get_subprocess_sqme
	<<Resonance insertion: procedures>>=
	module function evt_resonance_get_master_sqme (evt) result (sqme)
	class(evt_resonance_t), intent(in) :: evt
	real(default) :: sqme
	sqme = evt%process_instance%get_sqme ()
	end function evt_resonance_get_master_sqme

	module subroutine evt_resonance_get_subprocess_sqme (evt, sqme, index_array)
	class(evt_resonance_t), intent(in) :: evt
	real(default), dimension(:), intent(out) :: sqme
	integer, dimension(:), intent(in), optional :: index_array
	integer :: k, i
	if (present (index_array)) then
	sqme = 0
	do k = 1, size (index_array)
	call get_sqme (index_array(k))
	end do
	else
	do i = 1, size (evt%instance)
	call get_sqme (i)
	end do
	end if
	contains
	subroutine get_sqme (i)
	integer, intent(in) :: i
	associate (instance => evt%instance(i)%p)
	sqme(i) = instance%get_sqme ()
	end associate
	end subroutine get_sqme
	end subroutine evt_resonance_get_subprocess_sqme

	@ %def evt_resonance_get_master_sqme
	@ %def evt_resonance_get_subprocess_sqme
	@ Apply a turnoff factor for off-shell kinematics to the [[sqme]]
	values. The [[sqme]] array indices are offset from the resonance
	history set entries.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: apply_turnoff_factor => evt_resonance_apply_turnoff_factor
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_apply_turnoff_factor &
	(evt, sqme, index_array)
	class(evt_resonance_t), intent(in) :: evt
	real(default), dimension(:), intent(inout) :: sqme
	integer, dimension(:), intent(in) :: index_array
	end subroutine evt_resonance_apply_turnoff_factor
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_apply_turnoff_factor (evt, sqme, index_array)
	class(evt_resonance_t), intent(in) :: evt
	real(default), dimension(:), intent(inout) :: sqme
	integer, dimension(:), intent(in) :: index_array
	integer :: k, i_res, i_prc
	do k = 1, size (index_array)
	i_res = evt%selected_component
	i_prc = index_array(k) + evt%index_offset(i_res)
	sqme(i_prc) = sqme(i_prc) &
	* evt%res_history_set(i_res)%evaluate_gaussian &
	& (evt%particle_set%get_outgoing_momenta (), &
	& evt%on_shell_turnoff, index_array(k))
	end do
	end subroutine evt_resonance_apply_turnoff_factor

	@ %def evt_resonance_apply_turnoff_factor
	@ We use the calculations of resonant matrix elements to determine
	probabilities for all applicable resonance configurations. This method combines
	the steps implemented above.

	First, we determine the selected process component.

	TODO: the version below selects the first component which is found
	active. This make sense only for standard LO process components,
	where exactly one component corresponds to a MCI set.

	For the selected process component, we query the kinematics and
	determine the applicable resonance histories. We collect squared
	matrix elements for those resonance histories and compare them to the
	master-process squared matrix element.

	The result is the probability for each resonance history
	together with the probability for non-resonant background (zeroth
	entry). The latter is defined as the difference between the complete
	process result and the sum of the resonances, ignoring the possibility
	for interference. If the complete process result is actually
	undershooting the sum of resonances, we nevertheless count the
	background with positive probability.

	When looking up the subprocess sqme, we must add the [[index_offset]]
	to the resulting array, since the indices returned by the individual
	history set all count from one, while the subprocess instances that
	belong to process components are collected in one flat array.

	After determining matrix elements and background, we may reduce the
	weight of the matrix elements in the selector by applying a turnoff
	factor.

	The factor [[background_factor]] indicates whether to include the background
	contribution at all, as long as there is a nonvanishing resonance
	contribution. Note that instead of setting background to zero, we just
	multiply it by a very small number. This ensures that indices are assigned
	correctly, and that background will eventually be selected if smooth turnoff
	is chosen.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: compute_probabilities => evt_resonance_compute_probabilities
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_compute_probabilities (evt)
	class(evt_resonance_t), intent(inout) :: evt
	end subroutine evt_resonance_compute_probabilities
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_compute_probabilities (evt)
	class(evt_resonance_t), intent(inout) :: evt
	integer, dimension(:), allocatable :: index_array
	real(default) :: sqme_master, sqme_sum, sqme_bg
	real(default), dimension(:), allocatable :: sqme_res
	integer :: n, ic
	if (.not. associated (evt%process_instance)) return
	n = size (evt%instance)
	call evt%select_component (0)
	FIND_ACTIVE_COMPONENT: do ic = 1, evt%process%get_n_components ()
	if (evt%process%component_is_selected (ic)) then
	call evt%select_component (ic)
	exit FIND_ACTIVE_COMPONENT
	end if
	end do FIND_ACTIVE_COMPONENT
	if (evt%selected_component > 0) then
	call evt%determine_on_shell_histories (index_array)
	else
	allocate (index_array (0))
	end if
	call evt%evaluate_subprocess &
	(index_array + evt%index_offset(evt%selected_component))
	allocate (sqme_res (n), source = 0._default)
	call evt%get_subprocess_sqme &
	(sqme_res, index_array + evt%index_offset(evt%selected_component))
	sqme_master = evt%get_master_sqme ()
	sqme_sum = sum (sqme_res)
	sqme_bg = abs (sqme_master - sqme_sum)
	if (evt%on_shell_turnoff > 0) then
	call evt%apply_turnoff_factor (sqme_res, index_array)
	end if
	if (any (sqme_res > 0)) then
	sqme_bg = sqme_bg * evt%background_factor
	end if
	call evt%init_selector ([sqme_bg, sqme_res], offset = -1)
	end subroutine evt_resonance_compute_probabilities

	@ %def evt_resonance_compute_probabilities
	@ Set the selected component (unit tests).
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: select_component => evt_resonance_select_component
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_select_component (evt, i_component)
	class(evt_resonance_t), intent(inout) :: evt
	integer, intent(in) :: i_component
	end subroutine evt_resonance_select_component
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_select_component (evt, i_component)
	class(evt_resonance_t), intent(inout) :: evt
	integer, intent(in) :: i_component
	evt%selected_component = i_component
	end subroutine evt_resonance_select_component

	@ %def evt_resonance_select_component
	@
	\subsection{Sanity check}
	Check the color assignment, which may be wrong for the inserted resonances.
	Delegated to the particle-set component. Return offending particle
	indices and, optionally, particles as arrays.

	This is done in a unit test. The current algorithm, i.e., selecting
	the color assignment from the resonant-subprocess instance, should not
	generate invalid color assignments.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: find_prt_invalid_color => evt_resonance_find_prt_invalid_color
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_find_prt_invalid_color (evt, index, prt)
	class(evt_resonance_t), intent(in) :: evt
	integer, dimension(:), allocatable, intent(out) :: index
	type(particle_t), dimension(:), allocatable, intent(out), optional :: prt
	end subroutine evt_resonance_find_prt_invalid_color
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_find_prt_invalid_color (evt, index, prt)
	class(evt_resonance_t), intent(in) :: evt
	integer, dimension(:), allocatable, intent(out) :: index
	type(particle_t), dimension(:), allocatable, intent(out), optional :: prt
	if (evt%particle_set_exists) then
	call evt%particle_set%find_prt_invalid_color (index, prt)
	else
	allocate (prt (0))
	end if
	end subroutine evt_resonance_find_prt_invalid_color

	@ %def evt_resonance_find_prt_invalid_color
	@
	\subsection{API implementation}
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: prepare_new_event => evt_resonance_prepare_new_event
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_prepare_new_event (evt, i_mci, i_term)
	class(evt_resonance_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	end subroutine evt_resonance_prepare_new_event
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_prepare_new_event (evt, i_mci, i_term)
	class(evt_resonance_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	call evt%reset ()
	end subroutine evt_resonance_prepare_new_event

	@ %def evt_resonance_prepare_new_event
	@ Select one of the histories, based on the momentum array from the
	current particle set. Compute the probabilities for all resonant
	subprocesses and initialize the selector accordingly. Then select one
	resonance history, or none.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: generate_weighted => evt_resonance_generate_weighted
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_generate_weighted (evt, probability)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	end subroutine evt_resonance_generate_weighted
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_generate_weighted (evt, probability)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	+ integer :: i_term
	call evt%fill_momenta ()
	call evt%compute_probabilities ()
	- call evt%selector%generate (evt%rng, evt%selected_history)
	+ if (associated (evt%process_instance)) then
	+ i_term = evt%process_instance%get_first_active_i_term ()
	+ if (evt%process_instance%term(i_term)%passed) then
	+ call evt%selector%generate (evt%rng, evt%selected_history)
	+ end if
	+ else
	+ call evt%selector%generate (evt%rng, evt%selected_history)
	+ end if
	probability = 1
	end subroutine evt_resonance_generate_weighted

	@ %def evt_resonance_generate_weighted
	@ Here take the current particle set and insert resonance intermediate
	states if applicable. The resonance history has already been chosen
	by the generator above. If no resonance history applies, just retain
	the particle set.

	If a resonance history applies, we factorize the exclusive interaction
	of the selected (resonance-process) process instance. With a
	temporary particle set [[prt_set]] as workspace, we the insert the
	resonances, reinstate parent-child relations and set colors and
	momenta for the resonances. The temporary is then copied back.

	Taking the event data from the resonant subprocess instead of the
	master process, guarantees that all flavor, helicity, and color
	assignments are valid for the selected resonance history. Note that
	the transform may thus choose a quantum-number combination that is
	different from the one chosen by the master process.

	The [[i_term]] value for the selected subprocess instance is always
	1. We support only LO process. For those, the master process may
	have several terms (= components) that correspond to different
	external states. The subprocesses are distinct, each one corresponds
	to a definite master component, and by itself it consists of a single
	component/term.

	However, if the selector chooses resonance history \#0, i.e., no
	resonance, we just copy the particle set from the previous (i.e.,
	trivial) event transform and ignore all subprocess data.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: make_particle_set => evt_resonance_make_particle_set
	<<Resonance insertion: sub interfaces>>=
	module subroutine evt_resonance_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_resonance_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	end subroutine evt_resonance_make_particle_set
	<<Resonance insertion: procedures>>=
	module subroutine evt_resonance_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_resonance_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	type(particle_set_t), target :: prt_set
	type(particle_t), dimension(:), allocatable :: prt
	integer :: n_beam, n_in, n_vir, n_res, n_out, i, i_res, i_term, i_tree
	type(interaction_t), pointer :: int_matrix, int_flows
	integer, dimension(:), allocatable :: map
	type(resonance_tree_t) :: res_tree
	if (associated (evt%previous)) then
	if (evt%previous%particle_set_exists) then
	if (evt%selected_history > 0) then
	if (allocated (evt%instance)) then
	associate (instance => evt%instance(evt%selected_history)%p)
	call instance%evaluate_event_data (weight = 1._default)
	i_term = 1
	int_matrix => instance%get_matrix_int_ptr (i_term)
	int_flows => instance%get_flows_int_ptr (i_term)
	call evt%factorize_interactions (int_matrix, int_flows, &
	factorization_mode, keep_correlations, r)
	call evt%tag_incoming ()
	end associate
	else ! this branch only for unit test
	evt%particle_set = evt%previous%particle_set
	end if
	i_tree = evt%selected_history &
	- evt%index_offset(evt%selected_component)
	call evt%res_history_set(evt%selected_component)%get_tree &
	(i_tree, res_tree)
	n_beam = evt%particle_set%get_n_beam ()
	n_in = evt%particle_set%get_n_in ()
	n_vir = evt%particle_set%get_n_vir ()
	n_out = evt%particle_set%get_n_out ()
	n_res = res_tree%get_n_resonances ()
	allocate (map (n_beam + n_in + n_vir + n_out))
	map(1:n_beam+n_in+n_vir) &
	= [(i, i = 1, n_beam+n_in+n_vir)]
	map(n_beam+n_in+n_vir+1:n_beam+n_in+n_vir+n_out) &
	= [(i + n_res, &
	& i = n_beam+n_in+n_vir+1, &
	& n_beam+n_in+n_vir+n_out)]
	call prt_set%transfer (evt%particle_set, n_res, map)
	do i = 1, n_res
	i_res = n_beam + n_in + n_vir + i
	call prt_set%insert (i_res, &
	PRT_RESONANT, &
	res_tree%get_flv (i), &
	res_tree%get_children (i, &
	& n_beam+n_in+n_vir, n_beam+n_in+n_vir+n_res))
	end do
	do i = n_res, 1, -1
	i_res = n_beam + n_in + n_vir + i
	call prt_set%recover_color (i_res)
	end do
	call prt_set%set_momentum &
	(map(:), evt%particle_set%get_momenta (), on_shell = .true.)
	do i = n_res, 1, -1
	i_res = n_beam + n_in + n_vir + i
	call prt_set%recover_momentum (i_res)
	end do
	call evt%particle_set%final ()
	evt%particle_set = prt_set
	call prt_set%final ()
	evt%particle_set_exists = .true.
	else ! retain particle set, as copied from previous evt
	evt%particle_set_exists = .true.
	end if
	else
	evt%particle_set_exists = .false.
	end if
	else
	evt%particle_set_exists = .false.
	end if
	end subroutine evt_resonance_make_particle_set

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

	module resonance_insertion_ut
	use unit_tests
	use resonance_insertion_uti

	<<Standard module head>>

	<<Resonance insertion: public test>>

	contains

	<<Resonance insertion: test driver>>

	end module resonance_insertion_ut
	@ %def resonance_insertion_ut
	@
	<<[[resonance_insertion_uti.f90]]>>=
	<<File header>>

	module resonance_insertion_uti

	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use os_interface
	use lorentz
	use rng_base, only: rng_t
	use flavors, only: flavor_t
	use colors, only: color_t
	use models, only: syntax_model_file_init, syntax_model_file_final
	use models, only: model_list_t, model_t
	use particles, only: particle_t, particle_set_t

	use resonances, only: resonance_info_t
	use resonances, only: resonance_history_t
	use resonances, only: resonance_history_set_t

	use event_transforms
	use resonance_insertion

	use rng_base_ut, only: rng_test_t

	<<Standard module head>>

	<<Resonance insertion: test declarations>>

	contains

	<<Resonance insertion: tests>>

	end module resonance_insertion_uti

	@ %def resonance_insertion_uti
	@ API: driver for the unit tests below.
	<<Resonance insertion: public test>>=
	public :: resonance_insertion_test
	<<Resonance insertion: test driver>>=
	subroutine resonance_insertion_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Resonance insertion: execute tests>>
	end subroutine resonance_insertion_test

	@ %def resonance_insertion_test
	@
	\subsubsection{Test resonance insertion as event transform}
	Insert a resonance (W boson) into an event with momentum assignment.
	<<Resonance insertion: execute tests>>=
	call test (resonance_insertion_1, "resonance_insertion_1", &
	"simple resonance insertion", &
	u, results)
	<<Resonance insertion: test declarations>>=
	public :: resonance_insertion_1
	<<Resonance insertion: tests>>=
	subroutine resonance_insertion_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	type(flavor_t) :: fw
	type(color_t) :: col
	real(default) :: mw, ew, pw
	type(vector4_t), dimension(5) :: p
	class(rng_t), allocatable :: rng
	real(default) :: probability
	integer, dimension(:), allocatable :: i_invalid
	type(particle_t), dimension(:), allocatable :: prt_invalid
	integer :: i

	write (u, "(A)") "* Test output: resonance_insertion_1"
	write (u, "(A)") "* Purpose: apply simple resonance insertion"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data%init ()
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)
	! reset slightly in order to avoid a rounding ambiguity
	call model%set_real (var_str ("mW"), 80.418_default)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 3, &
	pdg = [1, -1, 1, -2, 24], model = model)

	call fw%init (24, model)

	mw = fw%get_mass ()
	ew = 200._default
	pw = sqrt (ew2 - mw2)

	p(1) = vector4_moving (ew, ew, 3)
	p(2) = vector4_moving (ew,-ew, 3)
	p(3) = vector4_moving (ew/2, vector3_moving ([pw/2, mw/2, 0._default]))
	p(4) = vector4_moving (ew/2, vector3_moving ([pw/2,-mw/2, 0._default]))
	p(5) = vector4_moving (ew, vector3_moving ([-pw, 0._default, 0._default]))

	call pset%set_momentum (p, on_shell = .true.)

	call col%init_col_acl (1,0)
	call pset%set_color (1, col)

	call col%init_col_acl (0,1)
	call pset%set_color (2, col)

	call col%init_col_acl (2,0)
	call pset%set_color (3, col)

	call col%init_col_acl (0,2)
	call pset%set_color (4, col)

	call col%init_col_acl (0,0)
	call pset%set_color (5, col)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Prepare resonance history set"
	write (u, "(A)")

	call res_history_set(1)%init ()

	call res_info%init (3, -24, model, 2)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_history_set(1)%freeze ()

	write (u, "(A)") "* Initialize resonance insertion transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	allocate (rng_test_t :: rng)
	call evt_resonance%import_rng (rng)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill resonance insertion transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%init_selector ([1._default])
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (0, .false.)

	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

	write (u, "(A)")
	call evt_resonance%find_prt_invalid_color (i_invalid, prt_invalid)
	write (u, "(A)") "Particles with invalid color:"
	select case (size (prt_invalid))
	case (0)
	write (u, "(2x,A)") "[none]"
	case default
	do i = 1, size (prt_invalid)
	write (u, "(1x,A,1x,I0)", advance="no") "Particle", i_invalid(i)
	call prt_invalid(i)%write (u)
	end do
	end select

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

	call evt_resonance%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

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

	end subroutine resonance_insertion_1

	@ %def resonance_insertion_1
	@
	\subsubsection{Resonance insertion with color mismatch}
	Same as previous test (but no momenta); resonance insertion should fail
	because of color mismatch: W boson is color-neutral.
	<<Resonance insertion: execute tests>>=
	call test (resonance_insertion_2, "resonance_insertion_2", &
	"resonance color mismatch", &
	u, results)
	<<Resonance insertion: test declarations>>=
	public :: resonance_insertion_2
	<<Resonance insertion: tests>>=
	subroutine resonance_insertion_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	type(color_t) :: col
	class(rng_t), allocatable :: rng
	real(default) :: probability
	type(particle_t), dimension(:), allocatable :: prt_invalid
	integer, dimension(:), allocatable :: i_invalid
	integer :: i

	write (u, "(A)") "* Test output: resonance_insertion_2"
	write (u, "(A)") "* Purpose: resonance insertion with color mismatch"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	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)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 3, &
	pdg = [1, -1, 1, -2, 24], model = model)

	call col%init_col_acl (1,0)
	call pset%set_color (1, col)

	call col%init_col_acl (0,2)
	call pset%set_color (2, col)

	call col%init_col_acl (1,0)
	call pset%set_color (3, col)

	call col%init_col_acl (0,2)
	call pset%set_color (4, col)

	call col%init_col_acl (0,0)
	call pset%set_color (5, col)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Prepare resonance history set"
	write (u, "(A)")

	call res_history_set(1)%init ()

	call res_info%init (3, -24, model, 2)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_history_set(1)%freeze ()

	write (u, "(A)") "* Initialize resonance insertion transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	allocate (rng_test_t :: rng)
	call evt_resonance%import_rng (rng)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill resonance insertion transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%init_selector ([1._default])
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (0, .false.)

	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

	write (u, "(A)")
	call evt_resonance%find_prt_invalid_color (i_invalid, prt_invalid)
	write (u, "(A)") "Particles with invalid color:"
	select case (size (prt_invalid))
	case (0)
	write (u, "(2x,A)") "[none]"
	case default
	do i = 1, size (prt_invalid)
	write (u, "(1x,A,1x,I0)", advance="no") "Particle", i_invalid(i)
	call prt_invalid(i)%write (u)
	end do
	end select

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

	call evt_resonance%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

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

	end subroutine resonance_insertion_2

	@ %def resonance_insertion_2
	@
	\subsubsection{Complex resonance history}
	This is the resonance history $u\bar u \to (t\to W^+ b) + (\bar t\to
	(h \to b\bar b) + (\bar t^\ast \to W^-\bar b))$.
	<<Resonance insertion: execute tests>>=
	call test (resonance_insertion_3, "resonance_insertion_3", &
	"complex resonance history", &
	u, results)
	<<Resonance insertion: test declarations>>=
	public :: resonance_insertion_3
	<<Resonance insertion: tests>>=
	subroutine resonance_insertion_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	type(color_t) :: col
	class(rng_t), allocatable :: rng
	real(default) :: probability
	type(particle_t), dimension(:), allocatable :: prt_invalid
	integer, dimension(:), allocatable :: i_invalid
	integer :: i

	write (u, "(A)") "* Test output: resonance_insertion_3"
	write (u, "(A)") "* Purpose: resonance insertion with color mismatch"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	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)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 6, &
	pdg = [2, -2, 24, 5, 5, -5, -24, -5], model = model)

	call col%init_col_acl (1,0)
	call pset%set_color (1, col)

	call col%init_col_acl (0,2)
	call pset%set_color (2, col)

	call col%init_col_acl (0,0)
	call pset%set_color (3, col)

	call col%init_col_acl (1,0)
	call pset%set_color (4, col)

	call col%init_col_acl (3,0)
	call pset%set_color (5, col)

	call col%init_col_acl (0,3)
	call pset%set_color (6, col)

	call col%init_col_acl (0,0)
	call pset%set_color (7, col)

	call col%init_col_acl (0,2)
	call pset%set_color (8, col)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Prepare resonance history set"
	write (u, "(A)")

	call res_history_set(1)%init ()

	call res_info%init (3, 6, model, 6)
	call res_history%add_resonance (res_info)
	call res_info%init (12, 25, model, 6)
	call res_history%add_resonance (res_info)
	call res_info%init (60, -6, model, 6)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_history_set(1)%freeze ()

	write (u, "(A)") "* Initialize resonance insertion transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	allocate (rng_test_t :: rng)
	call evt_resonance%import_rng (rng)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill resonance insertion transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%init_selector ([1._default])
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (0, .false.)

	call evt_resonance%write (u)

	write (u, "(A)")
	call evt_resonance%find_prt_invalid_color (i_invalid, prt_invalid)
	write (u, "(A)") "Particles with invalid color:"
	select case (size (prt_invalid))
	case (0)
	write (u, "(2x,A)") "[none]"
	case default
	do i = 1, size (prt_invalid)
	write (u, "(1x,A,1x,I0)", advance="no") "Particle", i_invalid(i)
	call prt_invalid(i)%write (u)
	end do
	end select

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

	call evt_resonance%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

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

	end subroutine resonance_insertion_3

	@ %def resonance_insertion_3
	@
	\subsubsection{Resonance history selection}
	Another test with zero momenta: select one of several resonant channels
	using the selector component.
	<<Resonance insertion: execute tests>>=
	call test (resonance_insertion_4, "resonance_insertion_4", &
	"resonance history selection", &
	u, results)
	<<Resonance insertion: test declarations>>=
	public :: resonance_insertion_4
	<<Resonance insertion: tests>>=
	subroutine resonance_insertion_4 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	type(color_t) :: col
	class(rng_t), allocatable :: rng
	real(default) :: probability
	integer :: i

	write (u, "(A)") "* Test output: resonance_insertion_4"
	write (u, "(A)") "* Purpose: resonance history selection"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	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)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 4, &
	pdg = [1, -1, 1, -2, -3, 4], model = model)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Prepare resonance history set"
	write (u, "(A)")

	call res_history_set(1)%init ()

	call res_info%init (3, -24, model, 4)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_info%init (12, 24, model, 4)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_info%init (12, 24, model, 4)
	call res_history%add_resonance (res_info)
	call res_info%init (15, 25, model, 4)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_history_set(1)%freeze ()

	write (u, "(A)") "* Initialize resonance insertion transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	allocate (rng_test_t :: rng)
	call evt_resonance%import_rng (rng)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill resonance insertion transform"
	write (u, "(A)")

	do i = 1, 6
	write (u, "(A,1x,I0)") "* Event #", i
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%init_selector ([1._default, 2._default, 1._default])
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (0, .false.)

	call evt_resonance%write (u)
	write (u, "(A)")
	end do

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

	call evt_resonance%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

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

	end subroutine resonance_insertion_4

	@ %def resonance_insertion_4
	@
	\subsubsection{Resonance history selection}
	Another test with zero momenta: select either a resonant channel or no
	resonance.
	<<Resonance insertion: execute tests>>=
	call test (resonance_insertion_5, "resonance_insertion_5", &
	"resonance history on/off", &
	u, results)
	<<Resonance insertion: test declarations>>=
	public :: resonance_insertion_5
	<<Resonance insertion: tests>>=
	subroutine resonance_insertion_5 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	type(color_t) :: col
	class(rng_t), allocatable :: rng
	real(default) :: probability
	integer :: i

	write (u, "(A)") "* Test output: resonance_insertion_5"
	write (u, "(A)") "* Purpose: resonance history selection including no resonance"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	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)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 4, &
	pdg = [1, -1, 1, -2, -3, 4], model = model)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)

	write (u, "(A)") "* Prepare resonance history set"
	write (u, "(A)")

	call res_history_set(1)%init ()

	call res_info%init (3, -24, model, 4)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_history_set(1)%freeze ()

	write (u, "(A)") "* Initialize resonance insertion transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	allocate (rng_test_t :: rng)
	call evt_resonance%import_rng (rng)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)

	write (u, "(A)") "* Fill resonance insertion transform"
	write (u, "(A)")

	do i = 1, 2
	write (u, "(A,1x,I0)") "* Event #", i
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%init_selector ([1._default, 3._default], offset = -1)
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (0, .false.)

	call evt_resonance%write (u)
	write (u, "(A)")
	end do

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

	call evt_resonance%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

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

	end subroutine resonance_insertion_5

	@ %def resonance_insertion_5
	@
	\subsubsection{Resonance insertion with structured beams}
	Insert a resonance (W boson) into an event with beam and virtual
	particles.
	<<Resonance insertion: execute tests>>=
	call test (resonance_insertion_6, "resonance_insertion_6", &
	"resonance insertion with beam structure", &
	u, results)
	<<Resonance insertion: test declarations>>=
	public :: resonance_insertion_6
	<<Resonance insertion: tests>>=
	subroutine resonance_insertion_6 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(particle_set_t) :: pset
	type(model_t), pointer :: model
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	class(rng_t), allocatable :: rng
	real(default) :: probability

	write (u, "(A)") "* Test output: resonance_insertion_6"
	write (u, "(A)") "* Purpose: resonance insertion with structured beams"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	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)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 11, -11, 22, 22, 13, -13], model = model)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Prepare resonance history set"
	write (u, "(A)")

	call res_history_set(1)%init ()

	call res_info%init (3, 23, model, 2)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_history_set(1)%freeze ()

	write (u, "(A)") "* Initialize resonance insertion transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	allocate (rng_test_t :: rng)
	call evt_resonance%import_rng (rng)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill resonance insertion transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%init_selector ([1._default])
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (0, .false.)

	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

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

	call evt_resonance%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

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

	end subroutine resonance_insertion_6

	@ %def resonance_insertion_6
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Recoil kinematics}
	<<[[recoil_kinematics.f90]]>>=
	<<File header>>

	module recoil_kinematics

	<<Use kinds>>
	use lorentz, only: vector4_t
	use lorentz, only: vector4_null
	use lorentz, only: vector4_moving
	use lorentz, only: vector3_moving
	use lorentz, only: transverse_part
	use lorentz, only: lorentz_transformation_t
	use lorentz, only: inverse
	use lorentz, only: boost
	use lorentz, only: transformation
	use lorentz, only: operator(+)
	use lorentz, only: operator(-)
	use lorentz, only: operator(*)
	use lorentz, only: operator(**)
	use lorentz, only: lambda

	<<Standard module head>>

	<<Recoil kinematics: public>>

	<<Recoil kinematics: parameters>>

	<<Recoil kinematics: types>>

	interface
	<<Recoil kinematics: sub interfaces>>
	end interface

	end module recoil_kinematics
	@ %def recoil_kinematics
	@
	<<[[recoil_kinematics_sub.f90]]>>=
	<<File header>>

	submodule (recoil_kinematics) recoil_kinematics_s

	use constants, only: twopi

	implicit none

	contains

	<<Recoil kinematics: procedures>>

	end submodule recoil_kinematics_s

	@ %def recoil_kinematics_s
	@
	\subsection{$\phi$ sampler}
	This is trivial. Generate an azimuthal angle, given a $(0,1)$ RNG parameter.
	<<Recoil kinematics: procedures>>=
	elemental subroutine generate_phi_recoil (r, phi)
	real(default), intent(in) :: r
	real(default), intent(out) :: phi

	phi = r * twopi

	end subroutine generate_phi_recoil

	@ %def generate_phi_recoil
	@
	\subsection{$Q^2$ sampler}
	The dynamics of factorization suggests to generate a flat $Q^2$
	distribution from a (random) number, event by event.

	At the lowest momentum transfer values, the particle (electron) mass
	sets a smooth cutoff. The formula can produce $Q$ values below the
	electron mass, down to zero, but with a power distribution that
	eventually evolves into the expected logarithmic distribution for $Q^2 >
	m^2$.

	We are talking about the absolute value here, so all $Q^2$
	values are positive. For the actual momentum transfer, $q^2=-Q^2$.
	<<Recoil kinematics: public>>=
	public :: generate_q2_recoil
	<<Recoil kinematics: sub interfaces>>=
	elemental module subroutine generate_q2_recoil (s, x_bar, q2_max, m2, r, q2)
	real(default), intent(in) :: s
	real(default), intent(in) :: q2_max
	real(default), intent(in) :: x_bar
	real(default), intent(in) :: m2
	real(default), intent(in) :: r
	real(default), intent(out) :: q2
	end subroutine generate_q2_recoil
	<<Recoil kinematics: procedures>>=
	elemental module subroutine generate_q2_recoil (s, x_bar, q2_max, m2, r, q2)
	real(default), intent(in) :: s
	real(default), intent(in) :: q2_max
	real(default), intent(in) :: x_bar
	real(default), intent(in) :: m2
	real(default), intent(in) :: r
	real(default), intent(out) :: q2

	real(default) :: q2_max_evt

	q2_max_evt = q2_max_event (s, x_bar, q2_max)

	q2 = m2 * (exp (r * log (1 + (q2_max_evt / m2))) - 1)

	end subroutine generate_q2_recoil

	@ %def generate_q_recoil
	@
	The $Q$ distribution is cut off from above by the kinematic limit,
	which depends on the energy that is available for the radiated photon,
	or by a user-defined cutoff -- whichever is less. The kinematic limit
	fits the formulas for recoil momenta (see below), and it also
	implicitly enters the ISR collinear structure function, so the
	normalization of the distribution should be correct.
	<<Recoil kinematics: procedures>>=
	elemental function q2_max_event (s, x_bar, q2_max) result (q2)
	real(default), intent(in) :: s
	real(default), intent(in) :: x_bar
	real(default), intent(in) :: q2_max
	real(default) :: q2

	q2 = min (x_bar * s, q2_max)

	end function q2_max_event

	@ %def q2_max_event
	@
	\subsection{Kinematics functions}
	Given values for energies, $Q_{1,2}^2$, azimuthal angle, compute the
	matching polar angle of the radiating particle. The subroutine
	returns $\sin\theta$ and $\cos\theta$.
	<<Recoil kinematics: procedures>>=
	subroutine polar_angles (s, xb, rho, ee, q2, sin_th, cos_th, ok)
	real(default), intent(in) :: s
	real(default), intent(in) :: xb
	real(default), intent(in) :: rho
	real(default), dimension(2), intent(in) :: ee
	real(default), dimension(2), intent(in) :: q2
	real(default), dimension(2), intent(out) :: sin_th
	real(default), dimension(2), intent(out) :: cos_th
	logical, intent(out) :: ok

	real(default), dimension(2) :: sin2_th_2

	sin2_th_2 = q2 / (ee * rho * xb * s)

	if (all (sin2_th_2 <= 1)) then
	sin_th = 2 * sqrt (sin2_th_2 * (1 - sin2_th_2))
	cos_th = 1 - 2 * sin2_th_2
	ok = .true.
	else
	sin_th = 0
	cos_th = 1
	ok = .false.
	end if

	end subroutine polar_angles

	@ %def polar_angles
	@
	Compute the acollinearity parameter $\lambda$ from azimuthal and polar
	angles. The result is a number between $0$ and $1$.
	<<Recoil kinematics: procedures>>=
	function lambda_factor (sin_th, cos_th, cphi) result (lambda)
	real(default), dimension(2), intent(in) :: sin_th
	real(default), dimension(2), intent(in) :: cos_th
	real(default), intent(in) :: cphi
	real(default) :: lambda

	lambda = (1 - cos_th(1) * cos_th(2) - cphi * sin_th(1) * sin_th(2)) / 2

	end function lambda_factor

	@ %def lambda_factor
	@
	Compute the factor that rescales photon energies, such that the
	radiation angles match the kinematics parameters.

	For small values of $\bar x/\cosh\eta$, we have to use the Taylor
	expansion if we do not want to lose precision. The optional argument
	allows for a unit test that compares exact and approximate.
	<<Recoil kinematics: procedures>>=
	function scale_factor (che, lambda, xb0, approximate) result (rho)
	real(default), intent(in) :: che
	real(default), intent(in) :: lambda
	real(default), intent(in) :: xb0
	logical, intent(in), optional :: approximate
	real(default) :: rho

	real(default), parameter :: &
	e0 = (100 * epsilon (1._default)) ** (0.3_default)
	logical :: approx

	if (present (approximate)) then
	approx = approximate
	else
	approx = (xb0/che) < e0
	end if

	if (approx) then
	rho = 1 - lambda * (xb0/(2che)) (1 + (1-lambda) * (xb0/che))
	else
	rho = (che / ((1-lambda)*xb0)) &
	* (1 - sqrt (1 - 2 * (1-lambda) * (xb0/che) &
	& + (1-lambda) * (xb0 / che)**2))
	end if

	end function scale_factor

	@ %def scale_factor
	@ The code snippet below is not used anywhere, but may be manually
	inserted in a unit test to numerically verify the approximation above.
	<<Recoil kinematics: extra test code>>=
	write (u, "(A)")
	write (u, "(A)") "*** Table: scale factor calculation"
	write (u, "(A)")

	lambda = 0.25_default
	write (u, FMT1) "lambda =", lambda

	che = 4._default
	write (u, FMT1) "che =", che

	write (u, "(A)") " x0 rho(exact) rho(approx) rho(chosen)"
	xb0 = 1._default
	do i = 1, 30
	xb0 = xb0 / 10
	write (u, FMT4) xb0, &
	scale_factor (che, lambda, xb0, approximate=.false.), &
	scale_factor (che, lambda, xb0, approximate=.true.), &
	scale_factor (che, lambda, xb0)
	end do
	@
	Compute the current values for the $x_{1,2}$ parameters, given the
	updated scale factor $\rho$ and the collinear parameters.
	<<Recoil kinematics: procedures>>=
	subroutine scaled_x (rho, ee, xb0, x, xb)
	real(default), intent(in) :: rho
	real(default), dimension(2), intent(in) :: ee
	real(default), intent(in) :: xb0
	real(default), dimension(2), intent(out) :: x
	real(default), dimension(2), intent(out) :: xb

	xb = rho * ee * xb0
	x = 1 - xb

	end subroutine scaled_x

	@ %def scaled_x
	@
	\subsection{Iterative solution of kinematics constraints}
	Find a solution of the kinematics constraints. We know the parameters
	appropriate for collinear kinematics $\sqrt{s}$, $x^c_{1,2}$. We
	have picked values vor the momentum transfer $Q_{1,2}$ and the
	azimuthal angles $\phi_{1,2}$. The solution consists of modified energy
	fractions $x_{1,2}$ and polar angles $\theta_{1,2}$.

	If the computation fails, which can happen for large momentum
	transfer, the flag [[ok]] will indicate this.
	<<Recoil kinematics: public>>=
	public :: solve_recoil
	<<Recoil kinematics: sub interfaces>>=
	module subroutine solve_recoil &
	(sqrts, xc, xcb, phi, q2, x, xb, cos_th, sin_th, ok)
	real(default), intent(in) :: sqrts
	real(default), dimension(2), intent(in) :: xc
	real(default), dimension(2), intent(in) :: xcb
	real(default), dimension(2), intent(in) :: phi
	real(default), dimension(2), intent(in) :: q2
	real(default), dimension(2), intent(out) :: x
	real(default), dimension(2), intent(out) :: xb
	real(default), dimension(2), intent(out) :: cos_th
	real(default), dimension(2), intent(out) :: sin_th
	logical, intent(out) :: ok
	end subroutine solve_recoil
	<<Recoil kinematics: procedures>>=
	module subroutine solve_recoil &
	(sqrts, xc, xcb, phi, q2, x, xb, cos_th, sin_th, ok)
	real(default), intent(in) :: sqrts
	real(default), dimension(2), intent(in) :: xc
	real(default), dimension(2), intent(in) :: xcb
	real(default), dimension(2), intent(in) :: phi
	real(default), dimension(2), intent(in) :: q2
	real(default), dimension(2), intent(out) :: x
	real(default), dimension(2), intent(out) :: xb
	real(default), dimension(2), intent(out) :: cos_th
	real(default), dimension(2), intent(out) :: sin_th
	logical, intent(out) :: ok

	real(default) :: s
	real(default), dimension(2) :: ee
	real(default), dimension(2) :: th
	real(default) :: xb0, cphi
	real(default) :: che, lambda
	real(default) :: rho_new, rho, rho_old
	real(default) :: dr_old, dr_new
	real(default), parameter :: dr_limit = 100 * epsilon (1._default)
	integer, parameter :: n_it_max = 20
	integer :: i

	ok = .true.

	s = sqrts**2
	ee = sqrt ([xcb(1)/xcb(2), xcb(2)/xcb(1)])
	che = sum (ee) / 2
	xb0 = sqrt (xcb(1) * xcb(2))
	cphi = cos (phi(1) - phi(2))

	rho_old = 10
	rho = 1
	th = 0
	sin_th = sin (th)
	cos_th = cos (th)
	lambda = lambda_factor (sin_th, cos_th, cphi)
	call scaled_x (rho, ee, xb0, x, xb)

	iterate_loop: do i = 1, n_it_max

	call polar_angles (s, xb0, rho, ee, q2, sin_th, cos_th, ok)
	if (.not. ok) return
	th = atan2 (sin_th, cos_th)

	lambda = lambda_factor (sin_th, cos_th, cphi)
	rho_new = scale_factor (che, lambda, xb0)
	call scaled_x (rho_new, ee, xb0, x, xb)

	dr_old = abs (rho - rho_old)
	dr_new = abs (rho_new - rho)

	rho_old = rho
	rho = rho_new

	if (dr_new < dr_limit .or. dr_new >= dr_old) exit iterate_loop

	end do iterate_loop

	end subroutine solve_recoil

	@ %def solve_recoil
	@
	With all kinematics parameters known, construct actual four-vectors
	for the recoil momenta, the off-shell (spacelike) parton momenta, and
	on-shell projected parton momenta.
	<<Recoil kinematics: public>>=
	public :: recoil_momenta
	<<Recoil kinematics: sub interfaces>>=
	module subroutine recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, mo, &
	km, qm, qo, ok)
	real(default), intent(in) :: sqrts
	real(default), dimension(2), intent(in) :: xc
	real(default), dimension(2), intent(in) :: xb
	real(default), dimension(2), intent(in) :: cos_th
	real(default), dimension(2), intent(in) :: sin_th
	real(default), dimension(2), intent(in) :: phi
	real(default), dimension(2), intent(in) :: mo
	type(vector4_t), dimension(2), intent(out) :: km
	type(vector4_t), dimension(2), intent(out) :: qm
	type(vector4_t), dimension(2), intent(out) :: qo
	logical, intent(out) :: ok
	end subroutine recoil_momenta
	<<Recoil kinematics: procedures>>=
	module subroutine recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, mo, &
	km, qm, qo, ok)
	real(default), intent(in) :: sqrts
	real(default), dimension(2), intent(in) :: xc
	real(default), dimension(2), intent(in) :: xb
	real(default), dimension(2), intent(in) :: cos_th
	real(default), dimension(2), intent(in) :: sin_th
	real(default), dimension(2), intent(in) :: phi
	real(default), dimension(2), intent(in) :: mo
	type(vector4_t), dimension(2), intent(out) :: km
	type(vector4_t), dimension(2), intent(out) :: qm
	type(vector4_t), dimension(2), intent(out) :: qo
	logical, intent(out) :: ok

	type(vector4_t), dimension(2) :: pm
	type(lorentz_transformation_t) :: lt
	real(default) :: sqsh
	real(default) :: po4, po2
	real(default), dimension(2) :: p0, p3

	pm(1) = &
	vector4_moving (sqrts/2, &
	vector3_moving ([0._default, 0._default, sqrts/2]))
	pm(2) = &
	vector4_moving (sqrts/2, &
	vector3_moving ([0._default, 0._default,-sqrts/2]))

	km(1) = xb(1) * (sqrts/2) * vector4_moving ( &
	1._default, &
	vector3_moving ([ &
	& sin_th(1) * cos (phi(1)), &
	& sin_th(1) * sin (phi(1)), &
	& cos_th(1)]) &
	)
	km(2) = xb(2) * (sqrts/2) * vector4_moving ( &
	1._default, &
	vector3_moving ([ &
	& -sin_th(2) * cos (phi(2)), &
	& -sin_th(2) * sin (phi(2)), &
	& -cos_th(2)]) &
	)

	qm(1) = pm(1) - km(1)
	qm(2) = pm(2) - km(2)

	sqsh = sqrt (xc(1)xc(2)) sqrts
	lt = transformation (3, qm(1), qm(2), sqsh)

	po4 = lambda (sqsh2, mo(1)2, mo(2)**2)
	ok = po4 > 0
	if (ok) then
	po2 = sqrt (po4)/4
	p0 = sqrt (po2 + mo**2)
	p3 = [sqrt (po2), -sqrt (po2)]
	qo = lt * vector4_moving (p0, p3, 3)
	else
	qo = vector4_null
	end if

	end subroutine recoil_momenta

	@ %def recoil_momenta
	@
	Compute the Lorentz transformation that we can use to transform any
	outgoing momenta into the new c.m.\ system of the incoming partons.
	Not relying on the previous calculations, we determine the
	transformation that transforms the original collinear partons into
	their c.m.\ system, and then transform this to the new c.m.\ system.
	<<Recoil kinematics: public>>=
	public :: recoil_transformation
	<<Recoil kinematics: sub interfaces>>=
	module subroutine recoil_transformation (sqrts, xc, qo, lt)
	real(default), intent(in) :: sqrts
	real(default), dimension(2), intent(in) :: xc
	type(vector4_t), dimension(2), intent(in) :: qo
	type(lorentz_transformation_t), intent(out) :: lt
	end subroutine recoil_transformation
	<<Recoil kinematics: procedures>>=
	module subroutine recoil_transformation (sqrts, xc, qo, lt)
	real(default), intent(in) :: sqrts
	real(default), dimension(2), intent(in) :: xc
	type(vector4_t), dimension(2), intent(in) :: qo
	type(lorentz_transformation_t), intent(out) :: lt

	real(default) :: sqsh
	type(vector4_t), dimension(2) :: qc
	type(lorentz_transformation_t) :: ltc, lto

	qc(1) = xc(1) * vector4_moving (sqrts/2, sqrts/2, 3)
	qc(2) = xc(2) * vector4_moving (sqrts/2,-sqrts/2, 3)

	sqsh = sqrt (xc(1) * xc(2)) * sqrts
	ltc = transformation (3, qc(1), qc(2), sqsh)
	lto = transformation (3, qo(1), qo(2), sqsh)
	lt = lto * inverse (ltc)

	end subroutine recoil_transformation

	@ %def recoil_transformation
	@
	Compute the Lorentz boost that transforms the c.m.\ frame of the
	momenta into the lab frame where they are given. Also return their
	common invariant mass, $\sqrt{s}$.

	If the initial momenta are not collinear, [[ok]] is set false.
	<<Recoil kinematics: public>>=
	public :: initial_transformation
	<<Recoil kinematics: sub interfaces>>=
	module subroutine initial_transformation (p, sqrts, lt, ok)
	type(vector4_t), dimension(2), intent(in) :: p
	real(default), intent(out) :: sqrts
	type(lorentz_transformation_t), intent(out) :: lt
	logical, intent(out) :: ok
	end subroutine initial_transformation
	<<Recoil kinematics: procedures>>=
	module subroutine initial_transformation (p, sqrts, lt, ok)
	type(vector4_t), dimension(2), intent(in) :: p
	real(default), intent(out) :: sqrts
	type(lorentz_transformation_t), intent(out) :: lt
	logical, intent(out) :: ok

	ok = all (transverse_part (p) == 0)

	sqrts = (p(1) + p(2)) ** 1
	lt = boost (p(1) + p(2), sqrts)

	end subroutine initial_transformation

	@ %def initial_transformation
	@
	\subsection{Generate recoil event}
	Combine the above kinematics calculations. First generate azimuthal
	angles and momentum transfer, solve kinematics and compute momenta for
	the radiated photons and the on-shell projected, recoiling partons.

	The [[mo]] masses are used for the on-shell projection of the partons after
	radiation. They may be equal to [[m]], or set to zero.

	If [[ok]] is false, the data point has failed and we should repeat the
	procedure for a new set of RNG parameters [[r]].
	<<Recoil kinematics: public>>=
	public :: generate_recoil
	<<Recoil kinematics: sub interfaces>>=
	module subroutine generate_recoil &
	(sqrts, q_max, m, mo, xc, xcb, r, km, qm, qo, ok)
	real(default), intent(in) :: sqrts
	real(default), intent(in), dimension(2) :: q_max
	real(default), intent(in), dimension(2) :: m
	real(default), intent(in), dimension(2) :: mo
	real(default), intent(in), dimension(2) :: xc
	real(default), intent(in), dimension(2) :: xcb
	real(default), intent(in), dimension(4) :: r
	type(vector4_t), dimension(2), intent(out) :: km
	type(vector4_t), dimension(2), intent(out) :: qm
	type(vector4_t), dimension(2), intent(out) :: qo
	logical, intent(out) :: ok
	end subroutine generate_recoil
	<<Recoil kinematics: procedures>>=
	module subroutine generate_recoil &
	(sqrts, q_max, m, mo, xc, xcb, r, km, qm, qo, ok)
	real(default), intent(in) :: sqrts
	real(default), intent(in), dimension(2) :: q_max
	real(default), intent(in), dimension(2) :: m
	real(default), intent(in), dimension(2) :: mo
	real(default), intent(in), dimension(2) :: xc
	real(default), intent(in), dimension(2) :: xcb
	real(default), intent(in), dimension(4) :: r
	type(vector4_t), dimension(2), intent(out) :: km
	type(vector4_t), dimension(2), intent(out) :: qm
	type(vector4_t), dimension(2), intent(out) :: qo
	logical, intent(out) :: ok

	real(default), dimension(2) :: q2
	real(default), dimension(2) :: phi
	real(default), dimension(2) :: x
	real(default), dimension(2) :: xb
	real(default), dimension(2) :: cos_th
	real(default), dimension(2) :: sin_th

	call generate_q2_recoil (sqrts2, xcb, q_max2, m**2, r(1:2), q2)
	call generate_phi_recoil (r(3:4), phi)

	call solve_recoil (sqrts, xc, xcb, phi, q2, x, xb, cos_th, sin_th, ok)
	if (ok) then
	call recoil_momenta &
	(sqrts, xc, xb, cos_th, sin_th, phi, mo, km, qm, qo, ok)
	end if

	end subroutine generate_recoil

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

	module recoil_kinematics_ut
	use unit_tests
	use recoil_kinematics_uti

	<<Standard module head>>

	<<Recoil kinematics: public test>>

	contains

	<<Recoil kinematics: test driver>>

	end module recoil_kinematics_ut
	@ %def recoil_kinematics_ut
	@
	<<[[recoil_kinematics_uti.f90]]>>=
	<<File header>>

	module recoil_kinematics_uti

	<<Use kinds>>
	use constants, only: twopi
	use constants, only: degree
	use lorentz, only: vector4_t
	use lorentz, only: vector4_moving
	use lorentz, only: lorentz_transformation_t
	use lorentz, only: inverse
	use lorentz, only: operator(+)
	use lorentz, only: operator(*)
	use lorentz, only: operator(**)
	use lorentz, only: pacify

	use recoil_kinematics, only: solve_recoil
	use recoil_kinematics, only: recoil_momenta
	use recoil_kinematics, only: recoil_transformation
	use recoil_kinematics, only: initial_transformation
	use recoil_kinematics, only: generate_q2_recoil
	use recoil_kinematics, only: generate_recoil

	<<Standard module head>>

	<<Recoil kinematics: test declarations>>

	contains

	<<Recoil kinematics: tests>>

	end module recoil_kinematics_uti

	@ %def recoil_kinematics_uti
	@ API: driver for the unit tests below.
	<<Recoil kinematics: public test>>=
	public :: recoil_kinematics_test
	<<Recoil kinematics: test driver>>=
	subroutine recoil_kinematics_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Recoil kinematics: execute tests>>
	end subroutine recoil_kinematics_test

	@ %def recoil_kinematics_test
	@
	\subsubsection{Recoil kinematics}
	For a set of input data, solve the kinematics constraints and generate
	momenta accordingly.
	<<Recoil kinematics: execute tests>>=
	call test (recoil_kinematics_1, "recoil_kinematics_1", &
	"iterative solution of non-collinear kinematics", &
	u, results)
	<<Recoil kinematics: test declarations>>=
	public :: recoil_kinematics_1
	<<Recoil kinematics: tests>>=
	subroutine recoil_kinematics_1 (u)
	integer, intent(in) :: u

	real(default) :: sqrts
	real(default), dimension(2) :: xc, xcb
	real(default), dimension(2) :: q
	real(default), dimension(2) :: phi
	real(default), dimension(2) :: mo
	real(default), dimension(2) :: cos_th, sin_th
	real(default), dimension(2) :: x
	real(default), dimension(2) :: xb
	type(vector4_t), dimension(2) :: km
	type(vector4_t), dimension(2) :: qm
	type(vector4_t), dimension(2) :: qo
	integer :: i
	logical :: ok

	character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
	character(*), parameter :: FMT2 = "(1x,A,9(1x,F10.5))"
	character(*), parameter :: FMT4 = "(3x,ES8.1,9(1x,ES19.12))"

	write (u, "(A)") "* Test output: recoil_kinematics_1"
	write (u, "(A)") "* Purpose: compute kinematics for various input data"
	write (u, "(A)")

	sqrts = 100
	write (u, FMT1) "sqrts =", sqrts

	write (u, "(A)")
	write (u, "(A)") "*** collinear data set"
	write (u, "(A)")

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.2_default] * twopi
	q = 0
	mo = 0

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call show_results

	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, mo, km, qm, qo, ok)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** moderate data set"
	write (u, "(A)")

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.2_default] * twopi
	q = [0.2_default, 0.05_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call show_results
	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, mo, km, qm, qo, ok)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** semi-soft data set"
	write (u, "(A)")

	xcb= [0.1_default, 0.0001_default]
	xc = 1 - xcb
	phi = [0.1_default, 0.2_default] * twopi
	q = [0.2_default, 0.00001_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call show_results

	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, mo, km, qm, qo, ok)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** hard-soft data set"
	write (u, "(A)")

	xcb= [0.1_default, 1.e-30_default]
	xc = 1 - xcb
	phi = [0.1_default, 0.2_default] * twopi
	q = [0.2_default, 1.e-35_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call show_results

	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, mo, km, qm, qo, ok)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** hard data set"
	write (u, "(A)")

	xc = [0.2_default, 0.4_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.8_default] * twopi
	q = [0.74_default, 0.3_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call show_results

	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, mo, km, qm, qo, ok)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** failing data set"
	write (u, "(A)")

	xc = [0.2_default, 0.4_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.8_default] * twopi
	q = [0.9_default, 0.3_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	if (.not. ok) then
	write (u, "(A)")
	write (u, "(A)") "Failed as expected."
	end if

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

	contains

	subroutine show_data
	write (u, FMT1) "sqs_h =", sqrt (xc(1) * xc(2)) * sqrts
	write (u, FMT1) "xc =", xc
	write (u, FMT1) "xcb =", xcb
	write (u, FMT1) "Q =", Q
	write (u, FMT1) "phi/D =", phi / degree
	end subroutine show_data

	subroutine show_results
	write (u, "(A)")
	write (u, "(A)") "Result:"
	write (u, FMT1) "th/D =", atan2 (sin_th, cos_th) / degree
	write (u, FMT1) "x =", x
	write (u, "(A)")
	end subroutine show_results

	subroutine show_momenta
	type(vector4_t) :: qm0, qo0
	real(default), parameter :: tol = 1.e-7_default
	call pacify (km, tol)
	call pacify (qm, tol)
	call pacify (qo, tol)
	write (u, "(A)") "Momenta: k"
	call km(1)%write (u, testflag=.true.)
	call km(2)%write (u, testflag=.true.)
	write (u, FMT1) "k^2 =", abs (km(1)2), abs (km(2)2)
	write (u, "(A)")
	write (u, "(A)") "Momenta: q"
	call qm(1)%write (u, testflag=.true.)
	call qm(2)%write (u, testflag=.true.)
	write (u, "(A)")
	write (u, "(A)") "Momenta: q(os)"
	call qo(1)%write (u, testflag=.true.)
	call qo(2)%write (u, testflag=.true.)
	write (u, "(A)")
	write (u, "(A)") "Check: parton momentum sum: q vs q(os)"
	qm0 = qm(1) + qm(2)
	call qm0%write (u, testflag=.true.)
	qo0 = qo(1) + qo(2)
	call qo0%write (u, testflag=.true.)
	write (u, "(A)")
	write (u, "(A)") "* Check: momentum transfer (off-shell/on-shell)"
	write (u, FMT2) "\|q\| =", abs (qm(1)1), abs (qm(2)1)
	write (u, FMT2) "Q =", q
	write (u, FMT2) "\|qo\|=", abs (qo(1)1), abs (qo(2)1)
	write (u, "(A)")
	write (u, "(A)") "* Check: sqrts, sqrts_hat"
	write (u, FMT1) "\|p\| =", (km(1)+km(2)+qm(1)+qm(2))1, (qm(1)+qm(2))1
	write (u, FMT1) "sqs =", sqrts, sqrt (product (xc)) * sqrts
	write (u, FMT1) "\|po\|=", abs ((km(1)+km(2)+qo(1)+qo(2))1), abs ((qo(1)+qo(2))1)
	end subroutine show_momenta

	end subroutine recoil_kinematics_1

	@ %def recoil_kinematics_1
	@
	\subsubsection{Recoil $Q$ distribution}
	Sample the $Q$ distribution for equidistant bins in the input variable.
	<<Recoil kinematics: execute tests>>=
	call test (recoil_kinematics_2, "recoil_kinematics_2", &
	"Q distribution", &
	u, results)
	<<Recoil kinematics: test declarations>>=
	public :: recoil_kinematics_2
	<<Recoil kinematics: tests>>=
	subroutine recoil_kinematics_2 (u)
	integer, intent(in) :: u

	real(default) :: sqrts
	real(default) :: q_max
	real(default) :: m
	real(default) :: x_bar
	real(default) :: r
	real(default) :: q2, q2_old
	integer :: i
	integer :: n_bin

	character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
	character(*), parameter :: FMT3 = "(2x,9(1x,F10.5))"

	write (u, "(A)") "* Test output: recoil_kinematics_2"
	write (u, "(A)") "* Purpose: compute Q distribution"
	write (u, "(A)")

	n_bin = 20

	write (u, "(A)") "* No Q cutoff, xbar = 1"
	write (u, "(A)")

	sqrts = 100
	q_max = sqrts
	m = 0.511e-3_default
	x_bar = 1._default
	call show_table

	write (u, "(A)")
	write (u, "(A)") "* With Q cutoff, xbar = 1"
	write (u, "(A)")

	q_max = 10
	call show_table

	write (u, "(A)")
	write (u, "(A)") "* No Q cutoff, xbar = 0.01"
	write (u, "(A)")

	q_max = sqrts
	x_bar = 0.01_default
	call show_table

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

	contains

	subroutine show_table
	write (u, FMT1) "sqrts =", sqrts
	write (u, FMT1) "q_max =", q_max
	write (u, FMT1) "m =", m
	write (u, FMT1) "x_bar =", x_bar
	write (u, "(A)")
	write (u, "(1x,A)") "Table: r \|Q\| \|Q_i/Q_(i-1)\|"
	q2_old = 0
	do i = 0, n_bin
	r = real (i, default) / n_bin
	call generate_q2_recoil (sqrts2, x_bar, q_max2, m**2, r, q2)
	if (q2_old > 0) then
	write (u, FMT3) r, sqrt (q2), sqrt (q2 / q2_old)
	else
	write (u, FMT3) r, sqrt (q2)
	end if
	q2_old = q2
	end do
	end subroutine show_table

	end subroutine recoil_kinematics_2

	@ %def recoil_kinematics_2
	@
	\subsubsection{Generate recoil event}
	Combine $Q^2$ sampling with momentum generation.
	<<Recoil kinematics: execute tests>>=
	call test (recoil_kinematics_3, "recoil_kinematics_3", &
	"generate recoil event", &
	u, results)
	<<Recoil kinematics: test declarations>>=
	public :: recoil_kinematics_3
	<<Recoil kinematics: tests>>=
	subroutine recoil_kinematics_3 (u)
	integer, intent(in) :: u

	real(default) :: sqrts
	real(default), dimension(2) :: q_max
	real(default), dimension(2) :: m, mo
	real(default), dimension(2) :: xc, xcb
	real(default), dimension(4) :: r
	type(vector4_t), dimension(2) :: km
	type(vector4_t), dimension(2) :: qm
	type(vector4_t), dimension(2) :: qo
	logical :: ok

	character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
	character(*), parameter :: FMT2 = "(1x,A,9(1x,F10.5))"

	write (u, "(A)") "* Test output: recoil_kinematics_3"
	write (u, "(A)") "* Purpose: generate momenta from RNG parameters"
	write (u, "(A)")

	write (u, "(A)") "*** collinear data set"
	write (u, "(A)")

	sqrts = 100
	q_max = sqrts
	m = 0.511e-3_default
	mo = 0

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc

	r = [0._default, 0._default, 0._default, 0._default]

	call show_data
	call generate_recoil (sqrts, q_max, m, mo, xc, xcb, r, km, qm, qo, ok)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** moderate data set"
	write (u, "(A)")

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc

	r = [0.8_default, 0.2_default, 0.1_default, 0.2_default]

	call show_data
	call generate_recoil (sqrts, q_max, m, mo, xc, xcb, r, km, qm, qo, ok)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** failing data set"
	write (u, "(A)")

	xc = [0.2_default, 0.4_default]
	xcb = 1 - xc

	r = [0.9999_default, 0.3_default, 0.1_default, 0.8_default]

	call show_data
	call generate_recoil (sqrts, q_max, m, mo, xc, xcb, r, km, qm, qo, ok)
	if (.not. ok) then
	write (u, "(A)")
	write (u, "(A)") "Failed as expected."
	else
	call show_momenta
	end if

	contains

	subroutine show_data
	write (u, FMT1) "sqrts =", sqrts
	write (u, FMT1) "q_max =", q_max
	write (u, FMT1) "m =", m
	write (u, FMT1) "xc =", xc
	write (u, FMT1) "xcb =", xcb
	write (u, FMT1) "r =", r
	end subroutine show_data

	subroutine show_momenta
	real(default), parameter :: tol = 1.e-7_default
	call pacify (km, tol)
	call pacify (qo, tol)
	write (u, "(A)")
	write (u, "(A)") "* Momenta: k"
	call km(1)%write (u, testflag=.true.)
	call km(2)%write (u, testflag=.true.)
	write (u, FMT1) "k^2 =", abs (km(1)2), abs (km(2)2)
	write (u, "(A)")
	write (u, "(A)") "* Momenta: q(os)"
	call qo(1)%write (u, testflag=.true.)
	call qo(2)%write (u, testflag=.true.)
	write (u, FMT1) "q^2 =", abs (qo(1)2), abs (qo(2)2)
	write (u, "(A)")
	write (u, "(A)") "* Check: momentum transfer (off-shell/on-shell)"
	write (u, FMT2) "Q =", q_check (1), q_check (2)
	write (u, FMT2) "\|q\| =", abs (qm(1)1), abs (qm(2)1)
	write (u, "(A)")
	write (u, "(A)") "* Check: sqrts, sqrts_hat"
	write (u, FMT1) "sqs =", sqrts, sqrt (product (xc)) * sqrts
	write (u, FMT1) "\|po\|=", abs ((km(1)+km(2)+qo(1)+qo(2))1), abs ((qo(1)+qo(2))1)
	end subroutine show_momenta

	function q_check (i) result (q)
	integer, intent(in) :: i
	real(default) :: q
	real(default) :: q2
	call generate_q2_recoil (sqrts2, xcb(i), q_max(i)2, m(i)**2, r(i), q2)
	q = sqrt (q2)
	end function q_check

	end subroutine recoil_kinematics_3

	@ %def recoil_kinematics_3
	@
	\subsubsection{Transformation after recoil}
	Given a solution to recoil kinematics, compute the Lorentz
	transformation that transforms the old collinear parton momenta into
	the new parton momenta.
	<<Recoil kinematics: execute tests>>=
	call test (recoil_kinematics_4, "recoil_kinematics_4", &
	"reference frame", &
	u, results)
	<<Recoil kinematics: test declarations>>=
	public :: recoil_kinematics_4
	<<Recoil kinematics: tests>>=
	subroutine recoil_kinematics_4 (u)
	integer, intent(in) :: u

	real(default) :: sqrts
	real(default), dimension(2) :: xc, xcb
	real(default), dimension(2) :: q
	real(default), dimension(2) :: phi
	real(default), dimension(2) :: cos_th, sin_th
	real(default), dimension(2) :: mo
	real(default), dimension(2) :: x
	real(default), dimension(2) :: xb
	type(vector4_t), dimension(2) :: km
	type(vector4_t), dimension(2) :: qm
	type(vector4_t), dimension(2) :: qo
	type(lorentz_transformation_t) :: lt
	logical :: ok

	character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
	character(*), parameter :: FMT2 = "(1x,A,9(1x,F10.5))"

	write (u, "(A)") "* Test output: recoil_kinematics_4"
	write (u, "(A)") "* Purpose: check Lorentz transformation for recoil"
	write (u, "(A)")

	sqrts = 100
	write (u, FMT1) "sqrts =", sqrts

	write (u, "(A)")
	write (u, "(A)") "*** collinear data set"
	write (u, "(A)")

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.2_default] * twopi
	q = 0
	mo = 0

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, mo, km, qm, qo, ok)
	call recoil_transformation (sqrts, xc, qo, lt)
	call show_transformation

	write (u, "(A)")
	write (u, "(A)") "*** moderate data set"
	write (u, "(A)")

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.2_default] * twopi
	q = [0.2_default, 0.05_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, mo, km, qm, qo, ok)
	call recoil_transformation (sqrts, xc, qo, lt)
	call show_transformation

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

	contains

	subroutine show_data
	write (u, FMT1) "sqs_h =", sqrt (xc(1) * xc(2)) * sqrts
	write (u, FMT1) "xc =", xc
	write (u, FMT1) "xcb =", xcb
	write (u, FMT1) "Q =", Q
	write (u, FMT1) "phi/D =", phi / degree
	end subroutine show_data

	subroutine show_transformation
	type(vector4_t), dimension(2) :: qc
	type(vector4_t), dimension(2) :: qct
	real(default), parameter :: tol = 1.e-7_default
	qc(1) = xc(1) * vector4_moving (sqrts/2, sqrts/2, 3)
	qc(2) = xc(2) * vector4_moving (sqrts/2,-sqrts/2, 3)
	qct = lt * qc
	call pacify (qct, tol)
	write (u, "(A)")
	write (u, "(A)") "Momenta: q(os)"
	call qo(1)%write (u, testflag=.true.)
	call qo(2)%write (u, testflag=.true.)
	write (u, "(A)")
	write (u, "(A)") "Momenta: LT * qc"
	call qct(1)%write (u, testflag=.true.)
	call qct(2)%write (u, testflag=.true.)
	end subroutine show_transformation

	end subroutine recoil_kinematics_4

	@ %def recoil_kinematics_4
	@
	\subsubsection{Transformation before recoil}
	Given a pair of incoming `beam' partons (i.e., before ISR splitting),
	compute the transformation that transforms their common c.m.\ frame
	into the lab frame.
	<<Recoil kinematics: execute tests>>=
	call test (recoil_kinematics_5, "recoil_kinematics_5", &
	"initial reference frame", &
	u, results)
	<<Recoil kinematics: test declarations>>=
	public :: recoil_kinematics_5
	<<Recoil kinematics: tests>>=
	subroutine recoil_kinematics_5 (u)
	integer, intent(in) :: u

	real(default) :: sqrts
	real(default) :: sqrtsi
	real(default), dimension(2) :: x
	type(vector4_t), dimension(2) :: p
	type(vector4_t), dimension(2) :: pi
	type(vector4_t), dimension(2) :: p0
	type(lorentz_transformation_t) :: lt
	logical :: ok

	character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
	character(*), parameter :: FMT2 = "(1x,A,9(1x,F10.5))"

	write (u, "(A)") "* Test output: recoil_kinematics_5"
	write (u, "(A)") "* Purpose: determine initial Lorentz transformation"
	write (u, "(A)")

	sqrts = 100
	write (u, FMT1) "sqrts =", sqrts

	x = [0.6_default, 0.9_default]

	p(1) = x(1) * vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = x(2) * vector4_moving (sqrts/2,-sqrts/2, 3)

	call show_data
	call initial_transformation (p, sqrtsi, lt, ok)

	pi(1) = vector4_moving (sqrtsi/2, sqrtsi/2, 3)
	pi(2) = vector4_moving (sqrtsi/2,-sqrtsi/2, 3)

	p0 = inverse (lt) * p

	call show_momenta

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

	contains

	subroutine show_data
	write (u, FMT1) "sqrts =", sqrts
	write (u, FMT1) "x =", x
	end subroutine show_data


	subroutine show_momenta
	real(default), parameter :: tol = 1.e-7_default
	write (u, "(A)")
	write (u, "(A)") "* Momenta: p_in(c.m.)"
	call pi(1)%write (u, testflag=.true.)
	call pi(2)%write (u, testflag=.true.)
	write (u, "(A)")
	write (u, "(A)") "* Momenta: inv(LT) * p_in(lab)"
	call p0(1)%write (u, testflag=.true.)
	call p0(2)%write (u, testflag=.true.)
	end subroutine show_momenta

	end subroutine recoil_kinematics_5

	@ %def recoil_kinematics_5
	@
	\subsubsection{Transformation after recoil with on-shell momenta}
	Given a solution to recoil kinematics, compute the Lorentz
	transformation that transforms the old collinear parton momenta into
	the new parton momenta.

	Compare the results for massless and massive on-shell projection.
	<<Recoil kinematics: execute tests>>=
	call test (recoil_kinematics_6, "recoil_kinematics_6", &
	"massless/massive on-shell projection", &
	u, results)
	<<Recoil kinematics: test declarations>>=
	public :: recoil_kinematics_6
	<<Recoil kinematics: tests>>=
	subroutine recoil_kinematics_6 (u)
	integer, intent(in) :: u

	real(default) :: sqrts
	real(default), dimension(2) :: xc, xcb
	real(default), dimension(2) :: q
	real(default), dimension(2) :: phi
	real(default), dimension(2) :: cos_th, sin_th
	real(default), dimension(2) :: x
	real(default), dimension(2) :: xb
	real(default), dimension(2) :: mo, z
	type(vector4_t), dimension(2) :: km
	type(vector4_t), dimension(2) :: qm
	type(vector4_t), dimension(2) :: qo
	type(lorentz_transformation_t) :: lt
	logical :: ok

	character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
	character(*), parameter :: FMT2 = "(1x,A,9(1x,F11.6))"

	write (u, "(A)") "* Test output: recoil_kinematics_6"
	write (u, "(A)") "* Purpose: check effect of mass in on-shell projection"
	write (u, "(A)")

	sqrts = 10
	write (u, FMT1) "sqrts =", sqrts
	z = 0
	mo = 0.511e-3
	write (u, FMT1) "mass =", mo

	write (u, "(A)")
	write (u, "(A)") "*** collinear data set"
	write (u, "(A)")

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.2_default] * twopi
	q = 0

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, z, km, qm, qo, ok)
	call recoil_transformation (sqrts, xc, qo, lt)
	write (u, "(A)")
	write (u, "(A)") "Massless projection:"
	call show_momenta

	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, mo, km, qm, qo, ok)
	call recoil_transformation (sqrts, xc, qo, lt)
	write (u, "(A)")
	write (u, "(A)") "Massive projection:"
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** moderate data set"
	write (u, "(A)")

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.2_default] * twopi
	q = [0.2_default, 0.05_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, z, km, qm, qo, ok)
	call recoil_transformation (sqrts, xc, qo, lt)
	write (u, "(A)")
	write (u, "(A)") "Massless projection:"
	call show_momenta

	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, mo, km, qm, qo, ok)
	call recoil_transformation (sqrts, xc, qo, lt)
	write (u, "(A)")
	write (u, "(A)") "Massive projection:"
	call show_momenta

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

	contains

	subroutine show_data
	write (u, FMT1) "sqs_h =", sqrt (xc(1) * xc(2)) * sqrts
	write (u, FMT1) "xc =", xc
	write (u, FMT1) "xcb =", xcb
	write (u, FMT1) "Q =", Q
	write (u, FMT1) "phi/D =", phi / degree
	end subroutine show_data

	subroutine show_momenta
	write (u, "(A)") "Momenta: q(os)"
	call qo(1)%write (u, testflag=.true.)
	write (u, FMT2) "m = ", abs (qo(1)**1)
	call qo(2)%write (u, testflag=.true.)
	write (u, FMT2) "m = ", abs (qo(2)**1)
	end subroutine show_momenta

	end subroutine recoil_kinematics_6

	@ %def recoil_kinematics_6
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Transverse momentum for the ISR and EPA approximations}

	The ISR and EPA handler takes an event with a single radiated collinear
	particle (photon for ISR, beam particle for EPA) for each beam, respectively,
	and inserts transverse momentum for both. The four-particle kinematics allows
	us to generate $Q^2$ and azimuthal angles independently, without violating
	energy-momentum conservation. The $Q^2$ distribution is logarithmic, as
	required by the effective particle approximation, and reflected in the
	inclusive ISR/EPA structure functions. We also conserve the invariant mass of
	the partonic systm after radiation. The total transverse-momentum kick is
	applied in form of a Lorentz transformation to the elementary process, both
	in- and out-particles. In fact, the incoming partons (beam particle for ISR,
	photon for EPA) which would be virtual space-like in the exact kinematics
	configuration, are replaced by on-shell incoming partons, such that energy,
	momentum, and invariant mass $\sqrt{\hat s}$ are conserved.

	Regarding kinematics, we treat all particles as massless. The beam-particle
	mass only appears as the parameter [[isr_mass]] or [[epa_mass]], respectively,
	and cuts off the logarithmic distribution. The upper cutoff is [[isr_q_max]]
	([[epa_q_max]]), which defaults to the available energy $\sqrt{s}$.

	The only differences between ISR and EPA, in this context, are the particle
	types, and an extra $\bar x$ factor in the lower cutoff for EPA, see below.
	<<[[isr_epa_handler.f90]]>>=
	<<File header>>

	module isr_epa_handler

	<<Use kinds>>
	<<Use strings>>
	use lorentz, only: vector4_t
	use lorentz, only: energy
	use lorentz, only: lorentz_transformation_t
	use lorentz, only: identity
	use lorentz, only: inverse
	use lorentz, only: operator(*)
	use flavors, only: flavor_t
	use particles, only: particle_t
	use rng_base, only: rng_t
	use event_transforms

	<<Standard module head>>

	<<ISR/EPA handler: public>>

	<<ISR/EPA handler: parameters>>

	<<ISR/EPA handler: types>>

	interface
	<<ISR/EPA handler: sub interfaces>>
	end interface

	end module isr_epa_handler
	@ %def isr_epa_handler
	@
	<<[[isr_epa_handler_sub.f90]]>>=
	<<File header>>

	submodule (isr_epa_handler) isr_epa_handler_s

	use diagnostics, only: msg_fatal
	use diagnostics, only: msg_bug
	use io_units
	use format_defs, only: FMT_12, FMT_19
	use format_utils, only: write_separator
	use format_utils, only: pac_fmt
	use physics_defs, only: PHOTON
	use recoil_kinematics, only: initial_transformation
	use recoil_kinematics, only: generate_recoil
	use recoil_kinematics, only: recoil_transformation

	implicit none

	contains

	<<ISR/EPA handler: procedures>>

	end submodule isr_epa_handler_s

	@ %def isr_epa_handler_s
	@
	\subsection{Event transform type}
	Convention: [[beam]] are the incoming partons before ISR -- not
	necessarily the actual beams, need not be in c.m.\ frame. [[radiated]]
	are the radiated particles (photon for ISR), and [[parton]] are the
	remainders which
	initiate the elementary process. These particles are copied verbatim
	from the event record, and must be collinear.

	The kinematical parameters are [[sqrts]] = invariant mass of the
	[[beam]] particles, [[q_max]] and [[m]] determining the $Q^2$
	distribution, and [[xc]]/[[xcb]] as the energy fraction (complement)
	of the partons, relative to the beams.

	Transformations: [[lti]] is the Lorentz transformation that would
	boosts [[pi]] (c.m. frame) back to the original [[beam]] momenta (lab
	frame). [[lto]] is the recoil transformation, transforming the partons
	after ISR from the collinear frame to the recoiling frame. [[lt]] is
	the combination of both, which is to be applied to all particles after
	the hard interaction.

	Momenta: [[pi]] are the beams transformed to their common c.m.\ frame.
	[[ki]] and [[qi]] are the photon/parton
	momenta in the [[pi]] c.m.\ frame. [[km]] and [[qm]] are the
	photon/parton momenta with the $Q$ distribution applied, and finally
	[[qo]] are the partons [[qm]] projected on-shell.
	<<ISR/EPA handler: public>>=
	public :: evt_isr_epa_t
	<<ISR/EPA handler: types>>=
	type, extends (evt_t) :: evt_isr_epa_t
	private
	integer :: mode = ISR_TRIVIAL_COLLINEAR
	logical :: isr_active = .false.
	logical :: epa_active = .false.
	real(default) :: isr_q_max = 0
	real(default) :: epa_q_max = 0
	real(default) :: isr_mass = 0
	real(default) :: epa_mass = 0
	logical :: isr_keep_mass = .true.
	real(default) :: sqrts = 0
	integer, dimension(2) :: rad_mode = BEAM_RAD_NONE
	real(default), dimension(2) :: q_max = 0
	real(default), dimension(2) :: m = 0
	real(default), dimension(2) :: xc = 0
	real(default), dimension(2) :: xcb = 0
	type(lorentz_transformation_t) :: lti = identity
	type(lorentz_transformation_t) :: lto = identity
	type(lorentz_transformation_t) :: lt = identity
	integer, dimension(2) :: i_beam = 0
	type(particle_t), dimension(2) :: beam
	type(vector4_t), dimension(2) :: pi
	integer, dimension(2) :: i_radiated = 0
	type(particle_t), dimension(2) :: radiated
	type(vector4_t), dimension(2) :: ki
	type(vector4_t), dimension(2) :: km
	integer, dimension(2) :: i_parton = 0
	type(particle_t), dimension(2) :: parton
	type(vector4_t), dimension(2) :: qi
	type(vector4_t), dimension(2) :: qm
	type(vector4_t), dimension(2) :: qo
	contains
	<<ISR/EPA handler: evt isr: TBP>>
	end type evt_isr_epa_t

	@ %def evt_isr_epa_t
	@
	\subsection{ISR/EPA distinction}
	<<ISR/EPA handler: parameters>>=
	integer, parameter, public :: BEAM_RAD_NONE = 0
	integer, parameter, public :: BEAM_RAD_ISR = 1
	integer, parameter, public :: BEAM_RAD_EPA = 2

	@ %def BEAM_RAD_NONE
	@ %def BEAM_RAD_ISR
	@ %def BEAM_RAD_EPA
	<<ISR/EPA handler: procedures>>=
	function rad_mode_string (mode) result (string)
	type(string_t) :: string
	integer, intent(in) :: mode
	select case (mode)
	case (BEAM_RAD_NONE); string = "---"
	case (BEAM_RAD_ISR); string = "ISR"
	case (BEAM_RAD_EPA); string = "EPA"
	case default; string = "???"
	end select
	end function rad_mode_string

	@ %def rad_mode_string
	@
	\subsection{Photon insertion modes}
	<<ISR/EPA handler: parameters>>=
	integer, parameter, public :: ISR_TRIVIAL_COLLINEAR = 0
	integer, parameter, public :: ISR_PAIR_RECOIL = 1

	@ %def ISR_TRIVIAL_COLLINEAR ISR_PAIR_RECOIL
	@
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: get_mode_string => evt_isr_epa_get_mode_string
	<<ISR/EPA handler: sub interfaces>>=
	module function evt_isr_epa_get_mode_string (evt) result (string)
	type(string_t) :: string
	class(evt_isr_epa_t), intent(in) :: evt
	end function evt_isr_epa_get_mode_string
	<<ISR/EPA handler: procedures>>=
	module function evt_isr_epa_get_mode_string (evt) result (string)
	type(string_t) :: string
	class(evt_isr_epa_t), intent(in) :: evt
	select case (evt%mode)
	case (ISR_TRIVIAL_COLLINEAR)
	string = "trivial, collinear"
	case (ISR_PAIR_RECOIL)
	string = "pair recoil"
	case default
	string = "[undefined]"
	end select
	end function evt_isr_epa_get_mode_string

	@ %def evt_isr_epa_get_mode_string
	@ Set the numerical mode ID from a user-level string representation.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: set_mode_string => evt_isr_epa_set_mode_string
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_set_mode_string (evt, string)
	class(evt_isr_epa_t), intent(inout) :: evt
	type(string_t), intent(in) :: string
	end subroutine evt_isr_epa_set_mode_string
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_set_mode_string (evt, string)
	class(evt_isr_epa_t), intent(inout) :: evt
	type(string_t), intent(in) :: string
	select case (char (string))
	case ("trivial")
	evt%mode = ISR_TRIVIAL_COLLINEAR
	case ("recoil")
	evt%mode = ISR_PAIR_RECOIL
	case default
	call msg_fatal ("ISR handler: mode '" // char (string) &
	// "' is undefined")
	end select
	end subroutine evt_isr_epa_set_mode_string

	@ %def evt_isr_epa_set_mode_string
	@
	\subsection{Output}
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: write_name => evt_isr_epa_write_name
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_write_name (evt, unit)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	end subroutine evt_isr_epa_write_name
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_write_name (evt, unit)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: ISR/EPA handler"
	end subroutine evt_isr_epa_write_name

	@ %def evt_isr_epa_write_name
	@ The overall recoil-handling mode.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: write_mode => evt_isr_epa_write_mode
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_write_mode (evt, unit)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	end subroutine evt_isr_epa_write_mode
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_write_mode (evt, unit)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A,1x,I0,':',1x,A)") "Insertion mode =", evt%mode, &
	char (evt%get_mode_string ())
	end subroutine evt_isr_epa_write_mode

	@ %def evt_isr_epa_write_mode
	@ The input data for ISR and EPA, respectively.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: write_input => evt_isr_epa_write_input
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_write_input (evt, unit, testflag)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine evt_isr_epa_write_input
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_write_input (evt, unit, testflag)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	character(len=7) :: fmt
	integer :: u
	u = given_output_unit (unit)
	call pac_fmt (fmt, FMT_19, FMT_12, testflag)
	if (evt%isr_active) then
	write (u, "(3x,A,1x," // fmt // ")") "ISR: Q_max =", evt%isr_q_max
	write (u, "(3x,A,1x," // fmt // ")") " m =", evt%isr_mass
	write (u, "(3x,A,1x,L1)") " keep m=", evt%isr_keep_mass
	else
	write (u, "(3x,A)") "ISR: [inactive]"
	end if
	if (evt%epa_active) then
	write (u, "(3x,A,1x," // fmt // ")") "EPA: Q_max =", evt%epa_q_max
	write (u, "(3x,A,1x," // fmt // ")") " m =", evt%epa_mass
	else
	write (u, "(3x,A)") "EPA: [inactive]"
	end if
	end subroutine evt_isr_epa_write_input

	@ %def evt_isr_epa_write_input
	@ The trivial mode does not depend on any data, since it does nothing
	to the event.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: write_data => evt_isr_epa_write_data
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_write_data (evt, unit, testflag)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine evt_isr_epa_write_data
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_write_data (evt, unit, testflag)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	character(len=7), parameter :: FMTL_19 = "A3,16x"
	character(len=7), parameter :: FMTL_12 = "A3,9x"
	character(len=7) :: fmt, fmtl
	integer :: u
	u = given_output_unit (unit)
	call pac_fmt (fmt, FMT_19, FMT_12, testflag)
	call pac_fmt (fmtl, FMTL_19, FMTL_12, testflag)
	select case (evt%mode)
	case (ISR_PAIR_RECOIL)
	write (u, "(1x,A)") "Event:"
	write (u, "(3x,A,2(1x," // fmtl // "))") &
	"mode = ", &
	char (rad_mode_string (evt%rad_mode(1))), &
	char (rad_mode_string (evt%rad_mode(2)))
	write (u, "(3x,A,2(1x," // fmt // "))") "Q_max =", evt%q_max
	write (u, "(3x,A,2(1x," // fmt // "))") "m =", evt%m
	write (u, "(3x,A,2(1x," // fmt // "))") "x =", evt%xc
	write (u, "(3x,A,2(1x," // fmt // "))") "xb =", evt%xcb
	write (u, "(3x,A,1x," // fmt // ")") "sqrts =", evt%sqrts
	call write_separator (u)
	write (u, "(A)") "Lorentz boost (partons before radiation &
	&c.m. -> lab) ="
	call evt%lti%write (u, testflag)
	write (u, "(A)") "Lorentz transformation (collinear partons &
	&-> partons with recoil in c.m.) ="
	call evt%lto%write (u, testflag)
	write (u, "(A)") "Combined transformation (partons &
	&-> partons with recoil in lab frame) ="
	call evt%lt%write (u, testflag)
	end select
	end subroutine evt_isr_epa_write_data

	@ %def evt_isr_epa_write_data
	@ Output method.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: write => evt_isr_epa_write
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	end subroutine evt_isr_epa_write
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	logical :: show_mass
	integer :: u, i
	u = given_output_unit (unit)
	if (present (testflag)) then
	show_mass = .not. testflag
	else
	show_mass = .true.
	end if
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u, 2)
	call evt%write_mode (u)
	call evt%write_input (u, testflag=testflag)
	call evt%write_data (u, testflag=testflag)
	call write_separator (u)
	call evt%base_write (u, testflag = testflag, show_set = .false.)
	if (all (evt%i_beam > 0)) then
	call write_separator (u)
	write (u, "(A,2(1x,I0))") "Partons before radiation:", evt%i_beam
	do i = 1, 2
	call evt%beam(i)%write (u, testflag=testflag)
	end do
	call write_separator (u)
	write (u, "(A)") "... boosted to c.m.:"
	do i = 1, 2
	call evt%pi(i)%write (u, show_mass=show_mass, testflag=testflag)
	end do
	end if
	if (all (evt%i_radiated > 0)) then
	call write_separator (u)
	write (u, "(A,2(1x,I0))") "Radiated particles, collinear:", &
	evt%i_radiated
	do i = 1, 2
	call evt%radiated(i)%write (u, testflag=testflag)
	end do
	call write_separator (u)
	write (u, "(A)") "... boosted to c.m.:"
	do i = 1, 2
	call evt%ki(i)%write (u, show_mass=show_mass, testflag=testflag)
	end do
	call write_separator (u)
	write (u, "(A)") "... with kT:"
	do i = 1, 2
	call evt%km(i)%write (u, show_mass=show_mass, testflag=testflag)
	end do
	end if
	if (all (evt%i_parton > 0)) then
	call write_separator (u)
	write (u, "(A,2(1x,I0))") "Partons after radiation, collinear:", &
	evt%i_parton
	do i = 1, 2
	call evt%parton(i)%write (u, testflag=testflag)
	end do
	call write_separator (u)
	write (u, "(A)") "... boosted to c.m.:"
	do i = 1, 2
	call evt%qi(i)%write (u, show_mass=show_mass, testflag=testflag)
	end do
	call write_separator (u)
	write (u, "(A)") "... with qT, off-shell:"
	do i = 1, 2
	call evt%qm(i)%write (u, show_mass=show_mass, testflag=testflag)
	end do
	call write_separator (u)
	write (u, "(A)") "... projected on-shell:"
	do i = 1, 2
	call evt%qo(i)%write (u, show_mass=show_mass, testflag=testflag)
	end do
	call write_separator (u)
	end if
	if (evt%particle_set_exists) &
	call evt%particle_set%write &
	(u, summary = .true., compressed = .true., testflag = testflag)
	call write_separator (u)
	end subroutine evt_isr_epa_write

	@ %def evt_isr_epa_write
	@
	\subsection{Initialization}
	Manually import a random-number generator object. This should be
	done only for testing purposes. The standard procedure is to
	[[connect]] a process to an event transform; this will create an
	appropriate [[rng]] from the RNG factory in the process object.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: import_rng => evt_isr_epa_import_rng
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_import_rng (evt, rng)
	class(evt_isr_epa_t), intent(inout) :: evt
	class(rng_t), allocatable, intent(inout) :: rng
	end subroutine evt_isr_epa_import_rng
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_import_rng (evt, rng)
	class(evt_isr_epa_t), intent(inout) :: evt
	class(rng_t), allocatable, intent(inout) :: rng
	call move_alloc (from = rng, to = evt%rng)
	end subroutine evt_isr_epa_import_rng

	@ %def evt_isr_epa_import_rng
	@ Set constant kinematics limits and initialize for ISR. Note that [[sqrts]]
	is used only as the fallback value for [[q_max]]. The actual [[sqrts]] value
	for the transform object is inferred from the incoming particles, event by
	event.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: set_data_isr => evt_isr_epa_set_data_isr
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_set_data_isr (evt, sqrts, q_max, m, keep_mass)
	class(evt_isr_epa_t), intent(inout) :: evt
	real(default), intent(in) :: sqrts
	real(default), intent(in) :: q_max
	real(default), intent(in) :: m
	logical, intent(in) :: keep_mass
	end subroutine evt_isr_epa_set_data_isr
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_set_data_isr (evt, sqrts, q_max, m, keep_mass)
	class(evt_isr_epa_t), intent(inout) :: evt
	real(default), intent(in) :: sqrts
	real(default), intent(in) :: q_max
	real(default), intent(in) :: m
	logical, intent(in) :: keep_mass
	if (sqrts <= 0) then
	call msg_fatal ("ISR handler: sqrts value must be positive")
	end if
	if (q_max <= 0 .or. q_max > sqrts) then
	evt%isr_q_max = sqrts
	else
	evt%isr_q_max = q_max
	end if
	if (m > 0) then
	evt%isr_mass = m
	else
	call msg_fatal ("ISR handler: ISR_mass value must be positive")
	end if
	evt%isr_active = .true.
	evt%isr_keep_mass = keep_mass
	end subroutine evt_isr_epa_set_data_isr

	@ %def evt_isr_epa_set_data_isr
	@ Set constant kinematics limits and initialize for EPA. Note that [[sqrts]] is
	used only as the fallback value for [[q_max]]. The actual [[sqrts]]
	value for the transform object is inferred from the incoming
	particles, event by event.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: set_data_epa => evt_isr_epa_set_data_epa
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_set_data_epa (evt, sqrts, q_max, m)
	class(evt_isr_epa_t), intent(inout) :: evt
	real(default), intent(in) :: sqrts
	real(default), intent(in) :: q_max
	real(default), intent(in) :: m
	end subroutine evt_isr_epa_set_data_epa
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_set_data_epa (evt, sqrts, q_max, m)
	class(evt_isr_epa_t), intent(inout) :: evt
	real(default), intent(in) :: sqrts
	real(default), intent(in) :: q_max
	real(default), intent(in) :: m
	if (sqrts <= 0) then
	call msg_fatal ("EPA handler: sqrts value must be positive")
	end if
	if (q_max <= 0 .or. q_max > sqrts) then
	evt%epa_q_max = sqrts
	else
	evt%epa_q_max = q_max
	end if
	if (m > 0) then
	evt%epa_mass = m
	else
	call msg_fatal ("EPA handler: EPA_mass value must be positive")
	end if
	evt%epa_active = .true.
	end subroutine evt_isr_epa_set_data_epa

	@ %def evt_isr_epa_set_data_epa
	@
	\subsection{Fetch event data}
	Identify the radiated particles and the recoil momenta in the
	particle set. Without much sophistication, start from the end and
	find particles with the ``remnant'' status. Their parents should point to
	the recoiling parton. If successful, set the particle indices in the
	[[evt]] object, for further processing.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure, private :: identify_radiated
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine identify_radiated (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	end subroutine identify_radiated
	<<ISR/EPA handler: procedures>>=
	module subroutine identify_radiated (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer :: i, k
	k = 2
	FIND_LAST_RADIATED: do i = evt%particle_set%get_n_tot (), 1, -1
	associate (prt => evt%particle_set%prt(i))
	if (prt%is_beam_remnant ()) then
	evt%i_radiated(k) = i
	evt%radiated(k) = prt
	k = k - 1
	if (k == 0) exit FIND_LAST_RADIATED
	end if
	end associate
	end do FIND_LAST_RADIATED
	if (k /= 0) call err_count
	contains
	subroutine err_count
	call evt%particle_set%write ()
	call msg_fatal ("ISR/EPA handler: &
	&event does not contain two radiated particles")
	end subroutine err_count
	end subroutine identify_radiated

	@ %def identify_radiated
	@ When the radiated particles are known, we can fetch their parent
	particles and ask for the other child, the incoming parton.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure, private :: identify_partons
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine identify_partons (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	end subroutine identify_partons
	<<ISR/EPA handler: procedures>>=
	module subroutine identify_partons (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer, dimension(:), allocatable :: parent, child
	integer :: i, j
	if (all (evt%i_radiated > 0)) then
	do i = 1, 2
	parent = evt%radiated(i)%get_parents ()
	if (size (parent) /= 1) call err_mismatch
	evt%i_beam(i) = parent(1)
	evt%beam(i) = evt%particle_set%prt(parent(1))
	associate (prt => evt%beam(i))
	child = prt%get_children ()
	if (size (child) /= 2) call err_mismatch
	do j = 1, 2
	if (child(j) /= evt%i_radiated(i)) then
	evt%i_parton(i) = child(j)
	evt%parton(i) = evt%particle_set%prt(child(j))
	end if
	end do
	end associate
	end do
	end if
	contains
	subroutine err_mismatch
	call evt%particle_set%write ()
	call msg_bug ("ISR/EPA handler: mismatch in parent-child relations")
	end subroutine err_mismatch
	end subroutine identify_partons

	@ %def identify_partons
	@ Check whether the radiated particle is a photon, or the incoming
	parton is a photon. Then set the ISR/EPA switch appropriately, for
	each beam.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: check_radiation => evt_isr_epa_check_radiation
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_check_radiation (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	end subroutine evt_isr_epa_check_radiation
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_check_radiation (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	type(flavor_t) :: flv
	integer :: i
	do i = 1, 2
	flv = evt%radiated(i)%get_flv ()
	if (flv%get_pdg () == PHOTON) then
	if (evt%isr_active) then
	evt%rad_mode(i) = BEAM_RAD_ISR
	else
	call err_isr_init
	end if
	else
	flv = evt%parton(i)%get_flv ()
	if (flv%get_pdg () == PHOTON) then
	if (evt%epa_active) then
	evt%rad_mode(i) = BEAM_RAD_EPA
	else
	call err_epa_init
	end if
	else
	call err_no_photon
	end if
	end if
	end do
	contains
	subroutine err_isr_init
	call evt%particle_set%write ()
	call msg_fatal ("ISR/EPA handler: &
	&event contains radiated photon, but ISR is not initialized")
	end subroutine err_isr_init
	subroutine err_epa_init
	call evt%particle_set%write ()
	call msg_fatal ("ISR/EPA handler: &
	&event contains incoming photon, but EPA is not initialized")
	end subroutine err_epa_init
	subroutine err_no_photon
	call evt%particle_set%write ()
	call msg_fatal ("ISR/EPA handler: &
	&event does not appear to be ISR or EPA - missing photon")
	end subroutine err_no_photon
	end subroutine evt_isr_epa_check_radiation

	@ %def evt_isr_epa_check_radiation
	@ Internally set the appropriate parameters (ISR/EPA) for the two
	beams in the recoil mode.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: set_recoil_parameters => evt_isr_epa_set_recoil_parameters
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_set_recoil_parameters (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	end subroutine evt_isr_epa_set_recoil_parameters
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_set_recoil_parameters (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer :: i
	do i = 1, 2
	select case (evt%rad_mode(i))
	case (BEAM_RAD_ISR)
	evt%q_max(i) = evt%isr_q_max
	evt%m(i) = evt%isr_mass
	case (BEAM_RAD_EPA)
	evt%q_max(i) = evt%epa_q_max
	evt%m(i) = evt%epa_mass
	end select
	end do
	end subroutine evt_isr_epa_set_recoil_parameters

	@ %def evt_isr_epa_set_recoil_parameters
	@ Boost the particles that participate in ISR to their proper
	c.m.\ frame, copying the momenta to [[pi]], [[ki]], [[qi]]. Also
	assign [[sqrts]] properly.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure, private :: boost_to_cm
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine boost_to_cm (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	end subroutine boost_to_cm
	<<ISR/EPA handler: procedures>>=
	module subroutine boost_to_cm (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	type(vector4_t), dimension(2) :: p
	type(vector4_t), dimension(2) :: k
	type(vector4_t), dimension(2) :: q
	logical :: ok
	p = evt%beam%get_momentum ()
	k = evt%radiated%get_momentum ()
	q = evt%parton%get_momentum ()
	call initial_transformation (p, evt%sqrts, evt%lti, ok)
	if (.not. ok) call err_non_collinear
	evt%pi = inverse (evt%lti) * p
	evt%ki = inverse (evt%lti) * k
	evt%qi = inverse (evt%lti) * q
	contains
	subroutine err_non_collinear
	call evt%particle_set%write ()
	call msg_fatal ("ISR/EPA handler: &
	&partons before radiation are not collinear")
	end subroutine err_non_collinear
	end subroutine boost_to_cm

	@ %def boost_to_cm
	@ We can infer the $x$ and $\bar x$ values of the event by looking at
	the energy fractions of the radiated particles and incoming partons,
	respectively, relative to their
	parents. Of course, we must assume that they are all collinear, and
	that energy is conserved.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure, private :: infer_x
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine infer_x (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	end subroutine infer_x
	<<ISR/EPA handler: procedures>>=
	module subroutine infer_x (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	real(default) :: E_parent, E_radiated, E_parton
	integer :: i
	if (all (evt%i_radiated > 0)) then
	do i = 1, 2
	E_parent = energy (evt%pi(i))
	E_radiated = energy (evt%ki(i))
	E_parton = energy (evt%qi(i))
	if (E_parent > 0) then
	evt%xc(i) = E_parton / E_parent
	evt%xcb(i)= E_radiated / E_parent
	else
	call err_energy
	end if
	end do
	end if
	contains
	subroutine err_energy
	call evt%particle_set%write ()
	call msg_bug ("ISR/EPA handler: non-positive energy in splitting")
	end subroutine err_energy
	end subroutine infer_x

	@ %def infer_x
	@
	\subsection{Two-parton recoil}
	For transforming partons into recoil momenta, we make use of the
	routines in the [[recoil_kinematics]] module. In addition to the
	collinear momenta, we use the $x$ energy fractions, and four numbers
	from the RNG.

	There is one subtle difference w.r.t.\ ISR case: the EPA mass
	parameter is multiplied by the energy fraction $x$, separately for
	each beam. This is the effective lower $Q$ cutoff.

	For certain kinematics, close to the $Q_\text{max}$ endpoint, this may
	fail, and [[ok]] is set to false. In that case, we should generate
	new recoil momenta for the same event. This is handled by the generic
	unweighting procedure.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure, private :: generate_recoil => evt_generate_recoil
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_generate_recoil (evt, ok)
	class(evt_isr_epa_t), intent(inout) :: evt
	logical, intent(out) :: ok
	end subroutine evt_generate_recoil
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_generate_recoil (evt, ok)
	class(evt_isr_epa_t), intent(inout) :: evt
	logical, intent(out) :: ok
	real(default), dimension(4) :: r
	real(default), dimension(2) :: m, mo
	integer :: i
	call evt%rng%generate (r)
	m = 0
	mo = 0
	do i = 1, 2
	select case (evt%rad_mode(i))
	case (BEAM_RAD_ISR)
	m(i) = evt%m(i)
	if (evt%isr_keep_mass) mo(i) = m(i)
	case (BEAM_RAD_EPA)
	m(i) = evt%xc(i) * evt%m(i)
	end select
	end do
	call generate_recoil (evt%sqrts, evt%q_max, m, mo, evt%xc, evt%xcb, r, &
	evt%km, evt%qm, evt%qo, ok)
	end subroutine evt_generate_recoil

	@ %def evt_generate_recoil
	@ Replace the collinear radiated (incoming) parton momenta by the
	momenta that we
	have generated, respectively. Recall that the recoil has been applied
	in the c.m.\ system of the partons before ISR, so we apply the stored
	Lorentz transformation to boost them to the lab frame.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure, private :: replace_radiated
	procedure, private :: replace_partons
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine replace_radiated (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	end subroutine replace_radiated
	module subroutine replace_partons (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	end subroutine replace_partons
	<<ISR/EPA handler: procedures>>=
	module subroutine replace_radiated (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer :: i
	do i = 1, 2
	associate (prt => evt%particle_set%prt(evt%i_radiated(i)))
	call prt%set_momentum (evt%lti * evt%km(i))
	end associate
	end do
	end subroutine replace_radiated

	module subroutine replace_partons (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer :: i
	do i = 1, 2
	associate (prt => evt%particle_set%prt(evt%i_parton(i)))
	call prt%set_momentum (evt%lti * evt%qo(i))
	end associate
	end do
	end subroutine replace_partons

	@ %def replace_radiated
	@ %def replace_partons
	@
	\subsection{Transform the event}
	Knowing the new incoming partons for the elementary process, we can
	make use of another procedure in [[recoil_kinematics]] to determine
	the Lorentz transformation that transforms the collinear frame into
	the frame with transverse momentum. We apply this transformation,
	recursively, to all particles that originate from those incoming
	partons in the original particle set.

	We have to allow for the pre-ISR partons being not in their common
	c.m.\ frame. Taking into account non-commutativity, we actually have
	to first transform the outgoing particles to that c.m.\ frame, then
	apply the recoil transformation, then boost back to the lab frame.

	The [[mask]] keep track of particles that we transform, just in case
	the parent-child tree is multiply connected.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: transform_outgoing => evt_transform_outgoing
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_transform_outgoing (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	end subroutine evt_transform_outgoing
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_transform_outgoing (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	logical, dimension(:), allocatable :: mask
	call recoil_transformation (evt%sqrts, evt%xc, evt%qo, evt%lto)
	evt%lt = evt%lti * evt%lto * inverse (evt%lti)
	allocate (mask (evt%particle_set%get_n_tot ()), source=.false.)
	call transform_children (evt%i_parton(1))
	contains
	recursive subroutine transform_children (i)
	integer, intent(in) :: i
	integer :: j, n_child, c
	integer, dimension(:), allocatable :: child
	child = evt%particle_set%prt(i)%get_children ()
	do j = 1, size (child)
	c = child(j)
	if (.not. mask(c)) then
	associate (prt => evt%particle_set%prt(c))
	call prt%set_momentum (evt%lt * prt%get_momentum ())
	mask(c) = .true.
	call transform_children (c)
	end associate
	end if
	end do
	end subroutine transform_children
	end subroutine evt_transform_outgoing

	@ %def evt_transform_outgoing
	@
	\subsection{Implemented methods}
	Here we take the particle set from the previous event transform and
	copy it, then generate the transverse momentum for the radiated
	particles and for
	the incoming partons. If this fails (rarely, for large $p_T$),
	return zero for the probability, to trigger another try.

	NOTE: The boost for the initial partonic system, if not in the
	c.m.\ frame, has not been implemented yet.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: generate_weighted => &
	evt_isr_epa_generate_weighted
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_generate_weighted (evt, probability)
	class(evt_isr_epa_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	end subroutine evt_isr_epa_generate_weighted
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_generate_weighted (evt, probability)
	class(evt_isr_epa_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	logical :: valid
	call evt%particle_set%final ()
	evt%particle_set = evt%previous%particle_set
	evt%particle_set_exists = .true.
	select case (evt%mode)
	case (ISR_TRIVIAL_COLLINEAR)
	probability = 1
	valid = .true.
	case (ISR_PAIR_RECOIL)
	call evt%identify_radiated ()
	call evt%identify_partons ()
	call evt%check_radiation ()
	call evt%set_recoil_parameters ()
	call evt%boost_to_cm ()
	call evt%infer_x ()
	call evt%generate_recoil (valid)
	if (valid) then
	probability = 1
	else
	probability = 0
	end if
	case default
	call msg_bug ("ISR/EPA handler: generate weighted: unsupported mode")
	end select
	evt%particle_set_exists = .false.
	end subroutine evt_isr_epa_generate_weighted

	@ %def evt_isr_epa_generate_weighted
	@ Insert the generated radiated particles and incoming partons with
	$p_T$ in their respective places.

	The factorization parameters are irrelevant.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: make_particle_set => &
	evt_isr_epa_make_particle_set
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	end subroutine evt_isr_epa_make_particle_set
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	select case (evt%mode)
	case (ISR_TRIVIAL_COLLINEAR)
	case (ISR_PAIR_RECOIL)
	call evt%replace_radiated ()
	call evt%replace_partons ()
	call evt%transform_outgoing ()
	case default
	call msg_bug ("ISR/EPA handler: make particle set: unsupported mode")
	end select
	evt%particle_set_exists = .true.
	end subroutine evt_isr_epa_make_particle_set

	@ %def event_isr_epa_handler_make_particle_set
	@
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: prepare_new_event => &
	evt_isr_epa_prepare_new_event
	<<ISR/EPA handler: sub interfaces>>=
	module subroutine evt_isr_epa_prepare_new_event (evt, i_mci, i_term)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	end subroutine evt_isr_epa_prepare_new_event
	<<ISR/EPA handler: procedures>>=
	module subroutine evt_isr_epa_prepare_new_event (evt, i_mci, i_term)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	call evt%reset ()
	end subroutine evt_isr_epa_prepare_new_event

	@ %def evt_isr_epa_prepare_new_event
	@
	\subsection{Unit tests: ISR}
	Test module, followed by the corresponding implementation module.

	This test module differs from most of the other test modules, since it
	contains two test subroutines: one for ISR and one for EPA below.
	<<[[isr_epa_handler_ut.f90]]>>=
	<<File header>>

	module isr_epa_handler_ut
	use unit_tests
	use isr_epa_handler_uti

	<<Standard module head>>

	<<ISR/EPA handler: public test>>

	contains

	<<ISR/EPA handler: test driver>>

	end module isr_epa_handler_ut
	@ %def isr_epa_handler_ut
	@
	<<[[isr_epa_handler_uti.f90]]>>=
	<<File header>>

	module isr_epa_handler_uti

	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use os_interface
	use lorentz, only: vector4_t, vector4_moving, operator(*)
	use rng_base, only: rng_t
	use models, only: syntax_model_file_init, syntax_model_file_final
	use models, only: model_list_t, model_t
	use particles, only: particle_set_t

	use event_transforms
	use isr_epa_handler, only: evt_isr_epa_t

	use rng_base_ut, only: rng_test_t

	<<Standard module head>>

	<<ISR/EPA handler: test declarations>>

	contains

	<<ISR/EPA handler: tests>>

	end module isr_epa_handler_uti

	@ %def isr_epa_handler_uti
	@ API: driver for the unit tests below.
	<<ISR/EPA handler: public test>>=
	public :: isr_handler_test
	<<ISR/EPA handler: test driver>>=
	subroutine isr_handler_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<ISR/EPA handler: execute ISR tests>>
	end subroutine isr_handler_test

	@ %def isr_handler_test
	@
	\subsubsection{Trivial case}
	Handle photons resulting from ISR radiation. This test is for the
	trivial case where the event is kept collinear.
	<<ISR/EPA handler: execute ISR tests>>=
	call test (isr_handler_1, "isr_handler_1", &
	"collinear case, no modification", &
	u, results)
	<<ISR/EPA handler: test declarations>>=
	public :: isr_handler_1
	<<ISR/EPA handler: tests>>=
	subroutine isr_handler_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(evt_trivial_t), target :: evt_trivial
	type(evt_isr_epa_t), target :: evt_isr_epa
	type(vector4_t), dimension(8) :: p
	real(default) :: sqrts
	real(default), dimension(2) :: x, xb
	real(default) :: probability

	write (u, "(A)") "* Test output: isr_handler_1"
	write (u, "(A)") "* Purpose: apply photon handler trivially (no-op)"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	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)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 11, -11, 22, 22, 13, -13], model = model)

	sqrts = 100._default
	x = [0.6_default, 0.9_default]
	xb= 1 - x

	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	p(3:4) = x * p(1:2)
	p(5:6) = xb * p(1:2)
	p(7:8) = p(3:4)

	call pset%set_momentum (p, on_shell = .false.)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Initialize ISR handler transform"
	write (u, "(A)")

	evt_trivial%next => evt_isr_epa
	evt_isr_epa%previous => evt_trivial

	call evt_isr_epa%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill ISR handler transform"
	write (u, "(A)")

	call evt_isr_epa%prepare_new_event (1, 1)
	call evt_isr_epa%generate_weighted (probability)
	call evt_isr_epa%make_particle_set (0, .false.)

	call evt_isr_epa%write (u)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

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

	call evt_isr_epa%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

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

	end subroutine isr_handler_1

	@ %def isr_handler_1
	@
	\subsubsection{Photon pair with recoil}
	Handle photons resulting from ISR radiation. This test invokes the
	two-photon recoil mechanism. Both photons acquire transverse
	momentum, the parton momenta recoil, such that total energy-momentum
	is conserved, and all outgoing photons and partons are on-shell
	(massless).
	<<ISR/EPA handler: execute ISR tests>>=
	call test (isr_handler_2, "isr_handler_2", &
	"two-photon recoil", &
	u, results)
	<<ISR/EPA handler: test declarations>>=
	public :: isr_handler_2
	<<ISR/EPA handler: tests>>=
	subroutine isr_handler_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(evt_trivial_t), target :: evt_trivial
	type(evt_isr_epa_t), target :: evt_isr_epa
	type(vector4_t), dimension(8) :: p
	real(default) :: sqrts
	real(default), dimension(2) :: x, xb
	class(rng_t), allocatable :: rng
	real(default) :: probability

	write (u, "(A)") "* Test output: isr_handler_2"
	write (u, "(A)") "* Purpose: apply photon handler with two-photon recoil"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	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)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 11, -11, 22, 22, 13, -13], model = model)

	sqrts = 100._default
	x = [0.6_default, 0.9_default]
	xb= 1 - x

	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	p(3:4) = x * p(1:2)
	p(5:6) = xb * p(1:2)
	p(7:8) = p(3:4)

	call pset%set_momentum (p, on_shell = .false.)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Initialize ISR handler transform"
	write (u, "(A)")

	evt_trivial%next => evt_isr_epa
	evt_isr_epa%previous => evt_trivial

	call evt_isr_epa%set_mode_string (var_str ("recoil"))
	call evt_isr_epa%set_data_isr ( &
	sqrts = sqrts, &
	q_max = sqrts, &
	m = 511.e-3_default, &
	keep_mass = .false. &
	)

	allocate (rng_test_t :: rng)
	call rng%init (3) ! default would produce pi for azimuthal angle
	call evt_isr_epa%import_rng (rng)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Fill ISR handler transform"
	write (u, "(A)")

	call evt_isr_epa%prepare_new_event (1, 1)
	call evt_isr_epa%generate_weighted (probability)
	call evt_isr_epa%make_particle_set (0, .false.)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

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

	call evt_isr_epa%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

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

	end subroutine isr_handler_2

	@ %def isr_handler_2
	@
	\subsubsection{Boosted beams}
	Handle photons resulting from ISR radiation. This test invokes the
	two-photon recoil mechanism, in the case that the partons before ISR
	are not in their c.m.\ frame (but collinear).
	<<ISR/EPA handler: execute ISR tests>>=
	call test (isr_handler_3, "isr_handler_3", &
	"two-photon recoil with boost", &
	u, results)
	<<ISR/EPA handler: test declarations>>=
	public :: isr_handler_3
	<<ISR/EPA handler: tests>>=
	subroutine isr_handler_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(evt_trivial_t), target :: evt_trivial
	type(evt_isr_epa_t), target :: evt_isr_epa
	type(vector4_t), dimension(8) :: p
	real(default) :: sqrts
	real(default), dimension(2) :: x0
	real(default), dimension(2) :: x, xb
	class(rng_t), allocatable :: rng
	real(default) :: probability

	write (u, "(A)") "* Test output: isr_handler_3"
	write (u, "(A)") "* Purpose: apply photon handler for boosted beams &
	&and two-photon recoil"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	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)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 11, -11, 22, 22, 13, -13], model = model)

	write (u, "(A)") "* Event data"
	write (u, "(A)")

	sqrts = 100._default
	write (u, "(A,2(1x,F12.7))") "sqrts =", sqrts

	x0 = [0.9_default, 0.4_default]
	write (u, "(A,2(1x,F12.7))") "x0 =", x0

	write (u, "(A)")
	write (u, "(A,2(1x,F12.7))") "sqs_hat =", sqrts * sqrt (product (x0))

	x = [0.6_default, 0.9_default]
	xb= 1 - x
	write (u, "(A,2(1x,F12.7))") "x =", x

	write (u, "(A)")
	write (u, "(A,2(1x,F12.7))") "x0 * x =", x0 * x

	p(1) = x0(1) * vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = x0(2) * vector4_moving (sqrts/2,-sqrts/2, 3)
	p(3:4) = x * p(1:2)
	p(5:6) = xb * p(1:2)
	p(7:8) = p(3:4)

	call pset%set_momentum (p, on_shell = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Initialize ISR handler transform"
	write (u, "(A)")

	evt_trivial%next => evt_isr_epa
	evt_isr_epa%previous => evt_trivial

	call evt_isr_epa%set_mode_string (var_str ("recoil"))
	call evt_isr_epa%set_data_isr ( &
	sqrts = sqrts, &
	q_max = sqrts, &
	m = 511.e-3_default, &
	keep_mass = .false. &
	)

	allocate (rng_test_t :: rng)
	call rng%init (3) ! default would produce pi for azimuthal angle
	call evt_isr_epa%import_rng (rng)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Fill ISR handler transform"
	write (u, "(A)")

	call evt_isr_epa%prepare_new_event (1, 1)
	call evt_isr_epa%generate_weighted (probability)
	call evt_isr_epa%make_particle_set (0, .false.)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

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

	call evt_isr_epa%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

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

	end subroutine isr_handler_3

	@ %def isr_handler_3
	@
	\subsection{Unit tests: EPA}
	API: Extra driver for the unit tests below.
	<<ISR/EPA handler: public test>>=
	public :: epa_handler_test
	<<ISR/EPA handler: test driver>>=
	subroutine epa_handler_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<ISR/EPA handler: execute EPA tests>>
	end subroutine epa_handler_test

	@ %def epa_handler_test
	@
	\subsubsection{Trivial case}
	Handle events resulting from the EPA approximation. This test is for the
	trivial case where the event is kept collinear.
	<<ISR/EPA handler: execute EPA tests>>=
	call test (epa_handler_1, "epa_handler_1", &
	"collinear case, no modification", &
	u, results)
	<<ISR/EPA handler: test declarations>>=
	public :: epa_handler_1
	<<ISR/EPA handler: tests>>=
	subroutine epa_handler_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(evt_trivial_t), target :: evt_trivial
	type(evt_isr_epa_t), target :: evt_isr_epa
	type(vector4_t), dimension(8) :: p
	real(default) :: sqrts
	real(default), dimension(2) :: x, xb
	real(default) :: probability

	write (u, "(A)") "* Test output: epa_handler_1"
	write (u, "(A)") "* Purpose: apply beam handler trivially (no-op)"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	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)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct &
	(n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 22, 22, 11, -11, 13, -13], &
	model = model)

	sqrts = 100._default
	x = [0.6_default, 0.9_default]
	xb= 1 - x

	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	p(3:4) = x * p(1:2)
	p(5:6) = xb * p(1:2)
	p(7:8) = p(3:4)

	call pset%set_momentum (p, on_shell = .false.)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Initialize EPA handler transform"
	write (u, "(A)")

	evt_trivial%next => evt_isr_epa
	evt_isr_epa%previous => evt_trivial

	call evt_isr_epa%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill EPA handler transform"
	write (u, "(A)")

	call evt_isr_epa%prepare_new_event (1, 1)
	call evt_isr_epa%generate_weighted (probability)
	call evt_isr_epa%make_particle_set (0, .false.)

	call evt_isr_epa%write (u)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

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

	call evt_isr_epa%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

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

	end subroutine epa_handler_1

	@ %def epa_handler_1
	@
	\subsubsection{Beam pair with recoil}
	Handle beams resulting from the EPA approximation. This test invokes the
	two-beam recoil mechanism. Both beam remnants acquire transverse
	momentum, the photon momenta recoil, such that total energy-momentum
	is conserved, and all outgoing beam remnants and photons are on-shell
	(massless).
	<<ISR/EPA handler: execute EPA tests>>=
	call test (epa_handler_2, "epa_handler_2", &
	"two-beam recoil", &
	u, results)
	<<ISR/EPA handler: test declarations>>=
	public :: epa_handler_2
	<<ISR/EPA handler: tests>>=
	subroutine epa_handler_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(evt_trivial_t), target :: evt_trivial
	type(evt_isr_epa_t), target :: evt_isr_epa
	type(vector4_t), dimension(8) :: p
	real(default) :: sqrts
	real(default), dimension(2) :: x, xb
	class(rng_t), allocatable :: rng
	real(default) :: probability

	write (u, "(A)") "* Test output: epa_handler_2"
	write (u, "(A)") "* Purpose: apply beam handler with two-beam recoil"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	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)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 22, 22, 11, -11, 13, -13], model = model)

	sqrts = 100._default
	x = [0.6_default, 0.9_default]
	xb= 1 - x

	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	p(3:4) = x * p(1:2)
	p(5:6) = xb * p(1:2)
	p(7:8) = p(3:4)

	call pset%set_momentum (p, on_shell = .false.)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Initialize EPA handler transform"
	write (u, "(A)")

	evt_trivial%next => evt_isr_epa
	evt_isr_epa%previous => evt_trivial

	call evt_isr_epa%set_mode_string (var_str ("recoil"))
	call evt_isr_epa%set_data_epa ( &
	sqrts = sqrts, &
	q_max = sqrts, &
	m = 511.e-3_default &
	)

	allocate (rng_test_t :: rng)
	call rng%init (3) ! default would produce pi for azimuthal angle
	call evt_isr_epa%import_rng (rng)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Fill EPA handler transform"
	write (u, "(A)")

	call evt_isr_epa%prepare_new_event (1, 1)
	call evt_isr_epa%generate_weighted (probability)
	call evt_isr_epa%make_particle_set (0, .false.)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

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

	call evt_isr_epa%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

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

	end subroutine epa_handler_2

	@ %def epa_handler_2
	@
	\subsubsection{Boosted beams}
	Handle radiated beam remnants resulting from EPA radiation. This test
	invokes the two-beam recoil mechanism, in the case that the partons
	before EPA are not in their c.m.\ frame (but collinear).
	<<ISR/EPA handler: execute EPA tests>>=
	call test (epa_handler_3, "epa_handler_3", &
	"two-beam recoil with boost", &
	u, results)
	<<ISR/EPA handler: test declarations>>=
	public :: epa_handler_3
	<<ISR/EPA handler: tests>>=
	subroutine epa_handler_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(evt_trivial_t), target :: evt_trivial
	type(evt_isr_epa_t), target :: evt_isr_epa
	type(vector4_t), dimension(8) :: p
	real(default) :: sqrts
	real(default), dimension(2) :: x0
	real(default), dimension(2) :: x, xb
	class(rng_t), allocatable :: rng
	real(default) :: probability

	write (u, "(A)") "* Test output: epa_handler_3"
	write (u, "(A)") "* Purpose: apply beam handler for boosted beams &
	&and two-beam recoil"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	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)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 22, 22, 11, -11, 13, -13], model = model)

	write (u, "(A)") "* Event data"
	write (u, "(A)")

	sqrts = 100._default
	write (u, "(A,2(1x,F12.7))") "sqrts =", sqrts

	x0 = [0.9_default, 0.4_default]
	write (u, "(A,2(1x,F12.7))") "x0 =", x0

	write (u, "(A)")
	write (u, "(A,2(1x,F12.7))") "sqs_hat =", sqrts * sqrt (product (x0))

	x = [0.6_default, 0.9_default]
	xb= 1 - x
	write (u, "(A,2(1x,F12.7))") "x =", x

	write (u, "(A)")
	write (u, "(A,2(1x,F12.7))") "x0 * x =", x0 * x

	p(1) = x0(1) * vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = x0(2) * vector4_moving (sqrts/2,-sqrts/2, 3)
	p(3:4) = x * p(1:2)
	p(5:6) = xb * p(1:2)
	p(7:8) = p(3:4)

	call pset%set_momentum (p, on_shell = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Initialize EPA handler transform"
	write (u, "(A)")

	evt_trivial%next => evt_isr_epa
	evt_isr_epa%previous => evt_trivial

	call evt_isr_epa%set_mode_string (var_str ("recoil"))
	call evt_isr_epa%set_data_epa ( &
	sqrts = sqrts, &
	q_max = sqrts, &
	m = 511.e-3_default &
	)

	allocate (rng_test_t :: rng)
	call rng%init (3) ! default would produce pi for azimuthal angle
	call evt_isr_epa%import_rng (rng)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Fill EPA handler transform"
	write (u, "(A)")

	call evt_isr_epa%prepare_new_event (1, 1)
	call evt_isr_epa%generate_weighted (probability)
	call evt_isr_epa%make_particle_set (0, .false.)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

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

	call evt_isr_epa%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

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

	end subroutine epa_handler_3

	@ %def epa_handler_3
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Decays}
	<<[[decays.f90]]>>=
	<<File header>>

	module decays

	<<Use kinds>>
	<<Use strings>>
	use diagnostics
	use flavors
	use interactions
	use evaluators
	use variables, only: var_list_t
	use model_data
	use rng_base
	use selectors
	use parton_states
	use process, only: process_t
	use instances, only: process_instance_t, pacify
	use process_stacks
	use event_transforms

	<<Standard module head>>

	<<Decays: public>>

	<<Decays: types>>

	<<Decays: interfaces>>

	interface
	<<Decays: sub interfaces>>
	end interface

	contains

	<<Decays: main procedures>>

	end module decays

	@ %def decays
	@
	<<[[decays_sub.f90]]>>=
	<<File header>>

	submodule (decays) decays_s

	use io_units
	use format_utils, only: write_indent, write_separator
	use format_defs, only: FMT_15
	use numeric_utils
	use helicities
	use quantum_numbers

	implicit none

	contains

	<<Decays: procedures>>

	end submodule decays_s

	@ %def decays_s
	@
	\subsection{Final-State Particle Configuration}
	A final-state particle may be either stable or unstable. Here is an
	empty abstract type as the parent of both, with holds just the flavor
	information.
	<<Decays: types>>=
	type, abstract :: any_config_t
	private
	contains
	<<Decays: any config: TBP>>
	end type any_config_t

	@ %def any_config_t
	@ Finalizer, depends on the implementation.
	<<Decays: any config: TBP>>=
	procedure (any_config_final), deferred :: final
	<<Decays: interfaces>>=
	interface
	subroutine any_config_final (object)
	import
	class(any_config_t), intent(inout) :: object
	end subroutine any_config_final
	end interface

	@ %def any_config_final
	@ The output is also deferred:
	<<Decays: any config: TBP>>=
	procedure (any_config_write), deferred :: write
	<<Decays: interfaces>>=
	interface
	subroutine any_config_write (object, unit, indent, verbose)
	import
	class(any_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	end subroutine any_config_write
	end interface

	@ %def any_config_write
	@ This is a container for a stable or unstable particle configurator.
	We need this wrapper for preparing arrays that mix stable and unstable
	particles.
	<<Decays: types>>=
	type :: particle_config_t
	private
	class(any_config_t), allocatable :: c
	end type particle_config_t

	@ %def particle_config_t
	@
	\subsection{Final-State Particle}
	In theory, for the particle instance we only need to consider the
	unstable case. However, it is more straightforward to treat
	configuration and instance on the same footing, and to introduce a
	wrapper for particle objects as above.
	<<Decays: types>>=
	type, abstract :: any_t
	private
	contains
	<<Decays: any: TBP>>
	end type any_t

	@ %def any_t
	@ Finalizer, depends on the implementation.
	<<Decays: any: TBP>>=
	procedure (any_final), deferred :: final
	<<Decays: interfaces>>=
	interface
	subroutine any_final (object)
	import
	class(any_t), intent(inout) :: object
	end subroutine any_final
	end interface

	@ %def any_final
	@ The output is also deferred:
	<<Decays: any: TBP>>=
	procedure (any_write), deferred :: write
	<<Decays: interfaces>>=
	interface
	subroutine any_write (object, unit, indent)
	import
	class(any_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	end subroutine any_write
	end interface

	@ %def any_write
	@ This is a container for a stable or unstable outgoing particle.
	We need this wrapper for preparing arrays that mix stable and unstable
	particles.
	<<Decays: types>>=
	type :: particle_out_t
	private
	class(any_t), allocatable :: c
	end type particle_out_t

	@ %def particle_config_t
	@
	\subsection{Decay Term Configuration}
	A decay term is a distinct final state, corresponding to a process
	term. Each decay process may give rise to several terms with,
	possibly, differing flavor content.
	<<Decays: types>>=
	type :: decay_term_config_t
	private
	type(particle_config_t), dimension(:), allocatable :: prt
	contains
	<<Decays: decay term config: TBP>>
	end type decay_term_config_t

	@ %def decay_term_config_t
	@ Finalizer, recursive.
	<<Decays: decay term config: TBP>>=
	procedure :: final => decay_term_config_final
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_term_config_final (object)
	class(decay_term_config_t), intent(inout) :: object
	end subroutine decay_term_config_final
	<<Decays: procedures>>=
	recursive module subroutine decay_term_config_final (object)
	class(decay_term_config_t), intent(inout) :: object
	integer :: i
	if (allocated (object%prt)) then
	do i = 1, size (object%prt)
	if (allocated (object%prt(i)%c)) call object%prt(i)%c%final ()
	end do
	end if
	end subroutine decay_term_config_final

	@ %def decay_term_config_final
	@ Output, with optional indentation
	<<Decays: decay term config: TBP>>=
	procedure :: write => decay_term_config_write
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_term_config_write &
	(object, unit, indent, verbose)
	class(decay_term_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	end subroutine decay_term_config_write
	<<Decays: procedures>>=
	recursive module subroutine decay_term_config_write &
	(object, unit, indent, verbose)
	class(decay_term_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	integer :: i, j, u, ind
	logical :: verb
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	verb = .true.; if (present (verbose)) verb = verbose
	call write_indent (u, ind)
	write (u, "(1x,A)", advance="no") "Final state:"
	do i = 1, size (object%prt)
	select type (prt_config => object%prt(i)%c)
	type is (stable_config_t)
	write (u, "(1x,A)", advance="no") &
	char (prt_config%flv(1)%get_name ())
	do j = 2, size (prt_config%flv)
	write (u, "(':',A)", advance="no") &
	char (prt_config%flv(j)%get_name ())
	end do
	type is (unstable_config_t)
	write (u, "(1x,A)", advance="no") &
	char (prt_config%flv%get_name ())
	end select
	end do
	write (u, *)
	if (verb) then
	do i = 1, size (object%prt)
	call object%prt(i)%c%write (u, ind)
	end do
	end if
	end subroutine decay_term_config_write

	@ %def decay_term_config_write
	@ Initialize, given a set of flavors. For each flavor, we must indicate
	whether the particle is stable. The second index of the flavor array runs
	over alternatives for each decay product; alternatives are allowed only if the
	decay product is itself stable.
	Gfortran 7/8/9 bug, has to remain in the main module:
	<<Decays: decay term config: TBP>>=
	procedure :: init => decay_term_config_init
	<<Decays: main procedures>>=
	recursive subroutine decay_term_config_init &
	(term, flv, stable, model, process_stack, var_list)
	class(decay_term_config_t), intent(out) :: term
	type(flavor_t), dimension(:,:), intent(in) :: flv
	logical, dimension(:), intent(in) :: stable
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(var_list_t), intent(in), optional :: var_list
	type(string_t), dimension(:), allocatable :: decay
	integer :: i
	allocate (term%prt (size (flv, 1)))
	do i = 1, size (flv, 1)
	associate (prt => term%prt(i))
	if (stable(i)) then
	allocate (stable_config_t :: prt%c)
	else
	allocate (unstable_config_t :: prt%c)
	end if
	select type (prt_config => prt%c)
	type is (stable_config_t)
	call prt_config%init (flv(i,:))
	type is (unstable_config_t)
	if (all (flv(i,:) == flv(i,1))) then
	call prt_config%init (flv(i,1))
	call flv(i,1)%get_decays (decay)
	call prt_config%init_decays &
	(decay, model, process_stack, var_list)
	else
	call prt_config%write ()
	call msg_fatal ("Decay configuration: &
	&unstable product must be unique")
	end if
	end select
	end associate
	end do
	end subroutine decay_term_config_init

	@ %def decay_term_config_init
	@ Recursively compute widths and branching ratios for all unstable particles.
	<<Decays: decay term config: TBP>>=
	procedure :: compute => decay_term_config_compute
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_term_config_compute (term)
	class(decay_term_config_t), intent(inout) :: term
	end subroutine decay_term_config_compute
	<<Decays: procedures>>=
	recursive module subroutine decay_term_config_compute (term)
	class(decay_term_config_t), intent(inout) :: term
	integer :: i
	do i = 1, size (term%prt)
	select type (unstable_config => term%prt(i)%c)
	type is (unstable_config_t)
	call unstable_config%compute ()
	end select
	end do
	end subroutine decay_term_config_compute

	@ %def decay_term_config_compute
	@
	\subsection{Decay Term}
	A decay term instance is selected when we generate an event for the associated
	process instance. When evaluated, it triggers further decays down the chain.

	Only unstable products are allocated as child particles.
	<<Decays: types>>=
	type :: decay_term_t
	private
	type(decay_term_config_t), pointer :: config => null ()
	type(particle_out_t), dimension(:), allocatable :: particle_out
	contains
	<<Decays: decay term: TBP>>
	end type decay_term_t

	@ %def decay_term_t
	@ Finalizer.
	<<Decays: decay term: TBP>>=
	procedure :: final => decay_term_final
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_term_final (object)
	class(decay_term_t), intent(inout) :: object
	end subroutine decay_term_final
	<<Decays: procedures>>=
	recursive module subroutine decay_term_final (object)
	class(decay_term_t), intent(inout) :: object
	integer :: i
	if (allocated (object%particle_out)) then
	do i = 1, size (object%particle_out)
	call object%particle_out(i)%c%final ()
	end do
	end if
	end subroutine decay_term_final

	@ %def decay_term_final
	@ Output.
	<<Decays: decay term: TBP>>=
	procedure :: write => decay_term_write
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_term_write (object, unit, indent)
	class(decay_term_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	end subroutine decay_term_write
	<<Decays: procedures>>=
	recursive module subroutine decay_term_write (object, unit, indent)
	class(decay_term_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	integer :: i, u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call object%config%write (u, ind, verbose = .false.)
	do i = 1, size (object%particle_out)
	call object%particle_out(i)%c%write (u, ind)
	end do
	end subroutine decay_term_write

	@ %def decay_term_write
	@ Recursively write the embedded process instances.
	<<Decays: decay term: TBP>>=
	procedure :: write_process_instances => decay_term_write_process_instances
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_term_write_process_instances &
	(term, unit, verbose)
	class(decay_term_t), intent(in) :: term
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine decay_term_write_process_instances
	<<Decays: procedures>>=
	recursive module subroutine decay_term_write_process_instances &
	(term, unit, verbose)
	class(decay_term_t), intent(in) :: term
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	call unstable%write_process_instances (unit, verbose)
	end select
	end do
	end subroutine decay_term_write_process_instances

	@ %def decay_term_write_process_instances
	@ Initialization, using the configuration object. We allocate
	particle objects in parallel to the particle configuration objects
	which we use to initialize them, one at a time.
	Gfortran 7/8/9 bug, has to remain in the main module:
	<<Decays: decay term: TBP>>=
	procedure :: init => decay_term_init
	<<Decays: main procedures>>=
	recursive subroutine decay_term_init (term, config)
	class(decay_term_t), intent(out) :: term
	type(decay_term_config_t), intent(in), target :: config
	integer :: i
	term%config => config
	allocate (term%particle_out (size (config%prt)))
	do i = 1, size (config%prt)
	select type (prt_config => config%prt(i)%c)
	type is (stable_config_t)
	allocate (stable_t :: term%particle_out(i)%c)
	select type (stable => term%particle_out(i)%c)
	type is (stable_t)
	call stable%init (prt_config)
	end select
	type is (unstable_config_t)
	allocate (unstable_t :: term%particle_out(i)%c)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	call unstable%init (prt_config)
	end select
	end select
	end do
	end subroutine decay_term_init

	@ %def decay_term_init
	@ Implement a RNG instance, spawned by the process object.
	<<Decays: decay term: TBP>>=
	procedure :: make_rng => decay_term_make_rng
	<<Decays: sub interfaces>>=
	module subroutine decay_term_make_rng (term, process)
	class(decay_term_t), intent(inout) :: term
	type(process_t), intent(inout) :: process
	class(rng_t), allocatable :: rng
	end subroutine decay_term_make_rng
	<<Decays: procedures>>=
	module subroutine decay_term_make_rng (term, process)
	class(decay_term_t), intent(inout) :: term
	type(process_t), intent(inout) :: process
	class(rng_t), allocatable :: rng
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	call process%make_rng (rng)
	call unstable%import_rng (rng)
	end select
	end do
	end subroutine decay_term_make_rng

	@ %def decay_term_make_rng
	@ Link the interactions for unstable decay products to the
	interaction of the parent process.
	<<Decays: decay term: TBP>>=
	procedure :: link_interactions => decay_term_link_interactions
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_term_link_interactions (term, trace)
	class(decay_term_t), intent(inout) :: term
	type(interaction_t), intent(in), target :: trace
	end subroutine decay_term_link_interactions
	<<Decays: procedures>>=
	recursive module subroutine decay_term_link_interactions (term, trace)
	class(decay_term_t), intent(inout) :: term
	type(interaction_t), intent(in), target :: trace
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	call unstable%link_interactions (i, trace)
	end select
	end do
	end subroutine decay_term_link_interactions

	@ %def decay_term_link_interactions
	@ Recursively generate a decay chain, for each of the unstable
	particles in the final state.
	<<Decays: decay term: TBP>>=
	procedure :: select_chain => decay_term_select_chain
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_term_select_chain (term)
	class(decay_term_t), intent(inout) :: term
	end subroutine decay_term_select_chain
	<<Decays: procedures>>=
	recursive module subroutine decay_term_select_chain (term)
	class(decay_term_t), intent(inout) :: term
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	call unstable%select_chain ()
	end select
	end do
	end subroutine decay_term_select_chain

	@ %def decay_term_select_chain
	@ Recursively generate a decay event, for each of the unstable
	particles in the final state.
	<<Decays: decay term: TBP>>=
	procedure :: generate => decay_term_generate
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_term_generate (term)
	class(decay_term_t), intent(inout) :: term
	end subroutine decay_term_generate
	<<Decays: procedures>>=
	recursive module subroutine decay_term_generate (term)
	class(decay_term_t), intent(inout) :: term
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	call unstable%generate ()
	end select
	end do
	end subroutine decay_term_generate

	@ %def decay_term_generate
	@
	\subsection{Decay Root Configuration}
	At the root of a decay chain, there is a parent process. The decay root
	stores a pointer to the parent process and the set of decay configurations.
	<<Decays: public>>=
	public :: decay_root_config_t
	<<Decays: types>>=
	type :: decay_root_config_t
	private
	type(string_t) :: process_id
	type(process_t), pointer :: process => null ()
	class(model_data_t), pointer :: model => null ()
	type(decay_term_config_t), dimension(:), allocatable :: term_config
	contains
	<<Decays: decay root config: TBP>>
	end type decay_root_config_t

	@ %def decay_root_config_t
	@ The finalizer is recursive since there may be cascade decays.
	<<Decays: decay root config: TBP>>=
	procedure :: final => decay_root_config_final
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_root_config_final (object)
	class(decay_root_config_t), intent(inout) :: object
	end subroutine decay_root_config_final
	<<Decays: procedures>>=
	recursive module subroutine decay_root_config_final (object)
	class(decay_root_config_t), intent(inout) :: object
	integer :: i
	if (allocated (object%term_config)) then
	do i = 1, size (object%term_config)
	call object%term_config(i)%final ()
	end do
	end if
	end subroutine decay_root_config_final

	@ %def decay_root_config_final
	@ The output routine is also recursive, and it contains an adjustable
	indentation.
	<<Decays: decay root config: TBP>>=
	procedure :: write => decay_root_config_write
	procedure :: write_header => decay_root_config_write_header
	procedure :: write_terms => decay_root_config_write_terms
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_root_config_write &
	(object, unit, indent, verbose)
	class(decay_root_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	end subroutine decay_root_config_write
	module subroutine decay_root_config_write_header (object, unit, indent)
	class(decay_root_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	end subroutine decay_root_config_write_header
	module recursive subroutine decay_root_config_write_terms &
	(object, unit, indent, verbose)
	class(decay_root_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	end subroutine decay_root_config_write_terms
	<<Decays: procedures>>=
	recursive module subroutine decay_root_config_write &
	(object, unit, indent, verbose)
	class(decay_root_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, ind)
	write (u, "(1x,A)") "Final-state decay tree:"
	call object%write_header (unit, indent)
	call object%write_terms (unit, indent, verbose)
	end subroutine decay_root_config_write

	module subroutine decay_root_config_write_header (object, unit, indent)
	class(decay_root_config_t), intent(in) :: object
	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, ind)
	if (associated (object%process)) then
	write (u, 3) "process ID =", char (object%process_id), "*"
	else
	write (u, 3) "process ID =", char (object%process_id)
	end if
	3 format (3x,A,2(1x,A))
	end subroutine decay_root_config_write_header

	module recursive subroutine decay_root_config_write_terms &
	(object, unit, indent, verbose)
	class(decay_root_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	integer :: i, u, ind
	logical :: verb
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	verb = .true.; if (present (verbose)) verb = verbose
	if (verb .and. allocated (object%term_config)) then
	do i = 1, size (object%term_config)
	call object%term_config(i)%write (u, ind + 1)
	end do
	end if
	end subroutine decay_root_config_write_terms

	@ %def decay_root_config_write
	@ Initialize for a named process and (optionally) a pre-determined
	number of terms.
	<<Decays: decay root config: TBP>>=
	procedure :: init => decay_root_config_init
	<<Decays: sub interfaces>>=
	module subroutine decay_root_config_init (decay, model, process_id, n_terms)
	class(decay_root_config_t), intent(out) :: decay
	class(model_data_t), intent(in), target :: model
	type(string_t), intent(in) :: process_id
	integer, intent(in), optional :: n_terms
	end subroutine decay_root_config_init
	<<Decays: procedures>>=
	module subroutine decay_root_config_init (decay, model, process_id, n_terms)
	class(decay_root_config_t), intent(out) :: decay
	class(model_data_t), intent(in), target :: model
	type(string_t), intent(in) :: process_id
	integer, intent(in), optional :: n_terms
	decay%model => model
	decay%process_id = process_id
	if (present (n_terms)) then
	allocate (decay%term_config (n_terms))
	end if
	end subroutine decay_root_config_init

	@ %def decay_root_config_init
	@ Declare a decay term, given an array of flavors.
	<<Decays: decay root config: TBP>>=
	procedure :: init_term => decay_root_config_init_term
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_root_config_init_term &
	(decay, i, flv, stable, model, process_stack, var_list)
	class(decay_root_config_t), intent(inout) :: decay
	integer, intent(in) :: i
	type(flavor_t), dimension(:,:), intent(in) :: flv
	logical, dimension(:), intent(in) :: stable
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(var_list_t), intent(in), optional, target :: var_list
	end subroutine decay_root_config_init_term
	<<Decays: procedures>>=
	recursive module subroutine decay_root_config_init_term &
	(decay, i, flv, stable, model, process_stack, var_list)
	class(decay_root_config_t), intent(inout) :: decay
	integer, intent(in) :: i
	type(flavor_t), dimension(:,:), intent(in) :: flv
	logical, dimension(:), intent(in) :: stable
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(var_list_t), intent(in), optional, target :: var_list
	call decay%term_config(i)%init (flv, stable, model, process_stack, var_list)
	end subroutine decay_root_config_init_term

	@ %def decay_root_config_init_term
	@ Connect the decay root configuration with a process object (which should
	represent the parent process). This includes initialization, therefore
	intent(out).

	The flavor state is retrieved from the process term object. However, we have
	to be careful: the flavor object points to the model instance that is stored
	in the process object. This model instance may not contain the current
	setting for unstable particles and decay. Therefore, we assign the model
	directly.

	If the [[process_instance]] argument is provided, we use this for the
	flavor state. This applies to the decay root only, where the process
	can be entangled with a beam setup, and the latter contains beam
	remnants as further outgoing particles. These must be included in the
	set of outgoing flavors, since the decay application is also done on
	the connected state.

	Infer stability from the particle properties, using the first row in the set
	of flavor states. For unstable particles, we look for decays,
	recursively, available from the process stack (if present).

	For the unstable particles, we have to check whether their masses
	match between the production and the decay. Fortunately, both
	versions are available for comparison.

	The optional [[var_list]] argument may override integral/error
	values for decay processes.
	<<Decays: decay root config: TBP>>=
	procedure :: connect => decay_root_config_connect
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_root_config_connect &
	(decay, process, model, process_stack, process_instance, var_list)
	class(decay_root_config_t), intent(out) :: decay
	type(process_t), intent(in), target :: process
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(process_instance_t), intent(in), optional, target :: process_instance
	type(var_list_t), intent(in), optional, target :: var_list
	end subroutine decay_root_config_connect
	<<Decays: procedures>>=
	recursive module subroutine decay_root_config_connect &
	(decay, process, model, process_stack, process_instance, var_list)
	class(decay_root_config_t), intent(out) :: decay
	type(process_t), intent(in), target :: process
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(process_instance_t), intent(in), optional, target :: process_instance
	type(var_list_t), intent(in), optional, target :: var_list
	type(connected_state_t), pointer :: connected_state
	type(interaction_t), pointer :: int
	type(flavor_t), dimension(:,:), allocatable :: flv
	logical, dimension(:), allocatable :: stable
	real(default), dimension(:), allocatable :: m_prod, m_dec
	integer :: i
	call decay%init (model, process%get_id (), process%get_n_terms ())
	do i = 1, size (decay%term_config)
	if (present (process_instance)) then
	connected_state => process_instance%get_connected_state_ptr (i)
	int => connected_state%get_matrix_int_ptr ()
	call int%get_flv_out (flv)
	else
	call process%get_term_flv_out (i, flv)
	end if
	allocate (m_prod (size (flv(:,1)%get_mass ())))
	m_prod = flv(:,1)%get_mass ()
	call flv%set_model (model)
	allocate (m_dec (size (flv(:,1)%get_mass ())))
	m_dec = flv(:,1)%get_mass ()
	allocate (stable (size (flv, 1)))
	stable = flv(:,1)%is_stable ()
	call check_masses ()
	call decay%init_term (i, flv, stable, model, process_stack, var_list)
	deallocate (flv, stable, m_prod, m_dec)
	end do
	decay%process => process
	contains
	subroutine check_masses ()
	integer :: i
	logical :: ok
	ok = .true.
	do i = 1, size (m_prod)
	if (.not. stable(i)) then
	if (.not. nearly_equal (m_prod(i), m_dec(i))) then
	write (msg_buffer, "(A,A,A)") "particle '", &
	char (flv(i,1)%get_name ()), "':"
	call msg_message
	write (msg_buffer, &
	"(2x,A,1x," // FMT_15 // ",3x,A,1x," // FMT_15 // ")") &
	"m_prod =", m_prod(i), "m_dec =", m_dec(i)
	call msg_message
	ok = .false.
	end if
	end if
	end do
	if (.not. ok) call msg_fatal &
	("Particle mass mismatch between production and decay")
	end subroutine check_masses
	end subroutine decay_root_config_connect

	@ %def decay_root_config_connect
	@ Recursively compute widths, errors, and branching ratios.
	<<Decays: decay root config: TBP>>=
	procedure :: compute => decay_root_config_compute
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_root_config_compute (decay)
	class(decay_root_config_t), intent(inout) :: decay
	end subroutine decay_root_config_compute
	<<Decays: procedures>>=
	recursive module subroutine decay_root_config_compute (decay)
	class(decay_root_config_t), intent(inout) :: decay
	integer :: i
	do i = 1, size (decay%term_config)
	call decay%term_config(i)%compute ()
	end do
	end subroutine decay_root_config_compute

	@ %def decay_root_config_compute
	@
	\subsection{Decay Root Instance}
	This is the common parent type for decay and decay root. The process instance
	points to the parent process. The model pointer is separate because particle
	settings may be updated w.r.t.\ the parent process object.
	<<Decays: types>>=
	type, abstract :: decay_gen_t
	private
	type(decay_term_t), dimension(:), allocatable :: term
	type(process_instance_t), pointer :: process_instance => null ()
	integer :: selected_mci = 0
	integer :: selected_term = 0
	contains
	<<Decays: decay gen: TBP>>
	end type decay_gen_t

	@ %def decay_gen_t
	@
	The decay root represents the parent process. When an event is generated, the
	generator selects the term to which the decay chain applies (if possible).

	The process instance is just a pointer.
	<<Decays: public>>=
	public :: decay_root_t
	<<Decays: types>>=
	type, extends (decay_gen_t) :: decay_root_t
	private
	type(decay_root_config_t), pointer :: config => null ()
	contains
	<<Decays: decay root: TBP>>
	end type decay_root_t

	@ %def decay_root_t
	@ The finalizer has to recursively finalize the terms, but we can skip the
	process instance which is not explicitly allocated.
	<<Decays: decay gen: TBP>>=
	procedure :: base_final => decay_gen_final
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_gen_final (object)
	class(decay_gen_t), intent(inout) :: object
	end subroutine decay_gen_final
	<<Decays: procedures>>=
	recursive module subroutine decay_gen_final (object)
	class(decay_gen_t), intent(inout) :: object
	integer :: i
	if (allocated (object%term)) then
	do i = 1, size (object%term)
	call object%term(i)%final ()
	end do
	end if
	end subroutine decay_gen_final

	@ %def decay_gen_final
	@ No extra finalization for the decay root.
	<<Decays: decay root: TBP>>=
	procedure :: final => decay_root_final
	<<Decays: sub interfaces>>=
	module subroutine decay_root_final (object)
	class(decay_root_t), intent(inout) :: object
	end subroutine decay_root_final
	<<Decays: procedures>>=
	module subroutine decay_root_final (object)
	class(decay_root_t), intent(inout) :: object
	call object%base_final ()
	end subroutine decay_root_final

	@ %def decay_gen_final
	@ Output.
	<<Decays: decay root: TBP>>=
	procedure :: write => decay_root_write
	<<Decays: sub interfaces>>=
	module subroutine decay_root_write (object, unit)
	class(decay_root_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine decay_root_write
	<<Decays: procedures>>=
	module subroutine decay_root_write (object, unit)
	class(decay_root_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%config)) then
	call object%config%write (unit, verbose = .false.)
	else
	write (u, "(1x,A)") "Final-state decay tree: [not configured]"
	end if
	if (object%selected_mci > 0) then
	write (u, "(3x,A,I0)") "Selected MCI = ", object%selected_mci
	else
	write (u, "(3x,A)") "Selected MCI = [undefined]"
	end if
	if (object%selected_term > 0) then
	write (u, "(3x,A,I0)") "Selected term = ", object%selected_term
	call object%term(object%selected_term)%write (u, 1)
	else
	write (u, "(3x,A)") "Selected term = [undefined]"
	end if
	end subroutine decay_root_write

	@ %def decay_root_write
	@ Write the process instances, recursively.
	<<Decays: decay gen: TBP>>=
	procedure :: write_process_instances => decay_gen_write_process_instances
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_gen_write_process_instances &
	(decay, unit, verbose)
	class(decay_gen_t), intent(in) :: decay
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine decay_gen_write_process_instances
	<<Decays: procedures>>=
	recursive module subroutine decay_gen_write_process_instances &
	(decay, unit, verbose)
	class(decay_gen_t), intent(in) :: decay
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical :: verb
	verb = .true.; if (present (verbose)) verb = verbose
	if (associated (decay%process_instance)) then
	if (verb) then
	call decay%process_instance%write (unit)
	else
	call decay%process_instance%write_header (unit)
	end if
	end if
	if (decay%selected_term > 0) then
	call decay%term(decay%selected_term)%write_process_instances (unit, verb)
	end if
	end subroutine decay_gen_write_process_instances

	@ %def decay_gen_write_process_instances
	@ Generic initializer. All can be done recursively.
	<<Decays: decay gen: TBP>>=
	procedure :: base_init => decay_gen_init
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_gen_init (decay, term_config)
	class(decay_gen_t), intent(out) :: decay
	type(decay_term_config_t), dimension(:), intent(in), target :: term_config
	end subroutine decay_gen_init
	<<Decays: procedures>>=
	recursive module subroutine decay_gen_init (decay, term_config)
	class(decay_gen_t), intent(out) :: decay
	type(decay_term_config_t), dimension(:), intent(in), target :: term_config
	integer :: i
	allocate (decay%term (size (term_config)))
	do i = 1, size (decay%term)
	call decay%term(i)%init (term_config(i))
	end do
	end subroutine decay_gen_init

	@ %def decay_gen_init
	@ Specific initializer. We assign the configuration object, which should
	correspond to a completely initialized decay configuration tree. We
	also connect to an existing process instance. Then, we recursively
	link the child interactions to the parent process.
	<<Decays: decay root: TBP>>=
	procedure :: init => decay_root_init
	<<Decays: sub interfaces>>=
	module subroutine decay_root_init (decay_root, config, process_instance)
	class(decay_root_t), intent(out) :: decay_root
	type(decay_root_config_t), intent(in), target :: config
	type(process_instance_t), intent(in), target :: process_instance
	end subroutine decay_root_init
	<<Decays: procedures>>=
	module subroutine decay_root_init (decay_root, config, process_instance)
	class(decay_root_t), intent(out) :: decay_root
	type(decay_root_config_t), intent(in), target :: config
	type(process_instance_t), intent(in), target :: process_instance
	call decay_root%base_init (config%term_config)
	decay_root%config => config
	decay_root%process_instance => process_instance
	call decay_root%make_term_rng (config%process)
	call decay_root%link_term_interactions ()
	end subroutine decay_root_init

	@ %def decay_root_init
	@ Explicitly set/get mci and term indices. (Used in unit test.)
	<<Decays: decay gen: TBP>>=
	procedure :: set_mci => decay_gen_set_mci
	procedure :: set_term => decay_gen_set_term
	procedure :: get_mci => decay_gen_get_mci
	procedure :: get_term => decay_gen_get_term
	<<Decays: sub interfaces>>=
	module subroutine decay_gen_set_mci (decay, i)
	class(decay_gen_t), intent(inout) :: decay
	integer, intent(in) :: i
	end subroutine decay_gen_set_mci
	module subroutine decay_gen_set_term (decay, i)
	class(decay_gen_t), intent(inout) :: decay
	integer, intent(in) :: i
	end subroutine decay_gen_set_term
	module function decay_gen_get_mci (decay) result (i)
	class(decay_gen_t), intent(inout) :: decay
	integer :: i
	end function decay_gen_get_mci
	module function decay_gen_get_term (decay) result (i)
	class(decay_gen_t), intent(inout) :: decay
	integer :: i
	end function decay_gen_get_term
	<<Decays: procedures>>=
	module subroutine decay_gen_set_mci (decay, i)
	class(decay_gen_t), intent(inout) :: decay
	integer, intent(in) :: i
	decay%selected_mci = i
	end subroutine decay_gen_set_mci

	module subroutine decay_gen_set_term (decay, i)
	class(decay_gen_t), intent(inout) :: decay
	integer, intent(in) :: i
	decay%selected_term = i
	end subroutine decay_gen_set_term

	module function decay_gen_get_mci (decay) result (i)
	class(decay_gen_t), intent(inout) :: decay
	integer :: i
	i = decay%selected_mci
	end function decay_gen_get_mci

	module function decay_gen_get_term (decay) result (i)
	class(decay_gen_t), intent(inout) :: decay
	integer :: i
	i = decay%selected_term
	end function decay_gen_get_term

	@ %def decay_gen_set_mci
	@ %def decay_gen_set_term
	@ %def decay_gen_get_mci
	@ %def decay_gen_get_term
	@ Implement random-number generators for unstable decay selection in
	all terms. This is not recursive.

	We also make use of the fact that [[process]] is a pointer; the (state
	of the RNG factory inside the) target process will be modified by the
	rng-spawning method, but not the pointer.
	<<Decays: decay gen: TBP>>=
	procedure :: make_term_rng => decay_gen_make_term_rng
	<<Decays: sub interfaces>>=
	module subroutine decay_gen_make_term_rng (decay, process)
	class(decay_gen_t), intent(inout) :: decay
	type(process_t), intent(in), pointer :: process
	end subroutine decay_gen_make_term_rng
	<<Decays: procedures>>=
	module subroutine decay_gen_make_term_rng (decay, process)
	class(decay_gen_t), intent(inout) :: decay
	type(process_t), intent(in), pointer :: process
	integer :: i
	do i = 1, size (decay%term)
	call decay%term(i)%make_rng (process)
	end do
	end subroutine decay_gen_make_term_rng

	@ %def decay_gen_make_term_rng
	@ Recursively link interactions of the enclosed decay terms to the
	corresponding terms in the current process instance.
	<<Decays: decay gen: TBP>>=
	procedure :: link_term_interactions => decay_gen_link_term_interactions
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_gen_link_term_interactions (decay)
	class(decay_gen_t), intent(inout) :: decay
	end subroutine decay_gen_link_term_interactions
	<<Decays: procedures>>=
	recursive module subroutine decay_gen_link_term_interactions (decay)
	class(decay_gen_t), intent(inout) :: decay
	integer :: i
	type(interaction_t), pointer :: trace
	associate (instance => decay%process_instance)
	do i = 1, size (decay%term)
	trace => instance%get_trace_int_ptr (i)
	call decay%term(i)%link_interactions (trace)
	end do
	end associate
	end subroutine decay_gen_link_term_interactions

	@ %def decay_gen_link_term_interactions
	@ Select a decay chain: decay modes and process components.
	<<Decays: decay root: TBP>>=
	procedure :: select_chain => decay_root_select_chain
	<<Decays: sub interfaces>>=
	module subroutine decay_root_select_chain (decay_root)
	class(decay_root_t), intent(inout) :: decay_root
	end subroutine decay_root_select_chain
	<<Decays: procedures>>=
	module subroutine decay_root_select_chain (decay_root)
	class(decay_root_t), intent(inout) :: decay_root
	if (decay_root%selected_term > 0) then
	call decay_root%term(decay_root%selected_term)%select_chain ()
	else
	call msg_bug ("Decays: no term selected for parent process")
	end if
	end subroutine decay_root_select_chain

	@ %def decay_root_select_chain
	@ Generate a decay tree, i.e., for the selected term in the parent
	process, recursively generate a decay event for all unstable
	particles.

	Factor out the trace of the connected state of the parent process.
	This trace should not be taken into account for unweighting the decay
	chain, since it was already used for unweighting the parent event, or
	it determines the overall event weight.
	<<Decays: decay root: TBP>>=
	procedure :: generate => decay_root_generate
	<<Decays: sub interfaces>>=
	module subroutine decay_root_generate (decay_root)
	class(decay_root_t), intent(inout) :: decay_root
	end subroutine decay_root_generate
	<<Decays: procedures>>=
	module subroutine decay_root_generate (decay_root)
	class(decay_root_t), intent(inout) :: decay_root
	type(connected_state_t), pointer :: connected_state
	if (decay_root%selected_term > 0) then
	connected_state => decay_root%process_instance%get_connected_state_ptr &
	(decay_root%selected_term)
	call connected_state%normalize_matrix_by_trace ()
	call decay_root%term(decay_root%selected_term)%generate ()
	else
	call msg_bug ("Decays: no term selected for parent process")
	end if
	end subroutine decay_root_generate

	@ %def decay_root_generate
	@
	\subsection{Decay Configuration}
	A decay configuration describes a distinct decay mode of a particle. Each
	decay mode may include several terms, which correspond to the terms in the
	associated process. In addition to the base type, the decay configuration
	object contains the integral of the parent process and the selector for the
	MCI group inside this process.

	The flavor component should be identical to the flavor component of the parent
	particle ([[unstable]] object).
	<<Decays: types>>=
	type, extends (decay_root_config_t) :: decay_config_t
	private
	type(flavor_t) :: flv
	real(default) :: weight = 0
	real(default) :: integral = 0
	real(default) :: abs_error = 0
	real(default) :: rel_error = 0
	type(selector_t) :: mci_selector
	contains
	<<Decays: decay config: TBP>>
	end type decay_config_t

	@ %def decay_config_t
	@ The output routine extends the decay-root writer by listing numerical
	component values.
	<<Decays: decay config: TBP>>=
	procedure :: write => decay_config_write
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_config_write &
	(object, unit, indent, verbose)
	class(decay_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	end subroutine decay_config_write
	<<Decays: procedures>>=
	recursive module subroutine decay_config_write (object, unit, indent, verbose)
	class(decay_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, ind)
	write (u, "(1x,A)") "Decay:"
	call object%write_header (unit, indent)
	call write_indent (u, ind)
	write (u, 2) "branching ratio =", object%weight * 100
	call write_indent (u, ind)
	write (u, 1) "partial width =", object%integral
	call write_indent (u, ind)
	write (u, 1) "error (abs) =", object%abs_error
	call write_indent (u, ind)
	write (u, 1) "error (rel) =", object%rel_error
	1 format (3x,A,ES19.12)
	2 format (3x,A,F11.6,1x,'%')
	call object%write_terms (unit, indent, verbose)
	end subroutine decay_config_write

	@ %def decay_config_write
	@ Connect a decay configuration with a process object (which should
	represent the decay). This includes initialization, therefore
	intent(out). We first connect the process itself, then do initializations
	that are specific for this decay.

	Infer stability from the particle properties, using the first row in the set
	of flavor states. Once we can deal with predetermined decay chains, they
	should be used instead.

	If there is an optional [[var_list]], check if the stored values for
	the decay partial width and error have been overridden there.
	<<Decays: decay config: TBP>>=
	procedure :: connect => decay_config_connect
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_config_connect &
	(decay, process, model, process_stack, process_instance, var_list)
	class(decay_config_t), intent(out) :: decay
	type(process_t), intent(in), target :: process
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(process_instance_t), intent(in), optional, target :: process_instance
	type(var_list_t), intent(in), optional, target :: var_list
	end subroutine decay_config_connect
	<<Decays: procedures>>=
	recursive module subroutine decay_config_connect &
	(decay, process, model, process_stack, process_instance, var_list)
	class(decay_config_t), intent(out) :: decay
	type(process_t), intent(in), target :: process
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(process_instance_t), intent(in), optional, target :: process_instance
	type(var_list_t), intent(in), optional, target :: var_list
	real(default), dimension(:), allocatable :: integral_mci
	type(string_t) :: process_id
	integer :: i, n_mci
	call decay%decay_root_config_t%connect &
	(process, model, process_stack, var_list=var_list)
	process_id = process%get_id ()
	if (process%lab_is_cm ()) then
	call msg_fatal ("Decay process " // char (process_id) &
	// ": unusable because rest frame is fixed.")
	end if
	decay%integral = process%get_integral ()
	decay%abs_error = process%get_error ()
	if (present (var_list)) then
	call update (decay%integral, "integral(" // process_id // ")")
	call update (decay%abs_error, "error(" // process_id // ")")
	end if
	n_mci = process%get_n_mci ()
	allocate (integral_mci (n_mci))
	do i = 1, n_mci
	integral_mci(i) = process%get_integral_mci (i)
	end do
	call decay%mci_selector%init (integral_mci)
	contains
	subroutine update (var, var_name)
	real(default), intent(inout) :: var
	type(string_t), intent(in) :: var_name
	if (var_list%contains (var_name)) then
	var = var_list%get_rval (var_name)
	end if
	end subroutine update
	end subroutine decay_config_connect

	@ %def decay_config_connect
	@ Set the flavor entry, which repeats the flavor of the parent unstable
	particle.
	<<Decays: decay config: TBP>>=
	procedure :: set_flv => decay_config_set_flv
	<<Decays: sub interfaces>>=
	module subroutine decay_config_set_flv (decay, flv)
	class(decay_config_t), intent(inout) :: decay
	type(flavor_t), intent(in) :: flv
	end subroutine decay_config_set_flv
	<<Decays: procedures>>=
	module subroutine decay_config_set_flv (decay, flv)
	class(decay_config_t), intent(inout) :: decay
	type(flavor_t), intent(in) :: flv
	decay%flv = flv
	end subroutine decay_config_set_flv

	@ %def decay_config_set_flv
	@ Compute embedded branchings and the relative error. This method does not
	apply to the decay root.
	<<Decays: decay config: TBP>>=
	procedure :: compute => decay_config_compute
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_config_compute (decay)
	class(decay_config_t), intent(inout) :: decay
	end subroutine decay_config_compute
	<<Decays: procedures>>=
	recursive module subroutine decay_config_compute (decay)
	class(decay_config_t), intent(inout) :: decay
	call decay%decay_root_config_t%compute ()
	if (.not. vanishes (decay%integral)) then
	decay%rel_error = decay%abs_error / decay%integral
	else
	decay%rel_error = 0
	end if
	end subroutine decay_config_compute

	@ %def decay_config_compute
	@
	\subsection{Decay Instance}
	The decay contains a collection of terms. One of them is selected when the
	decay is evaluated. This is similar to the decay root, but we implement it
	independently.

	The process instance object is allocated via a pointer, so it automatically
	behaves as a target.
	<<Decays: types>>=
	type, extends (decay_gen_t) :: decay_t
	private
	type(decay_config_t), pointer :: config => null ()
	class(rng_t), allocatable :: rng
	contains
	<<Decays: decay: TBP>>
	end type decay_t

	@ %def decay_t
	@ The finalizer is recursive.
	<<Decays: decay: TBP>>=
	procedure :: final => decay_final
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_final (object)
	class(decay_t), intent(inout) :: object
	end subroutine decay_final
	<<Decays: procedures>>=
	recursive module subroutine decay_final (object)
	class(decay_t), intent(inout) :: object
	integer :: i
	call object%base_final ()
	do i = 1, object%config%process%get_n_mci ()
	call object%process_instance%final_simulation (i)
	end do
	call object%process_instance%final ()
	deallocate (object%process_instance)
	end subroutine decay_final

	@ %def decay_final
	@ Output.
	<<Decays: decay: TBP>>=
	procedure :: write => decay_write
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_write (object, unit, indent, recursive)
	class(decay_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent, recursive
	end subroutine decay_write
	<<Decays: procedures>>=
	recursive module subroutine decay_write (object, unit, indent, recursive)
	class(decay_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent, recursive
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call object%config%write (unit, indent, verbose = .false.)
	if (allocated (object%rng)) then
	call object%rng%write (u, ind + 1)
	end if
	call write_indent (u, ind)
	if (object%selected_mci > 0) then
	write (u, "(3x,A,I0)") "Selected MCI = ", object%selected_mci
	else
	write (u, "(3x,A)") "Selected MCI = [undefined]"
	end if
	call write_indent (u, ind)
	if (object%selected_term > 0) then
	write (u, "(3x,A,I0)") "Selected term = ", object%selected_term
	call object%term(object%selected_term)%write (u, ind + 1)
	else
	write (u, "(3x,A)") "Selected term = [undefined]"
	end if
	end subroutine decay_write

	@ %def decay_write
	@ Initializer. Base initialization is done recursively. Then, we
	prepare the current process instance and allocate a random-number
	generator for term selection. For all unstable particles, we also
	allocate a r.n.g. as spawned by the current process.
	<<Decays: decay: TBP>>=
	procedure :: init => decay_init
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_init (decay, config)
	class(decay_t), intent(out) :: decay
	type(decay_config_t), intent(in), target :: config
	end subroutine decay_init
	<<Decays: procedures>>=
	recursive module subroutine decay_init (decay, config)
	class(decay_t), intent(out) :: decay
	type(decay_config_t), intent(in), target :: config
	integer :: i
	call decay%base_init (config%term_config)
	decay%config => config
	allocate (decay%process_instance)
	call decay%process_instance%init (decay%config%process)
	call decay%process_instance%setup_event_data (decay%config%model)
	do i = 1, decay%config%process%get_n_mci ()
	call decay%process_instance%init_simulation (i)
	end do
	call decay%config%process%make_rng (decay%rng)
	call decay%make_term_rng (decay%config%process)
	end subroutine decay_init

	@ %def decay_init
	@ Link interactions to the parent process. [[i_prt]] is the index of
	the current outgoing particle in the parent interaction, for which we
	take the trace evaluator. We link it to the beam particle in the beam
	interaction of the decay process instance. Then, repeat the procedure
	for the outgoing particles.
	<<Decays: decay: TBP>>=
	procedure :: link_interactions => decay_link_interactions
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_link_interactions (decay, i_prt, trace)
	class(decay_t), intent(inout) :: decay
	integer, intent(in) :: i_prt
	type(interaction_t), intent(in), target :: trace
	end subroutine decay_link_interactions
	<<Decays: procedures>>=
	recursive module subroutine decay_link_interactions (decay, i_prt, trace)
	class(decay_t), intent(inout) :: decay
	integer, intent(in) :: i_prt
	type(interaction_t), intent(in), target :: trace
	type(interaction_t), pointer :: beam_int
	integer :: n_in, n_vir
	beam_int => decay%process_instance%get_beam_int_ptr ()
	n_in = trace%get_n_in ()
	n_vir = trace%get_n_vir ()
	call beam_int%set_source_link (1, trace, &
	n_in + n_vir + i_prt)
	call decay%link_term_interactions ()
	end subroutine decay_link_interactions

	@ %def decay_link_interactions
	@ Determine a decay chain. For each unstable particle we select one
	of the possible decay modes, and for each decay process we select one
	of the possible decay MCI components, calling the random-number
	generators. We do not generate momenta, yet.
	<<Decays: decay: TBP>>=
	procedure :: select_chain => decay_select_chain
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_select_chain (decay)
	class(decay_t), intent(inout) :: decay
	end subroutine decay_select_chain
	<<Decays: procedures>>=
	recursive module subroutine decay_select_chain (decay)
	class(decay_t), intent(inout) :: decay
	real(default) :: x
	integer :: i
	call decay%rng%generate (x)
	decay%selected_mci = decay%config%mci_selector%select (x)
	call decay%process_instance%choose_mci (decay%selected_mci)
	decay%selected_term = decay%process_instance%select_i_term ()
	do i = 1, size (decay%term)
	call decay%term(i)%select_chain ()
	end do
	end subroutine decay_select_chain

	@ %def decay_select_chain
	@ Generate a decay. We first receive the beam momenta from the parent
	process (assuming that this is properly linked), then call the
	associated process object for a new event.

	Factor out the trace of the helicity density matrix of the isolated
	state (the one that will be used for the decay chain). The trace is
	taken into account for unweighting the individual decay event and
	should therefore be ignored for unweighting the correlated decay
	chain afterwards.
	<<Decays: decay: TBP>>=
	procedure :: generate => decay_generate
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_generate (decay)
	class(decay_t), intent(inout) :: decay
	end subroutine decay_generate
	<<Decays: procedures>>=
	recursive module subroutine decay_generate (decay)
	class(decay_t), intent(inout) :: decay
	type(isolated_state_t), pointer :: isolated_state
	integer :: i
	call decay%process_instance%receive_beam_momenta ()
	call decay%process_instance%generate_unweighted_event (decay%selected_mci)
	if (signal_is_pending ()) return
	call decay%process_instance%evaluate_event_data ()
	isolated_state => &
	decay%process_instance%get_isolated_state_ptr (decay%selected_term)
	call isolated_state%normalize_matrix_by_trace ()
	do i = 1, size (decay%term)
	call decay%term(i)%generate ()
	if (signal_is_pending ()) return
	end do
	end subroutine decay_generate

	@ %def decay_generate
	@
	\subsection{Stable Particles}
	This is a stable particle. The flavor can be ambiguous (e.g., partons).
	<<Decays: types>>=
	type, extends (any_config_t) :: stable_config_t
	private
	type(flavor_t), dimension(:), allocatable :: flv
	contains
	<<Decays: stable config: TBP>>
	end type stable_config_t

	@ %def stable_config_t
	@ The finalizer is empty:
	<<Decays: stable config: TBP>>=
	procedure :: final => stable_config_final
	<<Decays: sub interfaces>>=
	module subroutine stable_config_final (object)
	class(stable_config_t), intent(inout) :: object
	end subroutine stable_config_final
	<<Decays: procedures>>=
	module subroutine stable_config_final (object)
	class(stable_config_t), intent(inout) :: object
	end subroutine stable_config_final

	@ %def stable_config_final
	@ Output.
	<<Decays: stable config: TBP>>=
	procedure :: write => stable_config_write
	<<Decays: sub interfaces>>=
	recursive module subroutine stable_config_write &
	(object, unit, indent, verbose)
	class(stable_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	end subroutine stable_config_write
	<<Decays: procedures>>=
	recursive module subroutine stable_config_write &
	(object, unit, indent, verbose)
	class(stable_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	integer :: u, i, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, ind)
	write (u, "(1x,'+',1x,A)", advance = "no") "Stable:"
	write (u, "(1x,A)", advance = "no") char (object%flv(1)%get_name ())
	do i = 2, size (object%flv)
	write (u, "(':',A)", advance = "no") &
	char (object%flv(i)%get_name ())
	end do
	write (u, *)
	end subroutine stable_config_write

	@ %def stable_config_write
	@ Initializer. We are presented with an array of flavors, but there may be
	double entries which we remove, so we store only the distinct flavors.
	<<Decays: stable config: TBP>>=
	procedure :: init => stable_config_init
	<<Decays: sub interfaces>>=
	module subroutine stable_config_init (config, flv)
	class(stable_config_t), intent(out) :: config
	type(flavor_t), dimension(:), intent(in) :: flv
	end subroutine stable_config_init
	<<Decays: procedures>>=
	module subroutine stable_config_init (config, flv)
	class(stable_config_t), intent(out) :: config
	type(flavor_t), dimension(:), intent(in) :: flv
	integer, dimension (size (flv)) :: pdg
	logical, dimension (size (flv)) :: mask
	integer :: i
	pdg = flv%get_pdg ()
	mask(1) = .true.
	forall (i = 2 : size (pdg))
	mask(i) = all (pdg(i) /= pdg(1:i-1))
	end forall
	allocate (config%flv (count (mask)))
	config%flv = pack (flv, mask)
	end subroutine stable_config_init

	@ %def stable_config_init
	@ Here is the corresponding object instance. Except for the pointer
	to the configuration, there is no content.
	<<Decays: types>>=
	type, extends (any_t) :: stable_t
	private
	type(stable_config_t), pointer :: config => null ()
	contains
	<<Decays: stable: TBP>>
	end type stable_t

	@ %def stable_t
	@ The finalizer does nothing.
	<<Decays: stable: TBP>>=
	procedure :: final => stable_final
	<<Decays: sub interfaces>>=
	module subroutine stable_final (object)
	class(stable_t), intent(inout) :: object
	end subroutine stable_final
	<<Decays: procedures>>=
	module subroutine stable_final (object)
	class(stable_t), intent(inout) :: object
	end subroutine stable_final

	@ %def stable_final
	@ We can delegate output to the configuration object.
	<<Decays: stable: TBP>>=
	procedure :: write => stable_write
	<<Decays: sub interfaces>>=
	module subroutine stable_write (object, unit, indent)
	class(stable_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	end subroutine stable_write
	<<Decays: procedures>>=
	module subroutine stable_write (object, unit, indent)
	class(stable_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	call object%config%write (unit, indent)
	end subroutine stable_write

	@ %def stable_write
	@ Initializer: just assign the configuration.
	<<Decays: stable: TBP>>=
	procedure :: init => stable_init
	<<Decays: sub interfaces>>=
	module subroutine stable_init (stable, config)
	class(stable_t), intent(out) :: stable
	type(stable_config_t), intent(in), target :: config
	end subroutine stable_init
	<<Decays: procedures>>=
	module subroutine stable_init (stable, config)
	class(stable_t), intent(out) :: stable
	type(stable_config_t), intent(in), target :: config
	stable%config => config
	end subroutine stable_init

	@ %def stable_init
	@
	\subsection{Unstable Particles}
	A branching configuration enables us to select among distinct decay
	modes of a particle. We store the particle flavor (with its implicit
	link to a model), an array of decay configurations, and a selector object.

	The total width, absolute and relative error are stored as
	[[integral]], [[abs_error]], and [[rel_error]], respectively.

	The flavor must be unique in this case.
	<<Decays: public>>=
	public :: unstable_config_t
	<<Decays: types>>=
	type, extends (any_config_t) :: unstable_config_t
	private
	type(flavor_t) :: flv
	real(default) :: integral = 0
	real(default) :: abs_error = 0
	real(default) :: rel_error = 0
	type(selector_t) :: selector
	type(decay_config_t), dimension(:), allocatable :: decay_config
	contains
	<<Decays: unstable config: TBP>>
	end type unstable_config_t

	@ %def unstable_config_t
	@ Finalizer. The branching configuration can be a recursive structure.
	<<Decays: unstable config: TBP>>=
	procedure :: final => unstable_config_final
	<<Decays: sub interfaces>>=
	recursive module subroutine unstable_config_final (object)
	class(unstable_config_t), intent(inout) :: object
	end subroutine unstable_config_final
	<<Decays: procedures>>=
	recursive module subroutine unstable_config_final (object)
	class(unstable_config_t), intent(inout) :: object
	integer :: i
	if (allocated (object%decay_config)) then
	do i = 1, size (object%decay_config)
	call object%decay_config(i)%final ()
	end do
	end if
	end subroutine unstable_config_final

	@ %def unstable_config_final
	@ Output. Since this may be recursive, we include indentation.
	<<Decays: unstable config: TBP>>=
	procedure :: write => unstable_config_write
	<<Decays: sub interfaces>>=
	recursive module subroutine unstable_config_write &
	(object, unit, indent, verbose)
	class(unstable_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	end subroutine unstable_config_write
	<<Decays: procedures>>=
	recursive module subroutine unstable_config_write &
	(object, unit, indent, verbose)
	class(unstable_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	integer :: u, i, ind
	logical :: verb
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	verb = .true.; if (present (verbose)) verb = verbose
	call write_indent (u, ind)
	write (u, "(1x,'+',1x,A,1x,A)") "Unstable:", &
	char (object%flv%get_name ())
	call write_indent (u, ind)
	write (u, 1) "total width =", object%integral
	call write_indent (u, ind)
	write (u, 1) "error (abs) =", object%abs_error
	call write_indent (u, ind)
	write (u, 1) "error (rel) =", object%rel_error
	1 format (5x,A,ES19.12)
	if (verb .and. allocated (object%decay_config)) then
	do i = 1, size (object%decay_config)
	call object%decay_config(i)%write (u, ind + 1)
	end do
	end if
	end subroutine unstable_config_write

	@ %def unstable_config_write
	@ Initializer. For the unstable particle, the flavor is unique.
	<<Decays: unstable config: TBP>>=
	procedure :: init => unstable_config_init
	<<Decays: sub interfaces>>=
	module subroutine unstable_config_init (unstable, flv, set_decays, model)
	class(unstable_config_t), intent(out) :: unstable
	type(flavor_t), intent(in) :: flv
	logical, intent(in), optional :: set_decays
	class(model_data_t), intent(in), optional, target :: model
	end subroutine unstable_config_init
	<<Decays: procedures>>=
	module subroutine unstable_config_init (unstable, flv, set_decays, model)
	class(unstable_config_t), intent(out) :: unstable
	type(flavor_t), intent(in) :: flv
	logical, intent(in), optional :: set_decays
	class(model_data_t), intent(in), optional, target :: model
	type(string_t), dimension(:), allocatable :: decay
	unstable%flv = flv
	if (present (set_decays)) then
	call unstable%flv%get_decays (decay)
	call unstable%init_decays (decay, model)
	end if
	end subroutine unstable_config_init

	@ %def unstable_config_init
	@ Further initialization: determine the number of decay modes. We can assume
	that the flavor of the particle has been set already.

	If the process stack is given, we can delve recursively into actually
	assigning decay processes. Otherwise, we just initialize with decay
	process names.
	<<Decays: unstable config: TBP>>=
	procedure :: init_decays => unstable_config_init_decays
	<<Decays: sub interfaces>>=
	recursive module subroutine unstable_config_init_decays &
	(unstable, decay_id, model, process_stack, var_list)
	class(unstable_config_t), intent(inout) :: unstable
	type(string_t), dimension(:), intent(in) :: decay_id
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(var_list_t), intent(in), optional :: var_list
	end subroutine unstable_config_init_decays
	<<Decays: procedures>>=
	recursive module subroutine unstable_config_init_decays &
	(unstable, decay_id, model, process_stack, var_list)
	class(unstable_config_t), intent(inout) :: unstable
	type(string_t), dimension(:), intent(in) :: decay_id
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(var_list_t), intent(in), optional :: var_list
	integer :: i
	allocate (unstable%decay_config (size (decay_id)))
	do i = 1, size (decay_id)
	associate (decay => unstable%decay_config(i))
	if (present (process_stack)) then
	call decay%connect (process_stack%get_process_ptr (decay_id(i)), &
	model, process_stack, var_list=var_list)
	else
	call decay%init (model, decay_id(i))
	end if
	call decay%set_flv (unstable%flv)
	end associate
	end do
	end subroutine unstable_config_init_decays

	@ %def unstable_config_init_decays
	@ Explicitly connect a specific decay with a process. This is used only in
	unit tests.
	<<Decays: unstable config: TBP>>=
	procedure :: connect_decay => unstable_config_connect_decay
	<<Decays: sub interfaces>>=
	module subroutine unstable_config_connect_decay &
	(unstable, i, process, model)
	class(unstable_config_t), intent(inout) :: unstable
	integer, intent(in) :: i
	type(process_t), intent(in), target :: process
	class(model_data_t), intent(in), target :: model
	end subroutine unstable_config_connect_decay
	<<Decays: procedures>>=
	module subroutine unstable_config_connect_decay (unstable, i, process, model)
	class(unstable_config_t), intent(inout) :: unstable
	integer, intent(in) :: i
	type(process_t), intent(in), target :: process
	class(model_data_t), intent(in), target :: model
	associate (decay => unstable%decay_config(i))
	call decay%connect (process, model)
	end associate
	end subroutine unstable_config_connect_decay

	@ %def unstable_config_connect_decay
	@ Compute the total width and branching ratios, initializing the decay
	selector.
	<<Decays: unstable config: TBP>>=
	procedure :: compute => unstable_config_compute
	<<Decays: sub interfaces>>=
	recursive module subroutine unstable_config_compute (unstable)
	class(unstable_config_t), intent(inout) :: unstable
	end subroutine unstable_config_compute
	<<Decays: procedures>>=
	recursive module subroutine unstable_config_compute (unstable)
	class(unstable_config_t), intent(inout) :: unstable
	integer :: i
	do i = 1, size (unstable%decay_config)
	call unstable%decay_config(i)%compute ()
	end do
	unstable%integral = sum (unstable%decay_config%integral)
	if (unstable%integral <= 0) then
	call unstable%write ()
	call msg_fatal ("Decay configuration: computed total width is zero")
	end if
	unstable%abs_error = sqrt (sum (unstable%decay_config%abs_error ** 2))
	unstable%rel_error = unstable%abs_error / unstable%integral
	call unstable%selector%init (unstable%decay_config%integral)
	do i = 1, size (unstable%decay_config)
	unstable%decay_config(i)%weight &
	= unstable%selector%get_weight (i)
	end do
	end subroutine unstable_config_compute

	@ %def unstable_config_compute
	@
	Now we define the instance of an unstable particle.
	<<Decays: public>>=
	public :: unstable_t
	<<Decays: types>>=
	type, extends (any_t) :: unstable_t
	private
	type(unstable_config_t), pointer :: config => null ()
	class(rng_t), allocatable :: rng
	integer :: selected_decay = 0
	type(decay_t), dimension(:), allocatable :: decay
	contains
	<<Decays: unstable: TBP>>
	end type unstable_t

	@ %def unstable_t
	@ Recursive finalizer.
	<<Decays: unstable: TBP>>=
	procedure :: final => unstable_final
	<<Decays: sub interfaces>>=
	recursive module subroutine unstable_final (object)
	class(unstable_t), intent(inout) :: object
	end subroutine unstable_final
	<<Decays: procedures>>=
	recursive module subroutine unstable_final (object)
	class(unstable_t), intent(inout) :: object
	integer :: i
	if (allocated (object%decay)) then
	do i = 1, size (object%decay)
	call object%decay(i)%final ()
	end do
	end if
	end subroutine unstable_final

	@ %def unstable_final
	@ Output.
	<<Decays: unstable: TBP>>=
	procedure :: write => unstable_write
	<<Decays: sub interfaces>>=
	recursive module subroutine unstable_write (object, unit, indent)
	class(unstable_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	end subroutine unstable_write
	<<Decays: procedures>>=
	recursive module subroutine unstable_write (object, unit, indent)
	class(unstable_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call object%config%write (u, ind, verbose=.false.)
	if (allocated (object%rng)) then
	call object%rng%write (u, ind + 2)
	end if
	call write_indent (u, ind)
	if (object%selected_decay > 0) then
	write (u, "(5x,A,I0)") "Sel. decay = ", object%selected_decay
	call object%decay(object%selected_decay)%write (u, ind + 1)
	else
	write (u, "(5x,A)") "Sel. decay = [undefined]"
	end if
	end subroutine unstable_write

	@ %def unstable_write
	@ Write the embedded process instances.
	<<Decays: unstable: TBP>>=
	procedure :: write_process_instances => unstable_write_process_instances
	<<Decays: sub interfaces>>=
	recursive module subroutine unstable_write_process_instances &
	(unstable, unit, verbose)
	class(unstable_t), intent(in) :: unstable
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine unstable_write_process_instances
	<<Decays: procedures>>=
	recursive module subroutine unstable_write_process_instances &
	(unstable, unit, verbose)
	class(unstable_t), intent(in) :: unstable
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	if (unstable%selected_decay > 0) then
	call unstable%decay(unstable%selected_decay)% &
	write_process_instances (unit, verbose)
	end if
	end subroutine unstable_write_process_instances

	@ %def unstable_write_process_instances
	@ Initialization, using the configuration object.
	<<Decays: unstable: TBP>>=
	procedure :: init => unstable_init
	<<Decays: sub interfaces>>=
	recursive module subroutine unstable_init (unstable, config)
	class(unstable_t), intent(out) :: unstable
	type(unstable_config_t), intent(in), target :: config
	end subroutine unstable_init
	<<Decays: procedures>>=
	recursive module subroutine unstable_init (unstable, config)
	class(unstable_t), intent(out) :: unstable
	type(unstable_config_t), intent(in), target :: config
	integer :: i
	unstable%config => config
	allocate (unstable%decay (size (config%decay_config)))
	do i = 1, size (config%decay_config)
	call unstable%decay(i)%init (config%decay_config(i))
	end do
	end subroutine unstable_init

	@ %def unstable_init
	@ Recursively link interactions to the parent process. [[i_prt]] is
	the index of the current outgoing particle in the parent interaction.
	<<Decays: unstable: TBP>>=
	procedure :: link_interactions => unstable_link_interactions
	<<Decays: sub interfaces>>=
	recursive module subroutine unstable_link_interactions &
	(unstable, i_prt, trace)
	class(unstable_t), intent(inout) :: unstable
	integer, intent(in) :: i_prt
	type(interaction_t), intent(in), target :: trace
	end subroutine unstable_link_interactions
	<<Decays: procedures>>=
	recursive module subroutine unstable_link_interactions &
	(unstable, i_prt, trace)
	class(unstable_t), intent(inout) :: unstable
	integer, intent(in) :: i_prt
	type(interaction_t), intent(in), target :: trace
	integer :: i
	do i = 1, size (unstable%decay)
	call unstable%decay(i)%link_interactions (i_prt, trace)
	end do
	end subroutine unstable_link_interactions

	@ %def unstable_link_interactions
	@ Import the random-number generator state.
	<<Decays: unstable: TBP>>=
	procedure :: import_rng => unstable_import_rng
	<<Decays: sub interfaces>>=
	module subroutine unstable_import_rng (unstable, rng)
	class(unstable_t), intent(inout) :: unstable
	class(rng_t), intent(inout), allocatable :: rng
	end subroutine unstable_import_rng
	<<Decays: procedures>>=
	module subroutine unstable_import_rng (unstable, rng)
	class(unstable_t), intent(inout) :: unstable
	class(rng_t), intent(inout), allocatable :: rng
	call move_alloc (from = rng, to = unstable%rng)
	end subroutine unstable_import_rng

	@ %def unstable_import_rng
	@ Generate a decay chain. First select a decay mode, then call the
	[[select_chain]] method of the selected mode.
	<<Decays: unstable: TBP>>=
	procedure :: select_chain => unstable_select_chain
	<<Decays: sub interfaces>>=
	recursive module subroutine unstable_select_chain (unstable)
	class(unstable_t), intent(inout) :: unstable
	end subroutine unstable_select_chain
	<<Decays: procedures>>=
	recursive module subroutine unstable_select_chain (unstable)
	class(unstable_t), intent(inout) :: unstable
	real(default) :: x
	call unstable%rng%generate (x)
	unstable%selected_decay = unstable%config%selector%select (x)
	call unstable%decay(unstable%selected_decay)%select_chain ()
	end subroutine unstable_select_chain

	@ %def unstable_select_chain
	@ Generate a decay event.
	<<Decays: unstable: TBP>>=
	procedure :: generate => unstable_generate
	<<Decays: sub interfaces>>=
	recursive module subroutine unstable_generate (unstable)
	class(unstable_t), intent(inout) :: unstable
	end subroutine unstable_generate
	<<Decays: procedures>>=
	recursive module subroutine unstable_generate (unstable)
	class(unstable_t), intent(inout) :: unstable
	call unstable%decay(unstable%selected_decay)%generate ()
	end subroutine unstable_generate

	@ %def unstable_generate
	@
	\subsection{Decay Chain}
	While the decay configuration tree and the decay tree are static
	entities (during a simulation run), the decay chain is dynamically
	generated for each event. The reason is that with the possibility of
	several decay modes for each particle, and several terms for each
	process, the total number of distinct decay chains is not under control.

	Each entry in the decay chain is a connected parton state. The origin
	of the chain is a connected state in the parent process (not part of
	the chain itself). For each decay, mode and term chosen, we convolute
	this with the isolated (!) state of the current decay, to generate a
	new connected state. We accumulate this chain by recursively
	traversing the allocated decay tree. Whenever a particle decays, it
	becomes virtual and is replaced by its decay product, while all other
	particles stay in the parton state as spectators.

	Technically, we implement the decay chain as a stack structure and
	include information from the associated decay object for easier
	debugging. This is a decay chain entry:
	<<Decays: types>>=
	type, extends (connected_state_t) :: decay_chain_entry_t
	private
	integer :: index = 0
	type(decay_config_t), pointer :: config => null ()
	integer :: selected_mci = 0
	integer :: selected_term = 0
	type(decay_chain_entry_t), pointer :: previous => null ()
	end type decay_chain_entry_t

	@ %def decay_chain_entry_t
	@ This is the complete chain; we need just a pointer to the last
	entry. We also include a pointer to the master process instance,
	which serves as the seed for the decay chain.

	The evaluator [[correlated_trace]] traces over all quantum numbers
	for the final spin-correlated (but color-summed) evaluator of the
	decay chain. This allows us to compute the probability for a momentum
	configuration, given that all individual density matrices (of the
	initial process and the subsequent decays) have been normalized to one.

	Note: This trace is summed over color, so color is treated exactly
	when computing spin correlations. However, we do not keep
	non-diagonal color correlations. When an event is accepted, we
	compute probabilities for all color states and can choose one of them.
	<<Decays: public>>=
	public :: decay_chain_t
	<<Decays: types>>=
	type :: decay_chain_t
	private
	type(process_instance_t), pointer :: process_instance => null ()
	integer :: selected_term = 0
	type(evaluator_t) :: correlated_trace
	type(decay_chain_entry_t), pointer :: last => null ()
	contains
	<<Decays: decay chain: TBP>>
	end type decay_chain_t

	@ %def decay_chain_t
	@ The finalizer recursively deletes and deallocates the entries.
	<<Decays: decay chain: TBP>>=
	procedure :: final => decay_chain_final
	<<Decays: sub interfaces>>=
	module subroutine decay_chain_final (object)
	class(decay_chain_t), intent(inout) :: object
	end subroutine decay_chain_final
	<<Decays: procedures>>=
	module subroutine decay_chain_final (object)
	class(decay_chain_t), intent(inout) :: object
	type(decay_chain_entry_t), pointer :: entry
	do while (associated (object%last))
	entry => object%last
	object%last => entry%previous
	call entry%final ()
	deallocate (entry)
	end do
	call object%correlated_trace%final ()
	end subroutine decay_chain_final

	@ %def decay_chain_final
	@ Doing output recursively allows us to display the chain in
	chronological order.
	<<Decays: decay chain: TBP>>=
	procedure :: write => decay_chain_write
	<<Decays: sub interfaces>>=
	module subroutine decay_chain_write (object, unit)
	class(decay_chain_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine decay_chain_write
	<<Decays: procedures>>=
	module subroutine decay_chain_write (object, unit)
	class(decay_chain_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	write (u, "(1x,A)") "Decay chain:"
	call write_entries (object%last)
	call write_separator (u, 2)
	write (u, "(1x,A)") "Evaluator (correlated trace of the decay chain):"
	call write_separator (u)
	call object%correlated_trace%write (u)
	call write_separator (u, 2)
	contains
	recursive subroutine write_entries (entry)
	type(decay_chain_entry_t), intent(in), pointer :: entry
	if (associated (entry)) then
	call write_entries (entry%previous)
	call write_separator (u, 2)
	write (u, "(1x,A,I0)") "Decay #", entry%index
	call entry%config%write_header (u)
	write (u, "(3x,A,I0)") "Selected MCI = ", entry%selected_mci
	write (u, "(3x,A,I0)") "Selected term = ", entry%selected_term
	call entry%config%term_config(entry%selected_term)%write (u, indent=1)
	call entry%write (u)
	end if
	end subroutine write_entries
	end subroutine decay_chain_write

	@ %def decay_chain_write
	@
	Build a decay chain, recursively following the selected decays and
	terms in a decay tree. Before start, we finalize the chain, deleting
	any previous contents.
	<<Decays: decay chain: TBP>>=
	procedure :: build => decay_chain_build
	<<Decays: sub interfaces>>=
	module subroutine decay_chain_build (chain, decay_root)
	class(decay_chain_t), intent(inout), target :: chain
	type(decay_root_t), intent(in) :: decay_root
	end subroutine decay_chain_build
	<<Decays: procedures>>=
	module subroutine decay_chain_build (chain, decay_root)
	class(decay_chain_t), intent(inout), target :: chain
	type(decay_root_t), intent(in) :: decay_root
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
	type(interaction_t), pointer :: int_last_decay
	call chain%final ()
	if (decay_root%selected_term > 0) then
	chain%process_instance => decay_root%process_instance
	chain%selected_term = decay_root%selected_term
	call chain%build_term_entries (decay_root%term(decay_root%selected_term))
	end if
	int_last_decay => chain%last%get_matrix_int_ptr ()
	allocate (qn_mask (int_last_decay%get_n_tot ()))
	call qn_mask%init (mask_f = .true., mask_c = .true., mask_h = .true.)
	call chain%correlated_trace%init_qn_sum (int_last_decay, qn_mask)
	end subroutine decay_chain_build

	@ %def decay_chain_build
	@ Build the entries that correspond to a decay term. We have to scan
	all unstable particles.
	<<Decays: decay chain: TBP>>=
	procedure :: build_term_entries => decay_chain_build_term_entries
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_chain_build_term_entries (chain, term)
	class(decay_chain_t), intent(inout) :: chain
	type(decay_term_t), intent(in) :: term
	end subroutine decay_chain_build_term_entries
	<<Decays: procedures>>=
	recursive module subroutine decay_chain_build_term_entries (chain, term)
	class(decay_chain_t), intent(inout) :: chain
	type(decay_term_t), intent(in) :: term
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	if (unstable%selected_decay > 0) then
	call chain%build_decay_entries &
	(unstable%decay(unstable%selected_decay))
	end if
	end select
	end do
	end subroutine decay_chain_build_term_entries

	@ %def decay_chain_build_term_entries
	@ Build the entries that correspond to a specific decay. The
	decay term should have been determined, so we allocate a decay chain
	entry and fill it, then proceed to child decays.

	For the first entry, we convolute the connected state of the parent process
	instance with the isolated state of the current
	decay (which does not contain an extra beam entry for the parent).
	For subsequent entries, we take the previous entry as first factor.

	In principle, each chain entry (as a parton state) is capable of
	holding a subevent object and associated expressions. We currently do
	not make use of that feature.

	Before generating the decays, factor out the trace of the helicity
	density matrix of the parent parton state. This trace has
	been used for unweighting the original event (unweighted case) or it
	determines the overall weight, so it should not be taken into account
	in the decay chain generation.
	<<Decays: decay chain: TBP>>=
	procedure :: build_decay_entries => decay_chain_build_decay_entries
	<<Decays: sub interfaces>>=
	recursive module subroutine decay_chain_build_decay_entries (chain, decay)
	class(decay_chain_t), intent(inout) :: chain
	type(decay_t), intent(in) :: decay
	end subroutine decay_chain_build_decay_entries
	<<Decays: procedures>>=
	recursive module subroutine decay_chain_build_decay_entries (chain, decay)
	class(decay_chain_t), intent(inout) :: chain
	type(decay_t), intent(in) :: decay
	type(decay_chain_entry_t), pointer :: entry
	type(connected_state_t), pointer :: previous_state
	type(isolated_state_t), pointer :: current_decay
	type(helicity_t) :: hel
	type(quantum_numbers_t) :: qn_filter_conn
	allocate (entry)
	if (associated (chain%last)) then
	entry%previous => chain%last
	entry%index = entry%previous%index + 1
	previous_state => entry%previous%connected_state_t
	else
	entry%index = 1
	previous_state => &
	chain%process_instance%get_connected_state_ptr (chain%selected_term)
	end if
	entry%config => decay%config
	entry%selected_mci = decay%selected_mci
	entry%selected_term = decay%selected_term
	current_decay => decay%process_instance%get_isolated_state_ptr &
	(decay%selected_term)
	call entry%setup_connected_trace &
	(current_decay, previous_state%get_trace_int_ptr (), resonant=.true.)
	if (entry%config%flv%has_decay_helicity ()) then
	call hel%init (entry%config%flv%get_decay_helicity ())
	call qn_filter_conn%init (hel)
	call entry%setup_connected_matrix &
	(current_decay, previous_state%get_matrix_int_ptr (), &
	resonant=.true., qn_filter_conn = qn_filter_conn)
	call entry%setup_connected_flows &
	(current_decay, previous_state%get_flows_int_ptr (), &
	resonant=.true., qn_filter_conn = qn_filter_conn)
	else
	call entry%setup_connected_matrix &
	(current_decay, previous_state%get_matrix_int_ptr (), &
	resonant=.true.)
	call entry%setup_connected_flows &
	(current_decay, previous_state%get_flows_int_ptr (), &
	resonant=.true.)
	end if
	chain%last => entry
	call chain%build_term_entries (decay%term(decay%selected_term))
	end subroutine decay_chain_build_decay_entries

	@ %def decay_chain_build_decay_entries
	@ Recursively fill the decay chain with momenta and evaluate the
	matrix elements. Since all evaluators should have correct source
	entries at this point, momenta are automatically retrieved from the
	appropriate process instance.


	Like we did above for the parent process, factor out the trace for
	each subsequent decay (the helicity density matrix in the isolated
	state, which is taken for the convolution).
	<<Decays: decay chain: TBP>>=
	procedure :: evaluate => decay_chain_evaluate
	<<Decays: sub interfaces>>=
	module subroutine decay_chain_evaluate (chain)
	class(decay_chain_t), intent(inout) :: chain
	end subroutine decay_chain_evaluate
	<<Decays: procedures>>=
	module subroutine decay_chain_evaluate (chain)
	class(decay_chain_t), intent(inout) :: chain
	call evaluate (chain%last)
	call chain%correlated_trace%receive_momenta ()
	call chain%correlated_trace%evaluate ()
	contains
	recursive subroutine evaluate (entry)
	type(decay_chain_entry_t), intent(inout), pointer :: entry
	if (associated (entry)) then
	call evaluate (entry%previous)
	call entry%receive_kinematics ()
	call entry%evaluate_trace ()
	call entry%evaluate_event_data ()
	end if
	end subroutine evaluate
	end subroutine decay_chain_evaluate

	@ %def decay_chain_evaluate
	@ Return the probability of a decay chain. This is given as the trace
	of the density matrix with intermediate helicity correlations,
	normalized by the product of the uncorrelated density matrix traces. This
	works only if an event has been evaluated and the [[correlated_trace]]
	evaluator is filled. By definition, this evaluator has only one
	matrix element, and this must be real.
	<<Decays: decay chain: TBP>>=
	procedure :: get_probability => decay_chain_get_probability
	<<Decays: sub interfaces>>=
	module function decay_chain_get_probability (chain) result (x)
	class(decay_chain_t), intent(in) :: chain
	real(default) :: x
	end function decay_chain_get_probability
	<<Decays: procedures>>=
	module function decay_chain_get_probability (chain) result (x)
	class(decay_chain_t), intent(in) :: chain
	real(default) :: x
	x = real (chain%correlated_trace%get_matrix_element (1))
	end function decay_chain_get_probability

	@ %def decay_chain_get_probability
	@
	\subsection{Decay as Event Transform}
	The [[evt_decay]] object combines decay configuration, decay tree, and
	chain in a single object, as an implementation of the [[evt]] (event
	transform) abstract type.

	The [[var_list]] may be a pointer to the user variable list, which
	could contain overridden parameters for the decay processes.
	<<Decays: public>>=
	public :: evt_decay_t
	<<Decays: types>>=
	type, extends (evt_t) :: evt_decay_t
	private
	type(decay_root_config_t) :: decay_root_config
	type(decay_root_t) :: decay_root
	type(decay_chain_t) :: decay_chain
	type(var_list_t), pointer :: var_list => null ()
	contains
	<<Decays: evt decay: TBP>>
	end type evt_decay_t

	@ %def evt_decay_t
	@
	<<Decays: evt decay: TBP>>=
	procedure :: write_name => evt_decay_write_name
	<<Decays: sub interfaces>>=
	module subroutine evt_decay_write_name (evt, unit)
	class(evt_decay_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	end subroutine evt_decay_write_name
	<<Decays: procedures>>=
	module subroutine evt_decay_write_name (evt, unit)
	class(evt_decay_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: partonic decays"
	end subroutine evt_decay_write_name

	@ %def evt_decay_write_name
	@ Output. We display the currently selected decay tree, which
	includes configuration data, and the decay chain, i.e., the evaluators.
	<<Decays: evt decay: TBP>>=
	procedure :: write => evt_decay_write
	<<Decays: sub interfaces>>=
	module subroutine evt_decay_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_decay_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	end subroutine evt_decay_write
	<<Decays: procedures>>=
	module subroutine evt_decay_write (evt, unit, verbose, more_verbose, testflag)
	class(evt_decay_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	logical :: verb, verb2
	integer :: u
	u = given_output_unit (unit)
	verb = .true.; if (present (verbose)) verb = verbose
	verb2 = .false.; if (present (more_verbose)) verb2 = more_verbose
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u, 2)
	call evt%base_write (u, testflag = testflag)
	if (associated (evt%var_list)) then
	call write_separator (u)
	write (u, "(1x,A)") "Variable list for simulation: &
	&[associated, not shown]"
	end if
	if (verb) then
	call write_separator (u)
	call evt%decay_root%write (u)
	if (verb2) then
	call evt%decay_chain%write (u)
	call evt%decay_root%write_process_instances (u, verb)
	end if
	else
	call write_separator (u, 2)
	end if
	end subroutine evt_decay_write

	@ %def evt_decay_write
	@ Set the pointer to a user variable list.
	<<Decays: evt decay: TBP>>=
	procedure :: set_var_list => evt_decay_set_var_list
	<<Decays: sub interfaces>>=
	module subroutine evt_decay_set_var_list (evt, var_list)
	class(evt_decay_t), intent(inout) :: evt
	type(var_list_t), intent(in), target :: var_list
	end subroutine evt_decay_set_var_list
	<<Decays: procedures>>=
	module subroutine evt_decay_set_var_list (evt, var_list)
	class(evt_decay_t), intent(inout) :: evt
	type(var_list_t), intent(in), target :: var_list
	evt%var_list => var_list
	end subroutine evt_decay_set_var_list

	@ %def evt_decay_set_var_list
	@ Connect with a process instance and process. This initializes the
	decay configuration. The process stack is used to look for process
	objects that implement daughter decays.

	When all processes are assigned, configure the decay tree instance, using the
	decay tree configuration. First obtain the branching ratios, then allocate
	the decay tree. This is done once for all events.
	<<Decays: evt decay: TBP>>=
	procedure :: connect => evt_decay_connect
	<<Decays: sub interfaces>>=
	module subroutine evt_decay_connect &
	(evt, process_instance, model, process_stack)
	class(evt_decay_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	end subroutine evt_decay_connect
	<<Decays: procedures>>=
	module subroutine evt_decay_connect &
	(evt, process_instance, model, process_stack)
	class(evt_decay_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	call evt%base_connect (process_instance, model)
	if (associated (evt%var_list)) then
	call evt%decay_root_config%connect (process_instance%process, &
	model, process_stack, process_instance, evt%var_list)
	else
	call evt%decay_root_config%connect (process_instance%process, &
	model, process_stack, process_instance)
	end if
	call evt%decay_root_config%compute ()
	call evt%decay_root%init (evt%decay_root_config, evt%process_instance)
	end subroutine evt_decay_connect

	@ %def evt_decay_connect
	@ Prepare a new event: Select a decay chain and build the corresponding chain
	object.
	<<Decays: evt decay: TBP>>=
	procedure :: prepare_new_event => evt_decay_prepare_new_event
	<<Decays: sub interfaces>>=
	module subroutine evt_decay_prepare_new_event (evt, i_mci, i_term)
	class(evt_decay_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	end subroutine evt_decay_prepare_new_event
	<<Decays: procedures>>=
	module subroutine evt_decay_prepare_new_event (evt, i_mci, i_term)
	class(evt_decay_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	call evt%reset ()
	evt%decay_root%selected_mci = i_mci
	evt%decay_root%selected_term = i_term
	call evt%decay_root%select_chain ()
	call evt%decay_chain%build (evt%decay_root)
	end subroutine evt_decay_prepare_new_event

	@ %def evt_decay_prepare_new_event
	@ Generate a weighted event and assign the resulting weight
	(probability). We use a chain initialized by the preceding
	subroutine, fill it with momenta and evaluate.
	<<Decays: evt decay: TBP>>=
	procedure :: generate_weighted => evt_decay_generate_weighted
	<<Decays: sub interfaces>>=
	module subroutine evt_decay_generate_weighted (evt, probability)
	class(evt_decay_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	end subroutine evt_decay_generate_weighted
	<<Decays: procedures>>=
	module subroutine evt_decay_generate_weighted (evt, probability)
	class(evt_decay_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	call evt%decay_root%generate ()
	if (signal_is_pending ()) return
	call evt%decay_chain%evaluate ()
	probability = evt%decay_chain%get_probability ()
	end subroutine evt_decay_generate_weighted

	@ %def evt_decay_generate_weighted
	@ To create a usable event, we have to transform the interaction into a
	particle set; this requires factorization for the correlated density matrix,
	according to the factorization mode.
	<<Decays: evt decay: TBP>>=
	procedure :: make_particle_set => evt_decay_make_particle_set
	<<Decays: sub interfaces>>=
	module subroutine evt_decay_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_decay_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	end subroutine evt_decay_make_particle_set
	<<Decays: procedures>>=
	module subroutine evt_decay_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_decay_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	type(interaction_t), pointer :: int_matrix, int_flows
	type(decay_chain_entry_t), pointer :: last_entry
	last_entry => evt%decay_chain%last
	int_matrix => last_entry%get_matrix_int_ptr ()
	int_flows => last_entry%get_flows_int_ptr ()
	call evt%factorize_interactions (int_matrix, int_flows, &
	factorization_mode, keep_correlations, r)
	call evt%tag_incoming ()
	end subroutine evt_decay_make_particle_set

	@ %def event_decay_make_particle_set
	@
	\subsubsection{Auxiliary}
	Eliminate numerical noise for the associated process instances.
	<<Decays: public>>=
	public :: pacify
	<<Decays: interfaces>>=
	interface pacify
	module procedure pacify_decay
	module procedure pacify_decay_gen
	module procedure pacify_term
	module procedure pacify_unstable
	end interface pacify
	<<Decays: sub interfaces>>=
	module subroutine pacify_decay (evt)
	class(evt_decay_t), intent(inout) :: evt
	end subroutine pacify_decay
	recursive module subroutine pacify_decay_gen (decay)
	class(decay_gen_t), intent(inout) :: decay
	end subroutine pacify_decay_gen
	recursive module subroutine pacify_term (term)
	class(decay_term_t), intent(inout) :: term
	end subroutine pacify_term
	recursive module subroutine pacify_unstable (unstable)
	class(unstable_t), intent(inout) :: unstable
	end subroutine pacify_unstable
	<<Decays: procedures>>=
	module subroutine pacify_decay (evt)
	class(evt_decay_t), intent(inout) :: evt
	call pacify_decay_gen (evt%decay_root)
	end subroutine pacify_decay

	recursive module subroutine pacify_decay_gen (decay)
	class(decay_gen_t), intent(inout) :: decay
	if (associated (decay%process_instance)) then
	call pacify (decay%process_instance)
	end if
	if (decay%selected_term > 0) then
	call pacify_term (decay%term(decay%selected_term))
	end if
	end subroutine pacify_decay_gen

	recursive module subroutine pacify_term (term)
	class(decay_term_t), intent(inout) :: term
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t); call pacify_unstable (unstable)
	end select
	end do
	end subroutine pacify_term

	recursive module subroutine pacify_unstable (unstable)
	class(unstable_t), intent(inout) :: unstable
	if (unstable%selected_decay > 0) then
	call pacify_decay_gen (unstable%decay(unstable%selected_decay))
	end if
	end subroutine pacify_unstable

	@ %def pacify
	@ Prepare specific configurations for use in unit tests.
	<<Decays: unstable config: TBP>>=
	procedure :: init_test_case1
	procedure :: init_test_case2
	<<Decays: sub interfaces>>=
	module subroutine init_test_case1 &
	(unstable, i, flv, integral, relerr, model)
	class(unstable_config_t), intent(inout) :: unstable
	integer, intent(in) :: i
	type(flavor_t), dimension(:,:), intent(in) :: flv
	real(default), intent(in) :: integral
	real(default), intent(in) :: relerr
	class(model_data_t), intent(in), target :: model
	end subroutine init_test_case1
	module subroutine init_test_case2 (unstable, flv1, flv21, flv22, model)
	class(unstable_config_t), intent(inout) :: unstable
	type(flavor_t), dimension(:,:), intent(in) :: flv1, flv21, flv22
	class(model_data_t), intent(in), target :: model
	end subroutine init_test_case2
	<<Decays: procedures>>=
	module subroutine init_test_case1 (unstable, i, flv, integral, relerr, model)
	class(unstable_config_t), intent(inout) :: unstable
	integer, intent(in) :: i
	type(flavor_t), dimension(:,:), intent(in) :: flv
	real(default), intent(in) :: integral
	real(default), intent(in) :: relerr
	class(model_data_t), intent(in), target :: model
	associate (decay => unstable%decay_config(i))
	allocate (decay%term_config (1))
	call decay%init_term (1, flv, stable = [.true., .true.], model=model)
	decay%integral = integral
	decay%abs_error = integral * relerr
	end associate
	end subroutine init_test_case1

	module subroutine init_test_case2 (unstable, flv1, flv21, flv22, model)
	class(unstable_config_t), intent(inout) :: unstable
	type(flavor_t), dimension(:,:), intent(in) :: flv1, flv21, flv22
	class(model_data_t), intent(in), target :: model
	associate (decay => unstable%decay_config(1))
	decay%integral = 1.e-3_default
	decay%abs_error = decay%integral * .01_default

	allocate (decay%term_config (1))
	call decay%init_term (1, flv1, stable = [.false., .true.], model=model)

	select type (w => decay%term_config(1)%prt(1)%c)
	type is (unstable_config_t)

	associate (w_decay => w%decay_config(1))
	w_decay%integral = 2._default
	allocate (w_decay%term_config (1))
	call w_decay%init_term (1, flv21, stable = [.true., .true.], &
	model=model)
	end associate
	associate (w_decay => w%decay_config(2))
	w_decay%integral = 1._default
	allocate (w_decay%term_config (1))
	call w_decay%init_term (1, flv22, stable = [.true., .true.], &
	model=model)
	end associate
	call w%compute ()

	end select
	end associate
	end subroutine init_test_case2

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

	module decays_ut
	use unit_tests
	use decays_uti

	<<Standard module head>>

	<<Decays: public test>>

	<<Decays: public test auxiliary>>

	contains

	<<Decays: test driver>>

	end module decays_ut
	@ %def decays_ut
	@
	<<[[decays_uti.f90]]>>=
	<<File header>>

	module decays_uti

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use sm_qcd
	use model_data
	use models
	use state_matrices, only: FM_IGNORE_HELICITY
	use interactions, only: reset_interaction_counter
	use flavors
	use process_libraries
	use rng_base
	use mci_base
	use mci_midpoint
	use phs_base
	use phs_single
	use prc_core
	use prc_test, only: prc_test_create_library
	use process, only: process_t
	use instances, only: process_instance_t
	use process_stacks

	use decays

	use rng_base_ut, only: rng_test_t, rng_test_factory_t

	<<Standard module head>>

	<<Decays: public test auxiliary>>

	<<Decays: test declarations>>

	contains

	<<Decays: tests>>

	<<Decays: test auxiliary>>

	end module decays_uti

	@ %def decays_uti
	@ API: driver for the unit tests below.
	<<Decays: public test>>=
	public :: decays_test
	<<Decays: test driver>>=
	subroutine decays_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Decays: execute tests>>
	end subroutine decays_test

	@ %def decays_test
	@
	\subsubsection{Testbed}
	As a variation of the [[prepare_test_process]] routine used elsewhere, we
	define here a routine that creates two processes (scattering $ss\to ss$ and
	decay $s\to f\bar f$), compiles and integrates them and prepares for event
	generation.
	<<Decays: public test auxiliary>>=
	public :: prepare_testbed
	<<Decays: test auxiliary>>=
	subroutine prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering, decay, decay_rest_frame)
	type(process_library_t), intent(out), target :: lib
	type(process_stack_t), intent(out) :: process_stack
	type(string_t), intent(in) :: prefix
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: scattering, decay
	logical, intent(in), optional :: decay_rest_frame

	type(model_t), target :: model
	type(model_t), target :: model_copy
	type(string_t) :: libname, procname1, procname2
	type(process_entry_t), pointer :: process
	type(process_instance_t), allocatable, target :: process_instance
	class(phs_config_t), allocatable :: phs_config_template
	type(field_data_t), pointer :: field_data
	real(default) :: sqrts

	libname = prefix // "_lib"
	procname1 = prefix // "_p"
	procname2 = prefix // "_d"

	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")))

	if (scattering .and. decay) then
	field_data => model%get_field_ptr (25)
	call field_data%set (p_is_stable = .false.)
	end if

	call prc_test_create_library (libname, lib, &
	scattering = .true., decay = .true., &
	procname1 = procname1, procname2 = procname2)

	call reset_interaction_counter ()

	allocate (phs_single_config_t :: phs_config_template)

	if (scattering) then

	call model_copy%init (model%get_name (), &
	model%get_n_real (), &
	model%get_n_complex (), &
	model%get_n_field (), &
	model%get_n_vtx ())
	call model_copy%copy_from (model)

	allocate (process)
	call process%init (procname1, lib, os_data, model_copy)
	call process%setup_test_cores ()
	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_test_midpoint)
	call process%setup_terms ()

	allocate (process_instance)
	call process_instance%init (process%process_t)
	call process_instance%integrate (1, n_it = 1, n_calls = 100)
	call process%final_integration (1)
	call process_instance%final ()
	deallocate (process_instance)

	call process%prepare_simulation (1)
	call process_stack%push (process)
	end if

	if (decay) then
	call model_copy%init (model%get_name (), &
	model%get_n_real (), &
	model%get_n_complex (), &
	model%get_n_field (), &
	model%get_n_vtx ())
	call model_copy%copy_from (model)

	allocate (process)
	call process%init (procname2, lib, os_data, model_copy)
	call process%setup_test_cores ()
	call process%init_components (phs_config_template)
	if (present (decay_rest_frame)) then
	call process%setup_beams_decay (rest_frame = decay_rest_frame, i_core = 1)
	else
	call process%setup_beams_decay (rest_frame = .not. scattering, i_core = 1)
	end if
	call process%configure_phs ()
	call process%setup_mci (dispatch_mci_test_midpoint)
	call process%setup_terms ()

	allocate (process_instance)
	call process_instance%init (process%process_t)
	call process_instance%integrate (1, n_it=1, n_calls=100)
	call process%final_integration (1)
	call process_instance%final ()
	deallocate (process_instance)

	call process%prepare_simulation (1)
	call process_stack%push (process)
	end if

	call model%final ()
	call model_copy%final ()

	end subroutine prepare_testbed

	@ %def prepare_testbed
	@ MCI record prepared for midpoint integrator.
	<<Decays: test auxiliary>>=
	subroutine dispatch_mci_test_midpoint (mci, var_list, process_id, is_nlo)
	use variables, only: var_list_t
	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{Simple decay configuration}
	We define a branching configuration with two decay modes. We set the
	integral values by hand, so we do not need to evaluate processes, yet.
	<<Decays: execute tests>>=
	call test (decays_1, "decays_1", &
	"branching and decay configuration", &
	u, results)
	<<Decays: test declarations>>=
	public :: decays_1
	<<Decays: tests>>=
	subroutine decays_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(flavor_t) :: flv_h
	type(flavor_t), dimension(2,1) :: flv_hbb, flv_hgg
	type(unstable_config_t), allocatable :: unstable

	write (u, "(A)") "* Test output: decays_1"
	write (u, "(A)") "* Purpose: Set up branching and decay configuration"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call os_data%init ()
	call model%init_sm_test ()

	call flv_h%init (25, model)
	call flv_hbb(:,1)%init ([5, -5], model)
	call flv_hgg(:,1)%init ([22, 22], model)

	write (u, "(A)") "* Set up branching and decay"
	write (u, "(A)")

	allocate (unstable)
	call unstable%init (flv_h)
	call unstable%init_decays ([var_str ("h_bb"), var_str ("h_gg")], model)

	call unstable%init_test_case1 &
	(1, flv_hbb, 1.234e-3_default, .02_default, model)

	call unstable%init_test_case1 &
	(2, flv_hgg, 3.085e-4_default, .08_default, model)

	call unstable%compute ()
	call unstable%write (u)

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

	call unstable%final ()
	call model%final ()

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

	end subroutine decays_1

	@ %def decays_1
	@
	\subsubsection{Cascade decay configuration}
	We define a branching configuration with one decay, which is followed
	by another branching.
	<<Decays: execute tests>>=
	call test (decays_2, "decays_2", &
	"cascade decay configuration", &
	u, results)
	<<Decays: test declarations>>=
	public :: decays_2
	<<Decays: tests>>=
	subroutine decays_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(flavor_t) :: flv_h, flv_wp, flv_wm
	type(flavor_t), dimension(2,1) :: flv_hww, flv_wud, flv_wen
	type(unstable_config_t), allocatable :: unstable

	write (u, "(A)") "* Test output: decays_2"
	write (u, "(A)") "* Purpose: Set up cascade branching"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call os_data%init ()
	call model%init_sm_test ()

	call model%set_unstable (25, [var_str ("h_ww")])
	call model%set_unstable (24, [var_str ("w_ud"), var_str ("w_en")])

	call flv_h%init (25, model)
	call flv_hww(:,1)%init ([24, -24], model)
	call flv_wp%init (24, model)
	call flv_wm%init (-24, model)
	call flv_wud(:,1)%init ([2, -1], model)
	call flv_wen(:,1)%init ([-11, 12], model)


	write (u, "(A)") "* Set up branching and decay"
	write (u, "(A)")

	allocate (unstable)
	call unstable%init (flv_h, set_decays=.true., model=model)

	call unstable%init_test_case2 (flv_hww, flv_wud, flv_wen, model)

	call unstable%compute ()
	call unstable%write (u)

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

	call unstable%final ()
	call model%final ()

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

	end subroutine decays_2

	@ %def decays_2
	@
	\subsubsection{Decay and Process Object}
	We define a branching configuration with one decay and connect this
	with an actual process object.
	<<Decays: execute tests>>=
	call test (decays_3, "decays_3", &
	"associate process", &
	u, results)
	<<Decays: test declarations>>=
	public :: decays_3
	<<Decays: tests>>=
	subroutine decays_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(process_library_t), target :: lib
	type(string_t) :: prefix
	type(string_t) :: procname2
	type(process_stack_t) :: process_stack
	type(process_t), pointer :: process
	type(unstable_config_t), allocatable :: unstable
	type(flavor_t) :: flv

	write (u, "(A)") "* Test output: decays_3"
	write (u, "(A)") "* Purpose: Connect a decay configuration &
	&with a process"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment and integrate process"
	write (u, "(A)")

	call os_data%init ()

	prefix = "decays_3"
	call prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering=.false., decay=.true., decay_rest_frame=.false.)

	procname2 = prefix // "_d"
	process => process_stack%get_process_ptr (procname2)
	model => process%get_model_ptr ()
	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Set up branching and decay"
	write (u, "(A)")

	call flv%init (25, model)

	allocate (unstable)
	call unstable%init (flv)
	call unstable%init_decays ([procname2], model)

	write (u, "(A)") "* Connect decay with process object"
	write (u, "(A)")

	call unstable%connect_decay (1, process, model)

	call unstable%compute ()
	call unstable%write (u)

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

	call unstable%final ()
	call process_stack%final ()

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

	end subroutine decays_3

	@ %def decays_3
	@
	\subsubsection{Decay and Process Object}
	Building upon the previous test, we set up a decay instance and generate a
	decay event.
	<<Decays: execute tests>>=
	call test (decays_4, "decays_4", &
	"decay instance", &
	u, results)
	<<Decays: test declarations>>=
	public :: decays_4
	<<Decays: tests>>=
	subroutine decays_4 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(process_library_t), target :: lib
	type(string_t) :: prefix, procname2
	class(rng_t), allocatable :: rng
	type(process_stack_t) :: process_stack
	type(process_t), pointer :: process
	type(unstable_config_t), allocatable, target :: unstable
	type(flavor_t) :: flv
	type(unstable_t), allocatable :: instance

	write (u, "(A)") "* Test output: decays_4"
	write (u, "(A)") "* Purpose: Create a decay process and evaluate &
	&an instance"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment, process, &
	&and decay configuration"
	write (u, "(A)")

	call os_data%init ()

	prefix = "decays_4"
	call prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering=.false., decay=.true., decay_rest_frame = .false.)

	procname2 = prefix // "_d"
	process => process_stack%get_process_ptr (procname2)
	model => process%get_model_ptr ()

	call flv%init (25, model)

	allocate (unstable)
	call unstable%init (flv)
	call unstable%init_decays ([procname2], model)

	call model%set_unstable (25, [procname2])

	call unstable%connect_decay (1, process, model)

	call unstable%compute ()

	allocate (rng_test_t :: rng)

	allocate (instance)
	call instance%init (unstable)
	call instance%import_rng (rng)

	call instance%select_chain ()
	call instance%generate ()
	call instance%write (u)

	write (u, *)
	call instance%write_process_instances (u)

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

	call instance%final ()
	call process_stack%final ()
	call unstable%final ()

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

	end subroutine decays_4

	@ %def decays_4
	@
	\subsubsection{Decay with Parent Process}
	We define a scattering process $ss\to ss$ and subsequent decays $s\to f\bar
	f$.
	<<Decays: execute tests>>=
	call test (decays_5, "decays_5", &
	"parent process and decay", &
	u, results)
	<<Decays: test declarations>>=
	public :: decays_5
	<<Decays: tests>>=
	subroutine decays_5 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(process_library_t), target :: lib
	type(string_t) :: prefix, procname1, procname2
	type(process_stack_t) :: process_stack
	type(process_t), pointer :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(decay_root_config_t), target :: decay_root_config
	type(decay_root_t) :: decay_root
	type(decay_chain_t) :: decay_chain

	write (u, "(A)") "* Test output: decays_5"
	write (u, "(A)") "* Purpose: Handle a process with subsequent decays"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment and parent process"
	write (u, "(A)")

	call os_data%init ()

	prefix = "decays_5"
	procname1 = prefix // "_p"
	procname2 = prefix // "_d"
	call prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering=.true., decay=.true.)

	write (u, "(A)") "* Initialize decay process"
	write (u, "(A)")

	process => process_stack%get_process_ptr (procname1)
	model => process%get_model_ptr ()
	call model%set_unstable (25, [procname2])

	write (u, "(A)") "* Initialize decay tree configuration"
	write (u, "(A)")

	call decay_root_config%connect (process, model, process_stack)
	call decay_root_config%compute ()
	call decay_root_config%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize decay tree"

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	call process_instance%init_simulation (1)

	call decay_root%init (decay_root_config, process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Select decay chain"
	write (u, "(A)")

	call decay_root%set_mci (1)
	!!! Not yet implemented; there is only one term anyway:
	! call process_instance%select_i_term (decay_root%selected_term)
	call decay_root%set_term (1)
	call decay_root%select_chain ()

	call decay_chain%build (decay_root)

	call decay_root%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate event"
	write (u, "(A)")

	call process_instance%generate_unweighted_event (decay_root%get_mci ())
	call process_instance%evaluate_event_data ()

	call decay_root%generate ()

	call pacify (decay_root)

	write (u, "(A)") "* Process instances"
	write (u, "(A)")

	call decay_root%write_process_instances (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate decay chain"
	write (u, "(A)")

	call decay_chain%evaluate ()
	call decay_chain%write (u)

	write (u, *)
	write (u, "(A,ES19.12)") "chain probability =", &
	decay_chain%get_probability ()

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

	call decay_chain%final ()
	call decay_root%final ()
	call decay_root_config%final ()
	call process_instance%final ()
	deallocate (process_instance)

	call process_stack%final ()

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

	end subroutine decays_5

	@ %def decays_5
	@
	\subsubsection{Decay as Event Transform}
	Again, we define a scattering process $ss\to ss$ and subsequent decays
	$s\to f\bar f$.
	<<Decays: execute tests>>=
	call test (decays_6, "decays_6", &
	"evt_decay object", &
	u, results)
	<<Decays: test declarations>>=
	public :: decays_6
	<<Decays: tests>>=
	subroutine decays_6 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(process_library_t), target :: lib
	type(string_t) :: prefix, procname1, procname2
	type(process_stack_t) :: process_stack
	type(process_t), pointer :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(evt_decay_t), target :: evt_decay
	integer :: factorization_mode
	logical :: keep_correlations

	write (u, "(A)") "* Test output: decays_6"
	write (u, "(A)") "* Purpose: Handle a process with subsequent decays"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment and parent process"
	write (u, "(A)")

	call os_data%init ()

	prefix = "decays_6"
	procname1 = prefix // "_p"
	procname2 = prefix // "_d"
	call prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering=.true., decay=.true.)

	write (u, "(A)") "* Initialize decay process"

	process => process_stack%get_process_ptr (procname1)
	model => process%get_model_ptr ()
	call model%set_unstable (25, [procname2])

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	call process_instance%init_simulation (1)

	write (u, "(A)")
	write (u, "(A)") "* Initialize decay object"

	call evt_decay%connect (process_instance, model, process_stack)

	write (u, "(A)")
	write (u, "(A)") "* Generate scattering event"

	call process_instance%generate_unweighted_event (1)
	call process_instance%evaluate_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Select decay chain and generate event"
	write (u, "(A)")

	call evt_decay%prepare_new_event (1, 1)
	call evt_decay%generate_unweighted ()

	factorization_mode = FM_IGNORE_HELICITY
	keep_correlations = .false.
	call evt_decay%make_particle_set (factorization_mode, keep_correlations)

	call evt_decay%write (u, verbose = .true.)

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

	call evt_decay%final ()
	call process_instance%final ()
	deallocate (process_instance)

	call process_stack%final ()

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

	end subroutine decays_6

	@ %def decays_6
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Tau decays}
	<<[[tau_decays.f90]]>>=
	<<File header>>

	module tau_decays

	<<Use kinds>>
	use sm_qcd
	use model_data
	use models
	use event_transforms

	<<Standard module head>>

	<<Tau decays: public>>

	<<Tau decays: types>>

	interface
	<<Tau decays: sub interfaces>>
	end interface

	end module tau_decays
	@
	<<[[tau_decays_sub.f90]]>>=
	<<File header>>

	submodule (tau_decays) tau_decays_s

	use io_units
	use format_utils, only: write_separator

	implicit none

	contains

	<<Tau decays: procedures>>

	end submodule tau_decays_s

	@ %def tau_decays_s
	@
	@ %def tau_decays
	\subsection{Tau Decays Event Transform}
	This is the type for the tau decay event transform.
	<<Tau decays: public>>=
	public :: evt_tau_decays_t
	<<Tau decays: types>>=
	type, extends (evt_t) :: evt_tau_decays_t
	type(model_t), pointer :: model_hadrons => null()
	type(qcd_t) :: qcd
	contains
	<<Tau decays: evt tau decays: TBP>>
	end type evt_tau_decays_t

	@ %def evt_tau_decays_t
	<<Tau decays: evt tau decays: TBP>>=
	procedure :: write_name => evt_tau_decays_write_name
	<<Tau decays: sub interfaces>>=
	module subroutine evt_tau_decays_write_name (evt, unit)
	class(evt_tau_decays_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	end subroutine evt_tau_decays_write_name
	<<Tau decays: procedures>>=
	module subroutine evt_tau_decays_write_name (evt, unit)
	class(evt_tau_decays_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: tau decays"
	end subroutine evt_tau_decays_write_name

	@ %def evt_tau_decays_write_name
	@ Output.
	<<Tau decays: evt tau decays: TBP>>=
	procedure :: write => evt_tau_decays_write
	<<Tau decays: sub interfaces>>=
	module subroutine evt_tau_decays_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_tau_decays_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	end subroutine evt_tau_decays_write
	<<Tau decays: procedures>>=
	module subroutine evt_tau_decays_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_tau_decays_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u)
	call evt%base_write (u, testflag = testflag, show_set = .false.)
	if (evt%particle_set_exists) &
	call evt%particle_set%write &
	(u, summary = .true., compressed = .true., testflag = testflag)
	call write_separator (u)
	end subroutine evt_tau_decays_write

	@ %def evt_tau_decays_write
	@ Here we take the particle set from the previous event transform and
	apply the tau decays. What probability should be given back, the
	product of branching ratios of the corresponding tau decays?
	<<Tau decays: evt tau decays: TBP>>=
	procedure :: generate_weighted => evt_tau_decays_generate_weighted
	<<Tau decays: sub interfaces>>=
	module subroutine evt_tau_decays_generate_weighted (evt, probability)
	class(evt_tau_decays_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	end subroutine evt_tau_decays_generate_weighted
	<<Tau decays: procedures>>=
	module subroutine evt_tau_decays_generate_weighted (evt, probability)
	class(evt_tau_decays_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	logical :: valid
	evt%particle_set = evt%previous%particle_set
	!!! To be checked or expanded
	probability = 1
	valid = .true.
	evt%particle_set_exists = valid
	end subroutine evt_tau_decays_generate_weighted

	@ %def evt_tau_decays_generate_weighted
	@ The factorization parameters are irrelevant.
	<<Tau decays: evt tau decays: TBP>>=
	procedure :: make_particle_set => evt_tau_decays_make_particle_set
	<<Tau decays: sub interfaces>>=
	module subroutine evt_tau_decays_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_tau_decays_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	end subroutine evt_tau_decays_make_particle_set
	<<Tau decays: procedures>>=
	module subroutine evt_tau_decays_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_tau_decays_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	logical :: valid
	!!! to be checked and expanded
	valid = .true.
	evt%particle_set_exists = evt%particle_set_exists .and. valid
	end subroutine evt_tau_decays_make_particle_set

	@ %def event_tau_decays_make_particle_set
	@
	<<Tau decays: evt tau decays: TBP>>=
	procedure :: prepare_new_event => evt_tau_decays_prepare_new_event
	<<Tau decays: sub interfaces>>=
	module subroutine evt_tau_decays_prepare_new_event (evt, i_mci, i_term)
	class(evt_tau_decays_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	end subroutine evt_tau_decays_prepare_new_event
	<<Tau decays: procedures>>=
	module subroutine evt_tau_decays_prepare_new_event (evt, i_mci, i_term)
	class(evt_tau_decays_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	call evt%reset ()
	end subroutine evt_tau_decays_prepare_new_event

	@ %def evt_tau_decays_prepare_new_event
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Shower}
	We might use matrix elements of LO and NLO to increase the accuracy of
	the shower in the sense of matching as well as merging.
	<<[[shower.f90]]>>=
	<<File header>>

	module shower

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use pdf

	use shower_base
	use matching_base

	use sm_qcd
	use model_data

	use event_transforms
	use models
	use process, only: process_t
	use instances, only: process_instance_t
	use process_stacks

	<<Standard module head>>

	<<Shower: public>>

	<<Shower: parameters>>

	<<Shower: types>>

	interface
	<<Shower: sub interfaces>>
	end interface

	end module shower
	@ %def shower
	@
	<<[[shower_sub.f90]]>>=
	<<File header>>

	submodule (shower) shower_s

	<<Use debug>>
	use io_units
	use format_utils, only: write_separator
	use system_defs, only: LF
	use diagnostics
	use lorentz
	use subevents, only: PRT_BEAM_REMNANT, PRT_INCOMING, PRT_OUTGOING
	use powheg_matching, only: powheg_matching_t
	use rng_base
	use hep_common

	implicit none

	contains

	<<Shower: procedures>>

	end submodule shower_s

	@ %def shower_s
	@
	\subsection{Configuration Parameters}
	[[POWHEG_TESTING]] allows to disable the parton shower for validation
	and testing of the POWHEG procedure.
	<<Shower: parameters>>=
	logical, parameter :: POWHEG_TESTING = .true.

	@ %def POWHEG_TESTING
	@
	\subsection{Event Transform}
	The event transforms can do more than mere showering. Especially, it
	may reweight showered events to fixed-order matrix elements. The
	[[model_hadrons]] is supposed to be the SM variant that contains all
	hadrons that can be generated in the shower.
	<<Shower: public>>=
	public :: evt_shower_t
	<<Shower: types>>=
	type, extends (evt_t) :: evt_shower_t
	class(shower_base_t), allocatable :: shower
	class(matching_t), allocatable :: matching
	type(model_t), pointer :: model_hadrons => null ()
	type(qcd_t) :: qcd
	type(pdf_data_t) :: pdf_data
	type(os_data_t) :: os_data
	logical :: is_first_event
	contains
	<<Shower: evt shower: TBP>>
	end type evt_shower_t

	@ %def evt_shower_t
	@
	<<Shower: evt shower: TBP>>=
	procedure :: write_name => evt_shower_write_name
	<<Shower: sub interfaces>>=
	module subroutine evt_shower_write_name (evt, unit)
	class(evt_shower_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	end subroutine evt_shower_write_name
	<<Shower: procedures>>=
	module subroutine evt_shower_write_name (evt, unit)
	class(evt_shower_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: shower"
	end subroutine evt_shower_write_name

	@ %def evt_shower_write_name
	@ Output.
	<<Shower: evt shower: TBP>>=
	procedure :: write => evt_shower_write
	<<Shower: sub interfaces>>=
	module subroutine evt_shower_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_shower_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	end subroutine evt_shower_write
	<<Shower: procedures>>=
	module subroutine evt_shower_write &
	(evt, unit, verbose, more_verbose, testflag)
	class(evt_shower_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u)
	call evt%base_write (u, testflag = testflag, show_set = .false.)
	if (evt%particle_set_exists) call evt%particle_set%write &
	(u, summary = .true., compressed = .true., testflag = testflag)
	call write_separator (u)
	call evt%shower%settings%write (u)
	end subroutine evt_shower_write

	@ %def evt_shower_write
	<<Shower: evt shower: TBP>>=
	procedure :: connect => evt_shower_connect
	<<Shower: sub interfaces>>=
	module subroutine evt_shower_connect &
	(evt, process_instance, model, process_stack)
	class(evt_shower_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	end subroutine evt_shower_connect
	<<Shower: procedures>>=
	module subroutine evt_shower_connect &
	(evt, process_instance, model, process_stack)
	class(evt_shower_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	call evt%base_connect (process_instance, model, process_stack)
	call evt%make_rng (evt%process)
	if (allocated (evt%matching)) then
	call evt%matching%connect (process_instance, model, evt%shower)
	end if
	end subroutine evt_shower_connect

	@ %def evt_shower_connect
	@ Initialize the event transformation. This will be executed once
	during dispatching. The [[model_hadrons]] is supposed to be the SM
	variant that contains all hadrons that may be generated in the
	shower.
	<<Shower: evt shower: TBP>>=
	procedure :: init => evt_shower_init
	<<Shower: sub interfaces>>=
	module subroutine evt_shower_init (evt, model_hadrons, os_data)
	class(evt_shower_t), intent(out) :: evt
	type(model_t), intent(in), target :: model_hadrons
	type(os_data_t), intent(in) :: os_data
	end subroutine evt_shower_init
	<<Shower: procedures>>=
	module subroutine evt_shower_init (evt, model_hadrons, os_data)
	class(evt_shower_t), intent(out) :: evt
	type(model_t), intent(in), target :: model_hadrons
	type(os_data_t), intent(in) :: os_data
	evt%os_data = os_data
	evt%model_hadrons => model_hadrons
	evt%is_first_event = .true.
	end subroutine evt_shower_init

	@ %def evt_shower_init
	@ Create RNG instances, spawned by the process object.
	<<Shower: evt shower: TBP>>=
	procedure :: make_rng => evt_shower_make_rng
	<<Shower: sub interfaces>>=
	module subroutine evt_shower_make_rng (evt, process)
	class(evt_shower_t), intent(inout) :: evt
	type(process_t), intent(inout) :: process
	end subroutine evt_shower_make_rng
	<<Shower: procedures>>=
	module subroutine evt_shower_make_rng (evt, process)
	class(evt_shower_t), intent(inout) :: evt
	type(process_t), intent(inout) :: process
	class(rng_t), allocatable :: rng
	call process%make_rng (rng)
	call evt%shower%import_rng (rng)
	if (allocated (evt%matching)) then
	call process%make_rng (rng)
	call evt%matching%import_rng (rng)
	end if
	end subroutine evt_shower_make_rng

	@ %def evt_shower_make_rng
	@ Things we want to do for a new event before the whole event
	transformation chain is evaluated.
	<<Shower: evt shower: TBP>>=
	procedure :: prepare_new_event => evt_shower_prepare_new_event
	<<Shower: sub interfaces>>=
	module subroutine evt_shower_prepare_new_event (evt, i_mci, i_term)
	class(evt_shower_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	end subroutine evt_shower_prepare_new_event
	<<Shower: procedures>>=
	module subroutine evt_shower_prepare_new_event (evt, i_mci, i_term)
	class(evt_shower_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	real(default) :: fac_scale, alpha_s
	fac_scale = evt%process_instance%get_fac_scale (i_term)
	alpha_s = evt%process_instance%get_alpha_s (i_term)
	call evt%reset ()
	call evt%shower%prepare_new_event (fac_scale, alpha_s)
	end subroutine evt_shower_prepare_new_event

	@ %def evt_shower_prepare_new_event
	@
	<<Shower: evt shower: TBP>>=
	procedure :: first_event => evt_shower_first_event
	<<Shower: sub interfaces>>=
	module subroutine evt_shower_first_event (evt)
	class(evt_shower_t), intent(inout) :: evt
	end subroutine evt_shower_first_event
	<<Shower: procedures>>=
	module subroutine evt_shower_first_event (evt)
	class(evt_shower_t), intent(inout) :: evt
	double precision :: pdftest
	if (debug_on) call msg_debug (D_TRANSFORMS, "evt_shower_first_event")
	associate (settings => evt%shower%settings)
	settings%hadron_collision = .false.
	!!! !!! !!! Workaround for PGF90 v16.1
	!!! if (all (evt%particle_set%prt(1:2)%flv%get_pdg_abs () <= 39)) then
	if (evt%particle_set%prt(1)%flv%get_pdg_abs () <= 39 .and. &
	evt%particle_set%prt(2)%flv%get_pdg_abs () <= 39) then
	settings%hadron_collision = .false.
	!!! else if (all (evt%particle_set%prt(1:2)%flv%get_pdg_abs () >= 100)) then
	else if (evt%particle_set%prt(1)%flv%get_pdg_abs () >= 100 .and. &
	evt%particle_set%prt(2)%flv%get_pdg_abs () >= 100) then
	settings%hadron_collision = .true.
	else
	call msg_fatal ("evt_shower didn't recognize beams setup")
	end if
	if (debug_on) call msg_debug (D_TRANSFORMS, "hadron_collision", settings%hadron_collision)
	if (allocated (evt%matching)) then
	evt%matching%is_hadron_collision = settings%hadron_collision
	call evt%matching%first_event ()
	end if
	if (.not. settings%hadron_collision .and. settings%isr_active) then
	call msg_fatal ("?ps_isr_active is only intended for hadron-collisions")
	end if
	if (evt%pdf_data%type == STRF_LHAPDF5) then
	if (settings%isr_active .and. settings%hadron_collision) then
	call GetQ2max (0, pdftest)
	if (pdftest < epsilon (pdftest)) then
	call msg_bug ("ISR QCD shower enabled, but LHAPDF not " // &
	"initialized," // LF // " aborting simulation")
	return
	end if
	end if
	else if (evt%pdf_data%type == STRF_PDF_BUILTIN .and. &
	settings%method == PS_PYTHIA6) then
	call msg_fatal ("Builtin PDFs cannot be used for PYTHIA showers," &
	// LF // " aborting simulation")
	return
	end if
	end associate
	evt%is_first_event = .false.
	end subroutine evt_shower_first_event

	@ %def evt_shower_first_event
	@ Here we take the particle set from the previous event transform
	(assuming that there is always one) and apply the shower algorithm. The
	result is stored in the event transform of the current object. We
	always return a probability of unity as we don't have the analytic
	weight of the combination of shower, MLM matching and hadronization. A
	subdivision into multiple event transformations is under construction.
	Invalid or vetoed events have to be discarded by the caller which is why
	we mark the particle set as invalid. This procedure directly takes the
	(MLM) matching into account.
	<<Shower: evt shower: TBP>>=
	procedure :: generate_weighted => evt_shower_generate_weighted
	<<Shower: sub interfaces>>=
	module subroutine evt_shower_generate_weighted (evt, probability)
	class(evt_shower_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	end subroutine evt_shower_generate_weighted
	<<Shower: procedures>>=
	module subroutine evt_shower_generate_weighted (evt, probability)
	class(evt_shower_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	logical :: valid, vetoed, is_powheg_matching
	if (debug_on) call msg_debug (D_TRANSFORMS, "evt_shower_generate_weighted")
	if (signal_is_pending ()) return
	evt%particle_set = evt%previous%particle_set
	valid = .true.; vetoed = .false.; is_powheg_matching = .false.
	if (evt%is_first_event) call evt%first_event ()
	call evt%shower%import_particle_set (evt%particle_set)
	if (allocated (evt%matching)) then
	call evt%matching%before_shower (evt%particle_set, vetoed)
	if (msg_level(D_TRANSFORMS) >= DEBUG) then
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "Matching before generate emissions")
	call evt%matching%write ()
	end if
	end if
	if (allocated (evt%matching)) then
	select type (matching => evt%matching)
	type is (powheg_matching_t)
	is_powheg_matching = .true.
	end select
	end if
	if (.not. vetoed) then
	if (.not. POWHEG_TESTING .or. .not. is_powheg_matching) then
	if (evt%shower%settings%method == PS_PYTHIA6 .or. &
	evt%shower%settings%hadronization_active) then
	call assure_heprup (evt%particle_set)
	end if
	call evt%shower%generate_emissions (valid)
	end if
	end if
	probability = 1
	evt%particle_set_exists = valid .and. .not. vetoed
	end subroutine evt_shower_generate_weighted

	@ %def evt_shower_generate_weighted
	@ Here, we fill the particle set with the partons from the shower.
	The factorization parameters are irrelevant.
	We make a sanity check that the initial energy lands either in the
	outgoing particles or add to the beam remnant.
	<<Shower: evt shower: TBP>>=
	procedure :: make_particle_set => evt_shower_make_particle_set
	<<Shower: sub interfaces>>=
	module subroutine evt_shower_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_shower_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	end subroutine evt_shower_make_particle_set
	<<Shower: procedures>>=
	module subroutine evt_shower_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_shower_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	type(vector4_t) :: sum_vec_in, sum_vec_out, sum_vec_beamrem, &
	sum_vec_beamrem_before
	logical :: vetoed, sane
	if (evt%particle_set_exists) then
	vetoed = .false.
	sum_vec_beamrem_before = sum (evt%particle_set%prt%p, &
	mask=evt%particle_set%prt%get_status () == PRT_BEAM_REMNANT)
	call evt%shower%make_particle_set (evt%particle_set, &
	evt%model, evt%model_hadrons)
	if (allocated (evt%matching)) then
	call evt%matching%after_shower (evt%particle_set, vetoed)
	end if
	if (debug_active (D_TRANSFORMS)) then
	call msg_debug (D_TRANSFORMS, &
	"Shower: obtained particle set after shower + matching")
	call evt%particle_set%write (summary = .true., compressed = .true.)
	end if
	sum_vec_in = sum (evt%particle_set%prt%p, &
	mask=evt%particle_set%prt%get_status () == PRT_INCOMING)
	sum_vec_out = sum (evt%particle_set%prt%p, &
	mask=evt%particle_set%prt%get_status () == PRT_OUTGOING)
	sum_vec_beamrem = sum (evt%particle_set%prt%p, &
	mask=evt%particle_set%prt%get_status () == PRT_BEAM_REMNANT)
	sum_vec_beamrem = sum_vec_beamrem - sum_vec_beamrem_before
	sane = abs(sum_vec_out%p(0) - sum_vec_in%p(0)) < &
	sum_vec_in%p(0) / 10 .or. &
	abs((sum_vec_out%p(0) + sum_vec_beamrem%p(0)) - sum_vec_in%p(0)) < &
	sum_vec_in%p(0) / 10
	sane = .true.
	evt%particle_set_exists = .not. vetoed .and. sane
	end if
	end subroutine evt_shower_make_particle_set

	@ %def event_shower_make_particle_set
	@
	<<Shower: evt shower: TBP>>=
	procedure :: contains_powheg_matching => evt_shower_contains_powheg_matching
	<<Shower: sub interfaces>>=
	module function evt_shower_contains_powheg_matching (evt) result (val)
	logical :: val
	class(evt_shower_t), intent(in) :: evt
	end function evt_shower_contains_powheg_matching
	<<Shower: procedures>>=
	module function evt_shower_contains_powheg_matching (evt) result (val)
	logical :: val
	class(evt_shower_t), intent(in) :: evt
	val = .false.
	if (allocated (evt%matching)) &
	val = evt%matching%get_method () == "POWHEG"
	end function evt_shower_contains_powheg_matching

	@ %def evt_shower_contains_powheg_matching
	@
	<<Shower: evt shower: TBP>>=
	procedure :: disable_powheg_matching => evt_shower_disable_powheg_matching
	<<Shower: sub interfaces>>=
	module subroutine evt_shower_disable_powheg_matching (evt)
	class(evt_shower_t), intent(inout) :: evt
	end subroutine evt_shower_disable_powheg_matching
	<<Shower: procedures>>=
	module subroutine evt_shower_disable_powheg_matching (evt)
	class(evt_shower_t), intent(inout) :: evt
	select type (matching => evt%matching)
	type is (powheg_matching_t)
	matching%active = .false.
	class default
	call msg_fatal ("Trying to disable powheg but " // &
	"no powheg matching is allocated!")
	end select
	end subroutine evt_shower_disable_powheg_matching

	@ %def evt_shower_disable_powheg_matching
	@
	<<Shower: evt shower: TBP>>=
	procedure :: enable_powheg_matching => evt_shower_enable_powheg_matching
	<<Shower: sub interfaces>>=
	module subroutine evt_shower_enable_powheg_matching (evt)
	class(evt_shower_t), intent(inout) :: evt
	end subroutine evt_shower_enable_powheg_matching
	<<Shower: procedures>>=
	module subroutine evt_shower_enable_powheg_matching (evt)
	class(evt_shower_t), intent(inout) :: evt
	select type (matching => evt%matching)
	type is (powheg_matching_t)
	matching%active = .true.
	class default
	call msg_fatal &
	("Trying to enable powheg but no powheg matching is allocated!")
	end select
	end subroutine evt_shower_enable_powheg_matching

	@ %def evt_shower_enable_powheg_matching
	@
	<<Shower: evt shower: TBP>>=
	procedure :: final => evt_shower_final
	<<Shower: sub interfaces>>=
	module subroutine evt_shower_final (evt)
	class(evt_shower_t), intent(inout) :: evt
	end subroutine evt_shower_final
	<<Shower: procedures>>=
	module subroutine evt_shower_final (evt)
	class(evt_shower_t), intent(inout) :: evt
	call evt%base_final ()
	if (allocated (evt%matching)) call evt%matching%final ()
	end subroutine evt_shower_final

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

	module shower_ut
	use unit_tests
	use shower_uti

	<<Standard module head>>

	<<Shower: public test>>

	contains

	<<Shower: test driver>>

	end module shower_ut
	@ %def shower_ut
	@
	<<[[shower_uti.f90]]>>=
	<<File header>>

	module shower_uti

	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use os_interface
	use sm_qcd
	use physics_defs, only: BORN
	use model_data
	use models
	use state_matrices, only: FM_IGNORE_HELICITY
	use process_libraries
	use rng_base
	use rng_tao
	use dispatch_rng, only: dispatch_rng_factory_fallback
	use mci_base
	use mci_midpoint
	use phs_base
	use phs_single
	use prc_core_def, only: prc_core_def_t
	use prc_core
	use prc_omega
	use variables
	use event_transforms
	use tauola_interface !NODEP!

	use process, only: process_t
	use instances, only: process_instance_t

	use pdf
	use shower_base
	use shower_core

	use dispatch_rng_ut, only: dispatch_rng_factory_tao

	use shower

	<<Standard module head>>

	<<Shower: test declarations>>

	contains

	<<Shower: tests>>

	end module shower_uti

	@ %def shower_uti
	@ API: driver for the unit tests below.
	<<Shower: public test>>=
	public :: shower_test
	<<Shower: test driver>>=
	subroutine shower_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Shower: execute tests>>
	end subroutine shower_test

	@ %def shower_test
	@
	\subsubsection{Testbed}
	This sequence sets up a two-jet process, ready for generating events.
	<<Shower: tests>>=
	<<setup testbed>>
	@
	<<setup testbed>>=
	subroutine setup_testbed &
	(prefix, os_data, lib, model_list, process, process_instance)
	type(string_t), intent(in) :: prefix
	type(os_data_t), intent(out) :: os_data
	type(process_library_t), intent(out), target :: lib
	type(model_list_t), intent(out) :: model_list
	type(model_t), pointer :: model
	type(model_t), pointer :: model_tmp
	type(process_t), target, intent(out) :: process
	type(process_instance_t), target, intent(out) :: process_instance
	type(var_list_t), pointer :: model_vars
	type(string_t) :: model_name, libname, procname
	type(process_def_entry_t), pointer :: entry
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	class(prc_core_t), allocatable :: core_template
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts

	model_name = "SM"
	libname = prefix // "_lib"
	procname = prefix // "p"

	call os_data%init ()
	dispatch_rng_factory_fallback => dispatch_rng_factory_tao
	allocate (model_tmp)
	call model_list%read_model (model_name, model_name // ".mdl", &
	os_data, model_tmp)
	model_vars => model_tmp%get_var_list_ptr ()
	call model_vars%set_real (var_str ("me"), 0._default, &
	is_known = .true.)
	model => model_tmp

	call lib%init (libname)

	allocate (prt_in (2), source = [var_str ("e-"), var_str ("e+")])
	allocate (prt_out (2), source = [var_str ("d"), var_str ("dbar")])

	allocate (entry)
	call entry%init (procname, model, n_in = 2, n_components = 1)
	call omega_make_process_component (entry, 1, &
	model_name, prt_in, prt_out, &
	report_progress=.true.)
	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)

	call process%init (procname, lib, os_data, model)

	allocate (prc_omega_t :: core_template)
	allocate (phs_single_config_t :: phs_config_template)

	call process%setup_cores (dispatch_core_omega_test)

	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_test_midpoint)
	call process%setup_terms ()

	call process_instance%init (process)
	call process_instance%integrate (1, 1, 1000)
	call process%final_integration (1)

	call process_instance%setup_event_data (i_core = 1)
	call process_instance%init_simulation (1)
	call process_instance%generate_weighted_event (1)
	call process_instance%evaluate_event_data ()

	end subroutine setup_testbed

	@ %def setup_testbed
	@ A minimal dispatcher version that allocates the core object for testing.
	<<setup testbed>>=
	subroutine dispatch_core_omega_test (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
	allocate (prc_omega_t :: core)
	select type (core)
	type is (prc_omega_t)
	call core%set_parameters (model)
	end select
	end subroutine dispatch_core_omega_test

	@ %def dispatch_core_omega_test
	@ MCI record prepared for midpoint integrator.
	<<setup testbed>>=
	subroutine dispatch_mci_test_midpoint (mci, var_list, process_id, is_nlo)
	use variables, only: var_list_t
	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{Trivial Test}
	We generate a two-jet event and shower it using default settings, i.e.
	in disabled mode.
	<<Shower: execute tests>>=
	call test (shower_1, "shower_1", &
	"disabled shower", &
	u, results)
	<<Shower: test declarations>>=
	public :: shower_1
	<<Shower: tests>>=
	subroutine shower_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(process_library_t), target :: lib
	type(model_list_t) :: model_list
	class(model_data_t), pointer :: model
	type(model_t), pointer :: model_hadrons
	type(process_t), target :: process
	type(process_instance_t), target :: process_instance
	type(pdf_data_t) :: pdf_data
	integer :: factorization_mode
	logical :: keep_correlations
	class(evt_t), allocatable, target :: evt_trivial
	class(evt_t), allocatable, target :: evt_shower
	type(shower_settings_t) :: settings
	type(taudec_settings_t) :: taudec_settings

	write (u, "(A)") "* Test output: shower_1"
	write (u, "(A)") "* Purpose: Two-jet event with disabled shower"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data%init ()
	call model_list%read_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"), &
	os_data, model_hadrons)
	call setup_testbed (var_str ("shower_1"), &
	os_data, lib, model_list, process, process_instance)

	write (u, "(A)") "* Set up trivial transform"
	write (u, "(A)")

	allocate (evt_trivial_t :: evt_trivial)
	model => process%get_model_ptr ()
	call evt_trivial%connect (process_instance, model)
	call evt_trivial%prepare_new_event (1, 1)
	call evt_trivial%generate_unweighted ()

	factorization_mode = FM_IGNORE_HELICITY
	keep_correlations = .false.
	call evt_trivial%make_particle_set (factorization_mode, keep_correlations)

	select type (evt_trivial)
	type is (evt_trivial_t)
	call evt_trivial%write (u)
	call write_separator (u, 2)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Set up shower event transform"
	write (u, "(A)")

	allocate (evt_shower_t :: evt_shower)
	select type (evt_shower)
	type is (evt_shower_t)
	call evt_shower%init (model_hadrons, os_data)
	allocate (shower_t :: evt_shower%shower)
	call evt_shower%shower%init (settings, taudec_settings, pdf_data, os_data)
	call evt_shower%connect (process_instance, model)
	end select

	evt_trivial%next => evt_shower
	evt_shower%previous => evt_trivial

	call evt_shower%prepare_new_event (1, 1)
	call evt_shower%generate_unweighted ()
	call evt_shower%make_particle_set (factorization_mode, keep_correlations)

	select type (evt_shower)
	type is (evt_shower_t)
	call evt_shower%write (u)
	call write_separator (u, 2)
	end select

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

	call evt_shower%final ()
	call evt_trivial%final ()
	call process_instance%final ()
	call process%final ()
	call lib%final ()
	call model_hadrons%final ()
	deallocate (model_hadrons)
	call syntax_model_file_final ()

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

	end subroutine shower_1

	@ %def shower_1
	@
	\subsubsection{FSR Shower}
	We generate a two-jet event and shower it with the Whizard FSR shower.
	<<Shower: execute tests>>=
	call test (shower_2, "shower_2", &
	"final-state shower", &
	u, results)
	<<Shower: test declarations>>=
	public :: shower_2
	<<Shower: tests>>=
	subroutine shower_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(process_library_t), target :: lib
	type(model_list_t) :: model_list
	type(model_t), pointer :: model_hadrons
	class(model_data_t), pointer :: model
	type(process_t), target :: process
	type(process_instance_t), target :: process_instance
	integer :: factorization_mode
	logical :: keep_correlations
	type(pdf_data_t) :: pdf_data
	class(evt_t), allocatable, target :: evt_trivial
	class(evt_t), allocatable, target :: evt_shower
	type(shower_settings_t) :: settings
	type(taudec_settings_t) :: taudec_settings

	write (u, "(A)") "* Test output: shower_2"
	write (u, "(A)") "* Purpose: Two-jet event with FSR shower"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data%init ()
	call model_list%read_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"), &
	os_data, model_hadrons)
	call setup_testbed (var_str ("shower_2"), &
	os_data, lib, model_list, process, process_instance)
	model => process%get_model_ptr ()

	write (u, "(A)") "* Set up trivial transform"
	write (u, "(A)")

	allocate (evt_trivial_t :: evt_trivial)
	call evt_trivial%connect (process_instance, model)
	call evt_trivial%prepare_new_event (1, 1)
	call evt_trivial%generate_unweighted ()

	factorization_mode = FM_IGNORE_HELICITY
	keep_correlations = .false.
	call evt_trivial%make_particle_set (factorization_mode, keep_correlations)

	select type (evt_trivial)
	type is (evt_trivial_t)
	call evt_trivial%write (u)
	call write_separator (u, 2)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Set up shower event transform"
	write (u, "(A)")

	settings%fsr_active = .true.

	allocate (evt_shower_t :: evt_shower)
	select type (evt_shower)
	type is (evt_shower_t)
	call evt_shower%init (model_hadrons, os_data)
	allocate (shower_t :: evt_shower%shower)
	call evt_shower%shower%init (settings, taudec_settings, pdf_data, os_data)
	call evt_shower%connect (process_instance, model)
	end select

	evt_trivial%next => evt_shower
	evt_shower%previous => evt_trivial

	call evt_shower%prepare_new_event (1, 1)
	call evt_shower%generate_unweighted ()
	call evt_shower%make_particle_set (factorization_mode, keep_correlations)

	select type (evt_shower)
	type is (evt_shower_t)
	call evt_shower%write (u, testflag = .true.)
	call write_separator (u, 2)
	end select

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

	call evt_shower%final ()
	call evt_trivial%final ()
	call process_instance%final ()
	call process%final ()
	call lib%final ()
	call model_hadrons%final ()
	deallocate (model_hadrons)
	call syntax_model_file_final ()

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

	end subroutine shower_2

	@ %def shower_2
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Fixed Order NLO Events}
	This section deals with the generation of weighted event samples which
	take into account next-to-leading order corrections. An approach
	generating unweighted events is not possible here, because negative
	weights might occur due to subtraction. Note that the events produced
	this way are not physical in the sense that they will not keep
	NLO-accuracy when interfaced to a parton shower. They are rather
	useful for theoretical consistency checks and a fast estimate of
	NLO effects.\\
	We generate NLO events in the following way: First, the integration
	is carried out using the complete divergence-subtracted NLO matrix
	element. In the subsequent simulation, $N$-particle kinematics
	are generated using $\mathcal{B}+\mathcal{V}+\mathcal{C}$ as weight.
	After that, the program loops over all singular regions and for each
	of them generates an event with $N+1$-particle kinematics.
	The weight for those events corresponds to the real matrix
	element $\mathcal{R}^\alpha$ evaluated at the $\alpha$-region's
	emitter's phase space point, multiplied with $S_\alpha$.
	This procedure is implemented using the [[evt_nlo]] transform.

	<<[[evt_nlo.f90]]>>=
	<<File header>>

	module evt_nlo

	<<Use kinds>>
	<<Use strings>>
	use constants
	use phs_points, only: phs_point_t
	use phs_points, only: assignment(=), operator(*), size
	use sm_qcd
	use model_data
	use particles
	use instances, only: process_instance_t
	use process_stacks
	use event_transforms
	use quantum_numbers, only: quantum_numbers_t

	use phs_fks, only: phs_fks_t, phs_fks_generator_t
	use phs_fks, only: phs_identifier_t, phs_point_set_t
	use resonances, only: resonance_contributors_t
	use fks_regions, only: region_data_t

	<<Standard module head>>

	<<Evt NLO: public>>

	<<Evt NLO: public parameters>>

	<<Evt NLO: types>>

	interface
	<<Evt NLO: sub interfaces>>
	end interface

	end module evt_nlo

	@ %def evt_nlo
	@
	<<[[evt_nlo_sub.f90]]>>=
	<<File header>>

	submodule (evt_nlo) evt_nlo_s

	<<Use debug>>
	use io_units, only: given_output_unit
	use diagnostics
	use format_utils, only: write_separator
	use numeric_utils, only: nearly_equal
	use physics_defs, only: BORN, NLO_REAL
	use lorentz
	use interactions, only: interaction_t
	use pcm, only: pcm_nlo_t, pcm_nlo_workspace_t
	use prc_core, only: prc_core_t
	use prc_external, only: prc_external_t
	use phs_fks, only: SQRTS_FIXED, SQRTS_VAR

	implicit none

	contains

	<<Evt NLO: procedures>>

	end submodule evt_nlo_s

	@ %def evt_nlo_s
	@
	<<Evt NLO: types>>=
	type :: nlo_event_deps_t
	logical :: lab_is_cm = .true.
	type(phs_point_set_t) :: p_born_cms
	type(phs_point_set_t) :: p_born_lab
	type(phs_point_set_t) :: p_real_cms
	type(phs_point_set_t) :: p_real_lab
	type(resonance_contributors_t), dimension(:), allocatable :: contributors
	type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers
	integer, dimension(:), allocatable :: alr_to_i_con
	integer :: n_phs = 0
	end type nlo_event_deps_t

	@ %def nlo_event_deps_t
	@ This event transformation is for the generation of fixed-order NLO
	events. It takes an event with Born kinematics and creates $N_\alpha + 1$
	modified weighted events. The first one has Born kinematics and its
	weight is the sum of Born, virtual, subtraction and, if present, also
	DGLAP matrix elements. The other $N_\alpha$ events have a weight which
	is equal to the real matrix element, evaluated with the phase space
	corresponding to the emitter of the $\alpha$-region.

	As the NLO event transforms have different kinematics, they also
	differ in their [[particle_set]]s. The NLO [[event_t]] object carries
	a single pointer to a [[particle_set]]. To avoid interference between
	the different NLO [[particle_set]]s, we save the [[particle_set]] of
	the current $\alpha$-region in the array [[particle_set_nlo]].
	Otherwise it would be unretrievable if the usual particle set of the
	event object was used.
	<<Evt NLO: public parameters>>=
	integer, parameter, public :: EVT_NLO_UNDEFINED = 0
	integer, parameter, public :: EVT_NLO_SEPARATE_BORNLIKE = 1
	integer, parameter, public :: EVT_NLO_SEPARATE_REAL = 2
	integer, parameter, public :: EVT_NLO_COMBINED = 3
	<<Evt NLO: public>>=
	public :: evt_nlo_t
	<<Evt NLO: types>>=
	type, extends (evt_t) :: evt_nlo_t
	type(phs_fks_generator_t) :: phs_fks_generator
	real(default) :: sqme_rad = zero
	integer :: i_evaluation = 0
	type(particle_set_t), dimension(:), allocatable :: particle_set_nlo
	type(qcd_t) :: qcd
	type(nlo_event_deps_t) :: event_deps
	integer :: mode = EVT_NLO_UNDEFINED
	integer, dimension(:), allocatable :: &
	i_evaluation_to_i_phs, i_evaluation_to_emitter, &
	i_evaluation_to_i_term
	logical :: keep_failed_events = .false.
	integer :: selected_i_flv = 0
	contains
	<<Evt NLO: evt nlo: TBP>>
	end type evt_nlo_t

	@ %def evt_nlo_t
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: write_name => evt_nlo_write_name
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_write_name (evt, unit)
	class(evt_nlo_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	end subroutine evt_nlo_write_name
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_write_name (evt, unit)
	class(evt_nlo_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: NLO"
	end subroutine evt_nlo_write_name

	@ %def evt_nlo_write_name
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: write => evt_nlo_write
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_write (evt, unit, verbose, more_verbose, testflag)
	class(evt_nlo_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	end subroutine evt_nlo_write
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_write (evt, unit, verbose, more_verbose, testflag)
	class(evt_nlo_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	integer :: u, i
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u)
	call evt%base_write (u, testflag = testflag, show_set = .true.)
	write (u,'(A,ES16.9)') "sqme_rad = ", evt%sqme_rad
	write (u, "(3x,A,I0)") "i_evaluation = ", evt%i_evaluation
	call write_separator (u)
	write (u, "(1x,A)") "Radiated particle sets:"
	do i = 1, size (evt%particle_set_nlo)
	call evt%particle_set_nlo(i)%write (u, testflag = testflag)
	call write_separator (u)
	end do
	end subroutine evt_nlo_write

	@ %def evt_nlo_write
	@ Connects the event transform to the process. Here also the phase space
	is set up by making [[real_kinematics]] point to the corresponding
	object in the [[pcm_instance]].
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: connect => evt_nlo_connect
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_connect &
	(evt, process_instance, model, process_stack)
	class(evt_nlo_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	end subroutine evt_nlo_connect
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_connect &
	(evt, process_instance, model, process_stack)
	class(evt_nlo_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	if (debug_on) call msg_debug (D_TRANSFORMS, "evt_nlo_connect")
	call evt%base_connect (process_instance, model, process_stack)
	select type (pcm_work => process_instance%pcm_work)
	class is (pcm_nlo_workspace_t)
	select type (pcm => process_instance%pcm)
	type is (pcm_nlo_t)
	call pcm%setup_phs_generator (pcm_work, evt%phs_fks_generator, &
	process_instance%get_sqrts ())
	call evt%set_i_evaluation_mappings (pcm%region_data, &
	pcm_work%real_kinematics%alr_to_i_phs)
	end select
	end select
	call evt%set_mode (process_instance)
	call evt%setup_general_event_kinematics (process_instance)
	if (evt%mode > EVT_NLO_SEPARATE_BORNLIKE) &
	call evt%setup_real_event_kinematics (process_instance)
	if (debug_on) call msg_debug2 (D_TRANSFORMS, "evt_nlo_connect: success")
	end subroutine evt_nlo_connect

	@ %def evt_nlo_connect
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: set_i_evaluation_mappings => evt_nlo_set_i_evaluation_mappings
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_set_i_evaluation_mappings &
	(evt, reg_data, alr_to_i_phs)
	class(evt_nlo_t), intent(inout) :: evt
	type(region_data_t), intent(in) :: reg_data
	integer, intent(in), dimension(:) :: alr_to_i_phs
	end subroutine evt_nlo_set_i_evaluation_mappings
	<<Evt NLO: types>>=
	type :: registered_triple_t
	integer, dimension(2) :: phs_em
	type(registered_triple_t), pointer :: next => null ()
	end type registered_triple_t
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_set_i_evaluation_mappings &
	(evt, reg_data, alr_to_i_phs)
	class(evt_nlo_t), intent(inout) :: evt
	type(region_data_t), intent(in) :: reg_data
	integer, intent(in), dimension(:) :: alr_to_i_phs
	integer :: n_phs, alr
	integer :: i_evaluation, i_phs, emitter
	logical :: checked
	type(registered_triple_t), allocatable, target :: check_list
	i_evaluation = 1
	n_phs = reg_data%n_phs
	allocate (evt%i_evaluation_to_i_phs (n_phs), source = 0)
	allocate (evt%i_evaluation_to_emitter (n_phs), source = -1)
	allocate (evt%i_evaluation_to_i_term (0 : n_phs), source = 0)
	do alr = 1, reg_data%n_regions
	i_phs = alr_to_i_phs (alr)
	emitter = reg_data%regions(alr)%emitter
	call search_check_list (checked)
	if (.not. checked) then
	evt%i_evaluation_to_i_phs (i_evaluation) = i_phs
	evt%i_evaluation_to_emitter (i_evaluation) = emitter
	i_evaluation = i_evaluation + 1
	end if
	end do
	call fill_i_evaluation_to_i_term ()
	if (.not. (all (evt%i_evaluation_to_i_phs > 0) &
	.and. all (evt%i_evaluation_to_emitter > -1))) then
	call msg_fatal ("evt_nlo: Inconsistent mappings!")
	else
	if (debug2_active (D_TRANSFORMS)) then
	print *, 'evt_nlo Mappings, i_evaluation -> '
	print *, 'i_phs: ', evt%i_evaluation_to_i_phs
	print *, 'emitter: ', evt%i_evaluation_to_emitter
	end if
	end if
	contains
	subroutine fill_i_evaluation_to_i_term ()
	integer :: i_term, i_evaluation, term_emitter
	!!! First find subtraction component
	i_evaluation = 1
	do i_term = 1, evt%process%get_n_terms ()
	if (evt%process_instance%term(i_term)%nlo_type /= NLO_REAL) cycle
	term_emitter = evt%process_instance%kin(i_term)%emitter
	if (term_emitter < 0) then
	evt%i_evaluation_to_i_term (0) = i_term
	else if (evt%i_evaluation_to_emitter(i_evaluation) == term_emitter) then
	evt%i_evaluation_to_i_term (i_evaluation) = i_term
	i_evaluation = i_evaluation + 1
	end if
	end do
	end subroutine fill_i_evaluation_to_i_term

	subroutine search_check_list (found)
	logical, intent(out) :: found
	type(registered_triple_t), pointer :: current_triple => null ()
	if (allocated (check_list)) then
	current_triple => check_list
	do
	if (all (current_triple%phs_em == [i_phs, emitter])) then
	found = .true.
	exit
	end if
	if (.not. associated (current_triple%next)) then
	allocate (current_triple%next)
	current_triple%next%phs_em = [i_phs, emitter]
	found = .false.
	exit
	else
	current_triple => current_triple%next
	end if
	end do
	else
	allocate (check_list)
	check_list%phs_em = [i_phs, emitter]
	found = .false.
	end if
	end subroutine search_check_list
	end subroutine evt_nlo_set_i_evaluation_mappings

	@ %def evt_nlo_set_i_evaluation_mappings
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: get_i_phs => evt_nlo_get_i_phs
	<<Evt NLO: sub interfaces>>=
	module function evt_nlo_get_i_phs (evt) result (i_phs)
	integer :: i_phs
	class(evt_nlo_t), intent(in) :: evt
	end function evt_nlo_get_i_phs
	<<Evt NLO: procedures>>=
	module function evt_nlo_get_i_phs (evt) result (i_phs)
	integer :: i_phs
	class(evt_nlo_t), intent(in) :: evt
	i_phs = evt%i_evaluation_to_i_phs (evt%i_evaluation)
	end function evt_nlo_get_i_phs

	@ %def evt_nlo_get_i_phs
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: get_emitter => evt_nlo_get_emitter
	<<Evt NLO: sub interfaces>>=
	module function evt_nlo_get_emitter (evt) result (emitter)
	integer :: emitter
	class(evt_nlo_t), intent(in) :: evt
	end function evt_nlo_get_emitter
	<<Evt NLO: procedures>>=
	module function evt_nlo_get_emitter (evt) result (emitter)
	integer :: emitter
	class(evt_nlo_t), intent(in) :: evt
	emitter = evt%i_evaluation_to_emitter (evt%i_evaluation)
	end function evt_nlo_get_emitter

	@ %def evt_nlo_get_emitter
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: get_i_term => evt_nlo_get_i_term
	<<Evt NLO: sub interfaces>>=
	module function evt_nlo_get_i_term (evt) result (i_term)
	integer :: i_term
	class(evt_nlo_t), intent(in) :: evt
	end function evt_nlo_get_i_term
	<<Evt NLO: procedures>>=
	module function evt_nlo_get_i_term (evt) result (i_term)
	integer :: i_term
	class(evt_nlo_t), intent(in) :: evt
	if (evt%mode >= EVT_NLO_SEPARATE_REAL) then
	i_term = evt%i_evaluation_to_i_term (evt%i_evaluation)
	else
	i_term = evt%process_instance%get_first_active_i_term ()
	end if
	end function evt_nlo_get_i_term

	@ %def evt_nlo_get_i_term
	@ The event transform has a variable which counts the number of times it
	has already been called for one generation point. If this variable,
	[[i_evaluation]], is zero, this means that [[evt_nlo_generate_weighted]] is called
	for the first time, so that the generation of an $N$-particle event is required.
	In all other cases, emission events are generated.

	During a separate integration of the real component, the first event of
	each event group will become the counterevent. In this case, we return
	the sum of all subtraction matrix elements.

	During a combined integration, the first event will be a combination of all
	Born-like events. To get the sum of their matrix elements, we subtract the
	sum of all real emissions from the sum of all matrix elements as the real
	contribution is the only non-Born contribution.

	Note that the argument named [[probablity]], the use of the routine
	[[generate_weighted]] and the procedure we use to generate NLO events via an
	event transformation is an abuse of the interface which should be refactored.
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: generate_weighted => evt_nlo_generate_weighted
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_generate_weighted (evt, probability)
	class(evt_nlo_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	end subroutine evt_nlo_generate_weighted
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_generate_weighted (evt, probability)
	class(evt_nlo_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	real(default) :: sqme
	call print_debug_info ()
	sqme = probability
	if (evt%mode > EVT_NLO_SEPARATE_BORNLIKE) then
	if (evt%i_evaluation == 0) then
	call evt%reset_phs_identifiers ()
	call evt%evaluate_real_kinematics ()
	if (evt%mode == EVT_NLO_SEPARATE_REAL) then
	sqme = evt%compute_subtraction_sqmes ()
	else
	sqme = sqme - evt%compute_all_sqme_rad ()
	end if
	else
	call evt%compute_real ()
	sqme = evt%sqme_rad
	end if
	end if
	probability = sqme
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "probability (after)", probability)
	contains
	function status_code_to_string (mode) result (smode)
	type(string_t) :: smode
	integer, intent(in) :: mode
	select case (mode)
	case (EVT_NLO_UNDEFINED)
	smode = var_str ("Undefined")
	case (EVT_NLO_SEPARATE_BORNLIKE)
	smode = var_str ("Born-like")
	case (EVT_NLO_SEPARATE_REAL)
	smode = var_str ("Real")
	case (EVT_NLO_COMBINED)
	smode = var_str ("Combined")
	end select
	end function status_code_to_string

	subroutine print_debug_info ()
	if (debug_on) call msg_debug (D_TRANSFORMS, "evt_nlo_generate_weighted")
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, char ("mode: " // status_code_to_string (evt%mode)))
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "probability (before)", probability)
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "evt%i_evaluation", evt%i_evaluation)
	if (debug2_active (D_TRANSFORMS)) then
	if (evt%mode > EVT_NLO_SEPARATE_BORNLIKE) then
	if (evt%i_evaluation == 0) then
	print *, 'Evaluate subtraction component'
	else
	print *, 'Evaluate radiation component'
	end if
	end if
	end if
	end subroutine print_debug_info
	end subroutine evt_nlo_generate_weighted

	@ %def evt_nlo_generate_weighted
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: reset_phs_identifiers => evt_nlo_reset_phs_identifiers
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_reset_phs_identifiers (evt)
	class(evt_nlo_t), intent(inout) :: evt
	end subroutine evt_nlo_reset_phs_identifiers
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_reset_phs_identifiers (evt)
	class(evt_nlo_t), intent(inout) :: evt
	evt%event_deps%phs_identifiers%evaluated = .false.
	end subroutine evt_nlo_reset_phs_identifiers

	@ %def evt_nlo_reset_phs_identifiers
	@ The routine [[make_factorized_particle_set]] will setup the subevent momenta
	from the [[connected%matrix]]. Its initial state momenta correspond
	to the Born process without IS splitting and thus need to be updated
	with the real momenta from the [[int_hard]] to get correct momenta in
	the events with real radiation.

	Ideally the [[int_hard]] and the [[connected]] would be setup with correct
	[[source_link]]s to real momenta so that we would not need to replace
	momenta of the [[connected]] here.

	The parameter [[n_in]] from the [[int_matrix]] is still $0$ as it has
	been shifted to [[n_vir]]. We thus take [[n_in]] from the [[particle_set]].
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: connected_set_real_IS_momenta => &
	evt_nlo_connected_set_real_IS_momenta
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_connected_set_real_IS_momenta (evt)
	class(evt_nlo_t), intent(inout) :: evt
	end subroutine evt_nlo_connected_set_real_IS_momenta
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_connected_set_real_IS_momenta (evt)
	class(evt_nlo_t), intent(inout) :: evt
	type(vector4_t) :: p_hard, p_beam, p_remn
	type(interaction_t), pointer :: int_matrix
	integer :: i, i_term, n_in, i_in_beam, i_in_hard, i_in_remn
	i_term = evt%get_i_term ()
	int_matrix => evt%process_instance%get_matrix_int_ptr (i_term)
	n_in = evt%particle_set%get_n_in ()
	do i = 1, n_in
	i_in_beam = i
	i_in_hard = n_in + i
	i_in_remn = 2 * n_in + i
	p_hard = evt%process_instance%term(i_term)%int_hard%get_momentum (i)
	p_beam = int_matrix%get_momentum (i_in_beam)
	p_remn = p_beam - p_hard
	call int_matrix%set_momentum (p_hard , i_in_hard)
	call int_matrix%set_momentum (p_remn , i_in_remn)
	end do
	end subroutine evt_nlo_connected_set_real_IS_momenta

	@ %def evt_nlo_connected_set_real_IS_momenta
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: make_particle_set => evt_nlo_make_particle_set
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_nlo_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	end subroutine evt_nlo_make_particle_set
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_nlo_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	if (evt%mode >= EVT_NLO_SEPARATE_BORNLIKE) then
	call make_factorized_particle_set (evt, factorization_mode, &
	keep_correlations, r, evt%get_i_term (), &
	evt%get_selected_quantum_numbers (evt%selected_i_flv))
	else
	call make_factorized_particle_set (evt, factorization_mode, &
	keep_correlations, r)
	end if
	end subroutine evt_nlo_make_particle_set

	@ %def evt_nlo_make_particle_set
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: evaluate_real_kinematics => evt_nlo_evaluate_real_kinematics
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_evaluate_real_kinematics (evt)
	class(evt_nlo_t), intent(inout) :: evt
	end subroutine evt_nlo_evaluate_real_kinematics
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_evaluate_real_kinematics (evt)
	class(evt_nlo_t), intent(inout) :: evt
	integer :: alr, i_phs, i_con, emitter
	real(default), dimension(3) :: x_rad
	logical :: use_contributors
	integer :: n_regions
	integer :: i_term
	type(vector4_t), dimension(:), allocatable :: p_real

	select type (pcm_work => evt%process_instance%pcm_work)
	class is (pcm_nlo_workspace_t)
	x_rad = pcm_work%real_kinematics%x_rad
	associate (event_deps => evt%event_deps)
	i_term = evt%get_i_term ()
	event_deps%p_born_lab%phs_point(1) = &
	evt%process_instance%term(i_term)%p_seed
	event_deps%p_born_cms%phs_point(1) &
	= evt%boost_to_cms (event_deps%p_born_lab%phs_point(1))
	call evt%phs_fks_generator%set_sqrts_hat &
	(event_deps%p_born_cms%get_energy (1, 1))
	use_contributors = allocated (event_deps%contributors)
	select type (pcm => evt%process_instance%pcm)
	type is (pcm_nlo_t)
	n_regions = pcm%region_data%n_regions
	end select
	do alr = 1, n_regions
	i_phs = pcm_work%real_kinematics%alr_to_i_phs(alr)
	if (event_deps%phs_identifiers(i_phs)%evaluated) cycle
	emitter = event_deps%phs_identifiers(i_phs)%emitter
	associate (generator => evt%phs_fks_generator)
	if (emitter <= evt%process%get_n_in ()) then
	call generator%prepare_generation (x_rad, i_phs, emitter, &
	event_deps%p_born_cms%phs_point(1)%get (), &
	event_deps%phs_identifiers)
	! TODO wk 19-02-28: intent of p_real (also below)?
	p_real = event_deps%p_real_lab%phs_point(i_phs)
	select case (generator%isr_kinematics%isr_mode)
	case (SQRTS_FIXED)
	call generator%generate_isr_fixed_beam_energy (i_phs, &
	event_deps%p_born_cms%phs_point(1)%get (), &
	p_real)
	case (SQRTS_VAR)
	call generator%generate_isr (i_phs, &
	event_deps%p_born_lab%phs_point(1)%get (), &
	p_real)
	end select
	event_deps%p_real_lab%phs_point(i_phs) = p_real
	event_deps%p_real_cms%phs_point(i_phs) &
	= evt%boost_to_cms (event_deps%p_real_lab%phs_point(i_phs))
	else
	if (use_contributors) then
	i_con = event_deps%alr_to_i_con(alr)
	call generator%prepare_generation (x_rad, i_phs, emitter, &
	event_deps%p_born_cms%phs_point(1)%get (), &
	event_deps%phs_identifiers, event_deps%contributors, i_con)
	p_real = event_deps%p_real_cms%phs_point(i_phs)
	call generator%generate_fsr (emitter, i_phs, i_con, &
	event_deps%p_born_cms%phs_point(1)%get (), &
	p_real)
	event_deps%p_real_cms%phs_point(i_phs) = p_real
	else
	call generator%prepare_generation (x_rad, i_phs, emitter, &
	event_deps%p_born_cms%phs_point(1)%get (), &
	event_deps%phs_identifiers)
	p_real = event_deps%p_real_cms%phs_point(i_phs)
	call generator%generate_fsr (emitter, i_phs, &
	event_deps%p_born_cms%phs_point(1)%get (), &
	p_real)
	event_deps%p_real_cms%phs_point(i_phs) = p_real
	end if
	event_deps%p_real_lab%phs_point(i_phs) &
	= evt%boost_to_lab (event_deps%p_real_cms%phs_point(i_phs))
	end if
	end associate
	call pcm_work%set_momenta &
	(event_deps%p_born_lab%phs_point(1)%get (), &
	event_deps%p_real_lab%phs_point(i_phs)%get (), &
	i_phs)
	call pcm_work%set_momenta &
	(event_deps%p_born_cms%phs_point(1)%get (), &
	event_deps%p_real_cms%phs_point(i_phs)%get (), &
	i_phs, cms = .true.)
	event_deps%phs_identifiers(i_phs)%evaluated = .true.
	end do
	end associate
	end select
	end subroutine evt_nlo_evaluate_real_kinematics

	@ %def evt_nlo_evaluate_real_kinematics
	@ This routine calls the evaluation of the singular regions only for the
	subtraction terms.
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: compute_subtraction_sqmes => evt_nlo_compute_subtraction_sqmes
	<<Evt NLO: sub interfaces>>=
	module function evt_nlo_compute_subtraction_sqmes (evt) result (sqme)
	class(evt_nlo_t), intent(inout) :: evt
	real(default) :: sqme
	end function evt_nlo_compute_subtraction_sqmes
	<<Evt NLO: procedures>>=
	module function evt_nlo_compute_subtraction_sqmes (evt) result (sqme)
	class(evt_nlo_t), intent(inout) :: evt
	real(default) :: sqme
	integer :: i_phs, i_term
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "evt_nlo_compute_subtraction_sqmes")
	sqme = zero
	associate (event_deps => evt%event_deps)
	i_phs = 1; i_term = evt%i_evaluation_to_i_term(0)
	call evt%process_instance%compute_sqme_rad &
	(i_term, i_phs, is_subtraction = .true.)
	sqme = sqme + evt%process_instance%get_sqme (i_term)
	end associate
	end function evt_nlo_compute_subtraction_sqmes

	@ %def evt_nlo_compute_subtraction_sqmes
	@ This routine calls the evaluation of the singular regions only for
	emission matrix elements.
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: compute_real => evt_nlo_compute_real
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_compute_real (evt)
	class(evt_nlo_t), intent(inout) :: evt
	end subroutine evt_nlo_compute_real
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_compute_real (evt)
	class(evt_nlo_t), intent(inout) :: evt
	integer :: i_phs, i_term
	if (debug_on) call msg_debug (D_TRANSFORMS, "evt_nlo_compute_real")
	i_phs = evt%get_i_phs ()
	i_term = evt%i_evaluation_to_i_term (evt%i_evaluation)
	associate (event_deps => evt%event_deps)
	call evt%process_instance%compute_sqme_rad (i_term, i_phs, &
	is_subtraction = .false.)
	evt%sqme_rad = evt%process_instance%get_sqme (i_term)
	end associate
	end subroutine evt_nlo_compute_real

	@ %def evt_nlo_compute_real
	@ This routine calls the evaluation of the singular regions only for all
	emission matrix elements. This is needed for the combined mode. It returns
	the sum of all valid real matrix elements.
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: compute_all_sqme_rad => evt_nlo_compute_all_sqme_rad
	<<Evt NLO: sub interfaces>>=
	module function evt_nlo_compute_all_sqme_rad (evt) result (sqme)
	class(evt_nlo_t), intent(inout) :: evt
	real(default) :: sqme
	end function evt_nlo_compute_all_sqme_rad
	<<Evt NLO: procedures>>=
	module function evt_nlo_compute_all_sqme_rad (evt) result (sqme)
	class(evt_nlo_t), intent(inout) :: evt
	real(default) :: sqme
	integer :: i_phs, i_term
	if (debug_on) call msg_debug (D_TRANSFORMS, "evt_nlo_compute_all_sqme_rad")
	sqme = zero
	do i_term = 1, size (evt%process_instance%term)
	if (evt%is_valid_event (i_term)) then
	associate (term => evt%process_instance%term(i_term))
	if (term%nlo_type == NLO_REAL .and. &
	.not. term%is_subtraction ()) then
	i_phs = evt%process_instance%kin(i_term)%i_phs
	call evt%process_instance%compute_sqme_rad ( &
	i_term, i_phs, is_subtraction = .false.)
	sqme = sqme + evt%process_instance%get_sqme (i_term)
	end if
	end associate
	end if
	end do
	end function evt_nlo_compute_all_sqme_rad

	@ %def evt_nlo_compute_all_sqme_rad
	@ Boosts the given four vector [[p_lab]] to the Born or real CMS
	depending on the number of given momenta. Unfortunately, all boosts
	available via [[get_boost_to_cms]] are Born-like, so we need to
	compute the boost to the real CMS here manually. We cannot rely on
	[[i_term]] in order to determine whether to apply a Born-like or a
	real boost as we also need a real boost to compute the weights of the
	Born-like subevents as implemented in [[evt_nlo_generate_weighted]].
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: boost_to_cms => evt_nlo_boost_to_cms
	<<Evt NLO: sub interfaces>>=
	module function evt_nlo_boost_to_cms (evt, p_lab) result (p_cms)
	type(phs_point_t), intent(in) :: p_lab
	class(evt_nlo_t), intent(in) :: evt
	type(phs_point_t) :: p_cms
	end function evt_nlo_boost_to_cms
	<<Evt NLO: procedures>>=
	module function evt_nlo_boost_to_cms (evt, p_lab) result (p_cms)
	type(phs_point_t), intent(in) :: p_lab
	class(evt_nlo_t), intent(in) :: evt
	type(phs_point_t) :: p_cms
	type(vector4_t) :: p0, p1
	type(lorentz_transformation_t) :: lt_lab_to_cms, lt
	real(default) :: sqrts_hat
	integer :: i_boost, n_legs_born
	if (evt%event_deps%lab_is_cm) then
	lt_lab_to_cms = identity
	else
	n_legs_born = size (evt%event_deps%p_born_lab%phs_point(1))
	if (size (p_lab) == n_legs_born) then
	i_boost = evt%get_i_term ()
	lt_lab_to_cms = evt%process_instance%get_boost_to_cms (i_boost)
	else
	sqrts_hat = (p_lab%select (1) + p_lab%select (2))**1
	p0 = p_lab%select (1) + p_lab%select (2)
	lt = boost (p0, sqrts_hat)
	p1 = inverse(lt) * p_lab%select (1)
	lt_lab_to_cms = inverse (lt * rotation_to_2nd (3, space_part (p1)))
	end if
	end if
	p_cms = lt_lab_to_cms * p_lab
	end function evt_nlo_boost_to_cms

	@ %def evt_nlo_boost_to_cms
	@ Boosts the given four vector [[p_cms]] from the Born CMS to the lab
	system. It should not be called for ISR as in this case, the Born CMS
	and the real CMS differ.
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: boost_to_lab => evt_nlo_boost_to_lab
	<<Evt NLO: sub interfaces>>=
	module function evt_nlo_boost_to_lab (evt, p_cms) result (p_lab)
	type(phs_point_t) :: p_lab
	class(evt_nlo_t), intent(in) :: evt
	type(phs_point_t), intent(in) :: p_cms
	end function evt_nlo_boost_to_lab
	<<Evt NLO: procedures>>=
	module function evt_nlo_boost_to_lab (evt, p_cms) result (p_lab)
	type(phs_point_t) :: p_lab
	class(evt_nlo_t), intent(in) :: evt
	type(phs_point_t), intent(in) :: p_cms
	type(lorentz_transformation_t) :: lt_cms_to_lab
	integer :: i_boost
	if (evt%event_deps%lab_is_cm) then
	lt_cms_to_lab = identity
	else
	i_boost = evt%get_i_term ()
	lt_cms_to_lab = evt%process_instance%get_boost_to_lab (i_boost)
	end if
	p_lab = lt_cms_to_lab * p_cms
	end function evt_nlo_boost_to_lab

	@ %def evt_nlo_boost_to_lab
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: setup_general_event_kinematics => &
	evt_nlo_setup_general_event_kinematics
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_setup_general_event_kinematics &
	(evt, process_instance)
	class(evt_nlo_t), intent(inout) :: evt
	type(process_instance_t), intent(in) :: process_instance
	end subroutine evt_nlo_setup_general_event_kinematics
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_setup_general_event_kinematics &
	(evt, process_instance)
	class(evt_nlo_t), intent(inout) :: evt
	type(process_instance_t), intent(in) :: process_instance
	integer :: n_born
	associate (event_deps => evt%event_deps)
	event_deps%lab_is_cm = process_instance%lab_is_cm (1)
	select type (pcm => process_instance%pcm)
	type is (pcm_nlo_t)
	n_born = pcm%region_data%n_legs_born
	end select
	call event_deps%p_born_cms%init (n_born, 1)
	call event_deps%p_born_lab%init (n_born, 1)
	end associate
	end subroutine evt_nlo_setup_general_event_kinematics

	@ %def evt_nlo_setup_general_event_kinematics
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: setup_real_event_kinematics => &
	evt_nlo_setup_real_event_kinematics
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_setup_real_event_kinematics &
	(evt, process_instance)
	class(evt_nlo_t), intent(inout) :: evt
	type(process_instance_t), intent(in) :: process_instance
	end subroutine evt_nlo_setup_real_event_kinematics
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_setup_real_event_kinematics (evt, process_instance)
	class(evt_nlo_t), intent(inout) :: evt
	type(process_instance_t), intent(in) :: process_instance
	integer :: n_real, n_phs
	integer :: i_real
	associate (event_deps => evt%event_deps)
	select type (pcm => process_instance%pcm)
	class is (pcm_nlo_t)
	n_real = pcm%region_data%n_legs_real
	end select
	i_real = evt%process%get_first_real_term ()
	select type (phs => process_instance%kin(i_real)%phs)
	type is (phs_fks_t)
	event_deps%phs_identifiers = phs%phs_identifiers
	end select
	n_phs = size (event_deps%phs_identifiers)
	call event_deps%p_real_cms%init (n_real, n_phs)
	call event_deps%p_real_lab%init (n_real, n_phs)
	select type (pcm => process_instance%pcm)
	type is (pcm_nlo_t)
	if (allocated (pcm%region_data%alr_contributors)) then
	allocate (event_deps%contributors &
	(size (pcm%region_data%alr_contributors)))
	event_deps%contributors = pcm%region_data%alr_contributors
	end if
	if (allocated (pcm%region_data%alr_to_i_contributor)) then
	allocate (event_deps%alr_to_i_con &
	(size (pcm%region_data%alr_to_i_contributor)))
	event_deps%alr_to_i_con = pcm%region_data%alr_to_i_contributor
	end if
	end select
	end associate
	end subroutine evt_nlo_setup_real_event_kinematics

	@ %def evt_nlo_setup_real_event_kinematics
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: set_mode => evt_nlo_set_mode
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_set_mode (evt, process_instance)
	class(evt_nlo_t), intent(inout) :: evt
	type(process_instance_t), intent(in) :: process_instance
	end subroutine evt_nlo_set_mode
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_set_mode (evt, process_instance)
	class(evt_nlo_t), intent(inout) :: evt
	type(process_instance_t), intent(in) :: process_instance
	integer :: i_real
	select type (pcm => process_instance%pcm)
	type is (pcm_nlo_t)
	if (pcm%settings%combined_integration) then
	evt%mode = EVT_NLO_COMBINED
	else
	i_real = evt%process%get_first_real_component ()
	if (i_real == evt%process%extract_active_component_mci ()) then
	evt%mode = EVT_NLO_SEPARATE_REAL
	else
	evt%mode = EVT_NLO_SEPARATE_BORNLIKE
	end if
	end if
	end select
	end subroutine evt_nlo_set_mode

	@ %def evt_nlo_set_mode
	@
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: is_valid_event => evt_nlo_is_valid_event
	<<Evt NLO: sub interfaces>>=
	module function evt_nlo_is_valid_event (evt, i_term) result (valid)
	logical :: valid
	class(evt_nlo_t), intent(in) :: evt
	integer, intent(in) :: i_term
	end function evt_nlo_is_valid_event
	<<Evt NLO: procedures>>=
	module function evt_nlo_is_valid_event (evt, i_term) result (valid)
	logical :: valid
	class(evt_nlo_t), intent(in) :: evt
	integer, intent(in) :: i_term
	valid = evt%process_instance%term(i_term)%passed
	end function evt_nlo_is_valid_event

	@ %def evt_nlo_is_valid_event
	@ Retrieves the actual quantum numbers chosen in [[evt_nlo_prepare_new_event]].
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: get_selected_quantum_numbers => &
	evt_nlo_get_selected_quantum_numbers
	<<Evt NLO: sub interfaces>>=
	module function evt_nlo_get_selected_quantum_numbers &
	(evt, i_flv) result (qn_select)
	class(evt_nlo_t), intent(in) :: evt
	integer, intent(in) :: i_flv
	type(quantum_numbers_t), dimension(:), allocatable :: qn_select
	end function evt_nlo_get_selected_quantum_numbers
	<<Evt NLO: procedures>>=
	module function evt_nlo_get_selected_quantum_numbers &
	(evt, i_flv) result (qn_select)
	class(evt_nlo_t), intent(in) :: evt
	integer, intent(in) :: i_flv
	type(quantum_numbers_t), dimension(:), allocatable :: qn_select
	integer :: i_term, index
	i_term = evt%get_i_term ()
	associate (term => evt%process_instance%term(i_term))
	index = term%connected%matrix%get_qn_index (i_flv, i_sub = 0)
	qn_select = term%connected%matrix%get_quantum_numbers (index)
	end associate
	end function evt_nlo_get_selected_quantum_numbers

	@ %def evt_nlo_get_selected_quantum_numbers
	@ Selects a flavor structure for Born subevents, such that each
	possible flavor structure is as probable as its portion of the sum of
	Born matrix elements over all flavors. For non-Born Born-like
	subevents, no Born matrix elements are available. We always choose
	[[i_flv = 1]] in this case. If all terms are active, i.e. in a full
	NLO calculation, the flavors of Born-like subevents will be
	distributed according to the Born matrix elements only, to avoid
	issues with matrix elements of different sign and assure a LO flavor
	distribution.

	Likewise, the real-like event flavors are distributed according to the
	real matrix elements. Here, we need to make sure to not mix matrix
	elements from different real terms and instead determine the flavor
	for each subevent based on just the matrix elements for one of the
	terms. The implementation below assumes that in the sequence of NLO
	terms, the Born term is immediately followed by all the real terms
	which are again followed by the subtraction, the virtual and the DGLAP
	term.

	Both flavor structures can be determined without correlation as the
	flavors will only become important for events to be matched to a
	parton shower and in this case we will only generate either a single
	Born-like or a single real-like event which are not part of an event
	group.

	In case all subevents failed the cuts, all [[sqme]]s were set to $0$
	so we cannot determine the flavor in this way. In this case, we always
	choose the first flavor structure given by the matrix-element
	generator with [[i_flv = 1]].

	Ideally, having to choose a particle set here would not be necessary
	as it is also chosen in [[particle_set_init_interaction]] which in the
	current approach is disabled by supplying [[qn_select]] explicitly
	based on the flavors chosen here.
	<<Evt NLO: evt nlo: TBP>>=
	procedure :: prepare_new_event => evt_nlo_prepare_new_event
	<<Evt NLO: sub interfaces>>=
	module subroutine evt_nlo_prepare_new_event (evt, i_mci, i_term)
	class(evt_nlo_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	end subroutine evt_nlo_prepare_new_event
	<<Evt NLO: procedures>>=
	module subroutine evt_nlo_prepare_new_event (evt, i_mci, i_term)
	class(evt_nlo_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	real(default) :: s, x
	real(default) :: sqme_total
	real(default), dimension(:), allocatable :: sqme_flv
	integer :: i, i_flv, i_core, emitter, n_in
	logical, save :: warn_once = .true.
	class(prc_core_t), pointer :: core => null ()
	call evt%reset ()
	call evt%rng%generate (x)
	do i = 1, size (evt%process_instance%term)
	associate (term => evt%process_instance%term(i))
	if (evt%i_evaluation == 0) then
	if (term%nlo_type == BORN) then
	allocate (sqme_flv (term%config%data%n_flv))
	exit
	end if
	else
	if (term%nlo_type == NLO_REAL .and. .not. term%is_subtraction()) then
	allocate (sqme_flv (term%config%data%n_flv))
	exit
	end if
	end if
	end associate
	end do
	sqme_total = zero
	sqme_flv = zero
	i_core = evt%process%get_i_core (i_term)
	core => evt%process%get_core_ptr (i_core)
	do i = 1, size (evt%process_instance%term)
	associate (term => evt%process_instance%term(i))
	if (i == evt%i_evaluation + 1 .and. (term%nlo_type == BORN .or. &
	(term%nlo_type == NLO_REAL .and. .not. term%is_subtraction())) ) then
	sqme_total = sqme_total + real (sum ( term%connected%matrix%get_matrix_element ()))
	!!! TODO (VR 2020-02-19) figure out why this select type is needed for prc_omega_t
	!!! For NLO and prc_omega_t the connected trace seems to be set up incorrectly!
	!!! (PS 2020-11-05) This leads to real events of processes with structure functions
	!!! having a wrong flavor distribution if computed with O'Mega.
	!!! The flavor distributions are identical with and also without the special case
	!!! for O'Mega and wrong in both cases.
	!!! However, this case it is not critical as long as O'Mega does not provide matrix elements
	!!! exclusive in coupling orders and is thus only rarely used for NLO applications anyways
	select type (core)
	class is (prc_external_t)
	do i_flv = 1, size (sqme_flv)
	if (allocated (term%passed_array)) then
	if (term%passed .and. .not. term%passed_array(i_flv)) cycle
	end if
	sqme_flv(i_flv) = sqme_flv(i_flv) &
	+ real (term%connected%matrix%get_matrix_element ( &
	term%connected%matrix%get_qn_index (i_flv, i_sub = 0)))
	end do
	class default
	sqme_flv = sqme_flv &
	+ real (term%connected%matrix%get_matrix_element ())
	emitter = evt%process_instance%kin(i)%emitter
	n_in = evt%process_instance%kin(i)%n_in
	if (warn_once .and. term%nlo_type == NLO_REAL .and. emitter <= n_in) then
	warn_once = .false.
	call msg_warning("evt_nlo_prepare_new_event: fNLO flavor&
	& distributions with O'Mega are wrong.")
	end if
	end select
	end if
	end associate
	end do
	if (debug2_active (D_TRANSFORMS)) then
	if (.not. nearly_equal(sqme_total, sum (sqme_flv))) then
	call msg_warning ("evt_nlo_prepare_new_event: &
	&sum over flavored sqmes does not match total sqme.")
	end if
	end if
	!!! Need absolute values to take into account negative weights
	x = x * abs (sqme_total)
	s = abs (sqme_flv (1))
	evt%selected_i_flv = 1
	if (s < x) then
	do i_flv = 2, size (sqme_flv)
	s = s + abs (sqme_flv (i_flv))
	if (s > x) then
	evt%selected_i_flv = i_flv
	exit
	end if
	end do
	end if
	if (debug2_active (D_TRANSFORMS)) then
	call msg_print_color ("Selected i_flv: ", COL_GREEN)
	print *, evt%selected_i_flv
	end if
	end subroutine evt_nlo_prepare_new_event

	@ %def evt_nlo_prepare_new_event
	@
	\section{Complete Events}
	This module combines hard processes with decay chains, shower, and
	hadronization (not implemented yet) to complete events. It also
	manages the input and output of event records in various formats.
	<<[[events.f90]]>>=
	<<File header>>

	module events

	<<Use kinds>>
	<<Use strings>>
	use diagnostics
	use variables
	use expr_base
	use model_data
	use state_matrices, only: FM_IGNORE_HELICITY, &
	FM_SELECT_HELICITY, FM_FACTOR_HELICITY, FM_CORRELATED_HELICITY
	use particles
	use subevt_expr
	use rng_base
	use process, only: process_t
	use instances, only: process_instance_t
	use process_stacks
	use event_base
	use event_transforms

	<<Standard module head>>

	<<Events: public>>

	<<Events: types>>

	<<Events: interfaces>>

	interface
	<<Events: sub interfaces>>
	end interface

	contains

	<<Events: main procedures>>

	end module events
	@ %def events
	@
	<<[[events_sub.f90]]>>=
	<<File header>>

	submodule (events) events_s

	<<Use debug>>
	use constants, only: one
	use io_units
	use format_utils, only: pac_fmt, write_separator
	use format_defs, only: FMT_12, FMT_19
	use numeric_utils
	use pcm, only: pcm_nlo_workspace_t
	use decays
	use evt_nlo
	use phs_fks, only: SQRTS_FIXED, SQRTS_VAR

	implicit none

	contains

	<<Events: procedures>>

	end submodule events_s

	@ %def events_s
	@
	\subsection{Event configuration}
	The parameters govern the transformation of an event to a particle set.

	The [[safety_factor]] reduces the acceptance probability for
	unweighting. If greater than one, excess events become less likely,
	but the reweighting efficiency also drops.

	The [[sigma]] and [[n]] values, if nontrivial, allow for reweighting
	the events according to the requested [[norm_mode]].

	Various [[parse_node_t]] objects are taken from the SINDARIN input.
	They encode expressions that apply to the current event. The
	workspaces for evaluating those expressions are set up in the
	[[event_expr_t]] objects. Note that these are really pointers,
	so the actual nodes are not stored inside the event object.
	<<Events: types>>=
	type :: event_config_t
	logical :: unweighted = .false.
	integer :: norm_mode = NORM_UNDEFINED
	integer :: factorization_mode = FM_IGNORE_HELICITY
	logical :: keep_correlations = .false.
	logical :: colorize_subevt = .false.
	real(default) :: sigma = 1
	integer :: n = 1
	real(default) :: safety_factor = 1
	class(expr_factory_t), allocatable :: ef_selection
	class(expr_factory_t), allocatable :: ef_reweight
	class(expr_factory_t), allocatable :: ef_analysis
	contains
	<<Events: event config: TBP>>
	end type event_config_t

	@ %def event_config_t
	@ Output.
	<<Events: event config: TBP>>=
	procedure :: write => event_config_write
	<<Events: sub interfaces>>=
	module subroutine event_config_write (object, unit, show_expressions)
	class(event_config_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_expressions
	end subroutine event_config_write
	<<Events: procedures>>=
	module subroutine event_config_write (object, unit, show_expressions)
	class(event_config_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_expressions
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A,L1)") "Unweighted = ", object%unweighted
	write (u, "(3x,A,A)") "Normalization = ", &
	char (event_normalization_string (object%norm_mode))
	write (u, "(3x,A)", advance="no") "Helicity handling = "
	select case (object%factorization_mode)
	case (FM_IGNORE_HELICITY)
	write (u, "(A)") "drop"
	case (FM_SELECT_HELICITY)
	write (u, "(A)") "select"
	case (FM_FACTOR_HELICITY)
	write (u, "(A)") "factorize"
	end select
	write (u, "(3x,A,L1)") "Keep correlations = ", object%keep_correlations
	if (object%colorize_subevt) then
	write (u, "(3x,A,L1)") "Colorize subevent = ", object%colorize_subevt
	end if
	if (.not. nearly_equal (object%safety_factor, one)) then
	write (u, "(3x,A," // FMT_12 // ")") &
	"Safety factor = ", object%safety_factor
	end if
	if (present (show_expressions)) then
	if (show_expressions) then
	if (allocated (object%ef_selection)) then
	call write_separator (u)
	write (u, "(3x,A)") "Event selection expression:"
	call object%ef_selection%write (u)
	end if
	if (allocated (object%ef_reweight)) then
	call write_separator (u)
	write (u, "(3x,A)") "Event reweighting expression:"
	call object%ef_reweight%write (u)
	end if
	if (allocated (object%ef_analysis)) then
	call write_separator (u)
	write (u, "(3x,A)") "Analysis expression:"
	call object%ef_analysis%write (u)
	end if
	end if
	end if
	end subroutine event_config_write

	@ %def event_config_write
	@
	\subsection{The event type}
	This is the concrete implementation of the [[generic_event_t]] core
	that is defined above in the [[event_base]] module. The core manages
	the main (dressed) particle set pointer and the current values for
	weights and sqme. The implementation adds configuration data,
	expressions, process references, and event transforms.

	Each event refers to a single elementary process. This process may be
	dressed by a shower, a decay chain etc. We maintain pointers to a
	process instance.

	A list of event transforms (class [[evt_t]]) transform the connected
	interactions of the process instance into the final particle set. In
	this list, the first transform is always the trivial one, which just
	factorizes the process instance. Subsequent transforms may apply
	decays, etc. The [[particle_set]] pointer identifies the particle set
	that we want to be analyzed and returned by the event, usually the
	last one.

	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.

	The [[sqme]] and [[weight]] values mirror corresponding values in the
	[[expr]] subobject. The idea is that when generating or reading
	events, the event record is filled first, then the [[expr]] object
	acquires copies. These copies are used for writing events and as targets
	for pointer variables in the analysis expression.

	All data that involve user-provided expressions (selection, reweighting,
	analysis) are handled by the [[expr]] subobject. In particular, evaluating
	the event-selection expression sets the [[passed]] flag. Furthermore,
	the [[expr]] subobject collects data that can be used in the analysis
	and should be written to file, including copies of [[sqme]] and [[weight]].
	<<Events: public>>=
	public :: event_t
	<<Events: types>>=
	type, extends (generic_event_t) :: event_t
	type(event_config_t) :: config
	type(process_t), pointer :: process => null ()
	type(process_instance_t), pointer :: instance => null ()
	class(rng_t), allocatable :: rng
	integer :: selected_i_mci = 0
	integer :: selected_i_term = 0
	integer :: selected_channel = 0
	logical :: is_complete = .false.
	class(evt_t), pointer :: transform_first => null ()
	class(evt_t), pointer :: transform_last => null ()
	type(event_expr_t) :: expr
	logical :: selection_evaluated = .false.
	logical :: passed = .false.
	real(default), allocatable :: alpha_qcd_forced
	real(default), allocatable :: scale_forced
	real(default) :: reweight = 1
	logical :: analysis_flag = .false.
	integer :: i_event = 0
	contains
	<<Events: event: TBP>>
	end type event_t

	@ %def event_t
	@
	<<Events: event: TBP>>=
	procedure :: clone => event_clone
	<<Events: sub interfaces>>=
	module subroutine event_clone (event, event_new)
	class(event_t), intent(in), target :: event
	class(event_t), intent(out), target:: event_new
	end subroutine event_clone
	<<Events: procedures>>=
	module subroutine event_clone (event, event_new)
	class(event_t), intent(in), target :: event
	class(event_t), intent(out), target:: event_new
	type(string_t) :: id
	integer :: num_id
	event_new%config = event%config
	event_new%process => event%process
	event_new%instance => event%instance
	if (allocated (event%rng)) &
	allocate(event_new%rng, source=event%rng)
	event_new%selected_i_mci = event%selected_i_mci
	event_new%selected_i_term = event%selected_i_term
	event_new%selected_channel = event%selected_channel
	event_new%is_complete = event%is_complete
	event_new%transform_first => event%transform_first
	event_new%transform_last => event%transform_last
	event_new%selection_evaluated = event%selection_evaluated
	event_new%passed = event%passed
	if (allocated (event%alpha_qcd_forced)) &
	allocate(event_new%alpha_qcd_forced, source=event%alpha_qcd_forced)
	if (allocated (event%scale_forced)) &
	allocate(event_new%scale_forced, source=event%scale_forced)
	event_new%reweight = event%reweight
	event_new%analysis_flag = event%analysis_flag
	event_new%i_event = event%i_event
	id = event_new%process%get_id ()
	if (id /= "") call event_new%expr%set_process_id (id)
	num_id = event_new%process%get_num_id ()
	if (num_id /= 0) call event_new%expr%set_process_num_id (num_id)
	call event_new%expr%setup_vars (event_new%process%get_sqrts ())
	call event_new%expr%link_var_list (event_new%process%get_var_list_ptr ())
	end subroutine event_clone

	@ %def event_clone
	@ Finalizer: the list of event transforms is deleted iteratively.
	<<Events: event: TBP>>=
	procedure :: final => event_final
	<<Events: sub interfaces>>=
	module subroutine event_final (object)
	class(event_t), intent(inout) :: object
	end subroutine event_final
	<<Events: procedures>>=
	module subroutine event_final (object)
	class(event_t), intent(inout) :: object
	class(evt_t), pointer :: evt
	if (allocated (object%rng)) call object%rng%final ()
	call object%expr%final ()
	do while (associated (object%transform_first))
	evt => object%transform_first
	object%transform_first => evt%next
	call evt%final ()
	deallocate (evt)
	end do
	end subroutine event_final

	@ %def event_final
	@ Output.

	The event index is written in the header, it should coincide with the
	[[event_index]] variable that can be used in selection and analysis.

	Particle set: this is a pointer to one of the event transforms, so it
	should suffice to print the latter.
	<<Events: event: TBP>>=
	procedure :: write => event_write
	<<Events: sub interfaces>>=
	module subroutine event_write (object, unit, show_process, &
	show_transforms, show_decay, verbose, testflag)
	class(event_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_process, show_transforms, show_decay
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: testflag
	end subroutine event_write
	<<Events: procedures>>=
	module subroutine event_write (object, unit, show_process, &
	show_transforms, show_decay, verbose, testflag)
	class(event_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_process, show_transforms, show_decay
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: testflag
	logical :: prc, trans, dec, verb
	class(evt_t), pointer :: evt
	character(len=7) :: fmt
	integer :: u, i
	call pac_fmt (fmt, FMT_19, FMT_12, testflag)
	u = given_output_unit (unit)
	prc = .true.; if (present (show_process)) prc = show_process
	trans = .true.; if (present (show_transforms)) trans = show_transforms
	dec = .true.; if (present (show_decay)) dec = show_decay
	verb = .false.; if (present (verbose)) verb = verbose
	call write_separator (u, 2)
	write (u, "(1x,A)", advance="no") "Event"
	if (object%has_index ()) then
	write (u, "(1x,'#',I0)", advance="no") object%get_index ()
	end if
	if (object%is_complete) then
	write (u, *)
	else
	write (u, "(1x,A)") "[incomplete]"
	end if
	call write_separator (u)
	call object%config%write (u)
	if (object%sqme_ref_is_known () .or. object%weight_ref_is_known ()) then
	call write_separator (u)
	end if
	if (object%sqme_ref_is_known ()) then
	write (u, "(3x,A," // fmt // ")") &
	"Squared matrix el. (ref) = ", object%get_sqme_ref ()
	if (object%sqme_alt_is_known ()) then
	do i = 1, object%get_n_alt ()
	write (u, "(5x,A," // fmt // ",1x,I0)") &
	"alternate sqme = ", object%get_sqme_alt(i), i
	end do
	end if
	end if
	if (object%sqme_prc_is_known ()) &
	write (u, "(3x,A," // fmt // ")") &
	"Squared matrix el. (prc) = ", object%get_sqme_prc ()

	if (object%weight_ref_is_known ()) then
	write (u, "(3x,A," // fmt // ")") &
	"Event weight (ref) = ", object%get_weight_ref ()
	if (object%weight_alt_is_known ()) then
	do i = 1, object%get_n_alt ()
	write (u, "(5x,A," // fmt // ",1x,I0)") &
	"alternate weight = ", object%get_weight_alt(i), i
	end do
	end if
	end if
	if (object%weight_prc_is_known ()) &
	write (u, "(3x,A," // fmt // ")") &
	"Event weight (prc) = ", object%get_weight_prc ()

	if (object%selected_i_mci /= 0) then
	call write_separator (u)
	write (u, "(3x,A,I0)") "Selected MCI group = ", object%selected_i_mci
	write (u, "(3x,A,I0)") "Selected term = ", object%selected_i_term
	write (u, "(3x,A,I0)") "Selected channel = ", object%selected_channel
	end if
	if (object%selection_evaluated) then
	call write_separator (u)
	write (u, "(3x,A,L1)") "Passed selection = ", object%passed
	if (object%passed) then
	write (u, "(3x,A," // fmt // ")") &
	"Reweighting factor = ", object%reweight
	write (u, "(3x,A,L1)") &
	"Analysis flag = ", object%analysis_flag
	end if
	end if
	if (associated (object%instance)) then
	if (prc) then
	if (verb) then
	call object%instance%write (u, testflag)
	else
	call object%instance%write_header (u)
	end if
	end if
	if (trans) then
	evt => object%transform_first
	do while (associated (evt))
	select type (evt)
	type is (evt_decay_t)
	call evt%write (u, verbose = dec, more_verbose = verb, &
	testflag = testflag)
	class default
	call evt%write (u, verbose = verb, testflag = testflag)
	end select
	call write_separator (u, 2)
	evt => evt%next
	end do
	else
	call write_separator (u, 2)
	end if
	if (object%expr%subevt_filled) then
	call object%expr%write (u, pacified = testflag)
	call write_separator (u, 2)
	end if
	else
	call write_separator (u, 2)
	write (u, "(1x,A)") "Process instance: [undefined]"
	call write_separator (u, 2)
	end if
	end subroutine event_write

	@ %def event_write
	@
	\subsection{Initialization}
	Initialize: set configuration parameters, using a variable list. We
	do not call this [[init]], because this method name will be used by a type
	extension.

	The default normalization is [[NORM_SIGMA]], since the default
	generation mode is weighted.

	For unweighted events, we may want to a apply a safety factor to event
	rejection. (By default, this factor is unity and can be ignored.)

	We also allocate the trivial event transform, which is always the
	first one.
	Gfortran 7/8/9 bug, has to remain in the main module:
	<<Events: event: TBP>>=
	procedure :: basic_init => event_init
	<<Events: main procedures>>=
	subroutine event_init (event, var_list, n_alt)
	class(event_t), intent(out) :: event
	type(var_list_t), intent(in), optional :: var_list
	integer, intent(in), optional :: n_alt
	type(string_t) :: norm_string, mode_string
	logical :: polarized_events
	if (present (n_alt)) then
	call event%base_init (n_alt)
	call event%expr%init (n_alt)
	else
	call event%base_init (0)
	end if
	if (present (var_list)) then
	event%config%unweighted = var_list%get_lval (&
	var_str ("?unweighted"))
	norm_string = var_list%get_sval (&
	var_str ("$sample_normalization"))
	event%config%norm_mode = &
	event_normalization_mode (norm_string, event%config%unweighted)
	polarized_events = &
	var_list%get_lval (var_str ("?polarized_events"))
	if (polarized_events) then
	mode_string = &
	var_list%get_sval (var_str ("$polarization_mode"))
	select case (char (mode_string))
	case ("ignore")
	event%config%factorization_mode = FM_IGNORE_HELICITY
	case ("helicity")
	event%config%factorization_mode = FM_SELECT_HELICITY
	case ("factorized")
	event%config%factorization_mode = FM_FACTOR_HELICITY
	case ("correlated")
	event%config%factorization_mode = FM_CORRELATED_HELICITY
	case default
	call msg_fatal ("Polarization mode " &
	// char (mode_string) // " is undefined")
	end select
	else
	event%config%factorization_mode = FM_IGNORE_HELICITY
	end if
	event%config%colorize_subevt = &
	var_list%get_lval (var_str ("?colorize_subevt"))
	if (event%config%unweighted) then
	event%config%safety_factor = var_list%get_rval (&
	var_str ("safety_factor"))
	end if
	else
	event%config%norm_mode = NORM_SIGMA
	end if
	allocate (evt_trivial_t :: event%transform_first)
	event%transform_last => event%transform_first
	end subroutine event_init

	@ %def event_init
	@ Set the [[sigma]] and [[n]] values in the configuration record that
	determine non-standard event normalizations. If these numbers are not
	set explicitly, the default value for both is unity, and event
	renormalization has no effect.
	<<Events: event: TBP>>=
	procedure :: set_sigma => event_set_sigma
	procedure :: set_n => event_set_n
	<<Events: sub interfaces>>=
	elemental module subroutine event_set_sigma (event, sigma)
	class(event_t), intent(inout) :: event
	real(default), intent(in) :: sigma
	end subroutine event_set_sigma
	elemental module subroutine event_set_n (event, n)
	class(event_t), intent(inout) :: event
	integer, intent(in) :: n
	end subroutine event_set_n
	<<Events: procedures>>=
	elemental module subroutine event_set_sigma (event, sigma)
	class(event_t), intent(inout) :: event
	real(default), intent(in) :: sigma
	event%config%sigma = sigma
	end subroutine event_set_sigma

	elemental module subroutine event_set_n (event, n)
	class(event_t), intent(inout) :: event
	integer, intent(in) :: n
	event%config%n = n
	end subroutine event_set_n

	@ %def event_set_n
	@ Append an event transform (decays, etc.). The transform is not yet
	connected to a process. The transform is then considered to belong to
	the event object, and will be finalized together with it. The
	original pointer is removed.

	We can assume that the trivial transform is already present in the
	event object, at least.
	<<Events: event: TBP>>=
	procedure :: import_transform => event_import_transform
	<<Events: sub interfaces>>=
	module subroutine event_import_transform (event, evt)
	class(event_t), intent(inout) :: event
	class(evt_t), intent(inout), pointer :: evt
	end subroutine event_import_transform
	<<Events: procedures>>=
	module subroutine event_import_transform (event, evt)
	class(event_t), intent(inout) :: event
	class(evt_t), intent(inout), pointer :: evt
	event%transform_last%next => evt
	evt%previous => event%transform_last
	event%transform_last => evt
	evt => null ()
	end subroutine event_import_transform

	@ %def event_import_transform
	@
	We link the event to an existing process instance. This
	includes the variable list, which is linked to the process variable
	list. Note that this is not necessarily identical to the variable
	list used for event initialization.

	The variable list will contain pointers to [[event]] subobjects, therefore the
	[[target]] attribute.

	Once we have a process connected, we can use it to obtain an event
	generator instance.

	The model and process stack may be needed by event transforms. The
	current model setting may be different from the model in the process
	(regarding unstable particles, etc.). The process stack can be used
	for assigning extra processes that we need for the event transforms.
	<<Events: event: TBP>>=
	procedure :: connect => event_connect
	<<Events: sub interfaces>>=
	module subroutine event_connect &
	(event, process_instance, model, process_stack)
	class(event_t), intent(inout), target :: event
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	end subroutine event_connect
	<<Events: procedures>>=
	module subroutine event_connect &
	(event, process_instance, model, process_stack)
	class(event_t), intent(inout), target :: event
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(string_t) :: id
	integer :: num_id
	class(evt_t), pointer :: evt
	event%process => process_instance%process
	event%instance => process_instance
	id = event%process%get_id ()
	if (id /= "") call event%expr%set_process_id (id)
	num_id = event%process%get_num_id ()
	if (num_id /= 0) call event%expr%set_process_num_id (num_id)
	call event%expr%setup_vars (event%process%get_sqrts ())
	call event%expr%link_var_list (event%process%get_var_list_ptr ())
	call event%process%make_rng (event%rng)
	evt => event%transform_first
	do while (associated (evt))
	call evt%connect (process_instance, model, process_stack)
	evt => evt%next
	end do
	end subroutine event_connect

	@ %def event_connect
	@ Set the parse nodes for the associated expressions, individually. The
	parse-node pointers may be null.
	<<Events: event: TBP>>=
	procedure :: set_selection => event_set_selection
	procedure :: set_reweight => event_set_reweight
	procedure :: set_analysis => event_set_analysis
	<<Events: sub interfaces>>=
	module subroutine event_set_selection (event, ef_selection)
	class(event_t), intent(inout) :: event
	class(expr_factory_t), intent(in) :: ef_selection
	end subroutine event_set_selection
	module subroutine event_set_reweight (event, ef_reweight)
	class(event_t), intent(inout) :: event
	class(expr_factory_t), intent(in) :: ef_reweight
	end subroutine event_set_reweight
	module subroutine event_set_analysis (event, ef_analysis)
	class(event_t), intent(inout) :: event
	class(expr_factory_t), intent(in) :: ef_analysis
	end subroutine event_set_analysis
	<<Events: procedures>>=
	module subroutine event_set_selection (event, ef_selection)
	class(event_t), intent(inout) :: event
	class(expr_factory_t), intent(in) :: ef_selection
	allocate (event%config%ef_selection, source = ef_selection)
	end subroutine event_set_selection

	module subroutine event_set_reweight (event, ef_reweight)
	class(event_t), intent(inout) :: event
	class(expr_factory_t), intent(in) :: ef_reweight
	allocate (event%config%ef_reweight, source = ef_reweight)
	end subroutine event_set_reweight

	module subroutine event_set_analysis (event, ef_analysis)
	class(event_t), intent(inout) :: event
	class(expr_factory_t), intent(in) :: ef_analysis
	allocate (event%config%ef_analysis, source = ef_analysis)
	end subroutine event_set_analysis

	@ %def event_set_selection
	@ %def event_set_reweight
	@ %def event_set_analysis
	@ Create evaluation trees from the parse trees. The [[target]] attribute is
	required because the expressions contain pointers to event subobjects.
	<<Events: event: TBP>>=
	procedure :: setup_expressions => event_setup_expressions
	<<Events: sub interfaces>>=
	module subroutine event_setup_expressions (event)
	class(event_t), intent(inout), target :: event
	end subroutine event_setup_expressions
	<<Events: procedures>>=
	module subroutine event_setup_expressions (event)
	class(event_t), intent(inout), target :: event
	call event%expr%setup_selection (event%config%ef_selection)
	call event%expr%setup_analysis (event%config%ef_analysis)
	call event%expr%setup_reweight (event%config%ef_reweight)
	call event%expr%colorize (event%config%colorize_subevt)
	end subroutine event_setup_expressions

	@ %def event_setup_expressions
	@
	\subsection{Evaluation}
	To fill the [[particle_set]], i.e., the event record proper, we have
	to apply all event transforms in order. The last transform should
	fill its associated particle set, factorizing the state matrix
	according to the current settings. There are several parameters
	in the event configuration that control this.

	We always fill the particle set for the first transform (the hard
	process) and the last transform, if different from the first (the
	fully dressed process).

	Each event transform is an event generator of its own. We choose to
	generate an \emph{unweighted} event for each of them, even if the master
	event is assumed to be weighted. Thus, the overall event weight is
	the one of the hard process only. (There may be more options in future
	extensions.)

	We can generate the two random numbers that the factorization needs.
	For testing purpose, we allow for providing them explicitly, as an option.
	<<Events: event: TBP>>=
	procedure :: evaluate_transforms => event_evaluate_transforms
	<<Events: sub interfaces>>=
	module subroutine event_evaluate_transforms (event, r)
	class(event_t), intent(inout) :: event
	real(default), dimension(:), intent(in), optional :: r
	end subroutine event_evaluate_transforms
	<<Events: procedures>>=
	module subroutine event_evaluate_transforms (event, r)
	class(event_t), intent(inout) :: event
	real(default), dimension(:), intent(in), optional :: r
	class(evt_t), pointer :: evt
	real(default) :: weight_over_sqme
	integer :: i_term, emitter, n_in
	logical :: failed_but_keep
	failed_but_keep = .false.
	if (debug_on) call msg_debug (D_TRANSFORMS, "event_evaluate_transforms")
	call event%discard_particle_set ()
	call event%check ()
	if (event%instance%is_complete_event ()) then
	i_term = event%instance%select_i_term ()
	event%selected_i_term = i_term
	evt => event%transform_first
	do while (associated (evt))
	call evt%prepare_new_event &
	(event%selected_i_mci, event%selected_i_term)
	evt => evt%next
	end do
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "Before event transformations")
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "event%weight_prc", event%weight_prc)
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "event%sqme_prc", event%sqme_prc)
	evt => event%transform_first
	do while (associated (evt))
	call print_transform_name_if_debug ()
	if (evt%only_weighted_events) then
	select type (evt)
	type is (evt_nlo_t)
	i_term = evt%get_i_term ()
	failed_but_keep = .not. evt%is_valid_event (i_term) &
	.and. evt%keep_failed_events
	if (.not. any(evt%process_instance%term%passed .and. evt%process_instance%term%active) &
	.and. .not. evt%keep_failed_events) return
	end select
	if (abs (event%weight_prc) > 0._default) then
	weight_over_sqme = event%weight_prc / event%sqme_prc
	call evt%generate_weighted (event%sqme_prc)
	event%weight_prc = weight_over_sqme * event%sqme_prc
	select type (evt)
	type is (evt_nlo_t)
	if (.not. evt%is_valid_event (i_term)) event%weight_prc = 0
	end select
	else
	if (.not. failed_but_keep) exit
	end if
	else
	call evt%generate_unweighted ()
	end if
	if (signal_is_pending ()) return
	select type (evt)
	type is (evt_nlo_t)
	if (evt%i_evaluation > 0) then
	emitter = evt%process_instance%kin(i_term)%emitter
	n_in = evt%process_instance%kin(i_term)%n_in
	select type (pcm_work => evt%process_instance%term(i_term)%pcm_work)
	type is (pcm_nlo_workspace_t)
	if (emitter <= n_in .and. pcm_work%isr_kinematics%isr_mode == SQRTS_VAR) then
	call evt%connected_set_real_IS_momenta ()
	end if
	end select
	end if
	end select
	call evt%make_particle_set (event%config%factorization_mode, &
	event%config%keep_correlations)
	if (signal_is_pending ()) return
	if (.not. evt%particle_set_exists) exit
	evt => evt%next
	end do
	evt => event%transform_last
	if ((associated (evt) .and. evt%particle_set_exists) .or. failed_but_keep) then
	if (event%is_nlo ()) then
	select type (evt)
	type is (evt_nlo_t)
	evt%particle_set_nlo (event%i_event + 1) = evt%particle_set
	evt%i_evaluation = evt%i_evaluation + 1
	call event%link_particle_set &
	(evt%particle_set_nlo(event%i_event + 1))
	end select
	else
	call event%link_particle_set (evt%particle_set)
	end if
	end if
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "After event transformations")
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "event%weight_prc", event%weight_prc)
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "event%sqme_prc", event%sqme_prc)
	if (debug_on) call msg_debug &
	(D_TRANSFORMS, "evt%particle_set_exists", evt%particle_set_exists)
	end if
	contains
	subroutine print_transform_name_if_debug ()
	if (debug_active (D_TRANSFORMS)) then
	print *, 'Current event transform: '
	call evt%write_name ()
	end if
	end subroutine print_transform_name_if_debug
	end subroutine event_evaluate_transforms

	@ %def event_evaluate_transforms
	@ Set / increment the event index for the current event. There is no
	condition for this to happen. The event index is actually stored in
	the subevent expression, because this allows us to access it in
	subevent expressions as a variable.
	<<Events: event: TBP>>=
	procedure :: set_index => event_set_index
	procedure :: increment_index => event_increment_index
	<<Events: sub interfaces>>=
	module subroutine event_set_index (event, index)
	class(event_t), intent(inout) :: event
	integer, intent(in) :: index
	end subroutine event_set_index
	module subroutine event_increment_index (event, offset)
	class(event_t), intent(inout) :: event
	integer, intent(in), optional :: offset
	end subroutine event_increment_index
	<<Events: procedures>>=
	module subroutine event_set_index (event, index)
	class(event_t), intent(inout) :: event
	integer, intent(in) :: index
	call event%expr%set_event_index (index)
	end subroutine event_set_index

	module subroutine event_increment_index (event, offset)
	class(event_t), intent(inout) :: event
	integer, intent(in), optional :: offset
	call event%expr%increment_event_index (offset)
	end subroutine event_increment_index

	@ %def event_set_index
	@ %def event_increment_index
	@
	Evaluate the event-related expressions, given a valid
	[[particle_set]]. If [[update_sqme]] is set, we use the process
	instance for the [[sqme_prc]] value. The [[sqme_ref]] value is
	always taken from the event record.
	<<Events: event: TBP>>=
	procedure :: evaluate_expressions => event_evaluate_expressions
	<<Events: sub interfaces>>=
	module subroutine event_evaluate_expressions (event)
	class(event_t), intent(inout) :: event
	end subroutine event_evaluate_expressions
	<<Events: procedures>>=
	module subroutine event_evaluate_expressions (event)
	class(event_t), intent(inout) :: event
	if (event%has_valid_particle_set ()) then
	call event%expr%fill_subevt (event%get_particle_set_ptr ())
	end if
	if (event%weight_ref_is_known ()) then
	call event%expr%set (weight_ref = event%get_weight_ref ())
	end if
	if (event%weight_prc_is_known ()) then
	call event%expr%set (weight_prc = event%get_weight_prc ())
	end if
	if (event%excess_prc_is_known ()) then
	call event%expr%set (excess_prc = event%get_excess_prc ())
	end if
	if (event%sqme_ref_is_known ()) then
	call event%expr%set (sqme_ref = event%get_sqme_ref ())
	end if
	if (event%sqme_prc_is_known ()) then
	call event%expr%set (sqme_prc = event%get_sqme_prc ())
	end if
	if (event%has_valid_particle_set ()) then
	call event%expr%evaluate &
	(event%passed, event%reweight, event%analysis_flag)
	event%selection_evaluated = .true.
	end if
	end subroutine event_evaluate_expressions

	@ %def event_evaluate_expressions
	@ Report the result of the [[selection]] evaluation.
	<<Events: event: TBP>>=
	procedure :: passed_selection => event_passed_selection
	<<Events: sub interfaces>>=
	module function event_passed_selection (event) result (flag)
	class(event_t), intent(in) :: event
	logical :: flag
	end function event_passed_selection
	<<Events: procedures>>=
	module function event_passed_selection (event) result (flag)
	class(event_t), intent(in) :: event
	logical :: flag
	flag = event%passed
	end function event_passed_selection

	@ %def event_passed_selection
	@ Set alternate sqme and weight arrays. This should be merged with
	the previous routine, if the expressions are allowed to refer to these
	values.
	<<Events: event: TBP>>=
	procedure :: store_alt_values => event_store_alt_values
	<<Events: sub interfaces>>=
	module subroutine event_store_alt_values (event)
	class(event_t), intent(inout) :: event
	end subroutine event_store_alt_values
	<<Events: procedures>>=
	module subroutine event_store_alt_values (event)
	class(event_t), intent(inout) :: event
	if (event%weight_alt_is_known ()) then
	call event%expr%set (weight_alt = event%get_weight_alt ())
	end if
	if (event%sqme_alt_is_known ()) then
	call event%expr%set (sqme_alt = event%get_sqme_alt ())
	end if
	end subroutine event_store_alt_values

	@ %def event_store_alt_values
	@
	<<Events: event: TBP>>=
	procedure :: is_nlo => event_is_nlo
	<<Events: sub interfaces>>=
	module function event_is_nlo (event) result (is_nlo)
	logical :: is_nlo
	class(event_t), intent(in) :: event
	end function event_is_nlo
	<<Events: procedures>>=
	module function event_is_nlo (event) result (is_nlo)
	logical :: is_nlo
	class(event_t), intent(in) :: event
	if (associated (event%instance)) then
	select type (pcm_work => event%instance%pcm_work)
	type is (pcm_nlo_workspace_t)
	is_nlo = pcm_work%is_fixed_order_nlo_events ()
	class default
	is_nlo = .false.
	end select
	else
	is_nlo = .false.
	end if
	end function event_is_nlo

	@ %def event_is_nlo
	@
	\subsection{Reset to empty state}
	Applying this, current event contents are marked as incomplete but
	are not deleted. In particular, the initialization is kept. The
	event index is also kept, this can be reset separately.
	<<Events: event: TBP>>=
	procedure :: reset_contents => event_reset_contents
	procedure :: reset_index => event_reset_index
	<<Events: sub interfaces>>=
	module subroutine event_reset_contents (event)
	class(event_t), intent(inout) :: event
	end subroutine event_reset_contents
	module subroutine event_reset_index (event)
	class(event_t), intent(inout) :: event
	end subroutine event_reset_index
	<<Events: procedures>>=
	module subroutine event_reset_contents (event)
	class(event_t), intent(inout) :: event
	class(evt_t), pointer :: evt
	call event%base_reset_contents ()
	event%selected_i_mci = 0
	event%selected_i_term = 0
	event%selected_channel = 0
	event%is_complete = .false.
	call event%expr%reset_contents ()
	event%selection_evaluated = .false.
	event%passed = .false.
	event%analysis_flag = .false.
	if (associated (event%instance)) then
	call event%instance%reset (reset_mci = .true.)
	end if
	if (allocated (event%alpha_qcd_forced)) deallocate (event%alpha_qcd_forced)
	if (allocated (event%scale_forced)) deallocate (event%scale_forced)
	evt => event%transform_first
	do while (associated (evt))
	call evt%reset ()
	evt => evt%next
	end do
	end subroutine event_reset_contents

	module subroutine event_reset_index (event)
	class(event_t), intent(inout) :: event
	call event%expr%reset_event_index ()
	end subroutine event_reset_index

	@ %def event_reset_contents
	@ %def event_reset_index
	@
	\subsection{Squared Matrix Element and Weight}
	Transfer the result of the process instance calculation to the
	event record header.
	<<Events: event: TBP>>=
	procedure :: import_instance_results => event_import_instance_results
	<<Events: sub interfaces>>=
	module subroutine event_import_instance_results (event)
	class(event_t), intent(inout) :: event
	end subroutine event_import_instance_results
	<<Events: procedures>>=
	module subroutine event_import_instance_results (event)
	class(event_t), intent(inout) :: event
	if (associated (event%instance)) then
	if (event%instance%has_evaluated_trace ()) then
	call event%set ( &
	sqme_prc = event%instance%get_sqme (), &
	weight_prc = event%instance%get_weight (), &
	excess_prc = event%instance%get_excess (), &
	n_dropped = event%instance%get_n_dropped () &
	)
	end if
	end if
	end subroutine event_import_instance_results

	@ %def event_import_instance_results
	@ Duplicate the instance result / the reference result in the event
	record.
	<<Events: event: TBP>>=
	procedure :: accept_sqme_ref => event_accept_sqme_ref
	procedure :: accept_sqme_prc => event_accept_sqme_prc
	procedure :: accept_weight_ref => event_accept_weight_ref
	procedure :: accept_weight_prc => event_accept_weight_prc
	<<Events: sub interfaces>>=
	module subroutine event_accept_sqme_ref (event)
	class(event_t), intent(inout) :: event
	end subroutine event_accept_sqme_ref
	module subroutine event_accept_sqme_prc (event)
	class(event_t), intent(inout) :: event
	end subroutine event_accept_sqme_prc
	module subroutine event_accept_weight_ref (event)
	class(event_t), intent(inout) :: event
	end subroutine event_accept_weight_ref
	module subroutine event_accept_weight_prc (event)
	class(event_t), intent(inout) :: event
	end subroutine event_accept_weight_prc
	<<Events: procedures>>=
	module subroutine event_accept_sqme_ref (event)
	class(event_t), intent(inout) :: event
	if (event%sqme_ref_is_known ()) then
	call event%set (sqme_prc = event%get_sqme_ref ())
	end if
	end subroutine event_accept_sqme_ref

	module subroutine event_accept_sqme_prc (event)
	class(event_t), intent(inout) :: event
	if (event%sqme_prc_is_known ()) then
	call event%set (sqme_ref = event%get_sqme_prc ())
	end if
	end subroutine event_accept_sqme_prc

	module subroutine event_accept_weight_ref (event)
	class(event_t), intent(inout) :: event
	if (event%weight_ref_is_known ()) then
	call event%set (weight_prc = event%get_weight_ref ())
	end if
	end subroutine event_accept_weight_ref

	module subroutine event_accept_weight_prc (event)
	class(event_t), intent(inout) :: event
	if (event%weight_prc_is_known ()) then
	call event%set (weight_ref = event%get_weight_prc ())
	end if
	end subroutine event_accept_weight_prc

	@ %def event_accept_sqme_ref
	@ %def event_accept_sqme_prc
	@ %def event_accept_weight_ref
	@ %def event_accept_weight_prc
	@ Update the weight normalization, just after generation. Unweighted
	and weighted events are generated with a different default
	normalization. The intended normalization is stored in the
	configuration record.
	<<Events: event: TBP>>=
	procedure :: update_normalization => event_update_normalization
	<<Events: sub interfaces>>=
	module subroutine event_update_normalization (event, mode_ref)
	class(event_t), intent(inout) :: event
	integer, intent(in), optional :: mode_ref
	end subroutine event_update_normalization
	<<Events: procedures>>=
	module subroutine event_update_normalization (event, mode_ref)
	class(event_t), intent(inout) :: event
	integer, intent(in), optional :: mode_ref
	integer :: mode_old
	real(default) :: weight, excess
	if (present (mode_ref)) then
	mode_old = mode_ref
	else if (event%config%unweighted) then
	mode_old = NORM_UNIT
	else
	mode_old = NORM_SIGMA
	end if
	weight = event%get_weight_prc ()
	call event_normalization_update (weight, &
	event%config%sigma, event%config%n, &
	mode_new = event%config%norm_mode, &
	mode_old = mode_old)
	call event%set_weight_prc (weight)
	excess = event%get_excess_prc ()
	call event_normalization_update (excess, &
	event%config%sigma, event%config%n, &
	mode_new = event%config%norm_mode, &
	mode_old = mode_old)
	call event%set_excess_prc (excess)
	end subroutine event_update_normalization

	@ %def event_update_normalization
	@
	The event is complete if it has a particle set plus valid entries for
	the sqme and weight values.
	<<Events: event: TBP>>=
	procedure :: check => event_check
	<<Events: sub interfaces>>=
	module subroutine event_check (event)
	class(event_t), intent(inout) :: event
	end subroutine event_check
	<<Events: procedures>>=
	module subroutine event_check (event)
	class(event_t), intent(inout) :: event
	event%is_complete = event%has_valid_particle_set () &
	.and. event%sqme_ref_is_known () &
	.and. event%sqme_prc_is_known () &
	.and. event%weight_ref_is_known () &
	.and. event%weight_prc_is_known ()
	if (event%get_n_alt () /= 0) then
	event%is_complete = event%is_complete &
	.and. event%sqme_alt_is_known () &
	.and. event%weight_alt_is_known ()
	end if
	end subroutine event_check

	@ %def event_check
	@
	@
	\subsection{Generation}
	Assuming that we have a valid process associated to the event, we
	generate an event. We complete the event data, then factorize the
	spin density matrix and transfer it to the particle set.

	When done, we retrieve squared matrix element and weight. In case of
	explicit generation, the reference values coincide with the process
	values, so we [[accept]] the latter.

	The explicit random number argument [[r]] should be generated by a
	random-number generator. It is taken for the factorization algorithm,
	bypassing the event-specific random-number generator. This is useful
	for deterministic testing.
	<<Events: event: TBP>>=
	procedure :: generate => event_generate
	<<Events: sub interfaces>>=
	module subroutine event_generate (event, i_mci, r, i_nlo)
	class(event_t), intent(inout) :: event
	integer, intent(in) :: i_mci
	real(default), dimension(:), intent(in), optional :: r
	integer, intent(in), optional :: i_nlo
	end subroutine event_generate
	<<Events: procedures>>=
	module subroutine event_generate (event, i_mci, r, i_nlo)
	class(event_t), intent(inout) :: event
	integer, intent(in) :: i_mci
	real(default), dimension(:), intent(in), optional :: r
	integer, intent(in), optional :: i_nlo
	logical :: generate_new
	generate_new = .true.
	if (present (i_nlo)) generate_new = (i_nlo == 1)
	if (generate_new) call event%reset_contents ()
	event%selected_i_mci = i_mci
	if (event%config%unweighted) then
	call event%instance%generate_unweighted_event (i_mci)
	if (signal_is_pending ()) return
	call event%instance%evaluate_event_data ()
	call event%instance%normalize_weight ()
	else
	if (generate_new) &
	call event%instance%generate_weighted_event (i_mci)
	if (signal_is_pending ()) return
	call event%instance%evaluate_event_data ()
	end if
	event%selected_channel = event%instance%get_channel ()
	call event%import_instance_results ()
	call event%accept_sqme_prc ()
	call event%update_normalization ()
	call event%accept_weight_prc ()
	call event%evaluate_transforms (r)
	if (signal_is_pending ()) return
	call event%check ()
	end subroutine event_generate

	@ %def event_generate
	@ Get a copy of the particle set belonging to the hard process.
	<<Events: event: TBP>>=
	procedure :: get_hard_particle_set => event_get_hard_particle_set
	<<Events: sub interfaces>>=
	module subroutine event_get_hard_particle_set (event, pset)
	class(event_t), intent(in) :: event
	type(particle_set_t), intent(out) :: pset
	end subroutine event_get_hard_particle_set
	<<Events: procedures>>=
	module subroutine event_get_hard_particle_set (event, pset)
	class(event_t), intent(in) :: event
	type(particle_set_t), intent(out) :: pset
	class(evt_t), pointer :: evt
	evt => event%transform_first
	pset = evt%particle_set
	end subroutine event_get_hard_particle_set

	@ %def event_get_hard_particle_set
	@
	\subsection{Recovering an event}
	Select MC group, term, and integration channel.
	<<Events: event: TBP>>=
	procedure :: select => event_select
	<<Events: sub interfaces>>=
	module subroutine event_select (event, i_mci, i_term, channel)
	class(event_t), intent(inout) :: event
	integer, intent(in) :: i_mci, i_term, channel
	end subroutine event_select
	<<Events: procedures>>=
	module subroutine event_select (event, i_mci, i_term, channel)
	class(event_t), intent(inout) :: event
	integer, intent(in) :: i_mci, i_term, channel
	if (associated (event%instance)) then
	event%selected_i_mci = i_mci
	event%selected_i_term = i_term
	event%selected_channel = channel
	else
	event%selected_i_mci = 0
	event%selected_i_term = 0
	event%selected_channel = 0
	end if
	end subroutine event_select

	@ %def event_select
	@
	Copy a particle set into the event record.

	We deliberately use the first (the trivial) transform for this, i.e.,
	the hard process. The event reader may either read in the transformed
	event separately, or apply all event
	transforms to the hard particle set to (re)generate a fully dressed
	event.

	Since this makes all subsequent event transforms invalid, we call
	[[reset]] on them.
	<<Events: event: TBP>>=
	procedure :: set_hard_particle_set => event_set_hard_particle_set
	<<Events: sub interfaces>>=
	module subroutine event_set_hard_particle_set (event, particle_set)
	class(event_t), intent(inout) :: event
	type(particle_set_t), intent(in) :: particle_set
	end subroutine event_set_hard_particle_set
	<<Events: procedures>>=
	module subroutine event_set_hard_particle_set (event, particle_set)
	class(event_t), intent(inout) :: event
	type(particle_set_t), intent(in) :: particle_set
	class(evt_t), pointer :: evt
	evt => event%transform_first
	call evt%set_particle_set (particle_set, &
	event%selected_i_mci, event%selected_i_term)
	call event%link_particle_set (evt%particle_set)
	evt => evt%next
	do while (associated (evt))
	call evt%reset ()
	evt => evt%next
	end do
	end subroutine event_set_hard_particle_set

	@ %def event_set_hard_particle_set
	@
	Set the $\alpha_s$ value that should be used in a recalculation. This should
	be called only if we explicitly want to override the QCD setting of the
	process core.
	<<Events: event: TBP>>=
	procedure :: set_alpha_qcd_forced => event_set_alpha_qcd_forced
	<<Events: sub interfaces>>=
	module subroutine event_set_alpha_qcd_forced (event, alpha_qcd)
	class(event_t), intent(inout) :: event
	real(default), intent(in) :: alpha_qcd
	end subroutine event_set_alpha_qcd_forced
	<<Events: procedures>>=
	module subroutine event_set_alpha_qcd_forced (event, alpha_qcd)
	class(event_t), intent(inout) :: event
	real(default), intent(in) :: alpha_qcd
	if (allocated (event%alpha_qcd_forced)) then
	event%alpha_qcd_forced = alpha_qcd
	else
	allocate (event%alpha_qcd_forced, source = alpha_qcd)
	end if
	end subroutine event_set_alpha_qcd_forced

	@ %def event_set_alpha_qcd_forced
	@
	Analogously, for the common scale. This forces also renormalization and
	factorization scale.
	<<Events: event: TBP>>=
	procedure :: set_scale_forced => event_set_scale_forced
	<<Events: sub interfaces>>=
	module subroutine event_set_scale_forced (event, scale)
	class(event_t), intent(inout) :: event
	real(default), intent(in) :: scale
	end subroutine event_set_scale_forced
	<<Events: procedures>>=
	module subroutine event_set_scale_forced (event, scale)
	class(event_t), intent(inout) :: event
	real(default), intent(in) :: scale
	if (allocated (event%scale_forced)) then
	event%scale_forced = scale
	else
	allocate (event%scale_forced, source = scale)
	end if
	end subroutine event_set_scale_forced

	@ %def event_set_scale_forced
	@
	Here we try to recover an event from the [[particle_set]] subobject
	and recalculate the structure functions and matrix elements. We
	have the appropriate [[process]] object and an initialized
	[[process_instance]] at hand, so beam and configuration data are
	known. From the [[particle_set]], we get the momenta.

	The quantum-number information may be incomplete, e.g., helicity
	information may be partial or absent. We recover the event just from
	the momentum configuration.

	We do not transfer the matrix element from the process instance to the
	event record, as we do when generating an event. The event record may
	contain the matrix element as read from file, and the current
	calculation may use different parameters. We thus can compare old and
	new values.

	The event [[weight]] may also be known already. If yes, we pass it to the
	[[evaluate_event_data]] procedure. It should already be normalized. If we
	have a [[weight_factor]] value, we obtain the event weight by multiplying the
	computed [[sqme]] by this factor. Otherwise, we make use of the MCI setup
	(which should be valid then) to compute the event weight, and we should
	normalize the result just as when generating events.

	Evaluating event expressions must also be done separately.

	If [[recover_phs]] is set (and false), do not attempt any phase-space
	calculation, including MCI evaluation. Useful if we need only matrix elements.
	<<Events: event: TBP>>=
	procedure :: recalculate => event_recalculate
	<<Events: sub interfaces>>=
	module subroutine event_recalculate (event, update_sqme, weight_factor, &
	recover_beams, recover_phs, check_match, success)
	class(event_t), intent(inout) :: event
	logical, intent(in) :: update_sqme
	real(default), intent(in), optional :: weight_factor
	logical, intent(in), optional :: recover_beams
	logical, intent(in), optional :: recover_phs
	logical, intent(in), optional :: check_match
	logical, intent(out), optional :: success
	end subroutine event_recalculate
	<<Events: procedures>>=
	module subroutine event_recalculate (event, update_sqme, weight_factor, &
	recover_beams, recover_phs, check_match, success)
	class(event_t), intent(inout) :: event
	logical, intent(in) :: update_sqme
	real(default), intent(in), optional :: weight_factor
	logical, intent(in), optional :: recover_beams
	logical, intent(in), optional :: recover_phs
	logical, intent(in), optional :: check_match
	logical, intent(out), optional :: success
	type(particle_set_t), pointer :: particle_set
	integer :: i_mci, i_term, channel
	logical :: rec_phs_mci
	rec_phs_mci = .true.; if (present (recover_phs)) rec_phs_mci = recover_phs
	if (present (success)) success = .false.
	if (event%has_valid_particle_set ()) then
	particle_set => event%get_particle_set_ptr ()
	i_mci = event%selected_i_mci
	i_term = event%selected_i_term
	channel = event%selected_channel
	if (i_mci == 0 .or. i_term == 0 .or. channel == 0) then
	call msg_bug ("Event: recalculate: undefined selection parameters")
	end if
	call event%instance%choose_mci (i_mci)
	call event%instance%set_trace &
	(particle_set, i_term, recover_beams, check_match, success)
	if (present (success)) then
	if (.not. success) return
	end if
	if (allocated (event%alpha_qcd_forced)) then
	call event%instance%set_alpha_qcd_forced &
	(i_term, event%alpha_qcd_forced)
	end if
	call event%instance%recover (channel, i_term, &
	update_sqme, rec_phs_mci, event%scale_forced)
	if (signal_is_pending ()) return
	if (update_sqme .and. present (weight_factor)) then
	call event%instance%evaluate_event_data &
	(weight = event%instance%get_sqme () * weight_factor)
	else if (event%weight_ref_is_known ()) then
	call event%instance%evaluate_event_data &
	(weight = event%get_weight_ref ())
	else if (rec_phs_mci) then
	call event%instance%recover_event ()
	if (signal_is_pending ()) return
	call event%instance%evaluate_event_data ()
	if (event%config%unweighted) then
	call event%instance%normalize_weight ()
	end if
	end if
	if (signal_is_pending ()) return
	if (update_sqme) then
	call event%import_instance_results ()
	else
	call event%accept_sqme_ref ()
	call event%accept_weight_ref ()
	end if
	else
	call msg_bug ("Event: can't recalculate, particle set is undefined")
	end if
	end subroutine event_recalculate

	@ %def event_recalculate
	@
	\subsection{Access content}
	Pointer to the associated process object (the associated model).
	<<Events: event: TBP>>=
	procedure :: get_process_ptr => event_get_process_ptr
	procedure :: get_process_instance_ptr => event_get_process_instance_ptr
	procedure :: get_model_ptr => event_get_model_ptr
	<<Events: sub interfaces>>=
	module function event_get_process_ptr (event) result (ptr)
	class(event_t), intent(in) :: event
	type(process_t), pointer :: ptr
	end function event_get_process_ptr
	module function event_get_process_instance_ptr (event) result (ptr)
	class(event_t), intent(in) :: event
	type(process_instance_t), pointer :: ptr
	end function event_get_process_instance_ptr
	module function event_get_model_ptr (event) result (model)
	class(event_t), intent(in) :: event
	class(model_data_t), pointer :: model
	end function event_get_model_ptr
	<<Events: procedures>>=
	module function event_get_process_ptr (event) result (ptr)
	class(event_t), intent(in) :: event
	type(process_t), pointer :: ptr
	ptr => event%process
	end function event_get_process_ptr

	module function event_get_process_instance_ptr (event) result (ptr)
	class(event_t), intent(in) :: event
	type(process_instance_t), pointer :: ptr
	ptr => event%instance
	end function event_get_process_instance_ptr

	module function event_get_model_ptr (event) result (model)
	class(event_t), intent(in) :: event
	class(model_data_t), pointer :: model
	if (associated (event%process)) then
	model => event%process%get_model_ptr ()
	else
	model => null ()
	end if
	end function event_get_model_ptr

	@ %def event_get_process_ptr
	@ %def event_get_process_instance_ptr
	@ %def event_get_model_ptr
	@ Return the current values of indices: the MCI group of components, the term
	index (different terms corresponding, potentially, to different effective
	kinematics), and the MC integration channel. The [[i_mci]] call is delegated
	to the current process instance.
	<<Events: event: TBP>>=
	procedure :: get_i_mci => event_get_i_mci
	procedure :: get_i_term => event_get_i_term
	procedure :: get_channel => event_get_channel
	<<Events: sub interfaces>>=
	module function event_get_i_mci (event) result (i_mci)
	class(event_t), intent(in) :: event
	integer :: i_mci
	end function event_get_i_mci
	module function event_get_i_term (event) result (i_term)
	class(event_t), intent(in) :: event
	integer :: i_term
	end function event_get_i_term
	module function event_get_channel (event) result (channel)
	class(event_t), intent(in) :: event
	integer :: channel
	end function event_get_channel
	<<Events: procedures>>=
	module function event_get_i_mci (event) result (i_mci)
	class(event_t), intent(in) :: event
	integer :: i_mci
	i_mci = event%selected_i_mci
	end function event_get_i_mci

	module function event_get_i_term (event) result (i_term)
	class(event_t), intent(in) :: event
	integer :: i_term
	i_term = event%selected_i_term
	end function event_get_i_term

	module function event_get_channel (event) result (channel)
	class(event_t), intent(in) :: event
	integer :: channel
	channel = event%selected_channel
	end function event_get_channel

	@ %def event_get_i_mci
	@ %def event_get_i_term
	@ %def event_get_channel
	@ This flag tells us whether the event consists just of a hard process
	(i.e., holds at most the first, trivial transform), or is a dressed
	events with additional transforms.
	<<Events: event: TBP>>=
	procedure :: has_transform => event_has_transform
	<<Events: sub interfaces>>=
	module function event_has_transform (event) result (flag)
	class(event_t), intent(in) :: event
	logical :: flag
	end function event_has_transform
	<<Events: procedures>>=
	module function event_has_transform (event) result (flag)
	class(event_t), intent(in) :: event
	logical :: flag
	if (associated (event%transform_first)) then
	flag = associated (event%transform_first%next)
	else
	flag = .false.
	end if
	end function event_has_transform

	@ %def event_has_transform
	@ Return the currently selected normalization mode, or alternate
	normalization mode.
	<<Events: event: TBP>>=
	procedure :: get_norm_mode => event_get_norm_mode
	<<Events: sub interfaces>>=
	elemental module function event_get_norm_mode (event) result (norm_mode)
	class(event_t), intent(in) :: event
	integer :: norm_mode
	end function event_get_norm_mode
	<<Events: procedures>>=
	elemental module function event_get_norm_mode (event) result (norm_mode)
	class(event_t), intent(in) :: event
	integer :: norm_mode
	norm_mode = event%config%norm_mode
	end function event_get_norm_mode

	@ %def event_get_norm_mode
	@ Return the kinematical weight, defined as the ratio of event weight
	and squared matrix element.
	<<Events: event: TBP>>=
	procedure :: get_kinematical_weight => event_get_kinematical_weight
	<<Events: sub interfaces>>=
	module function event_get_kinematical_weight (event) result (f)
	class(event_t), intent(in) :: event
	real(default) :: f
	end function event_get_kinematical_weight
	<<Events: procedures>>=
	module function event_get_kinematical_weight (event) result (f)
	class(event_t), intent(in) :: event
	real(default) :: f
	if (event%sqme_ref_is_known () .and. event%weight_ref_is_known () &
	.and. abs (event%get_sqme_ref ()) > 0) then
	f = event%get_weight_ref () / event%get_sqme_ref ()
	else
	f = 0
	end if
	end function event_get_kinematical_weight

	@ %def event_get_kinematical_weight
	@ Return data used by external event formats.
	<<Events: event: TBP>>=
	procedure :: has_index => event_has_index
	procedure :: get_index => event_get_index
	procedure :: get_fac_scale => event_get_fac_scale
	procedure :: get_alpha_s => event_get_alpha_s
	procedure :: get_sqrts => event_get_sqrts
	procedure :: get_polarization => event_get_polarization
	procedure :: get_beam_file => event_get_beam_file
	procedure :: get_process_name => event_get_process_name
	<<Events: sub interfaces>>=
	module function event_has_index (event) result (flag)
	class(event_t), intent(in) :: event
	logical :: flag
	end function event_has_index
	module function event_get_index (event) result (index)
	class(event_t), intent(in) :: event
	integer :: index
	end function event_get_index
	module function event_get_fac_scale (event) result (fac_scale)
	class(event_t), intent(in) :: event
	real(default) :: fac_scale
	end function event_get_fac_scale
	module function event_get_alpha_s (event) result (alpha_s)
	class(event_t), intent(in) :: event
	real(default) :: alpha_s
	end function event_get_alpha_s
	module function event_get_sqrts (event) result (sqrts)
	class(event_t), intent(in) :: event
	real(default) :: sqrts
	end function event_get_sqrts
	module function event_get_polarization (event) result (pol)
	class(event_t), intent(in) :: event
	real(default), dimension(:), allocatable :: pol
	end function event_get_polarization
	module function event_get_beam_file (event) result (file)
	class(event_t), intent(in) :: event
	type(string_t) :: file
	end function event_get_beam_file
	module function event_get_process_name (event) result (name)
	class(event_t), intent(in) :: event
	type(string_t) :: name
	end function event_get_process_name
	<<Events: procedures>>=
	module function event_has_index (event) result (flag)
	class(event_t), intent(in) :: event
	logical :: flag
	flag = event%expr%has_event_index ()
	end function event_has_index

	module function event_get_index (event) result (index)
	class(event_t), intent(in) :: event
	integer :: index
	index = event%expr%get_event_index ()
	end function event_get_index

	module function event_get_fac_scale (event) result (fac_scale)
	class(event_t), intent(in) :: event
	real(default) :: fac_scale
	fac_scale = event%instance%get_fac_scale (event%selected_i_term)
	end function event_get_fac_scale

	module function event_get_alpha_s (event) result (alpha_s)
	class(event_t), intent(in) :: event
	real(default) :: alpha_s
	alpha_s = event%instance%get_alpha_s (event%selected_i_term)
	end function event_get_alpha_s

	module function event_get_sqrts (event) result (sqrts)
	class(event_t), intent(in) :: event
	real(default) :: sqrts
	sqrts = event%instance%get_sqrts ()
	end function event_get_sqrts

	module function event_get_polarization (event) result (pol)
	class(event_t), intent(in) :: event
	real(default), dimension(:), allocatable :: pol
	pol = event%instance%get_polarization ()
	end function event_get_polarization

	module function event_get_beam_file (event) result (file)
	class(event_t), intent(in) :: event
	type(string_t) :: file
	file = event%instance%get_beam_file ()
	end function event_get_beam_file

	module function event_get_process_name (event) result (name)
	class(event_t), intent(in) :: event
	type(string_t) :: name
	name = event%instance%get_process_name ()
	end function event_get_process_name

	@ %def event_get_index
	@ %def event_get_fac_scale
	@ %def event_get_alpha_s
	@ %def event_get_sqrts
	@ %def event_get_polarization
	@ %def event_get_beam_file
	@ %def event_get_process_name
	@ Return the actual number of calls, as stored in the process instance.
	<<Events: event: TBP>>=
	procedure :: get_actual_calls_total => event_get_actual_calls_total
	<<Events: sub interfaces>>=
	elemental module function event_get_actual_calls_total (event) result (n)
	class(event_t), intent(in) :: event
	integer :: n
	end function event_get_actual_calls_total
	<<Events: procedures>>=
	elemental module function event_get_actual_calls_total (event) result (n)
	class(event_t), intent(in) :: event
	integer :: n
	if (associated (event%instance)) then
	n = event%instance%get_actual_calls_total ()
	else
	n = 0
	end if
	end function event_get_actual_calls_total

	@ %def event_get_actual_calls_total
	@
	Eliminate numerical noise in the [[subevt]] expression and in the event
	transforms (which includes associated process instances).
	<<Events: public>>=
	public :: pacify
	<<Events: interfaces>>=
	interface pacify
	module procedure pacify_event
	end interface pacify
	<<Events: sub interfaces>>=
	module subroutine pacify_event (event)
	class(event_t), intent(inout) :: event
	class(evt_t), pointer :: evt
	end subroutine pacify_event
	<<Events: procedures>>=
	module subroutine pacify_event (event)
	class(event_t), intent(inout) :: event
	class(evt_t), pointer :: evt
	call event%pacify_particle_set ()
	if (event%expr%subevt_filled) call pacify (event%expr)
	evt => event%transform_first
	do while (associated (evt))
	select type (evt)
	type is (evt_decay_t); call pacify (evt)
	end select
	evt => evt%next
	end do
	end subroutine pacify_event

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

	module events_ut
	use unit_tests
	use events_uti

	<<Standard module head>>

	<<Events: public test>>

	contains

	<<Events: test driver>>

	end module events_ut
	@ %def events_ut
	@
	<<[[events_uti.f90]]>>=
	<<File header>>

	module events_uti

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use model_data
	use particles
	use process_libraries
	use process_stacks
	use event_transforms
	use decays
	use decays_ut, only: prepare_testbed

	use process, only: process_t
	use instances, only: process_instance_t

	use events

	<<Standard module head>>

	<<Events: test declarations>>

	contains

	<<Events: tests>>

	end module events_uti

	@ %def events_uti
	@ API: driver for the unit tests below.
	<<Events: public test>>=
	public :: events_test
	<<Events: test driver>>=
	subroutine events_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Events: execute tests>>
	end subroutine events_test

	@ %def events_test
	@
	\subsubsection{Empty event record}
	<<Events: execute tests>>=
	call test (events_1, "events_1", &
	"empty event record", &
	u, results)
	<<Events: test declarations>>=
	public :: events_1
	<<Events: tests>>=
	subroutine events_1 (u)
	integer, intent(in) :: u
	type(event_t), target :: event

	write (u, "(A)") "* Test output: events_1"
	write (u, "(A)") "* Purpose: display an empty event object"
	write (u, "(A)")

	call event%write (u)

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

	end subroutine events_1

	@ %def events_1
	@
	\subsubsection{Simple event}
	<<Events: execute tests>>=
	call test (events_2, "events_2", &
	"generate event", &
	u, results)
	<<Events: test declarations>>=
	public :: events_2
	<<Events: tests>>=
	subroutine events_2 (u)
	use processes_ut, only: prepare_test_process, cleanup_test_process
	integer, intent(in) :: u
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(model_data_t), target :: model

	write (u, "(A)") "* Test output: events_2"
	write (u, "(A)") "* Purpose: generate and display an event"
	write (u, "(A)")

	call model%init_test ()

	write (u, "(A)") "* Generate test process event"

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	call process_instance%setup_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Initialize event object"

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())

	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"
	write (u, "(A)")

	call event%generate (1, [0.4_default, 0.4_default])
	call event%increment_index ()
	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 model%final ()

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

	end subroutine events_2

	@ %def events_2
	@
	\subsubsection{Recovering an event}
	Generate an event and store the particle set. Then reset the event
	record, recall the particle set, and recover the event from that.
	<<Events: execute tests>>=
	call test (events_4, "events_4", &
	"recover event", &
	u, results)
	<<Events: test declarations>>=
	public :: events_4
	<<Events: tests>>=
	subroutine events_4 (u)
	use processes_ut, only: prepare_test_process, cleanup_test_process
	integer, intent(in) :: u
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(process_t), allocatable, target :: process2
	type(process_instance_t), allocatable, target :: process2_instance
	type(particle_set_t) :: particle_set
	type(model_data_t), target :: model

	write (u, "(A)") "* Test output: events_4"
	write (u, "(A)") "* Purpose: generate and recover an event"
	write (u, "(A)")

	call model%init_test ()

	write (u, "(A)") "* Generate test process event and save particle set"
	write (u, "(A)")

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	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 ()
	call event%write (u)

	particle_set = event%get_particle_set_ptr ()
	! NB: 'particle_set' contains pointers to the model within 'process'

	call event%final ()
	deallocate (event)

	write (u, "(A)")
	write (u, "(A)") "* Recover event from particle set"
	write (u, "(A)")

	allocate (process2)
	allocate (process2_instance)
	call prepare_test_process (process2, process2_instance, model)
	call process2_instance%setup_event_data ()

	allocate (event)
	call event%basic_init ()
	call event%connect (process2_instance, process2%get_model_ptr ())

	call event%select (1, 1, 1)
	call event%set_hard_particle_set (particle_set)
	call event%recalculate (update_sqme = .true.)
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Transfer sqme and evaluate expressions"
	write (u, "(A)")

	call event%accept_sqme_prc ()
	call event%accept_weight_prc ()
	call event%check ()
	call event%set_index (1)
	call event%evaluate_expressions ()
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reset contents"
	write (u, "(A)")

	call event%reset_contents ()
	call event%reset_index ()
	event%transform_first%particle_set_exists = .false.
	call event%write (u)

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

	call particle_set%final ()

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process2, process2_instance)
	deallocate (process2_instance)
	deallocate (process2)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call model%final ()

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

	end subroutine events_4

	@ %def events_4
	@
	\subsubsection{Partially Recovering an event}
	Generate an event and store the particle set. Then reset the event
	record, recall the particle set, and recover the event as far as possible
	without recomputing the squared matrix element.
	<<Events: execute tests>>=
	call test (events_5, "events_5", &
	"partially recover event", &
	u, results)
	<<Events: test declarations>>=
	public :: events_5
	<<Events: tests>>=
	subroutine events_5 (u)
	use processes_ut, only: prepare_test_process, cleanup_test_process
	integer, intent(in) :: u
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(process_t), allocatable, target :: process2
	type(process_instance_t), allocatable, target :: process2_instance
	type(particle_set_t) :: particle_set
	real(default) :: sqme, weight
	type(model_data_t), target :: model

	write (u, "(A)") "* Test output: events_5"
	write (u, "(A)") "* Purpose: generate and recover an event"
	write (u, "(A)")

	call model%init_test ()

	write (u, "(A)") "* Generate test process event and save particle set"
	write (u, "(A)")

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	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 ()
	call event%write (u)

	particle_set = event%get_particle_set_ptr ()
	sqme = event%get_sqme_ref ()
	weight = event%get_weight_ref ()

	call event%final ()
	deallocate (event)

	write (u, "(A)")
	write (u, "(A)") "* Recover event from particle set"
	write (u, "(A)")

	allocate (process2)
	allocate (process2_instance)
	call prepare_test_process (process2, process2_instance, model)
	call process2_instance%setup_event_data ()

	allocate (event)
	call event%basic_init ()
	call event%connect (process2_instance, process2%get_model_ptr ())

	call event%select (1, 1, 1)
	call event%set_hard_particle_set (particle_set)
	call event%recalculate (update_sqme = .false.)
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set sqme and evaluate expressions"
	write (u, "(A)")

	call event%set (sqme_ref = sqme, weight_ref = weight)
	call event%accept_sqme_ref ()
	call event%accept_weight_ref ()
	call event%set_index (1)
	call event%evaluate_expressions ()
	call event%write (u)

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

	call particle_set%final ()

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process2, process2_instance)
	deallocate (process2_instance)
	deallocate (process2)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call model%final ()

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

	end subroutine events_5

	@ %def events_5
	@
	\subsubsection{Decays}
	Generate an event with subsequent decays.
	<<Events: execute tests>>=
	call test (events_6, "events_6", &
	"decays", &
	u, results)
	<<Events: test declarations>>=
	public :: events_6
	<<Events: tests>>=
	subroutine events_6 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(string_t) :: prefix, procname1, procname2
	type(process_library_t), target :: lib
	type(process_stack_t) :: process_stack
	class(evt_t), pointer :: evt_decay
	type(event_t), allocatable, target :: event
	type(process_t), pointer :: process
	type(process_instance_t), allocatable, target :: process_instance

	write (u, "(A)") "* Test output: events_6"
	write (u, "(A)") "* Purpose: generate an event with subsequent decays"
	write (u, "(A)")

	write (u, "(A)") "* Generate test process and decay"
	write (u, "(A)")

	call os_data%init ()

	prefix = "events_6"
	procname1 = prefix // "_p"
	procname2 = prefix // "_d"
	call prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering=.true., decay=.true.)

	write (u, "(A)") "* Initialize decay process"

	process => process_stack%get_process_ptr (procname1)
	model => process%get_model_ptr ()
	call model%set_unstable (25, [procname2])

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	call process_instance%init_simulation (1)

	write (u, "(A)")
	write (u, "(A)") "* Initialize event transform: decay"

	allocate (evt_decay_t :: evt_decay)
	call evt_decay%connect (process_instance, model, process_stack)

	write (u, "(A)")
	write (u, "(A)") "* Initialize event object"
	write (u, "(A)")

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, model)
	call event%import_transform (evt_decay)

	call event%write (u, show_decay = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Generate event"
	write (u, "(A)")

	call event%generate (1, [0.4_default, 0.4_default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call event%write (u)

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

	call event%final ()
	deallocate (event)

	call process_instance%final ()
	deallocate (process_instance)

	call process_stack%final ()

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

	end subroutine events_6

	@ %def events_6
	@
	\subsubsection{Decays}
	Generate a decay event with varying options.
	<<Events: execute tests>>=
	call test (events_7, "events_7", &
	"decay options", &
	u, results)
	<<Events: test declarations>>=
	public :: events_7
	<<Events: tests>>=
	subroutine events_7 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(string_t) :: prefix, procname2
	type(process_library_t), target :: lib
	type(process_stack_t) :: process_stack
	type(process_t), pointer :: process
	type(process_instance_t), allocatable, target :: process_instance

	write (u, "(A)") "* Test output: events_7"
	write (u, "(A)") "* Purpose: check decay options"
	write (u, "(A)")

	write (u, "(A)") "* Prepare test process"
	write (u, "(A)")

	call os_data%init ()

	prefix = "events_7"
	procname2 = prefix // "_d"
	call prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering=.false., decay=.true.)

	write (u, "(A)") "* Generate decay event, default options"
	write (u, "(A)")

	process => process_stack%get_process_ptr (procname2)
	model => process%get_model_ptr ()
	call model%set_unstable (25, [procname2])

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data (model)
	call process_instance%init_simulation (1)

	call process_instance%generate_weighted_event (1)
	call process_instance%write (u)

	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Generate decay event, helicity-diagonal decay"
	write (u, "(A)")

	process => process_stack%get_process_ptr (procname2)
	model => process%get_model_ptr ()
	call model%set_unstable (25, [procname2], diagonal = .true.)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data (model)
	call process_instance%init_simulation (1)

	call process_instance%generate_weighted_event (1)
	call process_instance%write (u)

	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Generate decay event, isotropic decay, &
	&polarized final state"
	write (u, "(A)")

	process => process_stack%get_process_ptr (procname2)
	model => process%get_model_ptr ()
	call model%set_unstable (25, [procname2], isotropic = .true.)
	call model%set_polarized (6)
	call model%set_polarized (-6)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data (model)
	call process_instance%init_simulation (1)

	call process_instance%generate_weighted_event (1)
	call process_instance%write (u)

	call process_instance%final ()
	deallocate (process_instance)

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

	call process_stack%final ()

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

	end subroutine events_7

	@ %def events_7
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Raw Event I/O}
	The raw format is for internal use only. All data are stored
	unformatted, so they can be efficiently be re-read on the same
	machine, but not necessarily on another machine.

	This module explicitly depends on the [[events]] module which provides the
	concrete implementation of [[event_base]]. The other I/O formats
	access only the methods that are defined in [[event_base]].
	<<[[eio_raw.f90]]>>=
	<<File header>>

	module eio_raw

	<<Use kinds>>
	<<Use strings>>
	use event_base
	use event_handles, only: event_handle_t
	use eio_data
	use eio_base
	use events

	<<Standard module head>>

	<<EIO raw: public>>

	<<EIO raw: parameters>>

	<<EIO raw: types>>

	interface
	<<EIO raw: sub interfaces>>
	end interface

	end module eio_raw
	@ %def eio_raw
	@
	<<[[eio_raw_sub.f90]]>>=
	<<File header>>

	submodule (eio_raw) eio_raw_s

	use io_units
	use diagnostics
	use model_data
	use particles

	implicit none

	contains

	<<EIO raw: procedures>>

	end submodule eio_raw_s

	@ %def eio_raw_s
	@
	\subsection{File Format Version}
	This is the current default file version.
	<<EIO raw: parameters>>=
	integer, parameter :: CURRENT_FILE_VERSION = 2

	@ %def CURRENT_FILE_VERSION
	@ The user may change this number; this should force some
	compatibility mode for reading and writing. In any case, the file
	version stored in a event file that we read has to match the expected
	file version.

	History of version numbers:
	\begin{enumerate}
	\item
	Format for WHIZARD 2.2.0 to 2.2.3. No version number stored in the raw file.
	\item
	Format from 2.2.4 on. File contains version number. The file
	contains the transformed particle set (if applicable) after the
	hard-process particle set.
	\end{enumerate}
	@
	\subsection{Type}
	Note the file version number. The default may be reset during
	initialization, which should enforce some compatibility mode.
	<<EIO raw: public>>=
	public :: eio_raw_t
	<<EIO raw: types>>=
	type, extends (eio_t) :: eio_raw_t
	logical :: reading = .false.
	logical :: writing = .false.
	integer :: unit = 0
	integer :: norm_mode = NORM_UNDEFINED
	real(default) :: sigma = 1
	integer :: n = 1
	integer :: n_alt = 0
	logical :: check = .false.
	logical :: use_alphas_from_file = .false.
	logical :: use_scale_from_file = .false.
	logical :: fixed_order_nlo = .false.
	integer :: file_version = CURRENT_FILE_VERSION
	contains
	<<EIO raw: eio raw: TBP>>
	end type eio_raw_t

	@ %def eio_raw_t
	@ Output. This is not the actual event format, but a readable account
	of the current object status.
	<<EIO raw: eio raw: TBP>>=
	procedure :: write => eio_raw_write
	<<EIO raw: sub interfaces>>=
	module subroutine eio_raw_write (object, unit)
	class(eio_raw_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine eio_raw_write
	<<EIO raw: procedures>>=
	module subroutine eio_raw_write (object, unit)
	class(eio_raw_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Raw event stream:"
	write (u, "(3x,A,L1)") "Check MD5 sum = ", object%check
	if (object%n_alt > 0) then
	write (u, "(3x,A,I0)") "Alternate weights = ", object%n_alt
	end if
	write (u, "(3x,A,L1)") "Alpha_s from file = ", &
	object%use_alphas_from_file
	write (u, "(3x,A,L1)") "Scale from file = ", &
	object%use_scale_from_file
	write (u, "(3x,A,L1)") "Events for fNLO = ", &
	object%fixed_order_nlo
	if (object%reading) then
	write (u, "(3x,A,A)") "Reading from file = ", char (object%filename)
	else if (object%writing) then
	write (u, "(3x,A,A)") "Writing to file = ", char (object%filename)
	else
	write (u, "(3x,A)") "[closed]"
	end if
	end subroutine eio_raw_write

	@ %def eio_raw_write
	@ Finalizer: close any open file.
	<<EIO raw: eio raw: TBP>>=
	procedure :: final => eio_raw_final
	<<EIO raw: sub interfaces>>=
	module subroutine eio_raw_final (object)
	class(eio_raw_t), intent(inout) :: object
	end subroutine eio_raw_final
	<<EIO raw: procedures>>=
	module subroutine eio_raw_final (object)
	class(eio_raw_t), intent(inout) :: object
	if (object%reading .or. object%writing) then
	write (msg_buffer, "(A,A,A)") "Events: closing raw file '", &
	char (object%filename), "'"
	call msg_message ()
	close (object%unit)
	object%reading = .false.
	object%writing = .false.
	end if
	end subroutine eio_raw_final

	@ %def eio_raw_final
	@ Set the [[check]] flag which determines whether we compare checksums on input.
	<<EIO raw: eio raw: TBP>>=
	procedure :: set_parameters => eio_raw_set_parameters
	<<EIO raw: sub interfaces>>=
	module subroutine eio_raw_set_parameters (eio, check, &
	use_alphas_from_file, use_scale_from_file, fixed_order_nlo, &
	version_string, extension)
	class(eio_raw_t), intent(inout) :: eio
	logical, intent(in), optional :: check, use_alphas_from_file, &
	use_scale_from_file, fixed_order_nlo
	type(string_t), intent(in), optional :: version_string
	type(string_t), intent(in), optional :: extension
	end subroutine eio_raw_set_parameters
	<<EIO raw: procedures>>=
	module subroutine eio_raw_set_parameters (eio, check, use_alphas_from_file, &
	use_scale_from_file, fixed_order_nlo, version_string, extension)
	class(eio_raw_t), intent(inout) :: eio
	logical, intent(in), optional :: check, use_alphas_from_file, &
	use_scale_from_file, fixed_order_nlo
	type(string_t), intent(in), optional :: version_string
	type(string_t), intent(in), optional :: extension
	if (present (check)) eio%check = check
	if (present (use_alphas_from_file)) eio%use_alphas_from_file = &
	use_alphas_from_file
	if (present (use_scale_from_file)) eio%use_scale_from_file = &
	use_scale_from_file
	if (present (fixed_order_nlo)) eio%fixed_order_nlo = &
	fixed_order_nlo
	if (present (version_string)) then
	select case (char (version_string))
	case ("", "2.2.4")
	eio%file_version = CURRENT_FILE_VERSION
	case ("2.2")
	eio%file_version = 1
	case default
	call msg_fatal ("Raw event I/O: unsupported version '" &
	// char (version_string) // "'")
	eio%file_version = 0
	end select
	end if
	if (present (extension)) then
	eio%extension = extension
	else
	eio%extension = "evx"
	end if
	end subroutine eio_raw_set_parameters

	@ %def eio_raw_set_parameters
	@ Initialize event writing.
	<<EIO raw: eio raw: TBP>>=
	procedure :: init_out => eio_raw_init_out
	<<EIO raw: sub interfaces>>=
	module subroutine eio_raw_init_out (eio, sample, data, success, extension)
	class(eio_raw_t), intent(inout) :: eio
	type(string_t), intent(in) :: sample
	type(event_sample_data_t), intent(in), optional :: data
	logical, intent(out), optional :: success
	type(string_t), intent(in), optional :: extension
	end subroutine eio_raw_init_out
	<<EIO raw: procedures>>=
	module subroutine eio_raw_init_out (eio, sample, data, success, extension)
	class(eio_raw_t), intent(inout) :: eio
	type(string_t), intent(in) :: sample
	type(event_sample_data_t), intent(in), optional :: data
	logical, intent(out), optional :: success
	type(string_t), intent(in), optional :: extension
	character(32) :: md5sum_prc, md5sum_cfg
	character(32), dimension(:), allocatable :: md5sum_alt
	integer :: i
	if (present (extension)) then
	eio%extension = extension
	else
	eio%extension = "evx"
	end if
	eio%filename = sample // "." // eio%extension
	eio%unit = free_unit ()
	write (msg_buffer, "(A,A,A)") "Events: writing to raw file '", &
	char (eio%filename), "'"
	call msg_message ()
	eio%writing = .true.
	if (present (data)) then
	md5sum_prc = data%md5sum_prc
	md5sum_cfg = data%md5sum_cfg
	eio%norm_mode = data%norm_mode
	eio%sigma = data%total_cross_section
	eio%n = data%n_evt
	eio%n_alt = data%n_alt
	if (eio%n_alt > 0) then
	!!! !!! !!! Workaround for gfortran 5.0 ICE
	allocate (md5sum_alt (data%n_alt))
	md5sum_alt = data%md5sum_alt
	!!! allocate (md5sum_alt (data%n_alt), source = data%md5sum_alt)
	end if
	else
	md5sum_prc = ""
	md5sum_cfg = ""
	end if
	open (eio%unit, file = char (eio%filename), form = "unformatted", &
	action = "write", status = "replace")
	select case (eio%file_version)
	case (2:); write (eio%unit) eio%file_version
	end select
	write (eio%unit) md5sum_prc
	write (eio%unit) md5sum_cfg
	write (eio%unit) eio%norm_mode
	write (eio%unit) eio%n_alt
	if (allocated (md5sum_alt)) then
	do i = 1, eio%n_alt
	write (eio%unit) md5sum_alt(i)
	end do
	end if
	if (present (success)) success = .true.
	end subroutine eio_raw_init_out

	@ %def eio_raw_init_out
	@ Initialize event reading.
	<<EIO raw: eio raw: TBP>>=
	procedure :: init_in => eio_raw_init_in
	<<EIO raw: sub interfaces>>=
	module subroutine eio_raw_init_in (eio, sample, data, success, extension)
	class(eio_raw_t), intent(inout) :: eio
	type(string_t), intent(in) :: sample
	type(event_sample_data_t), intent(inout), optional :: data
	logical, intent(out), optional :: success
	type(string_t), intent(in), optional :: extension
	end subroutine eio_raw_init_in
	<<EIO raw: procedures>>=
	module subroutine eio_raw_init_in (eio, sample, data, success, extension)
	class(eio_raw_t), intent(inout) :: eio
	type(string_t), intent(in) :: sample
	type(event_sample_data_t), intent(inout), optional :: data
	logical, intent(out), optional :: success
	type(string_t), intent(in), optional :: extension
	character(32) :: md5sum_prc, md5sum_cfg
	character(32), dimension(:), allocatable :: md5sum_alt
	integer :: i, file_version
	if (present (success)) success = .true.
	if (present (extension)) then
	eio%extension = extension
	else
	eio%extension = "evx"
	end if
	eio%filename = sample // "." // eio%extension
	eio%unit = free_unit ()
	if (present (data)) then
	eio%sigma = data%total_cross_section
	eio%n = data%n_evt
	end if
	write (msg_buffer, "(A,A,A)") "Events: reading from raw file '", &
	char (eio%filename), "'"
	call msg_message ()
	eio%reading = .true.
	open (eio%unit, file = char (eio%filename), form = "unformatted", &
	action = "read", status = "old")
	select case (eio%file_version)
	case (2:); read (eio%unit) file_version
	case default; file_version = 1
	end select
	if (file_version /= eio%file_version) then
	call msg_error ("Reading event file: raw-file version mismatch.")
	if (present (success)) success = .false.
	return
	else if (file_version /= CURRENT_FILE_VERSION) then
	call msg_warning ("Reading event file: compatibility mode.")
	end if
	read (eio%unit) md5sum_prc
	read (eio%unit) md5sum_cfg
	read (eio%unit) eio%norm_mode
	read (eio%unit) eio%n_alt
	if (present (data)) then
	if (eio%n_alt /= data%n_alt) then
	if (present (success)) success = .false.
	return
	end if
	end if
	allocate (md5sum_alt (eio%n_alt))
	do i = 1, eio%n_alt
	read (eio%unit) md5sum_alt(i)
	end do
	if (present (success)) then
	if (present (data)) then
	if (eio%check) then
	if (data%md5sum_prc /= "") then
	success = success .and. md5sum_prc == data%md5sum_prc
	end if
	if (data%md5sum_cfg /= "") then
	success = success .and. md5sum_cfg == data%md5sum_cfg
	end if
	do i = 1, eio%n_alt
	if (data%md5sum_alt(i) /= "") then
	success = success .and. md5sum_alt(i) == data%md5sum_alt(i)
	end if
	end do
	else
	call msg_warning ("Reading event file: MD5 sum check disabled")
	end if
	end if
	end if
	end subroutine eio_raw_init_in

	@ %def eio_raw_init_in
	@ Switch from input to output: reopen the file for reading.
	<<EIO raw: eio raw: TBP>>=
	procedure :: switch_inout => eio_raw_switch_inout
	<<EIO raw: sub interfaces>>=
	module subroutine eio_raw_switch_inout (eio, success)
	class(eio_raw_t), intent(inout) :: eio
	logical, intent(out), optional :: success
	end subroutine eio_raw_switch_inout
	<<EIO raw: procedures>>=
	module subroutine eio_raw_switch_inout (eio, success)
	class(eio_raw_t), intent(inout) :: eio
	logical, intent(out), optional :: success
	write (msg_buffer, "(A,A,A)") "Events: appending to raw file '", &
	char (eio%filename), "'"
	call msg_message ()
	close (eio%unit, status = "keep")
	eio%reading = .false.
	open (eio%unit, file = char (eio%filename), form = "unformatted", &
	action = "write", position = "append", status = "old")
	eio%writing = .true.
	if (present (success)) success = .true.
	end subroutine eio_raw_switch_inout

	@ %def eio_raw_switch_inout
	@ Output an event. Write first the event indices, then weight and
	squared matrix element, then the particle set.

	We always write the particle set of the hard process. (Note: this
	should be reconsidered.) We do make a physical copy.

	On output, we write the [[prc]] values for weight and sqme, since
	these are the values just computed. On input, we store the values as
	[[ref]] values. The caller can then decide whether to recompute
	values and thus obtain distinct [[prc]] values, or just accept them.

	The [[passed]] flag is not written. This allow us to apply different
	selection criteria upon rereading.
	<<EIO raw: eio raw: TBP>>=
	procedure :: output => eio_raw_output
	<<EIO raw: sub interfaces>>=
	module subroutine eio_raw_output &
	(eio, event, i_prc, reading, passed, pacify, event_handle)
	class(eio_raw_t), intent(inout) :: eio
	class(generic_event_t), intent(in), target :: event
	logical, intent(in), optional :: reading, passed, pacify
	class(event_handle_t), intent(inout), optional :: event_handle
	integer, intent(in) :: i_prc
	end subroutine eio_raw_output
	<<EIO raw: procedures>>=
	module subroutine eio_raw_output &
	(eio, event, i_prc, reading, passed, pacify, event_handle)
	class(eio_raw_t), intent(inout) :: eio
	class(generic_event_t), intent(in), target :: event
	logical, intent(in), optional :: reading, passed, pacify
	class(event_handle_t), intent(inout), optional :: event_handle
	integer, intent(in) :: i_prc
	type(particle_set_t), pointer :: pset
	integer :: i
	if (eio%writing) then
	if (event%has_valid_particle_set ()) then
	select type (event)
	type is (event_t)
	write (eio%unit) i_prc
	write (eio%unit) event%get_index ()
	write (eio%unit) event%get_i_mci ()
	write (eio%unit) event%get_i_term ()
	write (eio%unit) event%get_channel ()
	write (eio%unit) event%expr%weight_prc
	write (eio%unit) event%expr%excess_prc
	write (eio%unit) event%get_n_dropped ()
	write (eio%unit) event%expr%sqme_prc
	do i = 1, eio%n_alt
	write (eio%unit) event%expr%weight_alt(i)
	write (eio%unit) event%expr%sqme_alt(i)
	end do
	allocate (pset)
	call event%get_hard_particle_set (pset)
	call pset%write_raw (eio%unit)
	call pset%final ()
	deallocate (pset)
	select case (eio%file_version)
	case (2:)
	if (event%has_transform ()) then
	write (eio%unit) .true.
	pset => event%get_particle_set_ptr ()
	call pset%write_raw (eio%unit)
	else
	write (eio%unit) .false.
	end if
	end select
	class default
	call msg_bug ("Event: write raw: defined only for full event_t")
	end select
	else
	call msg_bug ("Event: write raw: particle set is undefined")
	end if
	else
	call eio%write ()
	call msg_fatal ("Raw event file is not open for writing")
	end if
	end subroutine eio_raw_output

	@ %def eio_raw_output
	@ Input an event.

	Note: the particle set is physically copied. If there is a
	performance issue, we might choose to pointer-assign it instead, with
	a different version of [[event%set_hard_particle_set]].
	<<EIO raw: eio raw: TBP>>=
	procedure :: input_i_prc => eio_raw_input_i_prc
	procedure :: input_event => eio_raw_input_event
	<<EIO raw: sub interfaces>>=
	module subroutine eio_raw_input_i_prc (eio, i_prc, iostat)
	class(eio_raw_t), intent(inout) :: eio
	integer, intent(out) :: i_prc
	integer, intent(out) :: iostat
	end subroutine eio_raw_input_i_prc
	module subroutine eio_raw_input_event (eio, event, iostat, event_handle)
	class(eio_raw_t), intent(inout) :: eio
	class(generic_event_t), intent(inout), target :: event
	integer, intent(out) :: iostat
	class(event_handle_t), intent(inout), optional :: event_handle
	end subroutine eio_raw_input_event
	<<EIO raw: procedures>>=
	module subroutine eio_raw_input_i_prc (eio, i_prc, iostat)
	class(eio_raw_t), intent(inout) :: eio
	integer, intent(out) :: i_prc
	integer, intent(out) :: iostat
	if (eio%reading) then
	read (eio%unit, iostat = iostat) i_prc
	else
	call eio%write ()
	call msg_fatal ("Raw event file is not open for reading")
	end if
	end subroutine eio_raw_input_i_prc

	module subroutine eio_raw_input_event (eio, event, iostat, event_handle)
	class(eio_raw_t), intent(inout) :: eio
	class(generic_event_t), intent(inout), target :: event
	integer, intent(out) :: iostat
	class(event_handle_t), intent(inout), optional :: event_handle
	integer :: event_index, i_mci, i_term, channel, i
	real(default) :: weight, excess, sqme
	integer :: n_dropped
	real(default), dimension(:), allocatable :: weight_alt, sqme_alt
	logical :: has_transform
	type(particle_set_t), pointer :: pset
	class(model_data_t), pointer :: model
	if (eio%reading) then
	select type (event)
	type is (event_t)
	read (eio%unit, iostat = iostat) event_index
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) i_mci
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) i_term
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) channel
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) weight
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) excess
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) n_dropped
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) sqme
	if (iostat /= 0) return
	call event%reset_contents ()
	call event%set_index (event_index)
	call event%select (i_mci, i_term, channel)
	if (eio%norm_mode /= NORM_UNDEFINED) then
	call event_normalization_update (weight, &
	eio%sigma, eio%n, event%get_norm_mode (), eio%norm_mode)
	call event_normalization_update (excess, &
	eio%sigma, eio%n, event%get_norm_mode (), eio%norm_mode)
	end if
	call event%set (sqme_ref = sqme, weight_ref = weight, &
	excess_prc = excess, &
	n_dropped = n_dropped)
	if (eio%n_alt /= 0) then
	allocate (sqme_alt (eio%n_alt), weight_alt (eio%n_alt))
	do i = 1, eio%n_alt
	read (eio%unit, iostat = iostat) weight_alt(i)
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) sqme_alt(i)
	if (iostat /= 0) return
	end do
	call event%set (sqme_alt = sqme_alt, weight_alt = weight_alt)
	end if
	model => null ()
	if (associated (event%process)) then
	model => event%process%get_model_ptr ()
	end if
	allocate (pset)
	call pset%read_raw (eio%unit, iostat)
	if (iostat /= 0) return
	if (associated (model)) call pset%set_model (model)
	call event%set_hard_particle_set (pset)
	if (eio%use_alphas_from_file .or. eio%use_scale_from_file) then
	call event%recalculate (update_sqme = .true.)
	if (eio%fixed_order_nlo) then
	if (event%weight_prc /= event%weight_ref .and. &
	event%weight_prc == 0) then
	event%weight_prc = event%weight_ref
	end if
	end if
	end if
	call pset%final ()
	deallocate (pset)
	select case (eio%file_version)
	case (2:)
	read (eio%unit, iostat = iostat) has_transform
	if (iostat /= 0) return
	if (has_transform) then
	allocate (pset)
	call pset%read_raw (eio%unit, iostat)
	if (iostat /= 0) return
	if (associated (model)) &
	call pset%set_model (model)
	call event%link_particle_set (pset)
	end if
	end select
	class default
	call msg_bug ("Event: read raw: defined only for full event_t")
	end select
	else
	call eio%write ()
	call msg_fatal ("Raw event file is not open for reading")
	end if
	end subroutine eio_raw_input_event

	@ %def eio_raw_input_i_prc
	@ %def eio_raw_input_event
	@
	<<EIO raw: eio raw: TBP>>=
	procedure :: skip => eio_raw_skip
	<<EIO raw: sub interfaces>>=
	module subroutine eio_raw_skip (eio, iostat)
	class(eio_raw_t), intent(inout) :: eio
	integer, intent(out) :: iostat
	end subroutine eio_raw_skip
	<<EIO raw: procedures>>=
	module subroutine eio_raw_skip (eio, iostat)
	class(eio_raw_t), intent(inout) :: eio
	integer, intent(out) :: iostat
	if (eio%reading) then
	read (eio%unit, iostat = iostat)
	else
	call eio%write ()
	call msg_fatal ("Raw event file is not open for reading")
	end if
	end subroutine eio_raw_skip

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

	module eio_raw_ut
	use unit_tests
	use eio_raw_uti

	<<Standard module head>>

	<<EIO raw: public test>>

	contains

	<<EIO raw: test driver>>

	end module eio_raw_ut
	@ %def eio_raw_ut
	@
	<<[[eio_raw_uti.f90]]>>=
	<<File header>>

	module eio_raw_uti

	<<Use kinds>>
	<<Use strings>>
	use model_data
	use variables
	use events
	use eio_data
	use eio_base

	use eio_raw

	use process, only: process_t
	use instances, only: process_instance_t

	<<Standard module head>>

	<<EIO raw: test declarations>>

	contains

	<<EIO raw: tests>>

	end module eio_raw_uti

	@ %def eio_raw_uti
	@ API: driver for the unit tests below.
	<<EIO raw: public test>>=
	public :: eio_raw_test
	<<EIO raw: test driver>>=
	subroutine eio_raw_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<EIO raw: execute tests>>
	end subroutine eio_raw_test

	@ %def eio_raw_test
	@
	\subsubsection{Test I/O methods}
	We test the implementation of all I/O methods.
	<<EIO raw: execute tests>>=
	call test (eio_raw_1, "eio_raw_1", &
	"read and write event contents", &
	u, results)
	<<EIO raw: test declarations>>=
	public :: eio_raw_1
	<<EIO raw: tests>>=
	subroutine eio_raw_1 (u)
	use processes_ut, only: prepare_test_process, cleanup_test_process
	integer, intent(in) :: u
	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
	class(eio_t), allocatable :: eio
	integer :: i_prc, iostat
	type(string_t) :: sample

	write (u, "(A)") "* Test output: eio_raw_1"
	write (u, "(A)") "* Purpose: generate and read/write an event"
	write (u, "(A)")

	write (u, "(A)") "* Initialize test process"

	call model%init_test ()

	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 ())

	write (u, "(A)")
	write (u, "(A)") "* Generate and write an event"
	write (u, "(A)")

	sample = "eio_raw_1"

	allocate (eio_raw_t :: eio)

	call eio%init_out (sample)
	call event%generate (1, [0._default, 0._default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call event%write (u)
	write (u, "(A)")

	call eio%output (event, i_prc = 42)
	call eio%write (u)
	call eio%final ()

	call event%final ()
	deallocate (event)
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Re-read the event"
	write (u, "(A)")

	call eio%init_in (sample)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())

	call eio%input_i_prc (i_prc, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (i_prc):", iostat
	call eio%input_event (event, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (event):", iostat
	call eio%write (u)

	write (u, "(A)")
	write (u, "(1x,A,I0)") "i_prc = ", i_prc
	write (u, "(A)")
	call event%write (u)
	write (u, "(A)")
	write (u, "(A)") "* Generate and append another event"
	write (u, "(A)")

	call eio%switch_inout ()
	call event%generate (1, [0._default, 0._default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call event%write (u)
	write (u, "(A)")

	call eio%output (event, i_prc = 5)
	call eio%write (u)
	call eio%final ()

	call event%final ()
	deallocate (event)
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Re-read both events"
	write (u, "(A)")

	call eio%init_in (sample)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())

	call eio%input_i_prc (i_prc, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (i_prc/1):", iostat
	call eio%input_event (event, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (event/1):", iostat
	call eio%input_i_prc (i_prc, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (i_prc/2):", iostat
	call eio%input_event (event, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (event/2):", iostat
	call eio%write (u)

	write (u, "(A)")
	write (u, "(1x,A,I0)") "i_prc = ", i_prc
	write (u, "(A)")
	call event%write (u)

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

	call eio%final ()
	deallocate (eio)

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call model%final ()

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

	end subroutine eio_raw_1

	@ %def eio_raw_1
	@
	\subsubsection{Test I/O methods}
	We test the implementation of all I/O methods.
	<<EIO raw: execute tests>>=
	call test (eio_raw_2, "eio_raw_2", &
	"handle multiple weights", &
	u, results)
	<<EIO raw: test declarations>>=
	public :: eio_raw_2
	<<EIO raw: tests>>=
	subroutine eio_raw_2 (u)
	use processes_ut, only: prepare_test_process, cleanup_test_process
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(var_list_t) :: var_list
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(event_sample_data_t) :: data
	class(eio_t), allocatable :: eio
	integer :: i_prc, iostat
	type(string_t) :: sample

	write (u, "(A)") "* Test output: eio_raw_2"
	write (u, "(A)") "* Purpose: generate and read/write an event"
	write (u, "(A)") "* with multiple weights"
	write (u, "(A)")

	call model%init_test ()

	write (u, "(A)") "* Initialize test process"

	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 ()

	call data%init (n_proc = 1, n_alt = 2)

	call var_list%append_log (var_str ("?unweighted"), .false., &
	intrinsic = .true.)
	call var_list%append_string (var_str ("$sample_normalization"), &
	var_str ("auto"), intrinsic = .true.)
	call var_list%append_real (var_str ("safety_factor"), &
	1._default, intrinsic = .true.)

	allocate (event)
	call event%basic_init (var_list, n_alt = 2)
	call event%connect (process_instance, process%get_model_ptr ())

	write (u, "(A)")
	write (u, "(A)") "* Generate and write an event"
	write (u, "(A)")

	sample = "eio_raw_2"

	allocate (eio_raw_t :: eio)

	call eio%init_out (sample, data)
	call event%generate (1, [0._default, 0._default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call event%set (sqme_alt = [2._default, 3._default])
	call event%set (weight_alt = &
	[2 * event%get_weight_ref (), 3 * event%get_weight_ref ()])
	call event%store_alt_values ()
	call event%check ()

	call event%write (u)
	write (u, "(A)")

	call eio%output (event, i_prc = 42)
	call eio%write (u)
	call eio%final ()

	call event%final ()
	deallocate (event)
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Re-read the event"
	write (u, "(A)")

	call eio%init_in (sample, data)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	allocate (event)
	call event%basic_init (var_list, n_alt = 2)
	call event%connect (process_instance, process%get_model_ptr ())

	call eio%input_i_prc (i_prc, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (i_prc):", iostat
	call eio%input_event (event, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (event):", iostat
	call eio%write (u)

	write (u, "(A)")
	write (u, "(1x,A,I0)") "i_prc = ", i_prc
	write (u, "(A)")
	call event%write (u)

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

	call eio%final ()
	deallocate (eio)

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call model%final ()

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

	end subroutine eio_raw_2

	@ %def eio_raw_2
	@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Dispatch}
	An event transform is responsible for dressing a partonic event.
	Since event transforms are not mutually exclusive but are
	concatenated, we provide individual dispatchers for each of them.

	Due to the gfortran 7/8/9 bug that leads to segmentation violation if
	polymorphic user-defined derived types are allocated in routines within
	submodules, this module remains without submodule until we can switch
	to gfortran v10 or newer.
	<<[[dispatch_transforms.f90]]>>=
	<<File header>>

	module dispatch_transforms

	<<Use kinds>>
	<<Use strings>>
	use process
	use variables
	use system_defs, only: LF
	use system_dependencies, only: LHAPDF6_AVAILABLE
	use sf_lhapdf, only: lhapdf_initialize
	use pdf, only: pdf_data_t
	use diagnostics
	use models
	use os_interface
	use beam_structures
	use resonances, only: resonance_history_set_t
	use instances, only: process_instance_t, process_instance_hook_t

	use event_base, only: event_callback_t, event_callback_nop_t
	use hepmc_interface, only: HEPMC3_MODE_HEPMC2, HEPMC3_MODE_HEPMC3
	use hepmc_interface, only: HEPMC3_MODE_ROOT, HEPMC3_MODE_ROOTTREE
	use hepmc_interface, only: HEPMC3_MODE_HEPEVT
	use eio_base
	use eio_raw
	use eio_checkpoints
	use eio_callback
	use eio_lhef
	use eio_hepmc
	use eio_lcio
	use eio_stdhep
	use eio_ascii
	use eio_weights
	use eio_dump

	use event_transforms
	use resonance_insertion
	use isr_epa_handler
	use decays
	use shower_base
	use shower_core
	use shower
	use shower_pythia6
	use shower_pythia8
	use hadrons
	use mlm_matching
	use powheg_matching
	use ckkw_matching
	use tauola_interface !NODEP!
	use evt_nlo

	<<Standard module head>>

	<<Dispatch transforms: public>>

	contains

	<<Dispatch transforms: procedures>>

	end module dispatch_transforms
	@ %def dispatch_transforms
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_nlo
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_nlo (evt, keep_failed_events)
	class(evt_t), intent(out), pointer :: evt
	logical, intent(in) :: keep_failed_events
	call msg_message ("Simulate: activating fixed-order NLO events")
	allocate (evt_nlo_t :: evt)
	evt%only_weighted_events = .true.
	select type (evt)
	type is (evt_nlo_t)
	evt%i_evaluation = 0
	evt%keep_failed_events = keep_failed_events
	end select
	end subroutine dispatch_evt_nlo

	@ %def dispatch_evt_nlo
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_resonance
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_resonance (evt, var_list, res_history_set, libname)
	class(evt_t), intent(out), pointer :: evt
	type(var_list_t), intent(in) :: var_list
	type(resonance_history_set_t), dimension(:), intent(in) :: res_history_set
	type(string_t), intent(in) :: libname
	logical :: resonance_history
	resonance_history = var_list%get_lval (var_str ("?resonance_history"))
	if (resonance_history) then
	allocate (evt_resonance_t :: evt)
	call msg_message ("Simulate: activating resonance insertion")
	select type (evt)
	type is (evt_resonance_t)
	call evt%set_resonance_data (res_history_set)
	call evt%set_library (libname)
	end select
	else
	evt => null ()
	end if
	end subroutine dispatch_evt_resonance

	@ %def dispatch_evt_resonance
	@ Initialize the ISR/EPA handler, depending on active settings.

	The activation is independent for both handlers, since only one may be
	needed at a time. However, if both handlers are active, the current
	implementation requires the handler modes of ISR and EPA to coincide.
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_isr_epa_handler
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_isr_epa_handler (evt, var_list)
	class(evt_t), intent(out), pointer :: evt
	type(var_list_t), intent(in) :: var_list
	logical :: isr_recoil
	logical :: epa_recoil
	logical :: isr_handler_active
	logical :: epa_handler_active
	type(string_t) :: isr_handler_mode
	type(string_t) :: epa_handler_mode
	logical :: isr_keep_mass
	real(default) :: sqrts
	real(default) :: isr_q_max
	real(default) :: epa_q_max
	real(default) :: isr_mass
	real(default) :: epa_mass
	isr_handler_active = var_list%get_lval (var_str ("?isr_handler"))
	if (isr_handler_active) then
	call msg_message ("Simulate: activating ISR handler")
	isr_recoil = &
	var_list%get_lval (var_str ("?isr_recoil"))
	isr_handler_mode = &
	var_list%get_sval (var_str ("$isr_handler_mode"))
	isr_keep_mass = &
	var_list%get_lval (var_str ("?isr_handler_keep_mass"))
	if (isr_recoil) then
	call msg_fatal ("Simulate: ISR handler is incompatible &
	&with ?isr_recoil=true")
	end if
	end if
	epa_handler_active = var_list%get_lval (var_str ("?epa_handler"))
	if (epa_handler_active) then
	call msg_message ("Simulate: activating EPA handler")
	epa_recoil = var_list%get_lval (var_str ("?epa_recoil"))
	epa_handler_mode = var_list%get_sval (var_str ("$epa_handler_mode"))
	if (epa_recoil) then
	call msg_fatal ("Simulate: EPA handler is incompatible &
	&with ?epa_recoil=true")
	end if
	end if
	if (isr_handler_active .and. epa_handler_active) then
	if (isr_handler_mode /= epa_handler_mode) then
	call msg_fatal ("Simulate: ISR/EPA handler: modes must coincide")
	end if
	end if
	if (isr_handler_active .or. epa_handler_active) then
	allocate (evt_isr_epa_t :: evt)
	select type (evt)
	type is (evt_isr_epa_t)
	if (isr_handler_active) then
	call evt%set_mode_string (isr_handler_mode)
	else
	call evt%set_mode_string (epa_handler_mode)
	end if
	sqrts = var_list%get_rval (var_str ("sqrts"))
	if (isr_handler_active) then
	isr_q_max = var_list%get_rval (var_str ("isr_q_max"))
	isr_mass = var_list%get_rval (var_str ("isr_mass"))
	call evt%set_data_isr (sqrts, isr_q_max, isr_mass, isr_keep_mass)
	end if
	if (epa_handler_active) then
	epa_q_max = var_list%get_rval (var_str ("epa_q_max"))
	epa_mass = var_list%get_rval (var_str ("epa_mass"))
	call evt%set_data_epa (sqrts, epa_q_max, epa_mass)
	end if
	call msg_message ("Simulate: ISR/EPA handler mode: " &
	// char (evt%get_mode_string ()))
	end select
	else
	evt => null ()
	end if
	end subroutine dispatch_evt_isr_epa_handler

	@ %def dispatch_evt_isr_epa_handler
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_decay
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_decay (evt, var_list)
	class(evt_t), intent(out), pointer :: evt
	type(var_list_t), intent(in), target :: var_list
	logical :: allow_decays
	allow_decays = var_list%get_lval (var_str ("?allow_decays"))
	if (allow_decays) then
	allocate (evt_decay_t :: evt)
	call msg_message ("Simulate: activating decays")
	select type (evt)
	type is (evt_decay_t)
	call evt%set_var_list (var_list)
	end select
	else
	evt => null ()
	end if
	end subroutine dispatch_evt_decay

	@ %def dispatch_evt_decay
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_shower
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_shower (evt, var_list, model, fallback_model, &
	os_data, beam_structure, process)
	class(evt_t), intent(out), pointer :: evt
	type(var_list_t), intent(in) :: var_list
	type(model_t), pointer, intent(in) :: model, fallback_model
	type(os_data_t), intent(in) :: os_data
	type(beam_structure_t), intent(in) :: beam_structure
	type(process_t), intent(in), optional :: process
	type(string_t) :: lhapdf_file, lhapdf_dir, process_name
	integer :: lhapdf_member
	type(shower_settings_t) :: settings
	type(taudec_settings_t) :: taudec_settings
	call msg_message ("Simulate: activating parton shower")
	allocate (evt_shower_t :: evt)
	call settings%init (var_list)
	if (associated (model)) then
	call taudec_settings%init (var_list, model)
	else
	call taudec_settings%init (var_list, fallback_model)
	end if
	if (present (process)) then
	process_name = process%get_id ()
	else
	process_name = 'dispatch_testing'
	end if
	select type (evt)
	type is (evt_shower_t)
	call evt%init (fallback_model, os_data)
	lhapdf_member = &
	var_list%get_ival (var_str ("lhapdf_member"))
	if (LHAPDF6_AVAILABLE) then
	lhapdf_dir = &
	var_list%get_sval (var_str ("$lhapdf_dir"))
	lhapdf_file = &
	var_list%get_sval (var_str ("$lhapdf_file"))
	call lhapdf_initialize &
	(1, lhapdf_dir, lhapdf_file, lhapdf_member, evt%pdf_data%pdf)
	end if
	if (present (process)) call evt%pdf_data%setup ("Shower", &
	beam_structure, lhapdf_member, process%get_pdf_set ())
	select case (settings%method)
	case (PS_WHIZARD)
	allocate (shower_t :: evt%shower)
	case (PS_PYTHIA6)
	allocate (shower_pythia6_t :: evt%shower)
	case (PS_PYTHIA8)
	allocate (shower_pythia8_t :: evt%shower)
	case default
	call msg_fatal ('Shower: Method ' // &
	char (var_list%get_sval (var_str ("$shower_method"))) // &
	'not implemented!')
	end select
	call evt%shower%init (settings, taudec_settings, evt%pdf_data, os_data)
	call dispatch_matching (evt, settings, var_list, process_name, evt%pdf_data)
	class default
	call dispatch_matching (evt, settings, var_list, process_name)
	end select
	end subroutine dispatch_evt_shower

	@ %def dispatch_evt_shower
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_shower_hook
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_shower_hook (hook, var_list, process_instance, beam_structure, pdf_set)
	class(process_instance_hook_t), pointer, intent(out) :: hook
	type(var_list_t), intent(in) :: var_list
	class(process_instance_t), intent(in), target :: process_instance
	type(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: pdf_set
	type(pdf_data_t) :: pdf_data
	type(string_t) :: lhapdf_file, lhapdf_dir
	integer :: lhapdf_member
	if (var_list%get_lval (var_str ('?powheg_matching'))) then
	call msg_message ("Integration hook: add POWHEG hook")
	allocate (powheg_matching_hook_t :: hook)
	select type (hook)
	type is (powheg_matching_hook_t)
	lhapdf_member = var_list%get_ival (var_str ("lhapdf_member"))
	if (LHAPDF6_AVAILABLE) then
	lhapdf_dir = var_list%get_sval (var_str ("$lhapdf_dir"))
	lhapdf_file = var_list%get_sval (var_str ("$lhapdf_file"))
	call lhapdf_initialize (1, lhapdf_dir, lhapdf_file, lhapdf_member, pdf_data%pdf)
	end if
	call pdf_data%setup ("Shower", beam_structure, lhapdf_member, pdf_set)
	call hook%init (var_list, process_instance, pdf_data)
	end select
	else
	hook => null ()
	end if
	end subroutine dispatch_evt_shower_hook

	@ %def dispatch_evt_shower_hook
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_matching
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_matching (evt, settings, var_list, process_name, pdf_data)
	class(evt_t), intent(inout) :: evt
	type(shower_settings_t), intent(in) :: settings
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_name
	type(pdf_data_t), intent(in), optional :: pdf_data
	select type (evt)
	type is (evt_shower_t)
	if (settings%mlm_matching .and. settings%ckkw_matching) then
	call msg_fatal ("Both MLM and CKKW matching activated," // &
	LF // " aborting simulation")
	end if
	if (settings%powheg_matching) then
	call msg_message ("Simulate: applying POWHEG matching")
	allocate (powheg_matching_t :: evt%matching)
	end if
	if (settings%mlm_matching) then
	call msg_message ("Simulate: applying MLM matching")
	allocate (mlm_matching_t :: evt%matching)
	end if
	if (settings%ckkw_matching) then
	call msg_warning ("Simulate: CKKW(-L) matching not yet supported")
	allocate (ckkw_matching_t :: evt%matching)
	end if
	if (allocated (evt%matching)) then
	call evt%matching%init (var_list, process_name)
	if (present(pdf_data)) then
	select type (matching => evt%matching)
	type is (powheg_matching_t)
	matching%process_deps%pdf_data = pdf_data
	end select
	end if
	end if
	end select
	end subroutine dispatch_matching

	@ %def dispatch_matching
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_hadrons
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_hadrons (evt, var_list, fallback_model)
	class(evt_t), intent(out), pointer :: evt
	type(var_list_t), intent(in) :: var_list
	type(model_t), pointer, intent(in) :: fallback_model
	type(shower_settings_t) :: shower_settings
	type(hadron_settings_t) :: hadron_settings
	allocate (evt_hadrons_t :: evt)
	call msg_message ("Simulate: activating hadronization")
	call shower_settings%init (var_list)
	call hadron_settings%init (var_list)
	select type (evt)
	type is (evt_hadrons_t)
	call evt%init (fallback_model)
	select case (hadron_settings%method)
	case (HADRONS_WHIZARD)
	allocate (hadrons_hadrons_t :: evt%hadrons)
	case (HADRONS_PYTHIA6)
	allocate (hadrons_pythia6_t :: evt%hadrons)
	case (HADRONS_PYTHIA8)
	allocate (hadrons_pythia8_t :: evt%hadrons)
	case default
	call msg_fatal ('Hadronization: Method ' // &
	char (var_list%get_sval (var_str ("hadronization_method"))) // &
	'not implemented!')
	end select
	call evt%hadrons%init &
	(shower_settings, hadron_settings, fallback_model)
	end select
	end subroutine dispatch_evt_hadrons

	@ %def dispatch_evt_hadrons
	@ We cannot put this in the [[events]] subdir due to [[eio_raw_t]],
	which is defined here.
	<<Dispatch transforms: public>>=
	public :: dispatch_eio
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_eio (eio, method, var_list, fallback_model, &
	event_callback)
	class(eio_t), allocatable, intent(inout) :: eio
	type(string_t), intent(in) :: method
	type(var_list_t), intent(in) :: var_list
	type(model_t), target, intent(in) :: fallback_model
	class(event_callback_t), allocatable, intent(in) :: event_callback
	logical :: check, keep_beams, keep_remnants, recover_beams
	logical :: use_alphas_from_file, use_scale_from_file
	logical :: fixed_order_nlo_events
	logical :: write_sqme_prc, write_sqme_ref, write_sqme_alt
	logical :: output_cross_section, ensure_order
	type(string_t) :: lhef_version, lhef_extension, raw_version
	type(string_t) :: extension_default, debug_extension, dump_extension, &
	extension_hepmc, &
	extension_lha, extension_hepevt, extension_ascii_short, &
	extension_ascii_long, extension_athena, extension_mokka, &
	extension_stdhep, extension_stdhep_up, extension_stdhep_ev4, &
	extension_raw, extension_hepevt_verb, extension_lha_verb, &
	extension_lcio
	integer :: checkpoint
	integer :: lcio_run_id, hepmc3_mode
	logical :: show_process, show_transforms, show_decay, verbose, pacified
	logical :: dump_weights, dump_compressed, dump_summary, dump_screen
	logical :: proc_as_run_id, hepmc3_write_flows
	keep_beams = &
	var_list%get_lval (var_str ("?keep_beams"))
	keep_remnants = &
	var_list%get_lval (var_str ("?keep_remnants"))
	ensure_order = &
	var_list%get_lval (var_str ("?hepevt_ensure_order"))
	recover_beams = &
	var_list%get_lval (var_str ("?recover_beams"))
	use_alphas_from_file = &
	var_list%get_lval (var_str ("?use_alphas_from_file"))
	use_scale_from_file = &
	var_list%get_lval (var_str ("?use_scale_from_file"))
	fixed_order_nlo_events = &
	var_list%get_lval (var_str ("?fixed_order_nlo_events"))
	select case (char (method))
	case ("raw")
	allocate (eio_raw_t :: eio)
	select type (eio)
	type is (eio_raw_t)
	check = &
	var_list%get_lval (var_str ("?check_event_file"))
	raw_version = &
	var_list%get_sval (var_str ("$event_file_version"))
	extension_raw = &
	var_list%get_sval (var_str ("$extension_raw"))
	call eio%set_parameters (check, use_alphas_from_file, &
	use_scale_from_file, fixed_order_nlo_events, &
	raw_version, extension_raw)
	end select
	case ("checkpoint")
	allocate (eio_checkpoints_t :: eio)
	select type (eio)
	type is (eio_checkpoints_t)
	checkpoint = &
	var_list%get_ival (var_str ("checkpoint"))
	pacified = &
	var_list%get_lval (var_str ("?pacify"))
	call eio%set_parameters (checkpoint, blank = pacified)
	end select
	case ("callback")
	allocate (eio_callback_t :: eio)
	select type (eio)
	type is (eio_callback_t)
	checkpoint = &
	var_list%get_ival (var_str ("event_callback_interval"))
	if (allocated (event_callback)) then
	call eio%set_parameters (event_callback, checkpoint)
	else
	call eio%set_parameters (event_callback_nop_t (), 0)
	end if
	end select
	case ("lhef")
	allocate (eio_lhef_t :: eio)
	select type (eio)
	type is (eio_lhef_t)
	lhef_version = &
	var_list%get_sval (var_str ("$lhef_version"))
	lhef_extension = &
	var_list%get_sval (var_str ("$lhef_extension"))
	write_sqme_prc = &
	var_list%get_lval (var_str ("?lhef_write_sqme_prc"))
	write_sqme_ref = &
	var_list%get_lval (var_str ("?lhef_write_sqme_ref"))
	write_sqme_alt = &
	var_list%get_lval (var_str ("?lhef_write_sqme_alt"))
	call eio%set_parameters ( &
	keep_beams, keep_remnants, recover_beams, &
	use_alphas_from_file, use_scale_from_file, &
	char (lhef_version), lhef_extension, &
	write_sqme_ref, write_sqme_prc, write_sqme_alt)
	end select
	case ("hepmc")
	allocate (eio_hepmc_t :: eio)
	select type (eio)
	type is (eio_hepmc_t)
	output_cross_section = &
	var_list%get_lval (var_str ("?hepmc_output_cross_section"))
	extension_hepmc = &
	var_list%get_sval (var_str ("$extension_hepmc"))
	hepmc3_write_flows = &
	var_list%get_lval (var_str ("?hepmc3_write_flows"))
	select case (char (var_list%get_sval (var_str ("$hepmc3_mode"))))
	case ("HepMC2")
	hepmc3_mode = HEPMC3_MODE_HEPMC2
	case ("HepMC3")
	hepmc3_mode = HEPMC3_MODE_HEPMC3
	case ("Root")
	hepmc3_mode = HEPMC3_MODE_ROOT
	if (extension_hepmc /= "root") then
	call msg_message ("Events: HepMC3 Root mode, using " // &
	"event sample extension 'root'")
	extension_hepmc = "root"
	end if
	case ("RootTree")
	hepmc3_mode = HEPMC3_MODE_ROOTTREE
	if (extension_hepmc /= "root") then
	call msg_message ("Events: HepMC3 RootTree mode, using " // &
	"event sample extension 'root'")
	extension_hepmc = "root"
	end if
	case ("HepEVT")
	hepmc3_mode = HEPMC3_MODE_HEPEVT
	case default
	call msg_fatal ("Only supported HepMC3 modes are: 'HepMC2', " // &
	"'HepMC3', 'HepEVT', 'Root', and 'RootTree'.")
	end select
	call eio%set_parameters (recover_beams, &
	use_alphas_from_file, use_scale_from_file, &
	extension = extension_hepmc, &
	output_cross_section = output_cross_section, &
	hepmc3_mode = hepmc3_mode, &
	hepmc3_write_flows = hepmc3_write_flows)
	end select
	case ("lcio")
	allocate (eio_lcio_t :: eio)
	select type (eio)
	type is (eio_lcio_t)
	extension_lcio = &
	var_list%get_sval (var_str ("$extension_lcio"))
	proc_as_run_id = &
	var_list%get_lval (var_str ("?proc_as_run_id"))
	lcio_run_id = &
	var_list%get_ival (var_str ("lcio_run_id"))
	call eio%set_parameters (recover_beams, &
	use_alphas_from_file, use_scale_from_file, &
	extension_lcio, proc_as_run_id = proc_as_run_id, &
	lcio_run_id = lcio_run_id)
	end select
	case ("stdhep")
	allocate (eio_stdhep_hepevt_t :: eio)
	select type (eio)
	type is (eio_stdhep_hepevt_t)
	extension_stdhep = &
	var_list%get_sval (var_str ("$extension_stdhep"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, recover_beams, &
	use_alphas_from_file, use_scale_from_file, extension_stdhep)
	end select
	case ("stdhep_up")
	allocate (eio_stdhep_hepeup_t :: eio)
	select type (eio)
	type is (eio_stdhep_hepeup_t)
	extension_stdhep_up = &
	var_list%get_sval (var_str ("$extension_stdhep_up"))
	call eio%set_parameters (keep_beams, keep_remnants, ensure_order, &
	recover_beams, use_alphas_from_file, &
	use_scale_from_file, extension_stdhep_up)
	end select
	case ("stdhep_ev4")
	allocate (eio_stdhep_hepev4_t :: eio)
	select type (eio)
	type is (eio_stdhep_hepev4_t)
	extension_stdhep_ev4 = &
	var_list%get_sval (var_str ("$extension_stdhep_ev4"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, recover_beams, &
	use_alphas_from_file, use_scale_from_file, extension_stdhep_ev4)
	end select
	case ("ascii")
	allocate (eio_ascii_ascii_t :: eio)
	select type (eio)
	type is (eio_ascii_ascii_t)
	extension_default = &
	var_list%get_sval (var_str ("$extension_default"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_default)
	end select
	case ("athena")
	allocate (eio_ascii_athena_t :: eio)
	select type (eio)
	type is (eio_ascii_athena_t)
	extension_athena = &
	var_list%get_sval (var_str ("$extension_athena"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_athena)
	end select
	case ("debug")
	allocate (eio_ascii_debug_t :: eio)
	select type (eio)
	type is (eio_ascii_debug_t)
	debug_extension = &
	var_list%get_sval (var_str ("$debug_extension"))
	show_process = &
	var_list%get_lval (var_str ("?debug_process"))
	show_transforms = &
	var_list%get_lval (var_str ("?debug_transforms"))
	show_decay = &
	var_list%get_lval (var_str ("?debug_decay"))
	verbose = &
	var_list%get_lval (var_str ("?debug_verbose"))
	call eio%set_parameters ( &
	extension = debug_extension, &
	show_process = show_process, &
	show_transforms = show_transforms, &
	show_decay = show_decay, &
	verbose = verbose)
	end select
	case ("dump")
	allocate (eio_dump_t :: eio)
	select type (eio)
	type is (eio_dump_t)
	dump_extension = &
	var_list%get_sval (var_str ("$dump_extension"))
	pacified = &
	var_list%get_lval (var_str ("?pacify"))
	dump_weights = &
	var_list%get_lval (var_str ("?dump_weights"))
	dump_compressed = &
	var_list%get_lval (var_str ("?dump_compressed"))
	dump_summary = &
	var_list%get_lval (var_str ("?dump_summary"))
	dump_screen = &
	var_list%get_lval (var_str ("?dump_screen"))
	call eio%set_parameters ( &
	extension = dump_extension, &
	pacify = pacified, &
	weights = dump_weights, &
	compressed = dump_compressed, &
	summary = dump_summary, &
	screen = dump_screen)
	end select
	case ("hepevt")
	allocate (eio_ascii_hepevt_t :: eio)
	select type (eio)
	type is (eio_ascii_hepevt_t)
	extension_hepevt = &
	var_list%get_sval (var_str ("$extension_hepevt"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_hepevt)
	end select
	case ("hepevt_verb")
	allocate (eio_ascii_hepevt_verb_t :: eio)
	select type (eio)
	type is (eio_ascii_hepevt_verb_t)
	extension_hepevt_verb = &
	var_list%get_sval (var_str ("$extension_hepevt_verb"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_hepevt_verb)
	end select
	case ("lha")
	allocate (eio_ascii_lha_t :: eio)
	select type (eio)
	type is (eio_ascii_lha_t)
	extension_lha = &
	var_list%get_sval (var_str ("$extension_lha"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_lha)
	end select
	case ("lha_verb")
	allocate (eio_ascii_lha_verb_t :: eio)
	select type (eio)
	type is (eio_ascii_lha_verb_t)
	extension_lha_verb = var_list%get_sval ( &
	var_str ("$extension_lha_verb"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_lha_verb)
	end select
	case ("long")
	allocate (eio_ascii_long_t :: eio)
	select type (eio)
	type is (eio_ascii_long_t)
	extension_ascii_long = &
	var_list%get_sval (var_str ("$extension_ascii_long"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_ascii_long)
	end select
	case ("mokka")
	allocate (eio_ascii_mokka_t :: eio)
	select type (eio)
	type is (eio_ascii_mokka_t)
	extension_mokka = &
	var_list%get_sval (var_str ("$extension_mokka"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_mokka)
	end select
	case ("short")
	allocate (eio_ascii_short_t :: eio)
	select type (eio)
	type is (eio_ascii_short_t)
	extension_ascii_short = &
	var_list%get_sval (var_str ("$extension_ascii_short"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_ascii_short)
	end select
	case ("weight_stream")
	allocate (eio_weights_t :: eio)
	select type (eio)
	type is (eio_weights_t)
	pacified = &
	var_list%get_lval (var_str ("?pacify"))
	call eio%set_parameters (pacify = pacified)
	end select
	case default
	call msg_fatal ("Event I/O method '" // char (method) &
	// "' not implemented")
	end select
	call eio%set_fallback_model (fallback_model)
	end subroutine dispatch_eio

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

	module dispatch_transforms_ut
	use unit_tests
	use dispatch_transforms_uti

	<<Standard module head>>

	<<Dispatch transforms: public test>>

	contains

	<<Dispatch transforms: test driver>>

	end module dispatch_transforms_ut
	@ %def dispatch_transforms_ut
	@
	<<[[dispatch_transforms_uti.f90]]>>=
	<<File header>>

	module dispatch_transforms_uti

	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use variables
	use event_base, only: event_callback_t
	use models, only: model_t, model_list_t
	use models, only: syntax_model_file_init, syntax_model_file_final
	use resonances, only: resonance_history_set_t
	use beam_structures, only: beam_structure_t
	use eio_base, only: eio_t
	use os_interface, only: os_data_t
	use event_transforms, only: evt_t
	use dispatch_transforms

	<<Standard module head>>

	<<Dispatch transforms: test declarations>>

	contains

	<<Dispatch transforms: tests>>

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

	@ %def dispatch_transforms_test
	@
	\subsubsection{Event I/O}
	<<Dispatch transforms: execute tests>>=
	call test (dispatch_transforms_1, "dispatch_transforms_1", &
	"event I/O", &
	u, results)
	<<Dispatch transforms: test declarations>>=
	public :: dispatch_transforms_1
	<<Dispatch transforms: tests>>=
	subroutine dispatch_transforms_1 (u)
	integer, intent(in) :: u
	type(var_list_t) :: var_list
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(os_data_t) :: os_data
	class(event_callback_t), allocatable :: event_callback
	class(eio_t), allocatable :: eio

	write (u, "(A)") "* Test output: dispatch_transforms_1"
	write (u, "(A)") "* Purpose: allocate an event I/O (eio) stream"
	write (u, "(A)")

	call var_list%init_defaults (0)
	call os_data%init ()
	call syntax_model_file_init ()
	call model_list%read_model (var_str ("SM_hadrons"), &
	var_str ("SM_hadrons.mdl"), os_data, model)

	write (u, "(A)") "* Allocate as raw"
	write (u, "(A)")

	call dispatch_eio (eio, var_str ("raw"), var_list, &
	model, event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as checkpoints:"
	write (u, "(A)")

	call dispatch_eio (eio, var_str ("checkpoint"), var_list, &
	model, event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as LHEF:"
	write (u, "(A)")

	call var_list%set_string (var_str ("$lhef_extension"), &
	var_str ("lhe_custom"), is_known = .true.)
	call dispatch_eio (eio, var_str ("lhef"), var_list, &
	model, event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as HepMC:"
	write (u, "(A)")

	call dispatch_eio (eio, var_str ("hepmc"), var_list, &
	model, event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as weight_stream"
	write (u, "(A)")

	call dispatch_eio (eio, var_str ("weight_stream"), var_list, &
	model, event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as debug format"
	write (u, "(A)")

	call var_list%set_log (var_str ("?debug_verbose"), &
	.false., is_known = .true.)
	call dispatch_eio (eio, var_str ("debug"), var_list, &
	model, event_callback)

	call eio%write (u)

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

	call eio%final ()
	call var_list%final ()
	call syntax_model_file_final ()

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

	end subroutine dispatch_transforms_1

	@ %def dispatch_transforms_1
	@
	\subsubsection{Event transforms}
	This test dispatches [[evt]] (event transform) objects.
	<<Dispatch transforms: execute tests>>=
	call test (dispatch_transforms_2, "dispatch_transforms_2", &
	"event transforms", &
	u, results)
	<<Dispatch transforms: test declarations>>=
	public :: dispatch_transforms_2
	<<Dispatch transforms: tests>>=
	subroutine dispatch_transforms_2 (u)
	integer, intent(in) :: u
	type(var_list_t), target :: var_list
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(os_data_t) :: os_data
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(beam_structure_t) :: beam_structure
	class(evt_t), pointer :: evt

	write (u, "(A)") "* Test output: dispatch_transforms_2"
	write (u, "(A)") "* Purpose: configure event transform"
	write (u, "(A)")

	call syntax_model_file_init ()
	call var_list%init_defaults (0)
	call os_data%init ()
	call model_list%read_model (var_str ("SM_hadrons"), &
	var_str ("SM_hadrons.mdl"), os_data, model)

	write (u, "(A)") "* Resonance insertion"
	write (u, "(A)")

	call var_list%set_log (var_str ("?resonance_history"), .true., &
	is_known = .true.)
	call dispatch_evt_resonance (evt, var_list, &
	res_history_set, &
	var_str ("foo_R"))
	call evt%write (u, verbose = .true., more_verbose = .true.)

	call evt%final ()
	deallocate (evt)

	write (u, "(A)")
	write (u, "(A)") "* ISR handler"
	write (u, "(A)")

	call var_list%set_log (var_str ("?isr_handler"), .true., &
	is_known = .true.)
	call var_list%set_log (var_str ("?epa_handler"), .false., &
	is_known = .true.)
	call var_list%set_string (var_str ("$isr_handler_mode"), &
	var_str ("recoil"), &
	is_known = .true.)
	call var_list%set_real (var_str ("sqrts"), 100._default, &
	is_known = .true.)
	call var_list%set_real (var_str ("isr_mass"), 511.e-6_default, &
	is_known = .true.)
	call dispatch_evt_isr_epa_handler (evt, var_list)
	call evt%write (u, verbose = .true., more_verbose = .true.)

	call evt%final ()
	deallocate (evt)

	write (u, "(A)")
	write (u, "(A)") "* EPA handler"
	write (u, "(A)")

	call var_list%set_log (var_str ("?isr_handler"), .false., &
	is_known = .true.)
	call var_list%set_log (var_str ("?epa_handler"), .true., &
	is_known = .true.)
	call var_list%set_string (var_str ("$epa_handler_mode"), &
	var_str ("recoil"), &
	is_known = .true.)
	call var_list%set_real (var_str ("sqrts"), 100._default, &
	is_known = .true.)
	call var_list%set_real (var_str ("epa_mass"), 511.e-6_default, &
	is_known = .true.)
	call dispatch_evt_isr_epa_handler (evt, var_list)
	call evt%write (u, verbose = .true., more_verbose = .true.)

	call evt%final ()
	deallocate (evt)

	write (u, "(A)")
	write (u, "(A)") "* Partonic decays"
	write (u, "(A)")

	call dispatch_evt_decay (evt, var_list)
	call evt%write (u, verbose = .true., more_verbose = .true.)

	call evt%final ()
	deallocate (evt)

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

	call var_list%set_log (var_str ("?allow_shower"), .true., &
	is_known = .true.)
	call var_list%set_string (var_str ("$shower_method"), &
	var_str ("WHIZARD"), is_known = .true.)
	call dispatch_evt_shower (evt, var_list, model, &
	model, os_data, beam_structure)
	call evt%write (u)
	call write_separator (u, 2)

	call evt%final ()
	deallocate (evt)

	call var_list%final ()
	call syntax_model_file_final ()

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

	end subroutine dispatch_transforms_2

	@ %def dispatch_transforms_2
	Index: trunk/src/beams/beams.nw
	===================================================================
	--- trunk/src/beams/beams.nw (revision 8835)
	+++ trunk/src/beams/beams.nw (revision 8836)
	@@ -1,28248 +1,28264 @@
	%% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: beams and beam structure
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Beams}
	\includemodulegraph{beams}

	These modules implement beam configuration and beam structure, the
	latter in abstract terms.
	\begin{description}
	\item[beam\_structures]
	The [[beam_structure_t]] type is a messenger type that communicates
	the user settings to the \whizard\ core.
	\item[beams]
	Beam configuration.
	\item[sf\_aux]
	Tools for handling structure functions and splitting
	\item[sf\_mappings]
	Mapping functions, useful for structure function implementation
	\item[sf\_base]
	The abstract structure-function interaction and structure-function
	chain types.
	\end{description}

	These are the implementation modules, the concrete counterparts of
	[[sf_base]]:
	\begin{description}
	\item[sf\_isr]
	ISR structure function (photon radiation inclusive and resummed in
	collinear and IR regions).
	\item[sf\_epa]
	Effective Photon Approximation.
	\item[sf\_ewa]
	Effective $W$ (and $Z$) approximation.
	\item[sf\_escan]
	Energy spectrum that emulates a uniform energy scan.
	\item[sf\_gaussian]
	Gaussian beam spread
	\item[sf\_beam\_events]
	Beam-event generator that reads its input from an external file.
	\item[sf\_circe1]
	CIRCE1 beam spectra for electrons and photons.
	\item[sf\_circe2]
	CIRCE2 beam spectra for electrons and photons.
	\item[hoppet\_interface]
	Support for $b$-quark matching, addon to PDF modules.
	\item[sf\_pdf\_builtin]
	Direct support for selected hadron PDFs.
	\item[sf\_lhapdf]
	LHAPDF library support.
	\end{description}

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Beam structure}

	This module stores the beam structure definition as it is declared in
	the SINDARIN script. The structure definition is not analyzed, just
	recorded for later use.

	We do not capture any numerical parameters, just names of particles and
	structure functions.
	<<[[beam_structures.f90]]>>=
	<<File header>>

	module beam_structures

	<<Use kinds>>
	<<Use strings>>
	use lorentz
	use polarizations

	<<Standard module head>>

	<<Beam structures: public>>

	<<Beam structures: types>>

	<<Beam structures: interfaces>>

	interface
	<<Beam structures: sub interfaces>>
	end interface

	end module beam_structures
	@ %def beam_structures
	@
	<<[[beam_structures_sub.f90]]>>=
	<<File header>>

	submodule (beam_structures) beam_structures_s

	use io_units
	use format_defs, only: FMT_19
	use diagnostics

	implicit none

	contains

	<<Beam structures: procedures>>

	end submodule beam_structures_s

	@ %def beam_structures_s
	@
	\subsection{Beam structure elements}
	An entry in a beam-structure record consists of a string
	that denotes a type of structure function.
	<<Beam structures: types>>=
	type :: beam_structure_entry_t
	logical :: is_valid = .false.
	type(string_t) :: name
	contains
	<<Beam structures: beam structure entry: TBP>>
	end type beam_structure_entry_t

	@ %def beam_structure_entry_t
	@ Output.
	<<Beam structures: beam structure entry: TBP>>=
	procedure :: to_string => beam_structure_entry_to_string
	<<Beam structures: sub interfaces>>=
	module function beam_structure_entry_to_string (object) result (string)
	class(beam_structure_entry_t), intent(in) :: object
	type(string_t) :: string
	end function beam_structure_entry_to_string
	<<Beam structures: procedures>>=
	module function beam_structure_entry_to_string (object) result (string)
	class(beam_structure_entry_t), intent(in) :: object
	type(string_t) :: string
	if (object%is_valid) then
	string = object%name
	else
	string = "none"
	end if
	end function beam_structure_entry_to_string

	@ %def beam_structure_entry_to_string
	@
	A record in the beam-structure sequence denotes either a
	structure-function entry, a pair of such entries, or a pair spectrum.
	<<Beam structures: types>>=
	type :: beam_structure_record_t
	type(beam_structure_entry_t), dimension(:), allocatable :: entry
	end type beam_structure_record_t

	@ %def beam_structure_record_t
	@
	\subsection{Beam structure type}
	The beam-structure object contains the beam particle(s) as simple strings.
	The sequence of records indicates the structure functions by name. No
	numerical parameters are stored.
	<<Beam structures: public>>=
	public :: beam_structure_t
	<<Beam structures: types>>=
	type :: beam_structure_t
	private
	integer :: n_beam = 0
	type(string_t), dimension(:), allocatable :: prt
	type(beam_structure_record_t), dimension(:), allocatable :: record
	type(smatrix_t), dimension(:), allocatable :: smatrix
	real(default), dimension(:), allocatable :: pol_f
	real(default), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: theta
	real(default), dimension(:), allocatable :: phi
	contains
	<<Beam structures: beam structure: TBP>>
	end type beam_structure_t

	@ %def beam_structure_t
	@ The finalizer deletes all contents explicitly, so we can continue
	with an empty beam record. (It is not needed for deallocation.) We
	have distinct finalizers for the independent parts of the beam structure.
	<<Beam structures: beam structure: TBP>>=
	procedure :: final_sf => beam_structure_final_sf
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_final_sf (object)
	class(beam_structure_t), intent(inout) :: object
	end subroutine beam_structure_final_sf
	<<Beam structures: procedures>>=
	module subroutine beam_structure_final_sf (object)
	class(beam_structure_t), intent(inout) :: object
	if (allocated (object%prt)) deallocate (object%prt)
	if (allocated (object%record)) deallocate (object%record)
	object%n_beam = 0
	end subroutine beam_structure_final_sf

	@ %def beam_structure_final_sf
	@ Output. The actual information fits in a single line, therefore we can
	provide a [[to_string]] method. The [[show]] method also lists the
	current values of relevant global variables.
	<<Beam structures: beam structure: TBP>>=
	procedure :: write => beam_structure_write
	procedure :: to_string => beam_structure_to_string
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_write (object, unit)
	class(beam_structure_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine beam_structure_write
	module function beam_structure_to_string (object, sf_only) result (string)
	class(beam_structure_t), intent(in) :: object
	logical, intent(in), optional :: sf_only
	type(string_t) :: string
	end function beam_structure_to_string
	<<Beam structures: procedures>>=
	module subroutine beam_structure_write (object, unit)
	class(beam_structure_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1x,A,A)") "Beam structure: ", char (object%to_string ())
	if (allocated (object%smatrix)) then
	do i = 1, size (object%smatrix)
	write (u, "(3x,A,I0,A)") "polarization (beam ", i, "):"
	call object%smatrix(i)%write (u, indent=2)
	end do
	end if
	if (allocated (object%pol_f)) then
	write (u, "(3x,A,F10.7,:,',',F10.7)") "polarization degree =", &
	object%pol_f
	end if
	if (allocated (object%p)) then
	write (u, "(3x,A," // FMT_19 // ",:,','," // FMT_19 // &
	")") "momentum =", object%p
	end if
	if (allocated (object%theta)) then
	write (u, "(3x,A," // FMT_19 // ",:,','," // FMT_19 // &
	")") "angle th =", object%theta
	end if
	if (allocated (object%phi)) then
	write (u, "(3x,A," // FMT_19 // ",:,','," // FMT_19 // &
	")") "angle ph =", object%phi
	end if
	end subroutine beam_structure_write

	module function beam_structure_to_string (object, sf_only) result (string)
	class(beam_structure_t), intent(in) :: object
	logical, intent(in), optional :: sf_only
	type(string_t) :: string
	integer :: i, j
	logical :: with_beams
	with_beams = .true.; if (present (sf_only)) with_beams = .not. sf_only
	select case (object%n_beam)
	case (1)
	if (with_beams) then
	string = object%prt(1)
	else
	string = ""
	end if
	case (2)
	if (with_beams) then
	string = object%prt(1) // ", " // object%prt(2)
	else
	string = ""
	end if
	if (allocated (object%record)) then
	if (size (object%record) > 0) then
	if (with_beams) string = string // " => "
	do i = 1, size (object%record)
	if (i > 1) string = string // " => "
	do j = 1, size (object%record(i)%entry)
	if (j > 1) string = string // ", "
	string = string // object%record(i)%entry(j)%to_string ()
	end do
	end do
	end if
	end if
	case default
	string = "[any particles]"
	end select
	end function beam_structure_to_string

	@ %def beam_structure_write beam_structure_to_string
	@ Initializer: dimension the beam structure record. Each array
	element denotes the number of entries for a record within the
	beam-structure sequence. The number of entries is either one or two,
	while the number of records is unlimited.
	<<Beam structures: beam structure: TBP>>=
	procedure :: init_sf => beam_structure_init_sf
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_init_sf (beam_structure, prt, dim_array)
	class(beam_structure_t), intent(inout) :: beam_structure
	type(string_t), dimension(:), intent(in) :: prt
	integer, dimension(:), intent(in), optional :: dim_array
	end subroutine beam_structure_init_sf
	<<Beam structures: procedures>>=
	module subroutine beam_structure_init_sf (beam_structure, prt, dim_array)
	class(beam_structure_t), intent(inout) :: beam_structure
	type(string_t), dimension(:), intent(in) :: prt
	integer, dimension(:), intent(in), optional :: dim_array
	integer :: i
	call beam_structure%final_sf ()
	beam_structure%n_beam = size (prt)
	allocate (beam_structure%prt (size (prt)))
	beam_structure%prt = prt
	if (present (dim_array)) then
	allocate (beam_structure%record (size (dim_array)))
	do i = 1, size (dim_array)
	allocate (beam_structure%record(i)%entry (dim_array(i)))
	end do
	else
	allocate (beam_structure%record (0))
	end if
	end subroutine beam_structure_init_sf

	@ %def beam_structure_init_sf
	@ Set an entry, specified by record number and entry number.
	<<Beam structures: beam structure: TBP>>=
	procedure :: set_sf => beam_structure_set_sf
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_set_sf (beam_structure, i, j, name)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: i, j
	type(string_t), intent(in) :: name
	end subroutine beam_structure_set_sf
	<<Beam structures: procedures>>=
	module subroutine beam_structure_set_sf (beam_structure, i, j, name)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: i, j
	type(string_t), intent(in) :: name
	associate (entry => beam_structure%record(i)%entry(j))
	entry%name = name
	entry%is_valid = .true.
	end associate
	end subroutine beam_structure_set_sf

	@ %def beam_structure_set_sf
	@ Expand the beam-structure object. (i) For a pair spectrum, keep the
	entry. (ii) For a single-particle structure function written as a
	single entry, replace this by a record with two entries.
	(ii) For a record with two nontrivial entries, separate this into two
	records with one trivial entry each.

	To achieve this, we need a function that tells us whether an entry is
	a spectrum or a structure function. It returns 0 for a trivial entry,
	1 for a single-particle structure function, and 2 for a two-particle
	spectrum.
	<<Beam structures: interfaces>>=
	abstract interface
	function strfun_mode_fun (name) result (n)
	import
	type(string_t), intent(in) :: name
	integer :: n
	end function strfun_mode_fun
	end interface

	@ %def is_spectrum_t
	@ Algorithm: (1) Mark entries as invalid where necessary. (2) Count
	the number of entries that we will need. (3) Expand and copy
	entries to a new record array. (4) Replace the old array by the new one.
	<<Beam structures: beam structure: TBP>>=
	procedure :: expand => beam_structure_expand
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_expand (beam_structure, strfun_mode)
	class(beam_structure_t), intent(inout) :: beam_structure
	procedure(strfun_mode_fun) :: strfun_mode
	end subroutine beam_structure_expand
	<<Beam structures: procedures>>=
	module subroutine beam_structure_expand (beam_structure, strfun_mode)
	class(beam_structure_t), intent(inout) :: beam_structure
	procedure(strfun_mode_fun) :: strfun_mode
	type(beam_structure_record_t), dimension(:), allocatable :: new
	integer :: n_record, i, j
	if (.not. allocated (beam_structure%record)) return
	do i = 1, size (beam_structure%record)
	associate (entry => beam_structure%record(i)%entry)
	do j = 1, size (entry)
	select case (strfun_mode (entry(j)%name))
	case (0); entry(j)%is_valid = .false.
	end select
	end do
	end associate
	end do
	n_record = 0
	do i = 1, size (beam_structure%record)
	associate (entry => beam_structure%record(i)%entry)
	select case (size (entry))
	case (1)
	if (entry(1)%is_valid) then
	select case (strfun_mode (entry(1)%name))
	case (1); n_record = n_record + 2
	case (2); n_record = n_record + 1
	end select
	end if
	case (2)
	do j = 1, 2
	if (entry(j)%is_valid) then
	select case (strfun_mode (entry(j)%name))
	case (1); n_record = n_record + 1
	case (2)
	call beam_structure%write ()
	call msg_fatal ("Pair spectrum used as &
	&single-particle structure function")
	end select
	end if
	end do
	end select
	end associate
	end do
	allocate (new (n_record))
	n_record = 0
	do i = 1, size (beam_structure%record)
	associate (entry => beam_structure%record(i)%entry)
	select case (size (entry))
	case (1)
	if (entry(1)%is_valid) then
	select case (strfun_mode (entry(1)%name))
	case (1)
	n_record = n_record + 1
	allocate (new(n_record)%entry (2))
	new(n_record)%entry(1) = entry(1)
	n_record = n_record + 1
	allocate (new(n_record)%entry (2))
	new(n_record)%entry(2) = entry(1)
	case (2)
	n_record = n_record + 1
	allocate (new(n_record)%entry (1))
	new(n_record)%entry(1) = entry(1)
	end select
	end if
	case (2)
	do j = 1, 2
	if (entry(j)%is_valid) then
	n_record = n_record + 1
	allocate (new(n_record)%entry (2))
	new(n_record)%entry(j) = entry(j)
	end if
	end do
	end select
	end associate
	end do
	call move_alloc (from = new, to = beam_structure%record)
	end subroutine beam_structure_expand

	@ %def beam_structure_expand
	@
	\subsection{Polarization}
	To record polarization, we provide an allocatable array of [[smatrix]]
	objects, sparse matrices. The polarization structure is independent of the
	structure-function setup, they are combined only when an actual beam object is
	constructed.
	<<Beam structures: beam structure: TBP>>=
	procedure :: final_pol => beam_structure_final_pol
	procedure :: init_pol => beam_structure_init_pol
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_final_pol (beam_structure)
	class(beam_structure_t), intent(inout) :: beam_structure
	end subroutine beam_structure_final_pol
	module subroutine beam_structure_init_pol (beam_structure, n)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: n
	end subroutine beam_structure_init_pol
	<<Beam structures: procedures>>=
	module subroutine beam_structure_final_pol (beam_structure)
	class(beam_structure_t), intent(inout) :: beam_structure
	if (allocated (beam_structure%smatrix)) deallocate (beam_structure%smatrix)
	if (allocated (beam_structure%pol_f)) deallocate (beam_structure%pol_f)
	end subroutine beam_structure_final_pol

	module subroutine beam_structure_init_pol (beam_structure, n)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: n
	if (allocated (beam_structure%smatrix)) deallocate (beam_structure%smatrix)
	allocate (beam_structure%smatrix (n))
	if (.not. allocated (beam_structure%pol_f)) &
	allocate (beam_structure%pol_f (n), source = 1._default)
	end subroutine beam_structure_init_pol

	@ %def beam_structure_final_pol
	@ %def beam_structure_init_pol
	@ Check if polarized beams are used.
	<<Beam structures: beam structure: TBP>>=
	procedure :: has_polarized_beams => beam_structure_has_polarized_beams
	<<Beam structures: sub interfaces>>=
	elemental module function beam_structure_has_polarized_beams &
	(beam_structure) result (pol)
	logical :: pol
	class(beam_structure_t), intent(in) :: beam_structure
	end function beam_structure_has_polarized_beams
	<<Beam structures: procedures>>=
	elemental module function beam_structure_has_polarized_beams &
	(beam_structure) result (pol)
	logical :: pol
	class(beam_structure_t), intent(in) :: beam_structure
	if (allocated (beam_structure%pol_f)) then
	pol = any (beam_structure%pol_f /= 0)
	else
	pol = .false.
	end if
	end function beam_structure_has_polarized_beams

	@ %def beam_structure_has_polarized_beams
	@ Directly copy the spin density matrices.
	<<Beam structures: beam structure: TBP>>=
	procedure :: set_smatrix => beam_structure_set_smatrix
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_set_smatrix (beam_structure, i, smatrix)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: i
	type(smatrix_t), intent(in) :: smatrix
	end subroutine beam_structure_set_smatrix
	<<Beam structures: procedures>>=
	module subroutine beam_structure_set_smatrix (beam_structure, i, smatrix)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: i
	type(smatrix_t), intent(in) :: smatrix
	beam_structure%smatrix(i) = smatrix
	end subroutine beam_structure_set_smatrix

	@ %def beam_structure_set_smatrix
	@ Initialize one of the spin density matrices manually.
	<<Beam structures: beam structure: TBP>>=
	procedure :: init_smatrix => beam_structure_init_smatrix
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_init_smatrix (beam_structure, i, n_entry)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: i
	integer, intent(in) :: n_entry
	end subroutine beam_structure_init_smatrix
	<<Beam structures: procedures>>=
	module subroutine beam_structure_init_smatrix (beam_structure, i, n_entry)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: i
	integer, intent(in) :: n_entry
	call beam_structure%smatrix(i)%init (2, n_entry)
	end subroutine beam_structure_init_smatrix

	@ %def beam_structure_init_smatrix
	@ Set a polarization entry.
	<<Beam structures: beam structure: TBP>>=
	procedure :: set_sentry => beam_structure_set_sentry
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_set_sentry &
	(beam_structure, i, i_entry, index, value)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: i
	integer, intent(in) :: i_entry
	integer, dimension(:), intent(in) :: index
	complex(default), intent(in) :: value
	end subroutine beam_structure_set_sentry
	<<Beam structures: procedures>>=
	module subroutine beam_structure_set_sentry &
	(beam_structure, i, i_entry, index, value)
	class(beam_structure_t), intent(inout) :: beam_structure
	integer, intent(in) :: i
	integer, intent(in) :: i_entry
	integer, dimension(:), intent(in) :: index
	complex(default), intent(in) :: value
	call beam_structure%smatrix(i)%set_entry (i_entry, index, value)
	end subroutine beam_structure_set_sentry

	@ %def beam_structure_set_sentry
	@ Set the array of polarization fractions.
	<<Beam structures: beam structure: TBP>>=
	procedure :: set_pol_f => beam_structure_set_pol_f
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_set_pol_f (beam_structure, f)
	class(beam_structure_t), intent(inout) :: beam_structure
	real(default), dimension(:), intent(in) :: f
	end subroutine beam_structure_set_pol_f
	<<Beam structures: procedures>>=
	module subroutine beam_structure_set_pol_f (beam_structure, f)
	class(beam_structure_t), intent(inout) :: beam_structure
	real(default), dimension(:), intent(in) :: f
	if (allocated (beam_structure%pol_f)) deallocate (beam_structure%pol_f)
	allocate (beam_structure%pol_f (size (f)), source = f)
	end subroutine beam_structure_set_pol_f

	@ %def beam_structure_set_pol_f
	@
	\subsection{Beam momenta}
	By default, beam momenta are deduced from the [[sqrts]] value or from
	the mass of the decaying particle, assuming a c.m.\ setup. Here we
	set them explicitly.
	<<Beam structures: beam structure: TBP>>=
	procedure :: final_mom => beam_structure_final_mom
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_final_mom (beam_structure)
	class(beam_structure_t), intent(inout) :: beam_structure
	end subroutine beam_structure_final_mom
	<<Beam structures: procedures>>=
	module subroutine beam_structure_final_mom (beam_structure)
	class(beam_structure_t), intent(inout) :: beam_structure
	if (allocated (beam_structure%p)) deallocate (beam_structure%p)
	if (allocated (beam_structure%theta)) deallocate (beam_structure%theta)
	if (allocated (beam_structure%phi)) deallocate (beam_structure%phi)
	end subroutine beam_structure_final_mom

	@ %def beam_structure_final_mom
	<<Beam structures: beam structure: TBP>>=
	procedure :: set_momentum => beam_structure_set_momentum
	procedure :: set_theta => beam_structure_set_theta
	procedure :: set_phi => beam_structure_set_phi
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_set_momentum (beam_structure, p)
	class(beam_structure_t), intent(inout) :: beam_structure
	real(default), dimension(:), intent(in) :: p
	end subroutine beam_structure_set_momentum
	module subroutine beam_structure_set_theta (beam_structure, theta)
	class(beam_structure_t), intent(inout) :: beam_structure
	real(default), dimension(:), intent(in) :: theta
	end subroutine beam_structure_set_theta
	module subroutine beam_structure_set_phi (beam_structure, phi)
	class(beam_structure_t), intent(inout) :: beam_structure
	real(default), dimension(:), intent(in) :: phi
	end subroutine beam_structure_set_phi
	<<Beam structures: procedures>>=
	module subroutine beam_structure_set_momentum (beam_structure, p)
	class(beam_structure_t), intent(inout) :: beam_structure
	real(default), dimension(:), intent(in) :: p
	if (allocated (beam_structure%p)) deallocate (beam_structure%p)
	allocate (beam_structure%p (size (p)), source = p)
	end subroutine beam_structure_set_momentum

	module subroutine beam_structure_set_theta (beam_structure, theta)
	class(beam_structure_t), intent(inout) :: beam_structure
	real(default), dimension(:), intent(in) :: theta
	if (allocated (beam_structure%theta)) deallocate (beam_structure%theta)
	allocate (beam_structure%theta (size (theta)), source = theta)
	end subroutine beam_structure_set_theta

	module subroutine beam_structure_set_phi (beam_structure, phi)
	class(beam_structure_t), intent(inout) :: beam_structure
	real(default), dimension(:), intent(in) :: phi
	if (allocated (beam_structure%phi)) deallocate (beam_structure%phi)
	allocate (beam_structure%phi (size (phi)), source = phi)
	end subroutine beam_structure_set_phi

	@ %def beam_structure_set_momentum
	@ %def beam_structure_set_theta
	@ %def beam_structure_set_phi
	@
	\subsection{Get contents}
	Look at the incoming particles. We may also have the case that beam
	particles are not specified, but polarization.
	<<Beam structures: beam structure: TBP>>=
	procedure :: is_set => beam_structure_is_set
	procedure :: get_n_beam => beam_structure_get_n_beam
	procedure :: get_prt => beam_structure_get_prt
	<<Beam structures: sub interfaces>>=
	module function beam_structure_is_set (beam_structure) result (flag)
	class(beam_structure_t), intent(in) :: beam_structure
	logical :: flag
	end function beam_structure_is_set
	module function beam_structure_get_n_beam (beam_structure) result (n)
	class(beam_structure_t), intent(in) :: beam_structure
	integer :: n
	end function beam_structure_get_n_beam
	module function beam_structure_get_prt (beam_structure) result (prt)
	class(beam_structure_t), intent(in) :: beam_structure
	type(string_t), dimension(:), allocatable :: prt
	end function beam_structure_get_prt
	<<Beam structures: procedures>>=
	module function beam_structure_is_set (beam_structure) result (flag)
	class(beam_structure_t), intent(in) :: beam_structure
	logical :: flag
	flag = beam_structure%n_beam > 0 .or. beam_structure%asymmetric ()
	end function beam_structure_is_set

	module function beam_structure_get_n_beam (beam_structure) result (n)
	class(beam_structure_t), intent(in) :: beam_structure
	integer :: n
	n = beam_structure%n_beam
	end function beam_structure_get_n_beam

	module function beam_structure_get_prt (beam_structure) result (prt)
	class(beam_structure_t), intent(in) :: beam_structure
	type(string_t), dimension(:), allocatable :: prt
	allocate (prt (size (beam_structure%prt)))
	prt = beam_structure%prt
	end function beam_structure_get_prt

	@ %def beam_structure_is_set
	@ %def beam_structure_get_n_beam
	@ %def beam_structure_get_prt
	@
	Return the number of records.
	<<Beam structures: beam structure: TBP>>=
	procedure :: get_n_record => beam_structure_get_n_record
	<<Beam structures: sub interfaces>>=
	module function beam_structure_get_n_record (beam_structure) result (n)
	class(beam_structure_t), intent(in) :: beam_structure
	integer :: n
	end function beam_structure_get_n_record
	<<Beam structures: procedures>>=
	module function beam_structure_get_n_record (beam_structure) result (n)
	class(beam_structure_t), intent(in) :: beam_structure
	integer :: n
	if (allocated (beam_structure%record)) then
	n = size (beam_structure%record)
	else
	n = 0
	end if
	end function beam_structure_get_n_record

	@ %def beam_structure_get_n_record
	@ Return an array consisting of the beam indices affected by the valid
	entries within a record. After expansion, there should be exactly one
	valid entry per record.
	<<Beam structures: beam structure: TBP>>=
	procedure :: get_i_entry => beam_structure_get_i_entry
	<<Beam structures: sub interfaces>>=
	module function beam_structure_get_i_entry &
	(beam_structure, i) result (i_entry)
	class(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: i
	integer, dimension(:), allocatable :: i_entry
	end function beam_structure_get_i_entry
	<<Beam structures: procedures>>=
	module function beam_structure_get_i_entry &
	(beam_structure, i) result (i_entry)
	class(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: i
	integer, dimension(:), allocatable :: i_entry
	associate (record => beam_structure%record(i))
	select case (size (record%entry))
	case (1)
	if (record%entry(1)%is_valid) then
	allocate (i_entry (2), source = [1, 2])
	else
	allocate (i_entry (0))
	end if
	case (2)
	if (all (record%entry%is_valid)) then
	allocate (i_entry (2), source = [1, 2])
	else if (record%entry(1)%is_valid) then
	allocate (i_entry (1), source = [1])
	else if (record%entry(2)%is_valid) then
	allocate (i_entry (1), source = [2])
	else
	allocate (i_entry (0))
	end if
	end select
	end associate
	end function beam_structure_get_i_entry

	@ %def beam_structure_get_i_entry
	@ Return the name of the first valid entry within a record. After
	expansion, there should be exactly one valid entry per record.
	<<Beam structures: beam structure: TBP>>=
	procedure :: get_name => beam_structure_get_name
	<<Beam structures: sub interfaces>>=
	module function beam_structure_get_name (beam_structure, i) result (name)
	type(string_t) :: name
	class(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: i
	end function beam_structure_get_name
	<<Beam structures: procedures>>=
	module function beam_structure_get_name (beam_structure, i) result (name)
	type(string_t) :: name
	class(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: i
	associate (record => beam_structure%record(i))
	if (record%entry(1)%is_valid) then
	name = record%entry(1)%name
	else if (size (record%entry) == 2) then
	name = record%entry(2)%name
	end if
	end associate
	end function beam_structure_get_name

	@ %def beam_structure_get_name
	@
	<<Beam structures: beam structure: TBP>>=
	procedure :: has_pdf => beam_structure_has_pdf
	<<Beam structures: sub interfaces>>=
	module function beam_structure_has_pdf (beam_structure) result (has_pdf)
	logical :: has_pdf
	class(beam_structure_t), intent(in) :: beam_structure
	end function beam_structure_has_pdf
	<<Beam structures: procedures>>=
	module function beam_structure_has_pdf (beam_structure) result (has_pdf)
	logical :: has_pdf
	class(beam_structure_t), intent(in) :: beam_structure
	integer :: i
	type(string_t) :: name
	has_pdf = .false.
	do i = 1, beam_structure%get_n_record ()
	name = beam_structure%get_name (i)
	has_pdf = has_pdf .or. name == var_str ("pdf_builtin") .or. name == var_str ("lhapdf")
	end do
	end function beam_structure_has_pdf

	@ %def beam_structure_has_pdf
	@ Return true if the beam structure contains a particular structure
	function identifier (such as [[lhapdf]], [[isr]], etc.)
	<<Beam structures: beam structure: TBP>>=
	procedure :: contains => beam_structure_contains
	<<Beam structures: sub interfaces>>=
	module function beam_structure_contains (beam_structure, name) result (flag)
	class(beam_structure_t), intent(in) :: beam_structure
	character(*), intent(in) :: name
	logical :: flag
	end function beam_structure_contains
	<<Beam structures: procedures>>=
	module function beam_structure_contains (beam_structure, name) result (flag)
	class(beam_structure_t), intent(in) :: beam_structure
	character(*), intent(in) :: name
	logical :: flag
	integer :: i, j
	flag = .false.
	if (allocated (beam_structure%record)) then
	do i = 1, size (beam_structure%record)
	do j = 1, size (beam_structure%record(i)%entry)
	flag = beam_structure%record(i)%entry(j)%name == name
	if (flag) return
	end do
	end do
	end if
	end function beam_structure_contains

	@ %def beam_structure_contains
	@ Return polarization data.
	<<Beam structures: beam structure: TBP>>=
	procedure :: polarized => beam_structure_polarized
	procedure :: get_smatrix => beam_structure_get_smatrix
	procedure :: get_pol_f => beam_structure_get_pol_f
	procedure :: asymmetric => beam_structure_asymmetric
	<<Beam structures: sub interfaces>>=
	module function beam_structure_polarized (beam_structure) result (flag)
	class(beam_structure_t), intent(in) :: beam_structure
	logical :: flag
	end function beam_structure_polarized
	module function beam_structure_get_smatrix (beam_structure) result (smatrix)
	class(beam_structure_t), intent(in) :: beam_structure
	type(smatrix_t), dimension(:), allocatable :: smatrix
	end function beam_structure_get_smatrix
	module function beam_structure_get_pol_f (beam_structure) result (pol_f)
	class(beam_structure_t), intent(in) :: beam_structure
	real(default), dimension(:), allocatable :: pol_f
	end function beam_structure_get_pol_f
	module function beam_structure_asymmetric (beam_structure) result (flag)
	class(beam_structure_t), intent(in) :: beam_structure
	logical :: flag
	end function beam_structure_asymmetric
	<<Beam structures: procedures>>=
	module function beam_structure_polarized (beam_structure) result (flag)
	class(beam_structure_t), intent(in) :: beam_structure
	logical :: flag
	flag = allocated (beam_structure%smatrix)
	end function beam_structure_polarized

	module function beam_structure_get_smatrix (beam_structure) result (smatrix)
	class(beam_structure_t), intent(in) :: beam_structure
	type(smatrix_t), dimension(:), allocatable :: smatrix
	allocate (smatrix (size (beam_structure%smatrix)), &
	source = beam_structure%smatrix)
	end function beam_structure_get_smatrix

	module function beam_structure_get_pol_f (beam_structure) result (pol_f)
	class(beam_structure_t), intent(in) :: beam_structure
	real(default), dimension(:), allocatable :: pol_f
	allocate (pol_f (size (beam_structure%pol_f)), &
	source = beam_structure%pol_f)
	end function beam_structure_get_pol_f

	module function beam_structure_asymmetric (beam_structure) result (flag)
	class(beam_structure_t), intent(in) :: beam_structure
	logical :: flag
	flag = allocated (beam_structure%p) &
	.or. allocated (beam_structure%theta) &
	.or. allocated (beam_structure%phi)
	end function beam_structure_asymmetric

	@ %def beam_structure_polarized
	@ %def beam_structure_get_smatrix
	@ %def beam_structure_get_pol_f
	@ %def beam_structure_asymmetric
	@ Return the beam momenta (the space part, i.e., three-momenta). This
	is meaningful only if momenta and, optionally, angles have been set.
	<<Beam structures: beam structure: TBP>>=
	procedure :: get_momenta => beam_structure_get_momenta
	<<Beam structures: sub interfaces>>=
	module function beam_structure_get_momenta (beam_structure) result (p)
	class(beam_structure_t), intent(in) :: beam_structure
	type(vector3_t), dimension(:), allocatable :: p
	end function beam_structure_get_momenta
	<<Beam structures: procedures>>=
	module function beam_structure_get_momenta (beam_structure) result (p)
	class(beam_structure_t), intent(in) :: beam_structure
	type(vector3_t), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: theta, phi
	integer :: n, i
	if (allocated (beam_structure%p)) then
	n = size (beam_structure%p)
	if (allocated (beam_structure%theta)) then
	if (size (beam_structure%theta) == n) then
	allocate (theta (n), source = beam_structure%theta)
	else
	call msg_fatal ("Beam structure: mismatch in momentum vs. &
	&angle theta specification")
	end if
	else
	allocate (theta (n), source = 0._default)
	end if
	if (allocated (beam_structure%phi)) then
	if (size (beam_structure%phi) == n) then
	allocate (phi (n), source = beam_structure%phi)
	else
	call msg_fatal ("Beam structure: mismatch in momentum vs. &
	&angle phi specification")
	end if
	else
	allocate (phi (n), source = 0._default)
	end if
	allocate (p (n))
	do i = 1, n
	p(i) = beam_structure%p(i) * vector3_moving ([ &
	sin (theta(i)) * cos (phi(i)), &
	sin (theta(i)) * sin (phi(i)), &
	cos (theta(i))])
	end do
	if (n == 2) p(2) = - p(2)
	else
	call msg_fatal ("Beam structure: angle theta/phi specified but &
	&momentum/a p undefined")
	end if
	end function beam_structure_get_momenta

	@ %def beam_structure_get_momenta
	@ Check for a complete beam structure. The [[applies]] flag tells if
	the beam structure should actually be used for a process with the
	given [[n_in]] number of incoming particles.

	It set if the beam structure matches the process as either decay or
	scattering. It is unset if beam structure references a scattering
	setup but the process is a decay. It is also unset if the beam
	structure itself is empty.

	If the beam structure cannot be used, terminate with fatal error.
	<<Beam structures: beam structure: TBP>>=
	procedure :: check_against_n_in => beam_structure_check_against_n_in
	<<Beam structures: sub interfaces>>=
	module subroutine beam_structure_check_against_n_in &
	(beam_structure, n_in, applies)
	class(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: n_in
	logical, intent(out) :: applies
	end subroutine beam_structure_check_against_n_in
	<<Beam structures: procedures>>=
	module subroutine beam_structure_check_against_n_in &
	(beam_structure, n_in, applies)
	class(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: n_in
	logical, intent(out) :: applies
	if (beam_structure%is_set ()) then
	if (n_in == beam_structure%get_n_beam ()) then
	applies = .true.
	else if (beam_structure%get_n_beam () == 0) then
	call msg_fatal &
	("Asymmetric beams: missing beam particle specification")
	applies = .false.
	else
	call msg_fatal &
	("Mismatch of process and beam setup (scattering/decay)")
	applies = .false.
	end if
	else
	applies = .false.
	end if
	end subroutine beam_structure_check_against_n_in

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

	module beam_structures_ut
	use unit_tests
	use beam_structures_uti

	<<Standard module head>>

	<<Beam structures: public test>>

	contains

	<<Beam structures: test driver>>

	end module beam_structures_ut
	@ %def beam_structures_ut
	@
	<<[[beam_structures_uti.f90]]>>=
	<<File header>>

	module beam_structures_uti

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

	use beam_structures

	<<Standard module head>>

	<<Beam structures: test declarations>>

	contains

	<<Beam structures: tests>>

	<<Beam structures: test auxiliary>>

	end module beam_structures_uti
	@ %def beam_structures_ut
	@ API: driver for the unit tests below.
	<<Beam structures: public test>>=
	public :: beam_structures_test
	<<Beam structures: test driver>>=
	subroutine beam_structures_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Beam structures: execute tests>>
	end subroutine beam_structures_test

	@ %def beam_structures_tests
	@
	\subsubsection{Empty structure}
	<<Beam structures: execute tests>>=
	call test (beam_structures_1, "beam_structures_1", &
	"empty beam structure record", &
	u, results)
	<<Beam structures: test declarations>>=
	public :: beam_structures_1
	<<Beam structures: tests>>=
	subroutine beam_structures_1 (u)
	integer, intent(in) :: u
	type(beam_structure_t) :: beam_structure

	write (u, "(A)") "* Test output: beam_structures_1"
	write (u, "(A)") "* Purpose: display empty beam structure record"
	write (u, "(A)")

	call beam_structure%write (u)

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

	end subroutine beam_structures_1

	@ %def beam_structures_1
	@
	\subsubsection{Nontrivial configurations}
	<<Beam structures: execute tests>>=
	call test (beam_structures_2, "beam_structures_2", &
	"beam structure records", &
	u, results)
	<<Beam structures: test declarations>>=
	public :: beam_structures_2
	<<Beam structures: tests>>=
	subroutine beam_structures_2 (u)
	integer, intent(in) :: u
	type(beam_structure_t) :: beam_structure
	integer, dimension(0) :: empty_array
	type(string_t) :: s

	write (u, "(A)") "* Test output: beam_structures_2"
	write (u, "(A)") "* Purpose: setup beam structure records"
	write (u, "(A)")

	s = "s"

	call beam_structure%init_sf ([s], empty_array)
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [1])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [2])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%set_sf (1, 2, var_str ("b"))
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [2, 1])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%set_sf (1, 2, var_str ("b"))
	call beam_structure%set_sf (2, 1, var_str ("c"))
	call beam_structure%write (u)

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

	end subroutine beam_structures_2

	@ %def beam_structures_2
	@
	\subsubsection{Expansion}
	Provide a function that tells, for the dummy structure function names
	used here, whether they are considered a two-particle spectrum or a
	single-particle structure function:
	<<Beam structures: test auxiliary>>=
	function test_strfun_mode (name) result (n)
	type(string_t), intent(in) :: name
	integer :: n
	select case (char (name))
	case ("a"); n = 2
	case ("b"); n = 1
	case default; n = 0
	end select
	end function test_strfun_mode

	@ %def test_ist_pair_spectrum
	@
	<<Beam structures: execute tests>>=
	call test (beam_structures_3, "beam_structures_3", &
	"beam structure expansion", &
	u, results)
	<<Beam structures: test declarations>>=
	public :: beam_structures_3
	<<Beam structures: tests>>=
	subroutine beam_structures_3 (u)
	integer, intent(in) :: u
	type(beam_structure_t) :: beam_structure
	type(string_t) :: s

	write (u, "(A)") "* Test output: beam_structures_3"
	write (u, "(A)") "* Purpose: expand beam structure records"
	write (u, "(A)")

	s = "s"

	write (u, "(A)") "* Pair spectrum (keep as-is)"
	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [1])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%expand (test_strfun_mode)
	call beam_structure%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Structure function pair (expand)"
	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [2])
	call beam_structure%set_sf (1, 1, var_str ("b"))
	call beam_structure%set_sf (1, 2, var_str ("b"))
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%expand (test_strfun_mode)
	call beam_structure%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Structure function (separate and expand)"
	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [1])
	call beam_structure%set_sf (1, 1, var_str ("b"))
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%expand (test_strfun_mode)
	call beam_structure%write (u)

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

	call beam_structure%init_sf ([s, s], [1, 1])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%set_sf (2, 1, var_str ("b"))
	call beam_structure%write (u)

	write (u, "(A)")

	call beam_structure%expand (test_strfun_mode)
	call beam_structure%write (u)

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

	end subroutine beam_structures_3

	@ %def beam_structures_3
	@
	\subsubsection{Public methods}
	Check the methods that can be called to get the beam-structure
	contents.
	<<Beam structures: execute tests>>=
	call test (beam_structures_4, "beam_structures_4", &
	"beam structure contents", &
	u, results)
	<<Beam structures: test declarations>>=
	public :: beam_structures_4
	<<Beam structures: tests>>=
	subroutine beam_structures_4 (u)
	integer, intent(in) :: u
	type(beam_structure_t) :: beam_structure
	type(string_t) :: s
	type(string_t), dimension(2) :: prt
	integer :: i

	write (u, "(A)") "* Test output: beam_structures_4"
	write (u, "(A)") "* Purpose: check the API"
	write (u, "(A)")

	s = "s"

	write (u, "(A)") "* Structure-function combination"
	write (u, "(A)")

	call beam_structure%init_sf ([s, s], [1, 2, 2])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%set_sf (2, 1, var_str ("b"))
	call beam_structure%set_sf (3, 2, var_str ("c"))
	call beam_structure%write (u)

	write (u, *)
	write (u, "(1x,A,I0)") "n_beam = ", beam_structure%get_n_beam ()
	prt = beam_structure%get_prt ()
	write (u, "(1x,A,2(1x,A))") "prt =", char (prt(1)), char (prt(2))

	write (u, *)
	write (u, "(1x,A,I0)") "n_record = ", beam_structure%get_n_record ()

	do i = 1, 3
	write (u, "(A)")
	write (u, "(1x,A,I0,A,A)") "name(", i, ") = ", &
	char (beam_structure%get_name (i))
	write (u, "(1x,A,I0,A,2(1x,I0))") "i_entry(", i, ") =", &
	beam_structure%get_i_entry (i)
	end do

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

	end subroutine beam_structures_4

	@ %def beam_structures_4
	@
	\subsubsection{Polarization}
	The polarization properties are independent from the structure-function setup.
	<<Beam structures: execute tests>>=
	call test (beam_structures_5, "beam_structures_5", &
	"polarization", &
	u, results)
	<<Beam structures: test declarations>>=
	public :: beam_structures_5
	<<Beam structures: tests>>=
	subroutine beam_structures_5 (u)
	integer, intent(in) :: u
	type(beam_structure_t) :: beam_structure
	integer, dimension(0) :: empty_array
	type(string_t) :: s

	write (u, "(A)") "* Test output: beam_structures_5"
	write (u, "(A)") "* Purpose: setup polarization in beam structure records"
	write (u, "(A)")

	s = "s"

	call beam_structure%init_sf ([s], empty_array)
	call beam_structure%init_pol (1)
	call beam_structure%init_smatrix (1, 1)
	call beam_structure%set_sentry (1, 1, [0,0], (1._default, 0._default))
	call beam_structure%set_pol_f ([0.5_default])
	call beam_structure%write (u)


	write (u, "(A)")
	call beam_structure%final_sf ()
	call beam_structure%final_pol ()

	call beam_structure%init_sf ([s, s], [1])
	call beam_structure%set_sf (1, 1, var_str ("a"))
	call beam_structure%init_pol (2)
	call beam_structure%init_smatrix (1, 2)
	call beam_structure%set_sentry (1, 1, [-1,1], (0.5_default,-0.5_default))
	call beam_structure%set_sentry (1, 2, [ 1,1], (1._default, 0._default))
	call beam_structure%init_smatrix (2, 0)
	call beam_structure%write (u)

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

	end subroutine beam_structures_5

	@ %def beam_structures_5
	@
	\subsubsection{Momenta}
	The momenta are independent from the structure-function setup.
	<<Beam structures: execute tests>>=
	call test (beam_structures_6, "beam_structures_6", &
	"momenta", &
	u, results)
	<<Beam structures: test declarations>>=
	public :: beam_structures_6
	<<Beam structures: tests>>=
	subroutine beam_structures_6 (u)
	integer, intent(in) :: u
	type(beam_structure_t) :: beam_structure
	integer, dimension(0) :: empty_array
	type(string_t) :: s

	write (u, "(A)") "* Test output: beam_structures_6"
	write (u, "(A)") "* Purpose: setup momenta in beam structure records"
	write (u, "(A)")

	s = "s"

	call beam_structure%init_sf ([s], empty_array)
	call beam_structure%set_momentum ([500._default])
	call beam_structure%write (u)


	write (u, "(A)")
	call beam_structure%final_sf ()
	call beam_structure%final_mom ()

	call beam_structure%init_sf ([s, s], [1])
	call beam_structure%set_momentum ([500._default, 700._default])
	call beam_structure%set_theta ([0._default, 0.1_default])
	call beam_structure%set_phi ([0._default, 1.51_default])
	call beam_structure%write (u)

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

	end subroutine beam_structures_6

	@ %def beam_structures_6
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Beams for collisions and decays}

	<<[[beams.f90]]>>=
	<<File header>>

	module beams

	<<Use kinds>>
	<<Use strings>>
	use lorentz
	use model_data
	use flavors
	use quantum_numbers
	use state_matrices
	use interactions
	use polarizations
	use beam_structures

	<<Standard module head>>

	<<Beams: public>>

	<<Beams: types>>

	<<Beams: interfaces>>

	interface
	<<Beams: sub interfaces>>
	end interface

	end module beams
	@ %def beams
	@
	<<[[beams_sub.f90]]>>=
	<<File header>>

	submodule (beams) beams_s

	use io_units
	use format_defs, only: FMT_19
	use numeric_utils
	use diagnostics
	use md5

	implicit none

	contains

	<<Beams: procedures>>

	end submodule beams_s

	@ %def beams_s
	@
	\subsection{Beam data}
	The beam data type contains beam data for one or two beams, depending
	on whether we are dealing with beam collisions or particle decay. In
	addition, it holds the c.m.\ energy [[sqrts]], the Lorentz
	transformation [[L]] that transforms the c.m.\ system into the lab
	system, and the pair of c.m.\ momenta.
	<<Beams: public>>=
	public :: beam_data_t
	<<Beams: types>>=
	type :: beam_data_t
	logical :: initialized = .false.
	integer :: n = 0
	type(flavor_t), dimension(:), allocatable :: flv
	real(default), dimension(:), allocatable :: mass
	type(pmatrix_t), dimension(:), allocatable :: pmatrix
	logical :: lab_is_cm = .true.
	type(vector4_t), dimension(:), allocatable :: p_cm
	type(vector4_t), dimension(:), allocatable :: p
	type(lorentz_transformation_t), allocatable :: L_cm_to_lab
	real(default) :: sqrts = 0
	character(32) :: md5sum = ""
	contains
	<<Beams: beam data: TBP>>
	end type beam_data_t

	@ %def beam_data_t
	@ Generic initializer. This is called by the specific initializers
	below. Initialize either for decay or for collision.
	<<Beams: procedures>>=
	subroutine beam_data_init (beam_data, n)
	type(beam_data_t), intent(out) :: beam_data
	integer, intent(in) :: n
	beam_data%n = n
	allocate (beam_data%flv (n))
	allocate (beam_data%mass (n))
	allocate (beam_data%pmatrix (n))
	allocate (beam_data%p_cm (n))
	allocate (beam_data%p (n))
	beam_data%initialized = .true.
	end subroutine beam_data_init

	@ %def beam_data_init
	@ Finalizer: needed for the polarization components of the beams.
	<<Beams: beam data: TBP>>=
	procedure :: final => beam_data_final
	<<Beams: sub interfaces>>=
	module subroutine beam_data_final (beam_data)
	class(beam_data_t), intent(inout) :: beam_data
	end subroutine beam_data_final
	<<Beams: procedures>>=
	module subroutine beam_data_final (beam_data)
	class(beam_data_t), intent(inout) :: beam_data
	beam_data%initialized = .false.
	end subroutine beam_data_final

	@ %def beam_data_final
	@ The verbose (default) version is for debugging. The short version
	is for screen output in the UI.
	<<Beams: beam data: TBP>>=
	procedure :: write => beam_data_write
	<<Beams: sub interfaces>>=
	module subroutine beam_data_write (beam_data, unit, verbose, write_md5sum)
	class(beam_data_t), intent(in) :: beam_data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, write_md5sum
	end subroutine beam_data_write
	<<Beams: procedures>>=
	module subroutine beam_data_write (beam_data, unit, verbose, write_md5sum)
	class(beam_data_t), intent(in) :: beam_data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, write_md5sum
	integer :: prt_name_len
	logical :: verb, write_md5
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	verb = .false.; if (present (verbose)) verb = verbose
	write_md5 = verb; if (present (write_md5sum)) write_md5 = write_md5sum
	if (.not. beam_data%initialized) then
	write (u, "(1x,A)") "Beam data: [undefined]"
	return
	end if
	prt_name_len = maxval (len (beam_data%flv%get_name ()))
	select case (beam_data%n)
	case (1)
	write (u, "(1x,A)") "Beam data (decay):"
	if (verb) then
	call write_prt (1)
	call beam_data%pmatrix(1)%write (u)
	write (u, *) "R.f. momentum:"
	call vector4_write (beam_data%p_cm(1), u)
	write (u, *) "Lab momentum:"
	call vector4_write (beam_data%p(1), u)
	else
	call write_prt (1)
	end if
	case (2)
	write (u, "(1x,A)") "Beam data (collision):"
	if (verb) then
	call write_prt (1)
	call beam_data%pmatrix(1)%write (u)
	call write_prt (2)
	call beam_data%pmatrix(2)%write (u)
	call write_sqrts
	write (u, *) "C.m. momenta:"
	call vector4_write (beam_data%p_cm(1), u)
	call vector4_write (beam_data%p_cm(2), u)
	write (u, *) "Lab momenta:"
	call vector4_write (beam_data%p(1), u)
	call vector4_write (beam_data%p(2), u)
	else
	call write_prt (1)
	call write_prt (2)
	call write_sqrts
	end if
	end select
	if (allocated (beam_data%L_cm_to_lab)) then
	if (verb) then
	call lorentz_transformation_write (beam_data%L_cm_to_lab, u)
	else
	write (u, "(1x,A)") "Beam structure: lab and c.m. frame differ"
	end if
	end if
	if (write_md5) then
	write (u, *) "MD5 sum: ", beam_data%md5sum
	end if
	contains
	subroutine write_sqrts
	character(80) :: sqrts_str
	write (sqrts_str, "(" // FMT_19 // ")") beam_data%sqrts
	write (u, "(3x,A)") "sqrts = " // trim (adjustl (sqrts_str)) // " GeV"
	end subroutine write_sqrts
	subroutine write_prt (i)
	integer, intent(in) :: i
	character(80) :: name_str, mass_str
	write (name_str, "(A)") char (beam_data%flv(i)%get_name ())
	write (mass_str, "(ES13.7)") beam_data%mass(i)
	write (u, "(3x,A)", advance="no") &
	name_str(:prt_name_len) // " (mass = " &
	// trim (adjustl (mass_str)) // " GeV)"
	if (beam_data%pmatrix(i)%is_polarized ()) then
	write (u, "(2x,A)") "polarized"
	else
	write (u, *)
	end if
	end subroutine write_prt
	end subroutine beam_data_write

	@ %def beam_data_write
	@ Return initialization status:
	<<Beams: beam data: TBP>>=
	procedure :: are_valid => beam_data_are_valid
	<<Beams: sub interfaces>>=
	module function beam_data_are_valid (beam_data) result (flag)
	class(beam_data_t), intent(in) :: beam_data
	logical :: flag
	end function beam_data_are_valid
	<<Beams: procedures>>=
	module function beam_data_are_valid (beam_data) result (flag)
	class(beam_data_t), intent(in) :: beam_data
	logical :: flag
	flag = beam_data%initialized
	end function beam_data_are_valid

	@ %def beam_data_are_valid
	@ Check whether beam data agree with the current values of relevant
	parameters.
	<<Beams: beam data: TBP>>=
	procedure :: check_scattering => beam_data_check_scattering
	<<Beams: sub interfaces>>=
	module subroutine beam_data_check_scattering (beam_data, sqrts)
	class(beam_data_t), intent(in) :: beam_data
	real(default), intent(in), optional :: sqrts
	end subroutine beam_data_check_scattering
	<<Beams: procedures>>=
	module subroutine beam_data_check_scattering (beam_data, sqrts)
	class(beam_data_t), intent(in) :: beam_data
	real(default), intent(in), optional :: sqrts
	if (beam_data_are_valid (beam_data)) then
	if (present (sqrts)) then
	if (.not. nearly_equal (sqrts, beam_data%sqrts)) then
	call msg_error ("Current setting of sqrts is inconsistent " &
	// "with beam setup (ignored).")
	end if
	end if
	else
	call msg_bug ("Beam setup: invalid beam data")
	end if
	end subroutine beam_data_check_scattering

	@ %def beam_data_check_scattering
	@ Return the number of beams (1 for decays, 2 for collisions).
	<<Beams: beam data: TBP>>=
	procedure :: get_n_in => beam_data_get_n_in
	<<Beams: sub interfaces>>=
	module function beam_data_get_n_in (beam_data) result (n_in)
	class(beam_data_t), intent(in) :: beam_data
	integer :: n_in
	end function beam_data_get_n_in
	<<Beams: procedures>>=
	module function beam_data_get_n_in (beam_data) result (n_in)
	class(beam_data_t), intent(in) :: beam_data
	integer :: n_in
	n_in = beam_data%n
	end function beam_data_get_n_in

	@ %def beam_data_get_n_in
	@ Return the beam flavor
	<<Beams: beam data: TBP>>=
	procedure :: get_flavor => beam_data_get_flavor
	<<Beams: sub interfaces>>=
	module function beam_data_get_flavor (beam_data) result (flv)
	class(beam_data_t), intent(in) :: beam_data
	type(flavor_t), dimension(:), allocatable :: flv
	end function beam_data_get_flavor
	<<Beams: procedures>>=
	module function beam_data_get_flavor (beam_data) result (flv)
	class(beam_data_t), intent(in) :: beam_data
	type(flavor_t), dimension(:), allocatable :: flv
	allocate (flv (beam_data%n))
	flv = beam_data%flv
	end function beam_data_get_flavor

	@ %def beam_data_get_flavor
	@ Return the beam energies
	<<Beams: beam data: TBP>>=
	procedure :: get_energy => beam_data_get_energy
	<<Beams: sub interfaces>>=
	module function beam_data_get_energy (beam_data) result (e)
	class(beam_data_t), intent(in) :: beam_data
	real(default), dimension(:), allocatable :: e
	end function beam_data_get_energy
	<<Beams: procedures>>=
	module function beam_data_get_energy (beam_data) result (e)
	class(beam_data_t), intent(in) :: beam_data
	real(default), dimension(:), allocatable :: e
	integer :: i
	allocate (e (beam_data%n))
	if (beam_data%initialized) then
	do i = 1, beam_data%n
	e(i) = energy (beam_data%p(i))
	end do
	else
	e = 0
	end if
	end function beam_data_get_energy

	@ %def beam_data_get_energy
	@ Return the c.m.\ energy.
	<<Beams: beam data: TBP>>=
	procedure :: get_sqrts => beam_data_get_sqrts
	<<Beams: sub interfaces>>=
	module function beam_data_get_sqrts (beam_data) result (sqrts)
	class(beam_data_t), intent(in) :: beam_data
	real(default) :: sqrts
	end function beam_data_get_sqrts
	<<Beams: procedures>>=
	module function beam_data_get_sqrts (beam_data) result (sqrts)
	class(beam_data_t), intent(in) :: beam_data
	real(default) :: sqrts
	sqrts = beam_data%sqrts
	end function beam_data_get_sqrts

	@ %def beam_data_get_sqrts
	@ Return the polarization in case it is just two degrees
	<<Beams: beam data: TBP>>=
	procedure :: get_polarization => beam_data_get_polarization
	<<Beams: sub interfaces>>=
	module function beam_data_get_polarization (beam_data) result (pol)
	class(beam_data_t), intent(in) :: beam_data
	real(default), dimension(beam_data%n) :: pol
	end function beam_data_get_polarization
	<<Beams: procedures>>=
	module function beam_data_get_polarization (beam_data) result (pol)
	class(beam_data_t), intent(in) :: beam_data
	real(default), dimension(beam_data%n) :: pol
	pol = beam_data%pmatrix%get_simple_pol ()
	end function beam_data_get_polarization

	@ %def beam_data_get_polarization
	@
	<<Beams: beam data: TBP>>=
	procedure :: get_helicity_state_matrix => beam_data_get_helicity_state_matrix
	<<Beams: sub interfaces>>=
	module function beam_data_get_helicity_state_matrix &
	(beam_data) result (state_hel)
	type(state_matrix_t) :: state_hel
	class(beam_data_t), intent(in) :: beam_data
	end function beam_data_get_helicity_state_matrix
	<<Beams: procedures>>=
	module function beam_data_get_helicity_state_matrix &
	(beam_data) result (state_hel)
	type(state_matrix_t) :: state_hel
	class(beam_data_t), intent(in) :: beam_data
	type(polarization_t), dimension(:), allocatable :: pol
	integer :: i
	allocate (pol (beam_data%n))
	do i = 1, beam_data%n
	call pol(i)%init_pmatrix (beam_data%pmatrix(i))
	end do
	call combine_polarization_states (pol, state_hel)
	end function beam_data_get_helicity_state_matrix

	@ %def beam_data_get_helicity_state_matrix
	@
	<<Beams: beam data: TBP>>=
	procedure :: is_initialized => beam_data_is_initialized
	<<Beams: sub interfaces>>=
	module function beam_data_is_initialized (beam_data) result (initialized)
	logical :: initialized
	class(beam_data_t), intent(in) :: beam_data
	end function beam_data_is_initialized
	<<Beams: procedures>>=
	module function beam_data_is_initialized (beam_data) result (initialized)
	logical :: initialized
	class(beam_data_t), intent(in) :: beam_data
	initialized = any (beam_data%pmatrix%exists ())
	end function beam_data_is_initialized

	@ %def beam_data_is_initialized
	@ Return a MD5 checksum for beam data. If no checksum is present
	(because beams have not been initialized), compute the checksum of the
	sqrts value.
	<<Beams: beam data: TBP>>=
	procedure :: get_md5sum => beam_data_get_md5sum
	<<Beams: sub interfaces>>=
	module function beam_data_get_md5sum &
	(beam_data, sqrts) result (md5sum_beams)
	class(beam_data_t), intent(in) :: beam_data
	real(default), intent(in) :: sqrts
	character(32) :: md5sum_beams
	end function beam_data_get_md5sum
	<<Beams: procedures>>=
	module function beam_data_get_md5sum &
	(beam_data, sqrts) result (md5sum_beams)
	class(beam_data_t), intent(in) :: beam_data
	real(default), intent(in) :: sqrts
	character(32) :: md5sum_beams
	character(80) :: buffer
	if (beam_data%md5sum /= "") then
	md5sum_beams = beam_data%md5sum
	else
	write (buffer, *) sqrts
	md5sum_beams = md5sum (buffer)
	end if
	end function beam_data_get_md5sum

	@ %def beam_data_get_md5sum
	@
	\subsection{Initializers: beam structure}
	Initialize the beam data object from a beam structure object, given energy and
	model.
	<<Beams: beam data: TBP>>=
	procedure :: init_structure => beam_data_init_structure
	<<Beams: sub interfaces>>=
	module subroutine beam_data_init_structure &
	(beam_data, structure, sqrts, model, decay_rest_frame)
	class(beam_data_t), intent(out) :: beam_data
	type(beam_structure_t), intent(in) :: structure
	real(default), intent(in) :: sqrts
	class(model_data_t), intent(in), target :: model
	logical, intent(in), optional :: decay_rest_frame
	end subroutine beam_data_init_structure
	<<Beams: procedures>>=
	module subroutine beam_data_init_structure &
	(beam_data, structure, sqrts, model, decay_rest_frame)
	class(beam_data_t), intent(out) :: beam_data
	type(beam_structure_t), intent(in) :: structure
	integer :: n_beam
	real(default), intent(in) :: sqrts
	class(model_data_t), intent(in), target :: model
	logical, intent(in), optional :: decay_rest_frame
	type(flavor_t), dimension(:), allocatable :: flv
	n_beam = structure%get_n_beam ()
	allocate (flv (n_beam))
	call flv%init (structure%get_prt (), model)
	if (structure%asymmetric ()) then
	if (structure%polarized ()) then
	call beam_data%init_momenta (structure%get_momenta (), flv, &
	structure%get_smatrix (), structure%get_pol_f ())
	else
	call beam_data%init_momenta (structure%get_momenta (), flv)
	end if
	else
	select case (n_beam)
	case (1)
	if (structure%polarized ()) then
	call beam_data%init_decay (flv, &
	structure%get_smatrix (), structure%get_pol_f (), &
	rest_frame = decay_rest_frame)
	else
	call beam_data%init_decay (flv, &
	rest_frame = decay_rest_frame)
	end if
	case (2)
	if (structure%polarized ()) then
	call beam_data%init_sqrts (sqrts, flv, &
	structure%get_smatrix (), structure%get_pol_f ())
	else
	call beam_data%init_sqrts (sqrts, flv)
	end if
	case default
	call msg_bug ("Beam data: invalid beam structure object")
	end select
	end if
	end subroutine beam_data_init_structure

	@ %def beam_data_init_structure
	@
	\subsection{Initializers: collisions}
	This is the simplest one: just the two flavors, c.m.\ energy,
	polarization. Color is inferred from flavor. Beam momenta and c.m.\
	momenta coincide.
	<<Beams: beam data: TBP>>=
	procedure :: init_sqrts => beam_data_init_sqrts
	<<Beams: sub interfaces>>=
	module subroutine beam_data_init_sqrts &
	(beam_data, sqrts, flv, smatrix, pol_f)
	class(beam_data_t), intent(out) :: beam_data
	real(default), intent(in) :: sqrts
	type(flavor_t), dimension(:), intent(in) :: flv
	type(smatrix_t), dimension(:), intent(in), optional :: smatrix
	real(default), dimension(:), intent(in), optional :: pol_f
	end subroutine beam_data_init_sqrts
	<<Beams: procedures>>=
	module subroutine beam_data_init_sqrts &
	(beam_data, sqrts, flv, smatrix, pol_f)
	class(beam_data_t), intent(out) :: beam_data
	real(default), intent(in) :: sqrts
	type(flavor_t), dimension(:), intent(in) :: flv
	type(smatrix_t), dimension(:), intent(in), optional :: smatrix
	real(default), dimension(:), intent(in), optional :: pol_f
	real(default), dimension(size(flv)) :: E, p
	call beam_data_init (beam_data, size (flv))
	beam_data%sqrts = sqrts
	beam_data%lab_is_cm = .true.
	select case (beam_data%n)
	case (1)
	E = sqrts; p = 0
	beam_data%p_cm = vector4_moving (E, p, 3)
	beam_data%p = beam_data%p_cm
	case (2)
	beam_data%p_cm = colliding_momenta (sqrts, flv%get_mass ())
	beam_data%p = colliding_momenta (sqrts, flv%get_mass ())
	end select
	call beam_data_finish_initialization (beam_data, flv, smatrix, pol_f)
	end subroutine beam_data_init_sqrts

	@ %def beam_data_init_sqrts
	@ This version sets beam momenta directly, assuming that they are
	asymmetric, i.e., lab frame and c.m.\ frame do not coincide.
	Polarization info is deferred to a common initializer.

	The Lorentz transformation that we compute here is not actually used
	in the calculation; instead, it will be recomputed for each event in
	the subroutine [[phs_set_incoming_momenta]]. We compute it here for
	the nominal beam setup nevertheless, so we can print it and, in
	particular, include it in the MD5 sum.
	<<Beams: beam data: TBP>>=
	procedure :: init_momenta => beam_data_init_momenta
	<<Beams: sub interfaces>>=
	module subroutine beam_data_init_momenta &
	(beam_data, p3, flv, smatrix, pol_f)
	class(beam_data_t), intent(out) :: beam_data
	type(vector3_t), dimension(:), intent(in) :: p3
	type(flavor_t), dimension(:), intent(in) :: flv
	type(smatrix_t), dimension(:), intent(in), optional :: smatrix
	real(default), dimension(:), intent(in), optional :: pol_f
	end subroutine beam_data_init_momenta
	<<Beams: procedures>>=
	module subroutine beam_data_init_momenta &
	(beam_data, p3, flv, smatrix, pol_f)
	class(beam_data_t), intent(out) :: beam_data
	type(vector3_t), dimension(:), intent(in) :: p3
	type(flavor_t), dimension(:), intent(in) :: flv
	type(smatrix_t), dimension(:), intent(in), optional :: smatrix
	real(default), dimension(:), intent(in), optional :: pol_f
	type(vector4_t) :: p0
	type(vector4_t), dimension(:), allocatable :: p, p_cm_rot
	real(default), dimension(size(p3)) :: e
	real(default), dimension(size(flv)) :: m
	type(lorentz_transformation_t) :: L_boost, L_rot
	call beam_data_init (beam_data, size (flv))
	m = flv%get_mass ()
	e = sqrt (p3 2 + m 2)
	allocate (p (beam_data%n))
	p = vector4_moving (e, p3)
	p0 = sum (p)
	beam_data%p = p
	beam_data%lab_is_cm = .false.
	beam_data%sqrts = p0 ** 1
	L_boost = boost (p0, beam_data%sqrts)
	allocate (p_cm_rot (beam_data%n))
	p_cm_rot = inverse (L_boost) * p
	allocate (beam_data%L_cm_to_lab)
	select case (beam_data%n)
	case (1)
	beam_data%L_cm_to_lab = L_boost
	beam_data%p_cm = vector4_at_rest (beam_data%sqrts)
	case (2)
	L_rot = rotation_to_2nd (3, space_part (p_cm_rot(1)))
	beam_data%L_cm_to_lab = L_boost * L_rot
	beam_data%p_cm = &
	colliding_momenta (beam_data%sqrts, flv%get_mass ())
	end select
	call beam_data_finish_initialization (beam_data, flv, smatrix, pol_f)
	end subroutine beam_data_init_momenta

	@ %def beam_data_init_momenta
	@
	Final steps:
	If requested, rotate the beams in the lab frame, and set
	the beam-data components.
	<<Beams: procedures>>=
	subroutine beam_data_finish_initialization (beam_data, flv, smatrix, pol_f)
	type(beam_data_t), intent(inout) :: beam_data
	type(flavor_t), dimension(:), intent(in) :: flv
	type(smatrix_t), dimension(:), intent(in), optional :: smatrix
	real(default), dimension(:), intent(in), optional :: pol_f
	integer :: i
	do i = 1, beam_data%n
	beam_data%flv(i) = flv(i)
	beam_data%mass(i) = flv(i)%get_mass ()
	if (present (smatrix)) then
	if (size (smatrix) /= beam_data%n) &
	call msg_fatal ("Beam data: &
	&polarization density array has wrong dimension")
	beam_data%pmatrix(i) = smatrix(i)
	if (present (pol_f)) then
	if (size (pol_f) /= size (smatrix)) &
	call msg_fatal ("Beam data: &
	&polarization fraction array has wrong dimension")
	call beam_data%pmatrix(i)%normalize (flv(i), pol_f(i))
	else
	call beam_data%pmatrix(i)%normalize (flv(i), 1._default)
	end if
	else
	call beam_data%pmatrix(i)%init (2, 0)
	call beam_data%pmatrix(i)%normalize (flv(i), 0._default)
	end if
	end do
	call beam_data%compute_md5sum ()
	end subroutine beam_data_finish_initialization

	@ %def beam_data_finish_initialization
	@
	The MD5 sum is stored within the beam-data record, so it can be
	checked for integrity in subsequent runs.
	<<Beams: beam data: TBP>>=
	procedure :: compute_md5sum => beam_data_compute_md5sum
	<<Beams: sub interfaces>>=
	module subroutine beam_data_compute_md5sum (beam_data)
	class(beam_data_t), intent(inout) :: beam_data
	integer :: unit
	end subroutine beam_data_compute_md5sum
	<<Beams: procedures>>=
	module subroutine beam_data_compute_md5sum (beam_data)
	class(beam_data_t), intent(inout) :: beam_data
	integer :: unit
	unit = free_unit ()
	open (unit = unit, status = "scratch", action = "readwrite")
	call beam_data%write (unit, write_md5sum = .false., &
	verbose = .true.)
	rewind (unit)
	beam_data%md5sum = md5sum (unit)
	close (unit)
	end subroutine beam_data_compute_md5sum

	@ %def beam_data_compute_md5sum
	@
	\subsection{Initializers: decays}
	This is the simplest one: decay in rest frame. We need just flavor
	and polarization. Color is inferred from flavor. Beam momentum and
	c.m.\ momentum coincide.
	<<Beams: beam data: TBP>>=
	procedure :: init_decay => beam_data_init_decay
	<<Beams: sub interfaces>>=
	module subroutine beam_data_init_decay &
	(beam_data, flv, smatrix, pol_f, rest_frame)
	class(beam_data_t), intent(out) :: beam_data
	type(flavor_t), dimension(1), intent(in) :: flv
	type(smatrix_t), dimension(1), intent(in), optional :: smatrix
	real(default), dimension(:), intent(in), optional :: pol_f
	logical, intent(in), optional :: rest_frame
	end subroutine beam_data_init_decay
	<<Beams: procedures>>=
	module subroutine beam_data_init_decay &
	(beam_data, flv, smatrix, pol_f, rest_frame)
	class(beam_data_t), intent(out) :: beam_data
	type(flavor_t), dimension(1), intent(in) :: flv
	type(smatrix_t), dimension(1), intent(in), optional :: smatrix
	real(default), dimension(:), intent(in), optional :: pol_f
	logical, intent(in), optional :: rest_frame
	real(default), dimension(1) :: m
	m = flv%get_mass ()
	if (present (smatrix)) then
	call beam_data%init_sqrts (m(1), flv, smatrix, pol_f)
	else
	call beam_data%init_sqrts (m(1), flv, smatrix, pol_f)
	end if
	if (present (rest_frame)) beam_data%lab_is_cm = rest_frame
	end subroutine beam_data_init_decay

	@ %def beam_data_init_decay
	@
	\subsection{The beams type}
	Beam objects are interaction objects that contain the actual beam
	data including polarization and density matrix. For collisions, the
	beam object actually contains two beams.
	<<Beams: public>>=
	public :: beam_t
	<<Beams: types>>=
	type :: beam_t
	private
	type(interaction_t) :: int
	end type beam_t

	@ %def beam_t
	@ The constructor contains code that converts beam data into the
	(entangled) particle-pair quantum state. First, we set the number of
	particles and polarization mask. (The polarization mask is handed
	over to all later interactions, so if helicity is diagonal or absent, this fact
	is used when constructing the hard-interaction events.) Then, we
	construct the entangled state that combines helicity, flavor and color
	of the two particles (where flavor and color are unique, while several
	helicity states are possible). Then, we transfer this state together
	with the associated values from the spin density matrix into the
	[[interaction_t]] object.

	Calling the [[add_state]] method of the interaction object, we keep
	the entries of the helicity density matrix without adding them up.
	This ensures that for unpolarized states, we do not normalize but end
	up with an $1/N$ entry, where $N$ is the initial-state multiplicity.
	<<Beams: public>>=
	public :: beam_init
	<<Beams: sub interfaces>>=
	module subroutine beam_init (beam, beam_data)
	type(beam_t), intent(out) :: beam
	type(beam_data_t), intent(in), target :: beam_data
	end subroutine beam_init
	<<Beams: procedures>>=
	module subroutine beam_init (beam, beam_data)
	type(beam_t), intent(out) :: beam
	type(beam_data_t), intent(in), target :: beam_data
	logical, dimension(beam_data%n) :: polarized, diagonal
	type(quantum_numbers_mask_t), dimension(beam_data%n) :: mask, mask_d
	type(state_matrix_t), target :: state_hel, state_fc, state_tmp
	type(state_iterator_t) :: it_hel, it_tmp
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	complex(default) :: value
	real(default), parameter :: tolerance = 100 * epsilon (1._default)
	polarized = beam_data%pmatrix%is_polarized ()
	diagonal = beam_data%pmatrix%is_diagonal ()
	mask = quantum_numbers_mask (.false., .false., &
	mask_h = .not. polarized, &
	mask_hd = diagonal)
	mask_d = quantum_numbers_mask (.false., .false., .false., &
	mask_hd = polarized .and. diagonal)
	call beam%int%basic_init &
	(0, 0, beam_data%n, mask = mask, store_values = .true.)
	state_hel = beam_data%get_helicity_state_matrix ()
	allocate (qn (beam_data%n))
	call qn%init (beam_data%flv, color_from_flavor (beam_data%flv, 1))
	call state_fc%init ()
	call state_fc%add_state (qn)
	call merge_state_matrices (state_hel, state_fc, state_tmp)
	call it_hel%init (state_hel)
	call it_tmp%init (state_tmp)
	do while (it_hel%is_valid ())
	qn = it_tmp%get_quantum_numbers ()
	value = it_hel%get_matrix_element ()
	if (any (qn%are_redundant (mask_d))) then
	! skip off-diagonal elements for diagonal polarization
	else if (abs (value) <= tolerance) then
	! skip zero entries
	else
	call beam%int%add_state (qn, value = value)
	end if
	call it_hel%advance ()
	call it_tmp%advance ()
	end do
	call beam%int%freeze ()
	call beam%int%set_momenta (beam_data%p, outgoing = .true.)
	call state_hel%final ()
	call state_fc%final ()
	call state_tmp%final ()
	end subroutine beam_init

	@ %def beam_init
	@ Finalizer:
	<<Beams: public>>=
	public :: beam_final
	<<Beams: sub interfaces>>=
	module subroutine beam_final (beam)
	type(beam_t), intent(inout) :: beam
	end subroutine beam_final
	<<Beams: procedures>>=
	module subroutine beam_final (beam)
	type(beam_t), intent(inout) :: beam
	call beam%int%final ()
	end subroutine beam_final

	@ %def beam_final
	@ I/O:
	<<Beams: public>>=
	public :: beam_write
	<<Beams: sub interfaces>>=
	module subroutine beam_write &
	(beam, unit, verbose, show_momentum_sum, show_mass, col_verbose)
	type(beam_t), intent(in) :: beam
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, show_momentum_sum, show_mass
	logical, intent(in), optional :: col_verbose
	end subroutine beam_write
	<<Beams: procedures>>=
	module subroutine beam_write &
	(beam, unit, verbose, show_momentum_sum, show_mass, col_verbose)
	type(beam_t), intent(in) :: beam
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, show_momentum_sum, show_mass
	logical, intent(in), optional :: col_verbose
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	select case (beam%int%get_n_out ())
	case (1); write (u, *) "Decaying particle:"
	case (2); write (u, *) "Colliding beams:"
	end select
	call beam%int%basic_write &
	(unit, verbose = verbose, show_momentum_sum = &
	show_momentum_sum, show_mass = show_mass, &
	col_verbose = col_verbose)
	end subroutine beam_write

	@ %def beam_write
	@ Defined assignment: deep copy
	<<Beams: public>>=
	public :: assignment(=)
	<<Beams: interfaces>>=
	interface assignment(=)
	module procedure beam_assign
	end interface

	<<Beams: sub interfaces>>=
	module subroutine beam_assign (beam_out, beam_in)
	type(beam_t), intent(out) :: beam_out
	type(beam_t), intent(in) :: beam_in
	end subroutine beam_assign
	<<Beams: procedures>>=
	module subroutine beam_assign (beam_out, beam_in)
	type(beam_t), intent(out) :: beam_out
	type(beam_t), intent(in) :: beam_in
	beam_out%int = beam_in%int
	end subroutine beam_assign

	@ %def beam_assign
	@
	\subsection{Inherited procedures}
	<<Beams: public>>=
	public :: interaction_set_source_link_beam
	<<Beams: sub interfaces>>=
	module subroutine interaction_set_source_link_beam (int, i, beam1, i1)
	type(interaction_t), intent(inout) :: int
	type(beam_t), intent(in), target :: beam1
	integer, intent(in) :: i, i1
	end subroutine interaction_set_source_link_beam
	<<Beams: procedures>>=
	module subroutine interaction_set_source_link_beam (int, i, beam1, i1)
	type(interaction_t), intent(inout) :: int
	type(beam_t), intent(in), target :: beam1
	integer, intent(in) :: i, i1
	call int%set_source_link (i, beam1%int, i1)
	end subroutine interaction_set_source_link_beam

	@ %def interaction_set_source_link_beam
	@
	\subsection{Accessing contents}
	Return the interaction component -- as a pointer, to avoid any copying.
	<<Beams: public>>=
	public :: beam_get_int_ptr
	<<Beams: sub interfaces>>=
	module function beam_get_int_ptr (beam) result (int)
	type(interaction_t), pointer :: int
	type(beam_t), intent(in), target :: beam
	end function beam_get_int_ptr
	<<Beams: procedures>>=
	module function beam_get_int_ptr (beam) result (int)
	type(interaction_t), pointer :: int
	type(beam_t), intent(in), target :: beam
	int => beam%int
	end function beam_get_int_ptr

	@ %def beam_get_int_ptr
	@ Set beam momenta directly. (Used for cascade decays.)
	<<Beams: public>>=
	public :: beam_set_momenta
	<<Beams: sub interfaces>>=
	module subroutine beam_set_momenta (beam, p)
	type(beam_t), intent(inout) :: beam
	type(vector4_t), dimension(:), intent(in) :: p
	end subroutine beam_set_momenta
	<<Beams: procedures>>=
	module subroutine beam_set_momenta (beam, p)
	type(beam_t), intent(inout) :: beam
	type(vector4_t), dimension(:), intent(in) :: p
	call beam%int%set_momenta (p)
	end subroutine beam_set_momenta

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

	module beams_ut
	use unit_tests
	use beams_uti

	<<Standard module head>>

	<<Beams: public test>>

	contains

	<<Beams: test driver>>

	end module beams_ut
	@ %def beams_ut
	@
	<<[[beams_uti.f90]]>>=
	<<File header>>

	module beams_uti

	<<Use kinds>>
	use lorentz
	use flavors
	use interactions, only: reset_interaction_counter
	use polarizations, only: smatrix_t
	use model_data
	use beam_structures

	use beams

	<<Standard module head>>

	<<Beams: test declarations>>

	contains

	<<Beams: tests>>

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

	@ %def beams_test
	@ Test the basic beam setup.
	<<Beams: execute tests>>=
	call test (beam_1, "beam_1", &
	"check basic beam setup", &
	u, results)
	<<Beams: test declarations>>=
	public :: beam_1
	<<Beams: tests>>=
	subroutine beam_1 (u)
	integer, intent(in) :: u
	type(beam_data_t), target :: beam_data
	type(beam_t) :: beam
	real(default) :: sqrts
	type(flavor_t), dimension(2) :: flv
	type(smatrix_t), dimension(2) :: smatrix
	real(default), dimension(2) :: pol_f
	type(model_data_t), target :: model

	write (u, "(A)") "* Test output: beam_1"
	write (u, "(A)") "* Purpose: test basic beam setup"
	write (u, "(A)")

	write (u, "(A)") "* Reading model file"
	write (u, "(A)")

	call reset_interaction_counter ()

	call model%init_sm_test ()

	write (u, "(A)") "* Unpolarized scattering, massless fermions"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([1,-1], model)

	call beam_data%init_sqrts (sqrts, flv)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized scattering, massless bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([22,22], model)

	call beam_data%init_sqrts (sqrts, flv)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized scattering, massive bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([24,-24], model)

	call beam_data%init_sqrts (sqrts, flv)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Polarized scattering, massless fermions"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([1,-1], model)

	call smatrix(1)%init (2, 1)
	call smatrix(1)%set_entry (1, [1,1], (1._default, 0._default))
	pol_f(1) = 0.5_default

	call smatrix(2)%init (2, 3)
	call smatrix(2)%set_entry (1, [1,1], (1._default, 0._default))
	call smatrix(2)%set_entry (2, [-1,-1], (1._default, 0._default))
	call smatrix(2)%set_entry (3, [-1,1], (1._default, 0._default))
	pol_f(2) = 1._default

	call beam_data%init_sqrts (sqrts, flv, smatrix, pol_f)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Semi-polarized scattering, massless bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([22,22], model)

	call smatrix(1)%init (2, 0)
	pol_f(1) = 0._default

	call smatrix(2)%init (2, 1)
	call smatrix(2)%set_entry (1, [1,1], (1._default, 0._default))
	pol_f(2) = 1._default

	call beam_data%init_sqrts (sqrts, flv, smatrix, pol_f)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Semi-polarized scattering, massive bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([24,-24], model)

	call smatrix(1)%init (2, 0)
	pol_f(1) = 0._default

	call smatrix(2)%init (2, 1)
	call smatrix(2)%set_entry (1, [0,0], (1._default, 0._default))
	pol_f(2) = 1._default

	call beam_data%init_sqrts (sqrts, flv, smatrix, pol_f)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized decay, massive boson"
	write (u, "(A)")

	call reset_interaction_counter ()
	call flv(1)%init (23, model)

	call beam_data%init_decay (flv(1:1))
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)

	write (u, "(A)")
	write (u, "(A)") "* Polarized decay, massive boson"
	write (u, "(A)")

	call reset_interaction_counter ()
	call flv(1)%init (23, model)
	call smatrix(1)%init (2, 1)
	call smatrix(1)%set_entry (1, [0,0], (1._default, 0._default))
	pol_f(1) = 0.4_default

	call beam_data%init_decay (flv(1:1), smatrix(1:1), pol_f(1:1))
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)

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

	call beam_final (beam)
	call beam_data%final ()

	call model%final ()

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

	end subroutine beam_1

	@ %def beam_1
	@ Test advanced beam setup.
	<<Beams: execute tests>>=
	call test (beam_2, "beam_2", &
	"beam initialization", &
	u, results)
	<<Beams: test declarations>>=
	public :: beam_2
	<<Beams: tests>>=
	subroutine beam_2 (u)
	integer, intent(in) :: u
	type(beam_data_t), target :: beam_data
	type(beam_t) :: beam
	real(default) :: sqrts
	type(flavor_t), dimension(2) :: flv
	integer, dimension(0) :: no_records
	type(beam_structure_t) :: beam_structure
	type(model_data_t), target :: model

	write (u, "(A)") "* Test output: beam_2"
	write (u, "(A)") "* Purpose: transfer beam polarization using &
	&beam structure"
	write (u, "(A)")

	write (u, "(A)") "* Reading model file"
	write (u, "(A)")

	call model%init_sm_test ()

	write (u, "(A)") "* Unpolarized scattering, massless fermions"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([1,-1], model)
	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%final_pol ()

	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)

	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized scattering, massless bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([22,22], model)

	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%final_pol ()

	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)

	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized scattering, massive bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([24,-24], model)

	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%final_pol ()

	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)

	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Polarized scattering, massless fermions"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([1,-1], model)
	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%init_pol (2)

	call beam_structure%init_smatrix (1, 1)
	call beam_structure%set_sentry (1, 1, [1,1], (1._default, 0._default))

	call beam_structure%init_smatrix (2, 3)
	call beam_structure%set_sentry (2, 1, [1,1], (1._default, 0._default))
	call beam_structure%set_sentry (2, 2, [-1,-1], (1._default, 0._default))
	call beam_structure%set_sentry (2, 3, [-1,1], (1._default, 0._default))

	call beam_structure%set_pol_f ([0.5_default, 1._default])
	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)
	write (u, *)

	call beam_init (beam, beam_data)
	call beam_write (beam, u)

	call beam_final (beam)
	call beam_data%final ()
	call beam_structure%final_pol ()
	call beam_structure%final_sf ()

	write (u, "(A)")
	write (u, "(A)") "* Semi-polarized scattering, massless bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([22,22], model)

	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%init_pol (2)

	call beam_structure%init_smatrix (1, 0)

	call beam_structure%init_smatrix (2, 1)
	call beam_structure%set_sentry (2, 1, [1,1], (1._default, 0._default))

	call beam_structure%set_pol_f ([0._default, 1._default])
	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)

	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Semi-polarized scattering, massive bosons"
	write (u, "(A)")

	call reset_interaction_counter ()
	sqrts = 500
	call flv%init ([24,-24], model)

	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%init_pol (2)

	call beam_structure%init_smatrix (1, 0)

	call beam_structure%init_smatrix (2, 1)
	call beam_structure%set_sentry (2, 1, [0,0], (1._default, 0._default))
	call beam_structure%write (u)

	write (u, "(A)")
	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)

	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)
	call beam_final (beam)
	call beam_data%final ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized decay, massive boson"
	write (u, "(A)")

	call reset_interaction_counter ()
	call flv(1)%init (23, model)

	call beam_structure%init_sf ([flv(1)%get_name ()], no_records)
	call beam_structure%final_pol ()
	call beam_structure%write (u)

	write (u, "(A)")
	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)

	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)

	write (u, "(A)")
	write (u, "(A)") "* Polarized decay, massive boson"
	write (u, "(A)")

	call reset_interaction_counter ()
	call flv(1)%init (23, model)
	call beam_structure%init_sf ([flv(1)%get_name ()], no_records)

	call beam_structure%init_pol (1)

	call beam_structure%init_smatrix (1, 1)
	call beam_structure%set_sentry (1, 1, [0,0], (1._default, 0._default))
	call beam_structure%set_pol_f ([0.4_default])
	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, sqrts, model)
	call beam_data%write (u)
	write (u, "(A)")
	call beam_init (beam, beam_data)
	call beam_write (beam, u)

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

	call beam_final (beam)
	call beam_data%final ()

	call model%final ()

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

	end subroutine beam_2

	@ %def beam_2
	@ Test advanced beam setup, completely arbitrary momenta.
	<<Beams: execute tests>>=
	call test (beam_3, "beam_3", &
	"generic beam momenta", &
	u, results)
	<<Beams: test declarations>>=
	public :: beam_3
	<<Beams: tests>>=
	subroutine beam_3 (u)
	integer, intent(in) :: u
	type(beam_data_t), target :: beam_data
	type(beam_t) :: beam
	type(flavor_t), dimension(2) :: flv
	integer, dimension(0) :: no_records
	type(model_data_t), target :: model
	type(beam_structure_t) :: beam_structure
	type(vector3_t), dimension(2) :: p3
	type(vector4_t), dimension(2) :: p

	write (u, "(A)") "* Test output: beam_3"
	write (u, "(A)") "* Purpose: set up beams with generic momenta"
	write (u, "(A)")

	write (u, "(A)") "* Reading model file"
	write (u, "(A)")

	call reset_interaction_counter ()

	call model%init_sm_test ()

	write (u, "(A)") "* 1: Scattering process"
	write (u, "(A)")

	call flv%init ([2212,2212], model)

	p3(1) = vector3_moving ([5._default, 0._default, 10._default])
	p3(2) = -vector3_moving ([1._default, 1._default, -10._default])

	call beam_structure%init_sf (flv%get_name (), no_records)
	call beam_structure%set_momentum (p3 ** 1)
	call beam_structure%set_theta (polar_angle (p3))
	call beam_structure%set_phi (azimuthal_angle (p3))
	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, 0._default, model)
	call pacify (beam_data%l_cm_to_lab, 1e-20_default)
	call beam_data%compute_md5sum ()
	call beam_data%write (u, verbose = .true.)
	write (u, *)

	write (u, "(1x,A)") "Beam momenta reconstructed from LT:"
	p = beam_data%L_cm_to_lab * beam_data%p_cm
	call pacify (p, 1e-12_default)
	call vector4_write (p(1), u)
	call vector4_write (p(2), u)
	write (u, "(A)")

	call beam_init (beam, beam_data)
	call beam_write (beam, u)

	call beam_final (beam)
	call beam_data%final ()
	call beam_structure%final_sf ()
	call beam_structure%final_mom ()

	write (u, "(A)")
	write (u, "(A)") "* 2: Decay"
	write (u, "(A)")

	call flv(1)%init (23, model)
	p3(1) = vector3_moving ([10._default, 5._default, 50._default])

	call beam_structure%init_sf ([flv(1)%get_name ()], no_records)
	call beam_structure%set_momentum ([p3(1) ** 1])
	call beam_structure%set_theta ([polar_angle (p3(1))])
	call beam_structure%set_phi ([azimuthal_angle (p3(1))])
	call beam_structure%write (u)
	write (u, *)

	call beam_data%init_structure (beam_structure, 0._default, model)
	call beam_data%write (u, verbose = .true.)
	write (u, "(A)")

	write (u, "(1x,A)") "Beam momentum reconstructed from LT:"
	p(1) = beam_data%L_cm_to_lab * beam_data%p_cm(1)
	call pacify (p(1), 1e-12_default)
	call vector4_write (p(1), u)
	write (u, "(A)")

	call beam_init (beam, beam_data)
	call beam_write (beam, u)

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

	call beam_final (beam)
	call beam_data%final ()
	call beam_structure%final_sf ()
	call beam_structure%final_mom ()

	call model%final ()

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

	end subroutine beam_3

	@ %def beam_3
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Tools}

	This module contains auxiliary procedures that can be accessed by the
	structure function code.

	<<[[sf_aux.f90]]>>=
	<<File header>>

	module sf_aux

	<<Use kinds>>
	use constants, only: twopi
	use lorentz

	<<Standard module head>>

	<<SF aux: public>>

	<<SF aux: parameters>>

	<<SF aux: types>>

	interface
	<<SF aux: sub interfaces>>
	end interface

	end module sf_aux

	@ %def sf_aux
	@
	<<[[sf_aux_sub.f90]]>>=
	<<File header>>

	submodule (sf_aux) sf_aux_s

	use io_units
	use numeric_utils

	implicit none

	contains

	<<SF aux: procedures>>

	end submodule sf_aux_s

	@ %def sf_aux_s
	@
	\subsection{Momentum splitting}
	Let us consider first an incoming parton with momentum $k$ and
	invariant mass squared $s=k^2$ that splits into two partons with
	momenta $q,p$ and invariant masses $t=q^2$ and $u=p^2$. (This is an
	abuse of the Mandelstam notation. $t$ is actually the momentum
	transfer, assuming that $p$ is radiated and $q$ initiates the hard
	process.) The energy is split among the partons such that if $E=k^0$,
	we have $q^0 = xE$ and $p^0=\bar x E$, where $\bar x\equiv 1-x$.

	We define the angle $\theta$ as the polar angle of $p$ w.r.t.\ the
	momentum axis of the incoming momentum $k$. Ignoring azimuthal angle,
	we can write the four-momenta in the basis $(E,p_T,p_L)$ as
	\begin{equation}
	k =
	\begin{pmatrix}
	E \\ 0 \\ p
	\end{pmatrix},
	\qquad
	p =
	\begin{pmatrix}
	\bar x E \\ \bar x\bar p\sin\theta \\ \bar x\bar p\cos\theta
	\end{pmatrix},
	\qquad
	q =
	\begin{pmatrix}
	x E \\ -\bar x\bar p\sin\theta \\ p - \bar x\bar p\cos\theta
	\end{pmatrix},
	\end{equation}
	where the first two mass-shell conditions are
	\begin{equation}
	p^2 = E^2 - s,
	\qquad
	\bar p^2 = E^2 - \frac{u}{\bar x^2}.
	\end{equation}
	The second condition implies that, for positive $u$, $\bar x^2 >
	u/E^2$, or equivalently
	\begin{equation}
	x < 1 - \sqrt{u} / E.
	\end{equation}

	We are interested in the third mass-shell conditions: $s$ and $u$ are
	fixed, so we need $t$ as a function of $\cos\theta$:
	\begin{equation}
	t = -2\bar x \left(E^2 - p\bar p\cos\theta\right) + s + u.
	\end{equation}
	Solving for $\cos\theta$, we get
	\begin{equation}
	\cos\theta = \frac{2\bar x E^2 + t - s - u}{2\bar x p\bar p}.
	\end{equation}
	We can compute $\sin\theta$ numerically as
	$\sin^2\theta=1-\cos^2\theta$, but it is important to reexpress this
	in view of numerical stability. To this end, we first determine the
	bounds for $t$. The cosine must be between $-1$ and $1$, so the
	bounds are
	\begin{align}
	t_0 &= -2\bar x\left(E^2 + p\bar p\right) + s + u,
	\\
	t_1 &= -2\bar x\left(E^2 - p\bar p\right) + s + u.
	\end{align}
	Computing $\sin^2\theta$ from $\cos\theta$ above, we observe that the
	numerator is a quadratic polynomial in $t$ which has the zeros $t_0$
	and $t_1$, while the common denominator is given by $(2\bar x p\bar
	p)^2$. Hence, we can write
	\begin{equation}
	\sin^2\theta = -\frac{(t - t_0)(t - t_1)}{(2\bar x p\bar p)^2}
	\qquad\text{and}\qquad
	\cos\theta = \frac{(t-t_0) + (t-t_1)}{4\bar x p\bar p},
	\end{equation}
	which is free of large cancellations near $t=t_0$ or $t=t_1$.

	If all is massless, i.e., $s=u=0$, this simplifies to
	\begin{align}
	t_0 &= -4\bar x E^2,
	&
	t_1 &= 0,
	\\
	\sin^2\theta &= -\frac{t}{\bar x E^2}
	\left(1 + \frac{t}{4\bar x E^2}\right),
	&
	\cos\theta &= 1 + \frac{t}{2\bar x E^2}.
	\end{align}

	Here is the implementation. First, we define a container for the
	kinematical integration limits and some further data.

	Note: contents are public only for easy access in unit test.
	<<SF aux: public>>=
	public :: splitting_data_t
	<<SF aux: types>>=
	type :: splitting_data_t
	! private
	logical :: collinear = .false.
	real(default) :: x0 = 0
	real(default) :: x1
	real(default) :: t0
	real(default) :: t1
	real(default) :: phi0 = 0
	real(default) :: phi1 = twopi
	real(default) :: E, p, s, u, m2
	real(default) :: x, xb, pb
	real(default) :: t = 0
	real(default) :: phi = 0
	contains
	<<SF aux: splitting data: TBP>>
	end type splitting_data_t

	@ %def splitting_data_t
	@ I/O for debugging:
	<<SF aux: splitting data: TBP>>=
	procedure :: write => splitting_data_write
	<<SF aux: sub interfaces>>=
	module subroutine splitting_data_write (d, unit)
	class(splitting_data_t), intent(in) :: d
	integer, intent(in), optional :: unit
	end subroutine splitting_data_write
	<<SF aux: procedures>>=
	module subroutine splitting_data_write (d, unit)
	class(splitting_data_t), intent(in) :: d
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A)") "Splitting data:"
	write (u, "(2x,A,L1)") "collinear = ", d%collinear
	1 format (2x,A,1x,ES15.8)
	write (u, 1) "x0 =", d%x0
	write (u, 1) "x =", d%x
	write (u, 1) "xb =", d%xb
	write (u, 1) "x1 =", d%x1
	write (u, 1) "t0 =", d%t0
	write (u, 1) "t =", d%t
	write (u, 1) "t1 =", d%t1
	write (u, 1) "phi0 =", d%phi0
	write (u, 1) "phi =", d%phi
	write (u, 1) "phi1 =", d%phi1
	write (u, 1) "E =", d%E
	write (u, 1) "p =", d%p
	write (u, 1) "pb =", d%pb
	write (u, 1) "s =", d%s
	write (u, 1) "u =", d%u
	write (u, 1) "m2 =", d%m2
	end subroutine splitting_data_write

	@ %def splitting_data_write
	@
	\subsection{Constant data}
	This is the initializer for the data. The input consists of the
	incoming momentum, its invariant mass squared, and the invariant mass
	squared of the radiated particle. $m2$ is the \emph{physical} mass
	squared of the outgoing particle. The $t$ bounds depend on the chosen $x$
	value and cannot be determined yet.
	<<SF aux: splitting data: TBP>>=
	procedure :: init => splitting_data_init
	<<SF aux: sub interfaces>>=
	module subroutine splitting_data_init (d, k, mk2, mr2, mo2, collinear)
	class(splitting_data_t), intent(out) :: d
	type(vector4_t), intent(in) :: k
	real(default), intent(in) :: mk2, mr2, mo2
	logical, intent(in), optional :: collinear
	end subroutine splitting_data_init
	<<SF aux: procedures>>=
	module subroutine splitting_data_init (d, k, mk2, mr2, mo2, collinear)
	class(splitting_data_t), intent(out) :: d
	type(vector4_t), intent(in) :: k
	real(default), intent(in) :: mk2, mr2, mo2
	logical, intent(in), optional :: collinear
	if (present (collinear)) d%collinear = collinear
	d%E = energy (k)
	d%x1 = 1 - sqrt (max (mr2, 0._default)) / d%E
	d%p = sqrt (d%E**2 - mk2)
	d%s = mk2
	d%u = mr2
	d%m2 = mo2
	end subroutine splitting_data_init

	@ %def splitting_data_init
	@ Retrieve the $x$ bounds, if needed for $x$ sampling. Generating an
	$x$ value is done by the caller, since this is the part that depends
	on the nature of the structure function.
	<<SF aux: splitting data: TBP>>=
	procedure :: get_x_bounds => splitting_get_x_bounds
	<<SF aux: sub interfaces>>=
	module function splitting_get_x_bounds (d) result (x)
	class(splitting_data_t), intent(in) :: d
	real(default), dimension(2) :: x
	end function splitting_get_x_bounds
	<<SF aux: procedures>>=
	module function splitting_get_x_bounds (d) result (x)
	class(splitting_data_t), intent(in) :: d
	real(default), dimension(2) :: x
	x = [ d%x0, d%x1 ]
	end function splitting_get_x_bounds

	@ %def splitting_get_x_bounds
	@ Now set the momentum fraction and compute $t_0$ and $t_1$.

	[The calculation of $t_1$ is subject to numerical problems. The exact
	formula is ($s=m_i^2$, $u=m_r^2$)
	\begin{equation}
	t_1 = -2\bar x E^2 + m_i^2 + m_r^2
	+ 2\bar x \sqrt{E^2-m_i^2}\,\sqrt{E^2 - m_r^2/\bar x^2}.
	\end{equation}
	The structure-function paradigm is useful only if $E\gg m_i,m_r$. In
	a Taylor expansion for large $E$, the leading term cancels. The
	expansion of the square roots (to subleading order) yields
	\begin{equation}
	t_1 = xm_i^2 - \frac{x}{\bar x}m_r^2.
	\end{equation}
	There are two cases of interest: $m_i=m_o$ and $m_r=0$,
	\begin{equation}
	t_1 = xm_o^2
	\end{equation}
	and $m_i=m_r$ and $m_o=0$,
	\begin{equation}
	t_1 = -\frac{x^2}{\bar x}m_i^2.
	\end{equation}
	In both cases, $t_1\leq m_o^2$.]

	That said, it turns out that taking the $t_1$ evaluation at face value
	leads to less problems than the approximation. We express the angles
	in terms of $t-t_0$ and $t-t_1$. Numerical noise in $t_1$ can then be
	tolerated.
	<<SF aux: splitting data: TBP>>=
	procedure :: set_t_bounds => splitting_set_t_bounds
	<<SF aux: sub interfaces>>=
	elemental module subroutine splitting_set_t_bounds (d, x, xb)
	class(splitting_data_t), intent(inout) :: d
	real(default), intent(in), optional :: x, xb
	end subroutine splitting_set_t_bounds
	<<SF aux: procedures>>=
	elemental module subroutine splitting_set_t_bounds (d, x, xb)
	class(splitting_data_t), intent(inout) :: d
	real(default), intent(in), optional :: x, xb
	real(default) :: tp, tm
	if (present (x)) d%x = x
	if (present (xb)) d%xb = xb
	if (vanishes (d%u)) then
	d%pb = d%E
	else
	if (.not. vanishes (d%xb)) then
	d%pb = sqrt (max (d%E2 - d%u / d%xb2, 0._default))
	else
	d%pb = 0
	end if
	end if
	tp = -2 * d%xb * d%E**2 + d%s + d%u
	tm = -2 * d%xb * d%p * d%pb
	d%t0 = tp + tm
	d%t1 = tp - tm
	d%t = d%t1
	end subroutine splitting_set_t_bounds

	@ %def splitting_set_t_bounds
	@
	\subsection{Sampling recoil}
	Compute a value for the momentum transfer $t$, using a random number
	$r$. We assume a logarithmic distribution for $t-m^2$, corresponding
	to the propagator $1/(t-m^2)$ with the physical mass $m$ for the
	outgoing particle. Optionally, we can narrow the kinematical bounds.

	If all three masses in the splitting vanish, the upper limit for $t$
	is zero. In that case, the $t$ value is set to zero and the splitting
	will be collinear.
	<<SF aux: splitting data: TBP>>=
	procedure :: sample_t => splitting_sample_t
	<<SF aux: sub interfaces>>=
	module subroutine splitting_sample_t (d, r, t0, t1)
	class(splitting_data_t), intent(inout) :: d
	real(default), intent(in) :: r
	real(default), intent(in), optional :: t0, t1
	end subroutine splitting_sample_t
	<<SF aux: procedures>>=
	module subroutine splitting_sample_t (d, r, t0, t1)
	class(splitting_data_t), intent(inout) :: d
	real(default), intent(in) :: r
	real(default), intent(in), optional :: t0, t1
	real(default) :: tt0, tt1, tt0m, tt1m
	if (d%collinear) then
	d%t = d%t1
	else
	tt0 = d%t0; if (present (t0)) tt0 = max (t0, tt0)
	tt1 = d%t1; if (present (t1)) tt1 = min (t1, tt1)
	tt0m = tt0 - d%m2
	tt1m = tt1 - d%m2
	if (tt0m < 0 .and. tt1m < 0 .and. abs(tt0m) > &
	epsilon(tt0m) .and. abs(tt1m) > epsilon(tt0m)) then
	d%t = d%m2 + tt0m * exp (r * log (tt1m / tt0m))
	else
	d%t = tt1
	end if
	end if
	end subroutine splitting_sample_t

	@ %def splitting_sample_t
	@ The inverse operation: Given $t$, we recover the value of $r$ that
	would have produced this value.
	<<SF aux: splitting data: TBP>>=
	procedure :: inverse_t => splitting_inverse_t
	<<SF aux: sub interfaces>>=
	module subroutine splitting_inverse_t (d, r, t0, t1)
	class(splitting_data_t), intent(in) :: d
	real(default), intent(out) :: r
	real(default), intent(in), optional :: t0, t1
	end subroutine splitting_inverse_t
	<<SF aux: procedures>>=
	module subroutine splitting_inverse_t (d, r, t0, t1)
	class(splitting_data_t), intent(in) :: d
	real(default), intent(out) :: r
	real(default), intent(in), optional :: t0, t1
	real(default) :: tt0, tt1, tt0m, tt1m
	if (d%collinear) then
	r = 0
	else
	tt0 = d%t0; if (present (t0)) tt0 = max (t0, tt0)
	tt1 = d%t1; if (present (t1)) tt1 = min (t1, tt1)
	tt0m = tt0 - d%m2
	tt1m = tt1 - d%m2
	if (tt0m < 0 .and. tt1m < 0) then
	r = log ((d%t - d%m2) / tt0m) / log (tt1m / tt0m)
	else
	r = 0
	end if
	end if
	end subroutine splitting_inverse_t

	@ %def splitting_inverse_t
	@ This is trivial, but provided for convenience:
	<<SF aux: splitting data: TBP>>=
	procedure :: sample_phi => splitting_sample_phi
	<<SF aux: sub interfaces>>=
	module subroutine splitting_sample_phi (d, r)
	class(splitting_data_t), intent(inout) :: d
	real(default), intent(in) :: r
	end subroutine splitting_sample_phi
	<<SF aux: procedures>>=
	module subroutine splitting_sample_phi (d, r)
	class(splitting_data_t), intent(inout) :: d
	real(default), intent(in) :: r
	if (d%collinear) then
	d%phi = 0
	else
	d%phi = (1-r) * d%phi0 + r * d%phi1
	end if
	end subroutine splitting_sample_phi

	@ %def splitting_sample_phi
	@ Inverse:
	<<SF aux: splitting data: TBP>>=
	procedure :: inverse_phi => splitting_inverse_phi
	<<SF aux: sub interfaces>>=
	module subroutine splitting_inverse_phi (d, r)
	class(splitting_data_t), intent(in) :: d
	real(default), intent(out) :: r
	end subroutine splitting_inverse_phi
	<<SF aux: procedures>>=
	module subroutine splitting_inverse_phi (d, r)
	class(splitting_data_t), intent(in) :: d
	real(default), intent(out) :: r
	if (d%collinear) then
	r = 0
	else
	r = (d%phi - d%phi0) / (d%phi1 - d%phi0)
	end if
	end subroutine splitting_inverse_phi

	@ %def splitting_inverse_phi
	@
	\subsection{Splitting}
	In this function, we actually perform the splitting. The incoming momentum
	$k$ is split into (if no recoil) $q_1=(1-x)k$ and $q_2=xk$.

	Apart from the splitting data, we need the incoming momentum $k$, the momentum
	transfer $t$, and the azimuthal angle $\phi$. The momentum fraction $x$ is
	already known here.

	Alternatively, we can split without recoil. The azimuthal angle is
	irrelevant, and the momentum transfer is always equal to the upper
	limit $t_1$, so the polar angle is zero. Obviously, if there are
	nonzero masses it is not possible to keep both energy-momentum
	conservation and at the same time all particles on shell. We choose
	for dropping the on-shell condition here.
	<<SF aux: splitting data: TBP>>=
	procedure :: split_momentum => splitting_split_momentum
	<<SF aux: sub interfaces>>=
	module function splitting_split_momentum (d, k) result (q)
	class(splitting_data_t), intent(in) :: d
	type(vector4_t), dimension(2) :: q
	type(vector4_t), intent(in) :: k
	end function splitting_split_momentum
	<<SF aux: procedures>>=
	module function splitting_split_momentum (d, k) result (q)
	class(splitting_data_t), intent(in) :: d
	type(vector4_t), dimension(2) :: q
	type(vector4_t), intent(in) :: k
	real(default) :: st2, ct2, st, ct, cp, sp
	type(lorentz_transformation_t) :: rot
	real(default) :: tt0, tt1, den
	type(vector3_t) :: kk, q1, q2
	if (d%collinear) then
	if (vanishes (d%s) .and. vanishes(d%u)) then
	q(1) = d%xb * k
	q(2) = d%x * k
	else
	kk = space_part (k)
	q1 = d%xb * (d%pb / d%p) * kk
	q2 = kk - q1
	q(1) = vector4_moving (d%xb * d%E, q1)
	q(2) = vector4_moving (d%x * d%E, q2)
	end if
	else
	den = 2 * d%xb * d%p * d%pb
	tt0 = max (d%t - d%t0, 0._default)
	tt1 = min (d%t - d%t1, 0._default)
	if (den**2 <= epsilon(den)) then
	st2 = 0
	else
	st2 = - (tt0 * tt1) / den ** 2
	end if
	if (st2 > 1) then
	st2 = 1
	end if
	ct2 = 1 - st2
	st = sqrt (max (st2, 0._default))
	ct = sqrt (max (ct2, 0._default))
	if ((d%t - d%t0 + d%t - d%t1) < 0) then
	ct = - ct
	end if
	sp = sin (d%phi)
	cp = cos (d%phi)
	rot = rotation_to_2nd (3, space_part (k))
	q1 = vector3_moving (d%xb * d%pb * [st * cp, st * sp, ct])
	q2 = vector3_moving (d%p, 3) - q1
	q(1) = rot * vector4_moving (d%xb * d%E, q1)
	q(2) = rot * vector4_moving (d%x * d%E, q2)
	end if
	end function splitting_split_momentum

	@ %def splitting_split_momentum
	@
	Momenta generated by splitting will in general be off-shell. They are
	on-shell only if they are collinear and massless. This subroutine
	puts them on shell by brute force, violating either momentum or energy
	conservation. The direction of three-momentum is always retained.

	If the energy is below mass shell, we return a zero momentum.
	<<SF aux: parameters>>=
	integer, parameter, public :: KEEP_ENERGY = 0, KEEP_MOMENTUM = 1
	@ %def KEEP_ENERGY KEEP_MOMENTUM
	<<SF aux: public>>=
	public :: on_shell
	<<SF aux: sub interfaces>>=
	elemental module subroutine on_shell (p, m2, keep)
	type(vector4_t), intent(inout) :: p
	real(default), intent(in) :: m2
	integer, intent(in) :: keep
	end subroutine on_shell
	<<SF aux: procedures>>=
	elemental module subroutine on_shell (p, m2, keep)
	type(vector4_t), intent(inout) :: p
	real(default), intent(in) :: m2
	integer, intent(in) :: keep
	real(default) :: E, E2, pn
	select case (keep)
	case (KEEP_ENERGY)
	E = energy (p)
	E2 = E ** 2
	if (E2 >= m2) then
	pn = sqrt (E2 - m2)
	p = vector4_moving (E, pn * direction (space_part (p)))
	else
	p = vector4_null
	end if
	case (KEEP_MOMENTUM)
	E = sqrt (space_part (p) ** 2 + m2)
	p = vector4_moving (E, space_part (p))
	end select
	end subroutine on_shell

	@ %def on_shell
	@
	\subsection{Recovering the splitting}
	This is the inverse problem. We have on-shell momenta and want to
	deduce the splitting parameters $x$, $t$, and $\phi$.

	Update 2018-08-22: As a true inverse to [[splitting_split_momentum]], we now use
	not just a single momentum [[q2]] as before, but the momentum pair [[q1]], [[q2]]
	for recovering $x$ and $\bar x$ separately. If $x$ happens to be
	close to $1$, we would completely lose the tiny $\bar x$ value,
	otherwise, and thus get a meaningless result.
	<<SF aux: splitting data: TBP>>=
	procedure :: recover => splitting_recover
	<<SF aux: sub interfaces>>=
	module subroutine splitting_recover (d, k, q, keep)
	class(splitting_data_t), intent(inout) :: d
	type(vector4_t), intent(in) :: k
	type(vector4_t), dimension(2), intent(in) :: q
	integer, intent(in) :: keep
	end subroutine splitting_recover
	<<SF aux: procedures>>=
	module subroutine splitting_recover (d, k, q, keep)
	class(splitting_data_t), intent(inout) :: d
	type(vector4_t), intent(in) :: k
	type(vector4_t), dimension(2), intent(in) :: q
	integer, intent(in) :: keep
	type(lorentz_transformation_t) :: rot
	type(vector4_t) :: k0
	type(vector4_t), dimension(2) :: q0
	real(default) :: p1, p2, p3, pt2, pp2, pl
	real(default) :: aux, den, norm
	real(default) :: st2, ct2, ct
	rot = inverse (rotation_to_2nd (3, space_part (k)))
	q0 = rot * q
	p1 = vector4_get_component (q0(2), 1)
	p2 = vector4_get_component (q0(2), 2)
	p3 = vector4_get_component (q0(2), 3)
	pt2 = p1 2 + p2 2
	pp2 = p1 2 + p2 2 + p3 ** 2
	pl = abs (p3)
	k0 = vector4_moving (d%E, d%p, 3)
	select case (keep)
	case (KEEP_ENERGY)
	d%x = energy (q0(2)) / d%E
	d%xb = energy (q0(1)) / d%E
	call d%set_t_bounds ()
	if (.not. d%collinear) then
	aux = (d%xb * d%pb) ** 2 * pp2 - d%p ** 2 * pt2
	den = d%p ** 2 - (d%xb * d%pb) ** 2
	if (aux >= 0 .and. den > 0) then
	norm = (d%p * pl + sqrt (aux)) / den
	else
	norm = 1
	end if
	end if
	case (KEEP_MOMENTUM)
	d%xb = sqrt (space_part (q0(1)) ** 2 + d%u) / d%E
	d%x = 1 - d%xb
	call d%set_t_bounds ()
	norm = 1
	end select
	if (d%collinear) then
	d%t = d%t1
	d%phi = 0
	else
	if ((d%xb * d%pb * norm)**2 < epsilon(d%xb)) then
	st2 = 1
	else
	st2 = pt2 / (d%xb * d%pb * norm ) ** 2
	end if
	if (st2 > 1) then
	st2 = 1
	end if
	ct2 = 1 - st2
	ct = sqrt (max (ct2, 0._default))
	if (.not. vanishes (1 + ct)) then
	d%t = d%t1 - 2 * d%xb * d%p * d%pb * st2 / (1 + ct)
	else
	d%t = d%t0
	end if
	if (.not. vanishes (p1) .or. .not. vanishes (p2)) then
	d%phi = atan2 (-p2, -p1)
	else
	d%phi = 0
	end if
	end if
	end subroutine splitting_recover

	@ %def splitting_recover
	@
	\subsection{Extract data}
	<<SF aux: splitting data: TBP>>=
	procedure :: get_x => splitting_get_x
	procedure :: get_xb => splitting_get_xb
	<<SF aux: sub interfaces>>=
	module function splitting_get_x (sd) result (x)
	class(splitting_data_t), intent(in) :: sd
	real(default) :: x
	end function splitting_get_x
	module function splitting_get_xb (sd) result (xb)
	class(splitting_data_t), intent(in) :: sd
	real(default) :: xb
	end function splitting_get_xb
	<<SF aux: procedures>>=
	module function splitting_get_x (sd) result (x)
	class(splitting_data_t), intent(in) :: sd
	real(default) :: x
	x = sd%x
	end function splitting_get_x

	module function splitting_get_xb (sd) result (xb)
	class(splitting_data_t), intent(in) :: sd
	real(default) :: xb
	xb = sd%xb
	end function splitting_get_xb

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

	module sf_aux_ut
	use unit_tests
	use sf_aux_uti

	<<Standard module head>>

	<<SF aux: public test>>

	contains

	<<SF aux: test driver>>

	end module sf_aux_ut
	@ %def sf_aux_ut
	@
	<<[[sf_aux_uti.f90]]>>=
	<<File header>>

	module sf_aux_uti

	<<Use kinds>>
	use numeric_utils, only: pacify
	use lorentz

	use sf_aux

	<<Standard module head>>

	<<SF aux: test declarations>>

	contains

	<<SF aux: tests>>

	end module sf_aux_uti
	@ %def sf_aux_ut
	@ API: driver for the unit tests below.
	<<SF aux: public test>>=
	public :: sf_aux_test
	<<SF aux: test driver>>=
	subroutine sf_aux_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF aux: execute tests>>
	end subroutine sf_aux_test

	@ %def sf_aux_test
	@
	\subsubsection{Momentum splitting: massless radiation}
	Compute momentum splitting for generic kinematics. It turns out that
	for $x=0.5$, where $t-m^2$ is the geometric mean between its upper and
	lower bounds (this can be directly seen from the logarithmic
	distribution in the function [[sample_t]] for $r \equiv x = 1 - x =
	0.5$), we arrive at an exact number $t=-0.15$ for the given
	input values.
	<<SF aux: execute tests>>=
	call test (sf_aux_1, "sf_aux_1", &
	"massless radiation", &
	u, results)
	<<SF aux: test declarations>>=
	public :: sf_aux_1
	<<SF aux: tests>>=
	subroutine sf_aux_1 (u)
	integer, intent(in) :: u
	type(splitting_data_t) :: sd
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q, q0
	real(default) :: E, mk, mp, mq
	real(default) :: x, r1, r2, r1o, r2o
	real(default) :: k2, q0_2, q1_2, q2_2

	write (u, "(A)") "* Test output: sf_aux_1"
	write (u, "(A)") "* Purpose: compute momentum splitting"
	write (u, "(A)") " (massless radiated particle)"
	write (u, "(A)")

	E = 1
	mk = 0.3_default
	mp = 0
	mq = mk

	k = vector4_moving (E, sqrt (E2 - mk2), 3)
	k2 = k ** 2; call pacify (k2, 1e-10_default)

	x = 0.6_default
	r1 = 0.5_default
	r2 = 0.125_default

	write (u, "(A)") "* (1) Non-collinear setup"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%sample_t (r1)
	call sd%sample_phi (r2)

	call sd%write (u)

	q = sd%split_momentum (k)
	q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
	q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: s"
	write (u, "(2(1x,F11.8))") sd%s, k2

	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") sd%t, q2_2

	write (u, "(A)") "Compare: u"
	write (u, "(2(1x,F11.8))") sd%u, q1_2

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)

	write (u, "(A)")
	write (u, "(A)") "Extract: x, 1-x"
	write (u, "(2(1x,F11.8))") sd%get_x (), sd%get_xb ()

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep energy)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_ENERGY)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q0_2 = q0(2) ** 2; call pacify (q0_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q0_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%recover (k, q0, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t


	call sd%inverse_t (r1o)

	write (u, "(A)") "Compare: r1"
	write (u, "(2(1x,F11.8))") r1, r1o

	call sd%inverse_phi (r2o)

	write (u, "(A)") "Compare: r2"
	write (u, "(2(1x,F11.8))") r2, r2o

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep momentum)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_MOMENTUM)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q0_2 = q0(2) ** 2; call pacify (q0_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q0_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%recover (k, q0, KEEP_MOMENTUM)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	call sd%inverse_t (r1o)

	write (u, "(A)") "Compare: r1"
	write (u, "(2(1x,F11.8))") r1, r1o

	call sd%inverse_phi (r2o)

	write (u, "(A)") "Compare: r2"
	write (u, "(2(1x,F11.8))") r2, r2o

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* (2) Collinear setup"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, 1 - x)

	call sd%write (u)

	q = sd%split_momentum (k)
	q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
	q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: s"
	write (u, "(2(1x,F11.8))") sd%s, k2

	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") sd%t, q2_2

	write (u, "(A)") "Compare: u"
	write (u, "(2(1x,F11.8))") sd%u, q1_2

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep energy)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_ENERGY)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q0_2 = q0(2) ** 2; call pacify (q0_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q0_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%recover (k, q0, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep momentum)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_MOMENTUM)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q0_2 = q0(2) ** 2; call pacify (q0_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q0_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%recover (k, q0, KEEP_MOMENTUM)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	write (u, "(A)")
	call sd%write (u)

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

	end subroutine sf_aux_1

	@ %def sf_aux_1
	@
	\subsubsection{Momentum splitting: massless parton}
	Compute momentum splitting for generic kinematics. It turns out that
	for $x=0.5$, where $t-m^2$ is the geometric mean between its upper and
	lower bounds, we arrive at an exact number $t=-0.36$ for the given
	input values.
	<<SF aux: execute tests>>=
	call test (sf_aux_2, "sf_aux_2", &
	"massless parton", &
	u, results)
	<<SF aux: test declarations>>=
	public :: sf_aux_2
	<<SF aux: tests>>=
	subroutine sf_aux_2 (u)
	integer, intent(in) :: u
	type(splitting_data_t) :: sd
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q, q0
	real(default) :: E, mk, mp, mq
	real(default) :: x, r1, r2, r1o, r2o
	real(default) :: k2, q02_2, q1_2, q2_2

	write (u, "(A)") "* Test output: sf_aux_2"
	write (u, "(A)") "* Purpose: compute momentum splitting"
	write (u, "(A)") " (massless outgoing particle)"
	write (u, "(A)")

	E = 1
	mk = 0.3_default
	mp = mk
	mq = 0

	k = vector4_moving (E, sqrt (E2 - mk2), 3)
	k2 = k ** 2; call pacify (k2, 1e-10_default)

	x = 0.6_default
	r1 = 0.5_default
	r2 = 0.125_default

	write (u, "(A)") "* (1) Non-collinear setup"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%sample_t (r1)
	call sd%sample_phi (r2)

	call sd%write (u)

	q = sd%split_momentum (k)
	q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
	q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: s"
	write (u, "(2(1x,F11.8))") sd%s, k2

	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") sd%t, q2_2

	write (u, "(A)") "Compare: u"
	write (u, "(2(1x,F11.8))") sd%u, q1_2

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep energy)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_ENERGY)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t


	call sd%inverse_t (r1o)

	write (u, "(A)") "Compare: r1"
	write (u, "(2(1x,F11.8))") r1, r1o

	call sd%inverse_phi (r2o)

	write (u, "(A)") "Compare: r2"
	write (u, "(2(1x,F11.8))") r2, r2o

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep momentum)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_MOMENTUM)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_MOMENTUM)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	call sd%inverse_t (r1o)

	write (u, "(A)") "Compare: r1"
	write (u, "(2(1x,F11.8))") r1, r1o

	call sd%inverse_phi (r2o)

	write (u, "(A)") "Compare: r2"
	write (u, "(2(1x,F11.8))") r2, r2o

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* (2) Collinear setup"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, 1 - x)

	call sd%write (u)

	q = sd%split_momentum (k)
	q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
	q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: s"
	write (u, "(2(1x,F11.8))") sd%s, k2

	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") sd%t, q2_2

	write (u, "(A)") "Compare: u"
	write (u, "(2(1x,F11.8))") sd%u, q1_2

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep energy)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_ENERGY)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep momentum)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_MOMENTUM)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_MOMENTUM)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	write (u, "(A)")
	call sd%write (u)

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

	end subroutine sf_aux_2

	@ %def sf_aux_2
	@
	\subsubsection{Momentum splitting: all massless}
	Compute momentum splitting for massless kinematics. In the non-collinear
	case, we need a lower cutoff for $\|t\|$, otherwise a logarithmic distribution
	is not possible.
	<<SF aux: execute tests>>=
	call test (sf_aux_3, "sf_aux_3", &
	"massless parton", &
	u, results)
	<<SF aux: test declarations>>=
	public :: sf_aux_3
	<<SF aux: tests>>=
	subroutine sf_aux_3 (u)
	integer, intent(in) :: u
	type(splitting_data_t) :: sd
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q, q0
	real(default) :: E, mk, mp, mq, qmin, qmax
	real(default) :: x, r1, r2, r1o, r2o
	real(default) :: k2, q02_2, q1_2, q2_2

	write (u, "(A)") "* Test output: sf_aux_3"
	write (u, "(A)") "* Purpose: compute momentum splitting"
	write (u, "(A)") " (all massless, q cuts)"
	write (u, "(A)")

	E = 1
	mk = 0
	mp = 0
	mq = 0
	qmin = 1e-2_default
	qmax = 1e0_default

	k = vector4_moving (E, sqrt (E2 - mk2), 3)
	k2 = k ** 2; call pacify (k2, 1e-10_default)

	x = 0.6_default
	r1 = 0.5_default
	r2 = 0.125_default

	write (u, "(A)") "* (1) Non-collinear setup"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%sample_t (r1, t1 = - qmin 2, t0 = - qmax 2)
	call sd%sample_phi (r2)

	call sd%write (u)

	q = sd%split_momentum (k)
	q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
	q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: s"
	write (u, "(2(1x,F11.8))") sd%s, k2

	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") sd%t, q2_2

	write (u, "(A)") "Compare: u"
	write (u, "(2(1x,F11.8))") sd%u, q1_2

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep energy)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_ENERGY)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t


	call sd%inverse_t (r1o, t1 = - qmin 2, t0 = - qmax 2)

	write (u, "(A)") "Compare: r1"
	write (u, "(2(1x,F11.8))") r1, r1o

	call sd%inverse_phi (r2o)

	write (u, "(A)") "Compare: r2"
	write (u, "(2(1x,F11.8))") r2, r2o

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep momentum)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_MOMENTUM)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_MOMENTUM)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	call sd%inverse_t (r1o, t1 = - qmin 2, t0 = - qmax 2)

	write (u, "(A)") "Compare: r1"
	write (u, "(2(1x,F11.8))") r1, r1o

	call sd%inverse_phi (r2o)

	write (u, "(A)") "Compare: r2"
	write (u, "(2(1x,F11.8))") r2, r2o

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* (2) Collinear setup"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, 1 - x)

	call sd%write (u)

	q = sd%split_momentum (k)
	q1_2 = q(1) ** 2; call pacify (q1_2, 1e-10_default)
	q2_2 = q(2) ** 2; call pacify (q2_2, 1e-10_default)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: s"
	write (u, "(2(1x,F11.8))") sd%s, k2

	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") sd%t, q2_2

	write (u, "(A)") "Compare: u"
	write (u, "(2(1x,F11.8))") sd%u, q1_2

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") sd%x, energy (q(2)) / energy (k)

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") sd%xb, energy (q(1)) / energy (k)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep energy)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_ENERGY)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Project on-shell (keep momentum)"

	q0 = q
	call on_shell (q0, [mp2, mq2], KEEP_MOMENTUM)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q0), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q0(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q0(2), u)
	write (u, "(A)")

	write (u, "(A)") "Compare: mo^2"
	q02_2 = q0(2) ** 2; call pacify (q02_2, 1e-10_default)
	write (u, "(2(1x,F11.8))") sd%m2, q02_2
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momentum"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2)
	call sd%set_t_bounds (x, 1 - x)
	call sd%recover (k, q0, KEEP_MOMENTUM)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x
	write (u, "(A)") "Compare: t"
	write (u, "(2(1x,F11.8))") q2_2, sd%t

	write (u, "(A)")
	call sd%write (u)

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

	end subroutine sf_aux_3

	@ %def sf_aux_3
	@
	\subsubsection{Endpoint stability}
	Compute momentum splitting for collinear kinematics close to both
	endpoints. In particular, check both directions $x\to$ momenta and
	momenta $\to x$.

	For purely massless collinear splitting, the [[KEEP_XXX]] flag is
	irrelevant. We choose [[KEEP_ENERGY]] here.
	<<SF aux: execute tests>>=
	call test (sf_aux_4, "sf_aux_4", &
	"endpoint numerics", &
	u, results)
	<<SF aux: test declarations>>=
	public :: sf_aux_4
	<<SF aux: tests>>=
	subroutine sf_aux_4 (u)
	integer, intent(in) :: u
	type(splitting_data_t) :: sd
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E, mk, mp, mq, qmin, qmax
	real(default) :: x, xb

	write (u, "(A)") "* Test output: sf_aux_4"
	write (u, "(A)") "* Purpose: compute massless collinear splitting near endpoint"

	E = 1
	mk = 0
	mp = 0
	mq = 0
	qmin = 1e-2_default
	qmax = 1e0_default

	k = vector4_moving (E, sqrt (E2 - mk2), 3)

	x = 0.1_default
	xb = 1 - x

	write (u, "(A)")
	write (u, "(A)") "* (1) Collinear setup, moderate kinematics"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, xb)

	call sd%write (u)

	q = sd%split_momentum (k)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momenta"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, xb)
	call sd%recover (k, q, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") xb, sd%xb

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* (2) Close to x=0"
	write (u, "(A)")

	x = 1e-9_default
	xb = 1 - x

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, xb)

	call sd%write (u)

	q = sd%split_momentum (k)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momenta"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, xb)
	call sd%recover (k, q, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") xb, sd%xb

	write (u, "(A)")
	call sd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* (3) Close to x=1"
	write (u, "(A)")

	xb = 1e-9_default
	x = 1 - xb

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, xb)

	call sd%write (u)

	q = sd%split_momentum (k)

	write (u, "(A)")
	write (u, "(A)") "Incoming momentum k ="
	call vector4_write (k, u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum sum p + q ="
	call vector4_write (sum (q), u)
	write (u, "(A)")
	write (u, "(A)") "Radiated momentum p ="
	call vector4_write (q(1), u)
	write (u, "(A)")
	write (u, "(A)") "Outgoing momentum q ="
	call vector4_write (q(2), u)
	write (u, "(A)")

	write (u, "(A)") "* Recover parameters from outgoing momenta"
	write (u, "(A)")

	call sd%init (k, mk2, mp2, mq**2, collinear = .true.)
	call sd%set_t_bounds (x, xb)
	call sd%recover (k, q, KEEP_ENERGY)

	write (u, "(A)") "Compare: x"
	write (u, "(2(1x,F11.8))") x, sd%x

	write (u, "(A)") "Compare: 1-x"
	write (u, "(2(1x,F11.8))") xb, sd%xb

	write (u, "(A)")
	call sd%write (u)

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

	end subroutine sf_aux_4

	@ %def sf_aux_4
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Mappings for structure functions}
	In this module, we provide a wrapper for useful mappings of the unit
	(hyper-)square that we can apply to a set of structure functions.

	In some cases it is useful, or even mandatory, to map the MC input
	parameters nontrivially onto a set of structure functions for the two
	beams. In all cases considered here, instead of $x_1,x_2,\ldots$ as
	parameters for the beams, we generate one parameter that is equal, or
	related to, the product $x_1x_2\cdots$ (so it directly corresponds to
	$\sqrt{s}$). The other parameters describe the distribution of energy
	(loss) between beams and radiations.
	<<[[sf_mappings.f90]]>>=
	<<File header>>

	module sf_mappings

	<<Use kinds>>
	use kinds, only: double

	<<Standard module head>>

	<<SF mappings: public>>

	<<SF mappings: parameters>>

	<<SF mappings: types>>

	<<SF mappings: interfaces>>

	interface
	<<SF mappings: sub interfaces>>
	end interface

	contains

	<<SF mappings: main procedures>>

	end module sf_mappings
	@ %def sf_mappings
	@
	<<[[sf_mappings_sub.f90]]>>=
	<<File header>>

	submodule (sf_mappings) sf_mappings_s

	use io_units
	use constants, only: pi, zero, one
	use numeric_utils
	use diagnostics

	implicit none

	contains

	<<SF mappings: procedures>>

	end submodule sf_mappings_s

	@ %def sf_mappings_s
	@
	\subsection{Base type}
	First, we define an abstract base type for the mapping. In all cases
	we need to store the indices of the parameters on which the mapping
	applies. Additional parameters can be stored in the extensions of
	this type.
	<<SF mappings: public>>=
	public :: sf_mapping_t
	<<SF mappings: types>>=
	type, abstract :: sf_mapping_t
	integer, dimension(:), allocatable :: i
	contains
	<<SF mappings: sf mapping: TBP>>
	end type sf_mapping_t

	@ %def sf_mapping_t
	@ The output routine is deferred:
	<<SF mappings: sf mapping: TBP>>=
	procedure (sf_mapping_write), deferred :: write
	<<SF mappings: interfaces>>=
	abstract interface
	subroutine sf_mapping_write (object, unit)
	import
	class(sf_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_mapping_write
	end interface

	@ %def sf_mapping_write
	@ Initializer for the base type. The array of parameter indices is
	allocated but initialized to zero.
	<<SF mappings: sf mapping: TBP>>=
	procedure :: base_init => sf_mapping_base_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_mapping_base_init (mapping, n_par)
	class(sf_mapping_t), intent(out) :: mapping
	integer, intent(in) :: n_par
	end subroutine sf_mapping_base_init
	<<SF mappings: procedures>>=
	module subroutine sf_mapping_base_init (mapping, n_par)
	class(sf_mapping_t), intent(out) :: mapping
	integer, intent(in) :: n_par
	allocate (mapping%i (n_par))
	mapping%i = 0
	end subroutine sf_mapping_base_init

	@ %def sf_mapping_base_init
	@ Set an index value.
	<<SF mappings: sf mapping: TBP>>=
	procedure :: set_index => sf_mapping_set_index
	<<SF mappings: sub interfaces>>=
	module subroutine sf_mapping_set_index (mapping, j, i)
	class(sf_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j, i
	end subroutine sf_mapping_set_index
	<<SF mappings: procedures>>=
	module subroutine sf_mapping_set_index (mapping, j, i)
	class(sf_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j, i
	mapping%i(j) = i
	end subroutine sf_mapping_set_index

	@ %def sf_mapping_set_index
	@ Retrieve an index value.
	<<SF mappings: sf mapping: TBP>>=
	procedure :: get_index => sf_mapping_get_index
	<<SF mappings: sub interfaces>>=
	module function sf_mapping_get_index (mapping, j) result (i)
	class(sf_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j
	integer :: i
	end function sf_mapping_get_index
	<<SF mappings: procedures>>=
	module function sf_mapping_get_index (mapping, j) result (i)
	class(sf_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j
	integer :: i
	i = mapping%i(j)
	end function sf_mapping_get_index

	@ %def sf_mapping_get_index
	@ Return the dimensionality, i.e., the number of parameters.
	<<SF mappings: sf mapping: TBP>>=
	procedure :: get_n_dim => sf_mapping_get_n_dim
	<<SF mappings: sub interfaces>>=
	module function sf_mapping_get_n_dim (mapping) result (n)
	class(sf_mapping_t), intent(in) :: mapping
	integer :: n
	end function sf_mapping_get_n_dim
	<<SF mappings: procedures>>=
	module function sf_mapping_get_n_dim (mapping) result (n)
	class(sf_mapping_t), intent(in) :: mapping
	integer :: n
	n = size (mapping%i)
	end function sf_mapping_get_n_dim

	@ %def sf_mapping_get_n_dim
	@ Computation: the values [[p]] are the input parameters, the values
	[[r]] are the output parameters. The values [[rb]] are defined as
	$\bar r = 1 - r$, but provided explicitly. They allow us to avoid
	numerical problems near $r=1$.

	The extra parameter [[x_free]]
	indicates that the total energy has already been renormalized by this
	factor. We have to take such a factor into account in a resonance or
	on-shell mapping.

	The Jacobian is [[f]]. We modify only
	the two parameters indicated by the indices [[i]].
	<<SF mappings: sf mapping: TBP>>=
	procedure (sf_mapping_compute), deferred :: compute
	<<SF mappings: interfaces>>=
	abstract interface
	subroutine sf_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	import
	class(sf_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_mapping_compute
	end interface

	@ %def sf_mapping_compute
	@ The inverse mapping. Use [[r]] and/or [[rb]] to reconstruct [[p]]
	and also compute [[f]].
	<<SF mappings: sf mapping: TBP>>=
	procedure (sf_mapping_inverse), deferred :: inverse
	<<SF mappings: interfaces>>=
	abstract interface
	subroutine sf_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	import
	class(sf_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_mapping_inverse
	end interface

	@ %def sf_mapping_inverse
	@
	\subsection{Methods for self-tests}
	This is a shorthand for: inject parameters, compute the mapping,
	display results, compute the inverse, display again. We provide an
	output format for the parameters and, optionally, a different output
	format for the Jacobians.
	<<SF mappings: sf mapping: TBP>>=
	procedure :: check => sf_mapping_check
	<<SF mappings: sub interfaces>>=
	module subroutine sf_mapping_check (mapping, u, p_in, pb_in, fmt_p, fmt_f)
	class(sf_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: u
	real(default), dimension(:), intent(in) :: p_in, pb_in
	character(*), intent(in) :: fmt_p
	character(*), intent(in), optional :: fmt_f
	end subroutine sf_mapping_check
	<<SF mappings: procedures>>=
	module subroutine sf_mapping_check (mapping, u, p_in, pb_in, fmt_p, fmt_f)
	class(sf_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: u
	real(default), dimension(:), intent(in) :: p_in, pb_in
	character(*), intent(in) :: fmt_p
	character(*), intent(in), optional :: fmt_f
	real(default), dimension(size(p_in)) :: p, pb, r, rb
	real(default) :: f, tolerance
	tolerance = 1.5E-17_default
	p = p_in
	pb= pb_in
	call mapping%compute (r, rb, f, p, pb)
	call pacify (p, tolerance)
	call pacify (pb, tolerance)
	call pacify (r, tolerance)
	call pacify (rb, tolerance)
	write (u, "(3x,A,9(1x," // fmt_p // "))") "p =", p
	write (u, "(3x,A,9(1x," // fmt_p // "))") "pb=", pb
	write (u, "(3x,A,9(1x," // fmt_p // "))") "r =", r
	write (u, "(3x,A,9(1x," // fmt_p // "))") "rb=", rb
	if (present (fmt_f)) then
	write (u, "(3x,A,9(1x," // fmt_f // "))") "f =", f
	else
	write (u, "(3x,A,9(1x," // fmt_p // "))") "f =", f
	end if
	write (u, *)
	call mapping%inverse (r, rb, f, p, pb)
	call pacify (p, tolerance)
	call pacify (pb, tolerance)
	call pacify (r, tolerance)
	call pacify (rb, tolerance)
	write (u, "(3x,A,9(1x," // fmt_p // "))") "p =", p
	write (u, "(3x,A,9(1x," // fmt_p // "))") "pb=", pb
	write (u, "(3x,A,9(1x," // fmt_p // "))") "r =", r
	write (u, "(3x,A,9(1x," // fmt_p // "))") "rb=", rb
	if (present (fmt_f)) then
	write (u, "(3x,A,9(1x," // fmt_f // "))") "f =", f
	else
	write (u, "(3x,A,9(1x," // fmt_p // "))") "f =", f
	end if
	write (u, *)
	write (u, "(3x,A,9(1x," // fmt_p // "))") "*r=", product (r)
	end subroutine sf_mapping_check

	@ %def sf_mapping_check
	@ This is a consistency check for the self-tests: the integral over the unit
	square should be unity. We estimate this by a simple binning and adding up
	the values; this should be sufficient for a self-test.

	The argument is the requested number of sampling points. We take the square
	root for binning in both dimensions, so the precise number might be
	different.
	<<SF mappings: sf mapping: TBP>>=
	procedure :: integral => sf_mapping_integral
	<<SF mappings: sub interfaces>>=
	module function sf_mapping_integral (mapping, n_calls) result (integral)
	class(sf_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: n_calls
	real(default) :: integral
	end function sf_mapping_integral
	<<SF mappings: procedures>>=
	module function sf_mapping_integral (mapping, n_calls) result (integral)
	class(sf_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: n_calls
	real(default) :: integral
	integer :: n_dim, n_bin, k
	real(default), dimension(:), allocatable :: p, pb, r, rb
	integer, dimension(:), allocatable :: ii
	real(default) :: dx, f, s

	n_dim = mapping%get_n_dim ()
	allocate (p (n_dim))
	allocate (pb(n_dim))
	allocate (r (n_dim))
	allocate (rb(n_dim))
	allocate (ii(n_dim))
	n_bin = nint (real (n_calls, default) ** (1._default / n_dim))
	dx = 1._default / n_bin
	s = 0
	ii = 1

	SAMPLE: do
	do k = 1, n_dim
	p(k) = ii(k) * dx - dx/2
	pb(k) = (n_bin - ii(k)) * dx + dx/2
	end do
	call mapping%compute (r, rb, f, p, pb)
	s = s + f
	INCR: do k = 1, n_dim
	ii(k) = ii(k) + 1
	if (ii(k) <= n_bin) then
	exit INCR
	else if (k < n_dim) then
	ii(k) = 1
	else
	exit SAMPLE
	end if
	end do INCR
	end do SAMPLE

	integral = s / real (n_bin, default) ** n_dim

	end function sf_mapping_integral

	@ %def sf_mapping_integral
	@
	\subsection{Implementation: standard mapping}
	This maps the unit square ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$,
	while $p_2$ is related to the ratio.
	<<SF mappings: public>>=
	public :: sf_s_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_s_mapping_t
	logical :: power_set = .false.
	real(default) :: power = 1
	contains
	<<SF mappings: sf standard mapping: TBP>>
	end type sf_s_mapping_t

	@ %def sf_s_mapping_t
	@ Output.
	<<SF mappings: sf standard mapping: TBP>>=
	procedure :: write => sf_s_mapping_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_s_mapping_write (object, unit)
	class(sf_s_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_s_mapping_write
	<<SF mappings: procedures>>=
	module subroutine sf_s_mapping_write (object, unit)
	class(sf_s_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A)") ": standard (", object%power, ")"
	end subroutine sf_s_mapping_write

	@ %def sf_s_mapping_write
	@ Initialize: index pair and power parameter.
	<<SF mappings: sf standard mapping: TBP>>=
	procedure :: init => sf_s_mapping_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_s_mapping_init (mapping, power)
	class(sf_s_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: power
	end subroutine sf_s_mapping_init
	<<SF mappings: procedures>>=
	module subroutine sf_s_mapping_init (mapping, power)
	class(sf_s_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: power
	call mapping%base_init (2)
	if (present (power)) then
	mapping%power_set = .true.
	mapping%power = power
	end if
	end subroutine sf_s_mapping_init

	@ %def sf_s_mapping_init
	@ Apply mapping.
	<<SF mappings: sf standard mapping: TBP>>=
	procedure :: compute => sf_s_mapping_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_s_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_s_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_s_mapping_compute
	<<SF mappings: procedures>>=
	module subroutine sf_s_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_s_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2
	integer :: j
	if (mapping%power_set) then
	call map_unit_square (r2, f, p(mapping%i), mapping%power)
	else
	call map_unit_square (r2, f, p(mapping%i))
	end if
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2(j)
	rb(mapping%i(j)) = 1 - r2(j)
	end do
	end subroutine sf_s_mapping_compute

	@ %def sf_s_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf standard mapping: TBP>>=
	procedure :: inverse => sf_s_mapping_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_s_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_s_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_s_mapping_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_s_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_s_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: p2
	integer :: j
	if (mapping%power_set) then
	call map_unit_square_inverse (r(mapping%i), f, p2, mapping%power)
	else
	call map_unit_square_inverse (r(mapping%i), f, p2)
	end if
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = 1 - p2(j)
	end do
	end subroutine sf_s_mapping_inverse

	@ %def sf_s_mapping_inverse
	@
	\subsection{Implementation: resonance pair mapping}
	This maps the unit square ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$,
	while $p_2$ is related to the ratio, then it maps $p_1$ to itself
	according to a Breit-Wigner shape, i.e., a flat prior distribution in $p_1$
	results in a Breit-Wigner distribution. Mass and width of the BW are
	rescaled by the energy, thus dimensionless fractions.
	<<SF mappings: public>>=
	public :: sf_res_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_res_mapping_t
	real(default) :: m = 0
	real(default) :: w = 0
	contains
	<<SF mappings: sf resonance mapping: TBP>>
	end type sf_res_mapping_t

	@ %def sf_res_mapping_t
	@ Output.
	<<SF mappings: sf resonance mapping: TBP>>=
	procedure :: write => sf_res_mapping_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_res_mapping_write (object, unit)
	class(sf_res_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_res_mapping_write
	<<SF mappings: procedures>>=
	module subroutine sf_res_mapping_write (object, unit)
	class(sf_res_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,', ',F7.5,A)") ": resonance (", object%m, object%w, ")"
	end subroutine sf_res_mapping_write

	@ %def sf_res_mapping_write
	@ Initialize: index pair and dimensionless mass and width parameters.
	<<SF mappings: sf resonance mapping: TBP>>=
	procedure :: init => sf_res_mapping_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_res_mapping_init (mapping, m, w)
	class(sf_res_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: m, w
	end subroutine sf_res_mapping_init
	<<SF mappings: procedures>>=
	module subroutine sf_res_mapping_init (mapping, m, w)
	class(sf_res_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: m, w
	call mapping%base_init (2)
	mapping%m = m
	mapping%w = w
	end subroutine sf_res_mapping_init

	@ %def sf_res_mapping_init
	@ Apply mapping.
	<<SF mappings: sf resonance mapping: TBP>>=
	procedure :: compute => sf_res_mapping_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_res_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_res_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_res_mapping_compute
	<<SF mappings: procedures>>=
	module subroutine sf_res_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_res_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2, p2
	real(default) :: fbw, f2, p1m
	integer :: j
	p2 = p(mapping%i)
	call map_breit_wigner &
	(p1m, fbw, p2(1), mapping%m, mapping%w, x_free)
	call map_unit_square (r2, f2, [p1m, p2(2)])
	f = fbw * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2(j)
	rb(mapping%i(j)) = 1 - r2(j)
	end do
	end subroutine sf_res_mapping_compute

	@ %def sf_res_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf resonance mapping: TBP>>=
	procedure :: inverse => sf_res_mapping_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_res_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_res_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_res_mapping_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_res_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_res_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: p2
	real(default) :: fbw, f2, p1m
	call map_unit_square_inverse (r(mapping%i), f2, p2)
	call map_breit_wigner_inverse &
	(p2(1), fbw, p1m, mapping%m, mapping%w, x_free)
	p = r
	pb= rb
	p (mapping%i(1)) = p1m
	pb(mapping%i(1)) = 1 - p1m
	p (mapping%i(2)) = p2(2)
	pb(mapping%i(2)) = 1 - p2(2)
	f = fbw * f2
	end subroutine sf_res_mapping_inverse

	@ %def sf_res_mapping_inverse
	@
	\subsection{Implementation: resonance single mapping}
	While simpler, this is needed for structure-function setups only in
	exceptional cases.

	This maps the unit interval ($r_1$) to itself
	according to a Breit-Wigner shape, i.e., a flat prior distribution in $r_1$
	results in a Breit-Wigner distribution. Mass and width of the BW are
	rescaled by the energy, thus dimensionless fractions.
	<<SF mappings: public>>=
	public :: sf_res_mapping_single_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_res_mapping_single_t
	real(default) :: m = 0
	real(default) :: w = 0
	contains
	<<SF mappings: sf resonance single mapping: TBP>>
	end type sf_res_mapping_single_t

	@ %def sf_res_mapping_single_t
	@ Output.
	<<SF mappings: sf resonance single mapping: TBP>>=
	procedure :: write => sf_res_mapping_single_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_res_mapping_single_write (object, unit)
	class(sf_res_mapping_single_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_res_mapping_single_write
	<<SF mappings: procedures>>=
	module subroutine sf_res_mapping_single_write (object, unit)
	class(sf_res_mapping_single_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,', ',F7.5,A)") ": resonance (", object%m, object%w, ")"
	end subroutine sf_res_mapping_single_write

	@ %def sf_res_mapping_single_write
	@ Initialize: single index (!) and dimensionless mass and width parameters.
	<<SF mappings: sf resonance single mapping: TBP>>=
	procedure :: init => sf_res_mapping_single_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_res_mapping_single_init (mapping, m, w)
	class(sf_res_mapping_single_t), intent(out) :: mapping
	real(default), intent(in) :: m, w
	end subroutine sf_res_mapping_single_init
	<<SF mappings: procedures>>=
	module subroutine sf_res_mapping_single_init (mapping, m, w)
	class(sf_res_mapping_single_t), intent(out) :: mapping
	real(default), intent(in) :: m, w
	call mapping%base_init (1)
	mapping%m = m
	mapping%w = w
	end subroutine sf_res_mapping_single_init

	@ %def sf_res_mapping_single_init
	@ Apply mapping.
	<<SF mappings: sf resonance single mapping: TBP>>=
	procedure :: compute => sf_res_mapping_single_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_res_mapping_single_compute &
	(mapping, r, rb, f, p, pb, x_free)
	class(sf_res_mapping_single_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_res_mapping_single_compute
	<<SF mappings: procedures>>=
	module subroutine sf_res_mapping_single_compute &
	(mapping, r, rb, f, p, pb, x_free)
	class(sf_res_mapping_single_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(1) :: r2, p2
	real(default) :: fbw
	integer :: j
	p2 = p(mapping%i)
	call map_breit_wigner &
	(r2(1), fbw, p2(1), mapping%m, mapping%w, x_free)
	f = fbw
	r = p
	rb= pb
	r (mapping%i(1)) = r2(1)
	rb(mapping%i(1)) = 1 - r2(1)
	end subroutine sf_res_mapping_single_compute

	@ %def sf_res_mapping_single_compute
	@ Apply inverse.
	<<SF mappings: sf resonance single mapping: TBP>>=
	procedure :: inverse => sf_res_mapping_single_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_res_mapping_single_inverse &
	(mapping, r, rb, f, p, pb, x_free)
	class(sf_res_mapping_single_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_res_mapping_single_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_res_mapping_single_inverse &
	(mapping, r, rb, f, p, pb, x_free)
	class(sf_res_mapping_single_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(1) :: p2
	real(default) :: fbw
	call map_breit_wigner_inverse &
	(r(mapping%i(1)), fbw, p2(1), mapping%m, mapping%w, x_free)
	p = r
	pb= rb
	p (mapping%i(1)) = p2(1)
	pb(mapping%i(1)) = 1 - p2(1)
	f = fbw
	end subroutine sf_res_mapping_single_inverse

	@ %def sf_res_mapping_single_inverse
	@
	\subsection{Implementation: on-shell mapping}
	This is a degenerate version of the unit-square mapping where the
	product $r_1r_2$ is constant. This product is given by the rescaled
	squared mass. We introduce an artificial first parameter $p_1$ to
	keep the counting, but nothing depends on it. The second parameter is
	the same $p_2$ as for the standard unit-square mapping for $\alpha=1$,
	it parameterizes the ratio of $r_1$ and $r_2$.
	<<SF mappings: public>>=
	public :: sf_os_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_os_mapping_t
	real(default) :: m = 0
	real(default) :: lm2 = 0
	contains
	<<SF mappings: sf on-shell mapping: TBP>>
	end type sf_os_mapping_t

	@ %def sf_os_mapping_t
	@ Output.
	<<SF mappings: sf on-shell mapping: TBP>>=
	procedure :: write => sf_os_mapping_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_os_mapping_write (object, unit)
	class(sf_os_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_os_mapping_write
	<<SF mappings: procedures>>=
	module subroutine sf_os_mapping_write (object, unit)
	class(sf_os_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A)") ": on-shell (", object%m, ")"
	end subroutine sf_os_mapping_write

	@ %def sf_os_mapping_write
	@ Initialize: index pair and dimensionless mass parameter.
	<<SF mappings: sf on-shell mapping: TBP>>=
	procedure :: init => sf_os_mapping_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_os_mapping_init (mapping, m)
	class(sf_os_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: m
	end subroutine sf_os_mapping_init
	<<SF mappings: procedures>>=
	module subroutine sf_os_mapping_init (mapping, m)
	class(sf_os_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: m
	call mapping%base_init (2)
	mapping%m = m
	mapping%lm2 = abs (2 * log (mapping%m))
	end subroutine sf_os_mapping_init

	@ %def sf_os_mapping_init
	@ Apply mapping. The [[x_free]] parameter rescales the total energy,
	which must be accounted for in the enclosed mapping.
	<<SF mappings: sf on-shell mapping: TBP>>=
	procedure :: compute => sf_os_mapping_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_os_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_os_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_os_mapping_compute
	<<SF mappings: procedures>>=
	module subroutine sf_os_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_os_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2, p2
	integer :: j
	p2 = p(mapping%i)
	call map_on_shell (r2, f, p2, mapping%lm2, x_free)
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2(j)
	rb(mapping%i(j)) = 1 - r2(j)
	end do
	end subroutine sf_os_mapping_compute

	@ %def sf_os_mapping_compute
	@ Apply inverse. The irrelevant parameter $p_1$ is always set zero.
	<<SF mappings: sf on-shell mapping: TBP>>=
	procedure :: inverse => sf_os_mapping_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_os_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_os_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_os_mapping_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_os_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_os_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: p2, r2
	r2 = r(mapping%i)
	call map_on_shell_inverse (r2, f, p2, mapping%lm2, x_free)
	p = r
	pb= rb
	p (mapping%i(1)) = p2(1)
	pb(mapping%i(1)) = 1 - p2(1)
	p (mapping%i(2)) = p2(2)
	pb(mapping%i(2)) = 1 - p2(2)
	end subroutine sf_os_mapping_inverse

	@ %def sf_os_mapping_inverse
	@
	\subsection{Implementation: on-shell single mapping}
	This is a degenerate version of the unit-interval mapping where the
	result $r$ is constant. The value is given by the rescaled squared
	mass. The input parameter $p_1$ is actually ignored, nothing depends
	on it.
	<<SF mappings: public>>=
	public :: sf_os_mapping_single_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_os_mapping_single_t
	real(default) :: m = 0
	real(default) :: lm2 = 0
	contains
	<<SF mappings: sf on-shell mapping single: TBP>>
	end type sf_os_mapping_single_t

	@ %def sf_os_mapping_single_t
	@ Output.
	<<SF mappings: sf on-shell mapping single: TBP>>=
	procedure :: write => sf_os_mapping_single_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_os_mapping_single_write (object, unit)
	class(sf_os_mapping_single_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_os_mapping_single_write
	<<SF mappings: procedures>>=
	module subroutine sf_os_mapping_single_write (object, unit)
	class(sf_os_mapping_single_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A)") ": on-shell (", object%m, ")"
	end subroutine sf_os_mapping_single_write

	@ %def sf_os_mapping_single_write
	@ Initialize: index pair and dimensionless mass parameter.
	<<SF mappings: sf on-shell mapping single: TBP>>=
	procedure :: init => sf_os_mapping_single_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_os_mapping_single_init (mapping, m)
	class(sf_os_mapping_single_t), intent(out) :: mapping
	real(default), intent(in) :: m
	end subroutine sf_os_mapping_single_init
	<<SF mappings: procedures>>=
	module subroutine sf_os_mapping_single_init (mapping, m)
	class(sf_os_mapping_single_t), intent(out) :: mapping
	real(default), intent(in) :: m
	call mapping%base_init (1)
	mapping%m = m
	mapping%lm2 = abs (2 * log (mapping%m))
	end subroutine sf_os_mapping_single_init

	@ %def sf_os_mapping_single_init
	@ Apply mapping. The [[x_free]] parameter rescales the total energy,
	which must be accounted for in the enclosed mapping.
	<<SF mappings: sf on-shell mapping single: TBP>>=
	procedure :: compute => sf_os_mapping_single_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_os_mapping_single_compute &
	(mapping, r, rb, f, p, pb, x_free)
	class(sf_os_mapping_single_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_os_mapping_single_compute
	<<SF mappings: procedures>>=
	module subroutine sf_os_mapping_single_compute &
	(mapping, r, rb, f, p, pb, x_free)
	class(sf_os_mapping_single_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(1) :: r2, p2
	integer :: j
	p2 = p(mapping%i)
	call map_on_shell_single (r2, f, p2, mapping%lm2, x_free)
	r = p
	rb= pb
	r (mapping%i(1)) = r2(1)
	rb(mapping%i(1)) = 1 - r2(1)
	end subroutine sf_os_mapping_single_compute

	@ %def sf_os_mapping_single_compute
	@ Apply inverse. The irrelevant parameter $p_1$ is always set zero.
	<<SF mappings: sf on-shell mapping single: TBP>>=
	procedure :: inverse => sf_os_mapping_single_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_os_mapping_single_inverse &
	(mapping, r, rb, f, p, pb, x_free)
	class(sf_os_mapping_single_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_os_mapping_single_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_os_mapping_single_inverse &
	(mapping, r, rb, f, p, pb, x_free)
	class(sf_os_mapping_single_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(1) :: p2, r2
	r2 = r(mapping%i)
	call map_on_shell_single_inverse (r2, f, p2, mapping%lm2, x_free)
	p = r
	pb= rb
	p (mapping%i(1)) = p2(1)
	pb(mapping%i(1)) = 1 - p2(1)
	end subroutine sf_os_mapping_single_inverse

	@ %def sf_os_mapping_single_inverse
	@
	\subsection{Implementation: endpoint mapping}
	This maps the unit square ($r_1,r_2$) such that $p_1$ is the product $r_1r_2$,
	while $p_2$ is related to the ratio. Furthermore, we enhance the
	region at $r_1=1$ and $r_2=1$, which translates into $p_1=1$ and
	$p_2=0,1$. The enhancement is such that any power-like singularity is
	caught. This is useful for beamstrahlung spectra.

	In addition, we allow for a delta-function singularity in $r_1$ and/or
	$r_2$. The singularity is smeared to an interval of width
	$\epsilon$. If nonzero, we distinguish the kinematical momentum
	fractions $r_i$ from effective values $x_i$, which should go into the
	structure-function evaluation. A bin of width $\epsilon$ in $r$ is
	mapped to $x=1$ exactly, while the interval $(0,1-\epsilon)$ is mapped
	to $(0,1)$ in $x$. The Jacobian reflects this distinction, and the
	logical [[in_peak]] allows for an unambiguous distinction.

	The delta-peak fraction is used only for the integration self-test.
	<<SF mappings: public>>=
	public :: sf_ep_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_ep_mapping_t
	real(default) :: a = 1
	contains
	<<SF mappings: sf endpoint mapping: TBP>>
	end type sf_ep_mapping_t

	@ %def sf_ep_mapping_t
	@ Output.
	<<SF mappings: sf endpoint mapping: TBP>>=
	procedure :: write => sf_ep_mapping_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ep_mapping_write (object, unit)
	class(sf_ep_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_ep_mapping_write
	<<SF mappings: procedures>>=
	module subroutine sf_ep_mapping_write (object, unit)
	class(sf_ep_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,ES12.5,A)") ": endpoint (a =", object%a, ")"
	end subroutine sf_ep_mapping_write

	@ %def sf_ep_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf endpoint mapping: TBP>>=
	procedure :: init => sf_ep_mapping_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ep_mapping_init (mapping, a)
	class(sf_ep_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: a
	end subroutine sf_ep_mapping_init
	<<SF mappings: procedures>>=
	module subroutine sf_ep_mapping_init (mapping, a)
	class(sf_ep_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: a
	call mapping%base_init (2)
	if (present (a)) mapping%a = a
	end subroutine sf_ep_mapping_init

	@ %def sf_ep_mapping_init
	@ Apply mapping.
	<<SF mappings: sf endpoint mapping: TBP>>=
	procedure :: compute => sf_ep_mapping_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ep_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ep_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_ep_mapping_compute
	<<SF mappings: procedures>>=
	module subroutine sf_ep_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ep_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, r2
	real(default) :: f1, f2
	integer :: j
	call map_endpoint_1 (px(1), f1, p(mapping%i(1)), mapping%a)
	call map_endpoint_01 (px(2), f2, p(mapping%i(2)), mapping%a)
	call map_unit_square (r2, f, px)
	f = f * f1 * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2(j)
	rb(mapping%i(j)) = 1 - r2(j)
	end do
	end subroutine sf_ep_mapping_compute

	@ %def sf_ep_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf endpoint mapping: TBP>>=
	procedure :: inverse => sf_ep_mapping_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ep_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ep_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_ep_mapping_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_ep_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ep_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2, px, p2
	real(default) :: f1, f2
	integer :: j
	do j = 1, 2
	r2(j) = r(mapping%i(j))
	end do
	call map_unit_square_inverse (r2, f, px)
	call map_endpoint_inverse_1 (px(1), f1, p2(1), mapping%a)
	call map_endpoint_inverse_01 (px(2), f2, p2(2), mapping%a)
	f = f * f1 * f2
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = 1 - p2(j)
	end do
	end subroutine sf_ep_mapping_inverse

	@ %def sf_ep_mapping_inverse
	@
	\subsection{Implementation: endpoint mapping with resonance}
	Like the endpoint mapping for $p_2$, but replace the endpoint mapping
	by a Breit-Wigner mapping for $p_1$. This covers resonance production
	in the presence of beamstrahlung.

	If the flag [[resonance]] is unset, we skip the resonance mapping, so
	the parameter $p_1$ remains equal to $r_1r_2$, as in the standard
	s-channel mapping.
	<<SF mappings: public>>=
	public :: sf_epr_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_epr_mapping_t
	real(default) :: a = 1
	real(default) :: m = 0
	real(default) :: w = 0
	logical :: resonance = .true.
	contains
	<<SF mappings: sf endpoint/res mapping: TBP>>
	end type sf_epr_mapping_t

	@ %def sf_epr_mapping_t
	@ Output.
	<<SF mappings: sf endpoint/res mapping: TBP>>=
	procedure :: write => sf_epr_mapping_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_epr_mapping_write (object, unit)
	class(sf_epr_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_epr_mapping_write
	<<SF mappings: procedures>>=
	module subroutine sf_epr_mapping_write (object, unit)
	class(sf_epr_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	if (object%resonance) then
	write (u, "(A,F7.5,A,F7.5,', ',F7.5,A)") ": ep/res (a = ", object%a, &
	" \| ", object%m, object%w, ")"
	else
	write (u, "(A,F7.5,A)") ": ep/nores (a = ", object%a, ")"
	end if
	end subroutine sf_epr_mapping_write

	@ %def sf_epr_mapping_write
	@ Initialize: if mass and width are not given, we initialize a
	non-resonant version of the mapping.
	<<SF mappings: sf endpoint/res mapping: TBP>>=
	procedure :: init => sf_epr_mapping_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_epr_mapping_init (mapping, a, m, w)
	class(sf_epr_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: a
	real(default), intent(in), optional :: m, w
	end subroutine sf_epr_mapping_init
	<<SF mappings: procedures>>=
	module subroutine sf_epr_mapping_init (mapping, a, m, w)
	class(sf_epr_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: a
	real(default), intent(in), optional :: m, w
	call mapping%base_init (2)
	mapping%a = a
	if (present (m) .and. present (w)) then
	mapping%m = m
	mapping%w = w
	else
	mapping%resonance = .false.
	end if
	end subroutine sf_epr_mapping_init

	@ %def sf_epr_mapping_init
	@ Apply mapping.
	<<SF mappings: sf endpoint/res mapping: TBP>>=
	procedure :: compute => sf_epr_mapping_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_epr_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_epr_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_epr_mapping_compute
	<<SF mappings: procedures>>=
	module subroutine sf_epr_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_epr_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, r2
	real(default) :: f1, f2
	integer :: j
	if (mapping%resonance) then
	call map_breit_wigner &
	(px(1), f1, p(mapping%i(1)), mapping%m, mapping%w, x_free)
	else
	px(1) = p(mapping%i(1))
	f1 = 1
	end if
	call map_endpoint_01 (px(2), f2, p(mapping%i(2)), mapping%a)
	call map_unit_square (r2, f, px)
	f = f * f1 * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2(j)
	rb(mapping%i(j)) = 1 - r2(j)
	end do
	end subroutine sf_epr_mapping_compute

	@ %def sf_epr_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf endpoint/res mapping: TBP>>=
	procedure :: inverse => sf_epr_mapping_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_epr_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_epr_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_epr_mapping_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_epr_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_epr_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, p2
	real(default) :: f1, f2
	integer :: j
	call map_unit_square_inverse (r(mapping%i), f, px)
	if (mapping%resonance) then
	call map_breit_wigner_inverse &
	(px(1), f1, p2(1), mapping%m, mapping%w, x_free)
	else
	p2(1) = px(1)
	f1 = 1
	end if
	call map_endpoint_inverse_01 (px(2), f2, p2(2), mapping%a)
	f = f * f1 * f2
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = 1 - p2(j)
	end do
	end subroutine sf_epr_mapping_inverse

	@ %def sf_epr_mapping_inverse
	@
	\subsection{Implementation: endpoint mapping for on-shell particle}
	Analogous to the resonance mapping, but the $p_1$ input is ignored
	altogether. This covers on-shell particle production
	in the presence of beamstrahlung.
	<<SF mappings: public>>=
	public :: sf_epo_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_epo_mapping_t
	real(default) :: a = 1
	real(default) :: m = 0
	real(default) :: lm2 = 0
	contains
	<<SF mappings: sf endpoint/os mapping: TBP>>
	end type sf_epo_mapping_t

	@ %def sf_epo_mapping_t
	@ Output.
	<<SF mappings: sf endpoint/os mapping: TBP>>=
	procedure :: write => sf_epo_mapping_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_epo_mapping_write (object, unit)
	class(sf_epo_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_epo_mapping_write
	<<SF mappings: procedures>>=
	module subroutine sf_epo_mapping_write (object, unit)
	class(sf_epo_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A,F7.5,A)") ": ep/on-shell (a = ", object%a, &
	" \| ", object%m, ")"
	end subroutine sf_epo_mapping_write

	@ %def sf_epo_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf endpoint/os mapping: TBP>>=
	procedure :: init => sf_epo_mapping_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_epo_mapping_init (mapping, a, m)
	class(sf_epo_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: a, m
	end subroutine sf_epo_mapping_init
	<<SF mappings: procedures>>=
	module subroutine sf_epo_mapping_init (mapping, a, m)
	class(sf_epo_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: a, m
	call mapping%base_init (2)
	mapping%a = a
	mapping%m = m
	mapping%lm2 = abs (2 * log (mapping%m))
	end subroutine sf_epo_mapping_init

	@ %def sf_epo_mapping_init
	@ Apply mapping.
	<<SF mappings: sf endpoint/os mapping: TBP>>=
	procedure :: compute => sf_epo_mapping_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_epo_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_epo_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_epo_mapping_compute
	<<SF mappings: procedures>>=
	module subroutine sf_epo_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_epo_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, r2
	real(default) :: f2
	integer :: j
	px(1) = 0
	call map_endpoint_01 (px(2), f2, p(mapping%i(2)), mapping%a)
	call map_on_shell (r2, f, px, mapping%lm2)
	f = f * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2(j)
	rb(mapping%i(j)) = 1 - r2(j)
	end do
	end subroutine sf_epo_mapping_compute

	@ %def sf_epo_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf endpoint/os mapping: TBP>>=
	procedure :: inverse => sf_epo_mapping_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_epo_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_epo_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_epo_mapping_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_epo_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_epo_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, p2
	real(default) :: f2
	integer :: j
	call map_on_shell_inverse (r(mapping%i), f, px, mapping%lm2)
	p2(1) = 0
	call map_endpoint_inverse_01 (px(2), f2, p2(2), mapping%a)
	f = f * f2
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = 1 - p2(j)
	end do
	end subroutine sf_epo_mapping_inverse

	@ %def sf_epo_mapping_inverse
	@
	\subsection{Implementation: ISR endpoint mapping}
	Similar to the endpoint mapping above: This maps the unit square
	($r_1,r_2$) such that $p_1$ is the product $r_1r_2$, while $p_2$ is
	related to the ratio. Furthermore, we enhance the region at $r_1=1$
	and $r_2=1$, which translates into $p_1=1$ and $p_2=0,1$.

	The enhancement is such that ISR singularity $(1-x)^{-1+\epsilon}$ is
	flattened. This would be easy in one dimension, but becomes
	nontrivial in two dimensions.
	<<SF mappings: public>>=
	public :: sf_ip_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_ip_mapping_t
	real(default) :: eps = 0
	contains
	<<SF mappings: sf power mapping: TBP>>
	end type sf_ip_mapping_t

	@ %def sf_ip_mapping_t
	@ Output.
	<<SF mappings: sf power mapping: TBP>>=
	procedure :: write => sf_ip_mapping_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ip_mapping_write (object, unit)
	class(sf_ip_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_ip_mapping_write
	<<SF mappings: procedures>>=
	module subroutine sf_ip_mapping_write (object, unit)
	class(sf_ip_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,ES12.5,A)") ": isr (eps =", object%eps, ")"
	end subroutine sf_ip_mapping_write

	@ %def sf_ip_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf power mapping: TBP>>=
	procedure :: init => sf_ip_mapping_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ip_mapping_init (mapping, eps)
	class(sf_ip_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: eps
	end subroutine sf_ip_mapping_init
	<<SF mappings: procedures>>=
	module subroutine sf_ip_mapping_init (mapping, eps)
	class(sf_ip_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: eps
	call mapping%base_init (2)
	if (present (eps)) mapping%eps = eps
	if (mapping%eps <= 0) &
	call msg_fatal ("ISR mapping: regulator epsilon must not be zero")
	end subroutine sf_ip_mapping_init

	@ %def sf_ip_mapping_init
	@ Apply mapping.
	<<SF mappings: sf power mapping: TBP>>=
	procedure :: compute => sf_ip_mapping_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ip_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ip_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_ip_mapping_compute
	<<SF mappings: procedures>>=
	module subroutine sf_ip_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ip_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, pxb, r2, r2b
	real(default) :: f1, f2, xb, y, yb
	integer :: j
	call map_power_1 (xb, f1, pb(mapping%i(1)), 2 * mapping%eps)
	call map_power_01 (y, yb, f2, pb(mapping%i(2)), mapping%eps)
	px(1) = 1 - xb
	pxb(1) = xb
	px(2) = y
	pxb(2) = yb
	call map_unit_square_prec (r2, r2b, f, px, pxb)
	f = f * f1 * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2 (j)
	rb(mapping%i(j)) = r2b(j)
	end do
	end subroutine sf_ip_mapping_compute

	@ %def sf_ip_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf power mapping: TBP>>=
	procedure :: inverse => sf_ip_mapping_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ip_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ip_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_ip_mapping_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_ip_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ip_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2, r2b, px, pxb, p2, p2b
	real(default) :: f1, f2, xb, y, yb
	integer :: j
	do j = 1, 2
	r2 (j) = r (mapping%i(j))
	r2b(j) = rb(mapping%i(j))
	end do
	call map_unit_square_inverse_prec (r2, r2b, f, px, pxb)
	xb = pxb(1)
	if (px(1) > 0) then
	y = px(2)
	yb = pxb(2)
	else
	y = 0.5_default
	yb = 0.5_default
	end if
	call map_power_inverse_1 (xb, f1, p2b(1), 2 * mapping%eps)
	call map_power_inverse_01 (y, yb, f2, p2b(2), mapping%eps)
	p2 = 1 - p2b
	f = f * f1 * f2
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = p2b(j)
	end do
	end subroutine sf_ip_mapping_inverse

	@ %def sf_ip_mapping_inverse
	@
	\subsection{Implementation: ISR endpoint mapping, resonant}
	Similar to the endpoint mapping above: This maps the unit square
	($r_1,r_2$) such that $p_1$ is the product $r_1r_2$, while $p_2$ is
	related to the ratio. Furthermore, we enhance the region at $r_1=1$
	and $r_2=1$, which translates into $p_1=1$ and $p_2=0,1$.

	The enhancement is such that ISR singularity $(1-x)^{-1+\epsilon}$ is
	flattened. This would be easy in one dimension, but becomes
	nontrivial in two dimensions.

	The resonance can be turned off by the flag [[resonance]].
	<<SF mappings: public>>=
	public :: sf_ipr_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_ipr_mapping_t
	real(default) :: eps = 0
	real(default) :: m = 0
	real(default) :: w = 0
	logical :: resonance = .true.
	contains
	<<SF mappings: sf power/res mapping: TBP>>
	end type sf_ipr_mapping_t

	@ %def sf_ipr_mapping_t
	@ Output.
	<<SF mappings: sf power/res mapping: TBP>>=
	procedure :: write => sf_ipr_mapping_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ipr_mapping_write (object, unit)
	class(sf_ipr_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_ipr_mapping_write
	<<SF mappings: procedures>>=
	module subroutine sf_ipr_mapping_write (object, unit)
	class(sf_ipr_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	if (object%resonance) then
	write (u, "(A,F7.5,A,F7.5,', ',F7.5,A)") ": isr/res (eps = ", &
	object%eps, " \| ", object%m, object%w, ")"
	else
	write (u, "(A,F7.5,A)") ": isr/res (eps = ", object%eps, ")"
	end if
	end subroutine sf_ipr_mapping_write

	@ %def sf_ipr_mapping_write
	@ Initialize:
	<<SF mappings: sf power/res mapping: TBP>>=
	procedure :: init => sf_ipr_mapping_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ipr_mapping_init (mapping, eps, m, w)
	class(sf_ipr_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: eps, m, w
	end subroutine sf_ipr_mapping_init
	<<SF mappings: procedures>>=
	module subroutine sf_ipr_mapping_init (mapping, eps, m, w)
	class(sf_ipr_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: eps, m, w
	call mapping%base_init (2)
	if (present (eps)) mapping%eps = eps
	if (mapping%eps <= 0) &
	call msg_fatal ("ISR mapping: regulator epsilon must not be zero")
	if (present (m) .and. present (w)) then
	mapping%m = m
	mapping%w = w
	else
	mapping%resonance = .false.
	end if
	end subroutine sf_ipr_mapping_init

	@ %def sf_ipr_mapping_init
	@ Apply mapping.
	<<SF mappings: sf power/res mapping: TBP>>=
	procedure :: compute => sf_ipr_mapping_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ipr_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ipr_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_ipr_mapping_compute
	<<SF mappings: procedures>>=
	module subroutine sf_ipr_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ipr_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, pxb, r2, r2b
	real(default) :: f1, f2, y, yb
	integer :: j
	if (mapping%resonance) then
	call map_breit_wigner &
	(px(1), f1, p(mapping%i(1)), mapping%m, mapping%w, x_free)
	else
	px(1) = p(mapping%i(1))
	f1 = 1
	end if
	call map_power_01 (y, yb, f2, pb(mapping%i(2)), mapping%eps)
	pxb(1) = 1 - px(1)
	px(2) = y
	pxb(2) = yb
	call map_unit_square_prec (r2, r2b, f, px, pxb)
	f = f * f1 * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2 (j)
	rb(mapping%i(j)) = r2b(j)
	end do
	end subroutine sf_ipr_mapping_compute

	@ %def sf_ipr_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf power/res mapping: TBP>>=
	procedure :: inverse => sf_ipr_mapping_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ipr_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ipr_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_ipr_mapping_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_ipr_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ipr_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2, r2b, px, pxb, p2, p2b
	real(default) :: f1, f2, y, yb
	integer :: j
	do j = 1, 2
	r2 (j) = r (mapping%i(j))
	r2b(j) = rb(mapping%i(j))
	end do
	call map_unit_square_inverse_prec (r2, r2b, f, px, pxb)
	if (px(1) > 0) then
	y = px(2)
	yb = pxb(2)
	else
	y = 0.5_default
	yb = 0.5_default
	end if
	if (mapping%resonance) then
	call map_breit_wigner_inverse &
	(px(1), f1, p2(1), mapping%m, mapping%w, x_free)
	else
	p2(1) = px(1)
	f1 = 1
	end if
	call map_power_inverse_01 (y, yb, f2, p2b(2), mapping%eps)
	p2b(1) = 1 - p2(1)
	p2 (2) = 1 - p2b(2)
	f = f * f1 * f2
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = p2b(j)
	end do
	end subroutine sf_ipr_mapping_inverse

	@ %def sf_ipr_mapping_inverse
	@
	\subsection{Implementation: ISR on-shell mapping}
	Similar to the endpoint mapping above: This maps the unit square
	($r_1,r_2$) such that $p_1$ is ignored while the product $r_1r_2$ is
	constant. $p_2$ is related to the ratio. Furthermore, we enhance the
	region at $r_1=1$ and $r_2=1$, which translates into $p_1=1$ and
	$p_2=0,1$.

	The enhancement is such that ISR singularity $(1-x)^{-1+\epsilon}$ is
	flattened. This would be easy in one dimension, but becomes
	nontrivial in two dimensions.
	<<SF mappings: public>>=
	public :: sf_ipo_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_ipo_mapping_t
	real(default) :: eps = 0
	real(default) :: m = 0
	contains
	<<SF mappings: sf power/os mapping: TBP>>
	end type sf_ipo_mapping_t

	@ %def sf_ipo_mapping_t
	@ Output.
	<<SF mappings: sf power/os mapping: TBP>>=
	procedure :: write => sf_ipo_mapping_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ipo_mapping_write (object, unit)
	class(sf_ipo_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_ipo_mapping_write
	<<SF mappings: procedures>>=
	module subroutine sf_ipo_mapping_write (object, unit)
	class(sf_ipo_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,',',I0,')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A,F7.5,A)") ": isr/os (eps = ", object%eps, &
	" \| ", object%m, ")"
	end subroutine sf_ipo_mapping_write

	@ %def sf_ipo_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf power/os mapping: TBP>>=
	procedure :: init => sf_ipo_mapping_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ipo_mapping_init (mapping, eps, m)
	class(sf_ipo_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: eps, m
	end subroutine sf_ipo_mapping_init
	<<SF mappings: procedures>>=
	module subroutine sf_ipo_mapping_init (mapping, eps, m)
	class(sf_ipo_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: eps, m
	call mapping%base_init (2)
	if (present (eps)) mapping%eps = eps
	if (mapping%eps <= 0) &
	call msg_fatal ("ISR mapping: regulator epsilon must not be zero")
	mapping%m = m
	end subroutine sf_ipo_mapping_init

	@ %def sf_ipo_mapping_init
	@ Apply mapping.
	<<SF mappings: sf power/os mapping: TBP>>=
	procedure :: compute => sf_ipo_mapping_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ipo_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ipo_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_ipo_mapping_compute
	<<SF mappings: procedures>>=
	module subroutine sf_ipo_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ipo_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: px, pxb, r2, r2b
	real(default) :: f1, f2, y, yb
	integer :: j
	call map_power_01 (y, yb, f2, pb(mapping%i(2)), mapping%eps)
	px(1) = mapping%m ** 2
	if (present (x_free)) px(1) = px(1) / x_free
	pxb(1) = 1 - px(1)
	px(2) = y
	pxb(2) = yb
	call map_unit_square_prec (r2, r2b, f1, px, pxb)
	f = f1 * f2
	r = p
	rb= pb
	do j = 1, 2
	r (mapping%i(j)) = r2 (j)
	rb(mapping%i(j)) = r2b(j)
	end do
	end subroutine sf_ipo_mapping_compute

	@ %def sf_ipo_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf power/os mapping: TBP>>=
	procedure :: inverse => sf_ipo_mapping_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ipo_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ipo_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_ipo_mapping_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_ipo_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ipo_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: r2, r2b, px, pxb, p2, p2b
	real(default) :: f1, f2, y, yb
	integer :: j
	do j = 1, 2
	r2 (j) = r (mapping%i(j))
	r2b(j) = rb(mapping%i(j))
	end do
	call map_unit_square_inverse_prec (r2, r2b, f1, px, pxb)
	y = px(2)
	yb = pxb(2)
	call map_power_inverse_01 (y, yb, f2, p2b(2), mapping%eps)
	p2(1) = 0
	p2b(1)= 1
	p2(2) = 1 - p2b(2)
	f = f1 * f2
	p = r
	pb= rb
	do j = 1, 2
	p (mapping%i(j)) = p2(j)
	pb(mapping%i(j)) = p2b(j)
	end do
	end subroutine sf_ipo_mapping_inverse

	@ %def sf_ipo_mapping_inverse
	@
	\subsection{Implementation: Endpoint + ISR power mapping}
	This is a combination of endpoint (i.e., beamstrahlung) and ISR power
	mapping. The first two parameters apply to the beamstrahlung
	spectrum, the last two to the ISR function for the first and second
	beam, respectively.
	<<SF mappings: public>>=
	public :: sf_ei_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_ei_mapping_t
	type(sf_ep_mapping_t) :: ep
	type(sf_ip_mapping_t) :: ip
	contains
	<<SF mappings: sf ep-ip mapping: TBP>>
	end type sf_ei_mapping_t

	@ %def sf_ei_mapping_t
	@ Output.
	<<SF mappings: sf ep-ip mapping: TBP>>=
	procedure :: write => sf_ei_mapping_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ei_mapping_write (object, unit)
	class(sf_ei_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_ei_mapping_write
	<<SF mappings: procedures>>=
	module subroutine sf_ei_mapping_write (object, unit)
	class(sf_ei_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,3(',',I0),')')", advance="no") object%i
	end if
	write (u, "(A,ES12.5,A,ES12.5,A)") ": ep/isr (a =", object%ep%a, &
	", eps =", object%ip%eps, ")"
	end subroutine sf_ei_mapping_write

	@ %def sf_ei_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf ep-ip mapping: TBP>>=
	procedure :: init => sf_ei_mapping_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ei_mapping_init (mapping, a, eps)
	class(sf_ei_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: a, eps
	end subroutine sf_ei_mapping_init
	<<SF mappings: procedures>>=
	module subroutine sf_ei_mapping_init (mapping, a, eps)
	class(sf_ei_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: a, eps
	call mapping%base_init (4)
	call mapping%ep%init (a)
	call mapping%ip%init (eps)
	end subroutine sf_ei_mapping_init

	@ %def sf_ei_mapping_init
	@ Set an index value. We should communicate the appropriate indices to the
	enclosed sub-mappings, therefore override the method.
	<<SF mappings: sf ep-ip mapping: TBP>>=
	procedure :: set_index => sf_ei_mapping_set_index
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ei_mapping_set_index (mapping, j, i)
	class(sf_ei_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j, i
	end subroutine sf_ei_mapping_set_index
	<<SF mappings: procedures>>=
	module subroutine sf_ei_mapping_set_index (mapping, j, i)
	class(sf_ei_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j, i
	mapping%i(j) = i
	select case (j)
	case (1:2); call mapping%ep%set_index (j, i)
	case (3:4); call mapping%ip%set_index (j-2, i)
	end select
	end subroutine sf_ei_mapping_set_index

	@ %def sf_mapping_set_index
	@ Apply mapping. Now, the beamstrahlung and ISR mappings are
	independent of each other. The parameter subsets that are actually
	used should not overlap. The Jacobians are multiplied.
	<<SF mappings: sf ep-ip mapping: TBP>>=
	procedure :: compute => sf_ei_mapping_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ei_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ei_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_ei_mapping_compute
	<<SF mappings: procedures>>=
	module subroutine sf_ei_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_ei_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(size(p)) :: q, qb
	real(default) :: f1, f2
	call mapping%ep%compute (q, qb, f1, p, pb, x_free)
	call mapping%ip%compute (r, rb, f2, q, qb, x_free)
	f = f1 * f2
	end subroutine sf_ei_mapping_compute

	@ %def sf_ei_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf ep-ip mapping: TBP>>=
	procedure :: inverse => sf_ei_mapping_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_ei_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ei_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_ei_mapping_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_ei_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_ei_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(size(p)) :: q, qb
	real(default) :: f1, f2
	call mapping%ip%inverse (r, rb, f2, q, qb, x_free)
	call mapping%ep%inverse (q, qb, f1, p, pb, x_free)
	f = f1 * f2
	end subroutine sf_ei_mapping_inverse

	@ %def sf_ei_mapping_inverse
	@
	\subsection{Implementation: Endpoint + ISR + resonance}
	This is a combination of endpoint (i.e., beamstrahlung) and ISR power
	mapping, adapted for an s-channel resonance. The first two internal
	parameters apply to the beamstrahlung spectrum, the last two to the
	ISR function for the first and second beam, respectively. The first
	and third parameters are the result of an overall resonance mapping,
	so on the outside, the first parameter is the total momentum fraction,
	the third one describes the distribution between beamstrahlung and ISR.
	<<SF mappings: public>>=
	public :: sf_eir_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_eir_mapping_t
	type(sf_res_mapping_t) :: res
	type(sf_epr_mapping_t) :: ep
	type(sf_ipr_mapping_t) :: ip
	contains
	<<SF mappings: sf ep-ip-res mapping: TBP>>
	end type sf_eir_mapping_t

	@ %def sf_eir_mapping_t
	@ Output.
	<<SF mappings: sf ep-ip-res mapping: TBP>>=
	procedure :: write => sf_eir_mapping_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_eir_mapping_write (object, unit)
	class(sf_eir_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_eir_mapping_write
	<<SF mappings: procedures>>=
	module subroutine sf_eir_mapping_write (object, unit)
	class(sf_eir_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,3(',',I0),')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A,F7.5,A,F7.5,', ',F7.5,A)") &
	": ep/isr/res (a =", object%ep%a, &
	", eps =", object%ip%eps, " \| ", object%res%m, object%res%w, ")"
	end subroutine sf_eir_mapping_write

	@ %def sf_eir_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf ep-ip-res mapping: TBP>>=
	procedure :: init => sf_eir_mapping_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_eir_mapping_init (mapping, a, eps, m, w)
	class(sf_eir_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: a, eps, m, w
	end subroutine sf_eir_mapping_init
	<<SF mappings: procedures>>=
	module subroutine sf_eir_mapping_init (mapping, a, eps, m, w)
	class(sf_eir_mapping_t), intent(out) :: mapping
	real(default), intent(in) :: a, eps, m, w
	call mapping%base_init (4)
	call mapping%res%init (m, w)
	call mapping%ep%init (a)
	call mapping%ip%init (eps)
	end subroutine sf_eir_mapping_init

	@ %def sf_eir_mapping_init
	@ Set an index value. We should communicate the appropriate indices to the
	enclosed sub-mappings, therefore override the method.
	<<SF mappings: sf ep-ip-res mapping: TBP>>=
	procedure :: set_index => sf_eir_mapping_set_index
	<<SF mappings: sub interfaces>>=
	module subroutine sf_eir_mapping_set_index (mapping, j, i)
	class(sf_eir_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j, i
	end subroutine sf_eir_mapping_set_index
	<<SF mappings: procedures>>=
	module subroutine sf_eir_mapping_set_index (mapping, j, i)
	class(sf_eir_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j, i
	mapping%i(j) = i
	select case (j)
	case (1); call mapping%res%set_index (1, i)
	case (3); call mapping%res%set_index (2, i)
	end select
	select case (j)
	case (1:2); call mapping%ep%set_index (j, i)
	case (3:4); call mapping%ip%set_index (j-2, i)
	end select
	end subroutine sf_eir_mapping_set_index

	@ %def sf_mapping_set_index
	@ Apply mapping. Now, the beamstrahlung and ISR mappings are
	independent of each other. The parameter subsets that are actually
	used should not overlap. The Jacobians are multiplied.
	<<SF mappings: sf ep-ip-res mapping: TBP>>=
	procedure :: compute => sf_eir_mapping_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_eir_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_eir_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_eir_mapping_compute
	<<SF mappings: procedures>>=
	module subroutine sf_eir_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_eir_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(size(p)) :: px, pxb, q, qb
	real(default) :: f0, f1, f2
	call mapping%res%compute (px, pxb, f0, p, pb, x_free)
	call mapping%ep%compute (q, qb, f1, px, pxb, x_free)
	call mapping%ip%compute (r, rb, f2, q, qb, x_free)
	f = f0 * f1 * f2
	end subroutine sf_eir_mapping_compute

	@ %def sf_eir_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf ep-ip-res mapping: TBP>>=
	procedure :: inverse => sf_eir_mapping_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_eir_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_eir_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_eir_mapping_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_eir_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_eir_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(size(p)) :: px, pxb, q, qb
	real(default) :: f0, f1, f2
	call mapping%ip%inverse (r, rb, f2, q, qb, x_free)
	call mapping%ep%inverse (q, qb, f1, px, pxb, x_free)
	call mapping%res%inverse (px, pxb, f0, p, pb, x_free)
	f = f0 * f1 * f2
	end subroutine sf_eir_mapping_inverse

	@ %def sf_eir_mapping_inverse
	@
	\subsection{Implementation: Endpoint + ISR power mapping, on-shell}
	This is a combination of endpoint (i.e., beamstrahlung) and ISR power
	mapping. The first two parameters apply to the beamstrahlung
	spectrum, the last two to the ISR function for the first and second
	beam, respectively. On top of that, we map the first and third parameter
	such that the product is constant. From the outside, the first
	parameter is irrelevant while the third parameter describes the
	distribution of energy (loss) among beamstrahlung and ISR.
	<<SF mappings: public>>=
	public :: sf_eio_mapping_t
	<<SF mappings: types>>=
	type, extends (sf_mapping_t) :: sf_eio_mapping_t
	type(sf_os_mapping_t) :: os
	type(sf_epr_mapping_t) :: ep
	type(sf_ipr_mapping_t) :: ip
	contains
	<<SF mappings: sf ep-ip-os mapping: TBP>>
	end type sf_eio_mapping_t

	@ %def sf_eio_mapping_t
	@ Output.
	<<SF mappings: sf ep-ip-os mapping: TBP>>=
	procedure :: write => sf_eio_mapping_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_eio_mapping_write (object, unit)
	class(sf_eio_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_eio_mapping_write
	<<SF mappings: procedures>>=
	module subroutine sf_eio_mapping_write (object, unit)
	class(sf_eio_mapping_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "map"
	if (any (object%i /= 0)) then
	write (u, "('(',I0,3(',',I0),')')", advance="no") object%i
	end if
	write (u, "(A,F7.5,A,F7.5,A,F7.5,A)") ": ep/isr/os (a =", object%ep%a, &
	", eps =", object%ip%eps, " \| ", object%os%m, ")"
	end subroutine sf_eio_mapping_write

	@ %def sf_eio_mapping_write
	@ Initialize: no extra parameters.
	<<SF mappings: sf ep-ip-os mapping: TBP>>=
	procedure :: init => sf_eio_mapping_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_eio_mapping_init (mapping, a, eps, m)
	class(sf_eio_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: a, eps, m
	end subroutine sf_eio_mapping_init
	<<SF mappings: procedures>>=
	module subroutine sf_eio_mapping_init (mapping, a, eps, m)
	class(sf_eio_mapping_t), intent(out) :: mapping
	real(default), intent(in), optional :: a, eps, m
	call mapping%base_init (4)
	call mapping%os%init (m)
	call mapping%ep%init (a)
	call mapping%ip%init (eps)
	end subroutine sf_eio_mapping_init

	@ %def sf_eio_mapping_init
	@ Set an index value. We should communicate the appropriate indices to the
	enclosed sub-mappings, therefore override the method.
	<<SF mappings: sf ep-ip-os mapping: TBP>>=
	procedure :: set_index => sf_eio_mapping_set_index
	<<SF mappings: sub interfaces>>=
	module subroutine sf_eio_mapping_set_index (mapping, j, i)
	class(sf_eio_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j, i
	end subroutine sf_eio_mapping_set_index
	<<SF mappings: procedures>>=
	module subroutine sf_eio_mapping_set_index (mapping, j, i)
	class(sf_eio_mapping_t), intent(inout) :: mapping
	integer, intent(in) :: j, i
	mapping%i(j) = i
	select case (j)
	case (1); call mapping%os%set_index (1, i)
	case (3); call mapping%os%set_index (2, i)
	end select
	select case (j)
	case (1:2); call mapping%ep%set_index (j, i)
	case (3:4); call mapping%ip%set_index (j-2, i)
	end select
	end subroutine sf_eio_mapping_set_index

	@ %def sf_mapping_set_index
	@ Apply mapping. Now, the beamstrahlung and ISR mappings are
	independent of each other. The parameter subsets that are actually
	used should not overlap. The Jacobians are multiplied.
	<<SF mappings: sf ep-ip-os mapping: TBP>>=
	procedure :: compute => sf_eio_mapping_compute
	<<SF mappings: sub interfaces>>=
	module subroutine sf_eio_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_eio_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_eio_mapping_compute
	<<SF mappings: procedures>>=
	module subroutine sf_eio_mapping_compute (mapping, r, rb, f, p, pb, x_free)
	class(sf_eio_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(size(p)) :: px, pxb, q, qb
	real(default) :: f0, f1, f2
	call mapping%os%compute (px, pxb, f0, p, pb, x_free)
	call mapping%ep%compute (q, qb, f1, px, pxb, x_free)
	call mapping%ip%compute (r, rb, f2, q, qb, x_free)
	f = f0 * f1 * f2
	end subroutine sf_eio_mapping_compute

	@ %def sf_eio_mapping_compute
	@ Apply inverse.
	<<SF mappings: sf ep-ip-os mapping: TBP>>=
	procedure :: inverse => sf_eio_mapping_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine sf_eio_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_eio_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_eio_mapping_inverse
	<<SF mappings: procedures>>=
	module subroutine sf_eio_mapping_inverse (mapping, r, rb, f, p, pb, x_free)
	class(sf_eio_mapping_t), intent(inout) :: mapping
	real(default), dimension(:), intent(in) :: r, rb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: p, pb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(size(p)) :: px, pxb, q, qb
	real(default) :: f0, f1, f2
	call mapping%ip%inverse (r, rb, f2, q, qb, x_free)
	call mapping%ep%inverse (q, qb, f1, px, pxb, x_free)
	call mapping%os%inverse (px, pxb, f0, p, pb, x_free)
	f = f0 * f1 * f2
	end subroutine sf_eio_mapping_inverse

	@ %def sf_eio_mapping_inverse
	@
	\subsection{Basic formulas}
	\subsubsection{Standard mapping of the unit square}
	This mapping of the unit square is appropriate in particular for
	structure functions which are concentrated at the lower end. Instead
	of a rectangular grid, one set of grid lines corresponds to constant
	parton c.m. energy. The other set is chosen such that the jacobian is
	only mildly singular ($\ln x$ which is zero at $x=1$), corresponding
	to an initial concentration of sampling points at the maximum energy.
	If [[power]] is greater than one (the default), points are also
	concentrated at the lower end.

	The formula is ([[power]]=$\alpha$):
	\begin{align}
	r_1 &= (p_1 ^ {p_2})^\alpha \\
	r_2 &= (p_1 ^ {1 - p_2})^\alpha\\
	f &= \alpha^2 p_1 ^ {\alpha - 1} \|\log p_1\|
	\end{align}
	and for the default case $\alpha=1$:
	\begin{align}
	r_1 &= p_1 ^ {p_2} \\
	r_2 &= p_1 ^ {1 - p_2} \\
	f &= \|\log p_1\|
	\end{align}
	<<SF mappings: procedures>>=
	subroutine map_unit_square (r, factor, p, power)
	real(default), dimension(2), intent(out) :: r
	real(default), intent(out) :: factor
	real(default), dimension(2), intent(in) :: p
	real(default), intent(in), optional :: power
	real(default) :: xx, yy
	factor = 1
	xx = p(1)
	yy = p(2)
	if (present(power)) then
	if (p(1) > 0 .and. power > 1) then
	xx = p(1)**power
	factor = factor * power * xx / p(1)
	end if
	end if
	if (.not. vanishes (xx)) then
	r(1) = xx ** yy
	r(2) = xx / r(1)
	factor = factor * abs (log (xx))
	else
	r = 0
	end if
	end subroutine map_unit_square

	@ %def map_unit_square
	@ This is the inverse mapping.
	<<SF mappings: procedures>>=
	subroutine map_unit_square_inverse (r, factor, p, power)
	real(kind=default), dimension(2), intent(in) :: r
	real(kind=default), intent(out) :: factor
	real(kind=default), dimension(2), intent(out) :: p
	real(kind=default), intent(in), optional :: power
	real(kind=default) :: lg, xx, yy
	factor = 1
	xx = r(1) * r(2)
	if (.not. vanishes (xx)) then
	lg = log (xx)
	if (.not. vanishes (lg)) then
	yy = log (r(1)) / lg
	else
	yy = 0
	end if
	p(2) = yy
	factor = factor * abs (lg)
	if (present(power)) then
	p(1) = xx**(1._default/power)
	factor = factor * power * xx / p(1)
	else
	p(1) = xx
	end if
	else
	p = 0
	end if
	end subroutine map_unit_square_inverse

	@ %def map_unit_square_inverse
	@
	\subsubsection{Precise mapping of the unit square}
	A more precise version (with unit power parameter). This version
	should be numerically stable near $x=1$ and $y=0,1$. The formulas are again
	\begin{equation}
	r_1 = p_1^{p_2}, \qquad
	r_2 = p_1^{\bar p_2}, \qquad
	f = - \log p_1
	\end{equation}
	but we compute both $r_i$ and $\bar r_i$ simultaneously and make
	direct use of both $p_i$ and $\bar p_i$ as appropriate.
	<<SF mappings: procedures>>=
	subroutine map_unit_square_prec (r, rb, factor, p, pb)
	real(default), dimension(2), intent(out) :: r
	real(default), dimension(2), intent(out) :: rb
	real(default), intent(out) :: factor
	real(default), dimension(2), intent(in) :: p
	real(default), dimension(2), intent(in) :: pb
	if (p(1) > 0.5_default) then
	call compute_prec_xy_1 (r(1), rb(1), p(1), pb(1), p (2))
	call compute_prec_xy_1 (r(2), rb(2), p(1), pb(1), pb(2))
	factor = - log_prec (p(1), pb(1))
	else if (.not. vanishes (p(1))) then
	call compute_prec_xy_0 (r(1), rb(1), p(1), pb(1), p (2))
	call compute_prec_xy_0 (r(2), rb(2), p(1), pb(1), pb(2))
	factor = - log_prec (p(1), pb(1))
	else
	r = 0
	rb = 1
	factor = 0
	end if
	end subroutine map_unit_square_prec

	@ %def map_unit_square_prec
	@ This is the inverse mapping.
	<<SF mappings: procedures>>=
	subroutine map_unit_square_inverse_prec (r, rb, factor, p, pb)
	real(default), dimension(2), intent(in) :: r
	real(default), dimension(2), intent(in) :: rb
	real(default), intent(out) :: factor
	real(default), dimension(2), intent(out) :: p
	real(default), dimension(2), intent(out) :: pb
	call inverse_prec_x (r, rb, p(1), pb(1))
	if (all (r > 0)) then
	if (rb(1) < rb(2)) then
	call inverse_prec_y (r, rb, p(2), pb(2))
	else
	call inverse_prec_y ([r(2),r(1)], [rb(2),rb(1)], pb(2), p(2))
	end if
	factor = - log_prec (p(1), pb(1))
	else
	p(1) = 0
	pb(1) = 1
	p(2) = 0.5_default
	pb(2) = 0.5_default
	factor = 0
	end if
	end subroutine map_unit_square_inverse_prec

	@ %def map_unit_square_prec_inverse
	@ This is an auxiliary function: evaluate the expression $\bar z = 1 -
	x^y$ in a numerically stable way. Instabilities occur for $y=0$ and
	$x=1$. The idea is to replace the bracket by the first terms of its
	Taylor expansion around $x=1$ (read $\bar x\equiv 1 -x$)
	\begin{equation}
	1 - x^y = y\bar x\left(1 + \frac12(1-y)\bar x +
	\frac16(2-y)(1-y)\bar x^2\right)
	\end{equation}
	whenever this is the better approximation. Actually, the relative
	numerical error of the exact formula is about $\eta/(y\bar x)$ where
	$\eta$ is given by [[epsilon(KIND)]] in Fortran. The relative error
	of the approximation is better than the last included term divided by
	$(y\bar x)$.

	The first subroutine computes $z$ and $\bar z$ near $x=1$ where $\log
	x$ should be expanded, the second one near $x=0$ where $\log x$ can be
	kept.
	<<SF mappings: procedures>>=
	subroutine compute_prec_xy_1 (z, zb, x, xb, y)
	real(default), intent(out) :: z, zb
	real(default), intent(in) :: x, xb, y
	real(default) :: a1, a2, a3
	a1 = y * xb
	a2 = a1 * (1 - y) * xb / 2
	a3 = a2 * (2 - y) * xb / 3
	if (abs (a3) < epsilon (a3)) then
	zb = a1 + a2 + a3
	z = 1 - zb
	else
	z = x ** y
	zb = 1 - z
	end if
	end subroutine compute_prec_xy_1

	subroutine compute_prec_xy_0 (z, zb, x, xb, y)
	real(default), intent(out) :: z, zb
	real(default), intent(in) :: x, xb, y
	real(default) :: a1, a2, a3, lx
	lx = -log (x)
	a1 = y * lx
	a2 = a1 * y * lx / 2
	a3 = a2 * y * lx / 3
	if (abs (a3) < epsilon (a3)) then
	zb = a1 + a2 + a3
	z = 1 - zb
	else
	z = x ** y
	zb = 1 - z
	end if
	end subroutine compute_prec_xy_0

	@ %def compute_prec_xy_1
	@ %def compute_prec_xy_0
	@ For the inverse calculation, we evaluate $x=r_1r_2$ in a stable way.
	Since it is just a polynomial, the expansion near $x=1$ is
	analytically exact, and we don't need to choose based on precision.
	<<SF mappings: procedures>>=
	subroutine inverse_prec_x (r, rb, x, xb)
	real(default), dimension(2), intent(in) :: r, rb
	real(default), intent(out) :: x, xb
	real(default) :: a0, a1
	a0 = rb(1) + rb(2)
	a1 = rb(1) * rb(2)
	if (a0 > 0.5_default) then
	xb = a0 - a1
	x = 1 - xb
	else
	x = r(1) * r(2)
	xb = 1 - x
	end if
	end subroutine inverse_prec_x

	@ %def inverse_prec_x
	@ The inverse calculation for the relative momentum fraction
	\begin{equation}
	y = \frac{1}{1 + \frac{\log{r_2}}{\log{r_1}}}
	\end{equation}
	is slightly more complicated. We should take the precise form of the
	logarithm, so we are safe near $r_i=1$. A series expansion is
	required if $r_1\ll r_2$, since then $y$ becomes small. (We assume
	$r_1<r_2$ here; for the opposite case, the arguments can be
	exchanged.)
	<<SF mappings: procedures>>=
	subroutine inverse_prec_y (r, rb, y, yb)
	real(default), dimension(2), intent(in) :: r, rb
	real(default), intent(out) :: y, yb
	real(default) :: log1, log2, a1, a2, a3
	log1 = log_prec (r(1), rb(1))
	log2 = log_prec (r(2), rb(2))
	if (abs (log2**3) < epsilon (one)) then
	if (abs(log1) < epsilon (one)) then
	y = zero
	else
	y = one / (one + log2 / log1)
	end if
	if (abs(log2) < epsilon (one)) then
	yb = zero
	else
	yb = one / (one + log1 / log2)
	end if
	return
	end if
	a1 = - rb(1) / log2
	a2 = - rb(1) ** 2 * (one / log2*2 + one / (2 log2))
	a3 = - rb(1) ** 3 * (one / log23 + one / log22 + one/(3 * log2))
	if (abs (a3) < epsilon (a3)) then
	y = a1 + a2 + a3
	yb = one - y
	else
	y = one / (one + log2 / log1)
	yb = one / (one + log1 / log2)
	end if
	end subroutine inverse_prec_y

	@ %def inverse_prec_y
	@
	\subsubsection{Mapping for on-shell s-channel}
	The limiting case, if the product $r_1r_2$ is fixed for on-shell
	production. The parameter $p_1$ is ignored. In the inverse mapping,
	it is returned zero.

	The parameter [[x_free]], if present, rescales the total energy. If
	it is less than one, the rescaled mass parameter $m^2$ should be increased
	accordingly.

	Public for access in unit test.
	<<SF mappings: public>>=
	public :: map_on_shell
	public :: map_on_shell_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine map_on_shell (r, factor, p, lm2, x_free)
	real(default), dimension(2), intent(out) :: r
	real(default), intent(out) :: factor
	real(default), dimension(2), intent(in) :: p
	real(default), intent(in) :: lm2
	real(default), intent(in), optional :: x_free
	end subroutine map_on_shell
	module subroutine map_on_shell_inverse (r, factor, p, lm2, x_free)
	real(default), dimension(2), intent(in) :: r
	real(default), intent(out) :: factor
	real(default), dimension(2), intent(out) :: p
	real(default), intent(in) :: lm2
	real(default), intent(in), optional :: x_free
	end subroutine map_on_shell_inverse
	<<SF mappings: procedures>>=
	module subroutine map_on_shell (r, factor, p, lm2, x_free)
	real(default), dimension(2), intent(out) :: r
	real(default), intent(out) :: factor
	real(default), dimension(2), intent(in) :: p
	real(default), intent(in) :: lm2
	real(default), intent(in), optional :: x_free
	real(default) :: lx
	lx = lm2; if (present (x_free)) lx = lx + log (x_free)
	r(1) = exp (- p(2) * lx)
	r(2) = exp (- (1 - p(2)) * lx)
	factor = lx
	end subroutine map_on_shell

	module subroutine map_on_shell_inverse (r, factor, p, lm2, x_free)
	real(default), dimension(2), intent(in) :: r
	real(default), intent(out) :: factor
	real(default), dimension(2), intent(out) :: p
	real(default), intent(in) :: lm2
	real(default), intent(in), optional :: x_free
	real(default) :: lx
	lx = lm2; if (present (x_free)) lx = lx + log (x_free)
	p(1) = 0
	p(2) = abs (log (r(1))) / lx
	factor = lx
	end subroutine map_on_shell_inverse

	@ %def map_on_shell
	@ %def map_on_shell_inverse
	@
	\subsubsection{Mapping for on-shell s-channel, single parameter}
	This is a pseudo-mapping which applies if there is actually just one
	parameter [[p]]. The output parameter [[r]] is fixed for on-shell
	production. The lone parameter $p_1$ is ignored. In the inverse mapping,
	it is returned zero.

	The parameter [[x_free]], if present, rescales the total energy. If
	it is less than one, the rescaled mass parameter $m^2$ should be increased
	accordingly.

	Public for access in unit test.
	<<SF mappings: public>>=
	public :: map_on_shell_single
	public :: map_on_shell_single_inverse
	<<SF mappings: sub interfaces>>=
	module subroutine map_on_shell_single (r, factor, p, lm2, x_free)
	real(default), dimension(1), intent(out) :: r
	real(default), intent(out) :: factor
	real(default), dimension(1), intent(in) :: p
	real(default), intent(in) :: lm2
	real(default), intent(in), optional :: x_free
	end subroutine map_on_shell_single
	module subroutine map_on_shell_single_inverse (r, factor, p, lm2, x_free)
	real(default), dimension(1), intent(in) :: r
	real(default), intent(out) :: factor
	real(default), dimension(1), intent(out) :: p
	real(default), intent(in) :: lm2
	real(default), intent(in), optional :: x_free
	end subroutine map_on_shell_single_inverse
	<<SF mappings: procedures>>=
	module subroutine map_on_shell_single (r, factor, p, lm2, x_free)
	real(default), dimension(1), intent(out) :: r
	real(default), intent(out) :: factor
	real(default), dimension(1), intent(in) :: p
	real(default), intent(in) :: lm2
	real(default), intent(in), optional :: x_free
	real(default) :: lx
	lx = lm2; if (present (x_free)) lx = lx + log (x_free)
	r(1) = exp (- lx)
	factor = 1
	end subroutine map_on_shell_single

	module subroutine map_on_shell_single_inverse (r, factor, p, lm2, x_free)
	real(default), dimension(1), intent(in) :: r
	real(default), intent(out) :: factor
	real(default), dimension(1), intent(out) :: p
	real(default), intent(in) :: lm2
	real(default), intent(in), optional :: x_free
	real(default) :: lx
	lx = lm2; if (present (x_free)) lx = lx + log (x_free)
	p(1) = 0
	factor = 1
	end subroutine map_on_shell_single_inverse

	@ %def map_on_shell_single
	@ %def map_on_shell_single_inverse
	@
	\subsubsection{Mapping for a Breit-Wigner resonance}
	This is the standard Breit-Wigner mapping. We apply it to a single
	variable, independently of or in addition to a unit-square mapping. We
	assume here that the limits for the variable are 0 and 1, and that the
	mass $m$ and width $w$ are rescaled appropriately, so they are
	dimensionless and usually between 0 and 1.

	If [[x_free]] is set, it rescales the total energy and thus mass and
	width, since these are defined with respect to the total energy.
	<<SF mappings: procedures>>=
	subroutine map_breit_wigner (r, factor, p, m, w, x_free)
	real(default), intent(out) :: r
	real(default), intent(out) :: factor
	real(default), intent(in) :: p
	real(default), intent(in) :: m
	real(default), intent(in) :: w
	real(default), intent(in), optional :: x_free
	real(default) :: m2, mw, a1, a2, a3, z, tmp
	m2 = m ** 2
	mw = m * w
	if (present (x_free)) then
	m2 = m2 / x_free
	mw = mw / x_free
	end if
	a1 = atan (- m2 / mw)
	a2 = atan ((1 - m2) / mw)
	a3 = (a2 - a1) * mw
	z = (1-p) * a1 + p * a2
	if (-pi/2 < z .and. z < pi/2) then
	tmp = tan (z)
	r = max (m2 + mw * tmp, 0._default)
	factor = a3 * (1 + tmp ** 2)
	else
	r = 0
	factor = 0
	end if
	end subroutine map_breit_wigner

	subroutine map_breit_wigner_inverse (r, factor, p, m, w, x_free)
	real(default), intent(in) :: r
	real(default), intent(out) :: factor
	real(default), intent(out) :: p
	real(default), intent(in) :: m
	real(default), intent(in) :: w
	real(default) :: m2, mw, a1, a2, a3, tmp
	real(default), intent(in), optional :: x_free
	m2 = m ** 2
	mw = m * w
	if (present (x_free)) then
	m2 = m2 / x_free
	mw = mw / x_free
	end if
	a1 = atan (- m2 / mw)
	a2 = atan ((1 - m2) / mw)
	a3 = (a2 - a1) * mw
	tmp = (r - m2) / mw
	p = (atan (tmp) - a1) / (a2 - a1)
	factor = a3 * (1 + tmp ** 2)
	end subroutine map_breit_wigner_inverse

	@ %def map_breit_wigner
	@ %def map_breit_wigner_inverse
	@
	\subsubsection{Mapping with endpoint enhancement}
	This is a mapping which is close to the unit mapping, except that at
	the endpoint(s), the output values are exponentially enhanced.
	\begin{equation}
	y = \tanh (a \tan (\frac{\pi}{2}x))
	\end{equation}
	We have two variants: one covers endpoints at $0$ and $1$
	symmetrically, while the other one (which essentially maps one-half of
	the range), covers only the endpoint at $1$.
	<<SF mappings: procedures>>=
	subroutine map_endpoint_1 (x3, factor, x1, a)
	real(default), intent(out) :: x3, factor
	real(default), intent(in) :: x1
	real(default), intent(in) :: a
	real(default) :: x2
	if (abs (x1) < 1) then
	x2 = tan (x1 * pi / 2)
	x3 = tanh (a * x2)
	factor = a * pi/2 * (1 + x2 ** 2) * (1 - x3 ** 2)
	else
	x3 = x1
	factor = 0
	end if
	end subroutine map_endpoint_1

	subroutine map_endpoint_inverse_1 (x3, factor, x1, a)
	real(default), intent(in) :: x3
	real(default), intent(out) :: x1, factor
	real(default), intent(in) :: a
	real(default) :: x2
	if (abs (x3) < 1) then
	x2 = atanh (x3) / a
	x1 = 2 / pi * atan (x2)
	factor = a * pi/2 * (1 + x2 ** 2) * (1 - x3 ** 2)
	else
	x1 = x3
	factor = 0
	end if
	end subroutine map_endpoint_inverse_1

	subroutine map_endpoint_01 (x4, factor, x0, a)
	real(default), intent(out) :: x4, factor
	real(default), intent(in) :: x0
	real(default), intent(in) :: a
	real(default) :: x1, x3
	x1 = 2 * x0 - 1
	call map_endpoint_1 (x3, factor, x1, a)
	x4 = (x3 + 1) / 2
	end subroutine map_endpoint_01

	subroutine map_endpoint_inverse_01 (x4, factor, x0, a)
	real(default), intent(in) :: x4
	real(default), intent(out) :: x0, factor
	real(default), intent(in) :: a
	real(default) :: x1, x3
	x3 = 2 * x4 - 1
	call map_endpoint_inverse_1 (x3, factor, x1, a)
	x0 = (x1 + 1) / 2
	end subroutine map_endpoint_inverse_01

	@ %def map_endpoint_1
	@ %def map_endpoint_inverse_1
	@ %def map_endpoint_01
	@ %def map_endpoint_inverse_01
	@
	\subsubsection{Mapping with endpoint enhancement (ISR)}
	This is another endpoint mapping. It is designed to flatten the ISR
	singularity which is of power type at $x=1$, i.e., if
	\begin{equation}
	\sigma = \int_0^1 dx\,f(x)\,G(x)
	= \int_0^1 dx\,\epsilon(1-x)^{-1+\epsilon} G(x),
	\end{equation}
	we replace this by
	\begin{equation}
	r = x^\epsilon \quad\Longrightarrow\quad
	\sigma = \int_0^1 dr\,G(1- (1-r)^{1/\epsilon}).
	\end{equation}
	We expect that $\epsilon$ is small.

	The actual mapping is $r\to x$ (so $x$ emerges closer to $1$). The
	Jacobian that we return is thus $1/f(x)$. We compute the mapping in
	terms of $\bar x\equiv 1 - x$, so we can achieve the required precision.
	Because some compilers show quite wild numeric fluctuations, we
	internally convert numeric types to explicit [[double]] precision.
	<<SF mappings: public>>=
	public :: map_power_1
	public :: map_power_inverse_1
	<<SF mappings: sub interfaces>>=
	module subroutine map_power_1 (xb, factor, rb, eps)
	real(default), intent(out) :: xb, factor
	real(default), intent(in) :: rb
	real(default), intent(in) :: eps
	end subroutine map_power_1
	module subroutine map_power_inverse_1 (xb, factor, rb, eps)
	real(default), intent(in) :: xb
	real(default), intent(out) :: rb, factor
	real(default), intent(in) :: eps
	end subroutine map_power_inverse_1
	<<SF mappings: procedures>>=
	module subroutine map_power_1 (xb, factor, rb, eps)
	real(default), intent(out) :: xb, factor
	real(default), intent(in) :: rb
	real(double) :: rb_db, factor_db, eps_db, xb_db
	real(default), intent(in) :: eps
	rb_db = real (rb, kind=double)
	eps_db = real (eps, kind=double)
	xb_db = rb_db ** (1 / eps_db)
	if (rb_db > 0) then
	factor_db = xb_db / rb_db / eps_db
	factor = real (factor_db, kind=default)
	else
	factor = 0
	end if
	xb = real (xb_db, kind=default)
	end subroutine map_power_1

	module subroutine map_power_inverse_1 (xb, factor, rb, eps)
	real(default), intent(in) :: xb
	real(default), intent(out) :: rb, factor
	real(double) :: xb_db, factor_db, eps_db, rb_db
	real(default), intent(in) :: eps
	xb_db = real (xb, kind=double)
	eps_db = real (eps, kind=double)
	rb_db = xb_db ** eps_db
	if (xb_db > 0) then
	factor_db = xb_db / rb_db / eps_db
	factor = real (factor_db, kind=default)
	else
	factor = 0
	end if
	rb = real (rb_db, kind=default)
	end subroutine map_power_inverse_1

	@ %def map_power_1
	@ %def map_power_inverse_1
	@ Here we apply a power mapping to both endpoints. We divide the
	interval in two equal halves and apply the power mapping for the
	nearest endpoint, either $0$ or $1$.
	<<SF mappings: procedures>>=
	subroutine map_power_01 (y, yb, factor, r, eps)
	real(default), intent(out) :: y, yb, factor
	real(default), intent(in) :: r
	real(default), intent(in) :: eps
	real(default) :: u, ub, zp, zm
	u = 2 * r - 1
	if (u > 0) then
	ub = 2 * (1 - r)
	call map_power_1 (zm, factor, ub, eps)
	zp = 2 - zm
	else if (u < 0) then
	ub = 2 * r
	call map_power_1 (zp, factor, ub, eps)
	zm = 2 - zp
	else
	factor = 1 / eps
	zp = 1
	zm = 1
	end if
	y = zp / 2
	yb = zm / 2
	end subroutine map_power_01

	subroutine map_power_inverse_01 (y, yb, factor, r, eps)
	real(default), intent(in) :: y, yb
	real(default), intent(out) :: r, factor
	real(default), intent(in) :: eps
	real(default) :: ub, zp, zm
	zp = 2 * y
	zm = 2 * yb
	if (zm < zp) then
	call map_power_inverse_1 (zm, factor, ub, eps)
	r = 1 - ub / 2
	else if (zp < zm) then
	call map_power_inverse_1 (zp, factor, ub, eps)
	r = ub / 2
	else
	factor = 1 / eps
	ub = 1
	r = ub / 2
	end if
	end subroutine map_power_inverse_01

	@ %def map_power_01
	@ %def map_power_inverse_01
	@
	\subsubsection{Structure-function channels}
	A structure-function chain parameterization (channel) may contain a
	mapping that applies to multiple structure functions. This is
	described by an extension of the [[sf_mapping_t]] type. In addition,
	it may contain mappings that apply to (other) individual structure
	functions. The details of these mappings are implementation-specific.

	The [[sf_channel_t]] type combines this information. It contains an
	array of map codes, one for each structure-function entry. The code
	values are:
	\begin{description}
	\item[none] MC input parameters $r$ directly become energy fractions $x$
	\item[single] default mapping for a single structure-function entry
	\item[multi/s] map $r\to x$ such that one MC input parameter is $\hat s/s$
	\item[multi/resonance] as before, adapted to s-channel resonance
	\item[multi/on-shell] as before, adapted to an on-shell particle in
	the s channel
	\item[multi/endpoint] like multi/s, but enhance the region near $r_i=1$
	\item[multi/endpoint/res] endpoint mapping with resonance
	\item[multi/endpoint/os] endpoint mapping for on-shell
	\item[multi/power/os] like multi/endpoint, regulating a power singularity
	\end{description}
	<<SF mappings: parameters>>=
	integer, parameter :: SFMAP_NONE = 0
	integer, parameter :: SFMAP_SINGLE = 1
	integer, parameter :: SFMAP_MULTI_S = 2
	integer, parameter :: SFMAP_MULTI_RES = 3
	integer, parameter :: SFMAP_MULTI_ONS = 4
	integer, parameter :: SFMAP_MULTI_EP = 5
	integer, parameter :: SFMAP_MULTI_EPR = 6
	integer, parameter :: SFMAP_MULTI_EPO = 7
	integer, parameter :: SFMAP_MULTI_IP = 8
	integer, parameter :: SFMAP_MULTI_IPR = 9
	integer, parameter :: SFMAP_MULTI_IPO = 10
	integer, parameter :: SFMAP_MULTI_EI = 11
	integer, parameter :: SFMAP_MULTI_SRS = 13
	integer, parameter :: SFMAP_MULTI_SON = 14

	@ %def SFMAP_NONE SFMAP_SINGLE
	@ %def SFMAP_MULTI_S SFMAP_MULTI_RES SFMAP_MULTI_ONS
	@ %def SFMAP_MULTI_EP SFMAP_MULTI_EPR SFMAP_MULTI_EPO
	@ %def SFMAP_MULTI_IP SFMAP_MULTI_IPR SFMAP_MULTI_IPO
	@ %def SFMAP_MULTI_EI
	@ %def SFMAP_MULTI_SRS SFMAP_MULTI_SON
	@ Then, it contains an allocatable entry for the multi mapping. This
	entry holds the MC-parameter indices on which the mapping applies
	(there may be more than one MC parameter per structure-function entry)
	and any parameters associated with the mapping.

	There can be only one multi-mapping per channel.
	<<SF mappings: public>>=
	public :: sf_channel_t
	<<SF mappings: types>>=
	type :: sf_channel_t
	integer, dimension(:), allocatable :: map_code
	class(sf_mapping_t), allocatable :: multi_mapping
	contains
	<<SF mappings: sf channel: TBP>>
	end type sf_channel_t

	@ %def sf_channel_t
	@ The output format prints a single character for each
	structure-function entry and, if applicable, an account of the mapping
	parameters.
	<<SF mappings: sf channel: TBP>>=
	procedure :: write => sf_channel_write
	<<SF mappings: sub interfaces>>=
	module subroutine sf_channel_write (object, unit)
	class(sf_channel_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_channel_write
	<<SF mappings: procedures>>=
	module subroutine sf_channel_write (object, unit)
	class(sf_channel_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	if (allocated (object%map_code)) then
	do i = 1, size (object%map_code)
	select case (object%map_code (i))
	case (SFMAP_NONE)
	write (u, "(1x,A)", advance="no") "-"
	case (SFMAP_SINGLE)
	write (u, "(1x,A)", advance="no") "+"
	case (SFMAP_MULTI_S)
	write (u, "(1x,A)", advance="no") "s"
	case (SFMAP_MULTI_RES, SFMAP_MULTI_SRS)
	write (u, "(1x,A)", advance="no") "r"
	case (SFMAP_MULTI_ONS, SFMAP_MULTI_SON)
	write (u, "(1x,A)", advance="no") "o"
	case (SFMAP_MULTI_EP)
	write (u, "(1x,A)", advance="no") "e"
	case (SFMAP_MULTI_EPR)
	write (u, "(1x,A)", advance="no") "p"
	case (SFMAP_MULTI_EPO)
	write (u, "(1x,A)", advance="no") "q"
	case (SFMAP_MULTI_IP)
	write (u, "(1x,A)", advance="no") "i"
	case (SFMAP_MULTI_IPR)
	write (u, "(1x,A)", advance="no") "i"
	case (SFMAP_MULTI_IPO)
	write (u, "(1x,A)", advance="no") "i"
	case (SFMAP_MULTI_EI)
	write (u, "(1x,A)", advance="no") "i"
	case default
	write (u, "(1x,A)", advance="no") "?"
	end select
	end do
	else
	write (u, "(1x,A)", advance="no") "-"
	end if
	if (allocated (object%multi_mapping)) then
	write (u, "(1x,'/')", advance="no")
	call object%multi_mapping%write (u)
	else
	write (u, *)
	end if
	end subroutine sf_channel_write

	@ %def sf_channel_write
	@ Initializer for a single [[sf_channel]] object.
	<<SF mappings: sf channel: TBP>>=
	procedure :: init => sf_channel_init
	<<SF mappings: sub interfaces>>=
	module subroutine sf_channel_init (channel, n_strfun)
	class(sf_channel_t), intent(out) :: channel
	integer, intent(in) :: n_strfun
	end subroutine sf_channel_init
	<<SF mappings: procedures>>=
	module subroutine sf_channel_init (channel, n_strfun)
	class(sf_channel_t), intent(out) :: channel
	integer, intent(in) :: n_strfun
	allocate (channel%map_code (n_strfun))
	channel%map_code = SFMAP_NONE
	end subroutine sf_channel_init

	@ %def sf_channel_init
	@ Assignment. This merely copies intrinsic assignment.
	<<SF mappings: sf channel: TBP>>=
	generic :: assignment (=) => sf_channel_assign
	procedure :: sf_channel_assign
	<<SF mappings: sub interfaces>>=
	module subroutine sf_channel_assign (copy, original)
	class(sf_channel_t), intent(out) :: copy
	type(sf_channel_t), intent(in) :: original
	end subroutine sf_channel_assign
	<<SF mappings: procedures>>=
	module subroutine sf_channel_assign (copy, original)
	class(sf_channel_t), intent(out) :: copy
	type(sf_channel_t), intent(in) :: original
	allocate (copy%map_code (size (original%map_code)))
	copy%map_code = original%map_code
	if (allocated (original%multi_mapping)) then
	allocate (copy%multi_mapping, source = original%multi_mapping)
	end if
	end subroutine sf_channel_assign

	@ %def sf_channel_assign
	@ This initializer allocates an array of channels with common number of
	structure-function entries, therefore it is not a type-bound procedure.
	<<SF mappings: public>>=
	public :: allocate_sf_channels
	<<SF mappings: sub interfaces>>=
	module subroutine allocate_sf_channels (channel, n_channel, n_strfun)
	type(sf_channel_t), dimension(:), intent(out), allocatable :: channel
	integer, intent(in) :: n_channel
	integer, intent(in) :: n_strfun
	end subroutine allocate_sf_channels
	<<SF mappings: procedures>>=
	module subroutine allocate_sf_channels (channel, n_channel, n_strfun)
	type(sf_channel_t), dimension(:), intent(out), allocatable :: channel
	integer, intent(in) :: n_channel
	integer, intent(in) :: n_strfun
	integer :: c
	allocate (channel (n_channel))
	do c = 1, n_channel
	call channel(c)%init (n_strfun)
	end do
	end subroutine allocate_sf_channels

	@ %def allocate_sf_channels
	@ This marks a given subset of indices as single-mapping.
	<<SF mappings: sf channel: TBP>>=
	procedure :: activate_mapping => sf_channel_activate_mapping
	<<SF mappings: sub interfaces>>=
	module subroutine sf_channel_activate_mapping (channel, i_sf)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	end subroutine sf_channel_activate_mapping
	<<SF mappings: procedures>>=
	module subroutine sf_channel_activate_mapping (channel, i_sf)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	channel%map_code(i_sf) = SFMAP_SINGLE
	end subroutine sf_channel_activate_mapping

	@ %def sf_channel_activate_mapping
	@ This sets an s-channel multichannel mapping. The parameter indices
	are not yet set. Gfortran 7/8/9 bug, has to remain in module.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_s_mapping => sf_channel_set_s_mapping
	<<SF mappings: main procedures>>=
	subroutine sf_channel_set_s_mapping (channel, i_sf, power)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: power
	channel%map_code(i_sf) = SFMAP_MULTI_S
	allocate (sf_s_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_s_mapping_t)
	call mapping%init (power)
	end select
	end subroutine sf_channel_set_s_mapping

	@ %def sf_channel_set_s_mapping
	@ This sets an s-channel resonance multichannel mapping. Gfortran 7/8/9
	bug, has to remain in module.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_res_mapping => sf_channel_set_res_mapping
	<<SF mappings: main procedures>>=
	subroutine sf_channel_set_res_mapping (channel, i_sf, m, w, single)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in) :: m, w
	logical, intent(in) :: single
	if (single) then
	channel%map_code(i_sf) = SFMAP_MULTI_SRS
	allocate (sf_res_mapping_single_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_res_mapping_single_t)
	call mapping%init (m, w)
	end select
	else
	channel%map_code(i_sf) = SFMAP_MULTI_RES
	allocate (sf_res_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_res_mapping_t)
	call mapping%init (m, w)
	end select
	end if
	end subroutine sf_channel_set_res_mapping

	@ %def sf_channel_set_res_mapping
	@ This sets an s-channel on-shell multichannel mapping. The length of the
	[[i_sf]] array must be 2. (The first parameter actually becomes an
	irrelevant dummy.) Gfortran 7/8/9 bug, has to remain in module.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_os_mapping => sf_channel_set_os_mapping
	<<SF mappings: main procedures>>=
	subroutine sf_channel_set_os_mapping (channel, i_sf, m, single)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in) :: m
	logical, intent(in) :: single
	if (single) then
	channel%map_code(i_sf) = SFMAP_MULTI_SON
	allocate (sf_os_mapping_single_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_os_mapping_single_t)
	call mapping%init (m)
	end select
	else
	channel%map_code(i_sf) = SFMAP_MULTI_ONS
	allocate (sf_os_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_os_mapping_t)
	call mapping%init (m)
	end select
	end if
	end subroutine sf_channel_set_os_mapping

	@ %def sf_channel_set_os_mapping
	@ This sets an s-channel endpoint mapping. The parameter $a$ is the
	slope parameter (default 1); increasing it moves the endpoint region
	(at $x=1$ to lower values in the input parameter) even more. Gfortran
	7/8/9 bug, has to remain in the module.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_ep_mapping => sf_channel_set_ep_mapping
	<<SF mappings: main procedures>>=
	subroutine sf_channel_set_ep_mapping (channel, i_sf, a)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: a
	channel%map_code(i_sf) = SFMAP_MULTI_EP
	allocate (sf_ep_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_ep_mapping_t)
	call mapping%init (a = a)
	end select
	end subroutine sf_channel_set_ep_mapping

	@ %def sf_channel_set_ep_mapping
	@ This sets a resonant endpoint mapping. Gfortran
	7/8/9 bug, has to remain in the module.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_epr_mapping => sf_channel_set_epr_mapping
	<<SF mappings: main procedures>>=
	subroutine sf_channel_set_epr_mapping (channel, i_sf, a, m, w)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in) :: a, m, w
	channel%map_code(i_sf) = SFMAP_MULTI_EPR
	allocate (sf_epr_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_epr_mapping_t)
	call mapping%init (a, m, w)
	end select
	end subroutine sf_channel_set_epr_mapping

	@ %def sf_channel_set_epr_mapping
	@ This sets an on-shell endpoint mapping. Gfortran
	7/8/9 bug, has to remain in the module.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_epo_mapping => sf_channel_set_epo_mapping
	<<SF mappings: main procedures>>=
	subroutine sf_channel_set_epo_mapping (channel, i_sf, a, m)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in) :: a, m
	channel%map_code(i_sf) = SFMAP_MULTI_EPO
	allocate (sf_epo_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_epo_mapping_t)
	call mapping%init (a, m)
	end select
	end subroutine sf_channel_set_epo_mapping

	@ %def sf_channel_set_epo_mapping
	@ This sets an s-channel power mapping, regulating a singularity of
	type $(1-x)^{-1+\epsilon}$. The parameter $\epsilon$ depends on the
	structure function. Gfortran 7/8/9 bug, has to remain in the module.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_ip_mapping => sf_channel_set_ip_mapping
	<<SF mappings: main procedures>>=
	subroutine sf_channel_set_ip_mapping (channel, i_sf, eps)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: eps
	channel%map_code(i_sf) = SFMAP_MULTI_IP
	allocate (sf_ip_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_ip_mapping_t)
	call mapping%init (eps)
	end select
	end subroutine sf_channel_set_ip_mapping

	@ %def sf_channel_set_ip_mapping
	@ This sets an s-channel resonant power mapping, regulating a
	singularity of type $(1-x)^{-1+\epsilon}$ in the presence of an
	s-channel resonance. The parameter $\epsilon$ depends on the
	structure function. Gfortran 7/8/9 bug, has to remain in the module.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_ipr_mapping => sf_channel_set_ipr_mapping
	<<SF mappings: main procedures>>=
	subroutine sf_channel_set_ipr_mapping (channel, i_sf, eps, m, w)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: eps, m, w
	channel%map_code(i_sf) = SFMAP_MULTI_IPR
	allocate (sf_ipr_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_ipr_mapping_t)
	call mapping%init (eps, m, w)
	end select
	end subroutine sf_channel_set_ipr_mapping

	@ %def sf_channel_set_ipr_mapping
	@ This sets an on-shell power mapping, regulating a
	singularity of type $(1-x)^{-1+\epsilon}$ for the production of a
	single on-shell particle.. The parameter $\epsilon$ depends on the
	structure function. Gfortran 7/8/9 bug: has to remain in module.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_ipo_mapping => sf_channel_set_ipo_mapping
	<<SF mappings: main procedures>>=
	subroutine sf_channel_set_ipo_mapping (channel, i_sf, eps, m)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: eps, m
	channel%map_code(i_sf) = SFMAP_MULTI_IPO
	allocate (sf_ipo_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_ipo_mapping_t)
	call mapping%init (eps, m)
	end select
	end subroutine sf_channel_set_ipo_mapping

	@ %def sf_channel_set_ipo_mapping
	@ This sets a combined endpoint/ISR mapping. Gfortran 7/8/9 bug, remains
	in module.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_ei_mapping => sf_channel_set_ei_mapping
	<<SF mappings: main procedures>>=
	subroutine sf_channel_set_ei_mapping (channel, i_sf, a, eps)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: a, eps
	channel%map_code(i_sf) = SFMAP_MULTI_EI
	allocate (sf_ei_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_ei_mapping_t)
	call mapping%init (a, eps)
	end select
	end subroutine sf_channel_set_ei_mapping

	@ %def sf_channel_set_ei_mapping
	@ This sets a combined endpoint/ISR mapping with resonance. Gfortran
	7/8/9 bug, remains in module.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_eir_mapping => sf_channel_set_eir_mapping
	<<SF mappings: main procedures>>=
	subroutine sf_channel_set_eir_mapping (channel, i_sf, a, eps, m, w)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: a, eps, m, w
	channel%map_code(i_sf) = SFMAP_MULTI_EI
	allocate (sf_eir_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_eir_mapping_t)
	call mapping%init (a, eps, m, w)
	end select
	end subroutine sf_channel_set_eir_mapping

	@ %def sf_channel_set_eir_mapping
	@ This sets a combined endpoint/ISR mapping, on-shell. Gfortran 7/8/9 bug,
	remains in module.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_eio_mapping => sf_channel_set_eio_mapping
	<<SF mappings: main procedures>>=
	subroutine sf_channel_set_eio_mapping (channel, i_sf, a, eps, m)
	class(sf_channel_t), intent(inout) :: channel
	integer, dimension(:), intent(in) :: i_sf
	real(default), intent(in), optional :: a, eps, m
	channel%map_code(i_sf) = SFMAP_MULTI_EI
	allocate (sf_eio_mapping_t :: channel%multi_mapping)
	select type (mapping => channel%multi_mapping)
	type is (sf_eio_mapping_t)
	call mapping%init (a, eps, m)
	end select
	end subroutine sf_channel_set_eio_mapping

	@ %def sf_channel_set_eio_mapping
	@ Return true if the mapping code at position [[i_sf]] is [[SFMAP_SINGLE]].
	<<SF mappings: sf channel: TBP>>=
	procedure :: is_single_mapping => sf_channel_is_single_mapping
	<<SF mappings: sub interfaces>>=
	module function sf_channel_is_single_mapping (channel, i_sf) result (flag)
	class(sf_channel_t), intent(in) :: channel
	integer, intent(in) :: i_sf
	logical :: flag
	end function sf_channel_is_single_mapping
	<<SF mappings: procedures>>=
	module function sf_channel_is_single_mapping (channel, i_sf) result (flag)
	class(sf_channel_t), intent(in) :: channel
	integer, intent(in) :: i_sf
	logical :: flag
	flag = channel%map_code(i_sf) == SFMAP_SINGLE
	end function sf_channel_is_single_mapping

	@ %def sf_channel_is_single_mapping
	@ Return true if the mapping code at position [[i_sf]] is any of the
	[[SFMAP_MULTI]] mappings.
	<<SF mappings: sf channel: TBP>>=
	procedure :: is_multi_mapping => sf_channel_is_multi_mapping
	<<SF mappings: sub interfaces>>=
	module function sf_channel_is_multi_mapping (channel, i_sf) result (flag)
	class(sf_channel_t), intent(in) :: channel
	integer, intent(in) :: i_sf
	logical :: flag
	end function sf_channel_is_multi_mapping
	<<SF mappings: procedures>>=
	module function sf_channel_is_multi_mapping (channel, i_sf) result (flag)
	class(sf_channel_t), intent(in) :: channel
	integer, intent(in) :: i_sf
	logical :: flag
	select case (channel%map_code(i_sf))
	case (SFMAP_NONE, SFMAP_SINGLE)
	flag = .false.
	case default
	flag = .true.
	end select
	end function sf_channel_is_multi_mapping

	@ %def sf_channel_is_multi_mapping
	@ Return the number of parameters that the multi-mapping requires. The
	mapping object must be allocated.
	<<SF mappings: sf channel: TBP>>=
	procedure :: get_multi_mapping_n_par => sf_channel_get_multi_mapping_n_par
	<<SF mappings: sub interfaces>>=
	module function sf_channel_get_multi_mapping_n_par (channel) result (n_par)
	class(sf_channel_t), intent(in) :: channel
	integer :: n_par
	end function sf_channel_get_multi_mapping_n_par
	<<SF mappings: procedures>>=
	module function sf_channel_get_multi_mapping_n_par (channel) result (n_par)
	class(sf_channel_t), intent(in) :: channel
	integer :: n_par
	if (allocated (channel%multi_mapping)) then
	n_par = channel%multi_mapping%get_n_dim ()
	else
	n_par = 0
	end if
	end function sf_channel_get_multi_mapping_n_par

	@ %def sf_channel_get_multi_mapping_n_par
	@ Return true if there is any nontrivial mapping in any of the channels.
	<<SF mappings: public>>=
	public :: any_sf_channel_has_mapping
	<<SF mappings: sub interfaces>>=
	module function any_sf_channel_has_mapping (channel) result (flag)
	type(sf_channel_t), dimension(:), intent(in) :: channel
	logical :: flag
	end function any_sf_channel_has_mapping
	<<SF mappings: procedures>>=
	module function any_sf_channel_has_mapping (channel) result (flag)
	type(sf_channel_t), dimension(:), intent(in) :: channel
	logical :: flag
	integer :: c
	flag = .false.
	do c = 1, size (channel)
	flag = flag .or. any (channel(c)%map_code /= SFMAP_NONE)
	end do
	end function any_sf_channel_has_mapping

	@ %def any_sf_channel_has_mapping
	@ Set a parameter index for an active multi mapping. We assume that
	the index array is allocated properly.
	<<SF mappings: sf channel: TBP>>=
	procedure :: set_par_index => sf_channel_set_par_index
	<<SF mappings: sub interfaces>>=
	module subroutine sf_channel_set_par_index (channel, j, i_par)
	class(sf_channel_t), intent(inout) :: channel
	integer, intent(in) :: j
	integer, intent(in) :: i_par
	end subroutine sf_channel_set_par_index
	<<SF mappings: procedures>>=
	module subroutine sf_channel_set_par_index (channel, j, i_par)
	class(sf_channel_t), intent(inout) :: channel
	integer, intent(in) :: j
	integer, intent(in) :: i_par
	associate (mapping => channel%multi_mapping)
	if (j >= 1 .and. j <= mapping%get_n_dim ()) then
	if (mapping%get_index (j) == 0) then
	call channel%multi_mapping%set_index (j, i_par)
	else
	call msg_bug ("Structure-function setup: mapping index set twice")
	end if
	else
	call msg_bug ("Structure-function setup: mapping index out of range")
	end if
	end associate
	end subroutine sf_channel_set_par_index

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

	module sf_mappings_ut
	use unit_tests
	use sf_mappings_uti

	<<Standard module head>>

	<<SF mappings: public test>>

	contains

	<<SF mappings: test driver>>

	end module sf_mappings_ut
	@ %def sf_mappings_ut
	@
	<<[[sf_mappings_uti.f90]]>>=
	<<File header>>

	module sf_mappings_uti

	<<Use kinds>>
	use format_defs, only: FMT_11, FMT_12, FMT_13, FMT_14, FMT_15, FMT_16

	use sf_mappings

	<<Standard module head>>

	<<SF mappings: test declarations>>

	contains

	<<SF mappings: tests>>

	end module sf_mappings_uti
	@ %def sf_mappings_ut
	@ API: driver for the unit tests below.
	<<SF mappings: public test>>=
	public :: sf_mappings_test
	<<SF mappings: test driver>>=
	subroutine sf_mappings_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF mappings: execute tests>>
	end subroutine sf_mappings_test

	@ %def sf_mappings_test
	@
	\subsubsection{Check standard mapping}
	Probe the standard mapping of the unit square for different parameter
	values. Also calculates integrals. For a finite number of bins, they differ
	slightly from $1$, but the result is well-defined because we are not using
	random points.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_1, "sf_mappings_1", &
	"standard pair mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_1
	<<SF mappings: tests>>=
	subroutine sf_mappings_1 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p

	write (u, "(A)") "* Test output: sf_mappings_1"
	write (u, "(A)") "* Purpose: probe standard mapping"
	write (u, "(A)")

	allocate (sf_s_mapping_t :: mapping)
	select type (mapping)
	type is (sf_s_mapping_t)
	call mapping%init ()
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.1):"
	p = [0.1_default, 0.1_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)
	allocate (sf_s_mapping_t :: mapping)
	select type (mapping)
	type is (sf_s_mapping_t)
	call mapping%init (power=2._default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	write (u, *)
	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.1):"
	p = [0.1_default, 0.1_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

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

	end subroutine sf_mappings_1

	@ %def sf_mappings_1
	@
	\subsubsection{Channel entries}
	Construct channel entries and print them.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_2, "sf_mappings_2", &
	"structure-function mapping channels", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_2
	<<SF mappings: tests>>=
	subroutine sf_mappings_2 (u)
	integer, intent(in) :: u
	type(sf_channel_t), dimension(:), allocatable :: channel
	integer :: c

	write (u, "(A)") "* Test output: sf_mappings_2"
	write (u, "(A)") "* Purpose: construct and display &
	&mapping-channel objects"
	write (u, "(A)")

	call allocate_sf_channels (channel, n_channel = 8, n_strfun = 2)
	call channel(2)%activate_mapping ([1])
	call channel(3)%set_s_mapping ([1,2])
	call channel(4)%set_s_mapping ([1,2], power=2._default)
	call channel(5)%set_res_mapping ([1,2], m = 0.5_default, w = 0.1_default, single = .false.)
	call channel(6)%set_os_mapping ([1,2], m = 0.5_default, single = .false.)
	call channel(7)%set_res_mapping ([1], m = 0.5_default, w = 0.1_default, single = .true.)
	call channel(8)%set_os_mapping ([1], m = 0.5_default, single = .true.)

	call channel(3)%set_par_index (1, 1)
	call channel(3)%set_par_index (2, 4)

	call channel(4)%set_par_index (1, 1)
	call channel(4)%set_par_index (2, 4)

	call channel(5)%set_par_index (1, 1)
	call channel(5)%set_par_index (2, 3)

	call channel(6)%set_par_index (1, 1)
	call channel(6)%set_par_index (2, 2)

	call channel(7)%set_par_index (1, 1)

	call channel(8)%set_par_index (1, 1)

	do c = 1, size (channel)
	write (u, "(I0,':')", advance="no") c
	call channel(c)%write (u)
	end do

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

	end subroutine sf_mappings_2

	@ %def sf_mappings_2
	@
	\subsubsection{Check resonance mapping}
	Probe the resonance mapping of the unit square for different parameter
	values. Also calculates integrals. For a finite number of bins, they differ
	slightly from $1$, but the result is well-defined because we are not using
	random points.

	The resonance mass is at $1/2$ the energy, the width is $1/10$.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_3, "sf_mappings_3", &
	"resonant pair mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_3
	<<SF mappings: tests>>=
	subroutine sf_mappings_3 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p

	write (u, "(A)") "* Test output: sf_mappings_3"
	write (u, "(A)") "* Purpose: probe resonance pair mapping"
	write (u, "(A)")

	allocate (sf_res_mapping_t :: mapping)
	select type (mapping)
	type is (sf_res_mapping_t)
	call mapping%init (0.5_default, 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.1):"
	p = [0.1_default, 0.1_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_3

	@ %def sf_mappings_3
	@
	\subsubsection{Check on-shell mapping}
	Probe the on-shell mapping of the unit square for different parameter
	values. Also calculates integrals. In this case, the Jacobian is
	constant and given by $\|\log m^2\|$, so this is also the value of the
	integral. The factor results from the variable change in the $\delta$
	function $\delta (m^2 - x_1x_2)$ which multiplies the cross section
	for the case at hand.

	For the test, the (rescaled) resonance mass is set at $1/2$ the
	energy.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_4, "sf_mappings_4", &
	"on-shell pair mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_4
	<<SF mappings: tests>>=
	subroutine sf_mappings_4 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p

	write (u, "(A)") "* Test output: sf_mappings_4"
	write (u, "(A)") "* Purpose: probe on-shell pair mapping"
	write (u, "(A)")

	allocate (sf_os_mapping_t :: mapping)
	select type (mapping)
	type is (sf_os_mapping_t)
	call mapping%init (0.5_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0,0.1):"
	p = [0._default, 0.1_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0,1.0):"
	p = [0._default, 1.0_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_4

	@ %def sf_mappings_4
	@
	\subsubsection{Check endpoint mapping}
	Probe the endpoint mapping of the unit square for different parameter
	values. Also calculates integrals. For a finite number of bins, they differ
	slightly from $1$, but the result is well-defined because we are not using
	random points.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_5, "sf_mappings_5", &
	"endpoint pair mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_5
	<<SF mappings: tests>>=
	subroutine sf_mappings_5 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p

	write (u, "(A)") "* Test output: sf_mappings_5"
	write (u, "(A)") "* Purpose: probe endpoint pair mapping"
	write (u, "(A)")

	allocate (sf_ep_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ep_mapping_t)
	call mapping%init ()
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_5

	@ %def sf_mappings_5
	@
	\subsubsection{Check endpoint resonant mapping}
	Probe the endpoint mapping with resonance. Also calculates integrals.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_6, "sf_mappings_6", &
	"endpoint resonant mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_6
	<<SF mappings: tests>>=
	subroutine sf_mappings_6 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p

	write (u, "(A)") "* Test output: sf_mappings_6"
	write (u, "(A)") "* Purpose: probe endpoint resonant mapping"
	write (u, "(A)")

	allocate (sf_epr_mapping_t :: mapping)
	select type (mapping)
	type is (sf_epr_mapping_t)
	call mapping%init (a = 1._default, m = 0.5_default, w = 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

	write (u, "(A)")
	write (u, "(A)") "* Same mapping without resonance:"
	write (u, "(A)")

	allocate (sf_epr_mapping_t :: mapping)
	select type (mapping)
	type is (sf_epr_mapping_t)
	call mapping%init (a = 1._default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_6

	@ %def sf_mappings_6
	@
	\subsubsection{Check endpoint on-shell mapping}
	Probe the endpoint mapping with an on-shell particle. Also calculates
	integrals.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_7, "sf_mappings_7", &
	"endpoint on-shell mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_7
	<<SF mappings: tests>>=
	subroutine sf_mappings_7 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p

	write (u, "(A)") "* Test output: sf_mappings_7"
	write (u, "(A)") "* Purpose: probe endpoint on-shell mapping"
	write (u, "(A)")

	allocate (sf_epo_mapping_t :: mapping)
	select type (mapping)
	type is (sf_epo_mapping_t)
	call mapping%init (a = 1._default, m = 0.5_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0):"
	p = [0._default, 0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1,0.5):"
	p = [0.1_default, 0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_7

	@ %def sf_mappings_7
	@
	\subsubsection{Check power mapping}
	Probe the power mapping of the unit square for different parameter
	values. Also calculates integrals. For a finite number of bins, they differ
	slightly from $1$, but the result is well-defined because we are not using
	random points.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_8, "sf_mappings_8", &
	"power pair mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_8
	<<SF mappings: tests>>=
	subroutine sf_mappings_8 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p, pb

	write (u, "(A)") "* Test output: sf_mappings_8"
	write (u, "(A)") "* Purpose: probe power pair mapping"
	write (u, "(A)")

	allocate (sf_ip_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ip_mapping_t)
	call mapping%init (eps = 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0.5):"
	p = [0._default, 0.5_default]
	pb= [1._default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	pb= [0.5_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9,0.5):"
	p = [0.9_default, 0.5_default]
	pb= [0.1_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	pb= [0.3_default, 0.8_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.8):"
	p = [0.7_default, 0.8_default]
	pb= [0.3_default, 0.2_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.99,0.02):"
	p = [0.99_default, 0.02_default]
	pb= [0.01_default, 0.98_default]
	call mapping%check (u, p, pb, FMT_14, FMT_12)

	write (u, *)
	write (u, "(A)") "Probe at (0.99,0.98):"
	p = [0.99_default, 0.98_default]
	pb= [0.01_default, 0.02_default]
	call mapping%check (u, p, pb, FMT_14, FMT_12)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_8

	@ %def sf_mappings_8
	@
	\subsubsection{Check resonant power mapping}
	Probe the power mapping of the unit square, adapted for an s-channel
	resonance, for different parameter values. Also calculates integrals.
	For a finite number of bins, they differ slightly from $1$, but the
	result is well-defined because we are not using random points.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_9, "sf_mappings_9", &
	"power resonance mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_9
	<<SF mappings: tests>>=
	subroutine sf_mappings_9 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p, pb

	write (u, "(A)") "* Test output: sf_mappings_9"
	write (u, "(A)") "* Purpose: probe power resonant pair mapping"
	write (u, "(A)")

	allocate (sf_ipr_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ipr_mapping_t)
	call mapping%init (eps = 0.1_default, m = 0.5_default, w = 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0.5):"
	p = [0._default, 0.5_default]
	pb= [1._default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	pb= [0.5_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9,0.5):"
	p = [0.9_default, 0.5_default]
	pb= [0.1_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	pb= [0.3_default, 0.8_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.8):"
	p = [0.7_default, 0.8_default]
	pb= [0.3_default, 0.2_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9999,0.02):"
	p = [0.9999_default, 0.02_default]
	pb= [0.0001_default, 0.98_default]
	call mapping%check (u, p, pb, FMT_11, FMT_12)

	write (u, *)
	write (u, "(A)") "Probe at (0.9999,0.98):"
	p = [0.9999_default, 0.98_default]
	pb= [0.0001_default, 0.02_default]
	call mapping%check (u, p, pb, FMT_11, FMT_12)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

	write (u, "(A)")
	write (u, "(A)") "* Same mapping without resonance:"
	write (u, "(A)")

	allocate (sf_ipr_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ipr_mapping_t)
	call mapping%init (eps = 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0.5):"
	p = [0._default, 0.5_default]
	pb= [1._default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.5,0.5):"
	p = [0.5_default, 0.5_default]
	pb= [0.5_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9,0.5):"
	p = [0.9_default, 0.5_default]
	pb= [0.1_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.2):"
	p = [0.7_default, 0.2_default]
	pb= [0.3_default, 0.8_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7,0.8):"
	p = [0.7_default, 0.8_default]
	pb= [0.3_default, 0.2_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_9

	@ %def sf_mappings_9
	@
	\subsubsection{Check on-shell power mapping}
	Probe the power mapping of the unit square, adapted for
	single-particle production, for different parameter values. Also
	calculates integrals. For a finite number of bins, they differ
	slightly from $1$, but the result is well-defined because we are not
	using random points.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_10, "sf_mappings_10", &
	"power on-shell mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_10
	<<SF mappings: tests>>=
	subroutine sf_mappings_10 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(2) :: p, pb

	write (u, "(A)") "* Test output: sf_mappings_10"
	write (u, "(A)") "* Purpose: probe power on-shell mapping"
	write (u, "(A)")

	allocate (sf_ipo_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ipo_mapping_t)
	call mapping%init (eps = 0.1_default, m = 0.5_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0,0.5):"
	p = [0._default, 0.5_default]
	pb= [1._default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0,0.02):"
	p = [0._default, 0.02_default]
	pb= [1._default, 0.98_default]
	call mapping%check (u, p, pb, FMT_15, FMT_12)

	write (u, *)
	write (u, "(A)") "Probe at (0,0.98):"
	p = [0._default, 0.98_default]
	pb= [1._default, 0.02_default]
	call mapping%check (u, p, pb, FMT_15, FMT_12)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_10

	@ %def sf_mappings_10
	@
	\subsubsection{Check combined endpoint-power mapping}
	Probe the mapping for the beamstrahlung/ISR combination.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_11, "sf_mappings_11", &
	"endpoint/power combined mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_11
	<<SF mappings: tests>>=
	subroutine sf_mappings_11 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(4) :: p, pb

	write (u, "(A)") "* Test output: sf_mappings_11"
	write (u, "(A)") "* Purpose: probe power pair mapping"
	write (u, "(A)")

	allocate (sf_ei_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ei_mapping_t)
	call mapping%init (eps = 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	call mapping%set_index (3, 3)
	call mapping%set_index (4, 4)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0.5, 0.5, 0.5, 0.5):"
	p = [0.5_default, 0.5_default, 0.5_default, 0.5_default]
	pb= [0.5_default, 0.5_default, 0.5_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7, 0.2, 0.4, 0.8):"
	p = [0.7_default, 0.2_default, 0.4_default, 0.8_default]
	pb= [0.3_default, 0.8_default, 0.6_default, 0.2_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9, 0.06, 0.95, 0.1):"
	p = [0.9_default, 0.06_default, 0.95_default, 0.1_default]
	pb= [0.1_default, 0.94_default, 0.05_default, 0.9_default]
	call mapping%check (u, p, pb, FMT_13, FMT_12)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_11

	@ %def sf_mappings_11
	@
	\subsubsection{Check resonant endpoint-power mapping}
	Probe the mapping for the beamstrahlung/ISR combination.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_12, "sf_mappings_12", &
	"endpoint/power resonant combined mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_12
	<<SF mappings: tests>>=
	subroutine sf_mappings_12 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(4) :: p, pb

	write (u, "(A)") "* Test output: sf_mappings_12"
	write (u, "(A)") "* Purpose: probe resonant combined mapping"
	write (u, "(A)")

	allocate (sf_eir_mapping_t :: mapping)
	select type (mapping)
	type is (sf_eir_mapping_t)
	call mapping%init (a = 1._default, &
	eps = 0.1_default, m = 0.5_default, w = 0.1_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	call mapping%set_index (3, 3)
	call mapping%set_index (4, 4)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0.5, 0.5, 0.5, 0.5):"
	p = [0.5_default, 0.5_default, 0.5_default, 0.5_default]
	pb= [0.5_default, 0.5_default, 0.5_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7, 0.2, 0.4, 0.8):"
	p = [0.7_default, 0.2_default, 0.4_default, 0.8_default]
	pb= [0.3_default, 0.8_default, 0.6_default, 0.2_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9, 0.06, 0.95, 0.1):"
	p = [0.9_default, 0.06_default, 0.95_default, 0.1_default]
	pb= [0.1_default, 0.94_default, 0.05_default, 0.9_default]
	call mapping%check (u, p, pb, FMT_15, FMT_12)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_12

	@ %def sf_mappings_12
	@
	\subsubsection{Check on-shell endpoint-power mapping}
	Probe the mapping for the beamstrahlung/ISR combination.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_13, "sf_mappings_13", &
	"endpoint/power on-shell combined mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_13
	<<SF mappings: tests>>=
	subroutine sf_mappings_13 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(4) :: p, pb

	write (u, "(A)") "* Test output: sf_mappings_13"
	write (u, "(A)") "* Purpose: probe on-shell combined mapping"
	write (u, "(A)")

	allocate (sf_eio_mapping_t :: mapping)
	select type (mapping)
	type is (sf_eio_mapping_t)
	call mapping%init (a = 1._default, eps = 0.1_default, m = 0.5_default)
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	call mapping%set_index (3, 3)
	call mapping%set_index (4, 4)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0.5, 0.5, 0.5, 0.5):"
	p = [0.5_default, 0.5_default, 0.5_default, 0.5_default]
	pb= [0.5_default, 0.5_default, 0.5_default, 0.5_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.7, 0.2, 0.4, 0.8):"
	p = [0.7_default, 0.2_default, 0.4_default, 0.8_default]
	pb= [0.3_default, 0.8_default, 0.6_default, 0.2_default]
	call mapping%check (u, p, pb, FMT_16)

	write (u, *)
	write (u, "(A)") "Probe at (0.9, 0.06, 0.95, 0.1):"
	p = [0.9_default, 0.06_default, 0.95_default, 0.1_default]
	pb= [0.1_default, 0.94_default, 0.05_default, 0.9_default]
	call mapping%check (u, p, pb, FMT_14, FMT_12)

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_13

	@ %def sf_mappings_13
	@
	\subsubsection{Check rescaling}
	Check the rescaling factor in on-shell basic mapping.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_14, "sf_mappings_14", &
	"rescaled on-shell mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_14
	<<SF mappings: tests>>=
	subroutine sf_mappings_14 (u)
	integer, intent(in) :: u
	real(default), dimension(2) :: p2, r2
	real(default), dimension(1) :: p1, r1
	real(default) :: f, x_free, m2

	write (u, "(A)") "* Test output: sf_mappings_14"
	write (u, "(A)") "* Purpose: probe rescaling in os mapping"
	write (u, "(A)")

	x_free = 0.9_default
	m2 = 0.5_default

	write (u, "(A)") "* Two parameters"
	write (u, "(A)")

	p2 = [0.1_default, 0.2_default]

	call map_on_shell (r2, f, p2, -log (m2), x_free)

	write (u, "(A,9(1x," // FMT_14 // "))") "p =", p2
	write (u, "(A,9(1x," // FMT_14 // "))") "r =", r2
	write (u, "(A,9(1x," // FMT_14 // "))") "f =", f
	write (u, "(A,9(1x," // FMT_14 // "))") "r=", x_free product (r2)

	write (u, *)

	call map_on_shell_inverse (r2, f, p2, -log (m2), x_free)

	write (u, "(A,9(1x," // FMT_14 // "))") "p =", p2
	write (u, "(A,9(1x," // FMT_14 // "))") "r =", r2
	write (u, "(A,9(1x," // FMT_14 // "))") "f =", f
	write (u, "(A,9(1x," // FMT_14 // "))") "r=", x_free product (r2)

	write (u, "(A)")
	write (u, "(A)") "* One parameter"
	write (u, "(A)")

	p1 = [0.1_default]

	call map_on_shell_single (r1, f, p1, -log (m2), x_free)

	write (u, "(A,9(1x," // FMT_14 // "))") "p =", p1
	write (u, "(A,9(1x," // FMT_14 // "))") "r =", r1
	write (u, "(A,9(1x," // FMT_14 // "))") "f =", f
	write (u, "(A,9(1x," // FMT_14 // "))") "r=", x_free product (r1)

	write (u, *)

	call map_on_shell_single_inverse (r1, f, p1, -log (m2), x_free)

	write (u, "(A,9(1x," // FMT_14 // "))") "p =", p1
	write (u, "(A,9(1x," // FMT_14 // "))") "r =", r1
	write (u, "(A,9(1x," // FMT_14 // "))") "f =", f
	write (u, "(A,9(1x," // FMT_14 // "))") "r=", x_free product (r1)

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

	end subroutine sf_mappings_14

	@ %def sf_mappings_14
	@
	\subsubsection{Check single parameter resonance mapping}
	Probe the resonance mapping of the unit interval for different parameter
	values. Also calculates integrals.

	The resonance mass is at $1/2$ the energy, the width is $1/10$.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_15, "sf_mappings_15", &
	"resonant single mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_15
	<<SF mappings: tests>>=
	subroutine sf_mappings_15 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(1) :: p

	write (u, "(A)") "* Test output: sf_mappings_15"
	write (u, "(A)") "* Purpose: probe resonance single mapping"
	write (u, "(A)")

	allocate (sf_res_mapping_single_t :: mapping)
	select type (mapping)
	type is (sf_res_mapping_single_t)
	call mapping%init (0.5_default, 0.1_default)
	call mapping%set_index (1, 1)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0):"
	p = [0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5):"
	p = [0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.1):"
	p = [0.1_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_15

	@ %def sf_mappings_15
	@
	\subsubsection{Check single parameter on-shell mapping}
	Probe the on-shell (pseudo) mapping of the unit interval for different parameter
	values. Also calculates integrals.

	The resonance mass is at $1/2$ the energy.
	<<SF mappings: execute tests>>=
	call test (sf_mappings_16, "sf_mappings_16", &
	"on-shell single mapping", &
	u, results)
	<<SF mappings: test declarations>>=
	public :: sf_mappings_16
	<<SF mappings: tests>>=
	subroutine sf_mappings_16 (u)
	integer, intent(in) :: u
	class(sf_mapping_t), allocatable :: mapping
	real(default), dimension(1) :: p

	write (u, "(A)") "* Test output: sf_mappings_16"
	write (u, "(A)") "* Purpose: probe on-shell single mapping"
	write (u, "(A)")

	allocate (sf_os_mapping_single_t :: mapping)
	select type (mapping)
	type is (sf_os_mapping_single_t)
	call mapping%init (0.5_default)
	call mapping%set_index (1, 1)
	end select

	call mapping%write (u)

	write (u, *)
	write (u, "(A)") "Probe at (0):"
	p = [0._default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Probe at (0.5):"
	p = [0.5_default]
	call mapping%check (u, p, 1-p, "F7.5")

	write (u, *)
	write (u, "(A)") "Compute integral:"
	write (u, "(3x,A,1x,F7.5)") "I =", mapping%integral (100000)

	deallocate (mapping)

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

	end subroutine sf_mappings_16

	@ %def sf_mappings_16
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Structure function base}

	<<[[sf_base.f90]]>>=
	<<File header>>

	module sf_base

	<<Use kinds>>
	<<Use strings>>
	use numeric_utils, only: pacify
	use lorentz
	use quantum_numbers
	use pdg_arrays
	use interactions
	use evaluators
	use beams
	use sf_aux
	use sf_mappings

	<<Standard module head>>

	<<SF base: public>>

	<<SF base: parameters>>

	<<SF base: types>>

	<<SF base: interfaces>>

	interface
	<<SF base: sub interfaces>>
	end interface

	end module sf_base
	@ %def sf_base
	@
	<<[[sf_base_sub.f90]]>>=
	<<File header>>

	submodule (sf_base) sf_base_s

	use io_units
	use format_utils, only: write_separator
	use format_defs, only: FMT_17, FMT_19
	use constants, only: one, two
	use diagnostics
	use physics_defs, only: n_beams_rescaled

	implicit none

	contains

	<<SF base: procedures>>

	end submodule sf_base_s

	@ %def sf_base_s
	@
	\subsection{Abstract rescale data-type}

	NLO calculations require the treatment of initial state parton radiation.
	The radiation of a parton rescales the energy fraction which enters the hard process.
	We allow for different rescale settings by extending the abstract.
	[[sf_rescale_t]] data type.
	<<SF base: public>>=
	public :: sf_rescale_t
	<<SF base: types>>=
	type, abstract :: sf_rescale_t
	integer :: i_beam = 0
	contains
	<<SF base: rescaling function: TBP>>
	end type sf_rescale_t

	@ %def sf_rescale_t
	@
	<<SF base: rescaling function: TBP>>=
	procedure (sf_rescale_apply), deferred :: apply
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_rescale_apply (func, x)
	import
	class(sf_rescale_t), intent(in) :: func
	real(default), intent(inout) :: x
	end subroutine sf_rescale_apply
	end interface

	@ %def rescale_apply
	@
	<<SF base: rescaling function: TBP>>=
	procedure :: set_i_beam => sf_rescale_set_i_beam
	<<SF base: sub interfaces>>=
	module subroutine sf_rescale_set_i_beam (func, i_beam)
	class(sf_rescale_t), intent(inout) :: func
	integer, intent(in) :: i_beam
	end subroutine sf_rescale_set_i_beam
	<<SF base: procedures>>=
	module subroutine sf_rescale_set_i_beam (func, i_beam)
	class(sf_rescale_t), intent(inout) :: func
	integer, intent(in) :: i_beam
	func%i_beam = i_beam
	end subroutine sf_rescale_set_i_beam

	@ %def rescale_set_i_beam
	@
	<<SF base: public>>=
	public :: sf_rescale_collinear_t
	<<SF base: types>>=
	type, extends (sf_rescale_t) :: sf_rescale_collinear_t
	real(default) :: xi_tilde
	contains
	<<SF base: rescale collinear: TBP>>
	end type sf_rescale_collinear_t

	@ %def sf_rescale_collinear_t
	@ For the subtraction terms we need to rescale the Born $x$ of both beams in the
	collinear limit. This leaves one beam unaffected and rescales the other according to
	\begin{equation}
	x = \frac{\overline{x}}{1-\xi}
	\end{equation}
	which is the collinear limit of [[sf_rescale_real_apply]].
	<<SF base: rescale collinear: TBP>>=
	procedure :: apply => sf_rescale_collinear_apply
	<<SF base: sub interfaces>>=
	module subroutine sf_rescale_collinear_apply (func, x)
	class(sf_rescale_collinear_t), intent(in) :: func
	real(default), intent(inout) :: x
	end subroutine sf_rescale_collinear_apply
	<<SF base: procedures>>=
	module subroutine sf_rescale_collinear_apply (func, x)
	class(sf_rescale_collinear_t), intent(in) :: func
	real(default), intent(inout) :: x
	real(default) :: xi
	if (debug2_active (D_BEAMS)) then
	print *, 'Rescaling function - Collinear: '
	print *, 'Input, unscaled x: ', x
	print *, 'xi_tilde: ', func%xi_tilde
	end if
	xi = func%xi_tilde * (one - x)
	x = x / (one - xi)
	if (debug2_active (D_BEAMS)) print *, 'rescaled x: ', x
	end subroutine sf_rescale_collinear_apply

	@ %def sf_rescale_collinear_apply
	@
	<<SF base: rescale collinear: TBP>>=
	procedure :: set => sf_rescale_collinear_set
	<<SF base: sub interfaces>>=
	module subroutine sf_rescale_collinear_set (func, xi_tilde)
	class(sf_rescale_collinear_t), intent(inout) :: func
	real(default), intent(in) :: xi_tilde
	end subroutine sf_rescale_collinear_set
	<<SF base: procedures>>=
	module subroutine sf_rescale_collinear_set (func, xi_tilde)
	class(sf_rescale_collinear_t), intent(inout) :: func
	real(default), intent(in) :: xi_tilde
	func%xi_tilde = xi_tilde
	end subroutine sf_rescale_collinear_set

	@ %def sf_rescale_collinear_set
	@
	<<SF base: public>>=
	public :: sf_rescale_real_t
	<<SF base: types>>=
	type, extends (sf_rescale_t) :: sf_rescale_real_t
	real(default) :: xi, y
	contains
	<<SF base: rescale real: TBP>>
	end type sf_rescale_real_t

	@ %def sf_rescale_real_t
	@ In case of IS Splittings, the beam $x$ changes from Born to real and thus needs to be rescaled according to
	\begin{equation}
	x_\oplus = \frac{\overline{x}_\oplus}{\sqrt{1-\xi}} \sqrt{\frac{2-\xi(1-y)}{2-\xi(1+y)}}
	, \qquad
	x_\ominus = \frac{\overline{x}_\ominus}{\sqrt{1-\xi}} \sqrt{\frac{2-\xi(1+y)}{2-\xi(1-y)}}
	\end{equation}
	Refs:
	\begin{itemize}
	\item[\textbullet] [0709.2092] Eq. (5.7).
	\item[\textbullet] [0907.4076] Eq. (2.21).
	\item Christian Weiss' PhD Thesis (DESY-THESIS-2017-025), Eq. (A.2.3).
	\end{itemize}
	<<SF base: rescale real: TBP>>=
	procedure :: apply => sf_rescale_real_apply
	<<SF base: sub interfaces>>=
	module subroutine sf_rescale_real_apply (func, x)
	class(sf_rescale_real_t), intent(in) :: func
	real(default), intent(inout) :: x
	end subroutine sf_rescale_real_apply
	<<SF base: procedures>>=
	module subroutine sf_rescale_real_apply (func, x)
	class(sf_rescale_real_t), intent(in) :: func
	real(default), intent(inout) :: x
	real(default) :: onepy, onemy
	if (debug2_active (D_BEAMS)) then
	print *, 'Rescaling function - Real: '
	print *, 'Input, unscaled: ', x
	print *, 'Beam index: ', func%i_beam
	print *, 'xi: ', func%xi, 'y: ', func%y
	end if
	x = x / sqrt (one - func%xi)
	onepy = one + func%y; onemy = one - func%y
	if (func%i_beam == 1) then
	x = x * sqrt ((two - func%xi * onemy) / (two - func%xi * onepy))
	else if (func%i_beam == 2) then
	x = x * sqrt ((two - func%xi * onepy) / (two - func%xi * onemy))
	else
	call msg_fatal ("sf_rescale_real_apply - invalid beam index")
	end if
	if (debug2_active (D_BEAMS)) print *, 'rescaled x: ', x
	end subroutine sf_rescale_real_apply

	@ %def sf_rescale_real_apply
	@
	<<SF base: rescale real: TBP>>=
	procedure :: set => sf_rescale_real_set
	<<SF base: sub interfaces>>=
	module subroutine sf_rescale_real_set (func, xi, y)
	class(sf_rescale_real_t), intent(inout) :: func
	real(default), intent(in) :: xi, y
	end subroutine sf_rescale_real_set
	<<SF base: procedures>>=
	module subroutine sf_rescale_real_set (func, xi, y)
	class(sf_rescale_real_t), intent(inout) :: func
	real(default), intent(in) :: xi, y
	func%xi = xi; func%y = y
	end subroutine sf_rescale_real_set

	@ %def sf_rescale_real_set
	<<SF base: public>>=
	public :: sf_rescale_dglap_t
	<<SF base: types>>=
	type, extends(sf_rescale_t) :: sf_rescale_dglap_t
	real(default), dimension(:), allocatable :: z
	contains
	<<SF base: rescale dglap: TBP>>
	end type sf_rescale_dglap_t

	@ %def sf_rescale_dglap_t
	@
	<<SF base: rescale dglap: TBP>>=
	procedure :: apply => sf_rescale_dglap_apply
	<<SF base: sub interfaces>>=
	module subroutine sf_rescale_dglap_apply (func, x)
	class(sf_rescale_dglap_t), intent(in) :: func
	real(default), intent(inout) :: x
	end subroutine sf_rescale_dglap_apply
	<<SF base: procedures>>=
	module subroutine sf_rescale_dglap_apply (func, x)
	class(sf_rescale_dglap_t), intent(in) :: func
	real(default), intent(inout) :: x
	if (debug2_active (D_BEAMS)) then
	print *, "Rescaling function - DGLAP:"
	print *, "Input: ", x
	print *, "Beam index: ", func%i_beam
	print *, "z: ", func%z
	end if
	x = x / func%z(func%i_beam)
	if (debug2_active (D_BEAMS)) print *, "scaled x: ", x
	end subroutine sf_rescale_dglap_apply

	@ %def sf_rescale_dglap_apply
	@
	<<SF base: rescale dglap: TBP>>=
	procedure :: set => sf_rescale_dglap_set
	<<SF base: sub interfaces>>=
	module subroutine sf_rescale_dglap_set (func, z)
	class(sf_rescale_dglap_t), intent(inout) :: func
	real(default), dimension(:), intent(in) :: z
	end subroutine sf_rescale_dglap_set
	<<SF base: procedures>>=
	module subroutine sf_rescale_dglap_set (func, z)
	class(sf_rescale_dglap_t), intent(inout) :: func
	real(default), dimension(:), intent(in) :: z
	func%z = z
	end subroutine sf_rescale_dglap_set

	@ %def sf_rescale_dglap_set
	@
	\subsection{Abstract structure-function data type}
	This type should hold all configuration data for a specific type of
	structure function. The base object is empty; the implementations
	will fill it.
	<<SF base: public>>=
	public :: sf_data_t
	<<SF base: types>>=
	type, abstract :: sf_data_t
	contains
	<<SF base: sf data: TBP>>
	end type sf_data_t

	@ %def sf_data_t
	@ Output.
	<<SF base: sf data: TBP>>=
	procedure (sf_data_write), deferred :: write
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_data_write (data, unit, verbose)
	import
	class(sf_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine sf_data_write
	end interface

	@ %def sf_data_write
	@ Return true if this structure function is in generator mode. In
	that case, all parameters are free, otherwise bound. (We do not
	support mixed cases.) Default is: no generator.
	<<SF base: sf data: TBP>>=
	procedure :: is_generator => sf_data_is_generator
	<<SF base: sub interfaces>>=
	module function sf_data_is_generator (data) result (flag)
	class(sf_data_t), intent(in) :: data
	logical :: flag
	end function sf_data_is_generator
	<<SF base: procedures>>=
	module function sf_data_is_generator (data) result (flag)
	class(sf_data_t), intent(in) :: data
	logical :: flag
	flag = .false.
	end function sf_data_is_generator

	@ %def sf_data_is_generator
	@ Return the number of input parameters that determine the
	structure function.
	<<SF base: sf data: TBP>>=
	procedure (sf_data_get_int), deferred :: get_n_par
	<<SF base: interfaces>>=
	abstract interface
	function sf_data_get_int (data) result (n)
	import
	class(sf_data_t), intent(in) :: data
	integer :: n
	end function sf_data_get_int
	end interface

	@ %def sf_data_get_int
	@ Return the outgoing particle PDG codes for the current setup. The codes can
	be an array of particles, for each beam.
	<<SF base: sf data: TBP>>=
	procedure (sf_data_get_pdg_out), deferred :: get_pdg_out
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_data_get_pdg_out (data, pdg_out)
	import
	class(sf_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	end subroutine sf_data_get_pdg_out
	end interface

	@ %def sf_data_get_pdg_out
	@ Allocate a matching structure function interaction object and
	properly initialize it.

	<<SF base: sf data: TBP>>=
	procedure (sf_data_allocate_sf_int), deferred :: allocate_sf_int
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_data_allocate_sf_int (data, sf_int)
	import
	class(sf_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	end subroutine sf_data_allocate_sf_int
	end interface

	@ %def sf_data_allocate_sf_int
	@ Return the PDF set index, if applicable. We implement a default
	method which returns zero. The PDF (builtin and LHA) implementations
	will override this.
	<<SF base: sf data: TBP>>=
	procedure :: get_pdf_set => sf_data_get_pdf_set
	<<SF base: sub interfaces>>=
	elemental module function sf_data_get_pdf_set (data) result (pdf_set)
	class(sf_data_t), intent(in) :: data
	integer :: pdf_set
	end function sf_data_get_pdf_set
	<<SF base: procedures>>=
	elemental module function sf_data_get_pdf_set (data) result (pdf_set)
	class(sf_data_t), intent(in) :: data
	integer :: pdf_set
	pdf_set = 0
	end function sf_data_get_pdf_set

	@ %def sf_data_get_pdf_set
	@ Return the spectrum file, if applicable. We implement a default
	method which returns zero. CIRCE1, CIRCE2 and the beam spectrum will
	override this.
	<<SF base: sf data: TBP>>=
	procedure :: get_beam_file => sf_data_get_beam_file
	<<SF base: sub interfaces>>=
	module function sf_data_get_beam_file (data) result (file)
	class(sf_data_t), intent(in) :: data
	type(string_t) :: file
	end function sf_data_get_beam_file
	<<SF base: procedures>>=
	module function sf_data_get_beam_file (data) result (file)
	class(sf_data_t), intent(in) :: data
	type(string_t) :: file
	file = ""
	end function sf_data_get_beam_file

	@ %def sf_data_get_beam_file
	@
	\subsection{Structure-function chain configuration}
	This is the data type that the [[process]] module uses for setting
	up its structure-function chain. For each structure function described
	by the beam data, there is an entry. The [[i]] array indicates the
	beam(s) to which this structure function applies, and the [[data]]
	object contains the actual configuration data.
	<<SF base: public>>=
	public :: sf_config_t
	<<SF base: types>>=
	type :: sf_config_t
	integer, dimension(:), allocatable :: i
	class(sf_data_t), allocatable :: data
	contains
	<<SF base: sf config: TBP>>
	end type sf_config_t

	@ %def sf_config_t
	@ Output:
	<<SF base: sf config: TBP>>=
	procedure :: write => sf_config_write
	<<SF base: sub interfaces>>=
	module subroutine sf_config_write (object, unit, verbose)
	class(sf_config_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine sf_config_write
	<<SF base: procedures>>=
	module subroutine sf_config_write (object, unit, verbose)
	class(sf_config_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit)
	if (allocated (object%i)) then
	write (u, "(1x,A,2(1x,I0))") "Structure-function configuration: &
	&beam(s)", object%i
	if (allocated (object%data)) &
	call object%data%write (u, verbose = verbose)
	else
	write (u, "(1x,A)") "Structure-function configuration: [undefined]"
	end if
	end subroutine sf_config_write

	@ %def sf_config_write
	@ Initialize.
	<<SF base: sf config: TBP>>=
	procedure :: init => sf_config_init
	<<SF base: sub interfaces>>=
	module subroutine sf_config_init (sf_config, i_beam, sf_data)
	class(sf_config_t), intent(out) :: sf_config
	integer, dimension(:), intent(in) :: i_beam
	class(sf_data_t), intent(in) :: sf_data
	end subroutine sf_config_init
	<<SF base: procedures>>=
	module subroutine sf_config_init (sf_config, i_beam, sf_data)
	class(sf_config_t), intent(out) :: sf_config
	integer, dimension(:), intent(in) :: i_beam
	class(sf_data_t), intent(in) :: sf_data
	allocate (sf_config%i (size (i_beam)), source = i_beam)
	allocate (sf_config%data, source = sf_data)
	end subroutine sf_config_init

	@ %def sf_config_init
	@ Return the PDF set, if any.
	<<SF base: sf config: TBP>>=
	procedure :: get_pdf_set => sf_config_get_pdf_set
	<<SF base: sub interfaces>>=
	elemental module function sf_config_get_pdf_set (sf_config) result (pdf_set)
	class(sf_config_t), intent(in) :: sf_config
	integer :: pdf_set
	end function sf_config_get_pdf_set
	<<SF base: procedures>>=
	elemental module function sf_config_get_pdf_set (sf_config) result (pdf_set)
	class(sf_config_t), intent(in) :: sf_config
	integer :: pdf_set
	pdf_set = sf_config%data%get_pdf_set ()
	end function sf_config_get_pdf_set

	@ %def sf_config_get_pdf_set
	@ Return the beam spectrum file, if any.
	<<SF base: sf config: TBP>>=
	procedure :: get_beam_file => sf_config_get_beam_file
	<<SF base: sub interfaces>>=
	module function sf_config_get_beam_file (sf_config) result (file)
	class(sf_config_t), intent(in) :: sf_config
	type(string_t) :: file
	end function sf_config_get_beam_file
	<<SF base: procedures>>=
	module function sf_config_get_beam_file (sf_config) result (file)
	class(sf_config_t), intent(in) :: sf_config
	type(string_t) :: file
	file = sf_config%data%get_beam_file ()
	end function sf_config_get_beam_file

	@ %def sf_config_get_beam_file
	@
	\subsection{Structure-function instance}
	The [[sf_int_t]] data type contains an [[interaction_t]] object (it is
	an extension of this type) and a pointer to the [[sf_data_t]]
	configuration data. This interaction, or copies of it, is used to
	implement structure-function kinematics and dynamics in the context of
	process evaluation.

	The status code [[status]] tells whether the interaction is undefined,
	has defined kinematics (but matrix elements invalid), or is completely
	defined. There is also a status code for failure. The implementation
	is responsible for updating the status.

	The entries [[mi2]], [[mr2]], and [[mo2]] hold the squared
	invariant masses of the incoming, radiated, and outgoing particle,
	respectively. They are supposed to be set upon initialization, but
	could also be varied event by event.

	If the radiated or outgoing mass is nonzero, we may need to apply an
	on-shell projection. The projection mode is stored as
	[[on_shell_mode]].

	The array [[beam_index]] is the list of beams on which this structure
	function applies ($1$, $2$, or both). The arrays [[incoming]],
	[[radiated]], and [[outgoing]] contain the indices of the respective
	particle sets within the interaction, for convenient lookup. The
	array [[par_index]] indicates the MC input parameters that this entry
	will use up in the structure-function chain. The first parameter (or
	the first two, for a spectrum) in this array determines the momentum
	fraction and is thus subject to global mappings.

	In the abstract base type, we do not implement the data pointer. This
	allows us to restrict its type in the implementations.
	<<SF base: public>>=
	public :: sf_int_t
	<<SF base: types>>=
	type, abstract, extends (interaction_t) :: sf_int_t
	integer :: status = SF_UNDEFINED
	real(default), dimension(:), allocatable :: mi2
	real(default), dimension(:), allocatable :: mr2
	real(default), dimension(:), allocatable :: mo2
	integer :: on_shell_mode = KEEP_ENERGY
	logical :: qmin_defined = .false.
	logical :: qmax_defined = .false.
	real(default), dimension(:), allocatable :: qmin
	real(default), dimension(:), allocatable :: qmax
	integer, dimension(:), allocatable :: beam_index
	integer, dimension(:), allocatable :: incoming
	integer, dimension(:), allocatable :: radiated
	integer, dimension(:), allocatable :: outgoing
	integer, dimension(:), allocatable :: par_index
	integer, dimension(:), allocatable :: par_primary
	contains
	<<SF base: sf int: TBP>>
	end type sf_int_t

	@ %def sf_int_t
	@ Status codes. The codes that refer to links, masks, and
	connections, apply to structure-function chains only.

	The status codes are public.
	<<SF base: parameters>>=
	integer, parameter, public :: SF_UNDEFINED = 0
	integer, parameter, public :: SF_INITIAL = 1
	integer, parameter, public :: SF_DONE_LINKS = 2
	integer, parameter, public :: SF_FAILED_MASK = 3
	integer, parameter, public :: SF_DONE_MASK = 4
	integer, parameter, public :: SF_FAILED_CONNECTIONS = 5
	integer, parameter, public :: SF_DONE_CONNECTIONS = 6
	integer, parameter, public :: SF_SEED_KINEMATICS = 10
	integer, parameter, public :: SF_FAILED_KINEMATICS = 11
	integer, parameter, public :: SF_DONE_KINEMATICS = 12
	integer, parameter, public :: SF_FAILED_EVALUATION = 13
	integer, parameter, public :: SF_EVALUATED = 20

	@ %def SF_UNDEFINED SF_INITIAL
	@ %def SF_DONE_LINKS SF_DONE_MASK SF_DONE_CONNECTIONS
	@ %def SF_DONE_KINEMATICS SF_EVALUATED
	@ %def SF_FAILED_MASK SF_FAILED_CONNECTIONS
	@ %def SF_FAILED_KINEMATICS SF_FAILED_EVALUATION
	@ Write a string version of the status code:
	<<SF base: procedures>>=
	subroutine write_sf_status (status, u)
	integer, intent(in) :: status
	integer, intent(in) :: u
	select case (status)
	case (SF_UNDEFINED)
	write (u, "(1x,'[',A,']')") "undefined"
	case (SF_INITIAL)
	write (u, "(1x,'[',A,']')") "initialized"
	case (SF_DONE_LINKS)
	write (u, "(1x,'[',A,']')") "links set"
	case (SF_FAILED_MASK)
	write (u, "(1x,'[',A,']')") "mask mismatch"
	case (SF_DONE_MASK)
	write (u, "(1x,'[',A,']')") "mask set"
	case (SF_FAILED_CONNECTIONS)
	write (u, "(1x,'[',A,']')") "connections failed"
	case (SF_DONE_CONNECTIONS)
	write (u, "(1x,'[',A,']')") "connections set"
	case (SF_SEED_KINEMATICS)
	write (u, "(1x,'[',A,']')") "incoming momenta set"
	case (SF_FAILED_KINEMATICS)
	write (u, "(1x,'[',A,']')") "kinematics failed"
	case (SF_DONE_KINEMATICS)
	write (u, "(1x,'[',A,']')") "kinematics set"
	case (SF_FAILED_EVALUATION)
	write (u, "(1x,'[',A,']')") "evaluation failed"
	case (SF_EVALUATED)
	write (u, "(1x,'[',A,']')") "evaluated"
	end select
	end subroutine write_sf_status

	@ %def write_sf_status
	@ This is the basic output routine. Display status and interaction.
	<<SF base: sf int: TBP>>=
	procedure :: base_write => sf_int_base_write
	<<SF base: sub interfaces>>=
	module subroutine sf_int_base_write (object, unit, testflag)
	class(sf_int_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine sf_int_base_write
	<<SF base: procedures>>=
	module subroutine sf_int_base_write (object, unit, testflag)
	class(sf_int_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "SF instance:"
	call write_sf_status (object%status, u)
	if (allocated (object%beam_index)) &
	write (u, "(3x,A,2(1x,I0))") "beam =", object%beam_index
	if (allocated (object%incoming)) &
	write (u, "(3x,A,2(1x,I0))") "incoming =", object%incoming
	if (allocated (object%radiated)) &
	write (u, "(3x,A,2(1x,I0))") "radiated =", object%radiated
	if (allocated (object%outgoing)) &
	write (u, "(3x,A,2(1x,I0))") "outgoing =", object%outgoing
	if (allocated (object%par_index)) &
	write (u, "(3x,A,2(1x,I0))") "parameter =", object%par_index
	if (object%qmin_defined) &
	write (u, "(3x,A,1x," // FMT_19 // ")") "q_min =", object%qmin
	if (object%qmax_defined) &
	write (u, "(3x,A,1x," // FMT_19 // ")") "q_max =", object%qmax
	call object%interaction_t%basic_write (u, testflag = testflag)
	end subroutine sf_int_base_write

	@ %def sf_int_base_write
	@ The type string identifies the structure function class, and possibly more
	details about the structure function.
	<<SF base: sf int: TBP>>=
	procedure (sf_int_type_string), deferred :: type_string
	<<SF base: interfaces>>=
	abstract interface
	function sf_int_type_string (object) result (string)
	import
	class(sf_int_t), intent(in) :: object
	type(string_t) :: string
	end function sf_int_type_string
	end interface

	@ %def sf_int_type_string
	@ Output of the concrete object. We should not forget to call the
	output routine for the base type.
	<<SF base: sf int: TBP>>=
	procedure (sf_int_write), deferred :: write
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_int_write (object, unit, testflag)
	import
	class(sf_int_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine sf_int_write
	end interface

	@ %def sf_int_write
	@ Basic initialization: set the invariant masses for the particles and
	initialize the interaction. The caller should then add states to the
	interaction and freeze it.

	The dimension of the mask should be equal to the sum of the dimensions
	of the mass-squared arrays, which determine incoming, radiated, and
	outgoing particles, respectively.

	Optionally, we can define minimum and maximum values for the momentum
	transfer to the outgoing particle(s). If all masses are zero, this is
	actually required for non-collinear splitting.
	<<SF base: sf int: TBP>>=
	procedure :: base_init => sf_int_base_init
	<<SF base: sub interfaces>>=
	module subroutine sf_int_base_init &
	(sf_int, mask, mi2, mr2, mo2, qmin, qmax, hel_lock)
	class(sf_int_t), intent(out) :: sf_int
	type (quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	real(default), dimension(:), intent(in) :: mi2, mr2, mo2
	real(default), dimension(:), intent(in), optional :: qmin, qmax
	integer, dimension(:), intent(in), optional :: hel_lock
	end subroutine sf_int_base_init
	<<SF base: procedures>>=
	module subroutine sf_int_base_init &
	(sf_int, mask, mi2, mr2, mo2, qmin, qmax, hel_lock)
	class(sf_int_t), intent(out) :: sf_int
	type (quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	real(default), dimension(:), intent(in) :: mi2, mr2, mo2
	real(default), dimension(:), intent(in), optional :: qmin, qmax
	integer, dimension(:), intent(in), optional :: hel_lock
	allocate (sf_int%mi2 (size (mi2)))
	sf_int%mi2 = mi2
	allocate (sf_int%mr2 (size (mr2)))
	sf_int%mr2 = mr2
	allocate (sf_int%mo2 (size (mo2)))
	sf_int%mo2 = mo2
	if (present (qmin)) then
	sf_int%qmin_defined = .true.
	allocate (sf_int%qmin (size (qmin)))
	sf_int%qmin = qmin
	end if
	if (present (qmax)) then
	sf_int%qmax_defined = .true.
	allocate (sf_int%qmax (size (qmax)))
	sf_int%qmax = qmax
	end if
	call sf_int%interaction_t%basic_init &
	(size (mi2), 0, size (mr2) + size (mo2), &
	mask = mask, hel_lock = hel_lock, set_relations = .true.)
	end subroutine sf_int_base_init

	@ %def sf_int_base_init
	@ Set the indices of the incoming, radiated, and outgoing particles,
	respectively.
	<<SF base: sf int: TBP>>=
	procedure :: set_incoming => sf_int_set_incoming
	procedure :: set_radiated => sf_int_set_radiated
	procedure :: set_outgoing => sf_int_set_outgoing
	<<SF base: sub interfaces>>=
	module subroutine sf_int_set_incoming (sf_int, incoming)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: incoming
	end subroutine sf_int_set_incoming
	module subroutine sf_int_set_radiated (sf_int, radiated)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: radiated
	end subroutine sf_int_set_radiated
	module subroutine sf_int_set_outgoing (sf_int, outgoing)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: outgoing
	end subroutine sf_int_set_outgoing
	<<SF base: procedures>>=
	module subroutine sf_int_set_incoming (sf_int, incoming)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: incoming
	allocate (sf_int%incoming (size (incoming)))
	sf_int%incoming = incoming
	end subroutine sf_int_set_incoming

	module subroutine sf_int_set_radiated (sf_int, radiated)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: radiated
	allocate (sf_int%radiated (size (radiated)))
	sf_int%radiated = radiated
	end subroutine sf_int_set_radiated

	module subroutine sf_int_set_outgoing (sf_int, outgoing)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: outgoing
	allocate (sf_int%outgoing (size (outgoing)))
	sf_int%outgoing = outgoing
	end subroutine sf_int_set_outgoing

	@ %def sf_int_set_incoming
	@ %def sf_int_set_radiated
	@ %def sf_int_set_outgoing
	@ Initialization. This proceeds via an abstract data object, which
	for the actual implementation should have the matching concrete type.
	Since all implementations have the same signature, we can prepare a
	deferred procedure. The data object will become the target of a
	corresponding pointer within the [[sf_int_t]] implementation.

	This should call the previous procedure.
	<<SF base: sf int: TBP>>=
	procedure (sf_int_init), deferred :: init
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_int_init (sf_int, data)
	import
	class(sf_int_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	end subroutine sf_int_init
	end interface

	@ %def sf_int_init
	@ Complete initialization. This routine contains initializations that can
	only be performed after the interaction object got its final shape, i.e.,
	redundant helicities have been eliminated by matching with beams and process.

	The default implementation does nothing.

	The [[target]] attribute is formally required since some overriding
	implementations use a temporary pointer (iterator) to the state-matrix
	component. It doesn't appear to make a real difference, though.
	<<SF base: sf int: TBP>>=
	procedure :: setup_constants => sf_int_setup_constants
	<<SF base: sub interfaces>>=
	module subroutine sf_int_setup_constants (sf_int)
	class(sf_int_t), intent(inout), target :: sf_int
	end subroutine sf_int_setup_constants
	<<SF base: procedures>>=
	module subroutine sf_int_setup_constants (sf_int)
	class(sf_int_t), intent(inout), target :: sf_int
	end subroutine sf_int_setup_constants

	@ %def sf_int_setup_constants
	@ Set beam indices, i.e., the beam(s) on which
	this structure function applies.
	<<SF base: sf int: TBP>>=
	procedure :: set_beam_index => sf_int_set_beam_index
	<<SF base: sub interfaces>>=
	module subroutine sf_int_set_beam_index (sf_int, beam_index)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: beam_index
	end subroutine sf_int_set_beam_index
	<<SF base: procedures>>=
	module subroutine sf_int_set_beam_index (sf_int, beam_index)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: beam_index
	allocate (sf_int%beam_index (size (beam_index)))
	sf_int%beam_index = beam_index
	end subroutine sf_int_set_beam_index

	@ %def sf_int_set_beam_index
	@ Set parameter indices, indicating which MC input parameters are to
	be used for evaluating this structure function.
	<<SF base: sf int: TBP>>=
	procedure :: set_par_index => sf_int_set_par_index
	<<SF base: sub interfaces>>=
	module subroutine sf_int_set_par_index (sf_int, par_index)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: par_index
	end subroutine sf_int_set_par_index
	<<SF base: procedures>>=
	module subroutine sf_int_set_par_index (sf_int, par_index)
	class(sf_int_t), intent(inout) :: sf_int
	integer, dimension(:), intent(in) :: par_index
	allocate (sf_int%par_index (size (par_index)))
	sf_int%par_index = par_index
	end subroutine sf_int_set_par_index

	@ %def sf_int_set_par_index
	@ Initialize the structure-function kinematics, setting incoming
	momenta. We assume that array shapes match.

	Three versions. The first version relies on the momenta being linked
	to another interaction. The second version sets the momenta
	explicitly. In the third version, we first compute momenta for the
	specified energies and store those.
	<<SF base: sf int: TBP>>=
	generic :: seed_kinematics => sf_int_receive_momenta
	generic :: seed_kinematics => sf_int_seed_momenta
	generic :: seed_kinematics => sf_int_seed_energies
	procedure :: sf_int_receive_momenta
	procedure :: sf_int_seed_momenta
	procedure :: sf_int_seed_energies
	<<SF base: sub interfaces>>=
	module subroutine sf_int_receive_momenta (sf_int)
	class(sf_int_t), intent(inout) :: sf_int
	end subroutine sf_int_receive_momenta
	module subroutine sf_int_seed_momenta (sf_int, k)
	class(sf_int_t), intent(inout) :: sf_int
	type(vector4_t), dimension(:), intent(in) :: k
	end subroutine sf_int_seed_momenta
	module subroutine sf_int_seed_energies (sf_int, E)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: E
	type(vector4_t), dimension(:), allocatable :: k
	end subroutine sf_int_seed_energies
	<<SF base: procedures>>=
	module subroutine sf_int_receive_momenta (sf_int)
	class(sf_int_t), intent(inout) :: sf_int
	if (sf_int%status >= SF_INITIAL) then
	call sf_int%receive_momenta ()
	sf_int%status = SF_SEED_KINEMATICS
	end if
	end subroutine sf_int_receive_momenta

	module subroutine sf_int_seed_momenta (sf_int, k)
	class(sf_int_t), intent(inout) :: sf_int
	type(vector4_t), dimension(:), intent(in) :: k
	if (sf_int%status >= SF_INITIAL) then
	call sf_int%set_momenta (k, outgoing=.false.)
	sf_int%status = SF_SEED_KINEMATICS
	end if
	end subroutine sf_int_seed_momenta

	module subroutine sf_int_seed_energies (sf_int, E)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: E
	type(vector4_t), dimension(:), allocatable :: k
	integer :: j
	if (sf_int%status >= SF_INITIAL) then
	allocate (k (size (E)))
	if (all (E**2 >= sf_int%mi2)) then
	do j = 1, size (E)
	k(j) = vector4_moving (E(j), &
	(3-2j) sqrt (E(j)**2 - sf_int%mi2(j)), 3)
	end do
	call sf_int%seed_kinematics (k)
	end if
	end if
	end subroutine sf_int_seed_energies

	@ %def sf_int_seed_momenta
	@ %def sf_int_seed_energies
	@ Tell if in generator mode. By default, this is false. To be
	overridden where appropriate; we may refer to the [[is_generator]]
	method of the [[data]] component in the concrete type.
	<<SF base: sf int: TBP>>=
	procedure :: is_generator => sf_int_is_generator
	<<SF base: sub interfaces>>=
	module function sf_int_is_generator (sf_int) result (flag)
	class(sf_int_t), intent(in) :: sf_int
	logical :: flag
	end function sf_int_is_generator
	<<SF base: procedures>>=
	module function sf_int_is_generator (sf_int) result (flag)
	class(sf_int_t), intent(in) :: sf_int
	logical :: flag
	flag = .false.
	end function sf_int_is_generator

	@ %def sf_int_is_generator
	@ Generate free parameters [[r]]. Parameters are free if they do not
	correspond to integration parameters (i.e., are bound), but are
	generated by the structure function object itself. By default, all
	parameters are bound, and the output values of this procedure will be
	discarded. With free parameters, we have to override this procedure.

	The value [[x_free]] is the renormalization factor of the total energy
	that corresponds to the free parameters. If there are no free
	parameters, the procedure will not change its value, which starts as
	unity. Otherwise, the fraction is typically decreased, but may also
	be increased in some cases.
	<<SF base: sf int: TBP>>=
	procedure :: generate_free => sf_int_generate_free
	<<SF base: sub interfaces>>=
	module subroutine sf_int_generate_free (sf_int, r, rb, x_free)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	end subroutine sf_int_generate_free
	<<SF base: procedures>>=
	module subroutine sf_int_generate_free (sf_int, r, rb, x_free)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	r = 0
	rb= 1
	end subroutine sf_int_generate_free

	@ %def sf_int_generate_free
	@ Complete the structure-function kinematics, derived from an input
	parameter (array) $r$ between 0 and 1. The interaction momenta are
	calculated, and we return $x$ (the momentum fraction), and $f$ (the
	Jacobian factor for the map $r\to x$), if [[map]] is set.

	If the [[map]] flag is unset, $r$ and $x$ values will coincide, and $f$ will
	become unity. If it is set, the structure-function implementation chooses a
	convenient mapping from $r$ to $x$ with Jacobian $f$.

	In the [[inverse_kinematics]] variant, we exchange the intent of [[x]]
	and [[r]]. The momenta are calculated only if the optional flag
	[[set_momenta]] is present and set. Internal parameters of [[sf_int]]
	are calculated only if the optional flag [[set_x]] is present and set.

	Update 2018-08-22: Throughout this algorithm, we now carry
	[[xb]]=$1-x$ together with [[x]] values, as we did for [[r]] before.
	This allows us to handle unstable endpoint numerics wherever
	necessary. The only place where the changes actually did matter was
	for inverse kinematics in the ISR setup, with a very soft photon, but
	it might be most sensible to apply the extension with [[xb]] everywhere.
	<<SF base: sf int: TBP>>=
	procedure (sf_int_complete_kinematics), deferred :: complete_kinematics
	procedure (sf_int_inverse_kinematics), deferred :: inverse_kinematics
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_int_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	import
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	end subroutine sf_int_complete_kinematics
	end interface

	abstract interface
	subroutine sf_int_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
	import
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	end subroutine sf_int_inverse_kinematics
	end interface

	@ %def sf_int_complete_kinematics
	@ %def sf_int_inverse_kinematics
	@ Single splitting: compute momenta, given $x$ input parameters. We
	assume that the incoming momentum is set. The status code is set to
	[[SF_FAILED_KINEMATICS]] if
	the $x$ array does not correspond to a valid momentum configuration.
	Otherwise, it is updated to [[SF_DONE_KINEMATICS]].

	We force the outgoing particle on-shell. The on-shell projection is
	determined by the [[on_shell_mode]]. The radiated particle should already be
	on shell.
	<<SF base: sf int: TBP>>=
	procedure :: split_momentum => sf_int_split_momentum
	<<SF base: sub interfaces>>=
	module subroutine sf_int_split_momentum (sf_int, x, xb)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	end subroutine sf_int_split_momentum
	<<SF base: procedures>>=
	module subroutine sf_int_split_momentum (sf_int, x, xb)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	type(splitting_data_t) :: sd
	real(default) :: E1, E2
	logical :: fail
	if (sf_int%status >= SF_SEED_KINEMATICS) then
	k = sf_int%get_momentum (1)
	call sd%init (k, &
	sf_int%mi2(1), sf_int%mr2(1), sf_int%mo2(1), &
	collinear = size (x) == 1)
	call sd%set_t_bounds (x(1), xb(1))
	select case (size (x))
	case (1)
	case (3)
	if (sf_int%qmax_defined) then
	if (sf_int%qmin_defined) then
	call sd%sample_t (x(2), &
	t0 = - sf_int%qmax(1) 2, t1 = - sf_int%qmin(1) 2)
	else
	call sd%sample_t (x(2), &
	t0 = - sf_int%qmax(1) ** 2)
	end if
	else
	if (sf_int%qmin_defined) then
	call sd%sample_t (x(2), t1 = - sf_int%qmin(1) ** 2)
	else
	call sd%sample_t (x(2))
	end if
	end if
	call sd%sample_phi (x(3))
	case default
	call msg_bug ("Structure function: impossible number of parameters")
	end select
	q = sd%split_momentum (k)
	call on_shell (q, [sf_int%mr2, sf_int%mo2], &
	sf_int%on_shell_mode)
	call sf_int%set_momenta (q, outgoing=.true.)
	E1 = energy (q(1))
	E2 = energy (q(2))
	fail = E1 < 0 .or. E2 < 0 &
	.or. E1 ** 2 < sf_int%mr2(1) &
	.or. E2 ** 2 < sf_int%mo2(1)
	if (fail) then
	sf_int%status = SF_FAILED_KINEMATICS
	else
	sf_int%status = SF_DONE_KINEMATICS
	end if
	end if
	end subroutine sf_int_split_momentum

	@ %def sf_test_split_momentum
	@ Pair splitting: two incoming momenta, two radiated, two outgoing.
	This is simple because we insist on all momenta being collinear.
	<<SF base: sf int: TBP>>=
	procedure :: split_momenta => sf_int_split_momenta
	<<SF base: sub interfaces>>=
	module subroutine sf_int_split_momenta (sf_int, x, xb)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	end subroutine sf_int_split_momenta
	<<SF base: procedures>>=
	module subroutine sf_int_split_momenta (sf_int, x, xb)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	type(vector4_t), dimension(2) :: k
	type(vector4_t), dimension(4) :: q
	real(default), dimension(4) :: E
	logical :: fail
	if (sf_int%status >= SF_SEED_KINEMATICS) then
	select case (size (x))
	case (2)
	case default
	call msg_bug ("Pair structure function: recoil requested &
	&but not implemented yet")
	end select
	k(1) = sf_int%get_momentum (1)
	k(2) = sf_int%get_momentum (2)
	q(1:2) = xb * k
	q(3:4) = x * k
	select case (size (sf_int%mr2))
	case (2)
	call on_shell (q, &
	[sf_int%mr2(1), sf_int%mr2(2), &
	sf_int%mo2(1), sf_int%mo2(2)], &
	sf_int%on_shell_mode)
	call sf_int%set_momenta (q, outgoing=.true.)
	E = energy (q)
	fail = any (E < 0) &
	.or. any (E(1:2) ** 2 < sf_int%mr2) &
	.or. any (E(3:4) ** 2 < sf_int%mo2)
	case default; call msg_bug ("split momenta: incorrect use")
	end select
	if (fail) then
	sf_int%status = SF_FAILED_KINEMATICS
	else
	sf_int%status = SF_DONE_KINEMATICS
	end if
	end if
	end subroutine sf_int_split_momenta

	@ %def sf_int_split_momenta
	@ Pair spectrum: the reduced version of the previous splitting,
	without radiated momenta.
	<<SF base: sf int: TBP>>=
	procedure :: reduce_momenta => sf_int_reduce_momenta
	<<SF base: sub interfaces>>=
	module subroutine sf_int_reduce_momenta (sf_int, x)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	end subroutine sf_int_reduce_momenta
	<<SF base: procedures>>=
	module subroutine sf_int_reduce_momenta (sf_int, x)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	type(vector4_t), dimension(2) :: k
	type(vector4_t), dimension(2) :: q
	real(default), dimension(2) :: E
	logical :: fail
	if (sf_int%status >= SF_SEED_KINEMATICS) then
	select case (size (x))
	case (2)
	case default
	call msg_bug ("Pair spectrum: recoil requested &
	&but not implemented yet")
	end select
	k(1) = sf_int%get_momentum (1)
	k(2) = sf_int%get_momentum (2)
	q = x * k
	call on_shell (q, &
	[sf_int%mo2(1), sf_int%mo2(2)], &
	sf_int%on_shell_mode)
	call sf_int%set_momenta (q, outgoing=.true.)
	E = energy (q)
	fail = any (E < 0) &
	.or. any (E ** 2 < sf_int%mo2)
	if (fail) then
	sf_int%status = SF_FAILED_KINEMATICS
	else
	sf_int%status = SF_DONE_KINEMATICS
	end if
	end if
	end subroutine sf_int_reduce_momenta

	@ %def sf_int_reduce_momenta
	@ The inverse procedure: we compute the [[x]] array from the momentum
	configuration. In an overriding TBP, we may also set internal data
	that depend on this, for convenience.

	NOTE: Here and above, the single-particle case is treated in detail,
	allowing for non-collinearity and non-vanishing masses and nontrivial
	momentum-transfer bounds. For the pair case, we currently implement
	only collinear splitting and assume massless particles. This should
	be improved.

	Update 2017-08-22: recover also [[xb]], using the updated [[recover]]
	method of the splitting-data object. Th
	<<SF base: sf int: TBP>>=
	procedure :: recover_x => sf_int_recover_x
	procedure :: base_recover_x => sf_int_recover_x
	<<SF base: sub interfaces>>=
	module subroutine sf_int_recover_x (sf_int, x, xb, x_free)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_int_recover_x
	<<SF base: procedures>>=
	module subroutine sf_int_recover_x (sf_int, x, xb, x_free)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	type(vector4_t), dimension(:), allocatable :: k
	type(vector4_t), dimension(:), allocatable :: q
	type(splitting_data_t) :: sd
	if (sf_int%status >= SF_SEED_KINEMATICS) then
	allocate (k (sf_int%interaction_t%get_n_in ()))
	allocate (q (sf_int%interaction_t%get_n_out ()))
	k = sf_int%get_momenta (outgoing=.false.)
	q = sf_int%get_momenta (outgoing=.true.)
	select case (size (k))
	case (1)
	call sd%init (k(1), &
	sf_int%mi2(1), sf_int%mr2(1), sf_int%mo2(1), &
	collinear = size (x) == 1)
	call sd%recover (k(1), q, sf_int%on_shell_mode)
	x(1) = sd%get_x ()
	xb(1) = sd%get_xb ()
	select case (size (x))
	case (1)
	case (3)
	if (sf_int%qmax_defined) then
	if (sf_int%qmin_defined) then
	call sd%inverse_t (x(2), &
	t0 = - sf_int%qmax(1) 2, t1 = - sf_int%qmin(1) 2)
	else
	call sd%inverse_t (x(2), &
	t0 = - sf_int%qmax(1) ** 2)
	end if
	else
	if (sf_int%qmin_defined) then
	call sd%inverse_t (x(2), t1 = - sf_int%qmin(1) ** 2)
	else
	call sd%inverse_t (x(2))
	end if
	end if
	call sd%inverse_phi (x(3))
	xb(2:3) = 1 - x(2:3)
	case default
	call msg_bug ("Structure function: impossible number &
	&of parameters")
	end select
	case (2)
	select case (size (x))
	case (2)
	case default
	call msg_bug ("Pair structure function: recoil requested &
	&but not implemented yet")
	end select
	select case (sf_int%on_shell_mode)
	case (KEEP_ENERGY)
	select case (size (q))
	case (4)
	x = energy (q(3:4)) / energy (k)
	xb= energy (q(1:2)) / energy (k)
	case (2)
	x = energy (q) / energy (k)
	xb= 1 - x
	end select
	case (KEEP_MOMENTUM)
	select case (size (q))
	case (4)
	x = longitudinal_part (q(3:4)) / longitudinal_part (k)
	xb= longitudinal_part (q(1:2)) / longitudinal_part (k)
	case (2)
	x = longitudinal_part (q) / longitudinal_part (k)
	xb= 1 - x
	end select
	end select
	end select
	end if
	end subroutine sf_int_recover_x

	@ %def sf_int_recover_x
	@ Apply the structure function, i.e., evaluate the interaction. For
	the calculation, we may use the stored momenta, any further
	information stored inside the [[sf_int]] implementation during
	kinematics setup, and the given energy scale. It may happen that for
	the given kinematics the value is not defined. This should be
	indicated by the status code.
	<<SF base: sf int: TBP>>=
	procedure (sf_int_apply), deferred :: apply
	<<SF base: interfaces>>=
	abstract interface
	subroutine sf_int_apply (sf_int, scale, negative_sf, rescale, i_sub)
	import
	class(sf_int_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	end subroutine sf_int_apply
	end interface

	@ %def sf_int_apply
	@
	\subsection{Accessing the structure function}
	Return metadata. Once [[interaction_t]] is rewritten in OO, some of this will
	be inherited.

	The number of outgoing particles is equal to the number of incoming particles.
	The radiated particles are the difference.
	<<SF base: sf int: TBP>>=
	procedure :: get_n_in => sf_int_get_n_in
	procedure :: get_n_rad => sf_int_get_n_rad
	procedure :: get_n_out => sf_int_get_n_out
	<<SF base: sub interfaces>>=
	pure module function sf_int_get_n_in (object) result (n_in)
	class(sf_int_t), intent(in) :: object
	integer :: n_in
	end function sf_int_get_n_in
	pure module function sf_int_get_n_rad (object) result (n_rad)
	class(sf_int_t), intent(in) :: object
	integer :: n_rad
	end function sf_int_get_n_rad
	pure module function sf_int_get_n_out (object) result (n_out)
	class(sf_int_t), intent(in) :: object
	integer :: n_out
	end function sf_int_get_n_out
	<<SF base: procedures>>=
	pure module function sf_int_get_n_in (object) result (n_in)
	class(sf_int_t), intent(in) :: object
	integer :: n_in
	n_in = object%interaction_t%get_n_in ()
	end function sf_int_get_n_in

	pure module function sf_int_get_n_rad (object) result (n_rad)
	class(sf_int_t), intent(in) :: object
	integer :: n_rad
	n_rad = object%interaction_t%get_n_out () &
	- object%interaction_t%get_n_in ()
	end function sf_int_get_n_rad

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

	@ %def sf_int_get_n_in
	@ %def sf_int_get_n_rad
	@ %def sf_int_get_n_out
	@ Number of matrix element entries in the interaction:
	<<SF base: sf int: TBP>>=
	procedure :: get_n_states => sf_int_get_n_states
	<<SF base: sub interfaces>>=
	module function sf_int_get_n_states (sf_int) result (n_states)
	class(sf_int_t), intent(in) :: sf_int
	integer :: n_states
	end function sf_int_get_n_states
	<<SF base: procedures>>=
	module function sf_int_get_n_states (sf_int) result (n_states)
	class(sf_int_t), intent(in) :: sf_int
	integer :: n_states
	n_states = sf_int%get_n_matrix_elements ()
	end function sf_int_get_n_states

	@ %def sf_int_get_n_states
	@ Return a specific state as a quantum-number array.
	<<SF base: sf int: TBP>>=
	procedure :: get_state => sf_int_get_state
	<<SF base: sub interfaces>>=
	module function sf_int_get_state (sf_int, i) result (qn)
	class(sf_int_t), intent(in) :: sf_int
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer, intent(in) :: i
	end function sf_int_get_state
	<<SF base: procedures>>=
	module function sf_int_get_state (sf_int, i) result (qn)
	class(sf_int_t), intent(in) :: sf_int
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer, intent(in) :: i
	allocate (qn (sf_int%get_n_tot ()))
	qn = sf_int%get_quantum_numbers (i)
	end function sf_int_get_state

	@ %def sf_int_get_state
	@ Return the matrix-element values for all states. We can assume that
	the matrix elements are real, so we take the real part.
	<<SF base: sf int: TBP>>=
	procedure :: get_values => sf_int_get_values
	<<SF base: sub interfaces>>=
	module subroutine sf_int_get_values (sf_int, value)
	class(sf_int_t), intent(in) :: sf_int
	real(default), dimension(:), intent(out) :: value
	end subroutine sf_int_get_values
	<<SF base: procedures>>=
	module subroutine sf_int_get_values (sf_int, value)
	class(sf_int_t), intent(in) :: sf_int
	real(default), dimension(:), intent(out) :: value
	integer :: i
	if (sf_int%status >= SF_EVALUATED) then
	do i = 1, size (value)
	value(i) = real (sf_int%get_matrix_element (i))
	end do
	else
	value = 0
	end if
	end subroutine sf_int_get_values

	@ %def sf_int_get_values
	@
	\subsection{Direct calculations}
	Compute a structure function value (array) directly, given an array of $x$
	values and a scale. If the energy is also given, we initialize the
	kinematics for that energy, otherwise take it from a previous run.

	We assume that the [[E]] array has dimension [[n_in]], and the [[x]]
	array has [[n_par]].

	Note: the output x values ([[xx]] and [[xxb]]) are unused in this use case.
	<<SF base: sf int: TBP>>=
	procedure :: compute_values => sf_int_compute_values
	<<SF base: sub interfaces>>=
	module subroutine sf_int_compute_values (sf_int, value, x, xb, scale, E)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: value
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(in) :: scale
	real(default), dimension(:), intent(in), optional :: E
	end subroutine sf_int_compute_values
	<<SF base: procedures>>=
	module subroutine sf_int_compute_values (sf_int, value, x, xb, scale, E)
	class(sf_int_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: value
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(in) :: scale
	real(default), dimension(:), intent(in), optional :: E
	real(default), dimension(size (x)) :: xx, xxb
	real(default) :: f
	if (present (E)) call sf_int%seed_kinematics (E)
	if (sf_int%status >= SF_SEED_KINEMATICS) then
	call sf_int%complete_kinematics (xx, xxb, f, x, xb, map=.false.)
	call sf_int%apply (scale)
	call sf_int%get_values (value)
	value = value * f
	else
	value = 0
	end if
	end subroutine sf_int_compute_values

	@ %def sf_int_compute_values
	@ Compute just a single value for one of the states, i.e., throw the
	others away.
	<<SF base: sf int: TBP>>=
	procedure :: compute_value => sf_int_compute_value
	<<SF base: sub interfaces>>=
	module subroutine sf_int_compute_value &
	(sf_int, i_state, value, x, xb, scale, E)
	class(sf_int_t), intent(inout) :: sf_int
	integer, intent(in) :: i_state
	real(default), intent(out) :: value
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(in) :: scale
	real(default), dimension(:), intent(in), optional :: E
	end subroutine sf_int_compute_value
	<<SF base: procedures>>=
	module subroutine sf_int_compute_value &
	(sf_int, i_state, value, x, xb, scale, E)
	class(sf_int_t), intent(inout) :: sf_int
	integer, intent(in) :: i_state
	real(default), intent(out) :: value
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(in) :: scale
	real(default), dimension(:), intent(in), optional :: E
	real(default), dimension(:), allocatable :: value_array
	if (sf_int%status >= SF_INITIAL) then
	allocate (value_array (sf_int%get_n_states ()))
	call sf_int%compute_values (value_array, x, xb, scale, E)
	value = value_array(i_state)
	else
	value = 0
	end if
	end subroutine sf_int_compute_value

	@ %def sf_int_compute_value
	@
	\subsection{Structure-function instance}
	This is a wrapper for [[sf_int_t]] objects, such that we can
	build an array with different structure-function types. The
	structure-function contains an array (a sequence) of [[sf_int_t]]
	objects.

	The object, it holds the evaluator that connects the preceding part of the
	structure-function chain to the current interaction.

	It also stores the input and output parameter values for the
	contained structure function. The [[r]] array has a second dimension,
	corresponding to the mapping channels in a multi-channel
	configuration. There is a Jacobian entry [[f]] for each channel. The
	corresponding logical array [[mapping]] tells whether we apply the
	mapping appropriate for the current structure function in this channel.
	The [[x]] parameter values (energy fractions) are common to all
	channels.
	<<SF base: types>>=
	type :: sf_instance_t
	class(sf_int_t), allocatable :: int
	type(evaluator_t) :: eval
	real(default), dimension(:,:), allocatable :: r
	real(default), dimension(:,:), allocatable :: rb
	real(default), dimension(:), allocatable :: f
	logical, dimension(:), allocatable :: m
	real(default), dimension(:), allocatable :: x
	real(default), dimension(:), allocatable :: xb
	end type sf_instance_t

	@ %def sf_instance_t
	@
	\subsection{Structure-function chain}
	A chain is an array of structure functions [[sf]], initiated by a beam setup.
	We do not use this directly for evaluation, but create instances with
	copies of the contained interactions.

	[[n_par]] is the total number of parameters that is necessary for
	completely determining the structure-function chain. [[n_bound]] is
	the number of MC input parameters that are requested from the
	integrator. The difference of [[n_par]] and [[n_bound]] is the number
	of free parameters, which are generated by a structure-function
	object in generator mode.
	<<SF base: public>>=
	public :: sf_chain_t
	<<SF base: types>>=
	type, extends (beam_t) :: sf_chain_t
	type(beam_data_t), pointer :: beam_data => null ()
	integer :: n_in = 0
	integer :: n_strfun = 0
	integer :: n_par = 0
	integer :: n_bound = 0
	type(sf_instance_t), dimension(:), allocatable :: sf
	logical :: trace_enable = .false.
	integer :: trace_unit = 0
	contains
	<<SF base: sf chain: TBP>>
	end type sf_chain_t

	@ %def sf_chain_t
	@ Finalizer.
	<<SF base: sf chain: TBP>>=
	procedure :: final => sf_chain_final
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_final (object)
	class(sf_chain_t), intent(inout) :: object
	end subroutine sf_chain_final
	<<SF base: procedures>>=
	module subroutine sf_chain_final (object)
	class(sf_chain_t), intent(inout) :: object
	integer :: i
	call object%final_tracing ()
	if (allocated (object%sf)) then
	do i = 1, size (object%sf, 1)
	associate (sf => object%sf(i))
	if (allocated (sf%int)) then
	call sf%int%final ()
	end if
	end associate
	end do
	end if
	call beam_final (object%beam_t)
	end subroutine sf_chain_final

	@ %def sf_chain_final
	@ Output.
	<<SF base: sf chain: TBP>>=
	procedure :: write => sf_chain_write
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_write (object, unit)
	class(sf_chain_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine sf_chain_write
	<<SF base: procedures>>=
	module subroutine sf_chain_write (object, unit)
	class(sf_chain_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Incoming particles / structure-function chain:"
	if (associated (object%beam_data)) then
	write (u, "(3x,A,I0)") "n_in = ", object%n_in
	write (u, "(3x,A,I0)") "n_strfun = ", object%n_strfun
	write (u, "(3x,A,I0)") "n_par = ", object%n_par
	if (object%n_par /= object%n_bound) then
	write (u, "(3x,A,I0)") "n_bound = ", object%n_bound
	end if
	call object%beam_data%write (u)
	call write_separator (u)
	call beam_write (object%beam_t, u)
	if (allocated (object%sf)) then
	do i = 1, object%n_strfun
	associate (sf => object%sf(i))
	call write_separator (u)
	if (allocated (sf%int)) then
	call sf%int%write (u)
	else
	write (u, "(1x,A)") "SF instance: [undefined]"
	end if
	end associate
	end do
	end if
	else
	write (u, "(3x,A)") "[undefined]"
	end if
	end subroutine sf_chain_write

	@ %def sf_chain_write
	@ Initialize: setup beams. The [[beam_data]] target must remain valid
	for the lifetime of the chain, since we just establish a pointer. The
	structure-function configuration array is used to initialize the
	individual structure-function entries. The target attribute is needed
	because the [[sf_int]] entries establish pointers to the configuration data.
	<<SF base: sf chain: TBP>>=
	procedure :: init => sf_chain_init
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_init (sf_chain, beam_data, sf_config)
	class(sf_chain_t), intent(out) :: sf_chain
	type(beam_data_t), intent(in), target :: beam_data
	type(sf_config_t), dimension(:), intent(in), optional, target :: sf_config
	end subroutine sf_chain_init
	<<SF base: procedures>>=
	module subroutine sf_chain_init (sf_chain, beam_data, sf_config)
	class(sf_chain_t), intent(out) :: sf_chain
	type(beam_data_t), intent(in), target :: beam_data
	type(sf_config_t), dimension(:), intent(in), optional, target :: sf_config
	integer :: i
	sf_chain%beam_data => beam_data
	sf_chain%n_in = beam_data%get_n_in ()
	call beam_init (sf_chain%beam_t, beam_data)
	if (present (sf_config)) then
	sf_chain%n_strfun = size (sf_config)
	allocate (sf_chain%sf (sf_chain%n_strfun))
	do i = 1, sf_chain%n_strfun
	call sf_chain%set_strfun (i, sf_config(i)%i, sf_config(i)%data)
	end do
	end if
	end subroutine sf_chain_init

	@ %def sf_chain_init
	@ Receive the beam momenta from a source to which the beam interaction
	is linked.
	<<SF base: sf chain: TBP>>=
	procedure :: receive_beam_momenta => sf_chain_receive_beam_momenta
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_receive_beam_momenta (sf_chain)
	class(sf_chain_t), intent(inout), target :: sf_chain
	type(interaction_t), pointer :: beam_int
	end subroutine sf_chain_receive_beam_momenta
	<<SF base: procedures>>=
	module subroutine sf_chain_receive_beam_momenta (sf_chain)
	class(sf_chain_t), intent(inout), target :: sf_chain
	type(interaction_t), pointer :: beam_int
	beam_int => sf_chain%get_beam_int_ptr ()
	call beam_int%receive_momenta ()
	end subroutine sf_chain_receive_beam_momenta

	@ %def sf_chain_receive_beam_momenta
	@ Explicitly set the beam momenta.
	<<SF base: sf chain: TBP>>=
	procedure :: set_beam_momenta => sf_chain_set_beam_momenta
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_set_beam_momenta (sf_chain, p)
	class(sf_chain_t), intent(inout) :: sf_chain
	type(vector4_t), dimension(:), intent(in) :: p
	end subroutine sf_chain_set_beam_momenta
	<<SF base: procedures>>=
	module subroutine sf_chain_set_beam_momenta (sf_chain, p)
	class(sf_chain_t), intent(inout) :: sf_chain
	type(vector4_t), dimension(:), intent(in) :: p
	call beam_set_momenta (sf_chain%beam_t, p)
	end subroutine sf_chain_set_beam_momenta

	@ %def sf_chain_set_beam_momenta
	@ Set a structure-function entry. We use the [[data]] input to
	allocate the [[int]] structure-function instance with appropriate
	type, then initialize the entry. The entry establishes a pointer to
	[[data]].

	The index [[i]] is the structure-function index in the chain.
	<<SF base: sf chain: TBP>>=
	procedure :: set_strfun => sf_chain_set_strfun
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_set_strfun (sf_chain, i, beam_index, data)
	class(sf_chain_t), intent(inout) :: sf_chain
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: beam_index
	class(sf_data_t), intent(in), target :: data
	end subroutine sf_chain_set_strfun
	<<SF base: procedures>>=
	module subroutine sf_chain_set_strfun (sf_chain, i, beam_index, data)
	class(sf_chain_t), intent(inout) :: sf_chain
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: beam_index
	class(sf_data_t), intent(in), target :: data
	integer :: n_par, j
	n_par = data%get_n_par ()
	call data%allocate_sf_int (sf_chain%sf(i)%int)
	associate (sf_int => sf_chain%sf(i)%int)
	call sf_int%init (data)
	call sf_int%set_beam_index (beam_index)
	call sf_int%set_par_index &
	([(j, j = sf_chain%n_par + 1, sf_chain%n_par + n_par)])
	sf_chain%n_par = sf_chain%n_par + n_par
	if (.not. data%is_generator ()) then
	sf_chain%n_bound = sf_chain%n_bound + n_par
	end if
	end associate
	end subroutine sf_chain_set_strfun

	@ %def sf_chain_set_strfun
	@ Return the number of structure-function parameters.
	<<SF base: sf chain: TBP>>=
	procedure :: get_n_par => sf_chain_get_n_par
	procedure :: get_n_bound => sf_chain_get_n_bound
	<<SF base: sub interfaces>>=
	module function sf_chain_get_n_par (sf_chain) result (n)
	class(sf_chain_t), intent(in) :: sf_chain
	integer :: n
	end function sf_chain_get_n_par
	module function sf_chain_get_n_bound (sf_chain) result (n)
	class(sf_chain_t), intent(in) :: sf_chain
	integer :: n
	end function sf_chain_get_n_bound
	<<SF base: procedures>>=
	module function sf_chain_get_n_par (sf_chain) result (n)
	class(sf_chain_t), intent(in) :: sf_chain
	integer :: n
	n = sf_chain%n_par
	end function sf_chain_get_n_par

	module function sf_chain_get_n_bound (sf_chain) result (n)
	class(sf_chain_t), intent(in) :: sf_chain
	integer :: n
	n = sf_chain%n_bound
	end function sf_chain_get_n_bound

	@ %def sf_chain_get_n_par
	@ %def sf_chain_get_n_bound
	@ Return a pointer to the beam interaction.
	<<SF base: sf chain: TBP>>=
	procedure :: get_beam_int_ptr => sf_chain_get_beam_int_ptr
	<<SF base: sub interfaces>>=
	module function sf_chain_get_beam_int_ptr (sf_chain) result (int)
	type(interaction_t), pointer :: int
	class(sf_chain_t), intent(in), target :: sf_chain
	end function sf_chain_get_beam_int_ptr
	<<SF base: procedures>>=
	module function sf_chain_get_beam_int_ptr (sf_chain) result (int)
	type(interaction_t), pointer :: int
	class(sf_chain_t), intent(in), target :: sf_chain
	int => beam_get_int_ptr (sf_chain%beam_t)
	end function sf_chain_get_beam_int_ptr

	@ %def sf_chain_get_beam_int_ptr
	@ Enable the trace feature: record structure function data (input
	parameters, $x$ values, evaluation result) to an external file.
	<<SF base: sf chain: TBP>>=
	procedure :: setup_tracing => sf_chain_setup_tracing
	procedure :: final_tracing => sf_chain_final_tracing
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_setup_tracing (sf_chain, file)
	class(sf_chain_t), intent(inout) :: sf_chain
	type(string_t), intent(in) :: file
	end subroutine sf_chain_setup_tracing
	module subroutine sf_chain_final_tracing (sf_chain)
	class(sf_chain_t), intent(inout) :: sf_chain
	end subroutine sf_chain_final_tracing
	<<SF base: procedures>>=
	module subroutine sf_chain_setup_tracing (sf_chain, file)
	class(sf_chain_t), intent(inout) :: sf_chain
	type(string_t), intent(in) :: file
	if (sf_chain%n_strfun > 0) then
	sf_chain%trace_enable = .true.
	sf_chain%trace_unit = free_unit ()
	open (sf_chain%trace_unit, file = char (file), action = "write", &
	status = "replace")
	call sf_chain%write_trace_header ()
	else
	call msg_error ("Beam structure: no structure functions, tracing &
	&disabled")
	end if
	end subroutine sf_chain_setup_tracing

	module subroutine sf_chain_final_tracing (sf_chain)
	class(sf_chain_t), intent(inout) :: sf_chain
	if (sf_chain%trace_enable) then
	close (sf_chain%trace_unit)
	sf_chain%trace_enable = .false.
	end if
	end subroutine sf_chain_final_tracing

	@ %def sf_chain_setup_tracing
	@ %def sf_chain_final_tracing
	@ Write the header for the tracing file.
	<<SF base: sf chain: TBP>>=
	procedure :: write_trace_header => sf_chain_write_trace_header
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_write_trace_header (sf_chain)
	class(sf_chain_t), intent(in) :: sf_chain
	end subroutine sf_chain_write_trace_header
	<<SF base: procedures>>=
	module subroutine sf_chain_write_trace_header (sf_chain)
	class(sf_chain_t), intent(in) :: sf_chain
	integer :: u
	if (sf_chain%trace_enable) then
	u = sf_chain%trace_unit
	write (u, "('# ',A)") "WHIZARD output: &
	&structure-function sampling data"
	write (u, "('# ',A,1x,I0)") "Number of sf records:", sf_chain%n_strfun
	write (u, "('# ',A,1x,I0)") "Number of parameters:", sf_chain%n_par
	write (u, "('# ',A)") "Columns: channel, p(n_par), x(n_par), f, Jac * f"
	end if
	end subroutine sf_chain_write_trace_header

	@ %def sf_chain_write_trace_header
	@ Write a record which collects the structure function data for the
	current data point. For the selected channel, we print first the
	input integration parameters, then the $x$ values, then the
	structure-function value summed over all quantum numbers, then the
	structure function value times the mapping Jacobian.
	<<SF base: sf chain: TBP>>=
	procedure :: trace => sf_chain_trace
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_trace (sf_chain, c_sel, p, x, f, sf_sum)
	class(sf_chain_t), intent(in) :: sf_chain
	integer, intent(in) :: c_sel
	real(default), dimension(:,:), intent(in) :: p
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: f
	real(default), intent(in) :: sf_sum
	end subroutine sf_chain_trace
	<<SF base: procedures>>=
	module subroutine sf_chain_trace (sf_chain, c_sel, p, x, f, sf_sum)
	class(sf_chain_t), intent(in) :: sf_chain
	integer, intent(in) :: c_sel
	real(default), dimension(:,:), intent(in) :: p
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: f
	real(default), intent(in) :: sf_sum
	real(default) :: sf_sum_pac, f_sf_sum_pac
	integer :: u, i
	if (sf_chain%trace_enable) then
	u = sf_chain%trace_unit
	write (u, "(1x,I0)", advance="no") c_sel
	write (u, "(2x)", advance="no")
	do i = 1, sf_chain%n_par
	write (u, "(1x," // FMT_17 // ")", advance="no") p(i,c_sel)
	end do
	write (u, "(2x)", advance="no")
	do i = 1, sf_chain%n_par
	write (u, "(1x," // FMT_17 // ")", advance="no") x(i)
	end do
	write (u, "(2x)", advance="no")
	sf_sum_pac = sf_sum
	f_sf_sum_pac = f(c_sel) * sf_sum
	call pacify (sf_sum_pac, 1.E-28_default)
	call pacify (f_sf_sum_pac, 1.E-28_default)
	write (u, "(2(1x," // FMT_17 // "))") sf_sum_pac, f_sf_sum_pac
	end if
	end subroutine sf_chain_trace

	@ %def sf_chain_trace
	@
	\subsection{Chain instances}
	A structure-function chain instance contains copies of the
	interactions in the configuration chain, suitably linked to each other
	and connected by evaluators.

	After initialization, [[out_sf]] should point, for each beam, to the
	last structure function that affects this beam. [[out_sf_i]] should
	indicate the index of the corresponding outgoing particle within that
	structure-function interaction.

	Analogously, [[out_eval]] is the last evaluator in the
	structure-function chain, which contains the complete set of outgoing
	particles. [[out_eval_i]] should indicate the index of the outgoing
	particles, within that evaluator, which will initiate the collision.

	When calculating actual kinematics, we fill the [[p]], [[r]], and
	[[x]] arrays and the [[f]] factor. The [[p]] array denotes the MC
	input parameters as they come from the random-number generator. The
	[[r]] array results from applying global mappings. The [[x]] array
	results from applying structure-function local mappings. The $x$
	values can be interpreted directly as momentum fractions (or angle
	fractions, where recoil is involved). The [[f]] factor is the
	Jacobian that results from applying all mappings.

	Update 2017-08-22: carry and output all complements ([[pb]], [[rb]],
	[[xb]]). Previously, [[xb]] was not included in the record, and the
	output did not contain either. It does become more verbose, however.

	The [[mapping]] entry may store a global mapping that is applied to a
	combination of $x$ values and structure functions, as opposed to mappings that
	affect only a single structure function. It is applied before the latter
	mappings, in the transformation from the [[p]] array to the [[r]] array. For
	parameters affected by this mapping, we should ensure that they are not
	involved in a local mapping.
	<<SF base: public>>=
	public :: sf_chain_instance_t
	<<SF base: types>>=
	type, extends (beam_t) :: sf_chain_instance_t
	type(sf_chain_t), pointer :: config => null ()
	integer :: status = SF_UNDEFINED
	type(sf_instance_t), dimension(:), allocatable :: sf
	integer, dimension(:), allocatable :: out_sf
	integer, dimension(:), allocatable :: out_sf_i
	integer :: out_eval = 0
	integer, dimension(:), allocatable :: out_eval_i
	integer :: selected_channel = 0
	real(default), dimension(:,:), allocatable :: p, pb
	real(default), dimension(:,:), allocatable :: r, rb
	real(default), dimension(:), allocatable :: f
	real(default), dimension(:), allocatable :: x, xb
	logical, dimension(:), allocatable :: bound
	real(default) :: x_free = 1
	type(sf_channel_t), dimension(:), allocatable :: channel
	contains
	<<SF base: sf chain instance: TBP>>
	end type sf_chain_instance_t

	@ %def sf_chain_instance_t
	@ Finalizer.
	<<SF base: sf chain instance: TBP>>=
	procedure :: final => sf_chain_instance_final
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_final (object)
	class(sf_chain_instance_t), intent(inout) :: object
	end subroutine sf_chain_instance_final
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_final (object)
	class(sf_chain_instance_t), intent(inout) :: object
	integer :: i
	if (allocated (object%sf)) then
	do i = 1, size (object%sf, 1)
	associate (sf => object%sf(i))
	if (allocated (sf%int)) then
	call sf%eval%final ()
	call sf%int%final ()
	end if
	end associate
	end do
	end if
	call beam_final (object%beam_t)
	end subroutine sf_chain_instance_final

	@ %def sf_chain_instance_final
	@ Output.
	<<SF base: sf chain instance: TBP>>=
	procedure :: write => sf_chain_instance_write
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_write (object, unit, col_verbose)
	class(sf_chain_instance_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: col_verbose
	end subroutine sf_chain_instance_write
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_write (object, unit, col_verbose)
	class(sf_chain_instance_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: col_verbose
	integer :: u, i, c
	u = given_output_unit (unit)
	write (u, "(1x,A)", advance="no") "Structure-function chain instance:"
	call write_sf_status (object%status, u)
	if (allocated (object%out_sf)) then
	write (u, "(3x,A)", advance="no") "outgoing (interactions) ="
	do i = 1, size (object%out_sf)
	write (u, "(1x,I0,':',I0)", advance="no") &
	object%out_sf(i), object%out_sf_i(i)
	end do
	write (u, *)
	end if
	if (object%out_eval /= 0) then
	write (u, "(3x,A)", advance="no") "outgoing (evaluators) ="
	do i = 1, size (object%out_sf)
	write (u, "(1x,I0,':',I0)", advance="no") &
	object%out_eval, object%out_eval_i(i)
	end do
	write (u, *)
	end if
	if (allocated (object%sf)) then
	if (size (object%sf) /= 0) then
	write (u, "(1x,A)") "Structure-function parameters:"
	do c = 1, size (object%f)
	write (u, "(1x,A,I0,A)", advance="no") "Channel #", c, ":"
	if (c == object%selected_channel) then
	write (u, "(1x,A)") "[selected]"
	else
	write (u, *)
	end if
	write (u, "(3x,A,9(1x,F9.7))") "p =", object%p(:,c)
	write (u, "(3x,A,9(1x,F9.7))") "pb=", object%pb(:,c)
	write (u, "(3x,A,9(1x,F9.7))") "r =", object%r(:,c)
	write (u, "(3x,A,9(1x,F9.7))") "rb=", object%rb(:,c)
	write (u, "(3x,A,9(1x,ES13.7))") "f =", object%f(c)
	write (u, "(3x,A)", advance="no") "m ="
	call object%channel(c)%write (u)
	end do
	write (u, "(3x,A,9(1x,F9.7))") "x =", object%x
	write (u, "(3x,A,9(1x,F9.7))") "xb=", object%xb
	if (.not. all (object%bound)) then
	write (u, "(3x,A,9(1x,L1))") "bound =", object%bound
	end if
	end if
	end if
	call write_separator (u)
	call beam_write (object%beam_t, u, col_verbose = col_verbose)
	if (allocated (object%sf)) then
	do i = 1, size (object%sf)
	associate (sf => object%sf(i))
	call write_separator (u)
	if (allocated (sf%int)) then
	if (allocated (sf%r)) then
	write (u, "(1x,A)") "Structure-function parameters:"
	do c = 1, size (sf%f)
	write (u, "(1x,A,I0,A)", advance="no") "Channel #", c, ":"
	if (c == object%selected_channel) then
	write (u, "(1x,A)") "[selected]"
	else
	write (u, *)
	end if
	write (u, "(3x,A,9(1x,F9.7))") "r =", sf%r(:,c)
	write (u, "(3x,A,9(1x,F9.7))") "rb=", sf%rb(:,c)
	write (u, "(3x,A,9(1x,ES13.7))") "f =", sf%f(c)
	write (u, "(3x,A,9(1x,L1,7x))") "m =", sf%m(c)
	end do
	write (u, "(3x,A,9(1x,F9.7))") "x =", sf%x
	write (u, "(3x,A,9(1x,F9.7))") "xb=", sf%xb
	end if
	call sf%int%write(u)
	if (.not. sf%eval%is_empty ()) then
	call sf%eval%write (u, col_verbose = col_verbose)
	end if
	end if
	end associate
	end do
	end if
	end subroutine sf_chain_instance_write

	@ %def sf_chain_instance_write
	@ Initialize. This creates a copy of the interactions in the
	configuration chain, assumed to be properly initialized. In the copy,
	we allocate the [[p]] etc.\ arrays.

	The brute-force assignment of the [[sf]] component would be
	straightforward, but we provide a more fine-grained copy.
	In any case, the copy is deep as far as allocatables are concerned,
	but for the contained [[interaction_t]] objects the copy is shallow,
	as long as we do not bind defined assignment to the type. Therefore,
	we have to re-assign the [[interaction_t]] components explicitly, this
	time calling the proper defined assignment. Furthermore, we allocate
	the parameter arrays for each structure function.
	<<SF base: sf chain instance: TBP>>=
	procedure :: init => sf_chain_instance_init
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_init (chain, config, n_channel)
	class(sf_chain_instance_t), intent(out), target :: chain
	type(sf_chain_t), intent(in), target :: config
	integer, intent(in) :: n_channel
	end subroutine sf_chain_instance_init
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_init (chain, config, n_channel)
	class(sf_chain_instance_t), intent(out), target :: chain
	type(sf_chain_t), intent(in), target :: config
	integer, intent(in) :: n_channel
	integer :: i, j
	integer :: n_par_tot, n_par, n_strfun
	chain%config => config
	n_strfun = config%n_strfun
	chain%beam_t = config%beam_t
	allocate (chain%out_sf (config%n_in), chain%out_sf_i (config%n_in))
	allocate (chain%out_eval_i (config%n_in))
	chain%out_sf = 0
	chain%out_sf_i = [(i, i = 1, config%n_in)]
	chain%out_eval_i = chain%out_sf_i
	n_par_tot = 0
	if (n_strfun /= 0) then
	allocate (chain%sf (n_strfun))
	do i = 1, n_strfun
	associate (sf => chain%sf(i))
	allocate (sf%int, source=config%sf(i)%int)
	sf%int%interaction_t = config%sf(i)%int%interaction_t
	n_par = size (sf%int%par_index)
	allocate (sf%r (n_par, n_channel)); sf%r = 0
	allocate (sf%rb(n_par, n_channel)); sf%rb= 0
	allocate (sf%f (n_channel)); sf%f = 0
	allocate (sf%m (n_channel)); sf%m = .false.
	allocate (sf%x (n_par)); sf%x = 0
	allocate (sf%xb(n_par)); sf%xb= 0
	n_par_tot = n_par_tot + n_par
	end associate
	end do
	allocate (chain%p (n_par_tot, n_channel)); chain%p = 0
	allocate (chain%pb(n_par_tot, n_channel)); chain%pb= 0
	allocate (chain%r (n_par_tot, n_channel)); chain%r = 0
	allocate (chain%rb(n_par_tot, n_channel)); chain%rb= 0
	allocate (chain%f (n_channel)); chain%f = 0
	allocate (chain%x (n_par_tot)); chain%x = 0
	allocate (chain%xb(n_par_tot)); chain%xb= 0
	call allocate_sf_channels &
	(chain%channel, n_channel=n_channel, n_strfun=n_strfun)
	end if
	allocate (chain%bound (n_par_tot), source = .true.)
	do i = 1, n_strfun
	associate (sf => chain%sf(i))
	if (sf%int%is_generator ()) then
	do j = 1, size (sf%int%par_index)
	chain%bound(sf%int%par_index(j)) = .false.
	end do
	end if
	end associate
	end do
	chain%status = SF_INITIAL
	end subroutine sf_chain_instance_init

	@ %def sf_chain_instance_init
	@ Manually select a channel.
	<<SF base: sf chain instance: TBP>>=
	procedure :: select_channel => sf_chain_instance_select_channel
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_select_channel (chain, channel)
	class(sf_chain_instance_t), intent(inout) :: chain
	integer, intent(in), optional :: channel
	end subroutine sf_chain_instance_select_channel
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_select_channel (chain, channel)
	class(sf_chain_instance_t), intent(inout) :: chain
	integer, intent(in), optional :: channel
	if (present (channel)) then
	chain%selected_channel = channel
	else
	chain%selected_channel = 0
	end if
	end subroutine sf_chain_instance_select_channel

	@ %def sf_chain_instance_select_channel
	@ Copy a channel-mapping object to the structure-function
	chain instance. We assume that assignment is sufficient, i.e., any
	non-static components of the [[channel]] object are allocatable und
	thus recursively copied.

	After the copy, we extract the single-entry mappings and activate them
	for the individual structure functions. If there is a multi-entry
	mapping, we obtain the corresponding MC parameter indices and set them
	in the copy of the channel object.
	<<SF base: sf chain instance: TBP>>=
	procedure :: set_channel => sf_chain_instance_set_channel
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_set_channel (chain, c, channel)
	class(sf_chain_instance_t), intent(inout) :: chain
	integer, intent(in) :: c
	type(sf_channel_t), intent(in) :: channel
	end subroutine sf_chain_instance_set_channel
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_set_channel (chain, c, channel)
	class(sf_chain_instance_t), intent(inout) :: chain
	integer, intent(in) :: c
	type(sf_channel_t), intent(in) :: channel
	integer :: i, j, k
	if (chain%status >= SF_INITIAL) then
	chain%channel(c) = channel
	j = 0
	do i = 1, chain%config%n_strfun
	associate (sf => chain%sf(i))
	sf%m(c) = channel%is_single_mapping (i)
	if (channel%is_multi_mapping (i)) then
	do k = 1, size (sf%int%beam_index)
	j = j + 1
	call chain%channel(c)%set_par_index &
	(j, sf%int%par_index(k))
	end do
	end if
	end associate
	end do
	if (j /= chain%channel(c)%get_multi_mapping_n_par ()) then
	print *, "index last filled = ", j
	print *, "number of parameters = ", &
	chain%channel(c)%get_multi_mapping_n_par ()
	call msg_bug ("Structure-function setup: mapping index mismatch")
	end if
	chain%status = SF_INITIAL
	end if
	end subroutine sf_chain_instance_set_channel

	@ %def sf_chain_instance_set_channel
	@ Link the interactions in the chain. First, link the beam instance
	to its template in the configuration chain, which should have the
	appropriate momenta fixed.

	Then, we follow the chain via the
	arrays [[out_sf]] and [[out_sf_i]]. The arrays are (up to)
	two-dimensional, the entries correspond to the beam particle(s).
	For each beam, the entry [[out_sf]] points to the last interaction
	that affected this beam, and [[out_sf_i]] is the
	out-particle index within that interaction. For the initial beam,
	[[out_sf]] is zero by definition.

	For each entry in the chain, we scan the affected beams (one or two).
	We look for [[out_sf]] and link the out-particle there to the
	corresponding in-particle in the current interaction. Then, we update
	the entry in [[out_sf]] and [[out_sf_i]] to point to the current
	interaction.
	<<SF base: sf chain instance: TBP>>=
	procedure :: link_interactions => sf_chain_instance_link_interactions
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_link_interactions (chain)
	class(sf_chain_instance_t), intent(inout), target :: chain
	end subroutine sf_chain_instance_link_interactions
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_link_interactions (chain)
	class(sf_chain_instance_t), intent(inout), target :: chain
	type(interaction_t), pointer :: int
	integer :: i, j, b
	if (chain%status >= SF_INITIAL) then
	do b = 1, chain%config%n_in
	int => beam_get_int_ptr (chain%beam_t)
	call interaction_set_source_link_beam (int, b, &
	chain%config%beam_t, b)
	end do
	if (allocated (chain%sf)) then
	do i = 1, size (chain%sf)
	associate (sf_int => chain%sf(i)%int)
	do j = 1, size (sf_int%beam_index)
	b = sf_int%beam_index(j)
	call link (sf_int%interaction_t, b, sf_int%incoming(j))
	chain%out_sf(b) = i
	chain%out_sf_i(b) = sf_int%outgoing(j)
	end do
	end associate
	end do
	end if
	chain%status = SF_DONE_LINKS
	end if
	contains
	subroutine link (int, b, in_index)
	type(interaction_t), intent(inout) :: int
	integer, intent(in) :: b, in_index
	integer :: i
	i = chain%out_sf(b)
	select case (i)
	case (0)
	call interaction_set_source_link_beam (int, in_index, &
	chain%beam_t, chain%out_sf_i(b))
	case default
	call int%set_source_link (in_index, &
	chain%sf(i)%int, chain%out_sf_i(b))
	end select
	end subroutine link
	end subroutine sf_chain_instance_link_interactions

	@ %def sf_chain_instance_link_interactions
	@ Exchange the quantum-number masks between the interactions in the
	chain, so we can combine redundant entries and detect any obvious mismatch.

	We proceed first in the forward direction and then backwards again.

	After this is finished, we finalize initialization by calling the
	[[setup_constants]] method, which prepares constant data that depend on the
	matrix element structure.
	<<SF base: sf chain instance: TBP>>=
	procedure :: exchange_mask => sf_chain_exchange_mask
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_exchange_mask (chain)
	class(sf_chain_instance_t), intent(inout), target :: chain
	end subroutine sf_chain_exchange_mask
	<<SF base: procedures>>=
	module subroutine sf_chain_exchange_mask (chain)
	class(sf_chain_instance_t), intent(inout), target :: chain
	type(interaction_t), pointer :: int
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
	integer :: i
	if (chain%status >= SF_DONE_LINKS) then
	if (allocated (chain%sf)) then
	int => beam_get_int_ptr (chain%beam_t)
	allocate (mask (int%get_n_out ()))
	mask = int%get_mask ()
	if (size (chain%sf) /= 0) then
	do i = 1, size (chain%sf) - 1
	call chain%sf(i)%int%exchange_mask ()
	end do
	do i = size (chain%sf), 1, -1
	call chain%sf(i)%int%exchange_mask ()
	end do
	if (any (mask .neqv. int%get_mask ())) then
	chain%status = SF_FAILED_MASK
	return
	end if
	do i = 1, size (chain%sf)
	call chain%sf(i)%int%setup_constants ()
	end do
	end if
	end if
	chain%status = SF_DONE_MASK
	end if
	end subroutine sf_chain_exchange_mask

	@ %def sf_chain_exchange_mask
	@ Initialize the evaluators that connect the interactions in the
	chain.
	<<SF base: sf chain instance: TBP>>=
	procedure :: init_evaluators => sf_chain_instance_init_evaluators
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_init_evaluators (chain, extended_sf)
	class(sf_chain_instance_t), intent(inout), target :: chain
	logical, intent(in), optional :: extended_sf
	end subroutine sf_chain_instance_init_evaluators
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_init_evaluators (chain, extended_sf)
	class(sf_chain_instance_t), intent(inout), target :: chain
	logical, intent(in), optional :: extended_sf
	type(interaction_t), pointer :: int
	type(quantum_numbers_mask_t) :: mask
	integer :: i
	logical :: yorn
	yorn = .false.; if (present (extended_sf)) yorn = extended_sf
	if (chain%status >= SF_DONE_MASK) then
	if (allocated (chain%sf)) then
	if (size (chain%sf) /= 0) then
	mask = quantum_numbers_mask (.false., .false., .true.)
	int => beam_get_int_ptr (chain%beam_t)
	do i = 1, size (chain%sf)
	associate (sf => chain%sf(i))
	if (yorn) then
	if (int%get_n_sub () == 0) then
	call int%declare_subtraction (n_beams_rescaled)
	end if
	if (sf%int%interaction_t%get_n_sub () == 0) then
	call sf%int%interaction_t%declare_subtraction (n_beams_rescaled)
	end if
	end if
	call sf%eval%init_product (int, sf%int%interaction_t, mask,&
	& ignore_sub_for_qn = .true.)
	if (sf%eval%is_empty ()) then
	chain%status = SF_FAILED_CONNECTIONS
	return
	end if
	int => sf%eval%interaction_t
	end associate
	end do
	call find_outgoing_particles ()
	end if
	else if (chain%out_eval == 0) then
	int => beam_get_int_ptr (chain%beam_t)
	call int%tag_hard_process ()
	end if
	chain%status = SF_DONE_CONNECTIONS
	end if
	contains
	<<SF base: init evaluators: find outgoing particles>>
	end subroutine sf_chain_instance_init_evaluators

	@ %def sf_chain_instance_init_evaluators
	@ For debug purposes
	<<SF base: sf chain instance: TBP>>=
	procedure :: write_interaction => sf_chain_instance_write_interaction
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_write_interaction &
	(chain, i_sf, i_int, unit)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: i_sf, i_int
	integer, intent(in) :: unit
	end subroutine sf_chain_instance_write_interaction
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_write_interaction &
	(chain, i_sf, i_int, unit)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: i_sf, i_int
	integer, intent(in) :: unit
	class(interaction_t), pointer :: int_in1 => null ()
	class(interaction_t), pointer :: int_in2 => null ()
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	if (chain%status >= SF_DONE_MASK) then
	if (allocated (chain%sf)) then
	int_in1 => evaluator_get_int_in_ptr (chain%sf(i_sf)%eval, 1)
	int_in2 => evaluator_get_int_in_ptr (chain%sf(i_sf)%eval, 2)
	if (int_in1%get_tag () == i_int) then
	call int_in1%basic_write (u)
	else if (int_in2%get_tag () == i_int) then
	call int_in2%basic_write (u)
	else
	write (u, "(A,1x,I0,1x,A,1x,I0)") 'No tag of sf', i_sf, 'matches' , i_int
	end if
	else
	write (u, "(A)") 'No sf_chain allocated!'
	end if
	else
	write (u, "(A)") 'sf_chain not ready!'
	end if
	end subroutine sf_chain_instance_write_interaction

	@ %def sf_chain_instance_write_interaction
	@ This is an internal subroutine of the previous one: After evaluators
	are set, trace the outgoing particles to the last evaluator. We only
	need the first channel, all channels are equivalent for this purpose.

	For each beam, the outgoing particle is located by [[out_sf]] (the
	structure-function object where it originates) and [[out_sf_i]] (the
	index within that object). This particle is referenced by the
	corresponding evaluator, which in turn is referenced by the next
	evaluator, until we are at the end of the chain. We can trace back
	references by [[interaction_find_link]]. Knowing that [[out_eval]] is
	the index of the last evaluator, we thus determine [[out_eval_i]], the
	index of the outgoing particle within that evaluator.
	<<SF base: init evaluators: find outgoing particles>>=
	subroutine find_outgoing_particles ()
	type(interaction_t), pointer :: int, int_next
	integer :: i, j, out_sf, out_i
	chain%out_eval = size (chain%sf)
	do j = 1, size (chain%out_eval_i)
	out_sf = chain%out_sf(j)
	out_i = chain%out_sf_i(j)
	if (out_sf == 0) then
	int => beam_get_int_ptr (chain%beam_t)
	out_sf = 1
	else
	int => chain%sf(out_sf)%int%interaction_t
	end if
	do i = out_sf, chain%out_eval
	int_next => chain%sf(i)%eval%interaction_t
	out_i = interaction_find_link (int_next, int, out_i)
	int => int_next
	end do
	chain%out_eval_i(j) = out_i
	end do
	call int%tag_hard_process (chain%out_eval_i)
	end subroutine find_outgoing_particles

	@ %def find_outgoing_particles
	@ Compute the kinematics in the chain instance. We can assume that
	the seed momenta are set in the configuration beams. Scanning the
	chain, we first transfer the incoming momenta. Then, the use up the MC input
	parameter array [[p]] to compute the radiated and outgoing momenta.

	In the multi-channel case, [[c_sel]] is the channel which we use for
	computing the kinematics and the [[x]] values. In the other channels,
	we invert the kinematics in order to recover the corresponding rows in
	the [[r]] array, and the Jacobian [[f]].

	We first apply any global mapping to transform the input [[p]] into
	the array [[r]]. This is then given to the structure functions which
	compute the final array [[x]] and Jacobian factors [[f]], which we
	multiply to obtain the overall Jacobian.
	<<SF base: sf chain instance: TBP>>=
	procedure :: compute_kinematics => sf_chain_instance_compute_kinematics
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_compute_kinematics (chain, c_sel, p_in)
	class(sf_chain_instance_t), intent(inout), target :: chain
	integer, intent(in) :: c_sel
	real(default), dimension(:), intent(in) :: p_in
	end subroutine sf_chain_instance_compute_kinematics
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_compute_kinematics (chain, c_sel, p_in)
	class(sf_chain_instance_t), intent(inout), target :: chain
	integer, intent(in) :: c_sel
	real(default), dimension(:), intent(in) :: p_in
	type(interaction_t), pointer :: int
	real(default) :: f_mapping
	integer :: i, j, c
	if (chain%status >= SF_DONE_CONNECTIONS) then
	call chain%select_channel (c_sel)
	int => beam_get_int_ptr (chain%beam_t)
	call int%receive_momenta ()
	if (allocated (chain%sf)) then
	if (size (chain%sf) /= 0) then
	forall (i = 1:size (chain%sf)) chain%sf(i)%int%status = SF_INITIAL
	chain%p (:,c_sel) = unpack (p_in, chain%bound, 0._default)
	chain%pb(:,c_sel) = 1 - chain%p(:,c_sel)
	chain%f = 1
	chain%x_free = 1
	do i = 1, size (chain%sf)
	associate (sf => chain%sf(i))
	call sf%int%generate_free (sf%r(:,c_sel), sf%rb(:,c_sel), &
	chain%x_free)
	do j = 1, size (sf%x)
	if (.not. chain%bound(sf%int%par_index(j))) then
	chain%p (sf%int%par_index(j),c_sel) = sf%r (j,c_sel)
	chain%pb(sf%int%par_index(j),c_sel) = sf%rb(j,c_sel)
	end if
	end do
	end associate
	end do
	if (allocated (chain%channel(c_sel)%multi_mapping)) then
	call chain%channel(c_sel)%multi_mapping%compute &
	(chain%r(:,c_sel), chain%rb(:,c_sel), &
	f_mapping, &
	chain%p(:,c_sel), chain%pb(:,c_sel), &
	chain%x_free)
	chain%f(c_sel) = f_mapping
	else
	chain%r (:,c_sel) = chain%p (:,c_sel)
	chain%rb(:,c_sel) = chain%pb(:,c_sel)
	chain%f(c_sel) = 1
	end if
	do i = 1, size (chain%sf)
	associate (sf => chain%sf(i))
	call sf%int%seed_kinematics ()
	do j = 1, size (sf%x)
	sf%r (j,c_sel) = chain%r (sf%int%par_index(j),c_sel)
	sf%rb(j,c_sel) = chain%rb(sf%int%par_index(j),c_sel)
	end do
	call sf%int%complete_kinematics &
	(sf%x, sf%xb, sf%f(c_sel), sf%r(:,c_sel), sf%rb(:,c_sel), &
	sf%m(c_sel))
	do j = 1, size (sf%x)
	chain%x(sf%int%par_index(j)) = sf%x(j)
	chain%xb(sf%int%par_index(j)) = sf%xb(j)
	end do
	if (sf%int%status <= SF_FAILED_KINEMATICS) then
	chain%status = SF_FAILED_KINEMATICS
	return
	end if
	do c = 1, size (sf%f)
	if (c /= c_sel) then
	call sf%int%inverse_kinematics &
	(sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c))
	do j = 1, size (sf%x)
	chain%r (sf%int%par_index(j),c) = sf%r (j,c)
	chain%rb(sf%int%par_index(j),c) = sf%rb(j,c)
	end do
	end if
	chain%f(c) = chain%f(c) * sf%f(c)
	end do
	if (.not. sf%eval%is_empty ()) then
	call sf%eval%receive_momenta ()
	end if
	end associate
	end do
	do c = 1, size (chain%f)
	if (c /= c_sel) then
	if (allocated (chain%channel(c)%multi_mapping)) then
	call chain%channel(c)%multi_mapping%inverse &
	(chain%r(:,c), chain%rb(:,c), &
	f_mapping, &
	chain%p(:,c), chain%pb(:,c), &
	chain%x_free)
	chain%f(c) = chain%f(c) * f_mapping
	else
	chain%p (:,c) = chain%r (:,c)
	chain%pb(:,c) = chain%rb(:,c)
	end if
	end if
	end do
	end if
	end if
	chain%status = SF_DONE_KINEMATICS
	end if
	end subroutine sf_chain_instance_compute_kinematics

	@ %def sf_chain_instance_compute_kinematics
	@ This is a variant of the previous procedure. We know the $x$ parameters and
	reconstruct the momenta and the MC input parameters [[p]]. We do not need to
	select a channel.

	Note: this is probably redundant, since the method we actually want
	starts from the momenta, recovers all $x$ parameters, and then
	inverts mappings. See below [[recover_kinematics]].
	<<SF base: sf chain instance: TBP>>=
	procedure :: inverse_kinematics => sf_chain_instance_inverse_kinematics
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_inverse_kinematics (chain, x, xb)
	class(sf_chain_instance_t), intent(inout), target :: chain
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	end subroutine sf_chain_instance_inverse_kinematics
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_inverse_kinematics (chain, x, xb)
	class(sf_chain_instance_t), intent(inout), target :: chain
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	type(interaction_t), pointer :: int
	real(default) :: f_mapping
	integer :: i, j, c
	if (chain%status >= SF_DONE_CONNECTIONS) then
	call chain%select_channel ()
	int => beam_get_int_ptr (chain%beam_t)
	call int%receive_momenta ()
	if (allocated (chain%sf)) then
	chain%f = 1
	if (size (chain%sf) /= 0) then
	forall (i = 1:size (chain%sf)) chain%sf(i)%int%status = SF_INITIAL
	chain%x = x
	chain%xb= xb
	do i = 1, size (chain%sf)
	associate (sf => chain%sf(i))
	call sf%int%seed_kinematics ()
	do j = 1, size (sf%x)
	sf%x(j) = chain%x(sf%int%par_index(j))
	sf%xb(j) = chain%xb(sf%int%par_index(j))
	end do
	do c = 1, size (sf%f)
	call sf%int%inverse_kinematics &
	(sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c), &
	set_momenta = c==1)
	chain%f(c) = chain%f(c) * sf%f(c)
	do j = 1, size (sf%x)
	chain%r (sf%int%par_index(j),c) = sf%r (j,c)
	chain%rb(sf%int%par_index(j),c) = sf%rb(j,c)
	end do
	end do
	if (.not. sf%eval%is_empty ()) then
	call sf%eval%receive_momenta ()
	end if
	end associate
	end do
	do c = 1, size (chain%f)
	if (allocated (chain%channel(c)%multi_mapping)) then
	call chain%channel(c)%multi_mapping%inverse &
	(chain%r(:,c), chain%rb(:,c), &
	f_mapping, &
	chain%p(:,c), chain%pb(:,c), &
	chain%x_free)
	chain%f(c) = chain%f(c) * f_mapping
	else
	chain%p (:,c) = chain%r (:,c)
	chain%pb(:,c) = chain%rb(:,c)
	end if
	end do
	end if
	end if
	chain%status = SF_DONE_KINEMATICS
	end if
	end subroutine sf_chain_instance_inverse_kinematics

	@ %def sf_chain_instance_inverse_kinematics
	@ Recover the kinematics: assuming that the last evaluator has
	been filled with a valid set of momenta, we travel the momentum links
	backwards and fill the preceding evaluators and, as a side effect,
	interactions. We stop at the beam interaction.

	After all momenta are set, apply the [[inverse_kinematics]] procedure
	above, suitably modified, to recover the $x$ and $p$ parameters and
	the Jacobian factors.

	The [[c_sel]] (channel) argument is just used to mark a selected
	channel for the records, otherwise the recovery procedure is
	independent of this.
	<<SF base: sf chain instance: TBP>>=
	procedure :: recover_kinematics => sf_chain_instance_recover_kinematics
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_recover_kinematics (chain, c_sel)
	class(sf_chain_instance_t), intent(inout), target :: chain
	integer, intent(in) :: c_sel
	end subroutine sf_chain_instance_recover_kinematics
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_recover_kinematics (chain, c_sel)
	class(sf_chain_instance_t), intent(inout), target :: chain
	integer, intent(in) :: c_sel
	real(default) :: f_mapping
	integer :: i, j, c
	if (chain%status >= SF_DONE_CONNECTIONS) then
	call chain%select_channel (c_sel)
	if (allocated (chain%sf)) then
	do i = size (chain%sf), 1, -1
	associate (sf => chain%sf(i))
	if (.not. sf%eval%is_empty ()) then
	call sf%eval%send_momenta ()
	end if
	end associate
	end do
	chain%f = 1
	if (size (chain%sf) /= 0) then
	forall (i = 1:size (chain%sf)) chain%sf(i)%int%status = SF_INITIAL
	chain%x_free = 1
	do i = 1, size (chain%sf)
	associate (sf => chain%sf(i))
	call sf%int%seed_kinematics ()
	call sf%int%recover_x (sf%x, sf%xb, chain%x_free)
	do j = 1, size (sf%x)
	chain%x(sf%int%par_index(j)) = sf%x(j)
	chain%xb(sf%int%par_index(j)) = sf%xb(j)
	end do
	do c = 1, size (sf%f)
	call sf%int%inverse_kinematics &
	(sf%x, sf%xb, sf%f(c), sf%r(:,c), sf%rb(:,c), sf%m(c), &
	set_momenta = .false.)
	chain%f(c) = chain%f(c) * sf%f(c)
	do j = 1, size (sf%x)
	chain%r (sf%int%par_index(j),c) = sf%r (j,c)
	chain%rb(sf%int%par_index(j),c) = sf%rb(j,c)
	end do
	end do
	end associate
	end do
	do c = 1, size (chain%f)
	if (allocated (chain%channel(c)%multi_mapping)) then
	call chain%channel(c)%multi_mapping%inverse &
	(chain%r(:,c), chain%rb(:,c), &
	f_mapping, &
	chain%p(:,c), chain%pb(:,c), &
	chain%x_free)
	chain%f(c) = chain%f(c) * f_mapping
	else
	chain%p (:,c) = chain%r (:,c)
	chain%pb(:,c) = chain%rb(:,c)
	end if
	end do
	end if
	end if
	chain%status = SF_DONE_KINEMATICS
	end if
	end subroutine sf_chain_instance_recover_kinematics

	@ %def sf_chain_instance_recover_kinematics
	@ Return the initial beam momenta to their source, thus completing
	kinematics recovery. Obviously, this works as a side effect.
	<<SF base: sf chain instance: TBP>>=
	procedure :: return_beam_momenta => sf_chain_instance_return_beam_momenta
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_return_beam_momenta (chain)
	class(sf_chain_instance_t), intent(in), target :: chain
	type(interaction_t), pointer :: int
	end subroutine sf_chain_instance_return_beam_momenta
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_return_beam_momenta (chain)
	class(sf_chain_instance_t), intent(in), target :: chain
	type(interaction_t), pointer :: int
	if (chain%status >= SF_DONE_KINEMATICS) then
	int => beam_get_int_ptr (chain%beam_t)
	call int%send_momenta ()
	end if
	end subroutine sf_chain_instance_return_beam_momenta

	@ %def sf_chain_instance_return_beam_momenta
	@ Evaluate all interactions in the chain and the product evaluators.
	We provide a [[scale]] argument that is given to all structure
	functions in the chain.

	Hadronic NLO calculations involve rescaled fractions of the original beam
	momentum. In particular, we have to handle the following cases:
	\begin{itemize}
	\item normal evaluation (where [[i_sub = 0]]) for all terms except the
	real non-subtracted,
	\item rescaled momentum fraction for both beams in the case of the
	real non-subtracted term ([[i_sub = 0]]),
	\item and rescaled momentum fraction for one of both beams in the case of the
	subtraction and DGLAP component ([[i_sub = 1,2]]).
	\end{itemize}
	For the collinear final or intial state counter terms, we apply a rescaling to
	one beam, and keep the other beam as is. We redo it then vice versa having now two subtractions.
	<<SF base: sf chain instance: TBP>>=
	procedure :: evaluate => sf_chain_instance_evaluate
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_evaluate &
	(chain, scale, negative_sf, sf_rescale)
	class(sf_chain_instance_t), intent(inout), target :: chain
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(inout), optional :: sf_rescale
	end subroutine sf_chain_instance_evaluate
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_evaluate &
	(chain, scale, negative_sf, sf_rescale)
	class(sf_chain_instance_t), intent(inout), target :: chain
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(inout), optional :: sf_rescale
	type(interaction_t), pointer :: out_int
	real(default) :: sf_sum
	integer :: i_beam, i_sub, n_sub
	logical :: rescale
	n_sub = 0
	rescale = .false.; if (present (sf_rescale)) rescale = .true.
	if (rescale) then
	n_sub = chain%get_n_sub ()
	end if
	if (chain%status >= SF_DONE_KINEMATICS) then
	if (allocated (chain%sf)) then
	if (size (chain%sf) /= 0) then
	do i_beam = 1, size (chain%sf)
	associate (sf => chain%sf(i_beam))
	if (rescale) then
	call sf_rescale%set_i_beam (i_beam)
	do i_sub = 0, n_sub
	select case (i_sub)
	case (0)
	if (n_sub == 0) then
	call sf%int%apply (scale, negative_sf, sf_rescale, i_sub = i_sub)
	else
	call sf%int%apply (scale, negative_sf, i_sub = i_sub)
	end if
	case default
	if (i_beam == i_sub) then
	call sf%int%apply (scale, negative_sf, sf_rescale, i_sub = i_sub)
	else
	call sf%int%apply (scale, negative_sf, i_sub = i_sub)
	end if
	end select
	end do
	else
	call sf%int%apply (scale, negative_sf, i_sub = n_sub)
	end if
	if (sf%int%status <= SF_FAILED_EVALUATION) then
	chain%status = SF_FAILED_EVALUATION
	return
	end if
	if (.not. sf%eval%is_empty ()) call sf%eval%evaluate ()
	end associate
	end do
	out_int => chain%get_out_int_ptr ()
	sf_sum = real (out_int%sum ())
	call chain%config%trace &
	(chain%selected_channel, chain%p, chain%x, chain%f, sf_sum)
	end if
	end if
	chain%status = SF_EVALUATED
	end if
	end subroutine sf_chain_instance_evaluate

	@ %def sf_chain_instance_evaluate
	@
	\subsection{Access to the chain instance}
	Transfer the outgoing momenta to the array [[p]]. We assume that
	array sizes match.
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_out_momenta => sf_chain_instance_get_out_momenta
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_get_out_momenta (chain, p)
	class(sf_chain_instance_t), intent(in), target :: chain
	type(vector4_t), dimension(:), intent(out) :: p
	end subroutine sf_chain_instance_get_out_momenta
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_get_out_momenta (chain, p)
	class(sf_chain_instance_t), intent(in), target :: chain
	type(vector4_t), dimension(:), intent(out) :: p
	type(interaction_t), pointer :: int
	integer :: i, j
	if (chain%status >= SF_DONE_KINEMATICS) then
	do j = 1, size (chain%out_sf)
	i = chain%out_sf(j)
	select case (i)
	case (0)
	int => beam_get_int_ptr (chain%beam_t)
	case default
	int => chain%sf(i)%int%interaction_t
	end select
	p(j) = int%get_momentum (chain%out_sf_i(j))
	end do
	end if
	end subroutine sf_chain_instance_get_out_momenta

	@ %def sf_chain_instance_get_out_momenta
	@ Return a pointer to the last evaluator in the chain (to the interaction).
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_out_int_ptr => sf_chain_instance_get_out_int_ptr
	<<SF base: sub interfaces>>=
	module function sf_chain_instance_get_out_int_ptr (chain) result (int)
	class(sf_chain_instance_t), intent(in), target :: chain
	type(interaction_t), pointer :: int
	end function sf_chain_instance_get_out_int_ptr
	<<SF base: procedures>>=
	module function sf_chain_instance_get_out_int_ptr (chain) result (int)
	class(sf_chain_instance_t), intent(in), target :: chain
	type(interaction_t), pointer :: int
	if (chain%out_eval == 0) then
	int => beam_get_int_ptr (chain%beam_t)
	else
	int => chain%sf(chain%out_eval)%eval%interaction_t
	end if
	end function sf_chain_instance_get_out_int_ptr

	@ %def sf_chain_instance_get_out_int_ptr
	@ Return the index of the [[j]]-th outgoing particle, within the last
	evaluator.
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_out_i => sf_chain_instance_get_out_i
	<<SF base: sub interfaces>>=
	module function sf_chain_instance_get_out_i (chain, j) result (i)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: j
	integer :: i
	end function sf_chain_instance_get_out_i
	<<SF base: procedures>>=
	module function sf_chain_instance_get_out_i (chain, j) result (i)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: j
	integer :: i
	i = chain%out_eval_i(j)
	end function sf_chain_instance_get_out_i

	@ %def sf_chain_instance_get_out_i
	@ Return the mask for the outgoing particle(s), within the last evaluator.
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_out_mask => sf_chain_instance_get_out_mask
	<<SF base: sub interfaces>>=
	module function sf_chain_instance_get_out_mask (chain) result (mask)
	class(sf_chain_instance_t), intent(in), target :: chain
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
	end function sf_chain_instance_get_out_mask
	<<SF base: procedures>>=
	module function sf_chain_instance_get_out_mask (chain) result (mask)
	class(sf_chain_instance_t), intent(in), target :: chain
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
	type(interaction_t), pointer :: int
	allocate (mask (chain%config%n_in))
	int => chain%get_out_int_ptr ()
	mask = int%get_mask (chain%out_eval_i)
	end function sf_chain_instance_get_out_mask

	@ %def sf_chain_instance_get_out_mask
	@ Return the array of MC input parameters that corresponds to channel [[c]].
	This is the [[p]] array, the parameters before all mappings.

	The [[p]] array may be deallocated. This should correspond to a
	zero-size [[r]] argument, so nothing to do then.
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_mcpar => sf_chain_instance_get_mcpar
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_get_mcpar (chain, c, r)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: c
	real(default), dimension(:), intent(out) :: r
	end subroutine sf_chain_instance_get_mcpar
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_get_mcpar (chain, c, r)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: c
	real(default), dimension(:), intent(out) :: r
	if (allocated (chain%p)) r = pack (chain%p(:,c), chain%bound)
	end subroutine sf_chain_instance_get_mcpar

	@ %def sf_chain_instance_get_mcpar
	@ Return the Jacobian factor that corresponds to channel [[c]].
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_f => sf_chain_instance_get_f
	<<SF base: sub interfaces>>=
	module function sf_chain_instance_get_f (chain, c) result (f)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: c
	real(default) :: f
	end function sf_chain_instance_get_f
	<<SF base: procedures>>=
	module function sf_chain_instance_get_f (chain, c) result (f)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: c
	real(default) :: f
	if (allocated (chain%f)) then
	f = chain%f(c)
	else
	f = 1
	end if
	end function sf_chain_instance_get_f

	@ %def sf_chain_instance_get_f
	@ Return the evaluation status.
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_status => sf_chain_instance_get_status
	<<SF base: sub interfaces>>=
	module function sf_chain_instance_get_status (chain) result (status)
	class(sf_chain_instance_t), intent(in) :: chain
	integer :: status
	end function sf_chain_instance_get_status
	<<SF base: procedures>>=
	module function sf_chain_instance_get_status (chain) result (status)
	class(sf_chain_instance_t), intent(in) :: chain
	integer :: status
	status = chain%status
	end function sf_chain_instance_get_status

	@ %def sf_chain_instance_get_status
	@
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_matrix_elements => sf_chain_instance_get_matrix_elements
	<<SF base: sub interfaces>>=
	module subroutine sf_chain_instance_get_matrix_elements (chain, i, ff)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: i
	real(default), intent(out), dimension(:), allocatable :: ff
	end subroutine sf_chain_instance_get_matrix_elements
	<<SF base: procedures>>=
	module subroutine sf_chain_instance_get_matrix_elements (chain, i, ff)
	class(sf_chain_instance_t), intent(in) :: chain
	integer, intent(in) :: i
	real(default), intent(out), dimension(:), allocatable :: ff

	associate (sf => chain%sf(i))
	ff = real (sf%int%get_matrix_element ())
	end associate
	end subroutine sf_chain_instance_get_matrix_elements

	@ %def sf_chain_instance_get_matrix_elements
	@
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_beam_int_ptr => sf_chain_instance_get_beam_int_ptr
	<<SF base: sub interfaces>>=
	module function sf_chain_instance_get_beam_int_ptr (chain) result (int)
	type(interaction_t), pointer :: int
	class(sf_chain_instance_t), intent(in), target :: chain
	end function sf_chain_instance_get_beam_int_ptr
	<<SF base: procedures>>=
	module function sf_chain_instance_get_beam_int_ptr (chain) result (int)
	type(interaction_t), pointer :: int
	class(sf_chain_instance_t), intent(in), target :: chain
	int => beam_get_int_ptr (chain%beam_t)
	end function sf_chain_instance_get_beam_int_ptr

	@ %def sf_chain_instance_get_beam_ptr
	@
	<<SF base: sf chain instance: TBP>>=
	procedure :: get_n_sub => sf_chain_instance_get_n_sub
	<<SF base: sub interfaces>>=
	module function sf_chain_instance_get_n_sub (chain) result (n_sub)
	type(interaction_t), pointer :: int
	class(sf_chain_instance_t), intent(in), target :: chain
	integer :: n_sub
	end function sf_chain_instance_get_n_sub
	<<SF base: procedures>>=
	module function sf_chain_instance_get_n_sub (chain) result (n_sub)
	type(interaction_t), pointer :: int
	class(sf_chain_instance_t), intent(in), target :: chain
	integer :: n_sub
	int => beam_get_int_ptr (chain%beam_t)
	n_sub = int%get_n_sub ()
	end function sf_chain_instance_get_n_sub

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

	module sf_base_ut
	use unit_tests
	use sf_base_uti

	<<Standard module head>>

	<<SF base: public test auxiliary>>

	<<SF base: public test>>

	contains

	<<SF base: test driver>>

	end module sf_base_ut
	@ %def sf_base_ut
	@
	<<[[sf_base_uti.f90]]>>=
	<<File header>>

	module sf_base_uti

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_19
	use format_utils, only: write_separator
	use diagnostics
	use lorentz
	use pdg_arrays
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use state_matrices, only: FM_IGNORE_HELICITY
	use interactions
	use particles
	use model_data
	use beams
	use sf_aux
	use sf_mappings

	use sf_base

	<<Standard module head>>

	<<SF base: test declarations>>

	<<SF base: public test auxiliary>>

	<<SF base: test types>>

	contains

	<<SF base: tests>>

	<<SF base: test auxiliary>>

	end module sf_base_uti
	@ %def sf_base_ut
	@ API: driver for the unit tests below.
	<<SF base: public test>>=
	public :: sf_base_test
	<<SF base: test driver>>=
	subroutine sf_base_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF base: execute tests>>
	end subroutine sf_base_test

	@ %def sf_base_test
	@
	\subsection{Test implementation: structure function}
	This is a template for the actual structure-function implementation
	which will be defined in separate modules.

	\subsubsection{Configuration data}
	The test structure function uses the [[Test]] model. It describes a
	scalar within an arbitrary initial particle, which is given in the
	initialization. The radiated particle is also a scalar, the same one,
	but we set its mass artificially to zero.
	<<SF base: public test auxiliary>>=
	public :: sf_test_data_t
	<<SF base: test types>>=
	type, extends (sf_data_t) :: sf_test_data_t
	class(model_data_t), pointer :: model => null ()
	integer :: mode = 0
	type(flavor_t) :: flv_in
	type(flavor_t) :: flv_out
	type(flavor_t) :: flv_rad
	real(default) :: m = 0
	logical :: collinear = .true.
	real(default), dimension(:), allocatable :: qbounds
	contains
	<<SF base: sf test data: TBP>>
	end type sf_test_data_t

	@ %def sf_test_data_t
	@ Output.
	<<SF base: sf test data: TBP>>=
	procedure :: write => sf_test_data_write
	<<SF base: test auxiliary>>=
	subroutine sf_test_data_write (data, unit, verbose)
	class(sf_test_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "SF test data:"
	write (u, "(3x,A,A)") "model = ", char (data%model%get_name ())
	write (u, "(3x,A)", advance="no") "incoming = "
	call data%flv_in%write (u); write (u, *)
	write (u, "(3x,A)", advance="no") "outgoing = "
	call data%flv_out%write (u); write (u, *)
	write (u, "(3x,A)", advance="no") "radiated = "
	call data%flv_rad%write (u); write (u, *)
	write (u, "(3x,A," // FMT_19 // ")") "mass = ", data%m
	write (u, "(3x,A,L1)") "collinear = ", data%collinear
	if (.not. data%collinear .and. allocated (data%qbounds)) then
	write (u, "(3x,A," // FMT_19 // ")") "qmin = ", data%qbounds(1)
	write (u, "(3x,A," // FMT_19 // ")") "qmax = ", data%qbounds(2)
	end if
	end subroutine sf_test_data_write

	@ %def sf_test_data_write
	@ Initialization.
	<<SF base: sf test data: TBP>>=
	procedure :: init => sf_test_data_init
	<<SF base: test auxiliary>>=
	subroutine sf_test_data_init (data, model, pdg_in, collinear, qbounds, mode)
	class(sf_test_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	logical, intent(in), optional :: collinear
	real(default), dimension(2), intent(in), optional :: qbounds
	integer, intent(in), optional :: mode
	data%model => model
	if (present (mode)) data%mode = mode
	if (pdg_in%get (1) /= 25) then
	call msg_fatal ("Test spectrum function: input flavor must be 's'")
	end if
	call data%flv_in%init (25, model)
	data%m = data%flv_in%get_mass ()
	if (present (collinear)) data%collinear = collinear
	call data%flv_out%init (25, model)
	call data%flv_rad%init (25, model)
	if (present (qbounds)) then
	allocate (data%qbounds (2))
	data%qbounds = qbounds
	end if
	end subroutine sf_test_data_init

	@ %def sf_test_data_init
	@ Return the number of parameters: 1 if only consider collinear
	splitting, 3 otherwise.
	<<SF base: sf test data: TBP>>=
	procedure :: get_n_par => sf_test_data_get_n_par
	<<SF base: test auxiliary>>=
	function sf_test_data_get_n_par (data) result (n)
	class(sf_test_data_t), intent(in) :: data
	integer :: n
	if (data%collinear) then
	n = 1
	else
	n = 3
	end if
	end function sf_test_data_get_n_par

	@ %def sf_test_data_get_n_par
	@ Return the outgoing particle PDG code: 25
	<<SF base: sf test data: TBP>>=
	procedure :: get_pdg_out => sf_test_data_get_pdg_out
	<<SF base: test auxiliary>>=
	subroutine sf_test_data_get_pdg_out (data, pdg_out)
	class(sf_test_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	pdg_out(1) = 25
	end subroutine sf_test_data_get_pdg_out

	@ %def sf_test_data_get_pdg_out
	@ Allocate the matching interaction.
	<<SF base: sf test data: TBP>>=
	procedure :: allocate_sf_int => sf_test_data_allocate_sf_int
	<<SF base: test auxiliary>>=
	subroutine sf_test_data_allocate_sf_int (data, sf_int)
	class(sf_test_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	if (allocated (sf_int)) deallocate (sf_int)
	allocate (sf_test_t :: sf_int)
	end subroutine sf_test_data_allocate_sf_int

	@ %def sf_test_data_allocate_sf_int
	@
	\subsubsection{Interaction}
	<<SF base: test types>>=
	type, extends (sf_int_t) :: sf_test_t
	type(sf_test_data_t), pointer :: data => null ()
	real(default) :: x = 0
	contains
	<<SF base: sf test int: TBP>>
	end type sf_test_t

	@ %def sf_test_t
	@ Type string: constant
	<<SF base: sf test int: TBP>>=
	procedure :: type_string => sf_test_type_string
	<<SF base: test auxiliary>>=
	function sf_test_type_string (object) result (string)
	class(sf_test_t), intent(in) :: object
	type(string_t) :: string
	string = "Test"
	end function sf_test_type_string

	@ %def sf_test_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF base: sf test int: TBP>>=
	procedure :: write => sf_test_write
	<<SF base: test auxiliary>>=
	subroutine sf_test_write (object, unit, testflag)
	class(sf_test_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "SF test data: [undefined]"
	end if
	end subroutine sf_test_write

	@ %def sf_test_write
	@ Initialize. We know that [[data]] will be of concrete type
	[[sf_test_data_t]], but we have to cast this explicitly.

	For this implementation, we set the incoming and outgoing masses equal
	to the physical particle mass, but keep the radiated mass zero.

	Optionally, we can provide minimum and maximum values for the momentum
	transfer.
	<<SF base: sf test int: TBP>>=
	procedure :: init => sf_test_init
	<<SF base: test auxiliary>>=
	subroutine sf_test_init (sf_int, data)
	class(sf_test_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(3) :: mask
	type(helicity_t) :: hel0
	type(color_t) :: col0
	type(quantum_numbers_t), dimension(3) :: qn
	mask = quantum_numbers_mask (.false., .false., .false.)
	select type (data)
	type is (sf_test_data_t)
	if (allocated (data%qbounds)) then
	call sf_int%base_init (mask, &
	[data%m2], [0._default], [data%m2], &
	[data%qbounds(1)], [data%qbounds(2)])
	else
	call sf_int%base_init (mask, &
	[data%m2], [0._default], [data%m2])
	end if
	sf_int%data => data
	call hel0%init (0)
	call col0%init ()
	call qn(1)%init (data%flv_in, col0, hel0)
	call qn(2)%init (data%flv_rad, col0, hel0)
	call qn(3)%init (data%flv_out, col0, hel0)
	call sf_int%add_state (qn)
	call sf_int%freeze ()
	call sf_int%set_incoming ([1])
	call sf_int%set_radiated ([2])
	call sf_int%set_outgoing ([3])
	end select
	sf_int%status = SF_INITIAL
	end subroutine sf_test_init

	@ %def sf_test_init
	@ Set kinematics. If [[map]] is unset, the $r$ and $x$ values
	coincide, and the Jacobian $f(r)$ is trivial.

	If [[map]] is set, we are asked to provide an efficient mapping.
	For the test case, we set $x=r^2$ and consequently $f(r)=2r$.
	<<SF base: sf test int: TBP>>=
	procedure :: complete_kinematics => sf_test_complete_kinematics
	<<SF base: test auxiliary>>=
	subroutine sf_test_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(sf_test_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	if (map) then
	x(1) = r(1)**2
	f = 2 * r(1)
	else
	x(1) = r(1)
	f = 1
	end if
	xb(1) = 1 - x(1)
	if (size (x) == 3) then
	x(2:3) = r(2:3)
	xb(2:3) = rb(2:3)
	end if
	call sf_int%split_momentum (x, xb)
	sf_int%x = x(1)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end subroutine sf_test_complete_kinematics

	@ %def sf_test_complete_kinematics
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF base: sf test int: TBP>>=
	procedure :: inverse_kinematics => sf_test_inverse_kinematics
	<<SF base: test auxiliary>>=
	subroutine sf_test_inverse_kinematics (sf_int, x, xb, f, r, rb, map, set_momenta)
	class(sf_test_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	r(1) = sqrt (x(1))
	f = 2 * r(1)
	else
	r(1) = x(1)
	f = 1
	end if
	if (size (x) == 3) r(2:3) = x(2:3)
	rb = 1 - r
	sf_int%x = x(1)
	if (set_mom) then
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	end subroutine sf_test_inverse_kinematics

	@ %def sf_test_inverse_kinematics
	@ Apply the structure function. The matrix element becomes unity and
	the application always succeeds.

	If the [[mode]] indicator is one, the matrix element is equal to the
	parameter~$x$.
	<<SF base: sf test int: TBP>>=
	procedure :: apply => sf_test_apply
	<<SF base: test auxiliary>>=
	subroutine sf_test_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(sf_test_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	select case (sf_int%data%mode)
	case (0)
	call sf_int%set_matrix_element &
	(cmplx (1._default, kind=default))
	case (1)
	call sf_int%set_matrix_element &
	(cmplx (sf_int%x, kind=default))
	end select
	sf_int%status = SF_EVALUATED
	end subroutine sf_test_apply

	@ %def sf_test_apply
	@
	\subsection{Test implementation: pair spectrum}
	Another template, this time for a incoming particle pair, splitting
	into two radiated and two outgoing particles.

	\subsubsection{Configuration data}
	For simplicity, the spectrum contains two mirror images of the
	previous structure-function configuration: the incoming and all
	outgoing particles are test scalars.

	We have two versions, one with radiated particles, one without.
	<<SF base: test types>>=
	type, extends (sf_data_t) :: sf_test_spectrum_data_t
	class(model_data_t), pointer :: model => null ()
	type(flavor_t) :: flv_in
	type(flavor_t) :: flv_out
	type(flavor_t) :: flv_rad
	logical :: with_radiation = .true.
	real(default) :: m = 0
	contains
	<<SF base: sf test spectrum data: TBP>>
	end type sf_test_spectrum_data_t

	@ %def sf_test_spectrum_data_t
	@ Output.
	<<SF base: sf test spectrum data: TBP>>=
	procedure :: write => sf_test_spectrum_data_write
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_data_write (data, unit, verbose)
	class(sf_test_spectrum_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "SF test spectrum data:"
	write (u, "(3x,A,A)") "model = ", char (data%model%get_name ())
	write (u, "(3x,A)", advance="no") "incoming = "
	call data%flv_in%write (u); write (u, *)
	write (u, "(3x,A)", advance="no") "outgoing = "
	call data%flv_out%write (u); write (u, *)
	write (u, "(3x,A)", advance="no") "radiated = "
	call data%flv_rad%write (u); write (u, *)
	write (u, "(3x,A," // FMT_19 // ")") "mass = ", data%m
	end subroutine sf_test_spectrum_data_write

	@ %def sf_test_spectrum_data_write
	@ Initialization.
	<<SF base: sf test spectrum data: TBP>>=
	procedure :: init => sf_test_spectrum_data_init
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_data_init (data, model, pdg_in, with_radiation)
	class(sf_test_spectrum_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	logical, intent(in) :: with_radiation
	data%model => model
	data%with_radiation = with_radiation
	if (pdg_in%get (1) /= 25) then
	call msg_fatal ("Test structure function: input flavor must be 's'")
	end if
	call data%flv_in%init (25, model)
	data%m = data%flv_in%get_mass ()
	call data%flv_out%init (25, model)
	if (with_radiation) then
	call data%flv_rad%init (25, model)
	end if
	end subroutine sf_test_spectrum_data_init

	@ %def sf_test_spectrum_data_init
	@ Return the number of parameters: 2, since we have only collinear
	splitting here.
	<<SF base: sf test spectrum data: TBP>>=
	procedure :: get_n_par => sf_test_spectrum_data_get_n_par
	<<SF base: test auxiliary>>=
	function sf_test_spectrum_data_get_n_par (data) result (n)
	class(sf_test_spectrum_data_t), intent(in) :: data
	integer :: n
	n = 2
	end function sf_test_spectrum_data_get_n_par

	@ %def sf_test_spectrum_data_get_n_par
	@ Return the outgoing particle PDG codes: 25
	<<SF base: sf test spectrum data: TBP>>=
	procedure :: get_pdg_out => sf_test_spectrum_data_get_pdg_out
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_data_get_pdg_out (data, pdg_out)
	class(sf_test_spectrum_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	pdg_out(1) = 25
	pdg_out(2) = 25
	end subroutine sf_test_spectrum_data_get_pdg_out

	@ %def sf_test_spectrum_data_get_pdg_out
	@ Allocate the matching interaction.
	<<SF base: sf test spectrum data: TBP>>=
	procedure :: allocate_sf_int => &
	sf_test_spectrum_data_allocate_sf_int
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_data_allocate_sf_int (data, sf_int)
	class(sf_test_spectrum_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (sf_test_spectrum_t :: sf_int)
	end subroutine sf_test_spectrum_data_allocate_sf_int

	@ %def sf_test_spectrum_data_allocate_sf_int
	@
	\subsubsection{Interaction}
	<<SF base: test types>>=
	type, extends (sf_int_t) :: sf_test_spectrum_t
	type(sf_test_spectrum_data_t), pointer :: data => null ()
	contains
	<<SF base: sf test spectrum: TBP>>
	end type sf_test_spectrum_t

	@ %def sf_test_spectrum_t
	<<SF base: sf test spectrum: TBP>>=
	procedure :: type_string => sf_test_spectrum_type_string
	<<SF base: test auxiliary>>=
	function sf_test_spectrum_type_string (object) result (string)
	class(sf_test_spectrum_t), intent(in) :: object
	type(string_t) :: string
	string = "Test Spectrum"
	end function sf_test_spectrum_type_string

	@ %def sf_test_spectrum_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF base: sf test spectrum: TBP>>=
	procedure :: write => sf_test_spectrum_write
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_write (object, unit, testflag)
	class(sf_test_spectrum_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "SF test spectrum data: [undefined]"
	end if
	end subroutine sf_test_spectrum_write

	@ %def sf_test_spectrum_write
	@ Initialize. We know that [[data]] will be of concrete type
	[[sf_test_spectrum_data_t]], but we have to cast this explicitly.

	For this implementation, we set the incoming and outgoing masses equal
	to the physical particle mass, but keep the radiated mass zero.

	Optionally, we can provide minimum and maximum values for the momentum
	transfer.
	<<SF base: sf test spectrum: TBP>>=
	procedure :: init => sf_test_spectrum_init
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_init (sf_int, data)
	class(sf_test_spectrum_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(6) :: mask
	type(helicity_t) :: hel0
	type(color_t) :: col0
	type(quantum_numbers_t), dimension(6) :: qn
	mask = quantum_numbers_mask (.false., .false., .false.)
	select type (data)
	type is (sf_test_spectrum_data_t)
	if (data%with_radiation) then
	call sf_int%base_init (mask(1:6), &
	[data%m2, data%m2], &
	[0._default, 0._default], &
	[data%m2, data%m2])
	sf_int%data => data
	call hel0%init (0)
	call col0%init ()
	call qn(1)%init (data%flv_in, col0, hel0)
	call qn(2)%init (data%flv_in, col0, hel0)
	call qn(3)%init (data%flv_rad, col0, hel0)
	call qn(4)%init (data%flv_rad, col0, hel0)
	call qn(5)%init (data%flv_out, col0, hel0)
	call qn(6)%init (data%flv_out, col0, hel0)
	call sf_int%add_state (qn(1:6))
	call sf_int%set_incoming ([1,2])
	call sf_int%set_radiated ([3,4])
	call sf_int%set_outgoing ([5,6])
	else
	call sf_int%base_init (mask(1:4), &
	[data%m2, data%m2], &
	[real(default) :: ], &
	[data%m2, data%m2])
	sf_int%data => data
	call hel0%init (0)
	call col0%init ()
	call qn(1)%init (data%flv_in, col0, hel0)
	call qn(2)%init (data%flv_in, col0, hel0)
	call qn(3)%init (data%flv_out, col0, hel0)
	call qn(4)%init (data%flv_out, col0, hel0)
	call sf_int%add_state (qn(1:4))
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	end if
	call sf_int%freeze ()
	end select
	sf_int%status = SF_INITIAL
	end subroutine sf_test_spectrum_init

	@ %def sf_test_spectrum_init
	@ Set kinematics. If [[map]] is unset, the $r$ and $x$ values
	coincide, and the Jacobian $f(r)$ is trivial.

	If [[map]] is set, we are asked to provide an efficient mapping.
	For the test case, we set $x=r^2$ (as above) for both $x$ parameters
	and consequently $f(r)=4r_1r_2$.

	<<SF base: sf test spectrum: TBP>>=
	procedure :: complete_kinematics => sf_test_spectrum_complete_kinematics
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(sf_test_spectrum_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	real(default), dimension(2) :: xb1
	if (map) then
	x = r**2
	f = 4 * r(1) * r(2)
	else
	x = r
	f = 1
	end if
	xb = 1 - x
	if (sf_int%data%with_radiation) then
	call sf_int%split_momenta (x, xb)
	else
	call sf_int%reduce_momenta (x)
	end if
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end subroutine sf_test_spectrum_complete_kinematics

	@ %def sf_test_spectrum_complete_kinematics
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF base: sf test spectrum: TBP>>=
	procedure :: inverse_kinematics => sf_test_spectrum_inverse_kinematics
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(sf_test_spectrum_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	real(default), dimension(2) :: xb1
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	r = sqrt (x)
	f = 4 * r(1) * r(2)
	else
	r = x
	f = 1
	end if
	rb = 1 - r
	if (set_mom) then
	if (sf_int%data%with_radiation) then
	call sf_int%split_momenta (x, xb)
	else
	call sf_int%reduce_momenta (x)
	end if
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	end subroutine sf_test_spectrum_inverse_kinematics

	@ %def sf_test_spectrum_inverse_kinematics
	@ Apply the structure function. The matrix element becomes unity and
	the application always succeeds.
	<<SF base: sf test spectrum: TBP>>=
	procedure :: apply => sf_test_spectrum_apply
	<<SF base: test auxiliary>>=
	subroutine sf_test_spectrum_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(sf_test_spectrum_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	call sf_int%set_matrix_element &
	(cmplx (1._default, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine sf_test_spectrum_apply

	@ %def sf_test_spectrum_apply
	@
	\subsection{Test implementation: generator spectrum}
	A generator for two beams, no radiation (for simplicity).

	\subsubsection{Configuration data}
	For simplicity, the spectrum contains two mirror images of the
	previous structure-function configuration: the incoming and all
	outgoing particles are test scalars.

	We have two versions, one with radiated particles, one without.
	<<SF base: test types>>=
	type, extends (sf_data_t) :: sf_test_generator_data_t
	class(model_data_t), pointer :: model => null ()
	type(flavor_t) :: flv_in
	type(flavor_t) :: flv_out
	type(flavor_t) :: flv_rad
	real(default) :: m = 0
	contains
	<<SF base: sf test generator data: TBP>>
	end type sf_test_generator_data_t

	@ %def sf_test_generator_data_t
	@ Output.
	<<SF base: sf test generator data: TBP>>=
	procedure :: write => sf_test_generator_data_write
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_data_write (data, unit, verbose)
	class(sf_test_generator_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "SF test generator data:"
	write (u, "(3x,A,A)") "model = ", char (data%model%get_name ())
	write (u, "(3x,A)", advance="no") "incoming = "
	call data%flv_in%write (u); write (u, *)
	write (u, "(3x,A)", advance="no") "outgoing = "
	call data%flv_out%write (u); write (u, *)
	write (u, "(3x,A," // FMT_19 // ")") "mass = ", data%m
	end subroutine sf_test_generator_data_write

	@ %def sf_test_generator_data_write
	@ Initialization.
	<<SF base: sf test generator data: TBP>>=
	procedure :: init => sf_test_generator_data_init
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_data_init (data, model, pdg_in)
	class(sf_test_generator_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	data%model => model
	if (pdg_in%get (1) /= 25) then
	call msg_fatal ("Test generator: input flavor must be 's'")
	end if
	call data%flv_in%init (25, model)
	data%m = data%flv_in%get_mass ()
	call data%flv_out%init (25, model)
	end subroutine sf_test_generator_data_init

	@ %def sf_test_generator_data_init
	@ This structure function is a generator.
	<<SF base: sf test generator data: TBP>>=
	procedure :: is_generator => sf_test_generator_data_is_generator
	<<SF base: test auxiliary>>=
	function sf_test_generator_data_is_generator (data) result (flag)
	class(sf_test_generator_data_t), intent(in) :: data
	logical :: flag
	flag = .true.
	end function sf_test_generator_data_is_generator

	@ %def sf_test_generator_data_is_generator
	@ Return the number of parameters: 2, since we have only collinear
	splitting here.
	<<SF base: sf test generator data: TBP>>=
	procedure :: get_n_par => sf_test_generator_data_get_n_par
	<<SF base: test auxiliary>>=
	function sf_test_generator_data_get_n_par (data) result (n)
	class(sf_test_generator_data_t), intent(in) :: data
	integer :: n
	n = 2
	end function sf_test_generator_data_get_n_par

	@ %def sf_test_generator_data_get_n_par
	@ Return the outgoing particle PDG codes: 25
	<<SF base: sf test generator data: TBP>>=
	procedure :: get_pdg_out => sf_test_generator_data_get_pdg_out
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_data_get_pdg_out (data, pdg_out)
	class(sf_test_generator_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	pdg_out(1) = 25
	pdg_out(2) = 25
	end subroutine sf_test_generator_data_get_pdg_out

	@ %def sf_test_generator_data_get_pdg_out
	@ Allocate the matching interaction.
	<<SF base: sf test generator data: TBP>>=
	procedure :: allocate_sf_int => &
	sf_test_generator_data_allocate_sf_int
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_data_allocate_sf_int (data, sf_int)
	class(sf_test_generator_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (sf_test_generator_t :: sf_int)
	end subroutine sf_test_generator_data_allocate_sf_int

	@ %def sf_test_generator_data_allocate_sf_int
	@
	\subsubsection{Interaction}
	<<SF base: test types>>=
	type, extends (sf_int_t) :: sf_test_generator_t
	type(sf_test_generator_data_t), pointer :: data => null ()
	contains
	<<SF base: sf test generator: TBP>>
	end type sf_test_generator_t

	@ %def sf_test_generator_t
	<<SF base: sf test generator: TBP>>=
	procedure :: type_string => sf_test_generator_type_string
	<<SF base: test auxiliary>>=
	function sf_test_generator_type_string (object) result (string)
	class(sf_test_generator_t), intent(in) :: object
	type(string_t) :: string
	string = "Test Generator"
	end function sf_test_generator_type_string

	@ %def sf_test_generator_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF base: sf test generator: TBP>>=
	procedure :: write => sf_test_generator_write
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_write (object, unit, testflag)
	class(sf_test_generator_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "SF test generator data: [undefined]"
	end if
	end subroutine sf_test_generator_write

	@ %def sf_test_generator_write
	@ Initialize. We know that [[data]] will be of concrete type
	[[sf_test_generator_data_t]], but we have to cast this explicitly.

	For this implementation, we set the incoming and outgoing masses equal
	to the physical particle mass. No radiation.
	<<SF base: sf test generator: TBP>>=
	procedure :: init => sf_test_generator_init
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_init (sf_int, data)
	class(sf_test_generator_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(4) :: mask
	type(helicity_t) :: hel0
	type(color_t) :: col0
	type(quantum_numbers_t), dimension(4) :: qn
	mask = quantum_numbers_mask (.false., .false., .false.)
	select type (data)
	type is (sf_test_generator_data_t)
	call sf_int%base_init (mask(1:4), &
	[data%m2, data%m2], &
	[real(default) :: ], &
	[data%m2, data%m2])
	sf_int%data => data
	call hel0%init (0)
	call col0%init ()
	call qn(1)%init (data%flv_in, col0, hel0)
	call qn(2)%init (data%flv_in, col0, hel0)
	call qn(3)%init (data%flv_out, col0, hel0)
	call qn(4)%init (data%flv_out, col0, hel0)
	call sf_int%add_state (qn(1:4))
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	call sf_int%freeze ()
	end select
	sf_int%status = SF_INITIAL
	end subroutine sf_test_generator_init

	@ %def sf_test_generator_init
	@ This structure function is a generator.
	<<SF base: sf test generator: TBP>>=
	procedure :: is_generator => sf_test_generator_is_generator
	<<SF base: test auxiliary>>=
	function sf_test_generator_is_generator (sf_int) result (flag)
	class(sf_test_generator_t), intent(in) :: sf_int
	logical :: flag
	flag = sf_int%data%is_generator ()
	end function sf_test_generator_is_generator

	@ %def sf_test_generator_is_generator
	@ Generate free parameters. This mock generator always produces the
	nubmers 0.8 and 0.5.
	<<SF base: sf test generator: TBP>>=
	procedure :: generate_free => sf_test_generator_generate_free
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_generate_free (sf_int, r, rb, x_free)
	class(sf_test_generator_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	r = [0.8, 0.5]
	rb= 1 - r
	x_free = x_free * product (r)
	end subroutine sf_test_generator_generate_free

	@ %def sf_test_generator_generate_free
	@ Recover momentum fractions. Since the x values are free, we also set the [[x_free]] parameter.
	<<SF base: sf test generator: TBP>>=
	procedure :: recover_x => sf_test_generator_recover_x
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_recover_x (sf_int, x, xb, x_free)
	class(sf_test_generator_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	call sf_int%base_recover_x (x, xb)
	if (present (x_free)) x_free = x_free * product (x)
	end subroutine sf_test_generator_recover_x

	@ %def sf_test_generator_recover_x
	@ Set kinematics. Since this is a generator, just transfer input to output.
	<<SF base: sf test generator: TBP>>=
	procedure :: complete_kinematics => sf_test_generator_complete_kinematics
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(sf_test_generator_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	x = r
	xb= rb
	f = 1
	call sf_int%reduce_momenta (x)
	end subroutine sf_test_generator_complete_kinematics

	@ %def sf_test_generator_complete_kinematics
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF base: sf test generator: TBP>>=
	procedure :: inverse_kinematics => sf_test_generator_inverse_kinematics
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(sf_test_generator_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	r = x
	rb= xb
	f = 1
	if (set_mom) call sf_int%reduce_momenta (x)
	end subroutine sf_test_generator_inverse_kinematics

	@ %def sf_test_generator_inverse_kinematics
	@ Apply the structure function. The matrix element becomes unity and
	the application always succeeds.
	<<SF base: sf test generator: TBP>>=
	procedure :: apply => sf_test_generator_apply
	<<SF base: test auxiliary>>=
	subroutine sf_test_generator_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(sf_test_generator_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	call sf_int%set_matrix_element &
	(cmplx (1._default, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine sf_test_generator_apply

	@ %def sf_test_generator_apply
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF base: execute tests>>=
	call test (sf_base_1, "sf_base_1", &
	"structure function configuration", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_1
	<<SF base: tests>>=
	subroutine sf_base_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_base_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test structure function data"
	write (u, "(A)")

	call model%init_test ()
	pdg_in = 25

	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle code:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	call model%final ()

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

	end subroutine sf_base_1

	@ %def sf_base_1
	@
	\subsubsection{Test and probe structure function}
	Construct and display a structure function object based on the test
	structure function.
	<<SF base: execute tests>>=
	call test (sf_base_2, "sf_base_2", &
	"structure function instance", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_2
	<<SF base: tests>>=
	subroutine sf_base_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_base_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	pdg_in = 25
	call flv%init (25, model)

	call reset_interaction_counter ()

	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=1"
	write (u, "(A)")

	r = 1
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics with mapping for r=0.8"
	write (u, "(A)")

	r = 0.8_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb

	write (u, "(A)")
	write (u, "(A)") "* Compute inverse kinematics for x=0.64 and evaluate"
	write (u, "(A)")

	x = 0.64_default
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
	call sf_int%apply (scale=0._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "f =", f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_2

	@ %def sf_base_2
	@
	\subsubsection{Collinear kinematics}
	Scan over the possibilities for mass assignment and on-shell
	projections, collinear case.
	<<SF base: execute tests>>=
	call test (sf_base_3, "sf_base_3", &
	"alternatives for collinear kinematics", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_3
	<<SF base: tests>>=
	subroutine sf_base_3 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(flavor_t) :: flv
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_base_3"
	write (u, "(A)") "* Purpose: check various kinematical setups"
	write (u, "(A)") "* for collinear structure-function splitting."
	write (u, "(A)") " (two masses equal, one zero)"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	pdg_in = 25
	call flv%init (25, model)

	call reset_interaction_counter ()

	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	call sf_int%write (u)

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"

	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set radiated mass to zero"

	sf_int%mr2 = 0
	sf_int%mo2 = sf_int%mi2

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping energy"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping momentum"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set outgoing mass to zero"

	sf_int%mr2 = sf_int%mi2
	sf_int%mo2 = 0

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping energy"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping momentum"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set incoming mass to zero"

	k = vector4_moving (E, E, 3)
	call sf_int%seed_kinematics ([k])

	sf_int%mr2 = sf_int%mi2
	sf_int%mo2 = sf_int%mi2
	sf_int%mi2 = 0

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping energy"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping momentum"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set all masses to zero"

	sf_int%mr2 = 0
	sf_int%mo2 = 0
	sf_int%mi2 = 0

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping energy"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5, keeping momentum"
	write (u, "(A)")

	r = 0.5_default
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_3

	@ %def sf_base_3
	@
	\subsubsection{Non-collinear kinematics}
	Scan over the possibilities for mass assignment and on-shell
	projections, non-collinear case.
	<<SF base: execute tests>>=
	call test (sf_base_4, "sf_base_4", &
	"alternatives for non-collinear kinematics", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_4
	<<SF base: tests>>=
	subroutine sf_base_4 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(flavor_t) :: flv
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_base_4"
	write (u, "(A)") "* Purpose: check various kinematical setups"
	write (u, "(A)") "* for free structure-function splitting."
	write (u, "(A)") " (two masses equal, one zero)"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	pdg_in = 25
	call flv%init (25, model)

	call reset_interaction_counter ()

	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in, collinear=.false.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	call sf_int%write (u)

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"

	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set radiated mass to zero"

	sf_int%mr2 = 0
	sf_int%mo2 = sf_int%mi2

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set outgoing mass to zero"

	sf_int%mr2 = sf_int%mi2
	sf_int%mo2 = 0

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set incoming mass to zero"

	k = vector4_moving (E, E, 3)
	call sf_int%seed_kinematics ([k])

	sf_int%mr2 = sf_int%mi2
	sf_int%mo2 = sf_int%mi2
	sf_int%mi2 = 0

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set all masses to zero"

	sf_int%mr2 = 0
	sf_int%mo2 = 0
	sf_int%mi2 = 0

	write (u, "(A)")
	write (u, "(A)") "* Re-Initialize structure-function object with Q bounds"

	call reset_interaction_counter ()

	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in, collinear=.false., &
	qbounds = [1._default, 100._default])
	end select

	call sf_int%init (data)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping energy"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.125, keeping momentum"
	write (u, "(A)")

	r = [0.5_default, 0.5_default, 0.125_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_MOMENTUM
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r"
	write (u, "(A)")

	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_4

	@ %def sf_base_4
	@
	\subsubsection{Pair spectrum}
	Construct and display a structure function object for a pair spectrum
	(a structure function involving two particles simultaneously).
	<<SF base: execute tests>>=
	call test (sf_base_5, "sf_base_5", &
	"pair spectrum with radiation", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_5
	<<SF base: tests>>=
	subroutine sf_base_5 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(2) :: pdg_out
	integer, dimension(:), allocatable :: pdg1, pdg2
	type(flavor_t) :: flv
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t), dimension(2) :: k
	type(vector4_t), dimension(4) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_base_5"
	write (u, "(A)") "* Purpose: initialize and fill &
	&a pair spectrum object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	allocate (sf_test_spectrum_data_t :: data)
	select type (data)
	type is (sf_test_spectrum_data_t)
	call data%init (model, pdg_in, with_radiation=.true.)
	end select

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	pdg2 = pdg_out(2)
	write (u, "(2x,99(1x,I0))") pdg1, pdg2

	write (u, "(A)")
	write (u, "(A)") "* Initialize spectrum object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momenta with sqrts=1000"

	E = 500
	k(1) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	k(2) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call sf_int%seed_kinematics (k)

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.4,0.8"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = [0.4_default, 0.8_default]
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics with mapping for r=0.6,0.8"
	write (u, "(A)")

	r = [0.6_default, 0.8_default]
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call reset_interaction_counter ()
	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	call sf_int%seed_kinematics (k)
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb

	write (u, "(A)")
	write (u, "(A)") "* Compute inverse kinematics for x=0.36,0.64 &
	&and evaluate"
	write (u, "(A)")

	x = [0.36_default, 0.64_default]
	xb = 1 - x
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
	call sf_int%apply (scale=0._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "f =", f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_5

	@ %def sf_base_5
	@
	\subsubsection{Pair spectrum without radiation}
	Construct and display a structure function object for a pair spectrum
	(a structure function involving two particles simultaneously).
	<<SF base: execute tests>>=
	call test (sf_base_6, "sf_base_6", &
	"pair spectrum without radiation", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_6
	<<SF base: tests>>=
	subroutine sf_base_6 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(flavor_t) :: flv
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t), dimension(2) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_base_6"
	write (u, "(A)") "* Purpose: initialize and fill &
	&a pair spectrum object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	allocate (sf_test_spectrum_data_t :: data)
	select type (data)
	type is (sf_test_spectrum_data_t)
	call data%init (model, pdg_in, with_radiation=.false.)
	end select

	write (u, "(A)") "* Initialize spectrum object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	write (u, "(A)") "* Initialize incoming momenta with sqrts=1000"

	E = 500
	k(1) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	k(2) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call sf_int%seed_kinematics (k)

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.4,0.8"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = [0.4_default, 0.8_default]
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call reset_interaction_counter ()
	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	call sf_int%seed_kinematics (k)
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb

	write (u, "(A)")
	write (u, "(A)") "* Compute inverse kinematics for x=0.4,0.8 &
	&and evaluate"
	write (u, "(A)")

	x = [0.4_default, 0.8_default]
	xb = 1 - x
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%apply (scale=0._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "f =", f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_6

	@ %def sf_base_6
	@
	\subsubsection{Direct access to structure function}
	Probe a structure function directly.
	<<SF base: execute tests>>=
	call test (sf_base_7, "sf_base_7", &
	"direct access", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_7
	<<SF base: tests>>=
	subroutine sf_base_7 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(flavor_t) :: flv
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	real(default), dimension(:), allocatable :: value

	write (u, "(A)") "* Test output: sf_base_7"
	write (u, "(A)") "* Purpose: check direct access method"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in)
	end select

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	write (u, "(A)") "* Probe structure function: states"
	write (u, "(A)")

	write (u, "(A,I0)") "n_states = ", sf_int%get_n_states ()
	write (u, "(A,I0)") "n_in = ", sf_int%get_n_in ()
	write (u, "(A,I0)") "n_rad = ", sf_int%get_n_rad ()
	write (u, "(A,I0)") "n_out = ", sf_int%get_n_out ()
	write (u, "(A)")
	write (u, "(A)", advance="no") "state(1) = "
	call quantum_numbers_write (sf_int%get_state (1), u)
	write (u, *)

	allocate (value (sf_int%get_n_states ()))
	call sf_int%compute_values (value, &
	E=[500._default], x=[0.5_default], xb=[0.5_default], scale=0._default)

	write (u, "(A)")
	write (u, "(A)", advance="no") "value (E=500, x=0.5) ="
	write (u, "(9(1x," // FMT_19 // "))") value

	call sf_int%compute_values (value, &
	x=[0.1_default], xb=[0.9_default], scale=0._default)

	write (u, "(A)")
	write (u, "(A)", advance="no") "value (E=500, x=0.1) ="
	write (u, "(9(1x," // FMT_19 // "))") value


	write (u, "(A)")
	write (u, "(A)") "* Initialize spectrum object"
	write (u, "(A)")

	deallocate (value)
	call sf_int%final ()
	deallocate (sf_int)
	deallocate (data)

	allocate (sf_test_spectrum_data_t :: data)
	select type (data)
	type is (sf_test_spectrum_data_t)
	call data%init (model, pdg_in, with_radiation=.false.)
	end select

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	write (u, "(A)") "* Probe spectrum: states"
	write (u, "(A)")

	write (u, "(A,I0)") "n_states = ", sf_int%get_n_states ()
	write (u, "(A,I0)") "n_in = ", sf_int%get_n_in ()
	write (u, "(A,I0)") "n_rad = ", sf_int%get_n_rad ()
	write (u, "(A,I0)") "n_out = ", sf_int%get_n_out ()
	write (u, "(A)")
	write (u, "(A)", advance="no") "state(1) = "
	call quantum_numbers_write (sf_int%get_state (1), u)
	write (u, *)

	allocate (value (sf_int%get_n_states ()))
	call sf_int%compute_value (1, value(1), &
	E = [500._default, 500._default], &
	x = [0.5_default, 0.6_default], &
	xb= [0.5_default, 0.4_default], &
	scale = 0._default)

	write (u, "(A)")
	write (u, "(A)", advance="no") "value (E=500,500, x=0.5,0.6) ="
	write (u, "(9(1x," // FMT_19 // "))") value

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_7

	@ %def sf_base_7
	@
	\subsubsection{Structure function chain configuration}
	<<SF base: execute tests>>=
	call test (sf_base_8, "sf_base_8", &
	"structure function chain configuration", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_8
	<<SF base: tests>>=
	subroutine sf_base_8 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	type(beam_data_t), target :: beam_data
	class(sf_data_t), allocatable, target :: data_strfun
	class(sf_data_t), allocatable, target :: data_spectrum
	type(sf_config_t), dimension(:), allocatable :: sf_config
	type(sf_chain_t) :: sf_chain

	write (u, "(A)") "* Test output: sf_base_8"
	write (u, "(A)") "* Purpose: set up a structure-function chain"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	call beam_data%init_sqrts (1000._default, [flv, flv])

	allocate (sf_test_data_t :: data_strfun)
	select type (data_strfun)
	type is (sf_test_data_t)
	call data_strfun%init (model, pdg_in)
	end select

	allocate (sf_test_spectrum_data_t :: data_spectrum)
	select type (data_spectrum)
	type is (sf_test_spectrum_data_t)
	call data_spectrum%init (model, pdg_in, with_radiation=.true.)
	end select

	write (u, "(A)") "* Set up chain with beams only"
	write (u, "(A)")

	call sf_chain%init (beam_data)
	call write_separator (u, 2)
	call sf_chain%write (u)
	call write_separator (u, 2)
	call sf_chain%final ()

	write (u, "(A)")
	write (u, "(A)") "* Set up chain with structure function"
	write (u, "(A)")

	allocate (sf_config (1))
	call sf_config(1)%init ([1], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call write_separator (u, 2)
	call sf_chain%write (u)
	call write_separator (u, 2)
	call sf_chain%final ()

	write (u, "(A)")
	write (u, "(A)") "* Set up chain with spectrum and structure function"
	write (u, "(A)")

	deallocate (sf_config)
	allocate (sf_config (2))
	call sf_config(1)%init ([1,2], data_spectrum)
	call sf_config(2)%init ([2], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call write_separator (u, 2)
	call sf_chain%write (u)
	call write_separator (u, 2)
	call sf_chain%final ()

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

	call model%final ()

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

	end subroutine sf_base_8

	@ %def sf_base_8
	@
	\subsubsection{Structure function instance configuration}
	We create a structure-function chain instance which implements a
	configured structure-function chain. We link the momentum entries in
	the interactions and compute kinematics.

	We do not actually connect the interactions and create evaluators. We
	skip this step and manually advance the status of the chain instead.
	<<SF base: execute tests>>=
	call test (sf_base_9, "sf_base_9", &
	"structure function chain instance", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_9
	<<SF base: tests>>=
	subroutine sf_base_9 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	type(beam_data_t), target :: beam_data
	class(sf_data_t), allocatable, target :: data_strfun
	class(sf_data_t), allocatable, target :: data_spectrum
	type(sf_config_t), dimension(:), allocatable, target :: sf_config
	type(sf_chain_t), target :: sf_chain
	type(sf_chain_instance_t), target :: sf_chain_instance
	type(sf_channel_t), dimension(2) :: sf_channel
	type(vector4_t), dimension(2) :: p
	integer :: j

	write (u, "(A)") "* Test output: sf_base_9"
	write (u, "(A)") "* Purpose: set up a structure-function chain &
	&and create an instance"
	write (u, "(A)") "* compute kinematics"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	call beam_data%init_sqrts (1000._default, [flv, flv])

	allocate (sf_test_data_t :: data_strfun)
	select type (data_strfun)
	type is (sf_test_data_t)
	call data_strfun%init (model, pdg_in)
	end select

	allocate (sf_test_spectrum_data_t :: data_spectrum)
	select type (data_spectrum)
	type is (sf_test_spectrum_data_t)
	call data_spectrum%init (model, pdg_in, with_radiation=.true.)
	end select

	write (u, "(A)") "* Set up chain with beams only"
	write (u, "(A)")

	call sf_chain%init (beam_data)

	call sf_chain_instance%init (sf_chain, n_channel = 1)

	call sf_chain_instance%link_interactions ()
	sf_chain_instance%status = SF_DONE_CONNECTIONS
	call sf_chain_instance%compute_kinematics (1, [real(default) ::])

	call write_separator (u, 2)
	call sf_chain%write (u)
	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	call sf_chain_instance%get_out_momenta (p)

	write (u, "(A)")
	write (u, "(A)") "* Outgoing momenta:"

	do j = 1, 2
	write (u, "(A)")
	call vector4_write (p(j), u)
	end do

	call sf_chain_instance%final ()
	call sf_chain%final ()

	write (u, "(A)")
	write (u, "(A)") "* Set up chain with structure function"
	write (u, "(A)")

	allocate (sf_config (1))
	call sf_config(1)%init ([1], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 1)

	call sf_channel(1)%init (1)
	call sf_channel(1)%activate_mapping ([1])
	call sf_chain_instance%set_channel (1, sf_channel(1))

	call sf_chain_instance%link_interactions ()
	sf_chain_instance%status = SF_DONE_CONNECTIONS
	call sf_chain_instance%compute_kinematics (1, [0.8_default])

	call write_separator (u, 2)
	call sf_chain%write (u)
	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	call sf_chain_instance%get_out_momenta (p)

	write (u, "(A)")
	write (u, "(A)") "* Outgoing momenta:"

	do j = 1, 2
	write (u, "(A)")
	call vector4_write (p(j), u)
	end do

	call sf_chain_instance%final ()
	call sf_chain%final ()

	write (u, "(A)")
	write (u, "(A)") "* Set up chain with spectrum and structure function"
	write (u, "(A)")

	deallocate (sf_config)
	allocate (sf_config (2))
	call sf_config(1)%init ([1,2], data_spectrum)
	call sf_config(2)%init ([2], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 1)

	call sf_channel(2)%init (2)
	call sf_channel(2)%activate_mapping ([2])
	call sf_chain_instance%set_channel (1, sf_channel(2))

	call sf_chain_instance%link_interactions ()
	sf_chain_instance%status = SF_DONE_CONNECTIONS
	call sf_chain_instance%compute_kinematics &
	(1, [0.5_default, 0.6_default, 0.8_default])

	call write_separator (u, 2)
	call sf_chain%write (u)
	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	call sf_chain_instance%get_out_momenta (p)

	write (u, "(A)")
	write (u, "(A)") "* Outgoing momenta:"

	do j = 1, 2
	write (u, "(A)")
	call vector4_write (p(j), u)
	end do

	call sf_chain_instance%final ()
	call sf_chain%final ()

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

	call model%final ()

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

	end subroutine sf_base_9

	@ %def sf_base_9
	@
	\subsubsection{Structure function chain mappings}
	Set up a structure function chain instance with a pair of
	single-particle structure functions. We test different global
	mappings for this setup.

	Again, we skip evaluators.
	<<SF base: execute tests>>=
	call test (sf_base_10, "sf_base_10", &
	"structure function chain mapping", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_10
	<<SF base: tests>>=
	subroutine sf_base_10 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	type(beam_data_t), target :: beam_data
	class(sf_data_t), allocatable, target :: data_strfun
	type(sf_config_t), dimension(:), allocatable, target :: sf_config
	type(sf_chain_t), target :: sf_chain
	type(sf_chain_instance_t), target :: sf_chain_instance
	type(sf_channel_t), dimension(2) :: sf_channel
	real(default), dimension(2) :: x_saved

	write (u, "(A)") "* Test output: sf_base_10"
	write (u, "(A)") "* Purpose: set up a structure-function chain"
	write (u, "(A)") "* and check mappings"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	call beam_data%init_sqrts (1000._default, [flv, flv])

	allocate (sf_test_data_t :: data_strfun)
	select type (data_strfun)
	type is (sf_test_data_t)
	call data_strfun%init (model, pdg_in)
	end select

	write (u, "(A)") "* Set up chain with structure function pair &
	&and standard mapping"
	write (u, "(A)")

	allocate (sf_config (2))
	call sf_config(1)%init ([1], data_strfun)
	call sf_config(2)%init ([2], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 1)

	call sf_channel(1)%init (2)
	call sf_channel(1)%set_s_mapping ([1,2])
	call sf_chain_instance%set_channel (1, sf_channel(1))

	call sf_chain_instance%link_interactions ()
	sf_chain_instance%status = SF_DONE_CONNECTIONS
	call sf_chain_instance%compute_kinematics (1, [0.8_default, 0.6_default])

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Invert the kinematics calculation"
	write (u, "(A)")

	x_saved = sf_chain_instance%x

	call sf_chain_instance%init (sf_chain, n_channel = 1)

	call sf_channel(2)%init (2)
	call sf_channel(2)%set_s_mapping ([1, 2])
	call sf_chain_instance%set_channel (1, sf_channel(2))

	call sf_chain_instance%link_interactions ()
	sf_chain_instance%status = SF_DONE_CONNECTIONS
	call sf_chain_instance%inverse_kinematics (x_saved, 1 - x_saved)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)


	call sf_chain_instance%final ()
	call sf_chain%final ()

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

	call model%final ()

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

	end subroutine sf_base_10

	@ %def sf_base_10
	@
	\subsubsection{Structure function chain evaluation}
	Here, we test the complete workflow for structure-function chains.
	First, we create the template chain, then initialize an instance. We
	set up links, mask, and evaluators. Finally, we set kinematics and
	evaluate the matrix elements and their products.
	<<SF base: execute tests>>=
	call test (sf_base_11, "sf_base_11", &
	"structure function chain evaluation", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_11
	<<SF base: tests>>=
	subroutine sf_base_11 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	type(beam_data_t), target :: beam_data
	class(sf_data_t), allocatable, target :: data_strfun
	class(sf_data_t), allocatable, target :: data_spectrum
	type(sf_config_t), dimension(:), allocatable, target :: sf_config
	type(sf_chain_t), target :: sf_chain
	type(sf_chain_instance_t), target :: sf_chain_instance
	type(sf_channel_t), dimension(2) :: sf_channel
	type(particle_set_t) :: pset
	type(interaction_t), pointer :: int
	logical :: ok

	write (u, "(A)") "* Test output: sf_base_11"
	write (u, "(A)") "* Purpose: set up a structure-function chain"
	write (u, "(A)") "* create an instance and evaluate"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	call beam_data%init_sqrts (1000._default, [flv, flv])

	allocate (sf_test_data_t :: data_strfun)
	select type (data_strfun)
	type is (sf_test_data_t)
	call data_strfun%init (model, pdg_in)
	end select

	allocate (sf_test_spectrum_data_t :: data_spectrum)
	select type (data_spectrum)
	type is (sf_test_spectrum_data_t)
	call data_spectrum%init (model, pdg_in, with_radiation=.true.)
	end select

	write (u, "(A)") "* Set up chain with beams only"
	write (u, "(A)")

	call sf_chain%init (beam_data)

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	call sf_chain_instance%compute_kinematics (1, [real(default) ::])
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	int => sf_chain_instance%get_out_int_ptr ()
	call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
	[0._default, 0._default], .false., .true.)
	call sf_chain_instance%final ()

	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 chain:"
	write (u, "(A)")

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	int => sf_chain_instance%get_out_int_ptr ()
	call pset%fill_interaction (int, 2, check_match=.false.)

	call sf_chain_instance%recover_kinematics (1)
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	call pset%final ()
	call sf_chain_instance%final ()
	call sf_chain%final ()

	write (u, "(A)")
	write (u, "(A)")
	write (u, "(A)")
	write (u, "(A)") "* Set up chain with structure function"
	write (u, "(A)")

	allocate (sf_config (1))
	call sf_config(1)%init ([1], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_channel(1)%init (1)
	call sf_channel(1)%activate_mapping ([1])
	call sf_chain_instance%set_channel (1, sf_channel(1))
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	call sf_chain_instance%compute_kinematics (1, [0.8_default])
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	int => sf_chain_instance%get_out_int_ptr ()
	call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
	[0._default, 0._default], .false., .true.)
	call sf_chain_instance%final ()

	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 chain:"
	write (u, "(A)")

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_channel(1)%init (1)
	call sf_channel(1)%activate_mapping ([1])
	call sf_chain_instance%set_channel (1, sf_channel(1))
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	int => sf_chain_instance%get_out_int_ptr ()
	call pset%fill_interaction (int, 2, check_match=.false.)

	call sf_chain_instance%recover_kinematics (1)
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	call pset%final ()
	call sf_chain_instance%final ()
	call sf_chain%final ()

	write (u, "(A)")
	write (u, "(A)")
	write (u, "(A)")
	write (u, "(A)") "* Set up chain with spectrum and structure function"
	write (u, "(A)")

	deallocate (sf_config)
	allocate (sf_config (2))
	call sf_config(1)%init ([1,2], data_spectrum)
	call sf_config(2)%init ([2], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_channel(2)%init (2)
	call sf_channel(2)%activate_mapping ([2])
	call sf_chain_instance%set_channel (1, sf_channel(2))
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	call sf_chain_instance%compute_kinematics &
	(1, [0.5_default, 0.6_default, 0.8_default])
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	int => sf_chain_instance%get_out_int_ptr ()
	call pset%init (ok, int, int, FM_IGNORE_HELICITY, &
	[0._default, 0._default], .false., .true.)
	call sf_chain_instance%final ()

	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 chain:"
	write (u, "(A)")

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_channel(2)%init (2)
	call sf_channel(2)%activate_mapping ([2])
	call sf_chain_instance%set_channel (1, sf_channel(2))
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	int => sf_chain_instance%get_out_int_ptr ()
	call pset%fill_interaction (int, 2, check_match=.false.)

	call sf_chain_instance%recover_kinematics (1)
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	call pset%final ()
	call sf_chain_instance%final ()
	call sf_chain%final ()

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

	call model%final ()

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

	end subroutine sf_base_11

	@ %def sf_base_11
	@
	\subsubsection{Multichannel case}
	We set up a structure-function chain as before, but with three
	different parameterizations. The first instance is without mappings,
	the second one with single-particle mappings, and the third one with
	two-particle mappings.
	<<SF base: execute tests>>=
	call test (sf_base_12, "sf_base_12", &
	"multi-channel structure function chain", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_12
	<<SF base: tests>>=
	subroutine sf_base_12 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	type(beam_data_t), target :: beam_data
	class(sf_data_t), allocatable, target :: data
	type(sf_config_t), dimension(:), allocatable, target :: sf_config
	type(sf_chain_t), target :: sf_chain
	type(sf_chain_instance_t), target :: sf_chain_instance
	real(default), dimension(2) :: x_saved
	real(default), dimension(2,3) :: p_saved
	type(sf_channel_t), dimension(:), allocatable :: sf_channel

	write (u, "(A)") "* Test output: sf_base_12"
	write (u, "(A)") "* Purpose: set up and evaluate a multi-channel &
	&structure-function chain"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	call beam_data%init_sqrts (1000._default, [flv, flv])

	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	call data%init (model, pdg_in)
	end select

	write (u, "(A)") "* Set up chain with structure function pair &
	&and three different mappings"
	write (u, "(A)")

	allocate (sf_config (2))
	call sf_config(1)%init ([1], data)
	call sf_config(2)%init ([2], data)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 3)

	call allocate_sf_channels (sf_channel, n_channel = 3, n_strfun = 2)

	! channel 1: no mapping
	call sf_chain_instance%set_channel (1, sf_channel(1))

	! channel 2: single-particle mappings
	call sf_channel(2)%activate_mapping ([1,2])
	! call sf_chain_instance%activate_mapping (2, [1,2])
	call sf_chain_instance%set_channel (2, sf_channel(2))

	! channel 3: two-particle mapping
	call sf_channel(3)%set_s_mapping ([1,2])
	! call sf_chain_instance%set_s_mapping (3, [1, 2])
	call sf_chain_instance%set_channel (3, sf_channel(3))

	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	write (u, "(A)") "* Compute kinematics in channel 1 and evaluate"
	write (u, "(A)")

	call sf_chain_instance%compute_kinematics (1, [0.8_default, 0.6_default])
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Invert the kinematics calculation"
	write (u, "(A)")

	x_saved = sf_chain_instance%x

	call sf_chain_instance%inverse_kinematics (x_saved, 1 - x_saved)
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Compute kinematics in channel 2 and evaluate"
	write (u, "(A)")

	p_saved = sf_chain_instance%p

	call sf_chain_instance%compute_kinematics (2, p_saved(:,2))
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Compute kinematics in channel 3 and evaluate"
	write (u, "(A)")

	call sf_chain_instance%compute_kinematics (3, p_saved(:,3))
	call sf_chain_instance%evaluate (scale=0._default)

	call write_separator (u, 2)
	call sf_chain_instance%write (u)
	call write_separator (u, 2)

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

	call sf_chain_instance%final ()
	call sf_chain%final ()

	call model%final ()

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

	end subroutine sf_base_12

	@ %def sf_base_12
	@
	\subsubsection{Generated spectrum}
	Construct and evaluate a structure function object for a pair spectrum
	which is evaluated as a beam-event generator.
	<<SF base: execute tests>>=
	call test (sf_base_13, "sf_base_13", &
	"pair spectrum generator", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_13
	<<SF base: tests>>=
	subroutine sf_base_13 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t), dimension(2) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, x_free

	write (u, "(A)") "* Test output: sf_base_13"
	write (u, "(A)") "* Purpose: initialize and fill &
	&a pair generator object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	allocate (sf_test_generator_data_t :: data)
	select type (data)
	type is (sf_test_generator_data_t)
	call data%init (model, pdg_in)
	end select

	write (u, "(A)") "* Initialize generator object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	write (u, "(A)") "* Generate free r values"
	write (u, "(A)")

	x_free = 1
	call sf_int%generate_free (r, rb, x_free)

	write (u, "(A)") "* Initialize incoming momenta with sqrts=1000"

	E = 500
	k(1) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	k(2) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call sf_int%seed_kinematics (k)

	write (u, "(A)")
	write (u, "(A)") "* Complete kinematics"
	write (u, "(A)")

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call reset_interaction_counter ()
	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)

	call sf_int%seed_kinematics (k)
	call sf_int%set_momenta (q, outgoing=.true.)
	x_free = 1
	call sf_int%recover_x (x, xb, x_free)
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

	write (u, "(A)")
	write (u, "(A)") "* Compute inverse kinematics &
	&and evaluate"
	write (u, "(A)")

	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%apply (scale=0._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "f =", f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_base_13

	@ %def sf_base_13
	@
	\subsubsection{Structure function chain evaluation}
	Here, we test the complete workflow for a structure-function chain
	with generator. First, we create the template chain, then initialize
	an instance. We set up links, mask, and evaluators. Finally, we set
	kinematics and evaluate the matrix elements and their products.
	<<SF base: execute tests>>=
	call test (sf_base_14, "sf_base_14", &
	"structure function generator evaluation", &
	u, results)
	<<SF base: test declarations>>=
	public :: sf_base_14
	<<SF base: tests>>=
	subroutine sf_base_14 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	type(beam_data_t), target :: beam_data
	class(sf_data_t), allocatable, target :: data_strfun
	class(sf_data_t), allocatable, target :: data_generator
	type(sf_config_t), dimension(:), allocatable, target :: sf_config
	real(default), dimension(:), allocatable :: p_in
	type(sf_chain_t), target :: sf_chain
	type(sf_chain_instance_t), target :: sf_chain_instance

	write (u, "(A)") "* Test output: sf_base_14"
	write (u, "(A)") "* Purpose: set up a structure-function chain"
	write (u, "(A)") "* create an instance and evaluate"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_test ()
	call flv%init (25, model)
	pdg_in = 25

	call reset_interaction_counter ()

	call beam_data%init_sqrts (1000._default, [flv, flv])

	allocate (sf_test_data_t :: data_strfun)
	select type (data_strfun)
	type is (sf_test_data_t)
	call data_strfun%init (model, pdg_in)
	end select

	allocate (sf_test_generator_data_t :: data_generator)
	select type (data_generator)
	type is (sf_test_generator_data_t)
	call data_generator%init (model, pdg_in)
	end select

	write (u, "(A)") "* Set up chain with generator and structure function"
	write (u, "(A)")

	allocate (sf_config (2))
	call sf_config(1)%init ([1,2], data_generator)
	call sf_config(2)%init ([2], data_strfun)
	call sf_chain%init (beam_data, sf_config)

	call sf_chain_instance%init (sf_chain, n_channel = 1)
	call sf_chain_instance%link_interactions ()
	call sf_chain_instance%exchange_mask ()
	call sf_chain_instance%init_evaluators ()

	write (u, "(A)") "* Inject integration parameter"
	write (u, "(A)")

	allocate (p_in (sf_chain%get_n_bound ()), source = 0.9_default)
	write (u, "(A,9(1x,F10.7))") "p_in =", p_in

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

	call sf_chain_instance%compute_kinematics (1, p_in)
	call sf_chain_instance%evaluate (scale=0._default)

	call sf_chain_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Extract integration parameter"
	write (u, "(A)")

	call sf_chain_instance%get_mcpar (1, p_in)
	write (u, "(A,9(1x,F10.7))") "p_in =", p_in

	call sf_chain_instance%final ()
	call sf_chain%final ()

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

	call model%final ()

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

	end subroutine sf_base_14

	@ %def sf_base_14
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Photon radiation: ISR}

	<<[[sf_isr.f90]]>>=
	<<File header>>

	module sf_isr

	<<Use kinds>>
	<<Use strings>>
	use pdg_arrays
	use model_data
	use flavors
	use sf_aux
	use sf_mappings
	use sf_base
	use electron_pdfs

	<<Standard module head>>

	<<SF isr: public>>

	<<SF isr: parameters>>

	<<SF isr: types>>

	interface
	<<SF isr: sub interfaces>>
	end interface

	contains

	<<SF isr: main procedures>>

	end module sf_isr
	@ %def sf_isr
	@
	<<[[sf_isr_sub.f90]]>>=
	<<File header>>

	submodule (sf_isr) sf_isr_s

	use io_units
	use constants, only: pi
	use format_defs, only: FMT_15, FMT_19
	use numeric_utils
	use diagnostics
	use physics_defs, only: PHOTON
	use sm_physics, only: Li2
	use lorentz
	use colors
	use quantum_numbers
	use polarizations

	implicit none

	contains

	<<SF isr: procedures>>

	end submodule sf_isr_s

	@ %def sf_isr_s
	@
	\subsection{Physics}
	The ISR structure function is in the most crude approximation (LLA
	without $\alpha$ corrections, i.e. $\epsilon^0$)
	\begin{equation}
	f_0(x) = \epsilon (1-x)^{-1+\epsilon} \qquad\text{with}\qquad
	\epsilon = \frac{\alpha}{\pi}q_e^2\ln\frac{s}{m^2},
	\end{equation}
	where $m$ is the mass of the incoming (and outgoing) particle, which
	is initially assumed on-shell.

	In $f_0(x)$, there is an integrable singularity at $x=1$ which does
	not spoil the integration, but would lead to an unbounded $f_{\rm
	max}$. Therefore, we map this singularity like
	\begin{equation}\label{ISR-mapping}
	x = 1 - (1-x')^{1/\epsilon}
	\end{equation}
	such that
	\begin{equation}
	\int dx\,f_0(x) = \int dx'
	\end{equation}

	For the detailed form of the QED ISR structure function
	cf. Chap.~\ref{chap:qed_pdf}.

	\subsection{Implementation}

	In the concrete implementation, the zeroth order mapping
	(\ref{ISR-mapping}) is implemented, and the Jacobian is equal to
	$f_i(x)/f_0(x)$. This can be written as
	\begin{align}
	\frac{f_0(x)}{f_0(x)} &= 1 \\
	\frac{f_1(x)}{f_0(x)} &= 1 + \frac34\epsilon - \frac{1-x^2}{2(1-x')} \\
	\begin{split}\label{ISR-f2}
	\frac{f_2(x)}{f_0(x)} &= 1 + \frac34\epsilon
	+ \frac{27 - 8\pi^2}{96}\epsilon^2
	- \frac{1-x^2}{2(1-x')} \\
	&\quad - \frac{(1+3x^2)\ln x
	+ (1-x)\left(4(1+x)\ln(1-x) + 5 + x\right)}{8(1-x')}\epsilon
	\end{split}
	\end{align}
	%'
	For $x=1$ (i.e., numerically indistinguishable from $1$), this reduces to
	\begin{align}
	\frac{f_0(x)}{f_0(x)} &= 1 \\
	\frac{f_1(x)}{f_0(x)} &= 1 + \frac34\epsilon \\
	\frac{f_2(x)}{f_0(x)} &= 1 + \frac34\epsilon
	+ \frac{27 - 8\pi^2}{96}\epsilon^2
	\end{align}
	The last line in (\ref{ISR-f2}) is zero for
	\begin{equation}
	x_{\rm min} = 0.00714053329734592839549879772019
	\end{equation}
	(Mathematica result), independent of $\epsilon$. For $x$ values less
	than this we ignore this correction because of the logarithmic
	singularity which should in principle be resummed.


	\subsection{The ISR data block}
	<<SF isr: public>>=
	public :: isr_data_t
	<<SF isr: types>>=
	type, extends (sf_data_t) :: isr_data_t
	private
	class(model_data_t), pointer :: model => null ()
	type(flavor_t), dimension(:), allocatable :: flv_in
	type(qed_pdf_t) :: pdf
	real(default) :: alpha = 0
	real(default) :: q_max = 0
	real(default) :: real_mass = 0
	real(default) :: mass = 0
	real(default) :: eps = 0
	real(default) :: log = 0
	logical :: recoil = .false.
	logical :: keep_energy = .true.
	integer :: order = 3
	integer :: error = NONE
	contains
	<<SF isr: isr data: TBP>>
	end type isr_data_t

	@ %def isr_data_t
	@ Error codes
	<<SF isr: parameters>>=
	integer, parameter :: NONE = 0
	integer, parameter :: ZERO_MASS = 1
	integer, parameter :: Q_MAX_TOO_SMALL = 2
	integer, parameter :: EPS_TOO_LARGE = 3
	integer, parameter :: INVALID_ORDER = 4
	integer, parameter :: CHARGE_MIX = 5
	integer, parameter :: CHARGE_ZERO = 6
	integer, parameter :: MASS_MIX = 7
	@ Generate flavor-dependent ISR data:
	<<SF isr: isr data: TBP>>=
	procedure :: init => isr_data_init
	<<SF isr: sub interfaces>>=
	module subroutine isr_data_init (data, model, pdg_in, alpha, q_max, &
	mass, order, recoil, keep_energy)
	class(isr_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	real(default), intent(in) :: alpha
	real(default), intent(in) :: q_max
	real(default), intent(in), optional :: mass
	integer, intent(in), optional :: order
	logical, intent(in), optional :: recoil
	logical, intent(in), optional :: keep_energy
	end subroutine isr_data_init
	<<SF isr: procedures>>=
	module subroutine isr_data_init (data, model, pdg_in, alpha, q_max, &
	mass, order, recoil, keep_energy)
	class(isr_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	real(default), intent(in) :: alpha
	real(default), intent(in) :: q_max
	real(default), intent(in), optional :: mass
	integer, intent(in), optional :: order
	logical, intent(in), optional :: recoil
	logical, intent(in), optional :: keep_energy
	integer :: i, n_flv
	real(default) :: charge
	data%model => model
	n_flv = pdg_in%get_length ()
	allocate (data%flv_in (n_flv))
	do i = 1, n_flv
	call data%flv_in(i)%init (pdg_in%get (i), model)
	end do
	data%alpha = alpha
	data%q_max = q_max
	if (present (order)) then
	call data%set_order (order)
	end if
	if (present (recoil)) then
	data%recoil = recoil
	end if
	if (present (keep_energy)) then
	data%keep_energy = keep_energy
	end if
	data%real_mass = data%flv_in(1)%get_mass ()
	if (present (mass)) then
	if (mass > 0) then
	data%mass = mass
	else
	data%mass = data%real_mass
	if (any (data%flv_in%get_mass () /= data%mass)) then
	data%error = MASS_MIX; return
	end if
	end if
	else
	data%mass = data%real_mass
	if (any (data%flv_in%get_mass () /= data%mass)) then
	data%error = MASS_MIX; return
	end if
	end if
	if (vanishes (data%mass)) then
	data%error = ZERO_MASS; return
	else if (data%mass >= data%q_max) then
	data%error = Q_MAX_TOO_SMALL; return
	end if
	data%log = log (1 + (data%q_max / data%mass)**2)
	charge = data%flv_in(1)%get_charge ()
	if (any (abs (data%flv_in%get_charge ()) /= abs (charge))) then
	data%error = CHARGE_MIX; return
	else if (charge == 0) then
	data%error = CHARGE_ZERO; return
	end if
	data%eps = data%alpha / pi * charge ** 2 &
	* (2 * log (data%q_max / data%mass) - 1)
	if (data%eps > 1) then
	data%error = EPS_TOO_LARGE; return
	end if
	call data%pdf%init (data%mass, data%alpha, charge, data%q_max, data%order, &
	0, 1)
	end subroutine isr_data_init

	@ %def isr_data_init
	@ Explicitly set ISR order
	<<SF isr: isr data: TBP>>=
	procedure :: set_order => isr_data_set_order
	<<SF isr: sub interfaces>>=
	elemental module subroutine isr_data_set_order (data, order)
	class(isr_data_t), intent(inout) :: data
	integer, intent(in) :: order
	end subroutine isr_data_set_order
	<<SF isr: procedures>>=
	elemental module subroutine isr_data_set_order (data, order)
	class(isr_data_t), intent(inout) :: data
	integer, intent(in) :: order
	if (order < 0 .or. order > 3) then
	data%error = INVALID_ORDER
	else
	data%order = order
	end if
	end subroutine isr_data_set_order

	@ %def isr_data_set_order
	@ Handle error conditions. Should always be done after
	initialization, unless we are sure everything is ok.
	<<SF isr: isr data: TBP>>=
	procedure :: check => isr_data_check
	<<SF isr: sub interfaces>>=
	module subroutine isr_data_check (data)
	class(isr_data_t), intent(in) :: data
	end subroutine isr_data_check
	<<SF isr: procedures>>=
	module subroutine isr_data_check (data)
	class(isr_data_t), intent(in) :: data
	select case (data%error)
	case (ZERO_MASS)
	call msg_fatal ("ISR: Particle mass is zero")
	case (Q_MAX_TOO_SMALL)
	call msg_fatal ("ISR: Particle mass exceeds Qmax")
	case (EPS_TOO_LARGE)
	call msg_fatal ("ISR: Expansion parameter too large, " // &
	"perturbative expansion breaks down")
	case (INVALID_ORDER)
	call msg_error ("ISR: LLA order invalid (valid values are 0,1,2,3)")
	case (MASS_MIX)
	call msg_fatal ("ISR: Incoming particle masses must be uniform")
	case (CHARGE_MIX)
	call msg_fatal ("ISR: Incoming particle charges must be uniform")
	case (CHARGE_ZERO)
	call msg_fatal ("ISR: Incoming particle must be charged")
	end select
	end subroutine isr_data_check

	@ %def isr_data_check
	@ Output
	<<SF isr: isr data: TBP>>=
	procedure :: write => isr_data_write
	<<SF isr: sub interfaces>>=
	module subroutine isr_data_write (data, unit, verbose)
	class(isr_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine isr_data_write
	<<SF isr: procedures>>=
	module subroutine isr_data_write (data, unit, verbose)
	class(isr_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "ISR data:"
	if (allocated (data%flv_in)) then
	write (u, "(3x,A)", advance="no") " flavor = "
	do i = 1, size (data%flv_in)
	if (i > 1) write (u, "(',',1x)", advance="no")
	call data%flv_in(i)%write (u)
	end do
	write (u, *)
	write (u, "(3x,A," // FMT_19 // ")") " alpha = ", data%alpha
	write (u, "(3x,A," // FMT_19 // ")") " q_max = ", data%q_max
	write (u, "(3x,A," // FMT_19 // ")") " mass = ", data%mass
	write (u, "(3x,A," // FMT_19 // ")") " eps = ", data%eps
	write (u, "(3x,A," // FMT_19 // ")") " log = ", data%log
	write (u, "(3x,A,I2)") " order = ", data%order
	write (u, "(3x,A,L2)") " recoil = ", data%recoil
	write (u, "(3x,A,L2)") " keep en. = ", data%keep_energy
	else
	write (u, "(3x,A)") "[undefined]"
	end if
	end subroutine isr_data_write

	@ %def isr_data_write
	@ For ISR, there is the option to generate transverse momentum is
	generated. Hence, there can be up to three parameters, $x$, and two
	angles.
	<<SF isr: isr data: TBP>>=
	procedure :: get_n_par => isr_data_get_n_par
	<<SF isr: sub interfaces>>=
	module function isr_data_get_n_par (data) result (n)
	class(isr_data_t), intent(in) :: data
	integer :: n
	end function isr_data_get_n_par
	<<SF isr: procedures>>=
	module function isr_data_get_n_par (data) result (n)
	class(isr_data_t), intent(in) :: data
	integer :: n
	if (data%recoil) then
	n = 3
	else
	n = 1
	end if
	end function isr_data_get_n_par

	@ %def isr_data_get_n_par
	@ Return the outgoing particles PDG codes. For ISR, these are
	identical to the incoming particles.
	<<SF isr: isr data: TBP>>=
	procedure :: get_pdg_out => isr_data_get_pdg_out
	<<SF isr: sub interfaces>>=
	module subroutine isr_data_get_pdg_out (data, pdg_out)
	class(isr_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	end subroutine isr_data_get_pdg_out
	<<SF isr: procedures>>=
	module subroutine isr_data_get_pdg_out (data, pdg_out)
	class(isr_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	pdg_out(1) = data%flv_in%get_pdg ()
	end subroutine isr_data_get_pdg_out

	@ %def isr_data_get_pdg_out
	@ Return the [[eps]] value. We need it for an appropriate mapping of
	structure-function parameters.
	<<SF isr: isr data: TBP>>=
	procedure :: get_eps => isr_data_get_eps
	<<SF isr: sub interfaces>>=
	module function isr_data_get_eps (data) result (eps)
	class(isr_data_t), intent(in) :: data
	real(default) :: eps
	end function isr_data_get_eps
	<<SF isr: procedures>>=
	module function isr_data_get_eps (data) result (eps)
	class(isr_data_t), intent(in) :: data
	real(default) :: eps
	eps = data%eps
	end function isr_data_get_eps

	@ %def isr_data_get_eps
	@ Allocate the interaction record. Gfortran 7/8/9 bug, has to remain
	in the module.
	<<SF isr: isr data: TBP>>=
	procedure :: allocate_sf_int => isr_data_allocate_sf_int
	<<SF isr: main procedures>>=
	subroutine isr_data_allocate_sf_int (data, sf_int)
	class(isr_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (isr_t :: sf_int)
	end subroutine isr_data_allocate_sf_int

	@ %def isr_data_allocate_sf_int
	@
	\subsection{The ISR object}
	The [[isr_t]] data type is a $1\to 2$ interaction, i.e., we allow for
	single-photon emission only (but use the multi-photon resummed
	radiator function). The particles are ordered as (incoming, photon,
	outgoing).

	There is no need to handle several flavors (and data blocks) in
	parallel, since ISR is always applied immediately after beam
	collision. (ISR for partons is accounted for by the PDFs themselves.)
	Polarization is carried through, i.e., we retain the polarization of
	the incoming particle and treat the emitted photon as unpolarized.
	Color is trivially carried through. This implies that particles 1 and
	3 should be locked together. For ISR we don't need the q variable.
	<<SF isr: public>>=
	public :: isr_t
	<<SF isr: types>>=
	type, extends (sf_int_t) :: isr_t
	private
	type(isr_data_t), pointer :: data => null ()
	real(default) :: x = 0
	real(default) :: xb= 0
	contains
	<<SF isr: isr: TBP>>
	end type isr_t

	@ %def isr_t
	@ Type string: has to be here, but there is no string variable on which ISR
	depends. Hence, a dummy routine.
	<<SF isr: isr: TBP>>=
	procedure :: type_string => isr_type_string
	<<SF isr: sub interfaces>>=
	module function isr_type_string (object) result (string)
	class(isr_t), intent(in) :: object
	type(string_t) :: string
	end function isr_type_string
	<<SF isr: procedures>>=
	module function isr_type_string (object) result (string)
	class(isr_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "ISR: e+ e- ISR spectrum"
	else
	string = "ISR: [undefined]"
	end if
	end function isr_type_string

	@ %def isr_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF isr: isr: TBP>>=
	procedure :: write => isr_write
	<<SF isr: sub interfaces>>=
	module subroutine isr_write (object, unit, testflag)
	class(isr_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine isr_write
	<<SF isr: procedures>>=
	module subroutine isr_write (object, unit, testflag)
	class(isr_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	if (object%status >= SF_DONE_KINEMATICS) then
	write (u, "(1x,A)") "SF parameters:"
	write (u, "(3x,A," // FMT_15 // ")") "x =", object%x
	write (u, "(3x,A," // FMT_15 // ")") "xb=", object%xb
	end if
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "ISR data: [undefined]"
	end if
	end subroutine isr_write

	@ %def isr_write
	@ Explicitly set ISR order (for unit test).
	<<SF isr: isr: TBP>>=
	procedure :: set_order => isr_set_order
	<<SF isr: sub interfaces>>=
	module subroutine isr_set_order (object, order)
	class(isr_t), intent(inout) :: object
	integer, intent(in) :: order
	end subroutine isr_set_order
	<<SF isr: procedures>>=
	module subroutine isr_set_order (object, order)
	class(isr_t), intent(inout) :: object
	integer, intent(in) :: order
	call object%data%set_order (order)
	call object%data%pdf%set_order (order)
	end subroutine isr_set_order

	@ %def isr_set_order
	@
	\subsection{Kinematics}
	Set kinematics. If [[map]] is unset, the $r$ and $x$ values
	coincide, and the Jacobian $f(r)$ were trivial. The ISR structure
	function allows for a straightforward mapping of the unit interval.
	So, to leading order, the structure function value is unity, but the
	$x$ value is transformed. Higher orders affect the function value.

	The structure function implementation applies the above mapping to the
	input (random) number [[r]] to generate the momentum fraction [[x]]
	and the function value [[f]]. For numerical stability reasons, we
	also output [[xb]], which is $\bar x=1-x$.

	For the ISR structure function, the mapping Jacobian cancels the
	structure function (to order zero). We apply the cancellation
	explicitly, therefore both the Jacobian [[f]] and the zeroth-order value
	(see the [[apply]] method) are unity if mapping is turned on. If
	mapping is turned off, the Jacobian [[f]] includes the value of the
	(zeroth-order) structure function, and strongly peaked.
	<<SF isr: isr: TBP>>=
	procedure :: complete_kinematics => isr_complete_kinematics
	<<SF isr: sub interfaces>>=
	module subroutine isr_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(isr_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	end subroutine isr_complete_kinematics
	<<SF isr: procedures>>=
	module subroutine isr_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(isr_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	real(default) :: eps
	eps = sf_int%data%eps
	if (map) then
	call map_power_1 (sf_int%xb, f, rb(1), eps)
	else
	sf_int%xb = rb(1)
	if (rb(1) > 0) then
	f = 1
	else
	f = 0
	end if
	end if
	sf_int%x = 1 - sf_int%xb
	x(1) = sf_int%x
	xb(1) = sf_int%xb
	if (size (x) == 3) then
	x(2:3) = r(2:3)
	xb(2:3) = rb(2:3)
	end if
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS)
	sf_int%x = 0
	sf_int%xb= 0
	f = 0
	end select
	end subroutine isr_complete_kinematics

	@ %def isr_complete_kinematics
	@ Overriding the default method: we compute the [[x]] array from the
	momentum configuration. In the specific case of ISR, we also set the
	internally stored $x$ and $\bar x$ values, so they can be used in the
	following routine.
	<<SF isr: isr: TBP>>=
	procedure :: recover_x => sf_isr_recover_x
	<<SF isr: sub interfaces>>=
	module subroutine sf_isr_recover_x (sf_int, x, xb, x_free)
	class(isr_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_isr_recover_x
	<<SF isr: procedures>>=
	module subroutine sf_isr_recover_x (sf_int, x, xb, x_free)
	class(isr_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	call sf_int%base_recover_x (x, xb, x_free)
	sf_int%x = x(1)
	sf_int%xb = xb(1)
	end subroutine sf_isr_recover_x

	@ %def sf_isr_recover_x
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.

	For extracting $x$, we rely on the stored $\bar x$ value, since the
	$x$ value in the argument is likely imprecise. This means that either
	[[complete_kinematics]] or [[recover_x]] must be called first, for the
	current sampling point (but maybe another channel).
	<<SF isr: isr: TBP>>=
	procedure :: inverse_kinematics => isr_inverse_kinematics
	<<SF isr: sub interfaces>>=
	module subroutine isr_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(isr_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	end subroutine isr_inverse_kinematics
	<<SF isr: procedures>>=
	module subroutine isr_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(isr_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	real(default) :: eps
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	eps = sf_int%data%eps
	if (map) then
	call map_power_inverse_1 (xb(1), f, rb(1), eps)
	else
	rb(1) = xb(1)
	if (rb(1) > 0) then
	f = 1
	else
	f = 0
	end if
	end if
	r(1) = 1 - rb(1)
	if (size(r) == 3) then
	r(2:3) = x(2:3)
	rb(2:3)= xb(2:3)
	end if
	if (set_mom) then
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS)
	r = 0
	rb= 0
	f = 0
	end select
	end if
	end subroutine isr_inverse_kinematics

	@ %def isr_inverse_kinematics
	@
	<<SF isr: isr: TBP>>=
	procedure :: init => isr_init
	<<SF isr: sub interfaces>>=
	module subroutine isr_init (sf_int, data)
	class(isr_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	end subroutine isr_init
	<<SF isr: procedures>>=
	module subroutine isr_init (sf_int, data)
	class(isr_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(3) :: mask
	integer, dimension(3) :: hel_lock
	type(polarization_t), target :: pol
	type(quantum_numbers_t), dimension(1) :: qn_fc
	type(flavor_t) :: flv_photon
	type(color_t) :: col_photon
	type(quantum_numbers_t) :: qn_hel, qn_photon, qn
	type(polarization_iterator_t) :: it_hel
	real(default) :: m2
	integer :: i
	mask = quantum_numbers_mask (.false., .false., &
	mask_h = [.false., .true., .false.])
	hel_lock = [3, 0, 1]
	select type (data)
	type is (isr_data_t)
	m2 = data%mass**2
	call sf_int%base_init (mask, [m2], [0._default], [m2], &
	hel_lock = hel_lock)
	sf_int%data => data
	call flv_photon%init (PHOTON, data%model)
	call col_photon%init ()
	call qn_photon%init (flv_photon, col_photon)
	call qn_photon%tag_radiated ()
	do i = 1, size (data%flv_in)
	call pol%init_generic (data%flv_in(i))
	call qn_fc(1)%init (&
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i), 1))
	call it_hel%init (pol)
	do while (it_hel%is_valid ())
	qn_hel = it_hel%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc(1)
	call sf_int%add_state ([qn, qn_photon, qn])
	call it_hel%advance ()
	end do
	! call pol%final () !!! Obsolete
	end do
	call sf_int%freeze ()
	if (data%keep_energy) then
	sf_int%on_shell_mode = KEEP_ENERGY
	else
	sf_int%on_shell_mode = KEEP_MOMENTUM
	end if
	call sf_int%set_incoming ([1])
	call sf_int%set_radiated ([2])
	call sf_int%set_outgoing ([3])
	sf_int%status = SF_INITIAL
	end select
	end subroutine isr_init

	@ %def isr_init
	@
	\subsection{ISR application}
	For ISR, we could in principle compute kinematics and function value
	in a single step. In order to be able to reweight matrix elements
	including structure functions we split kinematics and structure
	function calculation. The structure function works on a single beam,
	assuming that the input momentum has been set.

	For the structure-function evaluation, we rely on the fact that the
	power mapping, which we apply in the kinematics method (if the [[map]]
	flag is set), has a Jacobian which is just the inverse lowest-order
	structure function. With mapping active, the two should cancel
	exactly.

	After splitting momenta, we set the outgoing momenta on-shell. We
	choose to conserve momentum, so energy conservation may be violated.
	<<SF isr: isr: TBP>>=
	procedure :: apply => isr_apply
	<<SF isr: sub interfaces>>=
	module subroutine isr_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(isr_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	end subroutine isr_apply
	<<SF isr: procedures>>=
	module subroutine isr_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(isr_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	real(default) :: f, finv, x, xb, eps, rb
	real(default) :: log_x, log_xb, x_2
	associate (data => sf_int%data)
	eps = sf_int%data%eps
	x = sf_int%x
	xb = sf_int%xb
	call map_power_inverse_1 (xb, finv, rb, eps)
	if (finv > 0) then
	f = 1 / finv
	else
	f = 0
	end if
	call data%pdf%evolve_qed_pdf (x, xb, rb, f)
	end associate
	call sf_int%set_matrix_element (cmplx (f, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine isr_apply

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

	module sf_isr_ut
	use unit_tests
	use sf_isr_uti

	<<Standard module head>>

	<<SF isr: public test>>

	contains

	<<SF isr: test driver>>

	end module sf_isr_ut
	@ %def sf_isr_ut
	@
	<<[[sf_isr_uti.f90]]>>=
	<<File header>>

	module sf_isr_uti

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_12
	use physics_defs, only: ELECTRON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use interactions, only: interaction_t
	use model_data
	use sf_aux, only: KEEP_ENERGY
	use sf_mappings
	use sf_base

	use sf_isr

	<<Standard module head>>

	<<SF isr: test declarations>>

	contains

	<<SF isr: tests>>

	end module sf_isr_uti
	@ %def sf_isr_ut
	@ API: driver for the unit tests below.
	<<SF isr: public test>>=
	public :: sf_isr_test
	<<SF isr: test driver>>=
	subroutine sf_isr_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF isr: execute tests>>
	end subroutine sf_isr_test

	@ %def sf_isr_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF isr: execute tests>>=
	call test (sf_isr_1, "sf_isr_1", &
	"structure function configuration", &
	u, results)
	<<SF isr: test declarations>>=
	public :: sf_isr_1
	<<SF isr: tests>>=
	subroutine sf_isr_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_isr_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in = ELECTRON

	allocate (isr_data_t :: data)
	call data%write (u)

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

	select type (data)
	type is (isr_data_t)
	call data%init (model, pdg_in, 1./137._default, 10._default, &
	0.000511_default, order = 3, recoil = .false.)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	call model%final ()

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

	end subroutine sf_isr_1

	@ %def sf_isr_1
	@
	\subsubsection{Structure function without mapping}
	Direct ISR evaluation. This is the use case for a double-beam
	structure function. The parameter pair is mapped in the calling program.
	<<SF isr: execute tests>>=
	call test (sf_isr_2, "sf_isr_2", &
	"no ISR mapping", &
	u, results)
	<<SF isr: test declarations>>=
	public :: sf_isr_2
	<<SF isr: tests>>=
	subroutine sf_isr_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(flavor_t) :: flv
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, f_isr

	write (u, "(A)") "* Test output: sf_isr_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in = ELECTRON
	call flv%init (ELECTRON, model)

	call reset_interaction_counter ()

	allocate (isr_data_t :: data)
	select type (data)
	type is (isr_data_t)
	call data%init (model, pdg_in, 1./137._default, 500._default, &
	0.000511_default, order = 3, recoil = .false.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.9, no ISR mapping, &
	&collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.9_default
	rb = 1 - r
	write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
	write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A)")
	write (u, "(A,9(1x," // FMT_12 // "))") "x =", x
	write (u, "(A,9(1x," // FMT_12 // "))") "xb=", xb
	write (u, "(A,9(1x," // FMT_12 // "))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Invert kinematics"
	write (u, "(A)")

	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)
	write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
	write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
	write (u, "(A,9(1x," // FMT_12 // "))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate ISR structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Structure-function value, default order"
	write (u, "(A)")

	f_isr = sf_int%get_matrix_element (1)

	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f

	write (u, "(A)")
	write (u, "(A)") "* Re-evaluate structure function, leading order"
	write (u, "(A)")

	select type (sf_int)
	type is (isr_t)
	call sf_int%set_order (0)
	end select
	call sf_int%apply (scale = 100._default)
	f_isr = sf_int%get_matrix_element (1)

	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_isr_2

	@ %def sf_isr_2
	@
	\subsubsection{Structure function with mapping}
	Apply the optimal ISR mapping. This is the use case for a single-beam
	structure function.
	<<SF isr: execute tests>>=
	call test (sf_isr_3, "sf_isr_3", &
	"ISR mapping", &
	u, results)
	<<SF isr: test declarations>>=
	public :: sf_isr_3
	<<SF isr: tests>>=
	subroutine sf_isr_3 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, f_isr

	write (u, "(A)") "* Test output: sf_isr_3"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv%init (ELECTRON, model)
	pdg_in = ELECTRON

	call reset_interaction_counter ()

	allocate (isr_data_t :: data)
	select type (data)
	type is (isr_data_t)
	call data%init (model, pdg_in, 1./137._default, 500._default, &
	0.000511_default, order = 3, recoil = .false.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.7, with ISR mapping, &
	&collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.7_default
	rb = 1 - r
	write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
	write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)

	write (u, "(A)")
	write (u, "(A,9(1x," // FMT_12 // "))") "x =", x
	write (u, "(A,9(1x," // FMT_12 // "))") "xb=", xb
	write (u, "(A,9(1x," // FMT_12 // "))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Invert kinematics"
	write (u, "(A)")

	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)
	write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
	write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
	write (u, "(A,9(1x," // FMT_12 // "))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate ISR structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Structure-function value, default order"
	write (u, "(A)")

	f_isr = sf_int%get_matrix_element (1)

	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f

	write (u, "(A)")
	write (u, "(A)") "* Re-evaluate structure function, leading order"
	write (u, "(A)")

	select type (sf_int)
	type is (isr_t)
	call sf_int%set_order (0)
	end select
	call sf_int%apply (scale = 100._default)
	f_isr = sf_int%get_matrix_element (1)

	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_isr_3

	@ %def sf_isr_3
	@
	\subsubsection{Non-collinear ISR splitting}
	Construct and display a structure function object based on the ISR
	structure function. We blank out numerical fluctuations for 32bit.
	<<SF isr: execute tests>>=
	call test (sf_isr_4, "sf_isr_4", &
	"ISR non-collinear", &
	u, results)
	<<SF isr: test declarations>>=
	public :: sf_isr_4
	<<SF isr: tests>>=
	subroutine sf_isr_4 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, f_isr
	character(len=80) :: buffer
	integer :: u_scratch, iostat

	write (u, "(A)") "* Test output: sf_isr_4"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv%init (ELECTRON, model)
	pdg_in = ELECTRON

	call reset_interaction_counter ()

	write (u, "(A)")
	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	allocate (isr_data_t :: data)
	select type (data)
	type is (isr_data_t)
	call data%init (model, pdg_in, 1./137._default, 500._default, &
	0.000511_default, order = 3, recoil = .true.)
	end select

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5/0.5/0.25, with ISR mapping, "
	write (u, "(A)") " non-coll., keeping energy"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = [0.5_default, 0.5_default, 0.25_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
	call sf_int%pacify_momenta (1e-10_default)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true.)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "r =", r

	write (u, "(A)")
	write (u, "(A)") "* Evaluate ISR structure function"
	write (u, "(A)")

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
	call sf_int%pacify_momenta (1e-10_default)
	call sf_int%apply (scale = 10._default)
	u_scratch = free_unit ()
	open (u_scratch, status="scratch", action = "readwrite")
	call sf_int%write (u_scratch, testflag = .true.)
	rewind (u_scratch)
	do
	read (u_scratch, "(A)", iostat=iostat) buffer
	if (iostat /= 0) exit
	if (buffer(1:25) == " P = 0.000000E+00 9.57") then
	buffer = replace (buffer, 26, "XXXX")
	end if
	if (buffer(1:25) == " P = 0.000000E+00 -9.57") then
	buffer = replace (buffer, 26, "XXXX")
	end if
	write (u, "(A)") buffer
	end do
	close (u_scratch)

	write (u, "(A)")
	write (u, "(A)") "* Structure-function value"
	write (u, "(A)")

	f_isr = sf_int%get_matrix_element (1)

	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", f_isr
	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", f_isr * f

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_isr_4

	@ %def sf_isr_4
	@
	\subsubsection{Structure function pair with mapping}
	Apply the ISR mapping for a ISR pair.
	structure function.
	<<SF isr: execute tests>>=
	call test (sf_isr_5, "sf_isr_5", &
	"ISR pair mapping", &
	u, results)
	<<SF isr: test declarations>>=
	public :: sf_isr_5
	<<SF isr: tests>>=
	subroutine sf_isr_5 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_mapping_t), allocatable :: mapping
	class(sf_int_t), dimension(:), allocatable :: sf_int
	type(vector4_t), dimension(2) :: k
	real(default) :: E, f_map
	real(default), dimension(:), allocatable :: p, pb, r, rb, x, xb
	real(default), dimension(2) :: f, f_isr
	integer :: i

	write (u, "(A)") "* Test output: sf_isr_5"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv%init (ELECTRON, model)
	pdg_in = ELECTRON

	call reset_interaction_counter ()

	allocate (isr_data_t :: data)
	select type (data)
	type is (isr_data_t)
	call data%init (model, pdg_in, 1./137._default, 500._default, &
	0.000511_default, order = 3, recoil = .false.)
	end select

	allocate (sf_ip_mapping_t :: mapping)
	select type (mapping)
	type is (sf_ip_mapping_t)
	select type (data)
	type is (isr_data_t)
	call mapping%init (eps = data%get_eps ())
	end select
	call mapping%set_index (1, 1)
	call mapping%set_index (2, 2)
	end select

	call mapping%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	allocate (isr_t :: sf_int (2))

	do i = 1, 2
	call sf_int(i)%init (data)
	call sf_int(i)%set_beam_index ([i])
	end do

	write (u, "(A)") "* Initialize incoming momenta with E=500"
	write (u, "(A)")
	E = 500
	k(1) = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	k(2) = vector4_moving (E, - sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	do i = 1, 2
	call vector4_write (k(i), u)
	call sf_int(i)%seed_kinematics (k(i:i))
	end do

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for p=[0.7,0.4], collinear"
	write (u, "(A)")

	allocate (p (2 * data%get_n_par ()))
	allocate (pb(size (p)))
	allocate (r (size (p)))
	allocate (rb(size (p)))
	allocate (x (size (p)))
	allocate (xb(size (p)))

	p = [0.7_default, 0.4_default]
	pb= 1 - p
	call mapping%compute (r, rb, f_map, p, pb)

	write (u, "(A,9(1x," // FMT_12 // "))") "p =", p
	write (u, "(A,9(1x," // FMT_12 // "))") "pb=", pb
	write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
	write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
	write (u, "(A,9(1x," // FMT_12 // "))") "fm=", f_map

	do i = 1, 2
	call sf_int(i)%complete_kinematics (x(i:i), xb(i:i), f(i), r(i:i), rb(i:i), &
	map=.false.)
	end do

	write (u, "(A)")
	write (u, "(A,9(1x," // FMT_12 // "))") "x =", x
	write (u, "(A,9(1x," // FMT_12 // "))") "xb=", xb
	write (u, "(A,9(1x," // FMT_12 // "))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Invert kinematics"
	write (u, "(A)")

	do i = 1, 2
	call sf_int(i)%inverse_kinematics (x(i:i), xb(i:i), f(i), r(i:i), rb(i:i), &
	map=.false.)
	end do
	call mapping%inverse (r, rb, f_map, p, pb)

	write (u, "(A,9(1x," // FMT_12 // "))") "p =", p
	write (u, "(A,9(1x," // FMT_12 // "))") "pb=", pb
	write (u, "(A,9(1x," // FMT_12 // "))") "r =", r
	write (u, "(A,9(1x," // FMT_12 // "))") "rb=", rb
	write (u, "(A,9(1x," // FMT_12 // "))") "fm=", f_map

	write (u, "(A)")
	write (u, "(A)") "* Evaluate ISR structure function"

	call sf_int(1)%apply (scale = 100._default)
	call sf_int(2)%apply (scale = 100._default)

	write (u, "(A)")
	write (u, "(A)") "* Structure function #1"
	write (u, "(A)")
	call sf_int(1)%write (u, testflag = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Structure function #2"
	write (u, "(A)")
	call sf_int(2)%write (u, testflag = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Structure-function value, default order"
	write (u, "(A)")

	do i = 1, 2
	f_isr(i) = sf_int(i)%get_matrix_element (1)
	end do

	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr =", &
	product (f_isr)
	write (u, "(A,9(1x," // FMT_12 // "))") "f_isr * f_map =", &
	product (f_isr * f) * f_map

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

	do i = 1, 2
	call sf_int(i)%final ()
	end do
	call model%final ()

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

	end subroutine sf_isr_5

	@ %def sf_isr_5
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{EPA}

	<<[[sf_epa.f90]]>>=
	<<File header>>

	module sf_epa

	<<Use kinds>>
	<<Use strings>>
	use lorentz
	use pdg_arrays
	use model_data
	use flavors
	use quantum_numbers
	use state_matrices
	use polarizations
	use interactions
	use sf_aux
	use sf_base

	<<Standard module head>>

	<<SF epa: public>>

	<<SF epa: parameters>>

	<<SF epa: types>>

	interface
	<<SF epa: sub interfaces>>
	end interface

	contains

	<<SF epa: main procedures>>

	end module sf_epa
	@ %def sf_epa
	@
	<<[[sf_epa_sub.f90]]>>=
	<<File header>>

	submodule (sf_epa) sf_epa_s

	use io_units
	use constants, only: pi
	use format_defs, only: FMT_17, FMT_19
	use numeric_utils
	use diagnostics
	use physics_defs, only: PHOTON
	use colors

	implicit none

	contains

	<<SF epa: procedures>>

	end submodule sf_epa_s

	@ %def sf_epa_s
	@
	\subsection{Physics}
	The EPA structure function for a photon inside an (elementary)
	particle $p$ with energy $E$, mass $m$ and charge $q_p$ (e.g.,
	electron) is given by ($\bar x \equiv 1-x$)

	There are several variants of the EPA, which are steered by the
	[[\$epa\_mode]] switch. The formula (6.17b) from the report by Budnev
	et al. is given by
	%% %\cite{Budnev:1974de}
	%% \bibitem{Budnev:1974de}
	%% V.~M.~Budnev, I.~F.~Ginzburg, G.~V.~Meledin and V.~G.~Serbo,
	%% %``The Two photon particle production mechanism. Physical problems.
	%% %Applications. Equivalent photon approximation,''
	%% Phys.\ Rept.\ {\bf 15} (1974) 181.
	%% %%CITATION = PRPLC,15,181;%%
	\begin{multline}
	\label{EPA_617}
	f(x) =
	\frac{\alpha}{\pi}\,q_p^2\,
	\frac{1}{x}\,
	\biggl[\left(\bar x + \frac{x^2}{2}\right)
	\ln\frac{Q^2_{\rm max}}{Q^2_{\rm min}}
	\\
	- \left(1 - \frac{x}{2}\right)^2
	\ln\frac{x^2+\frac{Q^2_{\rm max}}{E^2}}
	{x^2+\frac{Q^2_{\rm min}}{E^2}}
	- x^2\frac{m^2}{Q^2_{\rm min}}
	\left(1 - \frac{Q^2_{\rm min}}{Q^2_{\rm max}}\right)
	\biggr].
	\end{multline}
	If no explicit $Q$ bounds are provided, the kinematical bounds are
	\begin{align}
	-Q^2_{\rm max} &= t_0 = -2\bar x(E^2+p\bar p) + 2m^2 \approx -4\bar x E^2,
	\\
	-Q^2_{\rm min} &= t_1 = -2\bar x(E^2-p\bar p) + 2m^2
	\approx
	-\frac{x^2}{\bar x}m^2.
	\end{align}

	The second and third terms in (\ref{EPA_617}) are negative definite (and
	subleading). Noting that $\bar x + x^2/2$ is bounded between
	$1/2$ and $1$, we derive that $f(x)$ is always smaller than
	\begin{equation}
	\bar f(x) = \frac{\alpha}{\pi}\,q_p^2\,\frac{L - 2\ln x}{x}
	\qquad\text{where}\qquad
	L = \ln\frac{\min(4E_{\rm max}^2,Q^2_{\rm max})}{\max(m^2,Q_{\rm min}^2)},
	\end{equation}
	where we allow for explicit $Q$ bounds that narrow the kinematical range.
	Therefore, we generate this distribution:
	\begin{equation}\label{EPA-subst}
	\int_{x_0}^{x_1} dx\,\bar f(x) = C(x_0,x_1)\int_0^1 dx'
	\end{equation}
	We set
	\begin{equation}\label{EPA-x(x')}
	\ln x = \frac12\left\{ L - \sqrt{L^2 - 4\left[ x'\ln x_1(L-\ln x_1)
	+ \bar x'\ln x_0(L-\ln x_0) \right]} \right\}
	\end{equation}
	such that $x(0)=x_0$ and $x(1)=x_1$ and
	\begin{equation}
	\frac{dx}{dx'} = \left(\frac{\alpha}{\pi} q_p^2 \right)^{-1}
	x\frac{C(x_0,x_1)}{L - 2\ln x}
	\end{equation}
	with
	\begin{equation}
	C(x_0,x_1) = \frac{\alpha}{\pi} q_p^2\,\left[\ln x_1(L-\ln x_1) - \ln
	x_0(L-\ln x_0)\right]
	\end{equation}
	such that (\ref{EPA-subst}) is satisfied. Finally, we have
	\begin{equation}
	\int_{x_0}^{x_1} dx\,f(x) = C(x_0,x_1)\int_0^1 dx'\,
	\frac{f(x(x'))}{\bar f(x(x'))}
	\end{equation}
	where $x'$ is calculated from $x$ via (\ref{EPA-x(x')}).

	The structure of the mapping is most obvious from:
	\begin{equation}
	x'(x) = \frac{\log x ( L - \log x) - \log x_0 (L - \log x_0)}
	{\log x_1 ( L - \log x_1) - \log x_0 (L - \log x_0)} \; .
	\end{equation}

	Taking the Eq. (6.16e) from the Budnev et al. report, and integrating
	it over $q^2$ yields the modified result
	\begin{equation}
	\label{EPA_616e}
	f(x) =
	\frac{\alpha}{\pi}\,q_p^2\,
	\frac{1}{x}\,
	\biggl[\left(\bar x + \frac{x^2}{2}\right)
	\ln\frac{Q^2_{\rm max}}{Q^2_{\rm min}}
	- x^2\frac{m^2}{Q^2_{\rm min}}
	\left(1 - \frac{Q^2_{\rm min}}{Q^2_{\rm max}}\right)
	\biggr].
	\end{equation}
	This is closer to many standard papers from LEP times, and to textbook
	formulae like e.g. in Peskin/Schroeder. For historical reasons, we
	keep Eq.~(\ref{EPA_617}) as the default in \whizard.


	\subsection{The EPA data block}
	The EPA parameters are: $\alpha$, $E_{\rm max}$, $m$, $Q_{\rm min}$, and
	$x_{\rm min}$. Instead of $m$ we can use the incoming particle PDG
	code as input; from this we can deduce the mass and charge.

	Internally we store in addition $C_{0/1} = \frac{\alpha}{\pi}q_e^2\ln
	x_{0/1} (L - \ln x_{0/1})$, the c.m. energy squared and the incoming
	particle mass.
	<<SF epa: public>>=
	public :: EPA_MODE_DEFAULT
	public :: EPA_MODE_BUDNEV_617
	public :: EPA_MODE_BUDNEV_616E
	public :: EPA_MODE_LOG_POWER
	public :: EPA_MODE_LOG_SIMPLE
	public :: EPA_MODE_LOG
	<<SF epa: parameters>>=
	integer, parameter :: EPA_MODE_DEFAULT = 0
	integer, parameter :: EPA_MODE_BUDNEV_617 = 0
	integer, parameter :: EPA_MODE_BUDNEV_616E = 1
	integer, parameter :: EPA_MODE_LOG_POWER = 2
	integer, parameter :: EPA_MODE_LOG_SIMPLE = 3
	integer, parameter :: EPA_MODE_LOG = 4

	@ %def EPA_MODE_DEFAULT EPA_MODE_BUDNEV_617 EPA_MODE_BUDNEV_616E
	@ %def EPA_MODE_LOG_POWER EPA_MODE_LOG_SIMPLE EPA_MODE_LOG
	@
	<<SF epa: public>>=
	public :: epa_data_t
	<<SF epa: types>>=
	type, extends(sf_data_t) :: epa_data_t
	private
	class(model_data_t), pointer :: model => null ()
	type(flavor_t), dimension(:), allocatable :: flv_in
	real(default) :: alpha
	real(default) :: x_min
	real(default) :: x_max
	real(default) :: q_min
	real(default) :: q_max
	real(default) :: E_max
	real(default) :: mass
	real(default) :: log
	real(default) :: a
	real(default) :: c0
	real(default) :: c1
	real(default) :: dc
	integer :: mode = EPA_MODE_DEFAULT
	integer :: error = NONE
	logical :: recoil = .false.
	logical :: keep_energy = .true.
	contains
	<<SF epa: epa data: TBP>>
	end type epa_data_t

	@ %def epa_data_t
	@ Error codes
	<<SF epa: parameters>>=
	integer, parameter :: NONE = 0
	integer, parameter :: ZERO_QMIN = 1
	integer, parameter :: Q_MAX_TOO_SMALL = 2
	integer, parameter :: ZERO_XMIN = 3
	integer, parameter :: MASS_MIX = 4
	integer, parameter :: NO_EPA = 5
	<<SF epa: epa data: TBP>>=
	procedure :: init => epa_data_init
	<<SF epa: sub interfaces>>=
	module subroutine epa_data_init (data, model, mode, pdg_in, alpha, &
	x_min, q_min, q_max, mass, recoil, keep_energy)
	class(epa_data_t), intent(inout) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	integer, intent(in) :: mode
	real(default), intent(in) :: alpha, x_min, q_min, q_max
	real(default), intent(in), optional :: mass
	logical, intent(in), optional :: recoil
	logical, intent(in), optional :: keep_energy
	end subroutine epa_data_init
	<<SF epa: procedures>>=
	module subroutine epa_data_init (data, model, mode, pdg_in, alpha, &
	x_min, q_min, q_max, mass, recoil, keep_energy)
	class(epa_data_t), intent(inout) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	integer, intent(in) :: mode
	real(default), intent(in) :: alpha, x_min, q_min, q_max
	real(default), intent(in), optional :: mass
	logical, intent(in), optional :: recoil
	logical, intent(in), optional :: keep_energy
	integer :: n_flv, i
	data%model => model
	data%mode = mode
	n_flv = pdg_in%get_length ()
	allocate (data%flv_in (n_flv))
	do i = 1, n_flv
	call data%flv_in(i)%init (pdg_in%get (i), model)
	end do
	data%alpha = alpha
	data%E_max = q_max / 2
	data%x_min = x_min
	data%x_max = 1
	if (vanishes (data%x_min)) then
	data%error = ZERO_XMIN; return
	end if
	data%q_min = q_min
	data%q_max = q_max
	select case (char (data%model%get_name ()))
	case ("QCD","Test")
	data%error = NO_EPA; return
	end select
	if (present (recoil)) then
	data%recoil = recoil
	end if
	if (present (keep_energy)) then
	data%keep_energy = keep_energy
	end if
	if (present (mass)) then
	data%mass = mass
	else
	data%mass = data%flv_in(1)%get_mass ()
	if (any (data%flv_in%get_mass () /= data%mass)) then
	data%error = MASS_MIX; return
	end if
	end if
	if (max (data%mass, data%q_min) == 0) then
	data%error = ZERO_QMIN; return
	else if (max (data%mass, data%q_min) >= data%E_max) then
	data%error = Q_MAX_TOO_SMALL; return
	end if
	data%log = log ((data%q_max / max (data%mass, data%q_min)) ** 2 )
	data%a = data%alpha / pi
	data%c0 = log (data%x_min) * (data%log - log (data%x_min))
	data%c1 = log (data%x_max) * (data%log - log (data%x_max))
	data%dc = data%c1 - data%c0
	end subroutine epa_data_init

	@ %def epa_data_init
	@ Handle error conditions. Should always be done after
	initialization, unless we are sure everything is ok.
	<<SF epa: epa data: TBP>>=
	procedure :: check => epa_data_check
	<<SF epa: sub interfaces>>=
	module subroutine epa_data_check (data)
	class(epa_data_t), intent(in) :: data
	end subroutine epa_data_check
	<<SF epa: procedures>>=
	module subroutine epa_data_check (data)
	class(epa_data_t), intent(in) :: data
	select case (data%error)
	case (NO_EPA)
	call msg_fatal ("EPA structure function not available for model " &
	// char (data%model%get_name ()) // ".")
	case (ZERO_QMIN)
	call msg_fatal ("EPA: Particle mass is zero")
	case (Q_MAX_TOO_SMALL)
	call msg_fatal ("EPA: Particle mass exceeds Qmax")
	case (ZERO_XMIN)
	call msg_fatal ("EPA: x_min must be larger than zero")
	case (MASS_MIX)
	call msg_fatal ("EPA: incoming particle masses must be uniform")
	end select
	end subroutine epa_data_check

	@ %def epa_data_check
	@ Output
	<<SF epa: epa data: TBP>>=
	procedure :: write => epa_data_write
	<<SF epa: sub interfaces>>=
	module subroutine epa_data_write (data, unit, verbose)
	class(epa_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine epa_data_write
	<<SF epa: procedures>>=
	module subroutine epa_data_write (data, unit, verbose)
	class(epa_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "EPA data:"
	if (allocated (data%flv_in)) then
	write (u, "(3x,A)", advance="no") " flavor = "
	do i = 1, size (data%flv_in)
	if (i > 1) write (u, "(',',1x)", advance="no")
	call data%flv_in(i)%write (u)
	end do
	write (u, *)
	write (u, "(3x,A," // FMT_19 // ")") " alpha = ", data%alpha
	write (u, "(3x,A," // FMT_19 // ")") " x_min = ", data%x_min
	write (u, "(3x,A," // FMT_19 // ")") " x_max = ", data%x_max
	write (u, "(3x,A," // FMT_19 // ")") " q_min = ", data%q_min
	write (u, "(3x,A," // FMT_19 // ")") " q_max = ", data%q_max
	write (u, "(3x,A," // FMT_19 // ")") " E_max = ", data%e_max
	write (u, "(3x,A," // FMT_19 // ")") " mass = ", data%mass
	write (u, "(3x,A," // FMT_19 // ")") " a = ", data%a
	write (u, "(3x,A," // FMT_19 // ")") " c0 = ", data%c0
	write (u, "(3x,A," // FMT_19 // ")") " c1 = ", data%c1
	write (u, "(3x,A," // FMT_19 // ")") " log = ", data%log
	write (u, "(3x,A,L2)") " recoil = ", data%recoil
	write (u, "(3x,A,L2)") " keep en. = ", data%keep_energy
	else
	write (u, "(3x,A)") "[undefined]"
	end if
	end subroutine epa_data_write

	@ %def epa_data_write
	@ The number of kinematic parameters.
	<<SF epa: epa data: TBP>>=
	procedure :: get_n_par => epa_data_get_n_par
	<<SF epa: sub interfaces>>=
	module function epa_data_get_n_par (data) result (n)
	class(epa_data_t), intent(in) :: data
	integer :: n
	end function epa_data_get_n_par
	<<SF epa: procedures>>=
	module function epa_data_get_n_par (data) result (n)
	class(epa_data_t), intent(in) :: data
	integer :: n
	if (data%recoil) then
	n = 3
	else
	n = 1
	end if
	end function epa_data_get_n_par

	@ %def epa_data_get_n_par
	@ Return the outgoing particles PDG codes. The outgoing particle is always
	the photon while the radiated particle is identical to the incoming one.
	<<SF epa: epa data: TBP>>=
	procedure :: get_pdg_out => epa_data_get_pdg_out
	<<SF epa: sub interfaces>>=
	module subroutine epa_data_get_pdg_out (data, pdg_out)
	class(epa_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	end subroutine epa_data_get_pdg_out
	<<SF epa: procedures>>=
	module subroutine epa_data_get_pdg_out (data, pdg_out)
	class(epa_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	pdg_out(1) = PHOTON
	end subroutine epa_data_get_pdg_out

	@ %def epa_data_get_pdg_out
	@ Allocate the interaction record. Gfortran 7/8/9 bug, has to remain
	in module.
	<<SF epa: epa data: TBP>>=
	procedure :: allocate_sf_int => epa_data_allocate_sf_int
	<<SF epa: main procedures>>=
	subroutine epa_data_allocate_sf_int (data, sf_int)
	class(epa_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (epa_t :: sf_int)
	end subroutine epa_data_allocate_sf_int

	@ %def epa_data_allocate_sf_int
	@
	\subsection{The EPA object}
	The [[epa_t]] data type is a $1\to 2$ interaction. We should be able
	to handle several flavors in parallel, since EPA is not necessarily
	applied immediately after beam collision: Photons may be radiated
	from quarks. In that case, the partons are massless and $q_{\rm min}$
	applies instead, so we do not need to generate several kinematical
	configurations in parallel.

	The squared charge values multiply the matrix elements, depending on the
	flavour. We scan the interaction after building it, so we have the correct
	assignments.

	The particles are ordered as (incoming, radiated, photon), where the
	photon initiates the hard interaction.

	We generate an unpolarized photon and transfer initial polarization to
	the radiated parton. Color is transferred in the same way.
	<<SF epa: types>>=
	type, extends (sf_int_t) :: epa_t
	type(epa_data_t), pointer :: data => null ()
	real(default) :: x = 0
	real(default) :: xb = 0
	real(default) :: E = 0
	real(default), dimension(:), allocatable :: charge2
	contains
	<<SF epa: epa: TBP>>
	end type epa_t

	@ %def epa_t
	@ Type string: has to be here, but there is no string variable on which EPA
	depends. Hence, a dummy routine.
	<<SF epa: epa: TBP>>=
	procedure :: type_string => epa_type_string
	<<SF epa: sub interfaces>>=
	module function epa_type_string (object) result (string)
	class(epa_t), intent(in) :: object
	type(string_t) :: string
	end function epa_type_string
	<<SF epa: procedures>>=
	module function epa_type_string (object) result (string)
	class(epa_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "EPA: equivalent photon approx."
	else
	string = "EPA: [undefined]"
	end if
	end function epa_type_string

	@ %def epa_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF epa: epa: TBP>>=
	procedure :: write => epa_write
	<<SF epa: sub interfaces>>=
	module subroutine epa_write (object, unit, testflag)
	class(epa_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine epa_write
	<<SF epa: procedures>>=
	module subroutine epa_write (object, unit, testflag)
	class(epa_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	if (object%status >= SF_DONE_KINEMATICS) then
	write (u, "(1x,A)") "SF parameters:"
	write (u, "(3x,A," // FMT_17 // ")") "x =", object%x
	if (object%status >= SF_FAILED_EVALUATION) then
	write (u, "(3x,A," // FMT_17 // ")") "E =", object%E
	end if
	end if
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "EPA data: [undefined]"
	end if
	end subroutine epa_write

	@ %def epa_write
	@ Prepare the interaction object. We have to construct transition matrix
	elements for all flavor and helicity combinations.
	<<SF epa: epa: TBP>>=
	procedure :: init => epa_init
	<<SF epa: sub interfaces>>=
	module subroutine epa_init (sf_int, data)
	class(epa_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	end subroutine epa_init
	<<SF epa: procedures>>=
	module subroutine epa_init (sf_int, data)
	class(epa_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(3) :: mask
	integer, dimension(3) :: hel_lock
	type(polarization_t), target :: pol
	type(quantum_numbers_t), dimension(1) :: qn_fc
	type(flavor_t) :: flv_photon
	type(color_t) :: col_photon
	type(quantum_numbers_t) :: qn_hel, qn_photon, qn, qn_rad
	type(polarization_iterator_t) :: it_hel
	integer :: i
	mask = quantum_numbers_mask (.false., .false., &
	mask_h = [.false., .false., .true.])
	hel_lock = [2, 1, 0]
	select type (data)
	type is (epa_data_t)
	call sf_int%base_init (mask, [data%mass**2], &
	[data%mass**2], [0._default], hel_lock = hel_lock)
	sf_int%data => data
	call flv_photon%init (PHOTON, data%model)
	call col_photon%init ()
	call qn_photon%init (flv_photon, col_photon)
	do i = 1, size (data%flv_in)
	call pol%init_generic (data%flv_in(i))
	call qn_fc(1)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i), 1))
	call it_hel%init (pol)
	do while (it_hel%is_valid ())
	qn_hel = it_hel%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc(1)
	qn_rad = qn
	call qn_rad%tag_radiated ()
	call sf_int%add_state ([qn, qn_rad, qn_photon])
	call it_hel%advance ()
	end do
	! call pol%final ()
	end do
	call sf_int%freeze ()
	if (data%keep_energy) then
	sf_int%on_shell_mode = KEEP_ENERGY
	else
	sf_int%on_shell_mode = KEEP_MOMENTUM
	end if
	call sf_int%set_incoming ([1])
	call sf_int%set_radiated ([2])
	call sf_int%set_outgoing ([3])
	end select
	end subroutine epa_init

	@ %def epa_init
	@ Prepare the charge array. This is separate from the previous routine since
	the state matrix may be helicity-contracted.
	<<SF epa: epa: TBP>>=
	procedure :: setup_constants => epa_setup_constants
	<<SF epa: sub interfaces>>=
	module subroutine epa_setup_constants (sf_int)
	class(epa_t), intent(inout), target :: sf_int
	end subroutine epa_setup_constants
	<<SF epa: procedures>>=
	module subroutine epa_setup_constants (sf_int)
	class(epa_t), intent(inout), target :: sf_int
	type(state_iterator_t) :: it
	type(flavor_t) :: flv
	integer :: i, n_me
	n_me = sf_int%get_n_matrix_elements ()
	allocate (sf_int%charge2 (n_me))
	call it%init (sf_int%interaction_t%get_state_matrix_ptr ())
	do while (it%is_valid ())
	i = it%get_me_index ()
	flv = it%get_flavor (1)
	sf_int%charge2(i) = flv%get_charge () ** 2
	call it%advance ()
	end do
	sf_int%status = SF_INITIAL
	end subroutine epa_setup_constants

	@ %def epa_setup_constants
	@
	\subsection{Kinematics}
	Set kinematics. If [[map]] is unset, the $r$ and $x$ values
	coincide, and the Jacobian $f(r)$ is trivial.

	The EPA structure function allows for a straightforward mapping of the
	unit interval. The $x$ value is transformed, and the mapped structure
	function becomes unity at its upper boundary.

	The structure function implementation applies the above mapping to the
	input (random) number [[r]] to generate the momentum fraction [[x]]
	and the function value [[f]]. For numerical stability reasons, we
	also output [[xb]], which is $\bar x=1-x$.
	<<SF epa: epa: TBP>>=
	procedure :: complete_kinematics => epa_complete_kinematics
	<<SF epa: sub interfaces>>=
	module subroutine epa_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(epa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	end subroutine epa_complete_kinematics
	<<SF epa: procedures>>=
	module subroutine epa_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(epa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	real(default) :: delta, sqrt_delta, lx
	if (map) then
	associate (data => sf_int%data)
	delta = data%log ** 2 - 4 * (r(1) * data%c1 + rb(1) * data%c0)
	if (delta > 0) then
	sqrt_delta = sqrt (delta)
	lx = (data%log - sqrt_delta) / 2
	else
	sf_int%status = SF_FAILED_KINEMATICS
	f = 0
	return
	end if
	x(1) = exp (lx)
	f = x(1) * data%dc / sqrt_delta
	end associate
	else
	x(1) = r(1)
	if (sf_int%data%x_min < x(1) .and. x(1) < sf_int%data%x_max) then
	f = 1
	else
	sf_int%status = SF_FAILED_KINEMATICS
	f = 0
	return
	end if
	end if
	xb(1) = 1 - x(1)
	if (size(x) == 3) then
	x(2:3) = r(2:3)
	xb(2:3) = rb(2:3)
	end if
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_DONE_KINEMATICS)
	sf_int%x = x(1)
	sf_int%xb= xb(1)
	sf_int%E = energy (sf_int%get_momentum (1))
	case (SF_FAILED_KINEMATICS)
	sf_int%x = 0
	sf_int%xb= 0
	f = 0
	end select
	end subroutine epa_complete_kinematics

	@ %def epa_complete_kinematics
	@ Overriding the default method: we compute the [[x]] array from the
	momentum configuration. In the specific case of EPA, we also set the
	internally stored $x$ and $\bar x$ values, so they can be used in the
	following routine.

	Note: the extraction of $\bar x$ is not numerically safe, but it cannot
	be as long as the base [[recover_x]] is not.
	<<SF epa: epa: TBP>>=
	procedure :: recover_x => sf_epa_recover_x
	<<SF epa: sub interfaces>>=
	module subroutine sf_epa_recover_x (sf_int, x, xb, x_free)
	class(epa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_epa_recover_x
	<<SF epa: procedures>>=
	module subroutine sf_epa_recover_x (sf_int, x, xb, x_free)
	class(epa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	call sf_int%base_recover_x (x, xb, x_free)
	sf_int%x = x(1)
	sf_int%xb = xb(1)
	end subroutine sf_epa_recover_x

	@ %def sf_epa_recover_x
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF epa: epa: TBP>>=
	procedure :: inverse_kinematics => epa_inverse_kinematics
	<<SF epa: sub interfaces>>=
	module subroutine epa_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(epa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	end subroutine epa_inverse_kinematics
	<<SF epa: procedures>>=
	module subroutine epa_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(epa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	real(default) :: lx, delta, sqrt_delta, c
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	associate (data => sf_int%data)
	lx = log (x(1))
	sqrt_delta = data%log - 2 * lx
	delta = sqrt_delta ** 2
	c = (data%log ** 2 - delta) / 4
	r (1) = (c - data%c0) / data%dc
	rb(1) = (data%c1 - c) / data%dc
	f = x(1) * data%dc / sqrt_delta
	end associate
	else
	r (1) = x(1)
	rb(1) = xb(1)
	if (sf_int%data%x_min < x(1) .and. x(1) < sf_int%data%x_max) then
	f = 1
	else
	f = 0
	end if
	end if
	if (size(r) == 3) then
	r (2:3) = x(2:3)
	rb(2:3) = xb(2:3)
	end if
	if (set_mom) then
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	sf_int%E = energy (sf_int%get_momentum (1))
	end subroutine epa_inverse_kinematics

	@ %def epa_inverse_kinematics
	@
	\subsection{EPA application}
	For EPA, we can in principle compute kinematics and function value in
	a single step. In order to be able to reweight events, kinematics and
	structure function application are separated. This function works on a
	single beam, assuming that the input momentum has been set. We need
	three random numbers as input: one for $x$, and two for the polar and
	azimuthal angles. Alternatively, for the no-recoil case, we can skip
	$p_T$ generation; in this case, we only need one.

	For obtaining splitting kinematics, we rely on the assumption that all
	in-particles are mass-degenerate (or there is only one), so the
	generated $x$ values are identical.

	Fix 2020-03-10: Divide by two if there is polarization.
	In the polarized case, the outgoing electron/positron
	retains the incoming polarization. The latter is summed over
	when convoluting with the beam, but there are still two
	states with different outgoing polarization but identical
	structure-function value. This leads to double-counting for the
	overall cross section.

	Fix 2022-02-18: The above fix was wrong! The structure function was divided
	by 4 because there are four entries in the complete electron density
	matrix. Now it is divided by 2 if there is more than one entry, unchanged
	otherwise.
	<<SF epa: epa: TBP>>=
	procedure :: apply => epa_apply
	<<SF epa: sub interfaces>>=
	module subroutine epa_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(epa_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	end subroutine epa_apply
	<<SF epa: procedures>>=
	module subroutine epa_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(epa_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	real(default) :: x, xb, qminsq, qmaxsq, f, E, m2
	associate (data => sf_int%data)
	x = sf_int%x
	xb= sf_int%xb
	E = sf_int%E
	m2 = data%mass ** 2
	qminsq = max (x ** 2 / xb * data%mass 2, data%q_min 2)
	select case (data%mode)
	case (0)
	qmaxsq = min (4 * xb * E 2, data%q_max 2)
	if (qminsq < qmaxsq) then
	f = data%a / x &
	* ((xb + x ** 2 / 2) * log (qmaxsq / qminsq) &
	- (1 - x / 2) ** 2 &
	* log ((x2 + qmaxsq / E 2) / (x2 + qminsq / E 2)) &
	- x ** 2 * data%mass ** 2 / qminsq * (1 - qminsq / qmaxsq))
	else
	f = 0
	end if
	case (1)
	qmaxsq = min (4 * xb * E 2, data%q_max 2)
	if (qminsq < qmaxsq) then
	f = data%a / x &
	* ((xb + x ** 2 / 2) * log (qmaxsq / qminsq) &
	- x ** 2 * data%mass ** 2 / qminsq * (1 - qminsq / qmaxsq))
	else
	f = 0
	end if
	case (2)
	qmaxsq = data%q_max ** 2
	if (data%mass ** 2 < qmaxsq) then
	f = data%a / x &
	* ((xb + x ** 2 / 2) * log (qmaxsq / m2) &
	- x ** 2 * data%mass ** 2 / qminsq * (1 - qminsq / qmaxsq))
	else
	f = 0
	end if
	case (3)
	qmaxsq = data%q_max ** 2
	if (data%mass ** 2 < qmaxsq) then
	f = data%a / x &
	* ((xb + x ** 2 / 2) * log (qmaxsq / m2) &
	- x ** 2 * (1 - m2 / qmaxsq))
	else
	f = 0
	end if
	case (4)
	qmaxsq = data%q_max ** 2
	if (data%mass ** 2 < qmaxsq) then
	f = data%a / x &
	* ((xb + x ** 2 / 2) * log (qmaxsq / m2))
	else
	f = 0
	end if
	end select
	if (sf_int%get_n_matrix_elements () > 1) then
	f = f / 2
	end if
	call sf_int%set_matrix_element &
	(cmplx (f, kind=default) * sf_int%charge2)
	end associate
	sf_int%status = SF_EVALUATED
	end subroutine epa_apply

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

	module sf_epa_ut
	use unit_tests
	use sf_epa_uti

	<<Standard module head>>

	<<SF epa: public test>>

	contains

	<<SF epa: test driver>>

	end module sf_epa_ut
	@ %def sf_epa_ut
	@
	<<[[sf_epa_uti.f90]]>>=
	<<File header>>

	module sf_epa_uti

	<<Use kinds>>
	use physics_defs, only: ELECTRON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use sf_aux
	use sf_base

	use sf_epa

	<<Standard module head>>

	<<SF epa: test declarations>>

	contains

	<<SF epa: tests>>

	end module sf_epa_uti
	@ %def sf_epa_ut
	@ API: driver for the unit tests below.
	<<SF epa: public test>>=
	public :: sf_epa_test
	<<SF epa: test driver>>=
	subroutine sf_epa_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF epa: execute tests>>
	end subroutine sf_epa_test

	@ %def sf_epa_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF epa: execute tests>>=
	call test (sf_epa_1, "sf_epa_1", &
	"structure function configuration", &
	u, results)
	<<SF epa: test declarations>>=
	public :: sf_epa_1
	<<SF epa: tests>>=
	subroutine sf_epa_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_epa_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in = ELECTRON

	allocate (epa_data_t :: data)
	call data%write (u)

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

	select type (data)
	type is (epa_data_t)
	call data%init (model, 0, pdg_in, 1./137._default, 0.01_default, &
	10._default, 100._default, 0.000511_default, recoil = .false.)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	call model%final ()

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

	end subroutine sf_epa_1

	@ %def sf_epa_1
	@
	\subsubsection{Test and probe structure function}
	Construct and display a structure function object based on the EPA
	structure function.
	<<SF epa: execute tests>>=
	call test (sf_epa_2, "sf_epa_2", &
	"structure function instance", &
	u, results)
	<<SF epa: test declarations>>=
	public :: sf_epa_2
	<<SF epa: tests>>=
	subroutine sf_epa_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_epa_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv%init (ELECTRON, model)
	pdg_in = ELECTRON

	call reset_interaction_counter ()

	allocate (epa_data_t :: data)
	select type (data)
	type is (epa_data_t)
	call data%init (model, 0, pdg_in, 1./137._default, 0.01_default, &
	10._default, 100._default, 0.000511_default, recoil = .false.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.4, no EPA mapping, collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.4_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false., &
	set_momenta=.true.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EPA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_epa_2

	@ %def sf_epa_2
	@
	\subsubsection{Standard mapping}
	Construct and display a structure function object based on the EPA
	structure function, applying the standard single-particle mapping.
	<<SF epa: execute tests>>=
	call test (sf_epa_3, "sf_epa_3", &
	"apply mapping", &
	u, results)
	<<SF epa: test declarations>>=
	public :: sf_epa_3
	<<SF epa: tests>>=
	subroutine sf_epa_3 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_epa_3"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv%init (ELECTRON, model)
	pdg_in = ELECTRON

	call reset_interaction_counter ()

	allocate (epa_data_t :: data)
	select type (data)
	type is (epa_data_t)
	call data%init (model, 0, pdg_in, 1./137._default, 0.01_default, &
	10._default, 100._default, 0.000511_default, recoil = .false.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.4, with EPA mapping, collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.4_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
	set_momenta=.true.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EPA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_epa_3

	@ %def sf_epa_3
	@
	\subsubsection{Non-collinear case}
	Construct and display a structure function object based on the EPA
	structure function.
	<<SF epa: execute tests>>=
	call test (sf_epa_4, "sf_epa_4", &
	"non-collinear", &
	u, results)
	<<SF epa: test declarations>>=
	public :: sf_epa_4
	<<SF epa: tests>>=
	subroutine sf_epa_4 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E, m
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_epa_4"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv%init (ELECTRON, model)
	pdg_in = ELECTRON

	call reset_interaction_counter ()

	allocate (epa_data_t :: data)
	select type (data)
	type is (epa_data_t)
	call data%init (model, 0, pdg_in, 1./137._default, 0.01_default, &
	10._default, 100._default, 5.0_default, recoil = .true.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	write (u, "(A)") "* Initialize incoming momentum with E=500, me = 5 GeV"
	write (u, "(A)")
	E = 500
	m = 5
	k = vector4_moving (E, sqrt (E2 - m2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.5/0.5/0.25, with EPA mapping, "
	write (u, "(A)") " non-coll., keeping energy, me = 5 GeV"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = [0.5_default, 0.5_default, 0.25_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
	call sf_int%pacify_momenta (1e-10_default)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
	set_momenta=.true.)
	call sf_int%pacify_momenta (1e-10_default)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EPA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u, testflag = .true.)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_epa_4

	@ %def sf_epa_4
	@
	\subsubsection{Structure function for multiple flavors}
	Construct and display a structure function object based on the EPA
	structure function. The incoming state has multiple particles with
	non-uniform charge.
	<<SF epa: execute tests>>=
	call test (sf_epa_5, "sf_epa_5", &
	"multiple flavors", &
	u, results)
	<<SF epa: test declarations>>=
	public :: sf_epa_5
	<<SF epa: tests>>=
	subroutine sf_epa_5 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_epa_5"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_sm_test ()
	call flv%init (1, model)
	pdg_in = [1, 2, -1, -2]

	call reset_interaction_counter ()

	allocate (epa_data_t :: data)
	select type (data)
	type is (epa_data_t)
	call data%init (model, 0, pdg_in, 1./137._default, 0.01_default, &
	10._default, 100._default, 0.000511_default, recoil = .false.)
	call data%check ()
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.4, no EPA mapping, collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.4_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EPA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_epa_5

	@ %def sf_epa_5
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{EWA}

	<<[[sf_ewa.f90]]>>=
	<<File header>>

	module sf_ewa

	<<Use kinds>>
	<<Use strings>>
	use pdg_arrays
	use model_data
	use flavors
	use quantum_numbers
	use state_matrices
	use polarizations
	use interactions
	use sf_aux
	use sf_base

	<<Standard module head>>

	<<SF ewa: public>>

	<<SF ewa: parameters>>

	<<SF ewa: types>>

	interface
	<<SF ewa: sub interfaces>>
	end interface

	contains

	<<SF ewa: main procedures>>

	end module sf_ewa
	@ %def sf_ewa
	@
	<<[[sf_ewa_sub.f90]]>>=
	<<File header>>

	submodule (sf_ewa) sf_ewa_s

	use io_units
	use constants, only: pi
	use format_defs, only: FMT_17, FMT_19
	use numeric_utils
	use diagnostics
	use physics_defs, only: W_BOSON, Z_BOSON
	use lorentz
	use colors

	implicit none

	contains

	<<SF ewa: procedures>>

	end submodule sf_ewa_s

	@ %def sf_ewa_s
	@
	\subsection{Physics}
	The EWA structure function for a $Z$ or $W$ inside a fermion (lepton
	or quark) depends on the vector-boson polarization. We distinguish
	transversal ($\pm$) and longitudinal ($0$) polarization.
	\begin{align}
	F_{+}(x) &= \frac{1}{16\pi^2}\,\frac{(v-a)^2 + (v+a)^2\bar x^2}{x}
	\left[
	\ln\left(\frac{p_{\perp,\textrm{max}}^2 + \bar x M^2}{\bar x M^2}\right)
	-
	\frac{p_{\perp,\textrm{max}}^2}{p_{\perp,\textrm{max}}^2 + \bar x M^2}
	\right]
	\\
	F_{-}(x) &= \frac{1}{16\pi^2}\,\frac{(v+a)^2 + (v-a)^2\bar x^2}{x}
	\left[
	\ln\left(\frac{p_{\perp,\textrm{max}}^2 + \bar x M^2}{\bar x M^2}\right)
	-
	\frac{p_{\perp,\textrm{max}}^2}{p_{\perp,\textrm{max}}^2 + \bar x M^2}
	\right]
	\\
	F_0(x) &= \frac{v^2+a^2}{8\pi^2}\,\frac{2\bar x}{x}\,
	\frac{p_{\perp,\textrm{max}}^2}{p_{\perp,\textrm{max}}^2 + \bar x M^2}
	\end{align}
	where $p_{\perp,\textrm{max}}$ is the cutoff in transversal momentum, $M$ is
	the vector-boson mass, $v$ and $a$ are the vector and axial-vector
	couplings, and $\bar x\equiv 1-x$. Note that the longitudinal
	structure function is finite for large cutoff, while the transversal
	structure function is logarithmically divergent.

	The maximal transverse momentum is given by the kinematical limit, it is
	\begin{equation}
	p_{\perp,\textrm{max}} = \bar x \sqrt{s}/2.
	\end{equation}
	The vector and axial couplings for a fermion branching into a $W$ are
	\begin{align}
	v_W &= \frac{g}{2\sqrt 2},
	& a_W &= \frac{g}{2\sqrt 2}.
	\end{align}
	For $Z$ emission, this is replaced by
	\begin{align}
	v_Z &= \frac{g}{2\cos\theta_w}\left(t_3 - 2q\sin^2\theta_w\right),
	& a_Z &= \frac{g}{2\cos\theta_w}t_3,
	\end{align}
	where $t_3=\pm\frac12$ is the fermion isospin, and $q$ its charge.

	For an initial antifermion, the signs of the axial couplings are
	inverted. Note that a common sign change of $v$ and $a$ is
	irrelevant.

	%% Differentiating with respect to the cutoff, we get structure functions
	%% \begin{align}
	%% f_{W,\pm}(x,p_T) &= \frac{g^2}{16\pi^2}\,
	%% \frac{1+\bar x^2}{x}
	%% \frac{p_\perp}{p_\perp^2 + \bar x M^2}
	%% \\
	%% f_{W,0}(x,p_T) &= \frac{g^2}{16\pi^2}\,
	%% \frac{2\bar x}{x}\,
	%% \frac{p_\perp \bar xM^2}{(p_\perp^2 + \bar x M^2)^2}
	%% \\
	%% F_{Z,\pm}(x,p_T) &= \frac{g^2}{16\pi^2\cos\theta_w^2}
	%% \left[(t_3^f-2q^2\sin\theta_w^2)^2 + (t_3^f)^2\right]\,
	%% \frac{1+\bar x^2}{x}
	%% \frac{p_\perp}{p_\perp^2 + \bar x M^2}
	%% \\
	%% F_{Z,0}(x,p_T) &= \frac{g^2}{16\pi^2\cos\theta_w^2}\,
	%% \left[(t_3^f-2q^2\sin\theta_w^2)^2 + (t_3^f)^2\right]\,
	%% \frac{2\bar x}{x}\,
	%% \frac{p_\perp \bar xM^2}{(p_\perp^2 + \bar x M^2)^2}
	%% \end{align}
	%% Here, $t_3^f$ is the $SU(2)_L$ quantum number of the fermion
	%% $(\pm\frac12)$, and $q^f$ is the fermion charge in units of the
	%% positron charge.

	The EWA depends on the parameters $g$, $\sin^2\theta_w$, $M_W$, and
	$M_Z$. These can all be taken from the SM input, and the prefactors
	are calculated from those and the incoming particle type.

	Since these structure functions have a $1/x$ singularity (which is not
	really relevant in practice, however, since the vector boson mass is
	finite), we map this singularity allowing for nontrivial $x$ bounds:
	\begin{equation}
	x = \exp(\bar r\ln x_0 + r\ln x_1)
	\end{equation}
	such that
	\begin{equation}
	\int_{x_0}^{x_1}\frac{dx}{x} = (\ln x_1 - \ln x_0)\int_0^1 dr.
	\end{equation}

	As a user parameter, we have the cutoff $p_{\perp,\textrm{max}}$.
	The divergence $1/x$ also requires a $x_0$ cutoff; and for
	completeness we introduce a corresponding $x_1$. Physically, the
	minimal sensible value of $x$ is $M^2/s$, although the approximation
	loses its value already at higher $x$ values.


	\subsection{The EWA data block}
	The EWA parameters are: $p_{T,\rm max}$, $c_V$, $c_A$, and
	$m$. Instead of $m$ we can use the incoming particle PDG code as
	input; from this we can deduce the mass and charges. In the
	initialization phase it is not yet determined whether a $W$ or a $Z$
	is radiated, hence we set the vector and axial-vector couplings equal
	to the common prefactors $g/2 = e/2/\sin\theta_W$.

	In principle, for EWA it would make sense to allow the user to also
	set the upper bound for $x$, $x_{\rm max}$, but we fix it to one here.
	<<SF ewa: public>>=
	public :: ewa_data_t
	<<SF ewa: types>>=
	type, extends(sf_data_t) :: ewa_data_t
	private
	class(model_data_t), pointer :: model => null ()
	type(flavor_t), dimension(:), allocatable :: flv_in
	type(flavor_t), dimension(:), allocatable :: flv_out
	real(default) :: pt_max
	real(default) :: sqrts
	real(default) :: x_min
	real(default) :: x_max
	real(default) :: mass
	real(default) :: m_out
	real(default) :: q_min
	real(default) :: cv
	real(default) :: ca
	real(default) :: costhw
	real(default) :: sinthw
	real(default) :: mW
	real(default) :: mZ
	real(default) :: coeff
	logical :: mass_set = .false.
	logical :: recoil = .false.
	logical :: keep_energy = .false.
	integer :: id = 0
	integer :: error = NONE
	contains
	<<SF ewa: ewa data: TBP>>
	end type ewa_data_t

	@ %def ewa_data_t
	@ Error codes
	<<SF ewa: parameters>>=
	integer, parameter :: NONE = 0
	integer, parameter :: ZERO_QMIN = 1
	integer, parameter :: Q_MAX_TOO_SMALL = 2
	integer, parameter :: ZERO_XMIN = 3
	integer, parameter :: MASS_MIX = 4
	integer, parameter :: ZERO_SW = 5
	integer, parameter :: ISOSPIN_MIX = 6
	integer, parameter :: WRONG_PRT = 7
	integer, parameter :: MASS_MIX_OUT = 8
	integer, parameter :: NO_EWA = 9
	<<SF ewa: ewa data: TBP>>=
	procedure :: init => ewa_data_init
	<<SF ewa: sub interfaces>>=
	module subroutine ewa_data_init (data, model, pdg_in, x_min, pt_max, &
	sqrts, recoil, keep_energy, mass)
	class(ewa_data_t), intent(inout) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	real(default), intent(in) :: x_min, pt_max, sqrts
	logical, intent(in) :: recoil, keep_energy
	real(default), intent(in), optional :: mass
	end subroutine ewa_data_init
	<<SF ewa: procedures>>=
	module subroutine ewa_data_init (data, model, pdg_in, x_min, pt_max, &
	sqrts, recoil, keep_energy, mass)
	class(ewa_data_t), intent(inout) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	real(default), intent(in) :: x_min, pt_max, sqrts
	logical, intent(in) :: recoil, keep_energy
	real(default), intent(in), optional :: mass
	real(default) :: g, ee
	integer :: n_flv, i
	data%model => model
	if (.not. any (pdg_in .match. &
	[1,2,3,4,5,6,11,13,15,-1,-2,-3,-4,-5,-6,-11,-13,-15])) then
	data%error = WRONG_PRT; return
	end if
	n_flv = pdg_in%get_length ()
	allocate (data%flv_in (n_flv))
	allocate (data%flv_out(n_flv))
	do i = 1, n_flv
	call data%flv_in(i)%init (pdg_in%get (i), model)
	end do
	data%pt_max = pt_max
	data%sqrts = sqrts
	data%x_min = x_min
	data%x_max = 1
	if (vanishes (data%x_min)) then
	data%error = ZERO_XMIN; return
	end if
	select case (char (data%model%get_name ()))
	case ("QCD","QED","Test")
	data%error = NO_EWA; return
	end select
	ee = data%model%get_real (var_str ("ee"))
	data%sinthw = data%model%get_real (var_str ("sw"))
	data%costhw = data%model%get_real (var_str ("cw"))
	data%mZ = data%model%get_real (var_str ("mZ"))
	data%mW = data%model%get_real (var_str ("mW"))
	if (data%sinthw /= 0) then
	g = ee / data%sinthw
	else
	data%error = ZERO_SW; return
	end if
	data%cv = g / 2._default
	data%ca = g / 2._default
	data%coeff = 1._default / (8._default * PI**2)
	data%recoil = recoil
	data%keep_energy = keep_energy
	if (present (mass)) then
	data%mass = mass
	data%m_out = mass
	data%mass_set = .true.
	else
	data%mass = data%flv_in(1)%get_mass ()
	if (any (data%flv_in%get_mass () /= data%mass)) then
	data%error = MASS_MIX; return
	end if
	end if
	end subroutine ewa_data_init

	@ %def ewa_data_init
	@ Set the vector boson ID for distinguishing $W$ and $Z$ bosons.
	<<SF ewa: ewa data: TBP>>=
	procedure :: set_id => ewa_set_id
	<<SF ewa: sub interfaces>>=
	module subroutine ewa_set_id (data, id)
	class(ewa_data_t), intent(inout) :: data
	integer, intent(in) :: id
	end subroutine ewa_set_id
	<<SF ewa: procedures>>=
	module subroutine ewa_set_id (data, id)
	class(ewa_data_t), intent(inout) :: data
	integer, intent(in) :: id
	integer :: i, isospin, pdg
	if (.not. allocated (data%flv_in)) &
	call msg_bug ("EWA: incoming particles not set")
	data%id = id
	select case (data%id)
	case (23)
	data%m_out = data%mass
	data%flv_out = data%flv_in
	case (24)
	do i = 1, size (data%flv_in)
	pdg = data%flv_in(i)%get_pdg ()
	isospin = data%flv_in(i)%get_isospin_type ()
	if (isospin > 0) then
	!!! up-type quark or neutrinos
	if (data%flv_in(i)%is_antiparticle ()) then
	call data%flv_out(i)%init (pdg + 1, data%model)
	else
	call data%flv_out(i)%init (pdg - 1, data%model)
	end if
	else
	!!! down-type quark or lepton
	if (data%flv_in(i)%is_antiparticle ()) then
	call data%flv_out(i)%init (pdg - 1, data%model)
	else
	call data%flv_out(i)%init (pdg + 1, data%model)
	end if
	end if
	end do
	if (.not. data%mass_set) then
	data%m_out = data%flv_out(1)%get_mass ()
	if (any (data%flv_out%get_mass () /= data%m_out)) then
	data%error = MASS_MIX_OUT; return
	end if
	end if
	end select
	end subroutine ewa_set_id

	@ %def ewa_set_id
	@ Handle error conditions. Should always be done after
	initialization, unless we are sure everything is ok.
	<<SF ewa: ewa data: TBP>>=
	procedure :: check => ewa_data_check
	<<SF ewa: sub interfaces>>=
	module subroutine ewa_data_check (data)
	class(ewa_data_t), intent(in) :: data
	end subroutine ewa_data_check
	<<SF ewa: procedures>>=
	module subroutine ewa_data_check (data)
	class(ewa_data_t), intent(in) :: data
	select case (data%error)
	case (WRONG_PRT)
	call msg_fatal ("EWA structure function only accessible for " &
	// "SM quarks and leptons.")
	case (NO_EWA)
	call msg_fatal ("EWA structure function not available for model " &
	// char (data%model%get_name ()))
	case (ZERO_SW)
	call msg_fatal ("EWA: Vanishing value of sin(theta_w)")
	case (ZERO_QMIN)
	call msg_fatal ("EWA: Particle mass is zero")
	case (Q_MAX_TOO_SMALL)
	call msg_fatal ("EWA: Particle mass exceeds Qmax")
	case (ZERO_XMIN)
	call msg_fatal ("EWA: x_min must be larger than zero")
	case (MASS_MIX)
	call msg_fatal ("EWA: incoming particle masses must be uniform")
	case (MASS_MIX_OUT)
	call msg_fatal ("EWA: outgoing particle masses must be uniform")
	case (ISOSPIN_MIX)
	call msg_fatal ("EWA: incoming particle isospins must be uniform")
	end select
	end subroutine ewa_data_check

	@ %def ewa_data_check
	@ Output
	<<SF ewa: ewa data: TBP>>=
	procedure :: write => ewa_data_write
	<<SF ewa: sub interfaces>>=
	module subroutine ewa_data_write (data, unit, verbose)
	class(ewa_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine ewa_data_write
	<<SF ewa: procedures>>=
	module subroutine ewa_data_write (data, unit, verbose)
	class(ewa_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "EWA data:"
	if (allocated (data%flv_in) .and. allocated (data%flv_out)) then
	write (u, "(3x,A)", advance="no") " flavor(in) = "
	do i = 1, size (data%flv_in)
	if (i > 1) write (u, "(',',1x)", advance="no")
	call data%flv_in(i)%write (u)
	end do
	write (u, *)
	write (u, "(3x,A)", advance="no") " flavor(out) = "
	do i = 1, size (data%flv_out)
	if (i > 1) write (u, "(',',1x)", advance="no")
	call data%flv_out(i)%write (u)
	end do
	write (u, *)
	write (u, "(3x,A," // FMT_19 // ")") " x_min = ", data%x_min
	write (u, "(3x,A," // FMT_19 // ")") " x_max = ", data%x_max
	write (u, "(3x,A," // FMT_19 // ")") " pt_max = ", data%pt_max
	write (u, "(3x,A," // FMT_19 // ")") " sqrts = ", data%sqrts
	write (u, "(3x,A," // FMT_19 // ")") " mass = ", data%mass
	write (u, "(3x,A," // FMT_19 // ")") " cv = ", data%cv
	write (u, "(3x,A," // FMT_19 // ")") " ca = ", data%ca
	write (u, "(3x,A," // FMT_19 // ")") " coeff = ", data%coeff
	write (u, "(3x,A," // FMT_19 // ")") " costhw = ", data%costhw
	write (u, "(3x,A," // FMT_19 // ")") " sinthw = ", data%sinthw
	write (u, "(3x,A," // FMT_19 // ")") " mZ = ", data%mZ
	write (u, "(3x,A," // FMT_19 // ")") " mW = ", data%mW
	write (u, "(3x,A,L2)") " recoil = ", data%recoil
	write (u, "(3x,A,L2)") " keep en. = ", data%keep_energy
	write (u, "(3x,A,I2)") " PDG (VB) = ", data%id
	else
	write (u, "(3x,A)") "[undefined]"
	end if
	end subroutine ewa_data_write

	@ %def ewa_data_write
	@ The number of parameters is one for collinear splitting, in case the
	[[recoil]] option is set, we take the recoil into account.
	<<SF ewa: ewa data: TBP>>=
	procedure :: get_n_par => ewa_data_get_n_par
	<<SF ewa: sub interfaces>>=
	module function ewa_data_get_n_par (data) result (n)
	class(ewa_data_t), intent(in) :: data
	integer :: n
	end function ewa_data_get_n_par
	<<SF ewa: procedures>>=
	module function ewa_data_get_n_par (data) result (n)
	class(ewa_data_t), intent(in) :: data
	integer :: n
	if (data%recoil) then
	n = 3
	else
	n = 1
	end if
	end function ewa_data_get_n_par

	@ %def ewa_data_get_n_par
	@ Return the outgoing particles PDG codes. This depends, whether this
	is a charged-current or neutral-current interaction.
	<<SF ewa: ewa data: TBP>>=
	procedure :: get_pdg_out => ewa_data_get_pdg_out
	<<SF ewa: sub interfaces>>=
	module subroutine ewa_data_get_pdg_out (data, pdg_out)
	class(ewa_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	end subroutine ewa_data_get_pdg_out
	<<SF ewa: procedures>>=
	module subroutine ewa_data_get_pdg_out (data, pdg_out)
	class(ewa_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	integer :: i, n_flv
	if (allocated (data%flv_out)) then
	n_flv = size (data%flv_out)
	else
	n_flv = 0
	end if
	allocate (pdg1 (n_flv))
	do i = 1, n_flv
	pdg1(i) = data%flv_out(i)%get_pdg ()
	end do
	pdg_out(1) = pdg1
	end subroutine ewa_data_get_pdg_out

	@ %def ewa_data_get_pdg_out
	@ Allocate the interaction record. Due to a gfortran 7/8/9 bug, this
	has to remain in the main module.
	<<SF ewa: ewa data: TBP>>=
	procedure :: allocate_sf_int => ewa_data_allocate_sf_int
	<<SF ewa: main procedures>>=
	subroutine ewa_data_allocate_sf_int (data, sf_int)
	class(ewa_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (ewa_t :: sf_int)
	end subroutine ewa_data_allocate_sf_int

	@ %def ewa_data_allocate_sf_int
	@
	\subsection{The EWA object}
	The [[ewa_t]] data type is a $1\to 2$ interaction. We should be able
	to handle several flavors in parallel, since EWA is not necessarily
	applied immediately after beam collision: $W/Z$ bosons may be radiated
	from quarks. In that case, the partons are massless and $q_{\rm min}$
	applies instead, so we do not need to generate several kinematical
	configurations in parallel.

	The particles are ordered as (incoming, radiated, W/Z), where the
	W/Z initiates the hard interaction.

	In the case of EPA, we generated an unpolarized photon and transferred
	initial polarization to the radiated parton. Color is transferred in
	the same way. I do not know whether the same can/should be done for
	EWA, as the structure functions depend on the W/Z polarization. If we
	are having $Z$ bosons, both up- and down-type fermions can
	participate. Otherwise, with a $W^+$ an up-type fermion is transferred
	to a down-type fermion, and the other way round.
	<<SF ewa: types>>=
	type, extends (sf_int_t) :: ewa_t
	type(ewa_data_t), pointer :: data => null ()
	real(default) :: x = 0
	real(default) :: xb = 0
	integer :: n_me = 0
	real(default), dimension(:), allocatable :: cv
	real(default), dimension(:), allocatable :: ca
	contains
	<<SF ewa: ewa: TBP>>
	end type ewa_t

	@ %def ewa_t
	@ Type string: has to be here, but there is no string variable on which EWA
	depends. Hence, a dummy routine.
	<<SF ewa: ewa: TBP>>=
	procedure :: type_string => ewa_type_string
	<<SF ewa: sub interfaces>>=
	module function ewa_type_string (object) result (string)
	class(ewa_t), intent(in) :: object
	type(string_t) :: string
	end function ewa_type_string
	<<SF ewa: procedures>>=
	module function ewa_type_string (object) result (string)
	class(ewa_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "EWA: equivalent W/Z approx."
	else
	string = "EWA: [undefined]"
	end if
	end function ewa_type_string

	@ %def ewa_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF ewa: ewa: TBP>>=
	procedure :: write => ewa_write
	<<SF ewa: sub interfaces>>=
	module subroutine ewa_write (object, unit, testflag)
	class(ewa_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine ewa_write
	<<SF ewa: procedures>>=
	module subroutine ewa_write (object, unit, testflag)
	class(ewa_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	if (object%status >= SF_DONE_KINEMATICS) then
	write (u, "(1x,A)") "SF parameters:"
	write (u, "(3x,A," // FMT_17 // ")") "x =", object%x
	write (u, "(3x,A," // FMT_17 // ")") "xb=", object%xb
	end if
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "EWA data: [undefined]"
	end if
	end subroutine ewa_write

	@ %def ewa_write
	@ The current implementation requires uniform isospin for all incoming
	particles, therefore we need to probe only the first one.
	<<SF ewa: ewa: TBP>>=
	procedure :: init => ewa_init
	<<SF ewa: sub interfaces>>=
	module subroutine ewa_init (sf_int, data)
	class(ewa_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	end subroutine ewa_init
	<<SF ewa: procedures>>=
	module subroutine ewa_init (sf_int, data)
	class(ewa_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(3) :: mask
	integer, dimension(3) :: hel_lock
	type(polarization_t), target :: pol
	type(quantum_numbers_t), dimension(1) :: qn_fc, qn_fc_fin
	type(flavor_t) :: flv_z, flv_wp, flv_wm
	type(color_t) :: col0
	type(quantum_numbers_t) :: qn_hel, qn_z, qn_wp, qn_wm, qn, qn_rad, qn_w
	type(polarization_iterator_t) :: it_hel
	integer :: i, isospin
	select type (data)
	type is (ewa_data_t)
	mask = quantum_numbers_mask (.false., .false., &
	mask_h = [.false., .false., .true.])
	hel_lock = [2, 1, 0]
	call col0%init ()
	select case (data%id)
	case (23)
	!!! Z boson, flavor is not changing
	call sf_int%base_init (mask, [data%mass2], [data%mass2], &
	[data%mZ**2], hel_lock = hel_lock)
	sf_int%data => data
	call flv_z%init (Z_BOSON, data%model)
	call qn_z%init (flv_z, col0)
	do i = 1, size (data%flv_in)
	call pol%init_generic (data%flv_in(i))
	call qn_fc(1)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i), 1))
	call it_hel%init (pol)
	do while (it_hel%is_valid ())
	qn_hel = it_hel%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc(1)
	qn_rad = qn
	call qn_rad%tag_radiated ()
	call sf_int%add_state ([qn, qn_rad, qn_z])
	call it_hel%advance ()
	end do
	! call pol%final ()
	end do
	case (24)
	call sf_int%base_init (mask, [data%mass2], [data%m_out2], &
	[data%mW**2], hel_lock = hel_lock)
	sf_int%data => data
	call flv_wp%init (W_BOSON, data%model)
	call flv_wm%init (- W_BOSON, data%model)
	call qn_wp%init (flv_wp, col0)
	call qn_wm%init (flv_wm, col0)
	do i = 1, size (data%flv_in)
	isospin = data%flv_in(i)%get_isospin_type ()
	if (isospin > 0) then
	!!! up-type quark or neutrinos
	if (data%flv_in(i)%is_antiparticle ()) then
	qn_w = qn_wm
	else
	qn_w = qn_wp
	end if
	else
	!!! down-type quark or lepton
	if (data%flv_in(i)%is_antiparticle ()) then
	qn_w = qn_wp
	else
	qn_w = qn_wm
	end if
	end if
	call pol%init_generic (data%flv_in(i))
	call qn_fc(1)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i), 1))
	call qn_fc_fin(1)%init ( &
	flv = data%flv_out(i), &
	col = color_from_flavor (data%flv_out(i), 1))
	call it_hel%init (pol)
	do while (it_hel%is_valid ())
	qn_hel = it_hel%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc(1)
	qn_rad = qn_hel .merge. qn_fc_fin(1)
	call qn_rad%tag_radiated ()
	call sf_int%add_state ([qn, qn_rad, qn_w])
	call it_hel%advance ()
	end do
	! call pol%final ()
	end do
	case default
	call msg_fatal ("EWA initialization failed: wrong particle type.")
	end select
	call sf_int%freeze ()
	if (data%keep_energy) then
	sf_int%on_shell_mode = KEEP_ENERGY
	else
	sf_int%on_shell_mode = KEEP_MOMENTUM
	end if
	call sf_int%set_incoming ([1])
	call sf_int%set_radiated ([2])
	call sf_int%set_outgoing ([3])
	end select
	end subroutine ewa_init

	@ %def ewa_init
	@ Prepare the coupling arrays. This is separate from the previous routine since
	the state matrix may be helicity-contracted.
	<<SF ewa: ewa: TBP>>=
	procedure :: setup_constants => ewa_setup_constants
	<<SF ewa: sub interfaces>>=
	module subroutine ewa_setup_constants (sf_int)
	class(ewa_t), intent(inout), target :: sf_int
	end subroutine ewa_setup_constants
	<<SF ewa: procedures>>=
	module subroutine ewa_setup_constants (sf_int)
	class(ewa_t), intent(inout), target :: sf_int
	type(state_iterator_t) :: it
	type(flavor_t) :: flv
	real(default) :: q, t3
	integer :: i
	sf_int%n_me = sf_int%get_n_matrix_elements ()
	allocate (sf_int%cv (sf_int%n_me))
	allocate (sf_int%ca (sf_int%n_me))
	associate (data => sf_int%data)
	select case (data%id)
	case (23)
	call it%init (sf_int%interaction_t%get_state_matrix_ptr ())
	do while (it%is_valid ())
	i = it%get_me_index ()
	flv = it%get_flavor (1)
	q = flv%get_charge ()
	t3 = flv%get_isospin ()
	if (flv%is_antiparticle ()) then
	sf_int%cv(i) = - data%cv &
	* (t3 - 2._default * q * data%sinthw**2) / data%costhw
	sf_int%ca(i) = data%ca * t3 / data%costhw
	else
	sf_int%cv(i) = data%cv &
	* (t3 - 2._default * q * data%sinthw**2) / data%costhw
	sf_int%ca(i) = data%ca * t3 / data%costhw
	end if
	call it%advance ()
	end do
	case (24)
	call it%init (sf_int%interaction_t%get_state_matrix_ptr ())
	do while (it%is_valid ())
	i = it%get_me_index ()
	flv = it%get_flavor (1)
	if (flv%is_antiparticle ()) then
	sf_int%cv(i) = data%cv / sqrt(2._default)
	sf_int%ca(i) = - data%ca / sqrt(2._default)
	else
	sf_int%cv(i) = data%cv / sqrt(2._default)
	sf_int%ca(i) = data%ca / sqrt(2._default)
	end if
	call it%advance ()
	end do
	end select
	end associate
	sf_int%status = SF_INITIAL
	end subroutine ewa_setup_constants

	@ %def ewa_setup_constants
	@
	\subsection{Kinematics}
	Set kinematics. The EWA structure function allows for a
	straightforward mapping of the unit interval. So, to leading order,
	the structure function value is unity, but the $x$ value is
	transformed. Higher orders affect the function value.
	If [[map]] is unset, the $r$ and $x$ values coincide, and the Jacobian
	$f(r)$ is trivial.

	If [[map]] is set, the exponential mapping for the $1/x$ singularity
	discussed above is applied.
	<<SF ewa: ewa: TBP>>=
	procedure :: complete_kinematics => ewa_complete_kinematics
	<<SF ewa: sub interfaces>>=
	module subroutine ewa_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(ewa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	end subroutine ewa_complete_kinematics
	<<SF ewa: procedures>>=
	module subroutine ewa_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(ewa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	real(default) :: e_1
	real(default) :: x0, x1, lx0, lx1, lx
	e_1 = energy (sf_int%get_momentum (1))
	if (sf_int%data%recoil) then
	select case (sf_int%data%id)
	case (23)
	x0 = max (sf_int%data%x_min, sf_int%data%mz / e_1)
	case (24)
	x0 = max (sf_int%data%x_min, sf_int%data%mw / e_1)
	end select
	else
	x0 = sf_int%data%x_min
	end if
	x1 = sf_int%data%x_max
	if ( x0 >= x1) then
	f = 0
	sf_int%status = SF_FAILED_KINEMATICS
	return
	end if
	if (map) then
	lx0 = log (x0)
	lx1 = log (x1)
	lx = lx1 * r(1) + lx0 * rb(1)
	x(1) = exp(lx)
	f = x(1) * (lx1 - lx0)
	else
	x(1) = r(1)
	if (x0 < x(1) .and. x(1) < x1) then
	f = 1
	else
	sf_int%status = SF_FAILED_KINEMATICS
	f = 0
	return
	end if
	end if
	xb(1) = 1 - x(1)
	if (size(x) == 3) then
	x(2:3) = r(2:3)
	xb(2:3) = rb(2:3)
	end if
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_DONE_KINEMATICS)
	sf_int%x = x(1)
	sf_int%xb = xb(1)
	case (SF_FAILED_KINEMATICS)
	sf_int%x = 0
	sf_int%xb = 0
	f = 0
	end select
	end subroutine ewa_complete_kinematics

	@ %def ewa_complete_kinematics
	@ Overriding the default method: we compute the [[x]] array from the
	momentum configuration. In the specific case of EWA, we also set the
	internally stored $x$ and $\bar x$ values, so they can be used in the
	following routine.
	<<SF ewa: ewa: TBP>>=
	procedure :: recover_x => sf_ewa_recover_x
	<<SF ewa: sub interfaces>>=
	module subroutine sf_ewa_recover_x (sf_int, x, xb, x_free)
	class(ewa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	end subroutine sf_ewa_recover_x
	<<SF ewa: procedures>>=
	module subroutine sf_ewa_recover_x (sf_int, x, xb, x_free)
	class(ewa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	call sf_int%base_recover_x (x, xb, x_free)
	sf_int%x = x(1)
	sf_int%xb = xb(1)
	end subroutine sf_ewa_recover_x

	@ %def sf_ewa_recover_x
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF ewa: ewa: TBP>>=
	procedure :: inverse_kinematics => ewa_inverse_kinematics
	<<SF ewa: sub interfaces>>=
	module subroutine ewa_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(ewa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	end subroutine ewa_inverse_kinematics
	<<SF ewa: procedures>>=
	module subroutine ewa_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(ewa_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	real(default) :: x0, x1, lx0, lx1, lx, e_1
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	e_1 = energy (sf_int%get_momentum (1))
	if (sf_int%data%recoil) then
	select case (sf_int%data%id)
	case (23)
	x0 = max (sf_int%data%x_min, sf_int%data%mz / e_1)
	case (24)
	x0 = max (sf_int%data%x_min, sf_int%data%mw / e_1)
	end select
	else
	x0 = sf_int%data%x_min
	end if
	x1 = sf_int%data%x_max
	if (map) then
	lx0 = log (x0)
	lx1 = log (x1)
	lx = log (x(1))
	r(1) = (lx - lx0) / (lx1 - lx0)
	rb(1) = (lx1 - lx) / (lx1 - lx0)
	f = x(1) * (lx1 - lx0)
	else
	r (1) = x(1)
	rb(1) = 1 - x(1)
	if (x0 < x(1) .and. x(1) < x1) then
	f = 1
	else
	f = 0
	end if
	end if
	if (size(r) == 3) then
	r (2:3) = x(2:3)
	rb(2:3) = xb(2:3)
	end if
	if (set_mom) then
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	end subroutine ewa_inverse_kinematics

	@ %def ewa_inverse_kinematics
	@
	\subsection{EWA application}
	For EWA, we can compute kinematics and function value in a single
	step. This function works on a single beam, assuming that the input
	momentum has been set. We need four random numbers as input: one for
	$x$, one for $Q^2$, and two for the polar and azimuthal angles.
	Alternatively, we can skip $p_T$ generation; in this case, we only
	need one.

	For obtaining splitting kinematics, we rely on the assumption that all
	in-particles are mass-degenerate (or there is only one), so the
	generated $x$ values are identical.
	<<SF ewa: ewa: TBP>>=
	procedure :: apply => ewa_apply
	<<SF ewa: sub interfaces>>=
	module subroutine ewa_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(ewa_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	end subroutine ewa_apply
	<<SF ewa: procedures>>=
	module subroutine ewa_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(ewa_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	real(default) :: x, xb, pt2, c1, c2
	real(default) :: cv, ca
	real(default) :: f, fm, fp, fL
	integer :: i
	associate (data => sf_int%data)
	x = sf_int%x
	xb = sf_int%xb
	pt2 = min ((data%pt_max)*2, (xb data%sqrts / 2)**2)
	select case (data%id)
	case (23)
	!!! Z boson structure function
	c1 = log (1 + pt2 / (xb * (data%mZ)**2))
	c2 = 1 / (1 + (xb * (data%mZ)**2) / pt2)
	case (24)
	!!! W boson structure function
	c1 = log (1 + pt2 / (xb * (data%mW)**2))
	c2 = 1 / (1 + (xb * (data%mW)**2) / pt2)
	end select
	do i = 1, sf_int%n_me
	cv = sf_int%cv(i)
	ca = sf_int%ca(i)
	fm = data%coeff * &
	((cv + ca)*2 + ((cv - ca) xb)*2) (c1 - c2) / (2 * x)
	fp = data%coeff * &
	((cv - ca)*2 + ((cv + ca) xb)*2) (c1 - c2) / (2 * x)
	fL = data%coeff * &
	(cv2 + ca2) * (2 * xb / x) * c2
	f = fp + fm + fL
	if (.not. vanishes (f)) then
	fp = fp / f
	fm = fm / f
	fL = fL / f
	end if
	call sf_int%set_matrix_element (i, cmplx (f, kind=default))
	end do
	end associate
	sf_int%status = SF_EVALUATED
	end subroutine ewa_apply

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

	module sf_ewa_ut
	use unit_tests
	use sf_ewa_uti

	<<Standard module head>>

	<<SF ewa: public test>>

	contains

	<<SF ewa: test driver>>

	end module sf_ewa_ut
	@ %def sf_ewa_ut
	@
	<<[[sf_ewa_uti.f90]]>>=
	<<File header>>

	module sf_ewa_uti

	<<Use kinds>>
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use sf_aux
	use sf_base

	use sf_ewa

	<<Standard module head>>

	<<SF ewa: test declarations>>

	contains

	<<SF ewa: tests>>

	end module sf_ewa_uti
	@ %def sf_ewa_ut
	@ API: driver for the unit tests below.
	<<SF ewa: public test>>=
	public :: sf_ewa_test
	<<SF ewa: test driver>>=
	subroutine sf_ewa_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF ewa: execute tests>>
	end subroutine sf_ewa_test

	@ %def sf_ewa_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF ewa: execute tests>>=
	call test (sf_ewa_1, "sf_ewa_1", &
	"structure function configuration", &
	u, results)
	<<SF ewa: test declarations>>=
	public :: sf_ewa_1
	<<SF ewa: tests>>=
	subroutine sf_ewa_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_ewa_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call model%init_sm_test ()
	pdg_in = 2

	allocate (ewa_data_t :: data)
	call data%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize for Z boson"
	write (u, "(A)")

	select type (data)
	type is (ewa_data_t)
	call data%init (model, pdg_in, 0.01_default, &
	500._default, 5000._default, .false., .false.)
	call data%set_id (23)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	write (u, "(A)")
	write (u, "(A)") "* Initialize for W boson"
	write (u, "(A)")

	deallocate (data)
	allocate (ewa_data_t :: data)
	select type (data)
	type is (ewa_data_t)
	call data%init (model, pdg_in, 0.01_default, &
	500._default, 5000._default, .false., .false.)
	call data%set_id (24)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	call model%final ()

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

	end subroutine sf_ewa_1

	@ %def sf_ewa_1
	@
	\subsubsection{Test and probe structure function}
	Construct and display a structure function object based on the EWA
	structure function.
	<<SF ewa: execute tests>>=
	call test (sf_ewa_2, "sf_ewa_2", &
	"structure function instance", &
	u, results)
	<<SF ewa: test declarations>>=
	public :: sf_ewa_2
	<<SF ewa: tests>>=
	subroutine sf_ewa_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_ewa_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_sm_test ()
	call flv%init (2, model)
	pdg_in = 2

	call reset_interaction_counter ()

	allocate (ewa_data_t :: data)
	select type (data)
	type is (ewa_data_t)
	call data%init (model, pdg_in, 0.01_default, &
	500._default, 3000._default, .false., .true.)
	call data%set_id (24)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=1500"
	write (u, "(A)")
	E = 1500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.4, no EWA mapping, collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.4_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false., &
	set_momenta=.true.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EWA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_ewa_2

	@ %def sf_ewa_2
	@
	\subsubsection{Standard mapping}
	Construct and display a structure function object based on the EWA
	structure function, applying the standard single-particle mapping.
	<<SF ewa: execute tests>>=
	call test (sf_ewa_3, "sf_ewa_3", &
	"apply mapping", &
	u, results)
	<<SF ewa: test declarations>>=
	public :: sf_ewa_3
	<<SF ewa: tests>>=
	subroutine sf_ewa_3 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_ewa_3"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_sm_test ()
	call flv%init (2, model)
	pdg_in = 2

	call reset_interaction_counter ()

	allocate (ewa_data_t :: data)
	select type (data)
	type is (ewa_data_t)
	call data%init (model, pdg_in, 0.01_default, &
	500._default, 3000._default, .false., .true.)
	call data%set_id (24)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=1500"
	write (u, "(A)")
	E = 1500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.4, with EWA mapping, collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.4_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
	set_momenta=.true.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EWA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_ewa_3

	@ %def sf_ewa_3
	@
	\subsubsection{Non-collinear case}
	Construct and display a structure function object based on the EPA
	structure function.
	<<SF ewa: execute tests>>=
	call test (sf_ewa_4, "sf_ewa_4", &
	"non-collinear", &
	u, results)
	<<SF ewa: test declarations>>=
	public :: sf_ewa_4
	<<SF ewa: tests>>=
	subroutine sf_ewa_4 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_ewa_4"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call modeL%init_sm_test ()
	call flv%init (2, model)
	pdg_in = 2

	call reset_interaction_counter ()

	allocate (ewa_data_t :: data)
	select type (data)
	type is (ewa_data_t)
	call data%init (model, pdg_in, 0.01_default, &
	500._default, 3000.0_default, .true., .true.)
	call data%set_id (24)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	write (u, "(A)") "* Initialize incoming momentum with E=1500"
	write (u, "(A)")
	E = 1500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.5/0.5/0.25, with EWA mapping, "
	write (u, "(A)") " non-coll., keeping energy"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = [0.5_default, 0.5_default, 0.25_default]
	rb = 1 - r
	sf_int%on_shell_mode = KEEP_ENERGY
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.true.)
	call sf_int%pacify_momenta (1e-10_default)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x and r from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.true., &
	set_momenta=.true.)
	call sf_int%pacify_momenta (1e-10_default)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EWA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 1500._default)
	call sf_int%write (u, testflag = .true.)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_ewa_4

	@ %def sf_ewa_4
	@
	\subsubsection{Structure function for multiple flavors}
	Construct and display a structure function object based on the EWA
	structure function. The incoming state has multiple particles with
	non-uniform quantum numbers.
	<<SF ewa: execute tests>>=
	call test (sf_ewa_5, "sf_ewa_5", &
	"structure function instance", &
	u, results)
	<<SF ewa: test declarations>>=
	public :: sf_ewa_5
	<<SF ewa: tests>>=
	subroutine sf_ewa_5 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_ewa_5"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_sm_test ()
	call flv%init (2, model)
	pdg_in = [1, 2, -1, -2]

	call reset_interaction_counter ()

	allocate (ewa_data_t :: data)
	select type (data)
	type is (ewa_data_t)
	call data%init (model, pdg_in, 0.01_default, &
	500._default, 3000._default, .false., .true.)
	call data%set_id (24)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])
	call sf_int%setup_constants ()

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=1500"
	write (u, "(A)")
	E = 1500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call pacify (k, 1e-10_default)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for r=0.4, no EWA mapping, collinear"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.4_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Evaluate EWA structure function"
	write (u, "(A)")

	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_ewa_5

	@ %def sf_ewa_5
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{Energy-scan spectrum}

	This spectrum is actually a trick that allows us to plot the c.m.\ energy
	dependence of a cross section without scanning the input energy. We
	start with the observation that a spectrum $f(x)$, applied to one of
	the incoming beams only, results in a cross section
	\begin{equation}
	\sigma = \int dx\,f(x)\,\hat\sigma(xs).
	\end{equation}
	We want to compute the distribution of $E=\sqrt{\hat s}=\sqrt{xs}$, i.e.,
	\begin{equation}
	\frac{d\sigma}{dE} = \frac{2\sqrt{x}}{\sqrt{s}}\,\frac{d\sigma}{dx}
	= \frac{2\sqrt{x}}{\sqrt{s}}\,f(x)\,\hat\sigma(xs),
	\end{equation}
	so if we set
	\begin{equation}
	f(x) = \frac{\sqrt{s}}{2\sqrt{x}},
	\end{equation}
	we get the distribution
	\begin{equation}
	\frac{d\sigma}{dE} = \hat\sigma(\hat s=E^2).
	\end{equation}
	We implement this as a spectrum with a single parameter $x$. The
	parameters for the individual beams are computed as $x_i=\sqrt{x}$, so
	they are equal and the kinematics is always symmetric.
	<<[[sf_escan.f90]]>>=
	<<File header>>

	module sf_escan

	<<Use kinds>>
	<<Use strings>>
	use pdg_arrays
	use model_data
	use flavors
	use quantum_numbers
	use state_matrices
	use polarizations
	use sf_base

	<<Standard module head>>

	<<SF escan: public>>

	<<SF escan: types>>

	interface
	<<SF escan: sub interfaces>>
	end interface

	contains

	<<SF escan: main procedures>>

	end module sf_escan
	@ %def sf_escan
	@
	<<[[sf_escan_sub.f90]]>>=
	<<File header>>

	submodule (sf_escan) sf_escan_s

	use io_units
	use format_defs, only: FMT_12
	use numeric_utils
	use diagnostics
	use lorentz

	implicit none

	contains

	<<SF escan: procedures>>

	end submodule sf_escan_s

	@ %def sf_escan_s
	@
	\subsection{Data type}
	The [[norm]] is unity if the total cross section should be normalized
	to one, and $\sqrt{s}$ if it should be normalized to the total
	energy. In the latter case, the differential distribution
	$d\sigma/d\sqrt{\hat s}$ coincides with the partonic cross section
	$\hat\sigma$ as a function of $\sqrt{\hat s}$.
	<<SF escan: public>>=
	public :: escan_data_t
	<<SF escan: types>>=
	type, extends(sf_data_t) :: escan_data_t
	private
	type(flavor_t), dimension(:,:), allocatable :: flv_in
	integer, dimension(2) :: n_flv = 0
	real(default) :: norm = 1
	contains
	<<SF escan: escan data: TBP>>
	end type escan_data_t

	@ %def escan_data_t
	<<SF escan: escan data: TBP>>=
	procedure :: init => escan_data_init
	<<SF escan: sub interfaces>>=
	module subroutine escan_data_init (data, model, pdg_in, norm)
	class(escan_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	real(default), intent(in), optional :: norm
	end subroutine escan_data_init
	<<SF escan: procedures>>=
	module subroutine escan_data_init (data, model, pdg_in, norm)
	class(escan_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	real(default), intent(in), optional :: norm
	real(default), dimension(2) :: m2
	integer :: i, j
	data%n_flv = pdg_in%get_length ()
	allocate (data%flv_in (maxval (data%n_flv), 2))
	do i = 1, 2
	do j = 1, data%n_flv(i)
	call data%flv_in(j, i)%init (pdg_in(i)%get (j), model)
	end do
	end do
	m2 = data%flv_in(1,:)%get_mass ()
	do i = 1, 2
	if (.not. any (nearly_equal (data%flv_in(1:data%n_flv(i),i)%get_mass (), m2(i)))) then
	call msg_fatal ("Energy scan: incoming particle mass must be uniform")
	end if
	end do
	if (present (norm)) data%norm = norm
	end subroutine escan_data_init

	@ %def escan_data_init
	@ Output
	<<SF escan: escan data: TBP>>=
	procedure :: write => escan_data_write
	<<SF escan: sub interfaces>>=
	module subroutine escan_data_write (data, unit, verbose)
	class(escan_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine escan_data_write
	<<SF escan: procedures>>=
	module subroutine escan_data_write (data, unit, verbose)
	class(escan_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u, i, j
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "Energy-scan data:"
	write (u, "(3x,A)", advance="no") "prt_in = "
	do i = 1, 2
	if (i > 1) write (u, "(',',1x)", advance="no")
	do j = 1, data%n_flv(i)
	if (j > 1) write (u, "(':')", advance="no")
	write (u, "(A)", advance="no") char (data%flv_in(j,i)%get_name ())
	end do
	end do
	write (u, *)
	write (u, "(3x,A," // FMT_12 // ")") "norm =", data%norm
	end subroutine escan_data_write

	@ %def escan_data_write
	@ Kinematics is completely collinear, hence there is only one
	parameter for a pair spectrum.
	<<SF escan: escan data: TBP>>=
	procedure :: get_n_par => escan_data_get_n_par
	<<SF escan: sub interfaces>>=
	module function escan_data_get_n_par (data) result (n)
	class(escan_data_t), intent(in) :: data
	integer :: n
	end function escan_data_get_n_par
	<<SF escan: procedures>>=
	module function escan_data_get_n_par (data) result (n)
	class(escan_data_t), intent(in) :: data
	integer :: n
	n = 1
	end function escan_data_get_n_par

	@ %def escan_data_get_n_par
	@ Return the outgoing particles PDG codes. This is always the same as
	the incoming particle, where we use two indices for the two beams.
	<<SF escan: escan data: TBP>>=
	procedure :: get_pdg_out => escan_data_get_pdg_out
	<<SF escan: sub interfaces>>=
	module subroutine escan_data_get_pdg_out (data, pdg_out)
	class(escan_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	end subroutine escan_data_get_pdg_out
	<<SF escan: procedures>>=
	module subroutine escan_data_get_pdg_out (data, pdg_out)
	class(escan_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer :: i, n
	n = 2
	do i = 1, n
	pdg_out(i) = data%flv_in(1:data%n_flv(i),i)%get_pdg ()
	end do
	end subroutine escan_data_get_pdg_out

	@ %def escan_data_get_pdg_out
	@ Allocate the interaction record. Due to a gfortran 7/8/9 this has to
	remain in the main module.
	<<SF escan: escan data: TBP>>=
	procedure :: allocate_sf_int => escan_data_allocate_sf_int
	<<SF escan: main procedures>>=
	subroutine escan_data_allocate_sf_int (data, sf_int)
	class(escan_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (escan_t :: sf_int)
	end subroutine escan_data_allocate_sf_int

	@ %def escan_data_allocate_sf_int
	@
	\subsection{The Energy-scan object}
	This is a spectrum, not a radiation. We create an interaction with
	two incoming and two outgoing particles, flavor, color, and helicity
	being carried through. $x$ nevertheless is only one-dimensional, as we
	are always using only one beam parameter.
	<<SF escan: types>>=
	type, extends (sf_int_t) :: escan_t
	type(escan_data_t), pointer :: data => null ()
	contains
	<<SF escan: escan: TBP>>
	end type escan_t

	@ %def escan_t
	@ Type string: for the energy scan this is just a dummy function.
	<<SF escan: escan: TBP>>=
	procedure :: type_string => escan_type_string
	<<SF escan: sub interfaces>>=
	module function escan_type_string (object) result (string)
	class(escan_t), intent(in) :: object
	type(string_t) :: string
	end function escan_type_string
	<<SF escan: procedures>>=
	module function escan_type_string (object) result (string)
	class(escan_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "Escan: energy scan"
	else
	string = "Escan: [undefined]"
	end if
	end function escan_type_string

	@ %def escan_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF escan: escan: TBP>>=
	procedure :: write => escan_write
	<<SF escan: sub interfaces>>=
	module subroutine escan_write (object, unit, testflag)
	class(escan_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine escan_write
	<<SF escan: procedures>>=
	module subroutine escan_write (object, unit, testflag)
	class(escan_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "Energy scan data: [undefined]"
	end if
	end subroutine escan_write

	@ %def escan_write
	@
	<<SF escan: escan: TBP>>=
	procedure :: init => escan_init
	<<SF escan: sub interfaces>>=
	module subroutine escan_init (sf_int, data)
	class(escan_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	end subroutine escan_init
	<<SF escan: procedures>>=
	module subroutine escan_init (sf_int, data)
	class(escan_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(4) :: mask
	integer, dimension(4) :: hel_lock
	real(default), dimension(2) :: m2
	real(default), dimension(0) :: mr2
	type(quantum_numbers_t), dimension(4) :: qn_fc, qn_hel, qn
	type(polarization_t), target :: pol1, pol2
	type(polarization_iterator_t) :: it_hel1, it_hel2
	integer :: j1, j2
	select type (data)
	type is (escan_data_t)
	hel_lock = [3, 4, 1, 2]
	m2 = data%flv_in(1,:)%get_mass ()
	call sf_int%base_init (mask, m2, mr2, m2, hel_lock = hel_lock)
	sf_int%data => data
	do j1 = 1, data%n_flv(1)
	call qn_fc(1)%init ( &
	flv = data%flv_in(j1,1), &
	col = color_from_flavor (data%flv_in(j1,1)))
	call qn_fc(3)%init ( &
	flv = data%flv_in(j1,1), &
	col = color_from_flavor (data%flv_in(j1,1)))
	call pol1%init_generic (data%flv_in(j1,1))
	do j2 = 1, data%n_flv(2)
	call qn_fc(2)%init ( &
	flv = data%flv_in(j2,2), &
	col = color_from_flavor (data%flv_in(j2,2)))
	call qn_fc(4)%init ( &
	flv = data%flv_in(j2,2), &
	col = color_from_flavor (data%flv_in(j2,2)))
	call pol2%init_generic (data%flv_in(j2,2))
	call it_hel1%init (pol1)
	do while (it_hel1%is_valid ())
	qn_hel(1) = it_hel1%get_quantum_numbers ()
	qn_hel(3) = it_hel1%get_quantum_numbers ()
	call it_hel2%init (pol2)
	do while (it_hel2%is_valid ())
	qn_hel(2) = it_hel2%get_quantum_numbers ()
	qn_hel(4) = it_hel2%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc
	call sf_int%add_state (qn)
	call it_hel2%advance ()
	end do
	call it_hel1%advance ()
	end do
	! call pol2%final ()
	end do
	! call pol1%final ()
	end do
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	call sf_int%freeze ()
	sf_int%status = SF_INITIAL
	end select
	end subroutine escan_init

	@ %def escan_init
	@
	\subsection{Kinematics}
	Set kinematics. We have a single parameter, but reduce both beams.
	The [[map]] flag is ignored.
	<<SF escan: escan: TBP>>=
	procedure :: complete_kinematics => escan_complete_kinematics
	<<SF escan: sub interfaces>>=
	module subroutine escan_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(escan_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default) :: sqrt_x
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	end subroutine escan_complete_kinematics
	<<SF escan: procedures>>=
	module subroutine escan_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(escan_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default) :: sqrt_x
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	x = r
	xb= rb
	sqrt_x = sqrt (x(1))
	if (sqrt_x > 0) then
	f = 1 / (2 * sqrt_x)
	else
	f = 0
	sf_int%status = SF_FAILED_KINEMATICS
	return
	end if
	call sf_int%reduce_momenta ([sqrt_x, sqrt_x])
	end subroutine escan_complete_kinematics

	@ %def escan_complete_kinematics
	@ Recover $x$. The base procedure should return two momentum
	fractions for the two beams, while we have only one parameter. This
	is the product of the extracted momentum fractions.
	<<SF escan: escan: TBP>>=
	procedure :: recover_x => escan_recover_x
	<<SF escan: sub interfaces>>=
	module subroutine escan_recover_x (sf_int, x, xb, x_free)
	class(escan_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	end subroutine escan_recover_x
	<<SF escan: procedures>>=
	module subroutine escan_recover_x (sf_int, x, xb, x_free)
	class(escan_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	real(default), dimension(2) :: xi, xib
	call sf_int%base_recover_x (xi, xib, x_free)
	x = product (xi)
	xb= 1 - x
	end subroutine escan_recover_x

	@ %def escan_recover_x
	@ Compute inverse kinematics.
	<<SF escan: escan: TBP>>=
	procedure :: inverse_kinematics => escan_inverse_kinematics
	<<SF escan: sub interfaces>>=
	module subroutine escan_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(escan_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	end subroutine escan_inverse_kinematics
	<<SF escan: procedures>>=
	module subroutine escan_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(escan_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	real(default) :: sqrt_x
	logical :: set_mom

	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	sqrt_x = sqrt (x(1))
	if (sqrt_x > 0) then
	f = 1 / (2 * sqrt_x)
	else
	f = 0
	sf_int%status = SF_FAILED_KINEMATICS
	return
	end if
	r = x
	rb = xb
	if (set_mom) then
	call sf_int%reduce_momenta ([sqrt_x, sqrt_x])
	end if
	end subroutine escan_inverse_kinematics

	@ %def escan_inverse_kinematics
	@
	\subsection{Energy scan application}
	Here, we insert the predefined norm.
	<<SF escan: escan: TBP>>=
	procedure :: apply => escan_apply
	<<SF escan: sub interfaces>>=
	module subroutine escan_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(escan_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	end subroutine escan_apply
	<<SF escan: procedures>>=
	module subroutine escan_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(escan_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	real(default) :: f
	associate (data => sf_int%data)
	f = data%norm
	end associate
	call sf_int%set_matrix_element (cmplx (f, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine escan_apply

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

	module sf_escan_ut
	use unit_tests
	use sf_escan_uti

	<<Standard module head>>

	<<SF escan: public test>>

	contains

	<<SF escan: test driver>>

	end module sf_escan_ut
	@ %def sf_escan_ut
	@
	<<[[sf_escan_uti.f90]]>>=
	<<File header>>

	module sf_escan_uti

	<<Use kinds>>
	use physics_defs, only: ELECTRON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use sf_aux
	use sf_base

	use sf_escan

	<<Standard module head>>

	<<SF escan: test declarations>>

	contains

	<<SF escan: tests>>

	end module sf_escan_uti
	@ %def sf_escan_ut
	@ API: driver for the unit tests below.
	<<SF escan: public test>>=
	public :: sf_escan_test
	<<SF escan: test driver>>=
	subroutine sf_escan_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF escan: execute tests>>
	end subroutine sf_escan_test

	@ %def sf_escan_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF escan: execute tests>>=
	call test (sf_escan_1, "sf_escan_1", &
	"structure function configuration", &
	u, results)
	<<SF escan: test declarations>>=
	public :: sf_escan_1
	<<SF escan: tests>>=
	subroutine sf_escan_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t), dimension(2) :: pdg_in
	type(pdg_array_t), dimension(2) :: pdg_out
	integer, dimension(:), allocatable :: pdg1, pdg2
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_escan_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&energy-scan structure function data"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	allocate (escan_data_t :: data)
	select type (data)
	type is (escan_data_t)
	call data%init (model, pdg_in, norm = 2._default)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	pdg2 = pdg_out(2)
	write (u, "(2x,99(1x,I0))") pdg1, pdg2

	call model%final ()

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

	end subroutine sf_escan_1

	@ %def sf_escan_1
	g@
	\subsubsection{Probe the structure-function object}
	Active the beam event reader, generate an event.
	<<SF escan: execute tests>>=
	call test (sf_escan_2, "sf_escan_2", &
	"generate event", &
	u, results)
	<<SF escan: test declarations>>=
	public :: sf_escan_2
	<<SF escan: tests>>=
	subroutine sf_escan_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: x_free, f

	write (u, "(A)") "* Test output: sf_escan_2"
	write (u, "(A)") "* Purpose: initialize and display &
	&beam-events structure function data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv(1)%init (ELECTRON, model)
	call flv(2)%init (-ELECTRON, model)
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	call reset_interaction_counter ()

	allocate (escan_data_t :: data)
	select type (data)
	type is (escan_data_t)
	call data%init (model, pdg_in)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Set dummy parameters and generate x"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.8
	rb = 1 - r
	x_free = 1

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

	write (u, "(A)")
	write (u, "(A)") "* Inverse kinematics"
	write (u, "(A)")

	call sf_int%recover_x (x, xb, x_free)
	call sf_int%inverse_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

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

	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_escan_2

	@ %def sf_escan_2
	@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Gaussian beam spread}

	Instead of an analytic beam description, beam data may be provided in
	form of an event file. In its most simple form, the event file
	contains pairs of $x$ values, relative to nominal beam energies. More
	advanced formats may include polarization, etc. The current
	implementation carries beam polarization through, if specified.

	The code is very similar to the energy scan described above.

	However, we must include a file-handle manager for the beam-event
	files. Two different processes may access a given beam-event file at
	the same time (i.e., serially but alternating). Accessing an open
	file from two different units is non-standard and not supported by all
	compilers. Therefore, we keep a global registry of open files,
	associated units, and reference counts. The [[gaussian_t]] objects
	act as proxies to this registry.
	<<[[sf_gaussian.f90]]>>=
	<<File header>>

	module sf_gaussian

	<<Use kinds>>
	<<Use strings>>
	use rng_base
	use pdg_arrays
	use model_data
	use flavors
	use quantum_numbers
	use state_matrices
	use polarizations
	use sf_base

	<<Standard module head>>

	<<SF gaussian: public>>

	<<SF gaussian: types>>

	interface
	<<SF gaussian: sub interfaces>>
	end interface

	contains

	<<SF gaussian: main procedures>>

	end module sf_gaussian
	@ %def sf_gaussian
	@
	<<[[sf_gaussian_sub.f90]]>>=
	<<File header>>

	submodule (sf_gaussian) sf_gaussian_s

	use io_units
	use format_defs, only: FMT_12
	use file_registries
	use diagnostics
	use lorentz

	implicit none

	contains

	<<SF gaussian: procedures>>

	end submodule sf_gaussian_s

	@ %def sf_gaussian_s
	@
	\subsection{The beam-data file registry}
	We manage data files via the [[file_registries]] module. To this end,
	we keep the registry as a private module variable here.
	<<CCC SF gaussian: variables>>=
	type(file_registry_t), save :: beam_file_registry

	@ %def beam_file_registry
	@
	\subsection{Data type}
	We store the spread for each beam, as a relative number related to the beam
	energy. For the actual generation, we include an (abstract) random-number
	generator factory.
	<<SF gaussian: public>>=
	public :: gaussian_data_t
	<<SF gaussian: types>>=
	type, extends(sf_data_t) :: gaussian_data_t
	private
	type(flavor_t), dimension(2) :: flv_in
	real(default), dimension(2) :: spread
	class(rng_factory_t), allocatable :: rng_factory
	contains
	<<SF gaussian: gaussian data: TBP>>
	end type gaussian_data_t

	@ %def gaussian_data_t
	<<SF gaussian: gaussian data: TBP>>=
	procedure :: init => gaussian_data_init
	<<SF gaussian: sub interfaces>>=
	module subroutine gaussian_data_init &
	(data, model, pdg_in, spread, rng_factory)
	class(gaussian_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	real(default), dimension(2), intent(in) :: spread
	class(rng_factory_t), intent(inout), allocatable :: rng_factory
	end subroutine gaussian_data_init
	<<SF gaussian: procedures>>=
	module subroutine gaussian_data_init &
	(data, model, pdg_in, spread, rng_factory)
	class(gaussian_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	real(default), dimension(2), intent(in) :: spread
	class(rng_factory_t), intent(inout), allocatable :: rng_factory
	if (any (spread < 0)) then
	call msg_fatal ("Gaussian beam spread: must not be negative")
	end if
	call data%flv_in(1)%init (pdg_in(1)%get (1), model)
	call data%flv_in(2)%init (pdg_in(2)%get (1), model)
	data%spread = spread
	call move_alloc (from = rng_factory, to = data%rng_factory)
	end subroutine gaussian_data_init

	@ %def gaussian_data_init
	@ Return true since this spectrum is always in generator mode.
	<<SF gaussian: gaussian data: TBP>>=
	procedure :: is_generator => gaussian_data_is_generator
	<<SF gaussian: sub interfaces>>=
	module function gaussian_data_is_generator (data) result (flag)
	class(gaussian_data_t), intent(in) :: data
	logical :: flag
	end function gaussian_data_is_generator
	<<SF gaussian: procedures>>=
	module function gaussian_data_is_generator (data) result (flag)
	class(gaussian_data_t), intent(in) :: data
	logical :: flag
	flag = .true.
	end function gaussian_data_is_generator

	@ %def gaussian_data_is_generator
	@ The number of parameters is two. They are free parameters.
	<<SF gaussian: gaussian data: TBP>>=
	procedure :: get_n_par => gaussian_data_get_n_par
	<<SF gaussian: sub interfaces>>=
	module function gaussian_data_get_n_par (data) result (n)
	class(gaussian_data_t), intent(in) :: data
	integer :: n
	end function gaussian_data_get_n_par
	<<SF gaussian: procedures>>=
	module function gaussian_data_get_n_par (data) result (n)
	class(gaussian_data_t), intent(in) :: data
	integer :: n
	n = 2
	end function gaussian_data_get_n_par

	@ %def gaussian_data_get_n_par
	<<SF gaussian: gaussian data: TBP>>=
	procedure :: get_pdg_out => gaussian_data_get_pdg_out
	<<SF gaussian: sub interfaces>>=
	module subroutine gaussian_data_get_pdg_out (data, pdg_out)
	class(gaussian_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	end subroutine gaussian_data_get_pdg_out
	<<SF gaussian: procedures>>=
	module subroutine gaussian_data_get_pdg_out (data, pdg_out)
	class(gaussian_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer :: i, n
	n = 2
	do i = 1, n
	pdg_out(i) = data%flv_in(i)%get_pdg ()
	end do
	end subroutine gaussian_data_get_pdg_out

	@ %def gaussian_data_get_pdg_out
	@ Allocate the interaction record. Due to a gfortran 7/8/9 bug has to
	remain in the main module.
	<<SF gaussian: gaussian data: TBP>>=
	procedure :: allocate_sf_int => gaussian_data_allocate_sf_int
	<<SF gaussian: main procedures>>=
	subroutine gaussian_data_allocate_sf_int (data, sf_int)
	class(gaussian_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (gaussian_t :: sf_int)
	end subroutine gaussian_data_allocate_sf_int

	@ %def gaussian_data_allocate_sf_int
	@ Output
	<<SF gaussian: gaussian data: TBP>>=
	procedure :: write => gaussian_data_write
	<<SF gaussian: sub interfaces>>=
	module subroutine gaussian_data_write (data, unit, verbose)
	class(gaussian_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine gaussian_data_write
	<<SF gaussian: procedures>>=
	module subroutine gaussian_data_write (data, unit, verbose)
	class(gaussian_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "Gaussian beam spread data:"
	write (u, "(3x,A,A,A,A)") "prt_in = ", &
	char (data%flv_in(1)%get_name ()), &
	", ", char (data%flv_in(2)%get_name ())
	write (u, "(3x,A,2(1x," // FMT_12 // "))") "spread =", data%spread
	call data%rng_factory%write (u)
	end subroutine gaussian_data_write

	@ %def gaussian_data_write
	@
	\subsection{The gaussian object}
	Flavor and polarization carried through, no radiated particles. The generator
	needs a random-number generator, obviously.
	<<SF gaussian: public>>=
	public :: gaussian_t
	<<SF gaussian: types>>=
	type, extends (sf_int_t) :: gaussian_t
	type(gaussian_data_t), pointer :: data => null ()
	class(rng_t), allocatable :: rng
	contains
	<<SF gaussian: gaussian: TBP>>
	end type gaussian_t

	@ %def gaussian_t
	@ Type string: show gaussian file.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: type_string => gaussian_type_string
	<<SF gaussian: sub interfaces>>=
	module function gaussian_type_string (object) result (string)
	class(gaussian_t), intent(in) :: object
	type(string_t) :: string
	end function gaussian_type_string
	<<SF gaussian: procedures>>=
	module function gaussian_type_string (object) result (string)
	class(gaussian_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "Gaussian: gaussian beam-energy spread"
	else
	string = "Gaussian: [undefined]"
	end if
	end function gaussian_type_string

	@ %def gaussian_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: write => gaussian_write
	<<SF gaussian: sub interfaces>>=
	module subroutine gaussian_write (object, unit, testflag)
	class(gaussian_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine gaussian_write
	<<SF gaussian: procedures>>=
	module subroutine gaussian_write (object, unit, testflag)
	class(gaussian_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%rng%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "gaussian data: [undefined]"
	end if
	end subroutine gaussian_write

	@ %def gaussian_write
	@
	<<SF gaussian: gaussian: TBP>>=
	procedure :: init => gaussian_init
	<<SF gaussian: sub interfaces>>=
	module subroutine gaussian_init (sf_int, data)
	class(gaussian_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	end subroutine gaussian_init
	<<SF gaussian: procedures>>=
	module subroutine gaussian_init (sf_int, data)
	class(gaussian_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	real(default), dimension(2) :: m2
	real(default), dimension(0) :: mr2
	type(quantum_numbers_mask_t), dimension(4) :: mask
	integer, dimension(4) :: hel_lock
	type(quantum_numbers_t), dimension(4) :: qn_fc, qn_hel, qn
	type(polarization_t), target :: pol1, pol2
	type(polarization_iterator_t) :: it_hel1, it_hel2
	integer :: i
	select type (data)
	type is (gaussian_data_t)
	m2 = data%flv_in%get_mass () ** 2
	hel_lock = [3, 4, 1, 2]
	mask = quantum_numbers_mask (.false., .false., .false.)
	call sf_int%base_init (mask, m2, mr2, m2, hel_lock = hel_lock)
	sf_int%data => data
	do i = 1, 2
	call qn_fc(i)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i)))
	call qn_fc(i+2)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i)))
	end do
	call pol1%init_generic (data%flv_in(1))
	call it_hel1%init (pol1)
	do while (it_hel1%is_valid ())
	qn_hel(1) = it_hel1%get_quantum_numbers ()
	qn_hel(3) = it_hel1%get_quantum_numbers ()
	call pol2%init_generic (data%flv_in(2))
	call it_hel2%init (pol2)
	do while (it_hel2%is_valid ())
	qn_hel(2) = it_hel2%get_quantum_numbers ()
	qn_hel(4) = it_hel2%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc
	call sf_int%add_state (qn)
	call it_hel2%advance ()
	end do
	! call pol2%final ()
	call it_hel1%advance ()
	end do
	! call pol1%final ()
	call sf_int%freeze ()
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	sf_int%status = SF_INITIAL
	end select
	call sf_int%data%rng_factory%make (sf_int%rng)
	end subroutine gaussian_init

	@ %def gaussian_init
	@ This spectrum type needs a finalizer, which closes the data file.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: final => sf_gaussian_final
	<<SF gaussian: sub interfaces>>=
	module subroutine sf_gaussian_final (object)
	class(gaussian_t), intent(inout) :: object
	end subroutine sf_gaussian_final
	<<SF gaussian: procedures>>=
	module subroutine sf_gaussian_final (object)
	class(gaussian_t), intent(inout) :: object
	call object%interaction_t%final ()
	end subroutine sf_gaussian_final

	@ %def sf_gaussian_final
	@
	\subsection{Kinematics}
	Refer to the [[data]] component.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: is_generator => gaussian_is_generator
	<<SF gaussian: sub interfaces>>=
	module function gaussian_is_generator (sf_int) result (flag)
	class(gaussian_t), intent(in) :: sf_int
	logical :: flag
	end function gaussian_is_generator
	<<SF gaussian: procedures>>=
	module function gaussian_is_generator (sf_int) result (flag)
	class(gaussian_t), intent(in) :: sf_int
	logical :: flag
	flag = sf_int%data%is_generator ()
	end function gaussian_is_generator

	@ %def gaussian_is_generator
	@ Generate free parameters. The $x$ value should be distributed with mean $1$
	and $\sigma$ given by the spread. We reject negative $x$ values. (This
	cut slightly biases the distribution, but for reasonable (small)
	spreads negative $r$ should not occur.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: generate_free => gaussian_generate_free
	<<SF gaussian: sub interfaces>>=
	module subroutine gaussian_generate_free (sf_int, r, rb, x_free)
	class(gaussian_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	end subroutine gaussian_generate_free
	<<SF gaussian: procedures>>=
	module subroutine gaussian_generate_free (sf_int, r, rb, x_free)
	class(gaussian_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	real(default), dimension(size(r)) :: z
	associate (data => sf_int%data)
	do
	call sf_int%rng%generate_gaussian (z)
	rb = z * data%spread
	r = 1 - rb
	x_free = x_free * product (r)
	if (all (r > 0)) exit
	end do
	end associate
	end subroutine gaussian_generate_free

	@ %def gaussian_generate_free
	@ Set kinematics. Trivial transfer since this is a pure generator.
	The [[map]] flag doesn't apply.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: complete_kinematics => gaussian_complete_kinematics
	<<SF gaussian: sub interfaces>>=
	module subroutine gaussian_complete_kinematics &
	(sf_int, x, xb, f, r, rb, map)
	class(gaussian_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	end subroutine gaussian_complete_kinematics
	<<SF gaussian: procedures>>=
	module subroutine gaussian_complete_kinematics &
	(sf_int, x, xb, f, r, rb, map)
	class(gaussian_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	if (map) then
	call msg_fatal ("gaussian: map flag not supported")
	else
	x = r
	xb= rb
	f = 1
	end if
	call sf_int%reduce_momenta (x)
	end subroutine gaussian_complete_kinematics

	@ %def gaussian_complete_kinematics
	@ Compute inverse kinematics. Trivial in this case.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: inverse_kinematics => gaussian_inverse_kinematics
	<<SF gaussian: sub interfaces>>=
	module subroutine gaussian_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(gaussian_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	end subroutine gaussian_inverse_kinematics
	<<SF gaussian: procedures>>=
	module subroutine gaussian_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(gaussian_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	call msg_fatal ("gaussian: map flag not supported")
	else
	r = x
	rb= xb
	f = 1
	end if
	if (set_mom) then
	call sf_int%reduce_momenta (x)
	end if
	end subroutine gaussian_inverse_kinematics

	@ %def gaussian_inverse_kinematics
	@
	\subsection{gaussian application}
	Trivial, just set the unit weight.
	<<SF gaussian: gaussian: TBP>>=
	procedure :: apply => gaussian_apply
	<<SF gaussian: sub interfaces>>=
	module subroutine gaussian_apply &
	(sf_int, scale, negative_sf, rescale, i_sub)
	class(gaussian_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	end subroutine gaussian_apply
	<<SF gaussian: procedures>>=
	module subroutine gaussian_apply &
	(sf_int, scale, negative_sf, rescale, i_sub)
	class(gaussian_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	real(default) :: f
	f = 1
	call sf_int%set_matrix_element (cmplx (f, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine gaussian_apply

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

	module sf_gaussian_ut
	use unit_tests
	use sf_gaussian_uti

	<<Standard module head>>

	<<SF gaussian: public test>>

	contains

	<<SF gaussian: test driver>>

	end module sf_gaussian_ut
	@ %def sf_gaussian_ut
	@
	<<[[sf_gaussian_uti.f90]]>>=
	<<File header>>

	module sf_gaussian_uti

	<<Use kinds>>
	use numeric_utils, only: pacify
	use physics_defs, only: ELECTRON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use rng_base
	use sf_aux
	use sf_base

	use sf_gaussian

	use rng_base_ut, only: rng_test_factory_t

	<<Standard module head>>

	<<SF gaussian: test declarations>>

	contains

	<<SF gaussian: tests>>

	end module sf_gaussian_uti
	@ %def sf_gaussian_ut
	@ API: driver for the unit tests below.
	<<SF gaussian: public test>>=
	public :: sf_gaussian_test
	<<SF gaussian: test driver>>=
	subroutine sf_gaussian_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF gaussian: execute tests>>
	end subroutine sf_gaussian_test

	@ %def sf_gaussian_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF gaussian: execute tests>>=
	call test (sf_gaussian_1, "sf_gaussian_1", &
	"structure function configuration", &
	u, results)
	<<SF gaussian: test declarations>>=
	public :: sf_gaussian_1
	<<SF gaussian: tests>>=
	subroutine sf_gaussian_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t), dimension(2) :: pdg_in
	type(pdg_array_t), dimension(2) :: pdg_out
	integer, dimension(:), allocatable :: pdg1, pdg2
	class(sf_data_t), allocatable :: data
	class(rng_factory_t), allocatable :: rng_factory

	write (u, "(A)") "* Test output: sf_gaussian_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&gaussian-spread structure function data"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	allocate (gaussian_data_t :: data)
	allocate (rng_test_factory_t :: rng_factory)
	select type (data)
	type is (gaussian_data_t)
	call data%init (model, pdg_in, [1e-2_default, 2e-2_default], rng_factory)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	pdg2 = pdg_out(2)
	write (u, "(2x,99(1x,I0))") pdg1, pdg2

	call model%final ()

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

	end subroutine sf_gaussian_1

	@ %def sf_gaussian_1
	@
	\subsubsection{Probe the structure-function object}
	Active the beam event reader, generate an event.
	<<SF gaussian: execute tests>>=
	call test (sf_gaussian_2, "sf_gaussian_2", &
	"generate event", &
	u, results)
	<<SF gaussian: test declarations>>=
	public :: sf_gaussian_2
	<<SF gaussian: tests>>=
	subroutine sf_gaussian_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(rng_factory_t), allocatable :: rng_factory
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: x_free, f
	integer :: i

	write (u, "(A)") "* Test output: sf_gaussian_2"
	write (u, "(A)") "* Purpose: initialize and display &
	&gaussian-spread structure function data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv(1)%init (ELECTRON, model)
	call flv(2)%init (-ELECTRON, model)
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	call reset_interaction_counter ()

	allocate (gaussian_data_t :: data)
	allocate (rng_test_factory_t :: rng_factory)
	select type (data)
	type is (gaussian_data_t)
	call data%init (model, pdg_in, [1e-2_default, 2e-2_default], rng_factory)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Set dummy parameters and generate x."
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0
	rb = 0
	x_free = 1
	call sf_int%generate_free (r, rb, x_free)
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call pacify (rb, 1.e-8_default)
	call pacify (xb, 1.e-8_default)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

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

	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate more events"
	write (u, "(A)")

	select type (sf_int)
	type is (gaussian_t)
	do i = 1, 3
	call sf_int%generate_free (r, rb, x_free)
	write (u, "(A,9(1x,F10.7))") "r =", r
	end do
	end select

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_gaussian_2

	@ %def sf_gaussian_2
	@
	\clearpage
	@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Using beam event data}

	Instead of an analytic beam description, beam data may be provided in
	form of an event file. In its most simple form, the event file
	contains pairs of $x$ values, relative to nominal beam energies. More
	advanced formats may include polarization, etc. The current
	implementation carries beam polarization through, if specified.

	The code is very similar to the energy scan described above.

	However, we must include a file-handle manager for the beam-event
	files. Two different processes may access a given beam-event file at
	the same time (i.e., serially but alternating). Accessing an open
	file from two different units is non-standard and not supported by all
	compilers. Therefore, we keep a global registry of open files,
	associated units, and reference counts. The [[beam_events_t]] objects
	act as proxies to this registry.
	<<[[sf_beam_events.f90]]>>=
	<<File header>>

	module sf_beam_events

	<<Use kinds>>
	<<Use strings>>
	use file_registries
	use pdg_arrays
	use model_data
	use flavors
	use quantum_numbers
	use state_matrices
	use polarizations
	use sf_base

	<<Standard module head>>

	<<SF beam events: public>>

	<<SF beam events: types>>

	<<SF beam events: variables>>

	interface
	<<SF beam events: sub interfaces>>
	end interface

	contains

	<<SF beam events: main procedures>>

	end module sf_beam_events
	@ %def sf_beam_events
	@
	<<[[sf_beam_events_sub.f90]]>>=
	<<File header>>

	submodule (sf_beam_events) sf_beam_events_s

	use io_units
	use diagnostics
	use lorentz

	implicit none

	contains

	<<SF beam events: procedures>>

	end submodule sf_beam_events_s

	@ %def sf_beam_events_s
	@
	\subsection{The beam-data file registry}
	We manage data files via the [[file_registries]] module. To this end,
	we keep the registry as a private module variable here.

	This is public only for the unit tests.
	<<SF beam events: public>>=
	public :: beam_file_registry
	<<SF beam events: variables>>=
	type(file_registry_t), save :: beam_file_registry

	@ %def beam_file_registry
	@
	\subsection{Data type}
	<<SF beam events: public>>=
	public :: beam_events_data_t
	<<SF beam events: types>>=
	type, extends(sf_data_t) :: beam_events_data_t
	private
	type(flavor_t), dimension(2) :: flv_in
	type(string_t) :: dir
	type(string_t) :: file
	type(string_t) :: fqn
	integer :: unit = 0
	logical :: warn_eof = .true.
	contains
	<<SF beam events: beam events data: TBP>>
	end type beam_events_data_t

	@ %def beam_events_data_t
	<<SF beam events: beam events data: TBP>>=
	procedure :: init => beam_events_data_init
	<<SF beam events: sub interfaces>>=
	module subroutine beam_events_data_init &
	(data, model, pdg_in, dir, file, warn_eof)
	class(beam_events_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	type(string_t), intent(in) :: dir
	type(string_t), intent(in) :: file
	logical, intent(in), optional :: warn_eof
	end subroutine beam_events_data_init
	<<SF beam events: procedures>>=
	module subroutine beam_events_data_init &
	(data, model, pdg_in, dir, file, warn_eof)
	class(beam_events_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	type(string_t), intent(in) :: dir
	type(string_t), intent(in) :: file
	logical, intent(in), optional :: warn_eof
	if (any (pdg_in%get_length () /= 1)) then
	call msg_fatal ("Beam events: incoming beam particles must be unique")
	end if
	call data%flv_in(1)%init (pdg_in(1)%get (1), model)
	call data%flv_in(2)%init (pdg_in(2)%get (1), model)
	data%dir = dir
	data%file = file
	if (present (warn_eof)) data%warn_eof = warn_eof
	end subroutine beam_events_data_init

	@ %def beam_events_data_init
	@ Return true since this spectrum is always in generator mode.
	<<SF beam events: beam events data: TBP>>=
	procedure :: is_generator => beam_events_data_is_generator
	<<SF beam events: sub interfaces>>=
	module function beam_events_data_is_generator (data) result (flag)
	class(beam_events_data_t), intent(in) :: data
	logical :: flag
	end function beam_events_data_is_generator
	<<SF beam events: procedures>>=
	module function beam_events_data_is_generator (data) result (flag)
	class(beam_events_data_t), intent(in) :: data
	logical :: flag
	flag = .true.
	end function beam_events_data_is_generator

	@ %def beam_events_data_is_generator
	@ The number of parameters is two. They are free parameters.
	<<SF beam events: beam events data: TBP>>=
	procedure :: get_n_par => beam_events_data_get_n_par
	<<SF beam events: sub interfaces>>=
	module function beam_events_data_get_n_par (data) result (n)
	class(beam_events_data_t), intent(in) :: data
	integer :: n
	end function beam_events_data_get_n_par
	<<SF beam events: procedures>>=
	module function beam_events_data_get_n_par (data) result (n)
	class(beam_events_data_t), intent(in) :: data
	integer :: n
	n = 2
	end function beam_events_data_get_n_par

	@ %def beam_events_data_get_n_par
	<<SF beam events: beam events data: TBP>>=
	procedure :: get_pdg_out => beam_events_data_get_pdg_out
	<<SF beam events: sub interfaces>>=
	module subroutine beam_events_data_get_pdg_out (data, pdg_out)
	class(beam_events_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	end subroutine beam_events_data_get_pdg_out
	<<SF beam events: procedures>>=
	module subroutine beam_events_data_get_pdg_out (data, pdg_out)
	class(beam_events_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer :: i, n
	n = 2
	do i = 1, n
	pdg_out(i) = data%flv_in(i)%get_pdg ()
	end do
	end subroutine beam_events_data_get_pdg_out

	@ %def beam_events_data_get_pdg_out
	@ Allocate the interaction record. Due to a gfortran 7/8/9 bug has to
	remain in the main module.
	<<SF beam events: beam events data: TBP>>=
	procedure :: allocate_sf_int => beam_events_data_allocate_sf_int
	<<SF beam events: main procedures>>=
	subroutine beam_events_data_allocate_sf_int (data, sf_int)
	class(beam_events_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (beam_events_t :: sf_int)
	end subroutine beam_events_data_allocate_sf_int

	@ %def beam_events_data_allocate_sf_int
	@ Output
	<<SF beam events: beam events data: TBP>>=
	procedure :: write => beam_events_data_write
	<<SF beam events: sub interfaces>>=
	module subroutine beam_events_data_write (data, unit, verbose)
	class(beam_events_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine beam_events_data_write
	<<SF beam events: procedures>>=
	module subroutine beam_events_data_write (data, unit, verbose)
	class(beam_events_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "Beam-event file data:"
	write (u, "(3x,A,A,A,A)") "prt_in = ", &
	char (data%flv_in(1)%get_name ()), &
	", ", char (data%flv_in(2)%get_name ())
	write (u, "(3x,A,A,A)") "file = '", char (data%file), "'"
	write (u, "(3x,A,I0)") "unit = ", data%unit
	write (u, "(3x,A,L1)") "warn = ", data%warn_eof
	end subroutine beam_events_data_write

	@ %def beam_events_data_write
	@ The data file needs to be opened and closed explicitly. The
	open/close message is communicated to the file handle registry, which
	does the actual work.

	We determine first whether to look in the local directory or in the
	given system directory.
	<<SF beam events: beam events data: TBP>>=
	procedure :: open => beam_events_data_open
	procedure :: close => beam_events_data_close
	<<SF beam events: sub interfaces>>=
	module subroutine beam_events_data_open (data)
	class(beam_events_data_t), intent(inout) :: data
	end subroutine beam_events_data_open
	module subroutine beam_events_data_close (data)
	class(beam_events_data_t), intent(inout) :: data
	end subroutine beam_events_data_close
	<<SF beam events: procedures>>=
	module subroutine beam_events_data_open (data)
	class(beam_events_data_t), intent(inout) :: data
	logical :: exist
	if (data%unit == 0) then
	data%fqn = data%file
	if (data%fqn == "") &
	call msg_fatal ("Beam events: $beam_events_file is not set")
	inquire (file = char (data%fqn), exist = exist)
	if (.not. exist) then
	data%fqn = data%dir // "/" // data%file
	inquire (file = char (data%fqn), exist = exist)
	if (.not. exist) then
	data%fqn = ""
	call msg_fatal ("Beam events: file '" &
	// char (data%file) // "' not found")
	return
	end if
	end if
	call msg_message ("Beam events: reading from file '" &
	// char (data%file) // "'")
	call beam_file_registry%open (data%fqn, data%unit)
	else
	call msg_bug ("Beam events: file '" &
	// char (data%file) // "' is already open")
	end if
	end subroutine beam_events_data_open

	module subroutine beam_events_data_close (data)
	class(beam_events_data_t), intent(inout) :: data
	if (data%unit /= 0) then
	call beam_file_registry%close (data%fqn)
	call msg_message ("Beam events: closed file '" &
	// char (data%file) // "'")
	data%unit = 0
	end if
	end subroutine beam_events_data_close

	@ %def beam_events_data_close
	@ Return the beam event file.
	<<SF beam events: beam events data: TBP>>=
	procedure :: get_beam_file => beam_events_data_get_beam_file
	<<SF beam events: sub interfaces>>=
	module function beam_events_data_get_beam_file (data) result (file)
	class(beam_events_data_t), intent(in) :: data
	type(string_t) :: file
	end function beam_events_data_get_beam_file
	<<SF beam events: procedures>>=
	module function beam_events_data_get_beam_file (data) result (file)
	class(beam_events_data_t), intent(in) :: data
	type(string_t) :: file
	file = "Beam events: " // data%file
	end function beam_events_data_get_beam_file

	@ %def beam_events_data_get_beam_file
	@
	\subsection{The beam events object}
	Flavor and polarization carried through, no radiated particles.
	<<SF beam events: public>>=
	public :: beam_events_t
	<<SF beam events: types>>=
	type, extends (sf_int_t) :: beam_events_t
	type(beam_events_data_t), pointer :: data => null ()
	integer :: count = 0
	contains
	<<SF beam events: beam events: TBP>>
	end type beam_events_t

	@ %def beam_events_t
	@ Type string: show beam events file.
	<<SF beam events: beam events: TBP>>=
	procedure :: type_string => beam_events_type_string
	<<SF beam events: sub interfaces>>=
	module function beam_events_type_string (object) result (string)
	class(beam_events_t), intent(in) :: object
	type(string_t) :: string
	end function beam_events_type_string
	<<SF beam events: procedures>>=
	module function beam_events_type_string (object) result (string)
	class(beam_events_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "Beam events: " // object%data%file
	else
	string = "Beam events: [undefined]"
	end if
	end function beam_events_type_string

	@ %def beam_events_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF beam events: beam events: TBP>>=
	procedure :: write => beam_events_write
	<<SF beam events: sub interfaces>>=
	module subroutine beam_events_write (object, unit, testflag)
	class(beam_events_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine beam_events_write
	<<SF beam events: procedures>>=
	module subroutine beam_events_write (object, unit, testflag)
	class(beam_events_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "Beam events data: [undefined]"
	end if
	end subroutine beam_events_write

	@ %def beam_events_write
	@
	<<SF beam events: beam events: TBP>>=
	procedure :: init => beam_events_init
	<<SF beam events: sub interfaces>>=
	module subroutine beam_events_init (sf_int, data)
	class(beam_events_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	end subroutine beam_events_init
	<<SF beam events: procedures>>=
	module subroutine beam_events_init (sf_int, data)
	class(beam_events_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	real(default), dimension(2) :: m2
	real(default), dimension(0) :: mr2
	type(quantum_numbers_mask_t), dimension(4) :: mask
	integer, dimension(4) :: hel_lock
	type(quantum_numbers_t), dimension(4) :: qn_fc, qn_hel, qn
	type(polarization_t), target :: pol1, pol2
	type(polarization_iterator_t) :: it_hel1, it_hel2
	integer :: i
	select type (data)
	type is (beam_events_data_t)
	m2 = data%flv_in%get_mass () ** 2
	hel_lock = [3, 4, 1, 2]
	mask = quantum_numbers_mask (.false., .false., .false.)
	call sf_int%base_init (mask, m2, mr2, m2, hel_lock = hel_lock)
	sf_int%data => data
	do i = 1, 2
	call qn_fc(i)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i)))
	call qn_fc(i+2)%init ( &
	flv = data%flv_in(i), &
	col = color_from_flavor (data%flv_in(i)))
	end do
	call pol1%init_generic (data%flv_in(1))
	call it_hel1%init (pol1)
	do while (it_hel1%is_valid ())
	qn_hel(1) = it_hel1%get_quantum_numbers ()
	qn_hel(3) = it_hel1%get_quantum_numbers ()
	call pol2%init_generic (data%flv_in(2))
	call it_hel2%init (pol2)
	do while (it_hel2%is_valid ())
	qn_hel(2) = it_hel2%get_quantum_numbers ()
	qn_hel(4) = it_hel2%get_quantum_numbers ()
	qn = qn_hel .merge. qn_fc
	call sf_int%add_state (qn)
	call it_hel2%advance ()
	end do
	! call pol2%final ()
	call it_hel1%advance ()
	end do
	! call pol1%final ()
	call sf_int%freeze ()
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	call sf_int%data%open ()
	sf_int%status = SF_INITIAL
	end select
	end subroutine beam_events_init

	@ %def beam_events_init
	@ This spectrum type needs a finalizer, which closes the data file.
	<<SF beam events: beam events: TBP>>=
	procedure :: final => sf_beam_events_final
	<<SF beam events: sub interfaces>>=
	module subroutine sf_beam_events_final (object)
	class(beam_events_t), intent(inout) :: object
	end subroutine sf_beam_events_final
	<<SF beam events: procedures>>=
	module subroutine sf_beam_events_final (object)
	class(beam_events_t), intent(inout) :: object
	call object%data%close ()
	call object%interaction_t%final ()
	end subroutine sf_beam_events_final

	@ %def sf_beam_events_final
	@
	\subsection{Kinematics}
	Refer to the [[data]] component.
	<<SF beam events: beam events: TBP>>=
	procedure :: is_generator => beam_events_is_generator
	<<SF beam events: sub interfaces>>=
	module function beam_events_is_generator (sf_int) result (flag)
	class(beam_events_t), intent(in) :: sf_int
	logical :: flag
	end function beam_events_is_generator
	<<SF beam events: procedures>>=
	module function beam_events_is_generator (sf_int) result (flag)
	class(beam_events_t), intent(in) :: sf_int
	logical :: flag
	flag = sf_int%data%is_generator ()
	end function beam_events_is_generator

	@ %def beam_events_is_generator
	@ Generate free parameters. We read them from file.
	<<SF beam events: beam events: TBP>>=
	procedure :: generate_free => beam_events_generate_free
	<<SF beam events: sub interfaces>>=
	recursive module subroutine beam_events_generate_free &
	(sf_int, r, rb, x_free)
	class(beam_events_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	end subroutine beam_events_generate_free
	<<SF beam events: procedures>>=
	recursive module subroutine beam_events_generate_free &
	(sf_int, r, rb, x_free)
	class(beam_events_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	integer :: iostat
	associate (data => sf_int%data)
	if (data%unit /= 0) then
	read (data%unit, fmt=*, iostat=iostat) r
	if (iostat > 0) then
	write (msg_buffer, "(A,I0,A)") &
	"Beam events: I/O error after reading ", sf_int%count, &
	" events"
	call msg_fatal ()
	else if (iostat < 0) then
	if (sf_int%count == 0) then
	call msg_fatal ("Beam events: file is empty")
	else if (sf_int%data%warn_eof) then
	write (msg_buffer, "(A,I0,A)") &
	"Beam events: End of file after reading ", sf_int%count, &
	" events, rewinding"
	call msg_warning ()
	end if
	rewind (data%unit)
	sf_int%count = 0
	call sf_int%generate_free (r, rb, x_free)
	else
	sf_int%count = sf_int%count + 1
	rb = 1 - r
	x_free = x_free * product (r)
	end if
	else
	call msg_bug ("Beam events: file is not open for reading")
	end if
	end associate
	end subroutine beam_events_generate_free

	@ %def beam_events_generate_free
	@ Set kinematics. Trivial transfer since this is a pure generator.
	The [[map]] flag doesn't apply.
	<<SF beam events: beam events: TBP>>=
	procedure :: complete_kinematics => beam_events_complete_kinematics
	<<SF beam events: sub interfaces>>=
	module subroutine beam_events_complete_kinematics &
	(sf_int, x, xb, f, r, rb, map)
	class(beam_events_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	end subroutine beam_events_complete_kinematics
	<<SF beam events: procedures>>=
	module subroutine beam_events_complete_kinematics &
	(sf_int, x, xb, f, r, rb, map)
	class(beam_events_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	if (map) then
	call msg_fatal ("Beam events: map flag not supported")
	else
	x = r
	xb= rb
	f = 1
	end if
	call sf_int%reduce_momenta (x)
	end subroutine beam_events_complete_kinematics

	@ %def beam_events_complete_kinematics
	@ Compute inverse kinematics. Trivial in this case.
	<<SF beam events: beam events: TBP>>=
	procedure :: inverse_kinematics => beam_events_inverse_kinematics
	<<SF beam events: sub interfaces>>=
	module subroutine beam_events_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(beam_events_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	end subroutine beam_events_inverse_kinematics
	<<SF beam events: procedures>>=
	module subroutine beam_events_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(beam_events_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	call msg_fatal ("Beam events: map flag not supported")
	else
	r = x
	rb= xb
	f = 1
	end if
	if (set_mom) then
	call sf_int%reduce_momenta (x)
	end if
	end subroutine beam_events_inverse_kinematics

	@ %def beam_events_inverse_kinematics
	@
	\subsection{Beam events application}
	Trivial, just set the unit weight.
	<<SF beam events: beam events: TBP>>=
	procedure :: apply => beam_events_apply
	<<SF beam events: sub interfaces>>=
	module subroutine beam_events_apply &
	(sf_int, scale, negative_sf, rescale, i_sub)
	class(beam_events_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	end subroutine beam_events_apply
	<<SF beam events: procedures>>=
	module subroutine beam_events_apply &
	(sf_int, scale, negative_sf, rescale, i_sub)
	class(beam_events_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	real(default) :: f
	f = 1
	call sf_int%set_matrix_element (cmplx (f, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine beam_events_apply

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

	module sf_beam_events_ut
	use unit_tests
	use sf_beam_events_uti

	<<Standard module head>>

	<<SF beam events: public test>>

	contains

	<<SF beam events: test driver>>

	end module sf_beam_events_ut
	@ %def sf_beam_events_ut
	@
	<<[[sf_beam_events_uti.f90]]>>=
	<<File header>>

	module sf_beam_events_uti

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use numeric_utils, only: pacify
	use physics_defs, only: ELECTRON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use sf_aux
	use sf_base

	use sf_beam_events

	<<Standard module head>>

	<<SF beam events: test declarations>>

	contains

	<<SF beam events: tests>>

	end module sf_beam_events_uti
	@ %def sf_beam_events_ut
	@ API: driver for the unit tests below.
	<<SF beam events: public test>>=
	public :: sf_beam_events_test
	<<SF beam events: test driver>>=
	subroutine sf_beam_events_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF beam events: execute tests>>
	end subroutine sf_beam_events_test

	@ %def sf_beam_events_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF beam events: execute tests>>=
	call test (sf_beam_events_1, "sf_beam_events_1", &
	"structure function configuration", &
	u, results)
	<<SF beam events: test declarations>>=
	public :: sf_beam_events_1
	<<SF beam events: tests>>=
	subroutine sf_beam_events_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t), dimension(2) :: pdg_in
	type(pdg_array_t), dimension(2) :: pdg_out
	integer, dimension(:), allocatable :: pdg1, pdg2
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_beam_events_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&beam-events structure function data"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	allocate (beam_events_data_t :: data)
	select type (data)
	type is (beam_events_data_t)
	call data%init (model, pdg_in, var_str (""), var_str ("beam_events.dat"))
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	pdg2 = pdg_out(2)
	write (u, "(2x,99(1x,I0))") pdg1, pdg2

	call model%final ()

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

	end subroutine sf_beam_events_1

	@ %def sf_beam_events_1
	@
	\subsubsection{Probe the structure-function object}
	Active the beam event reader, generate an event.
	<<SF beam events: execute tests>>=
	call test (sf_beam_events_2, "sf_beam_events_2", &
	"generate event", &
	u, results)
	<<SF beam events: test declarations>>=
	public :: sf_beam_events_2
	<<SF beam events: tests>>=
	subroutine sf_beam_events_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: x_free, f
	integer :: i

	write (u, "(A)") "* Test output: sf_beam_events_2"
	write (u, "(A)") "* Purpose: initialize and display &
	&beam-events structure function data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv(1)%init (ELECTRON, model)
	call flv(2)%init (-ELECTRON, model)
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	call reset_interaction_counter ()

	allocate (beam_events_data_t :: data)
	select type (data)
	type is (beam_events_data_t)
	call data%init (model, pdg_in, &
	var_str (""), var_str ("test_beam_events.dat"))
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Set dummy parameters and generate x."
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0
	rb = 0
	x_free = 1
	call sf_int%generate_free (r, rb, x_free)
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,9(1x,F10.7))") "rb=", rb
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free
	select type (sf_int)
	type is (beam_events_t)
	write (u, "(A,1x,I0)") "count =", sf_int%count
	end select

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

	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate more events, rewind"
	write (u, "(A)")

	select type (sf_int)
	type is (beam_events_t)
	do i = 1, 3
	call sf_int%generate_free (r, rb, x_free)
	write (u, "(A,9(1x,F10.7))") "r =", r
	write (u, "(A,1x,I0)") "count =", sf_int%count
	end do
	end select

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_beam_events_2

	@ %def sf_beam_events_2
	@
	\subsubsection{Check the file handle registry}
	Open and close some files, checking the registry contents.
	<<SF beam events: execute tests>>=
	call test (sf_beam_events_3, "sf_beam_events_3", &
	"check registry", &
	u, results)
	<<SF beam events: test declarations>>=
	public :: sf_beam_events_3
	<<SF beam events: tests>>=
	subroutine sf_beam_events_3 (u)
	integer, intent(in) :: u
	integer :: u1

	write (u, "(A)") "* Test output: sf_beam_events_2"
	write (u, "(A)") "* Purpose: check file handle registry"
	write (u, "(A)")

	write (u, "(A)") "* Create some empty files"
	write (u, "(A)")

	u1 = free_unit ()
	open (u1, file = "sf_beam_events_f1.tmp", action="write", status="new")
	close (u1)
	open (u1, file = "sf_beam_events_f2.tmp", action="write", status="new")
	close (u1)
	open (u1, file = "sf_beam_events_f3.tmp", action="write", status="new")
	close (u1)

	write (u, "(A)") "* Empty registry"
	write (u, "(A)")

	call beam_file_registry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Insert three entries"
	write (u, "(A)")

	call beam_file_registry%open (var_str ("sf_beam_events_f3.tmp"))
	call beam_file_registry%open (var_str ("sf_beam_events_f2.tmp"))
	call beam_file_registry%open (var_str ("sf_beam_events_f1.tmp"))
	call beam_file_registry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Open a second channel"
	write (u, "(A)")

	call beam_file_registry%open (var_str ("sf_beam_events_f2.tmp"))
	call beam_file_registry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Close second entry twice"
	write (u, "(A)")

	call beam_file_registry%close (var_str ("sf_beam_events_f2.tmp"))
	call beam_file_registry%close (var_str ("sf_beam_events_f2.tmp"))
	call beam_file_registry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Close last entry"
	write (u, "(A)")

	call beam_file_registry%close (var_str ("sf_beam_events_f3.tmp"))
	call beam_file_registry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Close remaining entry"
	write (u, "(A)")

	call beam_file_registry%close (var_str ("sf_beam_events_f1.tmp"))
	call beam_file_registry%write (u)

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

	open (u1, file = "sf_beam_events_f1.tmp", action="write")
	close (u1, status = "delete")
	open (u1, file = "sf_beam_events_f2.tmp", action="write")
	close (u1, status = "delete")
	open (u1, file = "sf_beam_events_f3.tmp", action="write")
	close (u1, status = "delete")

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

	end subroutine sf_beam_events_3

	@ %def sf_beam_events_3
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{Lepton collider beamstrahlung: CIRCE1}

	<<[[sf_circe1.f90]]>>=
	<<File header>>

	module sf_circe1

	<<Use kinds>>
	use kinds, only: double
	<<Use strings>>
	use rng_base
	use pdg_arrays
	use model_data
	use flavors
	use polarizations
	use sf_mappings
	use sf_base
	use circe1, circe1_rng_t => rng_type !NODEP!

	<<Standard module head>>

	<<SF circe1: public>>

	<<SF circe1: types>>

	interface
	<<SF circe1: sub interfaces>>
	end interface

	contains

	<<SF circe1: main procedures>>

	end module sf_circe1
	@ %def sf_circe1
	@
	<<[[sf_circe1_sub.f90]]>>=
	<<File header>>

	submodule (sf_circe1) sf_circe1_s

	use io_units
	use format_defs, only: FMT_17, FMT_19
	use diagnostics
	use physics_defs, only: ELECTRON, PHOTON
	use lorentz
	use colors
	use quantum_numbers
	use state_matrices

	implicit none

	contains

	<<SF circe1: procedures>>

	end submodule sf_circe1_s

	@ %def sf_circe1_s
	@
	\subsection{Physics}
	Beamstrahlung is applied before ISR. The [[CIRCE1]] implementation has
	a single structure function for both beams (which makes sense since it
	has to be switched on or off for both beams simultaneously).
	Nevertheless it is factorized:

	The functional form in the [[CIRCE1]] parameterization is defined for
	electrons or photons
	\begin{equation}
	f(x) = \alpha\,x^\beta\,(1-x)^\gamma
	\end{equation}
	for $x<1-\epsilon$ (resp.\ $x>\epsilon$ in the photon case). In the
	remaining interval, the standard form is zero, with a delta
	singularity at $x=1$ (resp.\ $x=0$). Equivalently, the delta part may be
	distributed uniformly among this interval. This latter form is
	implemented in the [[kirke]] version of the [[CIRCE1]] subroutines, and
	is used here.

	The parameter [[circe1\_eps]] sets the peak mapping of the [[CIRCE1]]
	structure function. Its default value is $10^{-5}$.
	The other parameters are the parameterization version and revision
	number, the accelerator type, and the $\sqrt{s}$ value used by
	[[CIRCE1]]. The chattiness can also be set.

	Since the energy is distributed in a narrow region around unity (for
	electrons) or zero (for photons), it is advantageous to map the
	interval first. The mapping is controlled by the parameter
	[[circe1\_epsilon]] which is taken from the [[CIRCE1]]
	internal data structure.

	The $\sqrt{s}$ value, if not explicitly set, is taken from the
	process data. Note that interpolating $\sqrt{s}$ is not recommended;
	one should rather choose one of the distinct values known to [[CIRCE1]].

	\subsection{The CIRCE1 data block}
	The CIRCE1 parameters are: The incoming flavors, the flags whether the photon
	or the lepton is the parton in the hard interaction, the flags for the
	generation mode (generator/mapping/no mapping), the mapping parameter
	$\epsilon$, $\sqrt{s}$ and several steering parameters: [[ver]],
	[[rev]], [[acc]], [[chat]].

	In generator mode, the $x$ values are actually discarded and a random number
	generator is used instead.
	<<SF circe1: public>>=
	public :: circe1_data_t
	<<SF circe1: types>>=
	type, extends (sf_data_t) :: circe1_data_t
	private
	class(model_data_t), pointer :: model => null ()
	type(flavor_t), dimension(2) :: flv_in
	integer, dimension(2) :: pdg_in
	real(default), dimension(2) :: m_in = 0
	logical, dimension(2) :: photon = .false.
	logical :: generate = .false.
	class(rng_factory_t), allocatable :: rng_factory
	real(default) :: sqrts = 0
	real(default) :: eps = 0
	integer :: ver = 0
	integer :: rev = 0
	character(6) :: acc = "?"
	integer :: chat = 0
	logical :: with_radiation = .false.
	contains
	<<SF circe1: circe1 data: TBP>>
	end type circe1_data_t

	@ %def circe1_data_t
	@
	<<SF circe1: circe1 data: TBP>>=
	procedure :: init => circe1_data_init
	<<SF circe1: sub interfaces>>=
	module subroutine circe1_data_init &
	(data, model, pdg_in, sqrts, eps, out_photon, &
	ver, rev, acc, chat, with_radiation)
	class(circe1_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	real(default), intent(in) :: sqrts
	real(default), intent(in) :: eps
	logical, dimension(2), intent(in) :: out_photon
	character(*), intent(in) :: acc
	integer, intent(in) :: ver, rev, chat
	logical, intent(in) :: with_radiation
	end subroutine circe1_data_init
	<<SF circe1: procedures>>=
	module subroutine circe1_data_init &
	(data, model, pdg_in, sqrts, eps, out_photon, &
	ver, rev, acc, chat, with_radiation)
	class(circe1_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	real(default), intent(in) :: sqrts
	real(default), intent(in) :: eps
	logical, dimension(2), intent(in) :: out_photon
	character(*), intent(in) :: acc
	integer, intent(in) :: ver, rev, chat
	logical, intent(in) :: with_radiation
	data%model => model
	if (any (pdg_in%get_length () /= 1)) then
	call msg_fatal ("CIRCE1: incoming beam particles must be unique")
	end if
	call data%flv_in(1)%init (pdg_in(1)%get (1), model)
	call data%flv_in(2)%init (pdg_in(2)%get (1), model)
	data%pdg_in = data%flv_in%get_pdg ()
	data%m_in = data%flv_in%get_mass ()
	data%sqrts = sqrts
	data%eps = eps
	data%photon = out_photon
	data%ver = ver
	data%rev = rev
	data%acc = acc
	data%chat = chat
	data%with_radiation = with_radiation
	call data%check ()
	call circex (0.d0, 0.d0, dble (data%sqrts), &
	data%acc, data%ver, data%rev, data%chat)
	end subroutine circe1_data_init

	@ %def circe1_data_init
	@ Activate the generator mode. We import a RNG factory into the data
	type, which can then spawn RNG generator objects.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: set_generator_mode => circe1_data_set_generator_mode
	<<SF circe1: sub interfaces>>=
	module subroutine circe1_data_set_generator_mode (data, rng_factory)
	class(circe1_data_t), intent(inout) :: data
	class(rng_factory_t), intent(inout), allocatable :: rng_factory
	end subroutine circe1_data_set_generator_mode
	<<SF circe1: procedures>>=
	module subroutine circe1_data_set_generator_mode (data, rng_factory)
	class(circe1_data_t), intent(inout) :: data
	class(rng_factory_t), intent(inout), allocatable :: rng_factory
	data%generate = .true.
	call move_alloc (from = rng_factory, to = data%rng_factory)
	end subroutine circe1_data_set_generator_mode

	@ %def circe1_data_set_generator_mode
	@ Handle error conditions.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: check => circe1_data_check
	<<SF circe1: sub interfaces>>=
	module subroutine circe1_data_check (data)
	class(circe1_data_t), intent(in) :: data
	end subroutine circe1_data_check
	<<SF circe1: procedures>>=
	module subroutine circe1_data_check (data)
	class(circe1_data_t), intent(in) :: data
	type(flavor_t) :: flv_electron, flv_photon
	call flv_electron%init (ELECTRON, data%model)
	call flv_photon%init (PHOTON, data%model)
	if (.not. flv_electron%is_defined () &
	.or. .not. flv_photon%is_defined ()) then
	call msg_fatal ("CIRCE1: model must contain photon and electron")
	end if
	if (any (abs (data%pdg_in) /= ELECTRON) &
	.or. (data%pdg_in(1) /= - data%pdg_in(2))) then
	call msg_fatal ("CIRCE1: applicable only for e+e- or e-e+ collisions")
	end if
	if (data%eps <= 0) then
	call msg_error ("CIRCE1: circe1_eps = 0: integration will &
	&miss x=1 peak")
	end if
	end subroutine circe1_data_check

	@ %def circe1_data_check
	@ Output
	<<SF circe1: circe1 data: TBP>>=
	procedure :: write => circe1_data_write
	<<SF circe1: sub interfaces>>=
	module subroutine circe1_data_write (data, unit, verbose)
	class(circe1_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine circe1_data_write
	<<SF circe1: procedures>>=
	module subroutine circe1_data_write (data, unit, verbose)
	class(circe1_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	logical :: verb
	verb = .false.; if (present (verbose)) verb = verbose
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "CIRCE1 data:"
	write (u, "(3x,A,2(1x,A))") "prt_in =", &
	char (data%flv_in(1)%get_name ()), &
	char (data%flv_in(2)%get_name ())
	write (u, "(3x,A,2(1x,L1))") "photon =", data%photon
	write (u, "(3x,A,L1)") "generate = ", data%generate
	write (u, "(3x,A,2(1x," // FMT_19 // "))") "m_in =", data%m_in
	write (u, "(3x,A," // FMT_19 // ")") "sqrts = ", data%sqrts
	write (u, "(3x,A," // FMT_19 // ")") "eps = ", data%eps
	write (u, "(3x,A,I0)") "ver = ", data%ver
	write (u, "(3x,A,I0)") "rev = ", data%rev
	write (u, "(3x,A,A)") "acc = ", data%acc
	write (u, "(3x,A,I0)") "chat = ", data%chat
	write (u, "(3x,A,L1)") "with rad.= ", data%with_radiation
	if (data%generate) then
	if (verb) then
	call data%rng_factory%write (u)
	end if
	end if
	end subroutine circe1_data_write

	@ %def circe1_data_write
	@ Return true if this structure function is in generator mode. In
	that case, all parameters are free, otherwise bound. (We do not
	support mixed cases.) Default is: no generator.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: is_generator => circe1_data_is_generator
	<<SF circe1: sub interfaces>>=
	module function circe1_data_is_generator (data) result (flag)
	class(circe1_data_t), intent(in) :: data
	logical :: flag
	end function circe1_data_is_generator
	<<SF circe1: procedures>>=
	module function circe1_data_is_generator (data) result (flag)
	class(circe1_data_t), intent(in) :: data
	logical :: flag
	flag = data%generate
	end function circe1_data_is_generator

	@ %def circe1_data_is_generator
	@ The number of parameters is two, collinear splitting for the two beams.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: get_n_par => circe1_data_get_n_par
	<<SF circe1: sub interfaces>>=
	module function circe1_data_get_n_par (data) result (n)
	class(circe1_data_t), intent(in) :: data
	integer :: n
	end function circe1_data_get_n_par
	<<SF circe1: procedures>>=
	module function circe1_data_get_n_par (data) result (n)
	class(circe1_data_t), intent(in) :: data
	integer :: n
	n = 2
	end function circe1_data_get_n_par

	@ %def circe1_data_get_n_par
	@ Return the outgoing particles PDG codes. This is either the incoming
	particle (if a photon is radiated), or the photon if that is the particle
	of the hard interaction. The latter is determined via the [[photon]]
	flag. There are two entries for the two beams.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: get_pdg_out => circe1_data_get_pdg_out
	<<SF circe1: sub interfaces>>=
	module subroutine circe1_data_get_pdg_out (data, pdg_out)
	class(circe1_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	end subroutine circe1_data_get_pdg_out
	<<SF circe1: procedures>>=
	module subroutine circe1_data_get_pdg_out (data, pdg_out)
	class(circe1_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer :: i, n
	n = 2
	do i = 1, n
	if (data%photon(i)) then
	pdg_out(i) = PHOTON
	else
	pdg_out(i) = data%pdg_in(i)
	end if
	end do
	end subroutine circe1_data_get_pdg_out

	@ %def circe1_data_get_pdg_out
	@ This variant is not inherited, it returns integers.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: get_pdg_int => circe1_data_get_pdg_int
	<<SF circe1: sub interfaces>>=
	module function circe1_data_get_pdg_int (data) result (pdg)
	class(circe1_data_t), intent(in) :: data
	integer, dimension(2) :: pdg
	end function circe1_data_get_pdg_int
	<<SF circe1: procedures>>=
	module function circe1_data_get_pdg_int (data) result (pdg)
	class(circe1_data_t), intent(in) :: data
	integer, dimension(2) :: pdg
	integer :: i
	do i = 1, 2
	if (data%photon(i)) then
	pdg(i) = PHOTON
	else
	pdg(i) = data%pdg_in(i)
	end if
	end do
	end function circe1_data_get_pdg_int

	@ %def circe1_data_get_pdg_int
	@ Allocate the interaction record. Due to the gfortran 7/8/9 bug this
	has to remain in the main module.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: allocate_sf_int => circe1_data_allocate_sf_int
	<<SF circe1: main procedures>>=
	subroutine circe1_data_allocate_sf_int (data, sf_int)
	class(circe1_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (circe1_t :: sf_int)
	end subroutine circe1_data_allocate_sf_int

	@ %def circe1_data_allocate_sf_int
	@ Return the accelerator type.
	<<SF circe1: circe1 data: TBP>>=
	procedure :: get_beam_file => circe1_data_get_beam_file
	<<SF circe1: sub interfaces>>=
	module function circe1_data_get_beam_file (data) result (file)
	class(circe1_data_t), intent(in) :: data
	type(string_t) :: file
	end function circe1_data_get_beam_file
	<<SF circe1: procedures>>=
	module function circe1_data_get_beam_file (data) result (file)
	class(circe1_data_t), intent(in) :: data
	type(string_t) :: file
	file = "CIRCE1: " // data%acc
	end function circe1_data_get_beam_file

	@ %def circe1_data_get_beam_file
	@
	\subsection{Random Number Generator for CIRCE}
	The CIRCE implementation now supports a generic random-number
	generator object that allows for a local state as a component. To
	support this, we must extend the abstract type provided by CIRCE and
	delegate the generator call to the (also abstract) RNG used by WHIZARD.
	<<SF circe1: types>>=
	type, extends (circe1_rng_t) :: rng_obj_t
	class(rng_t), allocatable :: rng
	contains
	procedure :: generate => rng_obj_generate
	end type rng_obj_t

	@ %def rng_obj_t
	<<SF circe1: sub interfaces>>=
	module subroutine rng_obj_generate (rng_obj, u)
	class(rng_obj_t), intent(inout) :: rng_obj
	real(double), intent(out) :: u
	end subroutine rng_obj_generate
	<<SF circe1: procedures>>=
	module subroutine rng_obj_generate (rng_obj, u)
	class(rng_obj_t), intent(inout) :: rng_obj
	real(double), intent(out) :: u
	real(default) :: x
	call rng_obj%rng%generate (x)
	u = x
	end subroutine rng_obj_generate

	@ %def rng_obj_generate
	@
	\subsection{The CIRCE1 object}
	This is a $2\to 4$ interaction, where, depending on the parameters, any two of
	the four outgoing particles are connected to the hard interactions, the others
	are radiated. Knowing that all particles are colorless, we do not have to
	deal with color.

	The flavors are sorted such that the first two particles are the incoming
	leptons, the next two are the radiated particles, and the last two are the
	partons initiating the hard interaction.

	CIRCE1 does not support polarized beams explicitly. For simplicity, we
	nevertheless carry beam polarization through to the outgoing electrons and
	make the photons unpolarized.

	In the case that no radiated particle is kept (which actually is the
	default), polarization is always transferred to the electrons, too. If
	there is a recoil photon in the event, the radiated particles are 3
	and 4, respectively, and 5 and 6 are the outgoing ones (triggering the
	hard scattering process), while in the case of no radiation, the
	outgoing particles are 3 and 4, respectively. In the case of the
	electron being the radiated particle, helicity is not kept.
	<<SF circe1: public>>=
	public :: circe1_t
	<<SF circe1: types>>=
	type, extends (sf_int_t) :: circe1_t
	type(circe1_data_t), pointer :: data => null ()
	real(default), dimension(2) :: x = 0
	real(default), dimension(2) :: xb= 0
	real(default) :: f = 0
	logical, dimension(2) :: continuum = .true.
	logical, dimension(2) :: peak = .true.
	type(rng_obj_t) :: rng_obj
	contains
	<<SF circe1: circe1: TBP>>
	end type circe1_t

	@ %def circe1_t
	@ Type string: has to be here, but there is no string variable on which CIRCE1
	depends. Hence, a dummy routine.
	<<SF circe1: circe1: TBP>>=
	procedure :: type_string => circe1_type_string
	<<SF circe1: sub interfaces>>=
	module function circe1_type_string (object) result (string)
	class(circe1_t), intent(in) :: object
	type(string_t) :: string
	end function circe1_type_string
	<<SF circe1: procedures>>=
	module function circe1_type_string (object) result (string)
	class(circe1_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "CIRCE1: beamstrahlung"
	else
	string = "CIRCE1: [undefined]"
	end if
	end function circe1_type_string

	@ %def circe1_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF circe1: circe1: TBP>>=
	procedure :: write => circe1_write
	<<SF circe1: sub interfaces>>=
	module subroutine circe1_write (object, unit, testflag)
	class(circe1_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine circe1_write
	<<SF circe1: procedures>>=
	module subroutine circe1_write (object, unit, testflag)
	class(circe1_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	if (object%data%generate) call object%rng_obj%rng%write (u)
	if (object%status >= SF_DONE_KINEMATICS) then
	write (u, "(3x,A,2(1x," // FMT_17 // "))") "x =", object%x
	write (u, "(3x,A,2(1x," // FMT_17 // "))") "xb=", object%xb
	if (object%status >= SF_FAILED_EVALUATION) then
	write (u, "(3x,A,1x," // FMT_17 // ")") "f =", object%f
	end if
	end if
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "CIRCE1 data: [undefined]"
	end if
	end subroutine circe1_write

	@ %def circe1_write
	@
	<<SF circe1: circe1: TBP>>=
	procedure :: init => circe1_init
	<<SF circe1: sub interfaces>>=
	module subroutine circe1_init (sf_int, data)
	class(circe1_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	end subroutine circe1_init
	<<SF circe1: procedures>>=
	module subroutine circe1_init (sf_int, data)
	class(circe1_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	logical, dimension(6) :: mask_h
	type(quantum_numbers_mask_t), dimension(6) :: mask
	integer, dimension(6) :: hel_lock
	type(polarization_t), target :: pol1, pol2
	type(quantum_numbers_t), dimension(1) :: qn_fc1, qn_fc2
	type(flavor_t) :: flv_photon
	type(color_t) :: col0
	real(default), dimension(2) :: mi2, mr2, mo2
	type(quantum_numbers_t) :: qn_hel1, qn_hel2, qn_photon, qn1, qn2
	type(quantum_numbers_t), dimension(6) :: qn
	type(polarization_iterator_t) :: it_hel1, it_hel2
	hel_lock = 0
	mask_h = .false.
	select type (data)
	type is (circe1_data_t)
	mi2 = data%m_in**2
	if (data%with_radiation) then
	if (data%photon(1)) then
	hel_lock(1) = 3; hel_lock(3) = 1; mask_h(5) = .true.
	mr2(1) = mi2(1)
	mo2(1) = 0._default
	else
	hel_lock(1) = 5; hel_lock(5) = 1; mask_h(3) = .true.
	mr2(1) = 0._default
	mo2(1) = mi2(1)
	end if
	if (data%photon(2)) then
	hel_lock(2) = 4; hel_lock(4) = 2; mask_h(6) = .true.
	mr2(2) = mi2(2)
	mo2(2) = 0._default
	else
	hel_lock(2) = 6; hel_lock(6) = 2; mask_h(4) = .true.
	mr2(2) = 0._default
	mo2(2) = mi2(2)
	end if
	mask = quantum_numbers_mask (.false., .false., mask_h)
	call sf_int%base_init (mask, mi2, mr2, mo2, &
	hel_lock = hel_lock)
	sf_int%data => data
	call flv_photon%init (PHOTON, data%model)
	call col0%init ()
	call qn_photon%init (flv_photon, col0)
	call pol1%init_generic (data%flv_in(1))
	call qn_fc1(1)%init (flv = data%flv_in(1), col = col0)
	call pol2%init_generic (data%flv_in(2))
	call qn_fc2(1)%init (flv = data%flv_in(2), col = col0)
	call it_hel1%init (pol1)

	do while (it_hel1%is_valid ())
	qn_hel1 = it_hel1%get_quantum_numbers ()
	qn1 = qn_hel1 .merge. qn_fc1(1)
	qn(1) = qn1
	if (data%photon(1)) then
	qn(3) = qn1; qn(5) = qn_photon
	else
	qn(3) = qn_photon; qn(5) = qn1
	end if
	call it_hel2%init (pol2)
	do while (it_hel2%is_valid ())
	qn_hel2 = it_hel2%get_quantum_numbers ()
	qn2 = qn_hel2 .merge. qn_fc2(1)
	qn(2) = qn2
	if (data%photon(2)) then
	qn(4) = qn2; qn(6) = qn_photon
	else
	qn(4) = qn_photon; qn(6) = qn2
	end if
	call qn(3:4)%tag_radiated ()
	call sf_int%add_state (qn)
	call it_hel2%advance ()
	end do
	call it_hel1%advance ()
	end do
	! call pol1%final ()
	! call pol2%final ()
	call sf_int%freeze ()
	call sf_int%set_incoming ([1,2])
	call sf_int%set_radiated ([3,4])
	call sf_int%set_outgoing ([5,6])
	else
	if (data%photon(1)) then
	mask_h(3) = .true.
	mo2(1) = 0._default
	else
	hel_lock(1) = 3; hel_lock(3) = 1
	mo2(1) = mi2(1)
	end if
	if (data%photon(2)) then
	mask_h(4) = .true.
	mo2(2) = 0._default
	else
	hel_lock(2) = 4; hel_lock(4) = 2
	mo2(2) = mi2(2)
	end if
	mask = quantum_numbers_mask (.false., .false., mask_h)
	call sf_int%base_init (mask(1:4), mi2, [real(default) :: ], mo2, &
	hel_lock = hel_lock(1:4))
	sf_int%data => data
	call flv_photon%init (PHOTON, data%model)
	call col0%init ()
	call qn_photon%init (flv_photon, col0)
	call pol1%init_generic (data%flv_in(1))
	call qn_fc1(1)%init (flv = data%flv_in(1), col = col0)
	call pol2%init_generic (data%flv_in(2))
	call qn_fc2(1)%init (flv = data%flv_in(2), col = col0)
	call it_hel1%init (pol1)

	do while (it_hel1%is_valid ())
	qn_hel1 = it_hel1%get_quantum_numbers ()
	qn1 = qn_hel1 .merge. qn_fc1(1)
	qn(1) = qn1
	if (data%photon(1)) then
	qn(3) = qn_photon
	else
	qn(3) = qn1
	end if
	call it_hel2%init (pol2)
	do while (it_hel2%is_valid ())
	qn_hel2 = it_hel2%get_quantum_numbers ()
	qn2 = qn_hel2 .merge. qn_fc2(1)
	qn(2) = qn2
	if (data%photon(2)) then
	qn(4) = qn_photon
	else
	qn(4) = qn2
	end if
	call sf_int%add_state (qn(1:4))
	call it_hel2%advance ()
	end do
	call it_hel1%advance ()
	end do
	! call pol1%final ()
	! call pol2%final ()
	call sf_int%freeze ()
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	end if
	sf_int%status = SF_INITIAL
	end select
	if (sf_int%data%generate) then
	call sf_int%data%rng_factory%make (sf_int%rng_obj%rng)
	end if
	end subroutine circe1_init

	@ %def circe1_init
	@
	\subsection{Kinematics}
	Refer to the [[data]] component.
	<<SF circe1: circe1: TBP>>=
	procedure :: is_generator => circe1_is_generator
	<<SF circe1: sub interfaces>>=
	module function circe1_is_generator (sf_int) result (flag)
	class(circe1_t), intent(in) :: sf_int
	logical :: flag
	end function circe1_is_generator
	<<SF circe1: procedures>>=
	module function circe1_is_generator (sf_int) result (flag)
	class(circe1_t), intent(in) :: sf_int
	logical :: flag
	flag = sf_int%data%is_generator ()
	end function circe1_is_generator

	@ %def circe1_is_generator
	@ Generate free parameters, if generator mode is on. Otherwise, the
	parameters will be discarded.
	<<SF circe1: circe1: TBP>>=
	procedure :: generate_free => circe1_generate_free
	<<SF circe1: sub interfaces>>=
	module subroutine circe1_generate_free (sf_int, r, rb, x_free)
	class(circe1_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	end subroutine circe1_generate_free
	<<SF circe1: procedures>>=
	module subroutine circe1_generate_free (sf_int, r, rb, x_free)
	class(circe1_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free

	if (sf_int%data%generate) then
	call circe_generate (r, sf_int%data%get_pdg_int (), sf_int%rng_obj)
	rb = 1 - r
	x_free = x_free * product (r)
	else
	r = 0
	rb= 1
	end if
	end subroutine circe1_generate_free

	@ %def circe1_generate_free
	@ Generator mode: depending on the particle codes, call one of the
	available [[girce]] generators. Illegal particle code combinations
	should have been caught during data initialization.
	<<SF circe1: procedures>>=
	subroutine circe_generate (x, pdg, rng_obj)
	real(default), dimension(2), intent(out) :: x
	integer, dimension(2), intent(in) :: pdg
	class(rng_obj_t), intent(inout) :: rng_obj
	real(double) :: xc1, xc2
	select case (abs (pdg(1)))
	case (ELECTRON)
	select case (abs (pdg(2)))
	case (ELECTRON)
	call gircee (xc1, xc2, rng_obj = rng_obj)
	case (PHOTON)
	call girceg (xc1, xc2, rng_obj = rng_obj)
	end select
	case (PHOTON)
	select case (abs (pdg(2)))
	case (ELECTRON)
	call girceg (xc2, xc1, rng_obj = rng_obj)
	case (PHOTON)
	call gircgg (xc1, xc2, rng_obj = rng_obj)
	end select
	end select
	x = [xc1, xc2]
	end subroutine circe_generate

	@ %def circe_generate
	@ Set kinematics. The $r$ values (either from integration or from the
	generator call above) are copied to $x$ unchanged, and $f$ is unity.
	We store the $x$ values, so we can use them for the evaluation later.
	<<SF circe1: circe1: TBP>>=
	procedure :: complete_kinematics => circe1_complete_kinematics
	<<SF circe1: sub interfaces>>=
	module subroutine circe1_complete_kinematics &
	(sf_int, x, xb, f, r, rb, map)
	class(circe1_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	end subroutine circe1_complete_kinematics
	<<SF circe1: procedures>>=
	module subroutine circe1_complete_kinematics &
	(sf_int, x, xb, f, r, rb, map)
	class(circe1_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	x = r
	xb = rb
	sf_int%x = x
	sf_int%xb= xb
	f = 1
	if (sf_int%data%with_radiation) then
	call sf_int%split_momenta (x, xb)
	else
	call sf_int%reduce_momenta (x)
	end if
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end subroutine circe1_complete_kinematics

	@ %def circe1_complete_kinematics
	@ Compute inverse kinematics. In generator mode, the $r$ values are
	meaningless, but we copy them anyway.
	<<SF circe1: circe1: TBP>>=
	procedure :: inverse_kinematics => circe1_inverse_kinematics
	<<SF circe1: sub interfaces>>=
	module subroutine circe1_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(circe1_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	end subroutine circe1_inverse_kinematics
	<<SF circe1: procedures>>=
	module subroutine circe1_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(circe1_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	r = x
	rb = xb
	sf_int%x = x
	sf_int%xb= xb
	f = 1
	if (set_mom) then
	call sf_int%split_momenta (x, xb)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	end subroutine circe1_inverse_kinematics

	@ %def circe1_inverse_kinematics
	@
	\subsection{CIRCE1 application}
	CIRCE is applied for the two beams at once. We can safely assume that no
	structure functions are applied before this, so the incoming particles are
	on-shell electrons/positrons.

	The scale is ignored.
	<<SF circe1: circe1: TBP>>=
	procedure :: apply => circe1_apply
	<<SF circe1: sub interfaces>>=
	module subroutine circe1_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(circe1_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	end subroutine circe1_apply
	<<SF circe1: procedures>>=
	module subroutine circe1_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(circe1_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	real(default), dimension(2) :: xb
	real(double), dimension(2) :: xc
	real(double), parameter :: one = 1
	associate (data => sf_int%data)
	xc = sf_int%x
	xb = sf_int%xb
	if (data%generate) then
	sf_int%f = 1
	else
	sf_int%f = 0
	if (all (sf_int%continuum)) then
	sf_int%f = circe (xc(1), xc(2), data%pdg_in(1), data%pdg_in(2))
	end if
	if (sf_int%continuum(2) .and. sf_int%peak(1)) then
	sf_int%f = sf_int%f &
	+ circe (one, xc(2), data%pdg_in(1), data%pdg_in(2)) &
	* peak (xb(1), data%eps)
	end if
	if (sf_int%continuum(1) .and. sf_int%peak(2)) then
	sf_int%f = sf_int%f &
	+ circe (xc(1), one, data%pdg_in(1), data%pdg_in(2)) &
	* peak (xb(2), data%eps)
	end if
	if (all (sf_int%peak)) then
	sf_int%f = sf_int%f &
	+ circe (one, one, data%pdg_in(1), data%pdg_in(2)) &
	* peak (xb(1), data%eps) * peak (xb(2), data%eps)
	end if
	end if
	end associate
	call sf_int%set_matrix_element (cmplx (sf_int%f, kind=default))
	sf_int%status = SF_EVALUATED
	end subroutine circe1_apply

	@ %def circe1_apply
	@ This is a smeared delta peak at zero, as an endpoint singularity.
	We choose an exponentially decreasing function, starting at zero, with
	integral (from $0$ to $1$) $1-e^{-1/\epsilon}$. For small $\epsilon$,
	this reduces to one.
	<<SF circe1: procedures>>=
	function peak (x, eps) result (f)
	real(default), intent(in) :: x, eps
	real(default) :: f
	f = exp (-x / eps) / eps
	end function peak

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

	module sf_circe1_ut
	use unit_tests
	use sf_circe1_uti

	<<Standard module head>>

	<<SF circe1: public test>>

	contains

	<<SF circe1: test driver>>

	end module sf_circe1_ut
	@ %def sf_circe1_ut
	@
	<<[[sf_circe1_uti.f90]]>>=
	<<File header>>

	module sf_circe1_uti

	<<Use kinds>>
	use physics_defs, only: ELECTRON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use rng_base
	use sf_aux
	use sf_base

	use sf_circe1

	use rng_base_ut, only: rng_test_factory_t

	<<Standard module head>>

	<<SF circe1: test declarations>>

	contains

	<<SF circe1: tests>>

	end module sf_circe1_uti
	@ %def sf_circe1_ut
	@ API: driver for the unit tests below.
	<<SF circe1: public test>>=
	public :: sf_circe1_test
	<<SF circe1: test driver>>=
	subroutine sf_circe1_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF circe1: execute tests>>
	end subroutine sf_circe1_test

	@ %def sf_circe1_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF circe1: execute tests>>=
	call test (sf_circe1_1, "sf_circe1_1", &
	"structure function configuration", &
	u, results)
	<<SF circe1: test declarations>>=
	public :: sf_circe1_1
	<<SF circe1: tests>>=
	subroutine sf_circe1_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t), dimension(2) :: pdg_in
	type(pdg_array_t), dimension(2) :: pdg_out
	integer, dimension(:), allocatable :: pdg1, pdg2
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_circe1_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&CIRCE structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call model%init_qed_test ()
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	allocate (circe1_data_t :: data)
	call data%write (u)

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

	select type (data)
	type is (circe1_data_t)
	call data%init (model, pdg_in, &
	sqrts = 500._default, &
	eps = 1e-6_default, &
	out_photon = [.false., .false.], &
	ver = 0, &
	rev = 0, &
	acc = "SBAND", &
	chat = 0, &
	with_radiation = .true.)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	pdg2 = pdg_out(2)
	write (u, "(2x,99(1x,I0))") pdg1, pdg2

	call model%final ()

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

	end subroutine sf_circe1_1

	@ %def sf_circe1_1
	@
	\subsubsection{Test and probe structure function}
	Construct and display a structure function object based on the PDF builtin
	structure function.
	<<SF circe1: execute tests>>=
	call test (sf_circe1_2, "sf_circe1_2", &
	"structure function instance", &
	u, results)
	<<SF circe1: test declarations>>=
	public :: sf_circe1_2
	<<SF circe1: tests>>=
	subroutine sf_circe1_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	type(vector4_t), dimension(4) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_circe1_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&circe1 structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv(1)%init (ELECTRON, model)
	call flv(2)%init (-ELECTRON, model)
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	call reset_interaction_counter ()

	allocate (circe1_data_t :: data)
	select type (data)
	type is (circe1_data_t)
	call data%init (model, pdg_in, &
	sqrts = 500._default, &
	eps = 1e-6_default, &
	out_photon = [.false., .false.], &
	ver = 0, &
	rev = 0, &
	acc = "SBAND", &
	chat = 0, &
	with_radiation = .true.)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.95,0.85."
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = [0.9_default, 0.8_default]
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1, 2])

	call sf_int%seed_kinematics ([k1, k2])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb

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

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_circe1_2

	@ %def sf_circe1_2
	@
	\subsubsection{Generator mode}
	Construct and evaluate a structure function object in generator mode.
	<<SF circe1: execute tests>>=
	call test (sf_circe1_3, "sf_circe1_3", &
	"generator mode", &
	u, results)
	<<SF circe1: test declarations>>=
	public :: sf_circe1_3
	<<SF circe1: tests>>=
	subroutine sf_circe1_3 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(rng_factory_t), allocatable :: rng_factory
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, x_free

	write (u, "(A)") "* Test output: sf_circe1_3"
	write (u, "(A)") "* Purpose: initialize and fill &
	&circe1 structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_qed_test ()
	call flv(1)%init (ELECTRON, model)
	call flv(2)%init (-ELECTRON, model)
	pdg_in(1) = ELECTRON
	pdg_in(2) = -ELECTRON

	call reset_interaction_counter ()

	allocate (circe1_data_t :: data)
	allocate (rng_test_factory_t :: rng_factory)
	select type (data)
	type is (circe1_data_t)
	call data%init (model, pdg_in, &
	sqrts = 500._default, &
	eps = 1e-6_default, &
	out_photon = [.false., .false.], &
	ver = 0, &
	rev = 0, &
	acc = "SBAND", &
	chat = 0, &
	with_radiation = .true.)
	call data%set_generator_mode (rng_factory)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])
	select type (sf_int)
	type is (circe1_t)
	call sf_int%rng_obj%rng%init (3)
	end select

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Generate x"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0
	rb = 0
	x_free = 1
	call sf_int%generate_free (r, rb, x_free)
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

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

	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_circe1_3

	@ %def sf_circe1_3
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{Lepton Collider Beamstrahlung and Photon collider: CIRCE2}

	<<[[sf_circe2.f90]]>>=
	<<File header>>

	module sf_circe2

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use rng_base
	use selectors
	use pdg_arrays
	use model_data
	use flavors
	use polarizations
	use sf_base
	use circe2, circe2_rng_t => rng_type !NODEP!

	<<Standard module head>>

	<<SF circe2: public>>

	<<SF circe2: types>>

	interface
	<<SF circe2: sub interfaces>>
	end interface

	contains

	<<SF circe2: main procedures>>

	end module sf_circe2
	@ %def sf_circe2
	@
	<<[[sf_circe2_sub.f90]]>>=
	<<File header>>

	submodule (sf_circe2) sf_circe2_s

	use io_units
	use format_defs, only: FMT_19
	use numeric_utils
	use diagnostics
	use physics_defs, only: PHOTON, ELECTRON
	use lorentz
	use colors
	use helicities
	use quantum_numbers
	use state_matrices

	implicit none

	contains

	<<SF circe2: procedures>>

	end submodule sf_circe2_s

	@ %def sf_circe2_s
	@
	\subsection{Physics}
	[[CIRCE2]] describes photon spectra
	Beamstrahlung is applied before ISR. The [[CIRCE2]] implementation has
	a single structure function for both beams (which makes sense since it
	has to be switched on or off for both beams simultaneously).


	\subsection{The CIRCE2 data block}
	The CIRCE2 parameters are: file and collider specification, incoming
	(= outgoing) particles. The luminosity is returned by [[circe2_luminosity]].
	<<SF circe2: public>>=
	public :: circe2_data_t
	<<SF circe2: types>>=
	type, extends (sf_data_t) :: circe2_data_t
	private
	class(model_data_t), pointer :: model => null ()
	type(flavor_t), dimension(2) :: flv_in
	integer, dimension(2) :: pdg_in
	real(default) :: sqrts = 0
	logical :: polarized = .false.
	logical :: beams_polarized = .false.
	class(rng_factory_t), allocatable :: rng_factory
	type(string_t) :: filename
	type(string_t) :: file
	type(string_t) :: design
	real(default) :: lumi = 0
	real(default), dimension(4) :: lumi_hel_frac = 0
	integer, dimension(0:4) :: h1 = [0, -1, -1, 1, 1]
	integer, dimension(0:4) :: h2 = [0, -1, 1,-1, 1]
	integer :: error = 1
	contains
	<<SF circe2: circe2 data: TBP>>
	end type circe2_data_t

	@ %def circe2_data_t
	<<SF circe2: types>>=
	type(circe2_state) :: circe2_global_state

	@
	<<SF circe2: circe2 data: TBP>>=
	procedure :: init => circe2_data_init
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_data_init (data, os_data, model, pdg_in, &
	sqrts, polarized, beam_pol, file, design)
	class(circe2_data_t), intent(out) :: data
	type(os_data_t), intent(in) :: os_data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	real(default), intent(in) :: sqrts
	logical, intent(in) :: polarized, beam_pol
	type(string_t), intent(in) :: file, design
	end subroutine circe2_data_init
	<<SF circe2: procedures>>=
	module subroutine circe2_data_init (data, os_data, model, pdg_in, &
	sqrts, polarized, beam_pol, file, design)
	class(circe2_data_t), intent(out) :: data
	type(os_data_t), intent(in) :: os_data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), dimension(2), intent(in) :: pdg_in
	real(default), intent(in) :: sqrts
	logical, intent(in) :: polarized, beam_pol
	type(string_t), intent(in) :: file, design
	integer :: h
	data%model => model
	if (any (pdg_in%get_length () /= 1)) then
	call msg_fatal ("CIRCE2: incoming beam particles must be unique")
	end if
	call data%flv_in(1)%init (pdg_in(1)%get (1), model)
	call data%flv_in(2)%init (pdg_in(2)%get (1), model)
	data%pdg_in = data%flv_in%get_pdg ()
	data%sqrts = sqrts
	data%polarized = polarized
	data%beams_polarized = beam_pol
	data%filename = file
	data%design = design
	call data%check_file (os_data)
	call circe2_load (circe2_global_state, trim (char(data%file)), &
	trim (char(data%design)), data%sqrts, data%error)
	call data%check ()
	data%lumi = circe2_luminosity (circe2_global_state, data%pdg_in, [0, 0])
	if (vanishes (data%lumi)) then
	call msg_fatal ("CIRCE2: luminosity vanishes for specified beams.")
	end if
	if (data%polarized) then
	do h = 1, 4
	data%lumi_hel_frac(h) = &
	circe2_luminosity (circe2_global_state, data%pdg_in, &
	[data%h1(h), data%h2(h)]) &
	/ data%lumi
	end do
	end if
	end subroutine circe2_data_init

	@ %def circe2_data_init
	@ Activate the generator mode. We import a RNG factory into the data
	type, which can then spawn RNG generator objects.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: set_generator_mode => circe2_data_set_generator_mode
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_data_set_generator_mode (data, rng_factory)
	class(circe2_data_t), intent(inout) :: data
	class(rng_factory_t), intent(inout), allocatable :: rng_factory
	end subroutine circe2_data_set_generator_mode
	<<SF circe2: procedures>>=
	module subroutine circe2_data_set_generator_mode (data, rng_factory)
	class(circe2_data_t), intent(inout) :: data
	class(rng_factory_t), intent(inout), allocatable :: rng_factory
	call move_alloc (from = rng_factory, to = data%rng_factory)
	end subroutine circe2_data_set_generator_mode

	@ %def circe2_data_set_generator_mode
	@ Check whether the requested data file is in the system directory or
	in the current directory.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: check_file => circe2_check_file
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_check_file (data, os_data)
	class(circe2_data_t), intent(inout) :: data
	type(os_data_t), intent(in) :: os_data
	end subroutine circe2_check_file
	<<SF circe2: procedures>>=
	module subroutine circe2_check_file (data, os_data)
	class(circe2_data_t), intent(inout) :: data
	type(os_data_t), intent(in) :: os_data
	logical :: exist
	type(string_t) :: file
	file = data%filename
	if (file == "") &
	call msg_fatal ("CIRCE2: $circe2_file is not set")
	inquire (file = char (file), exist = exist)
	if (exist) then
	data%file = file
	else
	file = os_data%whizard_circe2path // "/" // data%filename
	inquire (file = char (file), exist = exist)
	if (exist) then
	data%file = file
	else
	call msg_fatal ("CIRCE2: data file '" // char (data%filename) &
	// "' not found")
	end if
	end if
	end subroutine circe2_check_file

	@ %def circe2_check_file
	@ Handle error conditions.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: check => circe2_data_check
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_data_check (data)
	class(circe2_data_t), intent(in) :: data
	end subroutine circe2_data_check
	<<SF circe2: procedures>>=
	module subroutine circe2_data_check (data)
	class(circe2_data_t), intent(in) :: data
	type(flavor_t) :: flv_photon, flv_electron
	call flv_photon%init (PHOTON, data%model)
	if (.not. flv_photon%is_defined ()) then
	call msg_fatal ("CIRCE2: model must contain photon")
	end if
	call flv_electron%init (ELECTRON, data%model)
	if (.not. flv_electron%is_defined ()) then
	call msg_fatal ("CIRCE2: model must contain electron")
	end if
	if (any (abs (data%pdg_in) /= PHOTON .and. abs (data%pdg_in) /= ELECTRON)) &
	then
	call msg_fatal ("CIRCE2: applicable only for e+e- or photon collisions")
	end if
	select case (data%error)
	case (-1)
	call msg_fatal ("CIRCE2: data file not found.")
	case (-2)
	call msg_fatal ("CIRCE2: beam setup does not match data file.")
	case (-3)
	call msg_fatal ("CIRCE2: invalid format of data file.")
	case (-4)
	call msg_fatal ("CIRCE2: data file too large.")
	end select
	end subroutine circe2_data_check

	@ %def circe2_data_check
	@ Output
	<<SF circe2: circe2 data: TBP>>=
	procedure :: write => circe2_data_write
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_data_write (data, unit, verbose)
	class(circe2_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine circe2_data_write
	<<SF circe2: procedures>>=
	module subroutine circe2_data_write (data, unit, verbose)
	class(circe2_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u, h
	logical :: verb
	verb = .false.; if (present (verbose)) verb = verbose
	u = given_output_unit (unit)
	write (u, "(1x,A)") "CIRCE2 data:"
	write (u, "(3x,A,A)") "file = ", char(data%filename)
	write (u, "(3x,A,A)") "design = ", char(data%design)
	write (u, "(3x,A," // FMT_19 // ")") "sqrts = ", data%sqrts
	write (u, "(3x,A,A,A,A)") "prt_in = ", &
	char (data%flv_in(1)%get_name ()), &
	", ", char (data%flv_in(2)%get_name ())
	write (u, "(3x,A,L1)") "polarized = ", data%polarized
	write (u, "(3x,A,L1)") "beams pol. = ", data%beams_polarized
	write (u, "(3x,A," // FMT_19 // ")") "luminosity = ", data%lumi
	if (data%polarized) then
	do h = 1, 4
	write (u, "(6x,'(',I2,1x,I2,')',1x,'=',1x)", advance="no") &
	data%h1(h), data%h2(h)
	write (u, "(6x, " // FMT_19 // ")") data%lumi_hel_frac(h)
	end do
	end if
	if (verb) then
	call data%rng_factory%write (u)
	end if
	end subroutine circe2_data_write

	@ %def circe2_data_write
	@ This is always in generator mode.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: is_generator => circe2_data_is_generator
	<<SF circe2: sub interfaces>>=
	module function circe2_data_is_generator (data) result (flag)
	class(circe2_data_t), intent(in) :: data
	logical :: flag
	end function circe2_data_is_generator
	<<SF circe2: procedures>>=
	module function circe2_data_is_generator (data) result (flag)
	class(circe2_data_t), intent(in) :: data
	logical :: flag
	flag = .true.
	end function circe2_data_is_generator

	@ %def circe2_data_is_generator
	@ The number of parameters is two, collinear splitting for
	the two beams.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: get_n_par => circe2_data_get_n_par
	<<SF circe2: sub interfaces>>=
	module function circe2_data_get_n_par (data) result (n)
	class(circe2_data_t), intent(in) :: data
	integer :: n
	end function circe2_data_get_n_par
	<<SF circe2: procedures>>=
	module function circe2_data_get_n_par (data) result (n)
	class(circe2_data_t), intent(in) :: data
	integer :: n
	n = 2
	end function circe2_data_get_n_par

	@ %def circe2_data_get_n_par
	@ Return the outgoing particles PDG codes. They are equal to the
	incoming ones.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: get_pdg_out => circe2_data_get_pdg_out
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_data_get_pdg_out (data, pdg_out)
	class(circe2_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	end subroutine circe2_data_get_pdg_out
	<<SF circe2: procedures>>=
	module subroutine circe2_data_get_pdg_out (data, pdg_out)
	class(circe2_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer :: i, n
	n = 2
	do i = 1, n
	pdg_out(i) = data%pdg_in(i)
	end do
	end subroutine circe2_data_get_pdg_out

	@ %def circe2_data_get_pdg_out
	@ Allocate the interaction record. Due to gfortran 7/8/9 bug has to
	remain in the main module.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: allocate_sf_int => circe2_data_allocate_sf_int
	<<SF circe2: main procedures>>=
	subroutine circe2_data_allocate_sf_int (data, sf_int)
	class(circe2_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (circe2_t :: sf_int)
	end subroutine circe2_data_allocate_sf_int

	@ %def circe2_data_allocate_sf_int
	@ Return the beam file.
	<<SF circe2: circe2 data: TBP>>=
	procedure :: get_beam_file => circe2_data_get_beam_file
	<<SF circe2: sub interfaces>>=
	module function circe2_data_get_beam_file (data) result (file)
	class(circe2_data_t), intent(in) :: data
	type(string_t) :: file
	end function circe2_data_get_beam_file
	<<SF circe2: procedures>>=
	module function circe2_data_get_beam_file (data) result (file)
	class(circe2_data_t), intent(in) :: data
	type(string_t) :: file
	file = "CIRCE2: " // data%filename
	end function circe2_data_get_beam_file

	@ %def circe2_data_get_beam_file
	@
	\subsection{Random Number Generator for CIRCE}
	The CIRCE implementation now supports a generic random-number
	generator object that allows for a local state as a component. To
	support this, we must extend the abstract type provided by CIRCE and
	delegate the generator call to the (also abstract) RNG used by WHIZARD.
	<<SF circe2: types>>=
	type, extends (circe2_rng_t) :: rng_obj_t
	class(rng_t), allocatable :: rng
	contains
	procedure :: generate => rng_obj_generate
	end type rng_obj_t

	@ %def rng_obj_t
	<<SF circe2: sub interfaces>>=
	module subroutine rng_obj_generate (rng_obj, u)
	class(rng_obj_t), intent(inout) :: rng_obj
	real(default), intent(out) :: u
	end subroutine rng_obj_generate
	<<SF circe2: procedures>>=
	module subroutine rng_obj_generate (rng_obj, u)
	class(rng_obj_t), intent(inout) :: rng_obj
	real(default), intent(out) :: u
	real(default) :: x
	call rng_obj%rng%generate (x)
	u = x
	end subroutine rng_obj_generate

	@ %def rng_obj_generate
	@
	\subsection{The CIRCE2 object}
	For CIRCE2 spectra it does not make sense to describe the state matrix
	as a radiation interaction, even if photons originate from laser
	backscattering. Instead, it is a $2\to 2$ interaction where the
	incoming particles are identical to the outgoing ones.

	The current implementation of CIRCE2 does support polarization and
	classical correlations, but no entanglement, so the density matrix of
	the outgoing particles is diagonal. The incoming particles are
	unpolarized (user-defined polarization for beams is meaningless, since
	polarization is described by the data file). The outgoing particles
	are polarized or polarization-averaged, depending on user request.

	When assigning matrix elements, we scan the previously initialized
	state matrix. For each entry, we extract helicity and call the
	structure function. In the unpolarized case, the helicity is
	undefined and replaced by value zero. In the polarized case, there
	are four entries. If the generator is used, only one entry is nonzero
	in each call. Which one, is determined by comparing with a previously
	(randomly, distributed by relative luminosity) selected pair of
	helicities.
	<<SF circe2: public>>=
	public :: circe2_t
	<<SF circe2: types>>=
	type, extends (sf_int_t) :: circe2_t
	type(circe2_data_t), pointer :: data => null ()
	type(rng_obj_t) :: rng_obj
	type(selector_t) :: selector
	integer :: h_sel = 0
	contains
	<<SF circe2: circe2: TBP>>
	end type circe2_t

	@ %def circe2_t
	@ Type string: show file and design of [[CIRCE2]] structure function.
	<<SF circe2: circe2: TBP>>=
	procedure :: type_string => circe2_type_string
	<<SF circe2: sub interfaces>>=
	module function circe2_type_string (object) result (string)
	class(circe2_t), intent(in) :: object
	type(string_t) :: string
	end function circe2_type_string
	<<SF circe2: procedures>>=
	module function circe2_type_string (object) result (string)
	class(circe2_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "CIRCE2: " // object%data%design
	else
	string = "CIRCE2: [undefined]"
	end if
	end function circe2_type_string

	@ %def circe2_type_string
	@
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF circe2: circe2: TBP>>=
	procedure :: write => circe2_write
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_write (object, unit, testflag)
	class(circe2_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine circe2_write
	<<SF circe2: procedures>>=
	module subroutine circe2_write (object, unit, testflag)
	class(circe2_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "CIRCE2 data: [undefined]"
	end if
	end subroutine circe2_write

	@ %def circe2_write
	@
	<<SF circe2: circe2: TBP>>=
	procedure :: init => circe2_init
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_init (sf_int, data)
	class(circe2_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	end subroutine circe2_init
	<<SF circe2: procedures>>=
	module subroutine circe2_init (sf_int, data)
	class(circe2_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	logical, dimension(4) :: mask_h
	real(default), dimension(2) :: m2_array
	real(default), dimension(0) :: null_array
	type(quantum_numbers_mask_t), dimension(4) :: mask
	type(quantum_numbers_t), dimension(4) :: qn
	type(helicity_t) :: hel
	type(color_t) :: col0
	integer :: h
	select type (data)
	type is (circe2_data_t)
	if (data%polarized .and. data%beams_polarized) then
	call msg_fatal ("CIRCE2: Beam polarization can't be set &
	&for polarized data file")
	else if (data%beams_polarized) then
	call msg_warning ("CIRCE2: User-defined beam polarization set &
	&for unpolarized CIRCE2 data file")
	end if
	mask_h(1:2) = .not. data%beams_polarized
	mask_h(3:4) = .not. (data%polarized .or. data%beams_polarized)
	mask = quantum_numbers_mask (.false., .false., mask_h)
	m2_array(:) = (data%flv_in(:)%get_mass ())**2
	call sf_int%base_init (mask, m2_array, null_array, m2_array)
	sf_int%data => data
	if (data%polarized) then
	if (vanishes (sum (data%lumi_hel_frac)) .or. &
	any (data%lumi_hel_frac < 0)) then
	call msg_fatal ("CIRCE2: Helicity-dependent lumi " &
	// "fractions all vanish or", &
	[var_str ("are negative: Please inspect the " &
	// "CIRCE2 file or "), &
	var_str ("switch off the polarized" // &
	" option for CIRCE2.")])
	else
	call sf_int%selector%init (data%lumi_hel_frac)
	end if
	end if
	call col0%init ()
	if (data%beams_polarized) then
	do h = 1, 4
	call hel%init (data%h1(h))
	call qn(1)%init &
	(flv = data%flv_in(1), col = col0, hel = hel)
	call qn(3)%init &
	(flv = data%flv_in(1), col = col0, hel = hel)
	call hel%init (data%h2(h))
	call qn(2)%init &
	(flv = data%flv_in(2), col = col0, hel = hel)
	call qn(4)%init &
	(flv = data%flv_in(2), col = col0, hel = hel)
	call sf_int%add_state (qn)
	end do
	else if (data%polarized) then
	call qn(1)%init (flv = data%flv_in(1), col = col0)
	call qn(2)%init (flv = data%flv_in(2), col = col0)
	do h = 1, 4
	call hel%init (data%h1(h))
	call qn(3)%init &
	(flv = data%flv_in(1), col = col0, hel = hel)
	call hel%init (data%h2(h))
	call qn(4)%init &
	(flv = data%flv_in(2), col = col0, hel = hel)
	call sf_int%add_state (qn)
	end do
	else
	call qn(1)%init (flv = data%flv_in(1), col = col0)
	call qn(2)%init (flv = data%flv_in(2), col = col0)
	call qn(3)%init (flv = data%flv_in(1), col = col0)
	call qn(4)%init (flv = data%flv_in(2), col = col0)
	call sf_int%add_state (qn)
	end if
	call sf_int%freeze ()
	call sf_int%set_incoming ([1,2])
	call sf_int%set_outgoing ([3,4])
	call sf_int%data%rng_factory%make (sf_int%rng_obj%rng)
	sf_int%status = SF_INITIAL
	end select
	end subroutine circe2_init

	@ %def circe2_init
	@
	\subsection{Kinematics}
	Refer to the [[data]] component.
	<<SF circe2: circe2: TBP>>=
	procedure :: is_generator => circe2_is_generator
	<<SF circe2: sub interfaces>>=
	module function circe2_is_generator (sf_int) result (flag)
	class(circe2_t), intent(in) :: sf_int
	logical :: flag
	end function circe2_is_generator
	<<SF circe2: procedures>>=
	module function circe2_is_generator (sf_int) result (flag)
	class(circe2_t), intent(in) :: sf_int
	logical :: flag
	flag = sf_int%data%is_generator ()
	end function circe2_is_generator

	@ %def circe2_is_generator
	@ Generate free parameters. We first select a helicity, which we have
	to store, then generate $x$ values for that helicity.
	<<SF circe2: circe2: TBP>>=
	procedure :: generate_free => circe2_generate_whizard_free
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_generate_whizard_free (sf_int, r, rb, x_free)
	class(circe2_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	end subroutine circe2_generate_whizard_free
	<<SF circe2: procedures>>=
	module subroutine circe2_generate_whizard_free (sf_int, r, rb, x_free)
	class(circe2_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: r, rb
	real(default), intent(inout) :: x_free
	integer :: h_sel
	if (sf_int%data%polarized) then
	call sf_int%selector%generate (sf_int%rng_obj%rng, h_sel)
	else
	h_sel = 0
	end if
	sf_int%h_sel = h_sel
	call circe2_generate_whizard (r, sf_int%data%pdg_in, &
	[sf_int%data%h1(h_sel), sf_int%data%h2(h_sel)], &
	sf_int%rng_obj)
	rb = 1 - r
	x_free = x_free * product (r)
	end subroutine circe2_generate_whizard_free

	@ %def circe2_generate_whizard_free
	@ Generator mode: call the CIRCE2 generator for the given particles
	and helicities. (For unpolarized generation, helicities are zero.)
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_generate_whizard (x, pdg, hel, rng_obj)
	real(default), dimension(2), intent(out) :: x
	integer, dimension(2), intent(in) :: pdg
	integer, dimension(2), intent(in) :: hel
	class(rng_obj_t), intent(inout) :: rng_obj
	end subroutine circe2_generate_whizard
	<<SF circe2: procedures>>=
	module subroutine circe2_generate_whizard (x, pdg, hel, rng_obj)
	real(default), dimension(2), intent(out) :: x
	integer, dimension(2), intent(in) :: pdg
	integer, dimension(2), intent(in) :: hel
	class(rng_obj_t), intent(inout) :: rng_obj
	call circe2_generate (circe2_global_state, rng_obj, x, pdg, hel)
	end subroutine circe2_generate_whizard

	@ %def circe2_generate_whizard
	@ Set kinematics. Trivial here.
	<<SF circe2: circe2: TBP>>=
	procedure :: complete_kinematics => circe2_complete_kinematics
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(circe2_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	end subroutine circe2_complete_kinematics
	<<SF circe2: procedures>>=
	module subroutine circe2_complete_kinematics (sf_int, x, xb, f, r, rb, map)
	class(circe2_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	if (map) then
	call msg_fatal ("CIRCE2: map flag not supported")
	else
	x = r
	xb= rb
	f = 1
	end if
	call sf_int%reduce_momenta (x)
	end subroutine circe2_complete_kinematics

	@ %def circe2_complete_kinematics
	@ Compute inverse kinematics.
	<<SF circe2: circe2: TBP>>=
	procedure :: inverse_kinematics => circe2_inverse_kinematics
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(circe2_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	end subroutine circe2_inverse_kinematics
	<<SF circe2: procedures>>=
	module subroutine circe2_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(circe2_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	call msg_fatal ("CIRCE2: map flag not supported")
	else
	r = x
	rb= xb
	f = 1
	end if
	if (set_mom) then
	call sf_int%reduce_momenta (x)
	end if
	end subroutine circe2_inverse_kinematics

	@ %def circe2_inverse_kinematics
	@
	\subsection{CIRCE2 application}
	This function works on both beams. In polarized mode, we set only the
	selected helicity. In unpolarized mode,
	the interaction has only one entry, and the factor is unity.
	<<SF circe2: circe2: TBP>>=
	procedure :: apply => circe2_apply
	<<SF circe2: sub interfaces>>=
	module subroutine circe2_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(circe2_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	end subroutine circe2_apply
	<<SF circe2: procedures>>=
	module subroutine circe2_apply (sf_int, scale, negative_sf, rescale, i_sub)
	class(circe2_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	complex(default) :: f
	associate (data => sf_int%data)
	f = 1
	if (data%beams_polarized) then
	call sf_int%set_matrix_element (f)
	else if (data%polarized) then
	call sf_int%set_matrix_element (sf_int%h_sel, f)
	else
	call sf_int%set_matrix_element (1, f)
	end if
	end associate
	sf_int%status = SF_EVALUATED
	end subroutine circe2_apply

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

	module sf_circe2_ut
	use unit_tests
	use sf_circe2_uti

	<<Standard module head>>

	<<SF circe2: public test>>

	contains

	<<SF circe2: test driver>>

	end module sf_circe2_ut
	@ %def sf_circe2_ut
	@
	<<[[sf_circe2_uti.f90]]>>=
	<<File header>>

	module sf_circe2_uti

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use physics_defs, only: PHOTON
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use rng_base
	use sf_aux
	use sf_base

	use sf_circe2

	use rng_base_ut, only: rng_test_factory_t

	<<Standard module head>>

	<<SF circe2: test declarations>>

	contains

	<<SF circe2: tests>>

	end module sf_circe2_uti
	@ %def sf_circe2_ut
	@ API: driver for the unit tests below.
	<<SF circe2: public test>>=
	public :: sf_circe2_test
	<<SF circe2: test driver>>=
	subroutine sf_circe2_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF circe2: execute tests>>
	end subroutine sf_circe2_test

	@ %def sf_circe2_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF circe2: execute tests>>=
	call test (sf_circe2_1, "sf_circe2_1", &
	"structure function configuration", &
	u, results)
	<<SF circe2: test declarations>>=
	public :: sf_circe2_1
	<<SF circe2: tests>>=
	subroutine sf_circe2_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(pdg_array_t), dimension(2) :: pdg_in
	type(pdg_array_t), dimension(2) :: pdg_out
	integer, dimension(:), allocatable :: pdg1, pdg2
	class(sf_data_t), allocatable :: data
	class(rng_factory_t), allocatable :: rng_factory

	write (u, "(A)") "* Test output: sf_circe2_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&CIRCE structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call os_data%init ()
	call model%init_qed_test ()
	pdg_in(1) = PHOTON
	pdg_in(2) = PHOTON

	allocate (circe2_data_t :: data)
	allocate (rng_test_factory_t :: rng_factory)

	write (u, "(A)")
	write (u, "(A)") "* Initialize (unpolarized)"
	write (u, "(A)")

	select type (data)
	type is (circe2_data_t)
	call data%init (os_data, model, pdg_in, &
	sqrts = 500._default, &
	polarized = .false., &
	beam_pol = .false., &
	file = var_str ("teslagg_500_polavg.circe"), &
	design = var_str ("TESLA/GG"))
	call data%set_generator_mode (rng_factory)
	end select

	call data%write (u, verbose = .true.)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	pdg2 = pdg_out(2)
	write (u, "(2x,99(1x,I0))") pdg1, pdg2

	write (u, "(A)")
	write (u, "(A)") "* Initialize (polarized)"
	write (u, "(A)")

	allocate (rng_test_factory_t :: rng_factory)

	select type (data)
	type is (circe2_data_t)
	call data%init (os_data, model, pdg_in, &
	sqrts = 500._default, &
	polarized = .true., &
	beam_pol = .false., &
	file = var_str ("teslagg_500.circe"), &
	design = var_str ("TESLA/GG"))
	call data%set_generator_mode (rng_factory)
	end select

	call data%write (u, verbose = .true.)

	call model%final ()

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

	end subroutine sf_circe2_1

	@ %def sf_circe2_1
	@
	\subsubsection{Generator mode, unpolarized}
	Construct and evaluate a structure function object in generator mode.
	<<SF circe2: execute tests>>=
	call test (sf_circe2_2, "sf_circe2_2", &
	"generator, unpolarized", &
	u, results)
	<<SF circe2: test declarations>>=
	public :: sf_circe2_2
	<<SF circe2: tests>>=
	subroutine sf_circe2_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(rng_factory_t), allocatable :: rng_factory
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, x_free

	write (u, "(A)") "* Test output: sf_circe2_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&circe2 structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call os_data%init ()
	call model%init_qed_test ()
	call flv(1)%init (PHOTON, model)
	call flv(2)%init (PHOTON, model)
	pdg_in(1) = PHOTON
	pdg_in(2) = PHOTON

	call reset_interaction_counter ()

	allocate (circe2_data_t :: data)
	allocate (rng_test_factory_t :: rng_factory)
	select type (data)
	type is (circe2_data_t)
	call data%init (os_data, model, pdg_in, &
	sqrts = 500._default, &
	polarized = .false., &
	beam_pol = .false., &
	file = var_str ("teslagg_500_polavg.circe"), &
	design = var_str ("TESLA/GG"))
	call data%set_generator_mode (rng_factory)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])
	select type (sf_int)
	type is (circe2_t)
	call sf_int%rng_obj%rng%init (3)
	end select

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Generate x"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0
	rb = 0
	x_free = 1
	call sf_int%generate_free (r, rb, x_free)
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

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

	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_circe2_2

	@ %def sf_circe2_2
	@
	\subsubsection{Generator mode, polarized}
	Construct and evaluate a structure function object in generator mode.
	<<SF circe2: execute tests>>=
	call test (sf_circe2_3, "sf_circe2_3", &
	"generator, polarized", &
	u, results)
	<<SF circe2: test declarations>>=
	public :: sf_circe2_3
	<<SF circe2: tests>>=
	subroutine sf_circe2_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(flavor_t), dimension(2) :: flv
	type(pdg_array_t), dimension(2) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(rng_factory_t), allocatable :: rng_factory
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k1, k2
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f, x_free

	write (u, "(A)") "* Test output: sf_circe2_3"
	write (u, "(A)") "* Purpose: initialize and fill &
	&circe2 structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call os_data%init ()
	call model%init_qed_test ()
	call flv(1)%init (PHOTON, model)
	call flv(2)%init (PHOTON, model)
	pdg_in(1) = PHOTON
	pdg_in(2) = PHOTON

	call reset_interaction_counter ()

	allocate (circe2_data_t :: data)
	allocate (rng_test_factory_t :: rng_factory)
	select type (data)
	type is (circe2_data_t)
	call data%init (os_data, model, pdg_in, &
	sqrts = 500._default, &
	polarized = .true., &
	beam_pol = .false., &
	file = var_str ("teslagg_500.circe"), &
	design = var_str ("TESLA/GG"))
	call data%set_generator_mode (rng_factory)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1,2])
	select type (sf_int)
	type is (circe2_t)
	call sf_int%rng_obj%rng%init (3)
	end select

	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 250
	k1 = vector4_moving (E, sqrt (E2 - flv(1)%get_mass ()2), 3)
	k2 = vector4_moving (E,-sqrt (E2 - flv(2)%get_mass ()2), 3)
	call vector4_write (k1, u)
	call vector4_write (k2, u)
	call sf_int%seed_kinematics ([k1, k2])

	write (u, "(A)")
	write (u, "(A)") "* Generate x"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0
	rb = 0
	x_free = 1
	call sf_int%generate_free (r, rb, x_free)
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f
	write (u, "(A,9(1x,F10.7))") "xf=", x_free

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

	call sf_int%apply (scale = 0._default)
	call sf_int%write (u)

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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_circe2_3

	@ %def sf_circe2_3
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{HOPPET interface}
	Interface to the HOPPET wrapper necessary to perform
	the LO vs. NLO matching of processes containing an initial
	b quark.
	<<[[hoppet_interface.f90]]>>=
	<<File header>>

	module hoppet_interface
	use lhapdf !NODEP!

	<<Standard module head>>

	public :: hoppet_init, hoppet_eval

	contains

	subroutine hoppet_init (pdf_builtin, pdf, pdf_id)
	logical, intent(in) :: pdf_builtin
	type(lhapdf_pdf_t), intent(inout), optional :: pdf
	integer, intent(in), optional :: pdf_id
	external InitForWhizard
	call InitForWhizard (pdf_builtin, pdf, pdf_id)
	end subroutine hoppet_init

	subroutine hoppet_eval (x, q, f)
	double precision, intent(in) :: x, q
	double precision, intent(out) :: f(-6:6)
	external EvalForWhizard
	call EvalForWhizard (x, q, f)
	end subroutine hoppet_eval

	end module hoppet_interface
	@ %def hoppet_interface
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{Builtin PDF sets}
	For convenience in order not to depend on the external package LHAPDF,
	we ship some PDFs with WHIZARD.
	@
	\subsection{The module}
	<<[[sf_pdf_builtin.f90]]>>=
	<<File header>>

	module sf_pdf_builtin

	<<Use kinds>>
	use kinds, only: double
	<<Use strings>>
	use sm_qcd
	use pdg_arrays
	use model_data
	use flavors
	use polarizations
	use sf_base

	<<Standard module head>>

	<<SF pdf builtin: public>>

	<<SF pdf builtin: types>>

	interface
	<<SF pdf builtin: sub interfaces>>
	end interface

	contains

	<<SF pdf builtin: main procedures>>

	end module sf_pdf_builtin
	@ %def sf_pdf_builtin
	@
	<<[[sf_pdf_builtin_sub.f90]]>>=
	<<File header>>

	submodule (sf_pdf_builtin) sf_pdf_builtin_s

	use io_units
	use format_defs, only: FMT_17
	use diagnostics
	use os_interface
	use physics_defs, only: PROTON, PHOTON, GLUON
	use physics_defs, only: HADRON_REMNANT_SINGLET
	use physics_defs, only: HADRON_REMNANT_TRIPLET
	use physics_defs, only: HADRON_REMNANT_OCTET
	use lorentz
	use colors
	use quantum_numbers
	use state_matrices
	use pdf_builtin !NODEP!
	use hoppet_interface

	implicit none

	<<SF pdf builtin: parameters>>

	contains

	<<SF pdf builtin: procedures>>

	end submodule sf_pdf_builtin_s

	@ %def sf_pdf_builtin_s
	@
	\subsection{Codes for default PDF sets}
	<<SF pdf builtin: parameters>>=
	character(*), parameter :: PDF_BUILTIN_DEFAULT_PROTON = "CTEQ6L"
	! character(*), parameter :: PDF_BUILTIN_DEFAULT_PION = "NONE"
	! character(*), parameter :: PDF_BUILTIN_DEFAULT_PHOTON = "MRST2004QEDp"
	@ %def PDF_BUILTIN_DEFAULT_SET
	@
	\subsection{The PDF builtin data block}
	The data block holds the incoming flavor (which has to be proton,
	pion, or photon), the corresponding pointer to the global access data
	(1, 2, or 3), the flag [[invert]] which is set for an antiproton, the
	bounds as returned by LHAPDF for the specified set, and a mask that
	determines which partons will be actually in use.
	<<SF pdf builtin: public>>=
	public :: pdf_builtin_data_t
	<<SF pdf builtin: types>>=
	type, extends (sf_data_t) :: pdf_builtin_data_t
	private
	integer :: id = -1
	type (string_t) :: name
	class(model_data_t), pointer :: model => null ()
	type(flavor_t) :: flv_in
	logical :: invert
	logical :: has_photon
	logical :: photon
	logical, dimension(-6:6) :: mask
	logical :: mask_photon
	logical :: hoppet_b_matching = .false.
	contains
	<<SF pdf builtin: pdf builtin data: TBP>>
	end type pdf_builtin_data_t

	@ %def pdf_builtin_data_t
	@ Generate PDF data and initialize the requested set. Pion and photon PDFs
	are disabled at the moment until we ship appropiate structure functions.
	needed.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: init => pdf_builtin_data_init
	<<SF pdf builtin: sub interfaces>>=
	module subroutine pdf_builtin_data_init (data, &
	model, pdg_in, name, path, hoppet_b_matching)
	class(pdf_builtin_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	type(string_t), intent(in) :: name
	type(string_t), intent(in) :: path
	logical, intent(in), optional :: hoppet_b_matching
	end subroutine pdf_builtin_data_init
	<<SF pdf builtin: procedures>>=
	module subroutine pdf_builtin_data_init (data, &
	model, pdg_in, name, path, hoppet_b_matching)
	class(pdf_builtin_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	type(string_t), intent(in) :: name
	type(string_t), intent(in) :: path
	logical, intent(in), optional :: hoppet_b_matching
	data%model => model
	if (pdg_in%get_length () /= 1) &
	call msg_fatal ("PDF: incoming particle must be unique")
	call data%flv_in%init (pdg_in%get (1), model)
	data%mask = .true.
	data%mask_photon = .true.
	select case (pdg_in%get (1))
	case (PROTON)
	data%name = var_str (PDF_BUILTIN_DEFAULT_PROTON)
	data%invert = .false.
	data%photon = .false.
	case (-PROTON)
	data%name = var_str (PDF_BUILTIN_DEFAULT_PROTON)
	data%invert = .true.
	data%photon = .false.
	! case (PIPLUS)
	! data%name = var_str (PDF_BUILTIN_DEFAULT_PION)
	! data%invert = .false.
	! data%photon = .false.
	! case (-PIPLUS)
	! data%name = var_str (PDF_BUILTIN_DEFAULT_PION)
	! data%invert = .true.
	! data%photon = .false.
	! case (PHOTON)
	! data%name = var_str (PDF_BUILTIN_DEFAULT_PHOTON)
	! data%invert = .false.
	! data%photon = .true.
	case default
	call msg_fatal ("PDF: " &
	// "incoming particle must either proton or antiproton.")
	return
	end select
	data%name = name
	data%id = pdf_get_id (data%name)
	if (data%id < 0) call msg_fatal ("unknown PDF set " // char (data%name))
	data%has_photon = pdf_provides_photon (data%id)
	if (present (hoppet_b_matching)) data%hoppet_b_matching = hoppet_b_matching
	call pdf_init (data%id, path)
	if (data%hoppet_b_matching) call hoppet_init (.true., pdf_id = data%id)
	end subroutine pdf_builtin_data_init

	@ %def pdf_builtin_data_init
	@ Enable/disable partons explicitly. If a mask entry is true,
	applying the PDF will generate the corresponding flavor on output.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: set_mask => pdf_builtin_data_set_mask
	<<SF pdf builtin: sub interfaces>>=
	module subroutine pdf_builtin_data_set_mask (data, mask)
	class(pdf_builtin_data_t), intent(inout) :: data
	logical, dimension(-6:6), intent(in) :: mask
	end subroutine pdf_builtin_data_set_mask
	<<SF pdf builtin: procedures>>=
	module subroutine pdf_builtin_data_set_mask (data, mask)
	class(pdf_builtin_data_t), intent(inout) :: data
	logical, dimension(-6:6), intent(in) :: mask
	data%mask = mask
	end subroutine pdf_builtin_data_set_mask

	@ %def pdf_builtin_data_set_mask
	@ Output.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: write => pdf_builtin_data_write
	<<SF pdf builtin: sub interfaces>>=
	module subroutine pdf_builtin_data_write (data, unit, verbose)
	class(pdf_builtin_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine pdf_builtin_data_write
	<<SF pdf builtin: procedures>>=
	module subroutine pdf_builtin_data_write (data, unit, verbose)
	class(pdf_builtin_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "PDF builtin data:"
	if (data%id < 0) then
	write (u, "(3x,A)") "[undefined]"
	return
	end if
	write (u, "(3x,A)", advance="no") "flavor = "
	call data%flv_in%write (u); write (u, *)
	write (u, "(3x,A,A)") "name = ", char (data%name)
	write (u, "(3x,A,L1)") "invert = ", data%invert
	write (u, "(3x,A,L1)") "has photon = ", data%has_photon
	write (u, "(3x,A,6(1x,L1),1x,A,1x,L1,1x,A,6(1x,L1))") &
	"mask =", &
	data%mask(-6:-1), "", data%mask(0), "", data%mask(1:6)
	write (u, "(3x,A,L1)") "photon mask = ", data%mask_photon
	write (u, "(3x,A,L1)") "hoppet_b = ", data%hoppet_b_matching
	end subroutine pdf_builtin_data_write

	@ %def pdf_builtin_data_write
	@ The number of parameters is one. We do not generate transverse momentum.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: get_n_par => pdf_builtin_data_get_n_par
	<<SF pdf builtin: sub interfaces>>=
	module function pdf_builtin_data_get_n_par (data) result (n)
	class(pdf_builtin_data_t), intent(in) :: data
	integer :: n
	end function pdf_builtin_data_get_n_par
	<<SF pdf builtin: procedures>>=
	module function pdf_builtin_data_get_n_par (data) result (n)
	class(pdf_builtin_data_t), intent(in) :: data
	integer :: n
	n = 1
	end function pdf_builtin_data_get_n_par

	@ %def pdf_builtin_data_get_n_par
	@ Return the outgoing particle PDG codes. This is based on the mask.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: get_pdg_out => pdf_builtin_data_get_pdg_out
	<<SF pdf builtin: sub interfaces>>=
	module subroutine pdf_builtin_data_get_pdg_out (data, pdg_out)
	class(pdf_builtin_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	end subroutine pdf_builtin_data_get_pdg_out
	<<SF pdf builtin: procedures>>=
	module subroutine pdf_builtin_data_get_pdg_out (data, pdg_out)
	class(pdf_builtin_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	integer :: n, np, i
	n = count (data%mask)
	np = 0; if (data%has_photon .and. data%mask_photon) np = 1
	allocate (pdg1 (n + np))
	pdg1(1:n) = pack ([(i, i = -6, 6)], data%mask)
	if (np == 1) pdg1(n+np) = PHOTON
	pdg_out(1) = pdg1
	end subroutine pdf_builtin_data_get_pdg_out

	@ %def pdf_builtin_data_get_pdg_out
	@ Allocate the interaction record. Due to gfortran 7/8/9 bug this has
	to remain in the main module.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: allocate_sf_int => pdf_builtin_data_allocate_sf_int
	<<SF pdf builtin: main procedures>>=
	subroutine pdf_builtin_data_allocate_sf_int (data, sf_int)
	class(pdf_builtin_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (pdf_builtin_t :: sf_int)
	end subroutine pdf_builtin_data_allocate_sf_int

	@ %def pdf_builtin_data_allocate_sf_int
	@ Return the numerical PDF set index.
	<<SF pdf builtin: pdf builtin data: TBP>>=
	procedure :: get_pdf_set => pdf_builtin_data_get_pdf_set
	<<SF pdf builtin: sub interfaces>>=
	elemental module function pdf_builtin_data_get_pdf_set &
	(data) result (pdf_set)
	class(pdf_builtin_data_t), intent(in) :: data
	integer :: pdf_set
	end function pdf_builtin_data_get_pdf_set
	<<SF pdf builtin: procedures>>=
	elemental module function pdf_builtin_data_get_pdf_set &
	(data) result (pdf_set)
	class(pdf_builtin_data_t), intent(in) :: data
	integer :: pdf_set
	pdf_set = data%id
	end function pdf_builtin_data_get_pdf_set

	@ %def pdf_builtin_data_get_pdf_set
	@
	\subsection{The PDF object}
	The PDF $1\to 2$ interaction which describes
	the splitting of an (anti)proton into a parton and a beam remnant. We
	stay in the strict forward-splitting limit, but allow some invariant
	mass for the beam remnant such that the outgoing parton is exactly
	massless. For a real event, we would replace this by a parton
	cascade, where the outgoing partons have virtuality as dictated by
	parton-shower kinematics, and transverse momentum is generated.

	The PDF application is a $1\to 2$ splitting process, where the
	particles are ordered as (hadron, remnant, parton).

	Polarization is ignored completely. The beam particle is colorless,
	while partons and beam remnant carry color. The remnant gets a
	special flavor code.
	<<SF pdf builtin: public>>=
	public :: pdf_builtin_t
	<<SF pdf builtin: types>>=
	type, extends (sf_int_t) :: pdf_builtin_t
	type(pdf_builtin_data_t), pointer :: data => null ()
	real(default) :: x = 0
	real(default) :: q = 0
	contains
	<<SF pdf builtin: pdf builtin: TBP>>
	end type pdf_builtin_t

	@ %def pdf_builtin_t
	@ Type string: display the chosen PDF set.
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: type_string => pdf_builtin_type_string
	<<SF pdf builtin: sub interfaces>>=
	module function pdf_builtin_type_string (object) result (string)
	class(pdf_builtin_t), intent(in) :: object
	type(string_t) :: string
	end function pdf_builtin_type_string
	<<SF pdf builtin: procedures>>=
	module function pdf_builtin_type_string (object) result (string)
	class(pdf_builtin_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "PDF builtin: " // object%data%name
	else
	string = "PDF builtin: [undefined]"
	end if
	end function pdf_builtin_type_string

	@ %def pdf_builtin_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: write => pdf_builtin_write
	<<SF pdf builtin: sub interfaces>>=
	module subroutine pdf_builtin_write (object, unit, testflag)
	class(pdf_builtin_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine pdf_builtin_write
	<<SF pdf builtin: procedures>>=
	module subroutine pdf_builtin_write (object, unit, testflag)
	class(pdf_builtin_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	if (object%status >= SF_DONE_KINEMATICS) then
	write (u, "(1x,A)") "SF parameters:"
	write (u, "(3x,A," // FMT_17 // ")") "x =", object%x
	if (object%status >= SF_FAILED_EVALUATION) then
	write (u, "(3x,A," // FMT_17 // ")") "Q =", object%q
	end if
	end if
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "PDF builtin data: [undefined]"
	end if
	end subroutine pdf_builtin_write

	@ %def pdf_builtin_write
	@ Initialize. We know that [[data]] will be of concrete type
	[[sf_test_data_t]], but we have to cast this explicitly.

	For this implementation, we set the incoming and outgoing masses equal
	to the physical particle mass, but keep the radiated mass zero.

	Optionally, we can provide minimum and maximum values for the momentum
	transfer.
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: init => pdf_builtin_init
	<<SF pdf builtin: sub interfaces>>=
	module subroutine pdf_builtin_init (sf_int, data)
	class(pdf_builtin_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	end subroutine pdf_builtin_init
	<<SF pdf builtin: procedures>>=
	module subroutine pdf_builtin_init (sf_int, data)
	class(pdf_builtin_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(3) :: mask
	type(flavor_t) :: flv, flv_remnant
	type(color_t) :: col0
	type(quantum_numbers_t), dimension(3) :: qn
	integer :: i
	select type (data)
	type is (pdf_builtin_data_t)
	mask = quantum_numbers_mask (.false., .false., .true.)
	call col0%init ()
	call sf_int%base_init (mask, [0._default], [0._default], [0._default])
	sf_int%data => data
	do i = -6, 6
	if (data%mask(i)) then
	call qn(1)%init (data%flv_in, col = col0)
	if (i == 0) then
	call flv%init (GLUON, data%model)
	call flv_remnant%init (HADRON_REMNANT_OCTET, data%model)
	else
	call flv%init (i, data%model)
	call flv_remnant%init &
	(sign (HADRON_REMNANT_TRIPLET, -i), data%model)
	end if
	call qn(2)%init ( &
	flv = flv_remnant, col = color_from_flavor (flv_remnant, 1))
	call qn(2)%tag_radiated ()
	call qn(3)%init ( &
	flv = flv, col = color_from_flavor (flv, 1, reverse=.true.))
	call sf_int%add_state (qn)
	end if
	end do
	if (data%has_photon .and. data%mask_photon) then
	call flv%init (PHOTON, data%model)
	call flv_remnant%init (HADRON_REMNANT_SINGLET, data%model)
	call qn(2)%init (flv = flv_remnant, &
	col = color_from_flavor (flv_remnant, 1))
	call qn(2)%tag_radiated ()
	call qn(3)%init (flv = flv, &
	col = color_from_flavor (flv, 1, reverse = .true.))
	call sf_int%add_state (qn)
	end if
	call sf_int%freeze ()
	call sf_int%set_incoming ([1])
	call sf_int%set_radiated ([2])
	call sf_int%set_outgoing ([3])
	sf_int%status = SF_INITIAL
	end select
	end subroutine pdf_builtin_init

	@ %def pdf_builtin_init
	@
	\subsection{Kinematics}
	Set kinematics. If [[map]] is unset, the $r$ and $x$ values
	coincide, and the Jacobian $f(r)$ is trivial.

	If [[map]] is set, we are asked to provide an efficient mapping.
	For the test case, we set $x=r^2$ and consequently $f(r)=2r$.
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: complete_kinematics => pdf_builtin_complete_kinematics
	<<SF pdf builtin: sub interfaces>>=
	module subroutine pdf_builtin_complete_kinematics &
	(sf_int, x, xb, f, r, rb, map)
	class(pdf_builtin_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	end subroutine pdf_builtin_complete_kinematics
	<<SF pdf builtin: procedures>>=
	module subroutine pdf_builtin_complete_kinematics &
	(sf_int, x, xb, f, r, rb, map)
	class(pdf_builtin_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	if (map) then
	call msg_fatal ("PDF builtin: map flag not supported")
	else
	x(1) = r(1)
	xb(1)= rb(1)
	f = 1
	end if
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_DONE_KINEMATICS)
	sf_int%x = x(1)
	case (SF_FAILED_KINEMATICS)
	sf_int%x = 0
	f = 0
	end select
	end subroutine pdf_builtin_complete_kinematics

	@ %def pdf_builtin_complete_kinematics
	@ Overriding the default method: we compute the [[x]] value from the
	momentum configuration. In this specific case, we also set the
	internally stored $x$ value, so it can be used in the
	following routine.
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: recover_x => pdf_builtin_recover_x
	<<SF pdf builtin: sub interfaces>>=
	module subroutine pdf_builtin_recover_x (sf_int, x, xb, x_free)
	class(pdf_builtin_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	end subroutine pdf_builtin_recover_x
	<<SF pdf builtin: procedures>>=
	module subroutine pdf_builtin_recover_x (sf_int, x, xb, x_free)
	class(pdf_builtin_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	call sf_int%base_recover_x (x, xb, x_free)
	sf_int%x = x(1)
	end subroutine pdf_builtin_recover_x

	@ %def sf_pdf_builtin_recover_x
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: inverse_kinematics => pdf_builtin_inverse_kinematics
	<<SF pdf builtin: sub interfaces>>=
	module subroutine pdf_builtin_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(pdf_builtin_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	end subroutine pdf_builtin_inverse_kinematics
	<<SF pdf builtin: procedures>>=
	module subroutine pdf_builtin_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(pdf_builtin_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	call msg_fatal ("PDF builtin: map flag not supported")
	else
	r(1) = x(1)
	rb(1)= xb(1)
	f = 1
	end if
	if (set_mom) then
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	end subroutine pdf_builtin_inverse_kinematics

	@ %def pdf_builtin_inverse_kinematics
	@
	\subsection{Structure function}
	Once the scale is also known, we can actually call the PDF and
	set the values. Contrary to LHAPDF, the wrapper already takes care of
	adjusting to the $x$ and $Q$ bounds. Account for the Jacobian.

	The parameter [[negative_sf]] is necessary to determine if we allow for negative PDF values.
	The class [[rescale]] gives rescaling prescription for NLO convolution of the
	structure function in combination with [[i_sub]].
	<<SF pdf builtin: pdf builtin: TBP>>=
	procedure :: apply => pdf_builtin_apply
	<<SF pdf builtin: sub interfaces>>=
	module subroutine pdf_builtin_apply &
	(sf_int, scale, negative_sf, rescale, i_sub)
	class(pdf_builtin_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	end subroutine pdf_builtin_apply
	<<SF pdf builtin: procedures>>=
	module subroutine pdf_builtin_apply &
	(sf_int, scale, negative_sf, rescale, i_sub)
	class(pdf_builtin_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	real(default), dimension(-6:6) :: ff
	real(double), dimension(-6:6) :: ff_dbl
	real(default) :: x, fph
	real(double) :: xx, qq
	complex(default), dimension(:), allocatable :: fc
	integer :: i, j_sub, i_sub_opt
	logical :: negative_sf_opt
	i_sub_opt = 0; if (present (i_sub)) i_sub_opt = i_sub
	negative_sf_opt = .false.; if (present(negative_sf)) negative_sf_opt = negative_sf
	associate (data => sf_int%data)
	sf_int%q = scale
	x = sf_int%x
	if (present (rescale)) call rescale%apply (x)
	if (debug2_active (D_BEAMS)) then
	call msg_debug2 (D_BEAMS, "pdf_builtin_apply")
	call msg_debug2 (D_BEAMS, "rescale: ", present(rescale))
	call msg_debug2 (D_BEAMS, "i_sub: ", i_sub_opt)
	call msg_debug2 (D_BEAMS, "x: ", x)
	end if
	xx = x
	qq = scale
	if (data%invert) then
	if (data%has_photon) then
	call pdf_evolve (data%id, x, scale, ff(6:-6:-1), fph)
	else
	if (data%hoppet_b_matching) then
	call hoppet_eval (xx, qq, ff_dbl(6:-6:-1))
	ff = ff_dbl
	else
	call pdf_evolve (data%id, x, scale, ff(6:-6:-1))
	end if
	end if
	else
	if (data%has_photon) then
	call pdf_evolve (data%id, x, scale, ff, fph)
	else
	if (data%hoppet_b_matching) then
	call hoppet_eval (xx, qq, ff_dbl)
	ff = ff_dbl
	else
	call pdf_evolve (data%id, x, scale, ff)
	end if
	end if
	end if
	if (data%has_photon) then
	allocate (fc (count ([data%mask, data%mask_photon])))
	if (negative_sf_opt) then
	fc = pack ([ff, fph], [data%mask, data%mask_photon])
	else
	fc = max( pack ([ff, fph], [data%mask, data%mask_photon]), 0._default)
	end if
	else
	allocate (fc (count (data%mask)))
	if (negative_sf_opt) then
	fc = pack (ff, data%mask)
	else
	fc = max( pack (ff, data%mask), 0._default)
	end if
	end if
	end associate
	if (debug_active (D_BEAMS)) print *, 'Set pdfs: ', real (fc)
	call sf_int%set_matrix_element (fc, [(i_sub_opt * size(fc) + i, i = 1, size(fc))])
	sf_int%status = SF_EVALUATED
	end subroutine pdf_builtin_apply

	@ %def pdf_builtin_apply
	@
	\subsection{Strong Coupling}
	Since the PDF codes provide a function for computing the running
	$\alpha_s$ value, we make this available as an implementation of the
	abstract [[alpha_qcd_t]] type, which is used for matrix element evaluation.
	<<SF pdf builtin: public>>=
	public :: alpha_qcd_pdf_builtin_t
	<<SF pdf builtin: types>>=
	type, extends (alpha_qcd_t) :: alpha_qcd_pdf_builtin_t
	type(string_t) :: pdfset_name
	integer :: pdfset_id = -1
	contains
	<<SF pdf builtin: alpha qcd: TBP>>
	end type alpha_qcd_pdf_builtin_t

	@ %def alpha_qcd_pdf_builtin_t
	@ Output.
	<<SF pdf builtin: alpha qcd: TBP>>=
	procedure :: write => alpha_qcd_pdf_builtin_write
	<<SF pdf builtin: sub interfaces>>=
	module subroutine alpha_qcd_pdf_builtin_write (object, unit)
	class(alpha_qcd_pdf_builtin_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine alpha_qcd_pdf_builtin_write
	<<SF pdf builtin: procedures>>=
	module subroutine alpha_qcd_pdf_builtin_write (object, unit)
	class(alpha_qcd_pdf_builtin_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A)") "QCD parameters (pdf_builtin):"
	write (u, "(5x,A,A)") "PDF set = ", char (object%pdfset_name)
	write (u, "(5x,A,I0)") "PDF ID = ", object%pdfset_id
	end subroutine alpha_qcd_pdf_builtin_write

	@ %def alpha_qcd_pdf_builtin_write
	@ Calculation: the numeric ID selects the correct PDF set, which must
	be properly initialized.
	<<SF pdf builtin: alpha qcd: TBP>>=
	procedure :: get => alpha_qcd_pdf_builtin_get
	<<SF pdf builtin: sub interfaces>>=
	module function alpha_qcd_pdf_builtin_get (alpha_qcd, scale) result (alpha)
	class(alpha_qcd_pdf_builtin_t), intent(in) :: alpha_qcd
	real(default), intent(in) :: scale
	real(default) :: alpha
	end function alpha_qcd_pdf_builtin_get
	<<SF pdf builtin: procedures>>=
	module function alpha_qcd_pdf_builtin_get (alpha_qcd, scale) result (alpha)
	class(alpha_qcd_pdf_builtin_t), intent(in) :: alpha_qcd
	real(default), intent(in) :: scale
	real(default) :: alpha
	alpha = pdf_alphas (alpha_qcd%pdfset_id, scale)
	end function alpha_qcd_pdf_builtin_get

	@ %def alpha_qcd_pdf_builtin_get
	@
	Initialization. We need to access the global initialization status.
	<<SF pdf builtin: alpha qcd: TBP>>=
	procedure :: init => alpha_qcd_pdf_builtin_init
	<<SF pdf builtin: sub interfaces>>=
	module subroutine alpha_qcd_pdf_builtin_init (alpha_qcd, name, path)
	class(alpha_qcd_pdf_builtin_t), intent(out) :: alpha_qcd
	type(string_t), intent(in) :: name
	type(string_t), intent(in) :: path
	end subroutine alpha_qcd_pdf_builtin_init
	<<SF pdf builtin: procedures>>=
	module subroutine alpha_qcd_pdf_builtin_init (alpha_qcd, name, path)
	class(alpha_qcd_pdf_builtin_t), intent(out) :: alpha_qcd
	type(string_t), intent(in) :: name
	type(string_t), intent(in) :: path
	alpha_qcd%pdfset_name = name
	alpha_qcd%pdfset_id = pdf_get_id (name)
	if (alpha_qcd%pdfset_id < 0) &
	call msg_fatal ("QCD parameter initialization: PDF set " &
	// char (name) // " is unknown")
	call pdf_init (alpha_qcd%pdfset_id, path)
	end subroutine alpha_qcd_pdf_builtin_init

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

	module sf_pdf_builtin_ut
	use unit_tests
	use sf_pdf_builtin_uti

	<<Standard module head>>

	<<SF pdf builtin: public test>>

	contains

	<<SF pdf builtin: test driver>>

	end module sf_pdf_builtin_ut
	@ %def sf_pdf_builtin_ut
	@
	<<[[sf_pdf_builtin_uti.f90]]>>=
	<<File header>>

	module sf_pdf_builtin_uti

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use physics_defs, only: PROTON
	use sm_qcd
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use sf_base

	use sf_pdf_builtin

	<<Standard module head>>

	<<SF pdf builtin: test declarations>>

	contains

	<<SF pdf builtin: tests>>

	end module sf_pdf_builtin_uti
	@ %def sf_pdf_builtin_ut
	@ API: driver for the unit tests below.
	<<SF pdf builtin: public test>>=
	public :: sf_pdf_builtin_test
	<<SF pdf builtin: test driver>>=
	subroutine sf_pdf_builtin_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF pdf builtin: execute tests>>
	end subroutine sf_pdf_builtin_test

	@ %def sf_pdf_builtin_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF pdf builtin: execute tests>>=
	call test (sf_pdf_builtin_1, "sf_pdf_builtin_1", &
	"structure function configuration", &
	u, results)
	<<SF pdf builtin: test declarations>>=
	public :: sf_pdf_builtin_1
	<<SF pdf builtin: tests>>=
	subroutine sf_pdf_builtin_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	class(sf_data_t), allocatable :: data
	type(string_t) :: name

	write (u, "(A)") "* Test output: sf_pdf_builtin_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call os_data%init ()

	call model%init_sm_test ()
	pdg_in = PROTON

	allocate (pdf_builtin_data_t :: data)
	call data%write (u)

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

	name = "CTEQ6L"

	select type (data)
	type is (pdf_builtin_data_t)
	call data%init (model, pdg_in, name, &
	os_data%pdf_builtin_datapath)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	call model%final ()

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

	end subroutine sf_pdf_builtin_1

	@ %def sf_pdf_builtin_1
	@
	\subsubsection{Test and probe structure function}
	Construct and display a structure function object based on the PDF builtin
	structure function.
	<<SF pdf builtin: execute tests>>=
	call test (sf_pdf_builtin_2, "sf_pdf_builtin_2", &
	"structure function instance", &
	u, results)
	<<SF pdf builtin: test declarations>>=
	public :: sf_pdf_builtin_2
	<<SF pdf builtin: tests>>=
	subroutine sf_pdf_builtin_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(string_t) :: name
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_pdf_builtin_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call os_data%init ()
	call model%init_sm_test ()
	call flv%init (PROTON, model)
	pdg_in = PROTON

	call reset_interaction_counter ()

	name = "CTEQ6L"

	allocate (pdf_builtin_data_t :: data)
	select type (data)
	type is (pdf_builtin_data_t)
	call data%init (model, pdg_in, name, &
	os_data%pdf_builtin_datapath)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.5_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for Q = 100 GeV"
	write (u, "(A)")

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%apply (scale = 100._default)
	call sf_int%write (u)


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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_pdf_builtin_2

	@ %def sf_pdf_builtin_2
	@
	\subsubsection{Strong Coupling}
	Test $\alpha_s$ as an implementation of the [[alpha_qcd_t]] abstract
	type.
	<<SF pdf builtin: execute tests>>=
	call test (sf_pdf_builtin_3, "sf_pdf_builtin_3", &
	"running alpha_s", &
	u, results)
	<<SF pdf builtin: test declarations>>=
	public :: sf_pdf_builtin_3
	<<SF pdf builtin: tests>>=
	subroutine sf_pdf_builtin_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(qcd_t) :: qcd
	type(string_t) :: name

	write (u, "(A)") "* Test output: sf_pdf_builtin_3"
	write (u, "(A)") "* Purpose: initialize and evaluate alpha_s"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call os_data%init ()

	name = "CTEQ6L"

	write (u, "(A)") "* Initialize qcd object"
	write (u, "(A)")

	allocate (alpha_qcd_pdf_builtin_t :: qcd%alpha)
	select type (alpha => qcd%alpha)
	type is (alpha_qcd_pdf_builtin_t)
	call alpha%init (name, os_data%pdf_builtin_datapath)
	end select
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for Q = 100"
	write (u, "(A)")

	write (u, "(1x,A,F8.5)") "alpha = ", qcd%alpha%get (100._default)

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

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

	end subroutine sf_pdf_builtin_3

	@ %def sf_pdf_builtin_3
	@
	\clearpage
	%------------------------------------------------------------------------
	\section{LHAPDF}
	Parton distribution functions (PDFs) are available via an interface to
	the LHAPDF standard library.
	@
	\subsection{The module}
	<<[[sf_lhapdf.f90]]>>=
	<<File header>>

	module sf_lhapdf

	<<Use kinds>>
	<<Use strings>>
	use sm_qcd
	use pdg_arrays
	use model_data
	use flavors
	use polarizations
	use sf_base
	use lhapdf !NODEP!

	<<Standard module head>>

	<<SF lhapdf: public>>

	<<SF lhapdf: types>>

	<<SF lhapdf: variables>>

	<<SF lhapdf: interfaces>>

	interface
	<<SF lhapdf: sub interfaces>>
	end interface

	contains

	<<SF lhapdf: main procedures>>

	end module sf_lhapdf
	@ %def sf_lhapdf
	@
	<<[[sf_lhapdf_sub.f90]]>>=
	<<File header>>

	submodule (sf_lhapdf) sf_lhapdf_s

	use format_defs, only: FMT_17, FMT_19
	use io_units
	use system_dependencies, only: LHAPDF_PDFSETS_PATH
	use system_dependencies, only: LHAPDF5_AVAILABLE
	use system_dependencies, only: LHAPDF6_AVAILABLE
	use diagnostics
	use physics_defs, only: PROTON, PHOTON, PIPLUS, GLUON
	use physics_defs, only: HADRON_REMNANT_SINGLET
	use physics_defs, only: HADRON_REMNANT_TRIPLET
	use physics_defs, only: HADRON_REMNANT_OCTET
	use lorentz
	use colors
	use quantum_numbers
	use state_matrices
	use hoppet_interface

	implicit none

	<<SF lhapdf: parameters>>

	contains

	<<SF lhapdf: procedures>>

	end submodule sf_lhapdf_s

	@ %def sf_lhapdf_s
	@
	\subsection{Codes for default PDF sets}
	The default PDF for protons set is chosen to be CTEQ6ll (LO fit with
	LO $\alpha_s$).
	<<SF lhapdf: parameters>>=
	character(*), parameter :: LHAPDF5_DEFAULT_PROTON = "cteq6ll.LHpdf"
	character(*), parameter :: LHAPDF5_DEFAULT_PION = "ABFKWPI.LHgrid"
	character(*), parameter :: LHAPDF5_DEFAULT_PHOTON = "GSG960.LHgrid"
	character(*), parameter :: LHAPDF6_DEFAULT_PROTON = "CT10"
	@ %def LHAPDF5_DEFAULT_PROTON LHAPDF5_DEFAULT_PION
	@ %def LHAPDF5_DEFAULT_PHOTON LHAPDF6_DEFAULT_PROTON
	@
	\subsection{LHAPDF library interface}
	Here we specify explicit interfaces for all LHAPDF routines that we
	use below.
	<<SF lhapdf: interfaces>>=
	interface
	subroutine InitPDFsetM (set, file)
	integer, intent(in) :: set
	character(*), intent(in) :: file
	end subroutine InitPDFsetM
	end interface

	@ %def InitPDFsetM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine InitPDFM (set, mem)
	integer, intent(in) :: set, mem
	end subroutine InitPDFM
	end interface

	@ %def InitPDFM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine numberPDFM (set, n_members)
	integer, intent(in) :: set
	integer, intent(out) :: n_members
	end subroutine numberPDFM
	end interface

	@ %def numberPDFM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine evolvePDFM (set, x, q, ff)
	integer, intent(in) :: set
	double precision, intent(in) :: x, q
	double precision, dimension(-6:6), intent(out) :: ff
	end subroutine evolvePDFM
	end interface

	@ %def evolvePDFM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine evolvePDFphotonM (set, x, q, ff, fphot)
	integer, intent(in) :: set
	double precision, intent(in) :: x, q
	double precision, dimension(-6:6), intent(out) :: ff
	double precision, intent(out) :: fphot
	end subroutine evolvePDFphotonM
	end interface

	@ %def evolvePDFphotonM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine evolvePDFpM (set, x, q, s, scheme, ff)
	integer, intent(in) :: set
	double precision, intent(in) :: x, q, s
	integer, intent(in) :: scheme
	double precision, dimension(-6:6), intent(out) :: ff
	end subroutine evolvePDFpM
	end interface

	@ %def evolvePDFpM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine GetXminM (set, mem, xmin)
	integer, intent(in) :: set, mem
	double precision, intent(out) :: xmin
	end subroutine GetXminM
	end interface

	@ %def GetXminM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine GetXmaxM (set, mem, xmax)
	integer, intent(in) :: set, mem
	double precision, intent(out) :: xmax
	end subroutine GetXmaxM
	end interface

	@ %def GetXmaxM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine GetQ2minM (set, mem, q2min)
	integer, intent(in) :: set, mem
	double precision, intent(out) :: q2min
	end subroutine GetQ2minM
	end interface

	@ %def GetQ2minM
	<<SF lhapdf: interfaces>>=
	interface
	subroutine GetQ2maxM (set, mem, q2max)
	integer, intent(in) :: set, mem
	double precision, intent(out) :: q2max
	end subroutine GetQ2maxM
	end interface

	@ %def GetQ2maxM
	<<SF lhapdf: interfaces>>=
	interface
	function has_photon () result(flag)
	logical :: flag
	end function has_photon
	end interface

	@ %def has_photon
	@
	\subsection{The LHAPDF status}
	This type holds the initialization status of the LHAPDF system. Entry
	1 is for proton PDFs, entry 2 for pion PDFs, entry 3 for photon PDFs.

	Since it is connected to the external LHAPDF library, this is a truly
	global object. We implement it as a a private module variable. To
	access it from elsewhere, the caller has to create and initialize an
	object of type [[lhapdf_status_t]], which acts as a proxy.
	<<SF lhapdf: types>>=
	type :: lhapdf_global_status_t
	private
	logical, dimension(3) :: initialized = .false.
	end type lhapdf_global_status_t

	@ %def lhapdf_global_status_t
	<<SF lhapdf: variables>>=
	type(lhapdf_global_status_t), save :: lhapdf_global_status
	@ %def lhapdf_global_status
	<<SF lhapdf: procedures>>=
	function lhapdf_global_status_is_initialized (set) result (flag)
	logical :: flag
	integer, intent(in), optional :: set
	if (present (set)) then
	select case (set)
	case (1:3); flag = lhapdf_global_status%initialized(set)
	case default; flag = .false.
	end select
	else
	flag = any (lhapdf_global_status%initialized)
	end if
	end function lhapdf_global_status_is_initialized

	@ %def lhapdf_global_status_is_initialized
	<<SF lhapdf: procedures>>=
	subroutine lhapdf_global_status_set_initialized (set)
	integer, intent(in) :: set
	lhapdf_global_status%initialized(set) = .true.
	end subroutine lhapdf_global_status_set_initialized

	@ %def lhapdf_global_status_set_initialized
	@ This is the only public procedure, it tells the system to forget
	about previous initialization, allowing for changing the chosen PDF
	set. Note that such a feature works only if the global program flow
	is serial, so no two distinct sets are accessed simultaneously. But
	this applies to LHAPDF anyway.
	<<SF lhapdf: public>>=
	public :: lhapdf_global_reset
	<<SF lhapdf: sub interfaces>>=
	module subroutine lhapdf_global_reset ()
	end subroutine lhapdf_global_reset
	<<SF lhapdf: procedures>>=
	module subroutine lhapdf_global_reset ()
	lhapdf_global_status%initialized = .false.
	end subroutine lhapdf_global_reset

	@ %def lhapdf_global_status_reset
	@
	\subsection{LHAPDF initialization}
	Before using LHAPDF, we have to initialize it with a particular data
	set and member. This applies not just if we use structure functions,
	but also if we just use an $\alpha_s$ formula. The integer [[set]]
	should be $1$ for proton, $2$ for pion, and $3$ for photon, but this
	is just convention.

	It appears as if LHAPDF does not allow for multiple data sets being
	used concurrently (?), so multi-threaded usage with different sets
	(e.g., a scan) is excluded. The current setup with a global flag that
	indicates initialization is fine as long as Whizard itself is run in
	serial mode at the Sindarin level. If we introduce multithreading in
	any form from Sindarin, we have to rethink the implementation of the
	LHAPDF interface. (The same considerations apply to builtin PDFs.)

	If the particular set has already been initialized, do nothing. This
	implies that whenever we want to change the setup for a particular
	set, we have to reset the LHAPDF status.
	[[lhapdf_initialize]] has an obvious name clash with [[lhapdf_init]],
	the reason it works for [[pdf_builtin]] is that there things are
	outsourced to a separate module (inc. [[lhapdf_status]] etc.).
	<<SF lhapdf: public>>=
	public :: lhapdf_initialize
	<<SF lhapdf: sub interfaces>>=
	module subroutine lhapdf_initialize &
	(set, prefix, file, member, pdf, b_match)
	integer, intent(in) :: set
	type(string_t), intent(inout) :: prefix
	type(string_t), intent(inout) :: file
	type(lhapdf_pdf_t), intent(inout), optional :: pdf
	integer, intent(inout) :: member
	logical, intent(in), optional :: b_match
	end subroutine lhapdf_initialize
	<<SF lhapdf: procedures>>=
	module subroutine lhapdf_initialize &
	(set, prefix, file, member, pdf, b_match)
	integer, intent(in) :: set
	type(string_t), intent(inout) :: prefix
	type(string_t), intent(inout) :: file
	type(lhapdf_pdf_t), intent(inout), optional :: pdf
	integer, intent(inout) :: member
	logical, intent(in), optional :: b_match
	if (prefix == "") prefix = LHAPDF_PDFSETS_PATH
	if (LHAPDF5_AVAILABLE) then
	if (lhapdf_global_status_is_initialized (set)) return
	if (file == "") then
	select case (set)
	case (1); file = LHAPDF5_DEFAULT_PROTON
	case (2); file = LHAPDF5_DEFAULT_PION
	case (3); file = LHAPDF5_DEFAULT_PHOTON
	end select
	end if
	if (data_file_exists (prefix // "/" // file)) then
	call InitPDFsetM (set, char (prefix // "/" // file))
	else
	call msg_fatal ("LHAPDF: Data file '" &
	// char (file) // "' not found in '" // char (prefix) // "'.")
	return
	end if
	if (.not. dataset_member_exists (set, member)) then
	call msg_error (" LHAPDF: Chosen member does not exist for set '" &
	// char (file) // "', using default.")
	member = 0
	end if
	call InitPDFM (set, member)
	else if (LHAPDF6_AVAILABLE) then
	! TODO: (bcn 2015-07-07) we should have a closer look why this global
	! check must not be executed
	! if (lhapdf_global_status_is_initialized (set) .and. &
	! pdf%is_associated ()) return
	if (file == "") then
	select case (set)
	case (1); file = LHAPDF6_DEFAULT_PROTON
	case (2);
	call msg_fatal ("LHAPDF6: no pion PDFs supported")
	case (3);
	call msg_fatal ("LHAPDF6: no photon PDFs supported")
	end select
	end if
	if (data_file_exists (prefix // "/" // file // "/" // file // ".info")) then
	call pdf%init (char (file), member)
	else
	call msg_fatal ("LHAPDF: Data file '" &
	// char (file) // "' not found in '" // char (prefix) // "'.")
	return
	end if
	end if
	if (present (b_match)) then
	if (b_match) then
	if (LHAPDF5_AVAILABLE) then
	call hoppet_init (.false.)
	else if (LHAPDF6_AVAILABLE) then
	call hoppet_init (.false., pdf)
	end if
	end if
	end if
	call lhapdf_global_status_set_initialized (set)
	contains
	function data_file_exists (fq_name) result (exist)
	type(string_t), intent(in) :: fq_name
	logical :: exist
	inquire (file = char(fq_name), exist = exist)
	end function data_file_exists
	function dataset_member_exists (set, member) result (exist)
	integer, intent(in) :: set, member
	logical :: exist
	integer :: n_members
	call numberPDFM (set, n_members)
	exist = member >= 0 .and. member <= n_members
	end function dataset_member_exists
	end subroutine lhapdf_initialize

	@ %def lhapdf_initialize
	@
	\subsection{Kinematics}
	Set kinematics. If [[map]] is unset, the $r$ and $x$ values
	coincide, and the Jacobian $f(r)$ is trivial.

	If [[map]] is set, we are asked to provide an efficient mapping.
	For the test case, we set $x=r^2$ and consequently $f(r)=2r$.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: complete_kinematics => lhapdf_complete_kinematics
	<<SF lhapdf: sub interfaces>>=
	module subroutine lhapdf_complete_kinematics &
	(sf_int, x, xb, f, r, rb, map)
	class(lhapdf_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	end subroutine lhapdf_complete_kinematics
	<<SF lhapdf: procedures>>=
	module subroutine lhapdf_complete_kinematics &
	(sf_int, x, xb, f, r, rb, map)
	class(lhapdf_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(in) :: r
	real(default), dimension(:), intent(in) :: rb
	logical, intent(in) :: map
	if (map) then
	call msg_fatal ("LHAPDF: map flag not supported")
	else
	x(1) = r(1)
	xb(1)= rb(1)
	f = 1
	end if
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_DONE_KINEMATICS)
	sf_int%x = x(1)
	case (SF_FAILED_KINEMATICS)
	sf_int%x = 0
	f = 0
	end select
	end subroutine lhapdf_complete_kinematics

	@ %def lhapdf_complete_kinematics
	@ Overriding the default method: we compute the [[x]] value from the
	momentum configuration. In this specific case, we also set the
	internally stored $x$ value, so it can be used in the
	following routine.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: recover_x => lhapdf_recover_x
	<<SF lhapdf: sub interfaces>>=
	module subroutine lhapdf_recover_x (sf_int, x, xb, x_free)
	class(lhapdf_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	end subroutine lhapdf_recover_x
	<<SF lhapdf: procedures>>=
	module subroutine lhapdf_recover_x (sf_int, x, xb, x_free)
	class(lhapdf_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(out) :: x
	real(default), dimension(:), intent(out) :: xb
	real(default), intent(inout), optional :: x_free
	call sf_int%base_recover_x (x, xb, x_free)
	sf_int%x = x(1)
	end subroutine lhapdf_recover_x

	@ %def lhapdf_recover_x
	@ Compute inverse kinematics. Here, we start with the $x$ array and
	compute the ``input'' $r$ values and the Jacobian $f$. After this, we
	can set momenta by the same formula as for normal kinematics.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: inverse_kinematics => lhapdf_inverse_kinematics
	<<SF lhapdf: sub interfaces>>=
	module subroutine lhapdf_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(lhapdf_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	end subroutine lhapdf_inverse_kinematics
	<<SF lhapdf: procedures>>=
	module subroutine lhapdf_inverse_kinematics &
	(sf_int, x, xb, f, r, rb, map, set_momenta)
	class(lhapdf_t), intent(inout) :: sf_int
	real(default), dimension(:), intent(in) :: x
	real(default), dimension(:), intent(in) :: xb
	real(default), intent(out) :: f
	real(default), dimension(:), intent(out) :: r
	real(default), dimension(:), intent(out) :: rb
	logical, intent(in) :: map
	logical, intent(in), optional :: set_momenta
	logical :: set_mom
	set_mom = .false.; if (present (set_momenta)) set_mom = set_momenta
	if (map) then
	call msg_fatal ("LHAPDF: map flag not supported")
	else
	r(1) = x(1)
	rb(1)= xb(1)
	f = 1
	end if
	if (set_mom) then
	call sf_int%split_momentum (x, xb)
	select case (sf_int%status)
	case (SF_FAILED_KINEMATICS); f = 0
	end select
	end if
	end subroutine lhapdf_inverse_kinematics

	@ %def lhapdf_inverse_kinematics
	@
	\subsection{The LHAPDF data block}
	The data block holds the incoming flavor (which has to be proton,
	pion, or photon), the corresponding pointer to the global access data
	(1, 2, or 3), the flag [[invert]] which is set for an antiproton, the
	bounds as returned by LHAPDF for the specified set, and a mask that
	determines which partons will be actually in use.
	<<SF lhapdf: public>>=
	public :: lhapdf_data_t
	<<SF lhapdf: types>>=
	type, extends (sf_data_t) :: lhapdf_data_t
	private
	type(string_t) :: prefix
	type(string_t) :: file
	type(lhapdf_pdf_t) :: pdf
	integer :: member = 0
	class(model_data_t), pointer :: model => null ()
	type(flavor_t) :: flv_in
	integer :: set = 0
	logical :: invert = .false.
	logical :: photon = .false.
	logical :: has_photon = .false.
	integer :: photon_scheme = 0
	real(default) :: xmin = 0, xmax = 0
	real(default) :: qmin = 0, qmax = 0
	logical, dimension(-6:6) :: mask = .true.
	logical :: mask_photon = .true.
	logical :: hoppet_b_matching = .false.
	contains
	<<SF lhapdf: lhapdf data: TBP>>
	end type lhapdf_data_t

	@ %def lhapdf_data_t
	@ Generate PDF data. This is provided as a function, but it has the
	side-effect of initializing the requested PDF set. A finalizer is not
	needed.

	The library uses double precision, so since the default precision may be
	extended or quadruple, we use auxiliary variables for type casting.
	<<SF lhapdf: lhapdf data: TBP>>=
	procedure :: init => lhapdf_data_init
	<<SF lhapdf: sub interfaces>>=
	module subroutine lhapdf_data_init &
	(data, model, pdg_in, prefix, file, member, photon_scheme, &
	hoppet_b_matching)
	class(lhapdf_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	type(string_t), intent(in), optional :: prefix, file
	integer, intent(in), optional :: member
	integer, intent(in), optional :: photon_scheme
	logical, intent(in), optional :: hoppet_b_matching
	end subroutine lhapdf_data_init
	<<SF lhapdf: procedures>>=
	module subroutine lhapdf_data_init &
	(data, model, pdg_in, prefix, file, member, photon_scheme, &
	hoppet_b_matching)
	class(lhapdf_data_t), intent(out) :: data
	class(model_data_t), intent(in), target :: model
	type(pdg_array_t), intent(in) :: pdg_in
	type(string_t), intent(in), optional :: prefix, file
	integer, intent(in), optional :: member
	integer, intent(in), optional :: photon_scheme
	logical, intent(in), optional :: hoppet_b_matching
	double precision :: xmin, xmax, q2min, q2max
	external :: InitPDFsetM, InitPDFM, numberPDFM
	external :: GetXminM, GetXmaxM, GetQ2minM, GetQ2maxM
	if (.not. LHAPDF5_AVAILABLE .and. .not. LHAPDF6_AVAILABLE) then
	call msg_fatal ("LHAPDF requested but library is not linked")
	return
	end if
	data%model => model
	if (pdg_in%get_length () /= 1) &
	call msg_fatal ("PDF: incoming particle must be unique")
	call data%flv_in%init (pdg_in%get (1), model)
	select case (pdg_in%get (1))
	case (PROTON)
	data%set = 1
	case (-PROTON)
	data%set = 1
	data%invert = .true.
	case (PIPLUS)
	data%set = 2
	case (-PIPLUS)
	data%set = 2
	data%invert = .true.
	case (PHOTON)
	data%set = 3
	data%photon = .true.
	if (present (photon_scheme)) data%photon_scheme = photon_scheme
	case default
	call msg_fatal (" LHAPDF: " &
	// "incoming particle must be (anti)proton, pion, or photon.")
	return
	end select
	if (present (prefix)) then
	data%prefix = prefix
	else
	data%prefix = ""
	end if
	if (present (file)) then
	data%file = file
	else
	data%file = ""
	end if
	if (present (hoppet_b_matching)) data%hoppet_b_matching = hoppet_b_matching
	if (LHAPDF5_AVAILABLE) then
	call lhapdf_initialize (data%set, &
	data%prefix, data%file, data%member, &
	b_match = data%hoppet_b_matching)
	call GetXminM (data%set, data%member, xmin)
	call GetXmaxM (data%set, data%member, xmax)
	call GetQ2minM (data%set, data%member, q2min)
	call GetQ2maxM (data%set, data%member, q2max)
	data%xmin = xmin
	data%xmax = xmax
	data%qmin = sqrt (q2min)
	data%qmax = sqrt (q2max)
	data%has_photon = has_photon ()
	else if (LHAPDF6_AVAILABLE) then
	call lhapdf_initialize (data%set, &
	data%prefix, data%file, data%member, &
	data%pdf, data%hoppet_b_matching)
	data%xmin = data%pdf%getxmin ()
	data%xmax = data%pdf%getxmax ()
	data%qmin = sqrt(data%pdf%getq2min ())
	data%qmax = sqrt(data%pdf%getq2max ())
	data%has_photon = data%pdf%has_photon ()
	end if
	end subroutine lhapdf_data_init

	@ %def lhapdf_data_init
	@ Enable/disable partons explicitly. If a mask entry is true,
	applying the PDF will generate the corresponding flavor on output.
	<<LHAPDF: lhapdf data: TBP>>=
	procedure :: set_mask => lhapdf_data_set_mask
	<<LHAPDF: procedures>>=
	subroutine lhapdf_data_set_mask (data, mask)
	class(lhapdf_data_t), intent(inout) :: data
	logical, dimension(-6:6), intent(in) :: mask
	data%mask = mask
	end subroutine lhapdf_data_set_mask

	@ %def lhapdf_data_set_mask
	@ Return the public part of the data set.
	<<LHAPDF: public>>=
	public :: lhapdf_data_get_public_info
	<<LHAPDF: procedures>>=
	subroutine lhapdf_data_get_public_info &
	(data, lhapdf_dir, lhapdf_file, lhapdf_member)
	type(lhapdf_data_t), intent(in) :: data
	type(string_t), intent(out) :: lhapdf_dir, lhapdf_file
	integer, intent(out) :: lhapdf_member
	lhapdf_dir = data%prefix
	lhapdf_file = data%file
	lhapdf_member = data%member
	end subroutine lhapdf_data_get_public_info

	@ %def lhapdf_data_get_public_info
	@ Return the number of the member of the data set.
	<<LHAPDF: public>>=
	public :: lhapdf_data_get_set
	<<LHAPDF: procedures>>=
	function lhapdf_data_get_set(data) result(set)
	type(lhapdf_data_t), intent(in) :: data
	integer :: set
	set = data%set
	end function lhapdf_data_get_set

	@ %def lhapdf_data_get_set
	@ Output
	<<SF lhapdf: lhapdf data: TBP>>=
	procedure :: write => lhapdf_data_write
	<<SF lhapdf: sub interfaces>>=
	module subroutine lhapdf_data_write (data, unit, verbose)
	class(lhapdf_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine lhapdf_data_write
	<<SF lhapdf: procedures>>=
	module subroutine lhapdf_data_write (data, unit, verbose)
	class(lhapdf_data_t), intent(in) :: data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical :: verb
	integer :: u
	if (present (verbose)) then
	verb = verbose
	else
	verb = .false.
	end if
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "LHAPDF data:"
	if (data%set /= 0) then
	write (u, "(3x,A)", advance="no") "flavor = "
	call data%flv_in%write (u); write (u, *)
	if (verb) then
	write (u, "(3x,A,A)") " prefix = ", char (data%prefix)
	else
	write (u, "(3x,A,A)") " prefix = ", &
	" <empty (non-verbose version)>"
	end if
	write (u, "(3x,A,A)") " file = ", char (data%file)
	write (u, "(3x,A,I3)") " member = ", data%member
	write (u, "(3x,A," // FMT_19 // ")") " x(min) = ", data%xmin
	write (u, "(3x,A," // FMT_19 // ")") " x(max) = ", data%xmax
	write (u, "(3x,A," // FMT_19 // ")") " Q(min) = ", data%qmin
	write (u, "(3x,A," // FMT_19 // ")") " Q(max) = ", data%qmax
	write (u, "(3x,A,L1)") " invert = ", data%invert
	if (data%photon) write (u, "(3x,A,I3)") &
	" IP2 (scheme) = ", data%photon_scheme
	write (u, "(3x,A,6(1x,L1),1x,A,1x,L1,1x,A,6(1x,L1))") &
	" mask = ", &
	data%mask(-6:-1), "", data%mask(0), "", data%mask(1:6)
	write (u, "(3x,A,L1)") " photon mask = ", data%mask_photon
	if (data%set == 1) write (u, "(3x,A,L1)") &
	" hoppet_b = ", data%hoppet_b_matching
	else
	write (u, "(3x,A)") "[undefined]"
	end if
	end subroutine lhapdf_data_write
	@ %def lhapdf_data_write
	@ The number of parameters is one. We do not generate transverse momentum.
	<<SF lhapdf: lhapdf data: TBP>>=
	procedure :: get_n_par => lhapdf_data_get_n_par
	<<SF lhapdf: sub interfaces>>=
	module function lhapdf_data_get_n_par (data) result (n)
	class(lhapdf_data_t), intent(in) :: data
	integer :: n
	end function lhapdf_data_get_n_par
	<<SF lhapdf: procedures>>=
	module function lhapdf_data_get_n_par (data) result (n)
	class(lhapdf_data_t), intent(in) :: data
	integer :: n
	n = 1
	end function lhapdf_data_get_n_par

	@ %def lhapdf_data_get_n_par
	@ Return the outgoing particle PDG codes. This is based on the mask.
	<<SF lhapdf: lhapdf data: TBP>>=
	procedure :: get_pdg_out => lhapdf_data_get_pdg_out
	<<SF lhapdf: sub interfaces>>=
	module subroutine lhapdf_data_get_pdg_out (data, pdg_out)
	class(lhapdf_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	end subroutine lhapdf_data_get_pdg_out
	<<SF lhapdf: procedures>>=
	module subroutine lhapdf_data_get_pdg_out (data, pdg_out)
	class(lhapdf_data_t), intent(in) :: data
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	integer :: n, np, i
	n = count (data%mask)
	np = 0; if (data%has_photon .and. data%mask_photon) np = 1
	allocate (pdg1 (n + np))
	pdg1(1:n) = pack ([(i, i = -6, 6)], data%mask)
	if (np == 1) pdg1(n+np) = PHOTON
	pdg_out(1) = pdg1
	end subroutine lhapdf_data_get_pdg_out

	@ %def lhapdf_data_get_pdg_out
	@ Allocate the interaction record. Due to a gfortran 7/8/9 bug this
	has to remain in the main module.
	<<SF lhapdf: lhapdf data: TBP>>=
	procedure :: allocate_sf_int => lhapdf_data_allocate_sf_int
	<<SF lhapdf: main procedures>>=
	subroutine lhapdf_data_allocate_sf_int (data, sf_int)
	class(lhapdf_data_t), intent(in) :: data
	class(sf_int_t), intent(inout), allocatable :: sf_int
	allocate (lhapdf_t :: sf_int)
	end subroutine lhapdf_data_allocate_sf_int

	@ %def lhapdf_data_allocate_sf_int
	@ Return the numerical PDF set index.
	<<SF lhapdf: lhapdf data: TBP>>=
	procedure :: get_pdf_set => lhapdf_data_get_pdf_set
	<<SF lhapdf: sub interfaces>>=
	elemental module function lhapdf_data_get_pdf_set (data) result (pdf_set)
	class(lhapdf_data_t), intent(in) :: data
	integer :: pdf_set
	end function lhapdf_data_get_pdf_set
	<<SF lhapdf: procedures>>=
	elemental module function lhapdf_data_get_pdf_set (data) result (pdf_set)
	class(lhapdf_data_t), intent(in) :: data
	integer :: pdf_set
	pdf_set = data%set
	end function lhapdf_data_get_pdf_set

	@ %def lhapdf_data_get_pdf_set
	@
	\subsection{The LHAPDF object}
	The [[lhapdf_t]] data type is a $1\to 2$ interaction which describes
	the splitting of an (anti)proton into a parton and a beam remnant. We
	stay in the strict forward-splitting limit, but allow some invariant
	mass for the beam remnant such that the outgoing parton is exactly
	massless. For a real event, we would replace this by a parton
	cascade, where the outgoing partons have virtuality as dictated by
	parton-shower kinematics, and transverse momentum is generated.

	This is the LHAPDF object which holds input data together with the
	interaction. We also store the $x$ momentum fraction and the scale,
	since kinematics and function value are requested at different times.

	The PDF application is a $1\to 2$ splitting process, where the
	particles are ordered as (hadron, remnant, parton).

	Polarization is ignored completely. The beam particle is colorless,
	while partons and beam remnant carry color. The remnant gets a
	special flavor code.
	<<SF lhapdf: public>>=
	public :: lhapdf_t
	<<SF lhapdf: types>>=
	type, extends (sf_int_t) :: lhapdf_t
	type(lhapdf_data_t), pointer :: data => null ()
	real(default) :: x = 0
	real(default) :: q = 0
	real(default) :: s = 0
	contains
	<<SF lhapdf: lhapdf: TBP>>
	end type lhapdf_t

	@ %def lhapdf_t
	@ Type string: display the chosen PDF set.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: type_string => lhapdf_type_string
	<<SF lhapdf: sub interfaces>>=
	module function lhapdf_type_string (object) result (string)
	class(lhapdf_t), intent(in) :: object
	type(string_t) :: string
	end function lhapdf_type_string
	<<SF lhapdf: procedures>>=
	module function lhapdf_type_string (object) result (string)
	class(lhapdf_t), intent(in) :: object
	type(string_t) :: string
	if (associated (object%data)) then
	string = "LHAPDF: " // object%data%file
	else
	string = "LHAPDF: [undefined]"
	end if
	end function lhapdf_type_string

	@ %def lhapdf_type_string
	@ Output. Call the interaction routine after displaying the configuration.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: write => lhapdf_write
	<<SF lhapdf: sub interfaces>>=
	module subroutine lhapdf_write (object, unit, testflag)
	class(lhapdf_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine lhapdf_write
	<<SF lhapdf: procedures>>=
	module subroutine lhapdf_write (object, unit, testflag)
	class(lhapdf_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%data)) then
	call object%data%write (u)
	if (object%status >= SF_DONE_KINEMATICS) then
	write (u, "(1x,A)") "SF parameters:"
	write (u, "(3x,A," // FMT_17 // ")") "x =", object%x
	if (object%status >= SF_FAILED_EVALUATION) then
	write (u, "(3x,A," // FMT_17 // ")") "Q =", object%q
	end if
	end if
	call object%base_write (u, testflag)
	else
	write (u, "(1x,A)") "LHAPDF data: [undefined]"
	end if
	end subroutine lhapdf_write

	@ %def lhapdf_write
	@ Initialize. We know that [[data]] will be of concrete type
	[[sf_lhapdf_data_t]], but we have to cast this explicitly.

	For this implementation, we set the incoming and outgoing masses equal
	to the physical particle mass, but keep the radiated mass zero.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: init => lhapdf_init
	<<SF lhapdf: sub interfaces>>=
	module subroutine lhapdf_init (sf_int, data)
	class(lhapdf_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	end subroutine lhapdf_init
	<<SF lhapdf: procedures>>=
	module subroutine lhapdf_init (sf_int, data)
	class(lhapdf_t), intent(out) :: sf_int
	class(sf_data_t), intent(in), target :: data
	type(quantum_numbers_mask_t), dimension(3) :: mask
	type(flavor_t) :: flv, flv_remnant
	type(color_t) :: col0
	type(quantum_numbers_t), dimension(3) :: qn
	integer :: i
	select type (data)
	type is (lhapdf_data_t)
	mask = quantum_numbers_mask (.false., .false., .true.)
	call col0%init ()
	call sf_int%base_init (mask, [0._default], [0._default], [0._default])
	sf_int%data => data
	do i = -6, 6
	if (data%mask(i)) then
	call qn(1)%init (data%flv_in, col = col0)
	if (i == 0) then
	call flv%init (GLUON, data%model)
	call flv_remnant%init (HADRON_REMNANT_OCTET, data%model)
	else
	call flv%init (i, data%model)
	call flv_remnant%init &
	(sign (HADRON_REMNANT_TRIPLET, -i), data%model)
	end if
	call qn(2)%init ( &
	flv = flv_remnant, col = color_from_flavor (flv_remnant, 1))
	call qn(2)%tag_radiated ()
	call qn(3)%init ( &
	flv = flv, col = color_from_flavor (flv, 1, reverse=.true.))
	call sf_int%add_state (qn)
	end if
	end do
	if (data%has_photon .and. data%mask_photon) then
	call flv%init (PHOTON, data%model)
	call flv_remnant%init (HADRON_REMNANT_SINGLET, data%model)
	call qn(2)%init (flv = flv_remnant, &
	col = color_from_flavor (flv_remnant, 1))
	call qn(2)%tag_radiated ()
	call qn(3)%init (flv = flv, &
	col = color_from_flavor (flv, 1, reverse=.true.))
	call sf_int%add_state (qn)
	end if
	call sf_int%freeze ()
	call sf_int%set_incoming ([1])
	call sf_int%set_radiated ([2])
	call sf_int%set_outgoing ([3])
	sf_int%status = SF_INITIAL
	end select
	end subroutine lhapdf_init

	@ %def lhapdf_init
	@
	\subsection{Structure function}
	We have to cast the LHAPDF arguments to/from double precision (possibly
	from/to extended/quadruple precision), if necessary.
	Some structure functions can yield negative results (sea quarks close
	to $x=1$). In an NLO computation, this is perfectly fine and we keep negative values.
	Unlike total cross sections, PDFs do not have to be positive definite. For LO however,
	negative PDFs would cause negative event weights so we set these values to zero instead.
	<<SF lhapdf: lhapdf: TBP>>=
	procedure :: apply => lhapdf_apply
	<<SF lhapdf: sub interfaces>>=
	module subroutine lhapdf_apply &
	(sf_int, scale, negative_sf, rescale, i_sub)
	class(lhapdf_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	end subroutine lhapdf_apply
	<<SF lhapdf: procedures>>=
	module subroutine lhapdf_apply &
	(sf_int, scale, negative_sf, rescale, i_sub)
	class(lhapdf_t), intent(inout) :: sf_int
	real(default), intent(in) :: scale
	logical, intent(in), optional :: negative_sf
	class(sf_rescale_t), intent(in), optional :: rescale
	integer, intent(in), optional :: i_sub
	real(default) :: x, s
	double precision :: xx, qq, ss
	double precision, dimension(-6:6) :: ff
	double precision :: fphot
	complex(default), dimension(:), allocatable :: fc
	integer :: i, i_sub_opt, j_sub
	logical :: negative_sf_opt
	external :: evolvePDFM, evolvePDFpM
	i_sub_opt = 0; if (present (i_sub)) i_sub_opt = i_sub
	negative_sf_opt = .false.; if (present(negative_sf)) negative_sf_opt = negative_sf
	associate (data => sf_int%data)
	sf_int%q = scale
	x = sf_int%x
	if (present (rescale)) call rescale%apply (x)
	s = sf_int%s
	xx = x
	if (debug2_active (D_BEAMS)) then
	call msg_debug2 (D_BEAMS, "lhapdf_apply")
	call msg_debug2 (D_BEAMS, "rescale: ", present(rescale))
	call msg_debug2 (D_BEAMS, "i_sub: ", i_sub_opt)
	call msg_debug2 (D_BEAMS, "x: ", x)
	end if
	qq = min (data%qmax, scale)
	qq = max (data%qmin, qq)
	if (.not. data%photon) then
	if (data%invert) then
	if (data%has_photon) then
	if (LHAPDF5_AVAILABLE) then
	call evolvePDFphotonM &
	(data%set, xx, qq, ff(6:-6:-1), fphot)
	else if (LHAPDF6_AVAILABLE) then
	call data%pdf%evolve_pdfphotonm &
	(xx, qq, ff(6:-6:-1), fphot)
	end if
	else
	if (data%hoppet_b_matching) then
	call hoppet_eval (xx, qq, ff(6:-6:-1))
	else
	if (LHAPDF5_AVAILABLE) then
	call evolvePDFM (data%set, xx, qq, ff(6:-6:-1))
	else if (LHAPDF6_AVAILABLE) then
	call data%pdf%evolve_pdfm (xx, qq, ff(6:-6:-1))
	end if
	end if
	end if
	else
	if (data%has_photon) then
	if (LHAPDF5_AVAILABLE) then
	call evolvePDFphotonM (data%set, xx, qq, ff, fphot)
	else if (LHAPDF6_AVAILABLE) then
	call data%pdf%evolve_pdfphotonm (xx, qq, ff, fphot)
	end if
	else
	if (data%hoppet_b_matching) then
	call hoppet_eval (xx, qq, ff)
	else
	if (LHAPDF5_AVAILABLE) then
	call evolvePDFM (data%set, xx, qq, ff)
	else if (LHAPDF6_AVAILABLE) then
	call data%pdf%evolve_pdfm (xx, qq, ff)
	end if
	end if
	end if
	end if
	else
	ss = s
	if (LHAPDF5_AVAILABLE) then
	call evolvePDFpM (data%set, xx, qq, &
	ss, data%photon_scheme, ff)
	else if (LHAPDF6_AVAILABLE) then
	call data%pdf%evolve_pdfpm (xx, qq, ss, &
	data%photon_scheme, ff)
	end if
	end if
	if (data%has_photon) then
	allocate (fc (count ([data%mask, data%mask_photon])))
	if (negative_sf_opt) then
	fc = pack ([ff, fphot] / x, [data%mask, data%mask_photon])
	else
	fc = max( pack ([ff, fphot] / x, [data%mask, data%mask_photon]), 0._default)
	end if
	else
	allocate (fc (count (data%mask)))
	if (negative_sf_opt) then
	fc = pack (ff / x, data%mask)
	else
	fc = max( pack (ff / x, data%mask), 0._default)
	end if
	end if
	end associate
	if (debug_active (D_BEAMS)) print *, 'Set pdfs: ', real (fc)
	call sf_int%set_matrix_element (fc, [(i_sub_opt * size(fc) + i, i = 1, size(fc))])
	sf_int%status = SF_EVALUATED
	end subroutine lhapdf_apply

	@ %def apply_lhapdf
	@
	\subsection{Strong Coupling}
	Since the PDF codes provide a function for computing the running
	$\alpha_s$ value, we make this available as an implementation of the
	abstract [[alpha_qcd_t]] type, which is used for matrix element evaluation.
	<<SF lhapdf: public>>=
	public :: alpha_qcd_lhapdf_t
	<<SF lhapdf: types>>=
	type, extends (alpha_qcd_t) :: alpha_qcd_lhapdf_t
	type(string_t) :: pdfset_dir
	type(string_t) :: pdfset_file
	integer :: pdfset_member = -1
	type(lhapdf_pdf_t) :: pdf
	contains
	<<SF lhapdf: alpha qcd: TBP>>
	end type alpha_qcd_lhapdf_t

	@ %def alpha_qcd_lhapdf_t
	@ Output. As in earlier versions we leave the LHAPDF path out.
	<<SF lhapdf: alpha qcd: TBP>>=
	procedure :: write => alpha_qcd_lhapdf_write
	<<SF lhapdf: sub interfaces>>=
	module subroutine alpha_qcd_lhapdf_write (object, unit)
	class(alpha_qcd_lhapdf_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine alpha_qcd_lhapdf_write
	<<SF lhapdf: procedures>>=
	module subroutine alpha_qcd_lhapdf_write (object, unit)
	class(alpha_qcd_lhapdf_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A)") "QCD parameters (lhapdf):"
	write (u, "(5x,A,A)") "PDF set = ", char (object%pdfset_file)
	write (u, "(5x,A,I0)") "PDF member = ", object%pdfset_member
	end subroutine alpha_qcd_lhapdf_write

	@ %def alpha_qcd_lhapdf_write
	@ Calculation: the numeric member ID selects the correct PDF set, which must
	be properly initialized.
	<<SF lhapdf: interfaces>>=
	interface
	double precision function alphasPDF (Q)
	double precision, intent(in) :: Q
	end function alphasPDF
	end interface

	@ %def alphasPDF
	@
	<<SF lhapdf: alpha qcd: TBP>>=
	procedure :: get => alpha_qcd_lhapdf_get
	<<SF lhapdf: sub interfaces>>=
	module function alpha_qcd_lhapdf_get (alpha_qcd, scale) result (alpha)
	class(alpha_qcd_lhapdf_t), intent(in) :: alpha_qcd
	real(default), intent(in) :: scale
	real(default) :: alpha
	end function alpha_qcd_lhapdf_get
	<<SF lhapdf: procedures>>=
	module function alpha_qcd_lhapdf_get (alpha_qcd, scale) result (alpha)
	class(alpha_qcd_lhapdf_t), intent(in) :: alpha_qcd
	real(default), intent(in) :: scale
	real(default) :: alpha
	if (LHAPDF5_AVAILABLE) then
	alpha = alphasPDF (dble (scale))
	else if (LHAPDF6_AVAILABLE) then
	alpha = alpha_qcd%pdf%alphas_pdf (dble (scale))
	end if
	end function alpha_qcd_lhapdf_get

	@ %def alpha_qcd_lhapdf_get
	@
	Initialization. We need to access the (quasi-global) initialization status.
	<<SF lhapdf: alpha qcd: TBP>>=
	procedure :: init => alpha_qcd_lhapdf_init
	<<SF lhapdf: sub interfaces>>=
	module subroutine alpha_qcd_lhapdf_init (alpha_qcd, file, member, path)
	class(alpha_qcd_lhapdf_t), intent(out) :: alpha_qcd
	type(string_t), intent(inout) :: file
	integer, intent(inout) :: member
	type(string_t), intent(inout) :: path
	end subroutine alpha_qcd_lhapdf_init
	<<SF lhapdf: procedures>>=
	module subroutine alpha_qcd_lhapdf_init (alpha_qcd, file, member, path)
	class(alpha_qcd_lhapdf_t), intent(out) :: alpha_qcd
	type(string_t), intent(inout) :: file
	integer, intent(inout) :: member
	type(string_t), intent(inout) :: path
	alpha_qcd%pdfset_file = file
	alpha_qcd%pdfset_member = member
	if (alpha_qcd%pdfset_member < 0) &
	call msg_fatal ("QCD parameter initialization: PDF set " &
	// char (file) // " is unknown")
	if (LHAPDF5_AVAILABLE) then
	call lhapdf_initialize (1, path, file, member)
	else if (LHAPDF6_AVAILABLE) then
	call lhapdf_initialize &
	(1, path, file, member, alpha_qcd%pdf)
	end if
	end subroutine alpha_qcd_lhapdf_init

	@ %def alpha_qcd_lhapdf_init
	@ Retrieves the quark masses from the PDF.
	<<SF lhapdf: alpha qcd: TBP>>=
	procedure :: get_qmass => alpha_qcd_lhapdf_get_qmass
	<<SF lhapdf: sub interfaces>>=
	module function alpha_qcd_lhapdf_get_qmass (alpha_qcd, i_q) result (mq)
	real(default) :: mq
	class(alpha_qcd_lhapdf_t), intent(in) :: alpha_qcd
	integer, intent(in) :: i_q
	end function alpha_qcd_lhapdf_get_qmass
	<<SF lhapdf: procedures>>=
	module function alpha_qcd_lhapdf_get_qmass (alpha_qcd, i_q) result (mq)
	real(default) :: mq
	class(alpha_qcd_lhapdf_t), intent(in) :: alpha_qcd
	integer, intent(in) :: i_q
	mq = alpha_qcd%pdf%get_qmass (i_q)
	end function alpha_qcd_lhapdf_get_qmass

	@ %def alpha_qcd_lhapdf_get_qmass
	+@ Retrieves the order from the PDF.
	+<<SF lhapdf: alpha qcd: TBP>>=
	+ procedure :: get_order => alpha_qcd_lhapdf_get_order
	+<<SF lhapdf: sub interfaces>>=
	+ module function alpha_qcd_lhapdf_get_order (alpha_qcd) result (order)
	+ integer :: order
	+ class(alpha_qcd_lhapdf_t), intent(in) :: alpha_qcd
	+ end function alpha_qcd_lhapdf_get_order
	+<<SF lhapdf: procedures>>=
	+ module function alpha_qcd_lhapdf_get_order (alpha_qcd) result (order)
	+ integer :: order
	+ class(alpha_qcd_lhapdf_t), intent(in) :: alpha_qcd
	+ order = alpha_qcd%pdf%get_order ()
	+ end function alpha_qcd_lhapdf_get_order
	+
	+@ %def alpha_qcd_lhapdf_get_order
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[sf_lhapdf_ut.f90]]>>=
	<<File header>>

	module sf_lhapdf_ut
	use unit_tests
	use system_dependencies, only: LHAPDF5_AVAILABLE
	use system_dependencies, only: LHAPDF6_AVAILABLE
	use sf_lhapdf_uti

	<<Standard module head>>

	<<SF lhapdf: public test>>

	contains

	<<SF lhapdf: test driver>>

	end module sf_lhapdf_ut
	@ %def sf_lhapdf_ut
	@
	<<[[sf_lhapdf_uti.f90]]>>=
	<<File header>>

	module sf_lhapdf_uti

	<<Use kinds>>
	<<Use strings>>
	use system_dependencies, only: LHAPDF5_AVAILABLE
	use system_dependencies, only: LHAPDF6_AVAILABLE
	use os_interface
	use physics_defs, only: PROTON
	use sm_qcd
	use lorentz
	use pdg_arrays
	use flavors
	use interactions, only: reset_interaction_counter
	use model_data
	use sf_base

	use sf_lhapdf

	<<Standard module head>>

	<<SF lhapdf: test declarations>>

	contains

	<<SF lhapdf: tests>>

	end module sf_lhapdf_uti
	@ %def sf_lhapdf_ut
	@ API: driver for the unit tests below.
	<<SF lhapdf: public test>>=
	public :: sf_lhapdf_test
	<<SF lhapdf: test driver>>=
	subroutine sf_lhapdf_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<SF lhapdf: execute tests>>
	end subroutine sf_lhapdf_test

	@ %def sf_lhapdf_test
	@
	\subsubsection{Test structure function data}
	Construct and display a test structure function data object.
	<<SF lhapdf: execute tests>>=
	if (LHAPDF5_AVAILABLE) then
	call test (sf_lhapdf_1, "sf_lhapdf5_1", &
	"structure function configuration", &
	u, results)
	else if (LHAPDF6_AVAILABLE) then
	call test (sf_lhapdf_1, "sf_lhapdf6_1", &
	"structure function configuration", &
	u, results)
	end if
	<<SF lhapdf: test declarations>>=
	public :: sf_lhapdf_1
	<<SF lhapdf: tests>>=
	subroutine sf_lhapdf_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(pdg_array_t) :: pdg_in
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1
	class(sf_data_t), allocatable :: data

	write (u, "(A)") "* Test output: sf_lhapdf_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test structure function data"
	write (u, "(A)")

	write (u, "(A)") "* Create empty data object"
	write (u, "(A)")

	call model%init_sm_test ()
	pdg_in = PROTON

	allocate (lhapdf_data_t :: data)
	call data%write (u)

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

	select type (data)
	type is (lhapdf_data_t)
	call data%init (model, pdg_in)
	end select

	call data%write (u)

	write (u, "(A)")

	write (u, "(1x,A)") "Outgoing particle codes:"
	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(2x,99(1x,I0))") pdg1

	call model%final ()

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

	end subroutine sf_lhapdf_1

	@ %def sf_lhapdf_1
	@
	\subsubsection{Test and probe structure function}
	Construct and display a structure function object based on the PDF builtin
	structure function.
	<<SF lhapdf: execute tests>>=
	if (LHAPDF5_AVAILABLE) then
	call test (sf_lhapdf_2, "sf_lhapdf5_2", &
	"structure function instance", &
	u, results)
	else if (LHAPDF6_AVAILABLE) then
	call test (sf_lhapdf_2, "sf_lhapdf6_2", &
	"structure function instance", &
	u, results)
	end if
	<<SF lhapdf: test declarations>>=
	public :: sf_lhapdf_2
	<<SF lhapdf: tests>>=
	subroutine sf_lhapdf_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(pdg_array_t) :: pdg_in
	class(sf_data_t), allocatable, target :: data
	class(sf_int_t), allocatable :: sf_int
	type(vector4_t) :: k
	type(vector4_t), dimension(2) :: q
	real(default) :: E
	real(default), dimension(:), allocatable :: r, rb, x, xb
	real(default) :: f

	write (u, "(A)") "* Test output: sf_lhapdf_2"
	write (u, "(A)") "* Purpose: initialize and fill &
	&test structure function object"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call model%init_sm_test ()
	call flv%init (PROTON, model)
	pdg_in = PROTON
	call lhapdf_global_reset ()

	call reset_interaction_counter ()

	allocate (lhapdf_data_t :: data)
	select type (data)
	type is (lhapdf_data_t)
	call data%init (model, pdg_in)
	end select

	write (u, "(A)") "* Initialize structure-function object"
	write (u, "(A)")

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize incoming momentum with E=500"
	write (u, "(A)")
	E = 500
	k = vector4_moving (E, sqrt (E2 - flv%get_mass ()2), 3)
	call vector4_write (k, u)
	call sf_int%seed_kinematics ([k])

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics for x=0.5"
	write (u, "(A)")

	allocate (r (data%get_n_par ()))
	allocate (rb(size (r)))
	allocate (x (size (r)))
	allocate (xb(size (r)))

	r = 0.5_default
	rb = 1 - r
	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%write (u)

	write (u, "(A)")
	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb
	write (u, "(A,9(1x,F10.7))") "f =", f

	write (u, "(A)")
	write (u, "(A)") "* Recover x from momenta"
	write (u, "(A)")

	q = sf_int%get_momenta (outgoing=.true.)
	call sf_int%final ()
	deallocate (sf_int)

	call data%allocate_sf_int (sf_int)
	call sf_int%init (data)
	call sf_int%set_beam_index ([1])

	call sf_int%seed_kinematics ([k])
	call sf_int%set_momenta (q, outgoing=.true.)
	call sf_int%recover_x (x, xb)

	write (u, "(A,9(1x,F10.7))") "x =", x
	write (u, "(A,9(1x,F10.7))") "xb=", xb

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for Q = 100 GeV"
	write (u, "(A)")

	call sf_int%complete_kinematics (x, xb, f, r, rb, map=.false.)
	call sf_int%apply (scale = 100._default)
	call sf_int%write (u, testflag = .true.)


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

	call sf_int%final ()
	call model%final ()

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

	end subroutine sf_lhapdf_2

	@ %def sf_lhapdf_2
	@
	\subsubsection{Strong Coupling}
	Test $\alpha_s$ as an implementation of the [[alpha_qcd_t]] abstract
	type.
	<<SF lhapdf: execute tests>>=
	if (LHAPDF5_AVAILABLE) then
	call test (sf_lhapdf_3, "sf_lhapdf5_3", &
	"running alpha_s", &
	u, results)
	else if (LHAPDF6_AVAILABLE) then
	call test (sf_lhapdf_3, "sf_lhapdf6_3", &
	"running alpha_s", &
	u, results)
	end if
	<<SF lhapdf: test declarations>>=
	public :: sf_lhapdf_3
	<<SF lhapdf: tests>>=
	subroutine sf_lhapdf_3 (u)
	integer, intent(in) :: u
	type(qcd_t) :: qcd
	type(string_t) :: name, path
	integer :: member

	write (u, "(A)") "* Test output: sf_lhapdf_3"
	write (u, "(A)") "* Purpose: initialize and evaluate alpha_s"
	write (u, "(A)")

	write (u, "(A)") "* Initialize configuration data"
	write (u, "(A)")

	call lhapdf_global_reset ()

	if (LHAPDF5_AVAILABLE) then
	name = "cteq6ll.LHpdf"
	member = 1
	path = ""
	else if (LHAPDF6_AVAILABLE) then
	name = "CT10"
	member = 1
	path = ""
	end if

	write (u, "(A)") "* Initialize qcd object"
	write (u, "(A)")

	allocate (alpha_qcd_lhapdf_t :: qcd%alpha)
	select type (alpha => qcd%alpha)
	type is (alpha_qcd_lhapdf_t)
	call alpha%init (name, member, path)
	end select
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for Q = 100"
	write (u, "(A)")

	write (u, "(1x,A,F8.5)") "alpha = ", qcd%alpha%get (100._default)

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

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

	end subroutine sf_lhapdf_3

	@ %def sf_lhapdf_3
	@
	\section{Easy PDF Access}
	For the shower, subtraction and matching, it is very useful to have
	direct access to $f(x,Q)$ independently of the used library.
	<<[[pdf.f90]]>>=
	<<File header>>

	module pdf

	<<Use kinds with double>>
	use beam_structures
	use lhapdf !NODEP!
	use pdf_builtin !NODEP!

	<<Standard module head>>

	<<PDF: public>>

	<<PDF: parameters>>

	<<PDF: types>>

	interface
	<<PDF: sub interfaces>>
	end interface

	end module pdf
	@ %def pdf
	@
	<<[[pdf_sub.f90]]>>=
	<<File header>>

	submodule (pdf) pdf_s

	use io_units
	use system_dependencies, only: LHAPDF5_AVAILABLE, LHAPDF6_AVAILABLE
	use diagnostics

	implicit none

	contains

	<<PDF: procedures>>

	end submodule pdf_s

	@ %def pdf_s
	@
	We support the following implementations:
	<<PDF: parameters>>=
	integer, parameter, public :: STRF_NONE = 0
	integer, parameter, public :: STRF_LHAPDF6 = 1
	integer, parameter, public :: STRF_LHAPDF5 = 2
	integer, parameter, public :: STRF_PDF_BUILTIN = 3

	@ %def STRF_NONE STRF_LHAPDF6 STRF_LHAPDF5 STRF_PDF_BUILTIN
	@ A container to bundle all necessary PDF data. Could be moved to a more
	central location.
	<<PDF: public>>=
	public :: pdf_data_t
	<<PDF: types>>=
	type :: pdf_data_t
	type(lhapdf_pdf_t) :: pdf
	real(default) :: xmin, xmax, qmin, qmax
	integer :: type = STRF_NONE
	integer :: set = 0
	contains
	<<PDF: pdf data: TBP>>
	end type pdf_data_t

	@ %def pdf_data
	@
	<<PDF: pdf data: TBP>>=
	procedure :: init => pdf_data_init
	<<PDF: sub interfaces>>=
	module subroutine pdf_data_init (pdf_data, pdf_data_in)
	class(pdf_data_t), intent(out) :: pdf_data
	type(pdf_data_t), target, intent(in) :: pdf_data_in
	end subroutine pdf_data_init
	<<PDF: procedures>>=
	module subroutine pdf_data_init (pdf_data, pdf_data_in)
	class(pdf_data_t), intent(out) :: pdf_data
	type(pdf_data_t), target, intent(in) :: pdf_data_in
	pdf_data%xmin = pdf_data_in%xmin
	pdf_data%xmax = pdf_data_in%xmax
	pdf_data%qmin = pdf_data_in%qmin
	pdf_data%qmax = pdf_data_in%qmax
	pdf_data%set = pdf_data_in%set
	pdf_data%type = pdf_data_in%type
	if (pdf_data%type == STRF_LHAPDF6) then
	if (pdf_data_in%pdf%is_associated ()) then
	call lhapdf_copy_pointer (pdf_data_in%pdf, pdf_data%pdf)
	else
	call msg_bug ('pdf_data_init: pdf_data%pdf was not associated!')
	end if
	end if
	end subroutine pdf_data_init

	@ %def pdf_data_init
	@
	<<PDF: pdf data: TBP>>=
	procedure :: write => pdf_data_write
	<<PDF: sub interfaces>>=
	module subroutine pdf_data_write (pdf_data, unit)
	class(pdf_data_t), intent(in) :: pdf_data
	integer, intent(in), optional :: unit
	end subroutine pdf_data_write
	<<PDF: procedures>>=
	module subroutine pdf_data_write (pdf_data, unit)
	class(pdf_data_t), intent(in) :: pdf_data
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(3x,A,I0)") "PDF set = ", pdf_data%set
	write (u, "(3x,A,I0)") "PDF type = ", pdf_data%type
	end subroutine pdf_data_write

	@ %def pdf_data_write
	@
	<<PDF: pdf data: TBP>>=
	procedure :: setup => pdf_data_setup
	<<PDF: sub interfaces>>=
	module subroutine pdf_data_setup &
	(pdf_data, caller, beam_structure, lhapdf_member, set)
	class(pdf_data_t), intent(inout) :: pdf_data
	character(len=*), intent(in) :: caller
	type(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: lhapdf_member, set
	end subroutine pdf_data_setup
	<<PDF: procedures>>=
	module subroutine pdf_data_setup &
	(pdf_data, caller, beam_structure, lhapdf_member, set)
	class(pdf_data_t), intent(inout) :: pdf_data
	character(len=*), intent(in) :: caller
	type(beam_structure_t), intent(in) :: beam_structure
	integer, intent(in) :: lhapdf_member, set
	real(default) :: xmin, xmax, q2min, q2max
	pdf_data%set = set
	if (beam_structure%contains ("lhapdf")) then
	if (LHAPDF6_AVAILABLE) then
	pdf_data%type = STRF_LHAPDF6
	else if (LHAPDF5_AVAILABLE) then
	pdf_data%type = STRF_LHAPDF5
	end if
	write (msg_buffer, "(A,I0)") caller &
	// ": interfacing LHAPDF set #", pdf_data%set
	call msg_message ()
	else if (beam_structure%contains ("pdf_builtin")) then
	pdf_data%type = STRF_PDF_BUILTIN
	write (msg_buffer, "(A,I0)") caller &
	// ": interfacing PDF builtin set #", pdf_data%set
	call msg_message ()
	end if
	select case (pdf_data%type)
	case (STRF_LHAPDF6)
	pdf_data%xmin = pdf_data%pdf%getxmin ()
	pdf_data%xmax = pdf_data%pdf%getxmax ()
	pdf_data%qmin = sqrt(pdf_data%pdf%getq2min ())
	pdf_data%qmax = sqrt(pdf_data%pdf%getq2max ())
	case (STRF_LHAPDF5)
	call GetXminM (1, lhapdf_member, xmin)
	call GetXmaxM (1, lhapdf_member, xmax)
	call GetQ2minM (1, lhapdf_member, q2min)
	call GetQ2maxM (1, lhapdf_member, q2max)
	pdf_data%xmin = xmin
	pdf_data%xmax = xmax
	pdf_data%qmin = sqrt(q2min)
	pdf_data%qmax = sqrt(q2max)
	end select
	end subroutine pdf_data_setup

	@ %def pdf_data_setup
	@ This could be overloaded with a version that only asks for a specific
	flavor as it is supported by LHAPDF6.
	<<PDF: pdf data: TBP>>=
	procedure :: evolve => pdf_data_evolve
	<<PDF: sub interfaces>>=
	module subroutine pdf_data_evolve (pdf_data, x, q_in, f)
	class(pdf_data_t), intent(inout) :: pdf_data
	real(double), intent(in) :: x, q_in
	real(double), dimension(-6:6), intent(out) :: f
	end subroutine pdf_data_evolve
	<<PDF: procedures>>=
	module subroutine pdf_data_evolve (pdf_data, x, q_in, f)
	class(pdf_data_t), intent(inout) :: pdf_data
	real(double), intent(in) :: x, q_in
	real(double), dimension(-6:6), intent(out) :: f
	real(double) :: q
	select case (pdf_data%type)
	case (STRF_PDF_BUILTIN)
	call pdf_evolve_LHAPDF (pdf_data%set, x, q_in, f)
	case (STRF_LHAPDF6)
	q = min (pdf_data%qmax, q_in)
	q = max (pdf_data%qmin, q)
	call pdf_data%pdf%evolve_pdfm (x, q, f)
	case (STRF_LHAPDF5)
	q = min (pdf_data%qmax, q_in)
	q = max (pdf_data%qmin, q)
	call evolvePDFM (pdf_data%set, x, q, f)
	case default
	call msg_fatal ("PDF function: unknown PDF method.")
	end select
	end subroutine pdf_data_evolve
	@ %def pdf_data_evolve
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Dispatch}
	@
	<<[[dispatch_beams.f90]]>>=
	<<File header>>

	module dispatch_beams

	<<Use kinds>>
	<<Use strings>>
	use constants, only: PI, one
	use numeric_utils, only: vanishes
	use diagnostics
	use os_interface, only: os_data_t
	use variables, only: var_list_t
	use rng_base, only: rng_factory_t
	use pdg_arrays
	use model_data, only: model_data_t
	use flavors, only: flavor_t
	use physics_defs, only: PHOTON
	use physics_defs, only: MZ_REF, ME_REF, ALPHA_QCD_MZ_REF, ALPHA_QED_ME_REF
	use sm_qcd, only: qcd_t, alpha_qcd_fixed_t, alpha_qcd_from_scale_t
	use sm_qcd, only: alpha_qcd_from_lambda_t
	use sm_qed, only: qed_t, alpha_qed_fixed_t, alpha_qed_from_scale_t
	use beam_structures
	use dispatch_rng, only: dispatch_rng_factory
	use dispatch_rng, only: update_rng_seed_in_var_list
	use sf_base
	use sf_mappings
	use sf_isr
	use sf_epa
	use sf_ewa
	use sf_escan
	use sf_gaussian
	use sf_beam_events
	use sf_circe1
	use sf_circe2
	use sf_pdf_builtin
	use sf_lhapdf

	<<Standard module head>>

	<<Dispatch beams: public>>

	<<Dispatch beams: types>>

	<<Dispatch beams: variables>>

	interface
	<<Dispatch beams: sub interfaces>>
	end interface

	contains

	<<Dispatch beams: main procedures>>

	end module dispatch_beams
	@ %def dispatch_beams
	@
	<<[[dispatch_beams_sub.f90]]>>=
	<<File header>>

	submodule (dispatch_beams) dispatch_beams_s

	implicit none

	contains

	<<Dispatch beams: procedures>>

	end submodule dispatch_beams_s

	@ %def dispatch_beams_s
	@ This data type is a container for transferring structure-function
	specific data from the [[dispatch_sf_data]] to the
	[[dispatch_sf_channels]] subroutine.
	<<Dispatch beams: public>>=
	public :: sf_prop_t
	<<Dispatch beams: types>>=
	type :: sf_prop_t
	real(default), dimension(2) :: isr_eps = 1
	end type sf_prop_t

	@ %def sf_prop_t
	@
	Allocate a structure-function configuration object according to the
	[[sf_method]] string.

	The [[sf_prop]] object can be used to transfer structure-function
	specific data up and to the [[dispatch_sf_channels]] subroutine below,
	so they can be used for particular mappings.

	The [[var_list_global]] object is used for the RNG generator seed.
	It is intent(inout) because the RNG generator seed
	may change during initialization.

	The [[pdg_in]] array is the array of incoming flavors, corresponding
	to the upstream structure function or the beam array. This will be
	checked for the structure function in question and replaced by the
	outgoing flavors. The [[pdg_prc]] array is the array of incoming
	flavors (beam index, component index) for the hard process.
	Due to a bug in gfortran 7/8/9 this has to remain in the main module.
	<<Dispatch beams: public>>=
	public :: dispatch_sf_data
	<<Dispatch beams: main procedures>>=
	subroutine dispatch_sf_data (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(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
	type(var_list_t), intent(in) :: var_list
	type(var_list_t), intent(inout) :: var_list_global
	integer :: next_rng_seed
	class(model_data_t), target, intent(in) :: model
	type(os_data_t), intent(in) :: os_data
	real(default), intent(in) :: sqrts
	logical, intent(in) :: polarized
	type(pdg_array_t), dimension(:), allocatable :: pdg_out
	real(default) :: isr_alpha, isr_q_max, isr_mass
	integer :: isr_order
	logical :: isr_recoil, isr_keep_energy
	real(default) :: epa_alpha, epa_x_min, epa_q_min, epa_q_max, epa_mass
	logical :: epa_recoil, epa_keep_energy
	integer :: epa_int_mode
	type(string_t) :: epa_mode
	real(default) :: ewa_x_min, ewa_pt_max, ewa_mass
	logical :: ewa_recoil, ewa_keep_energy
	type(pdg_array_t), dimension(:), allocatable :: pdg_prc1
	integer :: ewa_id
	type(string_t) :: pdf_name
	type(string_t) :: lhapdf_dir, lhapdf_file
	type(string_t), dimension(13) :: lhapdf_photon_sets
	integer :: lhapdf_member, lhapdf_photon_scheme
	logical :: hoppet_b_matching
	class(rng_factory_t), allocatable :: rng_factory
	logical :: circe1_photon1, circe1_photon2, circe1_generate, &
	circe1_with_radiation
	real(default) :: circe1_sqrts, circe1_eps
	integer :: circe1_version, circe1_chattiness, &
	circe1_revision
	character(6) :: circe1_accelerator
	logical :: circe2_polarized
	type(string_t) :: circe2_design, circe2_file
	real(default), dimension(2) :: gaussian_spread
	logical :: beam_events_warn_eof
	type(string_t) :: beam_events_dir, beam_events_file
	logical :: escan_normalize
	integer :: i
	lhapdf_photon_sets = [var_str ("DOG0.LHgrid"), var_str ("DOG1.LHgrid"), &
	var_str ("DGG.LHgrid"), var_str ("LACG.LHgrid"), &
	var_str ("GSG0.LHgrid"), var_str ("GSG1.LHgrid"), &
	var_str ("GSG960.LHgrid"), var_str ("GSG961.LHgrid"), &
	var_str ("GRVG0.LHgrid"), var_str ("GRVG1.LHgrid"), &
	var_str ("ACFGPG.LHgrid"), var_str ("WHITG.LHgrid"), &
	var_str ("SASG.LHgrid")]
	select case (char (sf_method))
	case ("pdf_builtin")
	allocate (pdf_builtin_data_t :: data)
	select type (data)
	type is (pdf_builtin_data_t)
	pdf_name = &
	var_list%get_sval (var_str ("$pdf_builtin_set"))
	hoppet_b_matching = &
	var_list%get_lval (var_str ("?hoppet_b_matching"))
	call data%init ( &
	model, pdg_in(i_beam(1)), &
	name = pdf_name, &
	path = os_data%pdf_builtin_datapath, &
	hoppet_b_matching = hoppet_b_matching)
	end select
	case ("pdf_builtin_photon")
	call msg_fatal ("Currently, there are no photon PDFs built into WHIZARD,", &
	[var_str ("for the photon content inside a proton or neutron use"), &
	var_str ("the 'lhapdf_photon' structure function.")])
	case ("lhapdf")
	allocate (lhapdf_data_t :: data)
	if (pdg_in(i_beam(1))%get (1) == PHOTON) then
	call msg_fatal ("The 'lhapdf' structure is intended only for protons and", &
	[var_str ("pions, please use 'lhapdf_photon' for photon beams.")])
	end if
	lhapdf_dir = &
	var_list%get_sval (var_str ("$lhapdf_dir"))
	lhapdf_file = &
	var_list%get_sval (var_str ("$lhapdf_file"))
	lhapdf_member = &
	var_list%get_ival (var_str ("lhapdf_member"))
	lhapdf_photon_scheme = &
	var_list%get_ival (var_str ("lhapdf_photon_scheme"))
	hoppet_b_matching = &
	var_list%get_lval (var_str ("?hoppet_b_matching"))
	select type (data)
	type is (lhapdf_data_t)
	call data%init &
	(model, pdg_in(i_beam(1)), &
	lhapdf_dir, lhapdf_file, lhapdf_member, &
	lhapdf_photon_scheme, hoppet_b_matching)
	end select
	case ("lhapdf_photon")
	allocate (lhapdf_data_t :: data)
	if (pdg_in(i_beam(1))%get_length () /= 1 .or. &
	pdg_in(i_beam(1))%get (1) /= PHOTON) then
	call msg_fatal ("The 'lhapdf_photon' structure function is exclusively for", &
	[var_str ("photon PDFs, i.e. for photons as beam particles")])
	end if
	lhapdf_dir = &
	var_list%get_sval (var_str ("$lhapdf_dir"))
	lhapdf_file = &
	var_list%get_sval (var_str ("$lhapdf_photon_file"))
	lhapdf_member = &
	var_list%get_ival (var_str ("lhapdf_member"))
	lhapdf_photon_scheme = &
	var_list%get_ival (var_str ("lhapdf_photon_scheme"))
	if (.not. any (lhapdf_photon_sets == lhapdf_file)) then
	call msg_fatal ("This PDF set is not supported or not " // &
	"intended for photon beams.")
	end if
	select type (data)
	type is (lhapdf_data_t)
	call data%init &
	(model, pdg_in(i_beam(1)), &
	lhapdf_dir, lhapdf_file, lhapdf_member, &
	lhapdf_photon_scheme)
	end select
	case ("isr")
	allocate (isr_data_t :: data)
	isr_alpha = &
	var_list%get_rval (var_str ("isr_alpha"))
	if (vanishes (isr_alpha)) then
	isr_alpha = (var_list%get_rval (var_str ("ee"))) &
	** 2 / (4 * PI)
	end if
	isr_q_max = &
	var_list%get_rval (var_str ("isr_q_max"))
	if (vanishes (isr_q_max)) then
	isr_q_max = sqrts
	end if
	isr_mass = var_list%get_rval (var_str ("isr_mass"))
	isr_order = var_list%get_ival (var_str ("isr_order"))
	isr_recoil = var_list%get_lval (var_str ("?isr_recoil"))
	isr_keep_energy = var_list%get_lval (var_str ("?isr_keep_energy"))
	select type (data)
	type is (isr_data_t)
	call data%init &
	(model, pdg_in (i_beam(1)), isr_alpha, isr_q_max, &
	isr_mass, isr_order, recoil = isr_recoil, keep_energy = &
	isr_keep_energy)
	call data%check ()
	sf_prop%isr_eps(i_beam(1)) = data%get_eps ()
	end select
	case ("epa")
	allocate (epa_data_t :: data)
	epa_mode = var_list%get_sval (var_str ("$epa_mode"))
	epa_int_mode = 0
	epa_alpha = var_list%get_rval (var_str ("epa_alpha"))
	if (vanishes (epa_alpha)) then
	epa_alpha = (var_list%get_rval (var_str ("ee"))) &
	** 2 / (4 * PI)
	end if
	epa_x_min = var_list%get_rval (var_str ("epa_x_min"))
	epa_q_min = var_list%get_rval (var_str ("epa_q_min"))
	epa_q_max = var_list%get_rval (var_str ("epa_q_max"))
	if (vanishes (epa_q_max)) then
	epa_q_max = sqrts
	end if
	select case (char (epa_mode))
	case ("default", "Budnev_617")
	epa_int_mode = 0
	case ("Budnev_616e")
	epa_int_mode = 1
	case ("log_power")
	epa_int_mode = 2
	epa_q_max = sqrts
	case ("log_simple")
	epa_int_mode = 3
	epa_q_max = sqrts
	case ("log")
	epa_int_mode = 4
	epa_q_max = sqrts
	case default
	call msg_fatal ("EPA: unsupported EPA mode; please choose " // &
	"'default', 'Budnev_616', 'Budnev_616e', 'log_power', " // &
	"'log_simple', or 'log'")
	end select
	epa_mass = var_list%get_rval (var_str ("epa_mass"))
	epa_recoil = var_list%get_lval (var_str ("?epa_recoil"))
	epa_keep_energy = var_list%get_lval (var_str ("?epa_keep_energy"))
	select type (data)
	type is (epa_data_t)
	call data%init &
	(model, epa_int_mode, pdg_in (i_beam(1)), epa_alpha, &
	epa_x_min, epa_q_min, epa_q_max, epa_mass, &
	recoil = epa_recoil, keep_energy = epa_keep_energy)
	call data%check ()
	end select
	case ("ewa")
	allocate (ewa_data_t :: data)
	allocate (pdg_prc1 (size (pdg_prc, 2)))
	pdg_prc1 = pdg_prc(i_beam(1),:)
	if (any (pdg_prc1%get_length () /= 1) &
	.or. any (pdg_prc1 /= pdg_prc1(1))) then
	call msg_fatal &
	("EWA: process incoming particle (W/Z) must be unique")
	end if
	ewa_id = abs (pdg_prc1(1)%get (1))
	ewa_x_min = var_list%get_rval (var_str ("ewa_x_min"))
	ewa_pt_max = var_list%get_rval (var_str ("ewa_pt_max"))
	if (vanishes (ewa_pt_max)) then
	ewa_pt_max = sqrts
	end if
	ewa_mass = var_list%get_rval (var_str ("ewa_mass"))
	ewa_recoil = var_list%get_lval (&
	var_str ("?ewa_recoil"))
	ewa_keep_energy = var_list%get_lval (&
	var_str ("?ewa_keep_energy"))
	select type (data)
	type is (ewa_data_t)
	call data%init &
	(model, pdg_in (i_beam(1)), ewa_x_min, &
	ewa_pt_max, sqrts, ewa_recoil, &
	ewa_keep_energy, ewa_mass)
	call data%set_id (ewa_id)
	call data%check ()
	end select
	case ("circe1")
	allocate (circe1_data_t :: data)
	select type (data)
	type is (circe1_data_t)
	circe1_photon1 = &
	var_list%get_lval (var_str ("?circe1_photon1"))
	circe1_photon2 = &
	var_list%get_lval (var_str ("?circe1_photon2"))
	circe1_sqrts = &
	var_list%get_rval (var_str ("circe1_sqrts"))
	circe1_eps = &
	var_list%get_rval (var_str ("circe1_eps"))
	if (circe1_sqrts <= 0) circe1_sqrts = sqrts
	circe1_generate = &
	var_list%get_lval (var_str ("?circe1_generate"))
	circe1_version = &
	var_list%get_ival (var_str ("circe1_ver"))
	circe1_revision = &
	var_list%get_ival (var_str ("circe1_rev"))
	circe1_accelerator = &
	char (var_list%get_sval (var_str ("$circe1_acc")))
	circe1_chattiness = &
	var_list%get_ival (var_str ("circe1_chat"))
	circe1_with_radiation = &
	var_list%get_lval (var_str ("?circe1_with_radiation"))
	call data%init (model, pdg_in, circe1_sqrts, circe1_eps, &
	[circe1_photon1, circe1_photon2], &
	circe1_version, circe1_revision, circe1_accelerator, &
	circe1_chattiness, circe1_with_radiation)
	if (circe1_generate) then
	call msg_message ("CIRCE1: activating generator mode")
	call dispatch_rng_factory &
	(rng_factory, var_list_global, next_rng_seed)
	call update_rng_seed_in_var_list (var_list_global, next_rng_seed)
	call data%set_generator_mode (rng_factory)
	end if
	end select
	case ("circe2")
	allocate (circe2_data_t :: data)
	select type (data)
	type is (circe2_data_t)
	circe2_polarized = &
	var_list%get_lval (var_str ("?circe2_polarized"))
	circe2_file = &
	var_list%get_sval (var_str ("$circe2_file"))
	circe2_design = &
	var_list%get_sval (var_str ("$circe2_design"))
	call data%init (os_data, model, pdg_in, sqrts, &
	circe2_polarized, polarized, circe2_file, circe2_design)
	call msg_message ("CIRCE2: activating generator mode")
	call dispatch_rng_factory &
	(rng_factory, var_list_global, next_rng_seed)
	call update_rng_seed_in_var_list (var_list_global, next_rng_seed)
	call data%set_generator_mode (rng_factory)
	end select
	case ("gaussian")
	allocate (gaussian_data_t :: data)
	select type (data)
	type is (gaussian_data_t)
	gaussian_spread = &
	[var_list%get_rval (var_str ("gaussian_spread1")), &
	var_list%get_rval (var_str ("gaussian_spread2"))]
	call dispatch_rng_factory &
	(rng_factory, var_list_global, next_rng_seed)
	call update_rng_seed_in_var_list (var_list_global, next_rng_seed)
	call data%init (model, pdg_in, gaussian_spread, rng_factory)
	end select
	case ("beam_events")
	allocate (beam_events_data_t :: data)
	select type (data)
	type is (beam_events_data_t)
	beam_events_dir = os_data%whizard_beamsimpath
	beam_events_file = var_list%get_sval (&
	var_str ("$beam_events_file"))
	beam_events_warn_eof = var_list%get_lval (&
	var_str ("?beam_events_warn_eof"))
	call data%init (model, pdg_in, &
	beam_events_dir, beam_events_file, beam_events_warn_eof)
	end select
	case ("energy_scan")
	escan_normalize = &
	var_list%get_lval (var_str ("?energy_scan_normalize"))
	allocate (escan_data_t :: data)
	select type (data)
	type is (escan_data_t)
	if (escan_normalize) then
	call data%init (model, pdg_in)
	else
	call data%init (model, pdg_in, sqrts)
	end if
	end select
	case default
	if (associated (dispatch_sf_data_extra)) then
	call dispatch_sf_data_extra (data, sf_method, i_beam, &
	sf_prop, var_list, var_list_global, model, os_data, sqrts, pdg_in, &
	pdg_prc, polarized)
	end if
	if (.not. allocated (data)) then
	call msg_fatal ("Structure function '" &
	// char (sf_method) // "' not implemented")
	end if
	end select
	if (allocated (data)) then
	allocate (pdg_out (size (pdg_prc, 1)))
	call data%get_pdg_out (pdg_out)
	do i = 1, size (i_beam)
	pdg_in(i_beam(i)) = pdg_out(i)
	end do
	end if
	end subroutine dispatch_sf_data

	@ %def dispatch_sf_data
	@ This is a hook that allows us to inject further handlers for
	structure-function objects, in particular a test structure function.
	<<Dispatch beams: public>>=
	public :: dispatch_sf_data_extra
	<<Dispatch beams: variables>>=
	procedure (dispatch_sf_data), pointer :: &
	dispatch_sf_data_extra => null ()
	@ %def dispatch_sf_data_extra
	@ This is an auxiliary procedure, used by the beam-structure
	expansion: tell for a given structure function name, whether it
	corresponds to a pair spectrum ($n=2$), a single-particle structure
	function ($n=1$), or nothing ($n=0$). Though [[energy_scan]] can
	in principle also be a pair spectrum, it always has only one
	parameter.
	<<Dispatch beams: public>>=
	public :: strfun_mode
	<<Dispatch beams: sub interfaces>>=
	module function strfun_mode (name) result (n)
	type(string_t), intent(in) :: name
	integer :: n
	end function strfun_mode
	<<Dispatch beams: procedures>>=
	module function strfun_mode (name) result (n)
	type(string_t), intent(in) :: name
	integer :: n
	select case (char (name))
	case ("none")
	n = 0
	case ("sf_test_0", "sf_test_1")
	n = 1
	case ("pdf_builtin","pdf_builtin_photon", &
	"lhapdf","lhapdf_photon")
	n = 1
	case ("isr","epa","ewa")
	n = 1
	case ("circe1", "circe2")
	n = 2
	case ("gaussian")
	n = 2
	case ("beam_events")
	n = 2
	case ("energy_scan")
	n = 2
	case default
	n = -1
	call msg_bug ("Structure function '" // char (name) &
	// "' not supported yet")
	end select
	end function strfun_mode

	@ %def strfun_mode
	@ Dispatch a whole structure-function chain, given beam data and beam
	structure data.

	This could be done generically, but we should look at the specific
	combination of structure functions in order to select appropriate mappings.

	The [[beam_structure]] argument gets copied because
	we want to expand it to canonical form (one valid structure-function
	entry per record) before proceeding further.

	The [[pdg_prc]] argument is the array of incoming flavors. The first
	index is the beam index, the second one the process component index.
	Each element is itself a PDG array, notrivial if there is a flavor sum
	for the incoming state of this component.

	The dispatcher is divided in two parts. The first part configures the
	structure function data themselves. After this, we can configure the
	phase space for the elementary process.
	<<Dispatch beams: public>>=
	public :: dispatch_sf_config
	<<Dispatch beams: sub interfaces>>=
	module subroutine dispatch_sf_config (sf_config, sf_prop, beam_structure, &
	var_list, var_list_global, model, os_data, sqrts, pdg_prc)
	type(sf_config_t), dimension(:), allocatable, intent(out) :: sf_config
	type(sf_prop_t), intent(out) :: sf_prop
	type(beam_structure_t), intent(inout) :: beam_structure
	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
	class(sf_data_t), allocatable :: sf_data
	type(beam_structure_t) :: beam_structure_tmp
	type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
	type(string_t), dimension(:), allocatable :: prt_in
	type(pdg_array_t), dimension(:), allocatable :: pdg_in
	end subroutine dispatch_sf_config
	<<Dispatch beams: procedures>>=
	module subroutine dispatch_sf_config (sf_config, sf_prop, beam_structure, &
	var_list, var_list_global, model, os_data, sqrts, pdg_prc)
	type(sf_config_t), dimension(:), allocatable, intent(out) :: sf_config
	type(sf_prop_t), intent(out) :: sf_prop
	type(beam_structure_t), intent(inout) :: beam_structure
	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
	class(sf_data_t), allocatable :: sf_data
	type(beam_structure_t) :: beam_structure_tmp
	type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
	type(string_t), dimension(:), allocatable :: prt_in
	type(pdg_array_t), dimension(:), allocatable :: pdg_in
	type(flavor_t) :: flv_in
	integer :: n_beam, n_record, i
	beam_structure_tmp = beam_structure
	call beam_structure_tmp%expand (strfun_mode)
	n_record = beam_structure_tmp%get_n_record ()
	allocate (sf_config (n_record))
	n_beam = beam_structure_tmp%get_n_beam ()
	if (n_beam > 0) then
	allocate (prt_in (n_beam), pdg_in (n_beam))
	prt_in = beam_structure_tmp%get_prt ()
	do i = 1, n_beam
	call flv_in%init (prt_in(i), model)
	pdg_in(i) = flv_in%get_pdg ()
	end do
	else
	n_beam = size (pdg_prc, 1)
	allocate (pdg_in (n_beam))
	pdg_in = pdg_prc(:,1)
	end if
	do i = 1, n_record
	call dispatch_sf_data (sf_data, &
	beam_structure_tmp%get_name (i), &
	beam_structure_tmp%get_i_entry (i), &
	sf_prop, var_list, var_list_global, model, os_data, sqrts, &
	pdg_in, pdg_prc, &
	beam_structure_tmp%polarized ())
	call sf_config(i)%init (beam_structure_tmp%get_i_entry (i), sf_data)
	deallocate (sf_data)
	end do
	end subroutine dispatch_sf_config

	@ %def dispatch_sf_config
	@
	\subsection{QCD and QED coupling}
	Allocate the [[alpha]] (running coupling) component of the [[qcd]] block with
	a concrete implementation, depending on the variable settings in the
	[[global]] record.

	If a fixed $\alpha_s$ is requested, we do not allocate the
	[[qcd%alpha]] object. In this case, the matrix element code will just take
	the model parameter as-is, which implies fixed $\alpha_s$. If the
	object is allocated, the $\alpha_s$ value is computed and updated for
	each matrix-element call.

	Also fetch the [[alphas_nf]] variable from the list and store it in
	the QCD record. This is not used in the $\alpha_s$ calculation, but
	the QCD record thus becomes a messenger for this user parameter.
	Gfortran 7/8/9 bug: has to be part of main module.
	<<Dispatch beams: public>>=
	public :: dispatch_qcd
	<<Dispatch beams: main procedures>>=
	subroutine dispatch_qcd (qcd, var_list, os_data)
	type(qcd_t), intent(inout) :: qcd
	type(var_list_t), intent(in) :: var_list
	type(os_data_t), intent(in) :: os_data
	logical :: fixed, from_mz, from_pdf_builtin, from_lhapdf, from_lambda_qcd
	real(default) :: mz, alpha_val, lambda
	integer :: nf, order, lhapdf_member
	type(string_t) :: pdfset, lhapdf_dir, lhapdf_file
	call unpack_variables ()
	if (allocated (qcd%alpha)) deallocate (qcd%alpha)
	if (from_lhapdf .and. from_pdf_builtin) then
	call msg_fatal (" Mixing alphas evolution", &
	[var_str (" from LHAPDF and builtin PDF is not permitted")])
	end if
	select case (count ([from_mz, from_pdf_builtin, from_lhapdf, from_lambda_qcd]))
	case (0)
	if (fixed) then
	allocate (alpha_qcd_fixed_t :: qcd%alpha)
	else
	call msg_fatal ("QCD alpha: no calculation mode set")
	end if
	case (2:)
	call msg_fatal ("QCD alpha: calculation mode is ambiguous")
	case (1)
	if (fixed) then
	call msg_fatal ("QCD alpha: use '?alphas_is_fixed = false' for " // &
	"running alphas")
	else if (from_mz) then
	allocate (alpha_qcd_from_scale_t :: qcd%alpha)
	else if (from_pdf_builtin) then
	allocate (alpha_qcd_pdf_builtin_t :: qcd%alpha)
	else if (from_lhapdf) then
	allocate (alpha_qcd_lhapdf_t :: qcd%alpha)
	else if (from_lambda_qcd) then
	allocate (alpha_qcd_from_lambda_t :: qcd%alpha)
	end if
	call msg_message ("QCD alpha: using a running strong coupling")
	end select
	call init_alpha ()
	qcd%n_f = var_list%get_ival (var_str ("alphas_nf"))
	contains
	<<Dispatch qcd: dispatch qcd: procedures>>
	end subroutine dispatch_qcd

	@ %def dispatch_qcd
	@
	<<Dispatch qcd: dispatch qcd: procedures>>=
	subroutine unpack_variables ()
	fixed = var_list%get_lval (var_str ("?alphas_is_fixed"))
	from_mz = var_list%get_lval (var_str ("?alphas_from_mz"))
	from_pdf_builtin = &
	var_list%get_lval (var_str ("?alphas_from_pdf_builtin"))
	from_lhapdf = &
	var_list%get_lval (var_str ("?alphas_from_lhapdf"))
	from_lambda_qcd = &
	var_list%get_lval (var_str ("?alphas_from_lambda_qcd"))
	pdfset = var_list%get_sval (var_str ("$pdf_builtin_set"))
	lambda = var_list%get_rval (var_str ("lambda_qcd"))
	nf = var_list%get_ival (var_str ("alphas_nf"))
	order = var_list%get_ival (var_str ("alphas_order"))
	lhapdf_dir = var_list%get_sval (var_str ("$lhapdf_dir"))
	lhapdf_file = var_list%get_sval (var_str ("$lhapdf_file"))
	lhapdf_member = var_list%get_ival (var_str ("lhapdf_member"))
	if (var_list%contains (var_str ("mZ"))) then
	mz = var_list%get_rval (var_str ("mZ"))
	else
	mz = MZ_REF
	end if
	if (var_list%contains (var_str ("alphas"))) then
	alpha_val = var_list%get_rval (var_str ("alphas"))
	else
	alpha_val = ALPHA_QCD_MZ_REF
	end if
	end subroutine unpack_variables

	@
	<<Dispatch qcd: dispatch qcd: procedures>>=
	subroutine init_alpha ()
	select type (alpha => qcd%alpha)
	type is (alpha_qcd_fixed_t)
	alpha%val = alpha_val
	type is (alpha_qcd_from_scale_t)
	alpha%mu_ref = mz
	alpha%ref = alpha_val
	alpha%order = order
	alpha%nf = nf
	type is (alpha_qcd_from_lambda_t)
	alpha%lambda = lambda
	alpha%order = order
	alpha%nf = nf
	type is (alpha_qcd_pdf_builtin_t)
	call alpha%init (pdfset, &
	os_data%pdf_builtin_datapath)
	type is (alpha_qcd_lhapdf_t)
	call alpha%init (lhapdf_file, lhapdf_member, lhapdf_dir)
	end select
	end subroutine init_alpha

	@
	@ Same for QED. Gfortran 7/8/9: has to be part of main module.
	<<Dispatch beams: public>>=
	public :: dispatch_qed
	<<Dispatch beams: main procedures>>=
	subroutine dispatch_qed (qed, var_list)
	type(qed_t), intent(inout) :: qed
	type(var_list_t), intent(in) :: var_list
	logical :: fixed, from_me, analytic
	real(default) :: me, alpha_val
	integer :: nf, nlep, order
	call unpack_variables ()
	if (allocated (qed%alpha)) deallocate (qed%alpha)
	select case (count ([from_me]))
	case (0)
	if (fixed) then
	allocate (alpha_qed_fixed_t :: qed%alpha)
	else
	call msg_fatal ("QED alpha: no calculation mode set")
	end if
	case (2:)
	call msg_fatal ("QED alpha: calculation mode is ambiguous")
	case (1)
	if (fixed) then
	call msg_fatal ("QED alpha: use '?alphas_is_fixed = false' for " // &
	"running alpha")
	else if (from_me) then
	allocate (alpha_qed_from_scale_t :: qed%alpha)
	end if
	call msg_message ("QED alpha: using a running electromagnetic coupling")
	end select
	call init_alpha ()
	if (var_list%get_ival (var_str ("alpha_nf")) == -1) then
	qed%n_f = var_list%get_ival (var_str ("alphas_nf"))
	else
	qed%n_f = var_list%get_ival (var_str ("alpha_nf"))
	end if
	qed%n_lep = var_list%get_ival (var_str ("alpha_nlep"))
	contains
	<<Dispatch qed: dispatch qed: procedures>>
	end subroutine dispatch_qed

	@ %def dispatch_qed
	@
	<<Dispatch qed: dispatch qed: procedures>>=
	subroutine unpack_variables ()
	fixed = var_list%get_lval (var_str ("?alpha_is_fixed"))
	from_me = var_list%get_lval (var_str ("?alpha_from_me"))
	if (var_list%get_ival (var_str ("alpha_nf")) == -1) then
	nf = var_list%get_ival (var_str ("alphas_nf"))
	else
	nf = var_list%get_ival (var_str ("alpha_nf"))
	end if
	analytic = var_list%get_lval (var_str ("?alpha_evolve_analytic"))
	nlep = var_list%get_ival (var_str ("alpha_nlep"))
	order = var_list%get_ival (var_str ("alpha_order"))
	if (var_list%contains (var_str ("me"))) then
	me = var_list%get_rval (var_str ("me"))
	else
	me = ME_REF
	end if
	if (var_list%contains (var_str ("alpha_em_i"))) then
	alpha_val = one / var_list%get_rval (var_str ("alpha_em_i"))
	else
	alpha_val = ALPHA_QED_ME_REF
	end if
	end subroutine unpack_variables

	@
	<<Dispatch qed: dispatch qed: procedures>>=
	subroutine init_alpha ()
	select type (alpha => qed%alpha)
	type is (alpha_qed_fixed_t)
	alpha%val = alpha_val
	type is (alpha_qed_from_scale_t)
	alpha%mu_ref = me
	alpha%ref = alpha_val
	alpha%order = order
	alpha%nf = nf
	alpha%nlep = nlep
	alpha%analytic = analytic
	end select
	end subroutine init_alpha

	@
	Index: trunk/src/matching/matching.nw
	===================================================================
	--- trunk/src/matching/matching.nw (revision 8835)
	+++ trunk/src/matching/matching.nw (revision 8836)
	@@ -1,5643 +1,5711 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: Matching and Merging
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Matching}
	\includemodulegraph{matching}

	<<[[matching_base.f90]]>>=
	<<File header>>

	module matching_base

	<<Use strings>>
	use sm_qcd
	use model_data
	use particles
	use variables
	use shower_base
	use instances, only: process_instance_t
	use rng_base

	<<Standard module head>>

	<<Matching base: public>>

	<<Matching base: parameters>>

	<<Matching base: types>>

	<<Matching base: interfaces>>

	interface
	<<Matching base: sub interfaces>>
	end interface

	end module matching_base
	@ %def matching_base
	@
	<<[[matching_base_sub.f90]]>>=
	<<File header>>

	submodule (matching_base) matching_base_s

	<<Use debug>>
	use diagnostics

	implicit none

	contains

	<<Matching base: procedures>>

	end submodule matching_base_s

	@ %def matching_base_s
	@
	\section{Abstract Matching Type}
	A matching will need access to the [[shower]] as well as matrix elements
	that we currently get over [[process_instace]]. The [[model]] is
	intended for the backup [[model_hadrons]].
	<<Matching base: public>>=
	public :: matching_t
	<<Matching base: types>>=
	type, abstract :: matching_t
	logical :: is_hadron_collision = .false.
	type(qcd_t) :: qcd
	class(shower_base_t), pointer :: shower => null ()
	type(process_instance_t), pointer :: process_instance => null ()
	class(model_data_t), pointer :: model => null ()
	class(rng_t), allocatable :: rng
	type(string_t) :: process_name
	contains
	<<Matching base: matching: TBP>>
	end type matching_t

	@ %def matching_t
	@
	<<Matching base: matching: TBP>>=
	procedure (matching_init), deferred :: init
	<<Matching base: interfaces>>=
	abstract interface
	subroutine matching_init (matching, var_list, process_name)
	import
	class(matching_t), intent(out) :: matching
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_name
	end subroutine matching_init
	end interface

	@ %def matching_init
	@ If we use a polymorphic settings type, this boilerplate wouldn't be
	necessary but then we introduce [[select type]] statements all over the place.
	<<default matching init>>=
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_name
	if (debug_on) call msg_debug (D_MATCHING, "matching_init")
	call matching%settings%init (var_list)
	matching%process_name = process_name
	@
	<<Matching base: matching: TBP>>=
	procedure (matching_write), deferred :: write
	<<Matching base: interfaces>>=
	abstract interface
	subroutine matching_write (matching, unit)
	import
	class(matching_t), intent(in) :: matching
	integer, intent(in), optional :: unit
	end subroutine matching_write
	end interface

	@ %def matching_write
	@
	<<Matching base: matching: TBP>>=
	procedure :: import_rng => matching_import_rng
	<<Matching base: sub interfaces>>=
	pure module subroutine matching_import_rng (matching, rng)
	class(matching_t), intent(inout) :: matching
	class(rng_t), allocatable, intent(inout) :: rng
	end subroutine matching_import_rng
	<<Matching base: procedures>>=
	pure module subroutine matching_import_rng (matching, rng)
	class(matching_t), intent(inout) :: matching
	class(rng_t), allocatable, intent(inout) :: rng
	call move_alloc (from = rng, to = matching%rng)
	end subroutine matching_import_rng

	@ %def matching_import_rng
	@
	<<Matching base: matching: TBP>>=
	procedure :: connect => matching_connect
	procedure :: base_connect => matching_connect
	<<Matching base: sub interfaces>>=
	module subroutine matching_connect &
	(matching, process_instance, model, shower)
	class(matching_t), intent(inout) :: matching
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target, optional :: model
	class(shower_base_t), intent(in), target, optional :: shower
	end subroutine matching_connect
	<<Matching base: procedures>>=
	module subroutine matching_connect (matching, process_instance, model, shower)
	class(matching_t), intent(inout) :: matching
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target, optional :: model
	class(shower_base_t), intent(in), target, optional :: shower
	if (debug_on) call msg_debug (D_MATCHING, "matching_connect")
	matching%process_instance => process_instance
	if (present (model)) matching%model => model
	if (present (shower)) matching%shower => shower
	end subroutine matching_connect

	@ %def matching_base_connect
	@
	<<Matching base: matching: TBP>>=
	procedure (matching_before_shower), deferred :: before_shower
	<<Matching base: interfaces>>=
	abstract interface
	subroutine matching_before_shower (matching, particle_set, vetoed)
	import
	class(matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	end subroutine matching_before_shower
	end interface

	@ %def matching_before_shower
	@
	<<Matching base: matching: TBP>>=
	procedure (matching_after_shower), deferred :: after_shower
	<<Matching base: interfaces>>=
	abstract interface
	subroutine matching_after_shower (matching, particle_set, vetoed)
	import
	class(matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	end subroutine matching_after_shower
	end interface

	@ %def matching_after_shower
	@ Per default, do nothing here.
	<<Matching base: matching: TBP>>=
	procedure :: prepare_for_events => matching_prepare_for_events
	<<Matching base: sub interfaces>>=
	module subroutine matching_prepare_for_events (matching)
	class(matching_t), intent(inout), target :: matching
	end subroutine matching_prepare_for_events
	<<Matching base: procedures>>=
	module subroutine matching_prepare_for_events (matching)
	class(matching_t), intent(inout), target :: matching
	end subroutine matching_prepare_for_events

	@ %def matching_prepare_for_events
	@
	<<Matching base: matching: TBP>>=
	procedure :: first_event => matching_first_event
	<<Matching base: sub interfaces>>=
	module subroutine matching_first_event (matching)
	class(matching_t), intent(inout), target :: matching
	end subroutine matching_first_event
	<<Matching base: procedures>>=
	module subroutine matching_first_event (matching)
	class(matching_t), intent(inout), target :: matching
	end subroutine matching_first_event

	@ %def matching_first_event
	@
	<<Matching base: matching: TBP>>=
	procedure (matching_get_method), deferred :: get_method
	<<Matching base: interfaces>>=
	abstract interface
	function matching_get_method (matching) result (method)
	import
	type(string_t) :: method
	class(matching_t), intent(in) :: matching
	end function matching_get_method
	end interface

	@ %def matching_after_shower
	@
	<<Matching base: matching: TBP>>=
	procedure :: final => matching_final
	<<Matching base: sub interfaces>>=
	module subroutine matching_final (matching)
	class(matching_t), intent(in) :: matching
	end subroutine matching_final
	<<Matching base: procedures>>=
	module subroutine matching_final (matching)
	class(matching_t), intent(in) :: matching
	end subroutine matching_final

	@ %def matching_final
	@
	\subsection{Matching implementations}
	<<Matching base: public>>=
	public :: MATCH_MLM, MATCH_CKKW, MATCH_POWHEG
	<<Matching base: parameters>>=
	integer, parameter :: MATCH_MLM = 1
	integer, parameter :: MATCH_CKKW = 2
	integer, parameter :: MATCH_POWHEG = 3
	integer, parameter :: MATCH_UNDEFINED = 17
	@ %def MATCH_MLM MATCH_CKKW MATCH_POWHEG MATCH_UNDEFINED
	@ A dictionary
	<<Matching base: public>>=
	public :: matching_method
	<<Matching base: interfaces>>=
	interface matching_method
	module procedure matching_method_of_string
	module procedure matching_method_to_string
	end interface
	<<Matching base: sub interfaces>>=
	elemental module function matching_method_of_string (string) result (i)
	integer :: i
	type(string_t), intent(in) :: string
	end function matching_method_of_string
	elemental module function matching_method_to_string (i) result (string)
	type(string_t) :: string
	integer, intent(in) :: i
	end function matching_method_to_string
	<<Matching base: procedures>>=
	elemental module function matching_method_of_string (string) result (i)
	integer :: i
	type(string_t), intent(in) :: string
	select case (char (string))
	case ("MLM")
	i = MATCH_MLM
	case ("CKKW")
	i = MATCH_CKKW
	case ("POWHEG")
	i = MATCH_POWHEG
	case default
	i = MATCH_UNDEFINED
	end select
	end function matching_method_of_string

	elemental module function matching_method_to_string (i) result (string)
	type(string_t) :: string
	integer, intent(in) :: i
	select case (i)
	case (MATCH_MLM)
	string = "MLM"
	case (MATCH_CKKW)
	string = "CKKW"
	case (MATCH_POWHEG)
	string = "POWHEG"
	case default
	string = "UNDEFINED"
	end select
	end function matching_method_to_string

	@ %def matching_method
	@
	\section{MLM Matching}
	<<[[mlm_matching.f90]]>>=
	<<File header>>

	module mlm_matching

	<<Use kinds with double>>
	<<Use strings>>
	use constants
	use lorentz
	use particles
	use variables
	use matching_base

	<<Standard module head>>

	<<MLM matching: public>>

	<<MLM matching: types>>

	interface
	<<MLM matching: sub interfaces>>
	end interface

	end module mlm_matching
	@ %def mlm_matching
	@
	<<[[mlm_matching_sub.f90]]>>=
	<<File header>>

	submodule (mlm_matching) mlm_matching_s

	<<Use debug>>
	use io_units
	use format_utils, only: write_separator
	use diagnostics
	use file_utils
	use subevents, only: PRT_OUTGOING
	use shower_base
	use ktclus

	implicit none

	contains

	<<MLM matching: procedures>>

	end submodule mlm_matching_s

	@ %def mlm_matching_s
	@
	<<MLM matching: public>>=
	public :: mlm_matching_settings_t
	<<MLM matching: types>>=
	type :: mlm_matching_settings_t
	real(default) :: mlm_Qcut_ME = one
	real(default) :: mlm_Qcut_PS = one
	real(default) :: mlm_ptmin, mlm_etamax, mlm_Rmin, mlm_Emin
	real(default) :: mlm_ETclusfactor = 0.2_default
	real(default) :: mlm_ETclusminE = five
	real(default) :: mlm_etaclusfactor = one
	real(default) :: mlm_Rclusfactor = one
	real(default) :: mlm_Eclusfactor = one
	integer :: kt_imode_hadronic = 4313
	integer :: kt_imode_leptonic = 1111
	integer :: mlm_nmaxMEjets = 0
	contains
	<<MLM matching: mlm matching settings: TBP>>
	end type mlm_matching_settings_t

	@ %def mlm_matching_settings_t
	@
	<<MLM matching: mlm matching settings: TBP>>=
	procedure :: init => mlm_matching_settings_init
	<<MLM matching: sub interfaces>>=
	module subroutine mlm_matching_settings_init (settings, var_list)
	class(mlm_matching_settings_t), intent(out) :: settings
	type(var_list_t), intent(in) :: var_list
	end subroutine mlm_matching_settings_init
	<<MLM matching: procedures>>=
	module subroutine mlm_matching_settings_init (settings, var_list)
	class(mlm_matching_settings_t), intent(out) :: settings
	type(var_list_t), intent(in) :: var_list
	settings%mlm_Qcut_ME = &
	var_list%get_rval (var_str ("mlm_Qcut_ME"))
	settings%mlm_Qcut_PS = &
	var_list%get_rval (var_str ("mlm_Qcut_PS"))
	settings%mlm_ptmin = &
	var_list%get_rval (var_str ("mlm_ptmin"))
	settings%mlm_etamax = &
	var_list%get_rval (var_str ("mlm_etamax"))
	settings%mlm_Rmin = &
	var_list%get_rval (var_str ("mlm_Rmin"))
	settings%mlm_Emin = &
	var_list%get_rval (var_str ("mlm_Emin"))
	settings%mlm_nmaxMEjets = &
	var_list%get_ival (var_str ("mlm_nmaxMEjets"))

	settings%mlm_ETclusfactor = &
	var_list%get_rval (var_str ("mlm_ETclusfactor"))
	settings%mlm_ETclusminE = &
	var_list%get_rval (var_str ("mlm_ETclusminE"))
	settings%mlm_etaclusfactor = &
	var_list%get_rval (var_str ("mlm_etaclusfactor"))
	settings%mlm_Rclusfactor = &
	var_list%get_rval (var_str ("mlm_Rclusfactor"))
	settings%mlm_Eclusfactor = &
	var_list%get_rval (var_str ("mlm_Eclusfactor"))
	end subroutine mlm_matching_settings_init

	@ %def mlm_matching_settings_init
	@
	<<MLM matching: mlm matching settings: TBP>>=
	procedure :: write => mlm_matching_settings_write
	<<MLM matching: sub interfaces>>=
	module subroutine mlm_matching_settings_write (settings, unit)
	class(mlm_matching_settings_t), intent(in) :: settings
	integer, intent(in), optional :: unit
	end subroutine mlm_matching_settings_write
	<<MLM matching: procedures>>=
	module subroutine mlm_matching_settings_write (settings, unit)
	class(mlm_matching_settings_t), intent(in) :: settings
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(3x,A,ES19.12)") &
	"mlm_Qcut_ME = ", settings%mlm_Qcut_ME
	write (u, "(3x,A,ES19.12)") &
	"mlm_Qcut_PS = ", settings%mlm_Qcut_PS
	write (u, "(3x,A,ES19.12)") &
	"mlm_ptmin = ", settings%mlm_ptmin
	write (u, "(3x,A,ES19.12)") &
	"mlm_etamax = ", settings%mlm_etamax
	write (u, "(3x,A,ES19.12)") &
	"mlm_Rmin = ", settings%mlm_Rmin
	write (u, "(3x,A,ES19.12)") &
	"mlm_Emin = ", settings%mlm_Emin
	write (u, "(3x,A,1x,I0)") &
	"mlm_nmaxMEjets = ", settings%mlm_nmaxMEjets
	write (u, "(3x,A,ES19.12)") &
	"mlm_ETclusfactor (D=0.2) = ", settings%mlm_ETclusfactor
	write (u, "(3x,A,ES19.12)") &
	"mlm_ETclusminE (D=5.0) = ", settings%mlm_ETclusminE
	write (u, "(3x,A,ES19.12)") &
	"mlm_etaclusfactor (D=1.0) = ", settings%mlm_etaClusfactor
	write (u, "(3x,A,ES19.12)") &
	"mlm_Rclusfactor (D=1.0) = ", settings%mlm_RClusfactor
	write (u, "(3x,A,ES19.12)") &
	"mlm_Eclusfactor (D=1.0) = ", settings%mlm_EClusfactor
	end subroutine mlm_matching_settings_write

	@ %def mlm_matching_settings_write
	@ This is a container for the (colored) parton momenta as well as the
	jet momenta.
	<<MLM matching: public>>=
	public :: mlm_matching_t
	<<MLM matching: types>>=
	type, extends (matching_t) :: mlm_matching_t
	type(vector4_t), dimension(:), allocatable, public :: P_ME
	type(vector4_t), dimension(:), allocatable, public :: P_PS
	type(vector4_t), dimension(:), allocatable, private :: JETS_ME
	type(vector4_t), dimension(:), allocatable, private :: JETS_PS
	type(mlm_matching_settings_t) :: settings
	contains
	<<MLM matching: mlm matching: TBP>>
	end type mlm_matching_t

	@ %def mlm_matching_t
	@
	<<MLM matching: mlm matching: TBP>>=
	procedure :: init => mlm_matching_init
	<<MLM matching: sub interfaces>>=
	module subroutine mlm_matching_init (matching, var_list, process_name)
	class(mlm_matching_t), intent(out) :: matching
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_name
	end subroutine mlm_matching_init
	<<MLM matching: procedures>>=
	module subroutine mlm_matching_init (matching, var_list, process_name)
	class(mlm_matching_t), intent(out) :: matching
	<<default matching init>>
	end subroutine mlm_matching_init

	@ %def mlm_matching_init
	@
	<<MLM matching: mlm matching: TBP>>=
	procedure :: write => mlm_matching_write
	<<MLM matching: sub interfaces>>=
	module subroutine mlm_matching_write (matching, unit)
	class(mlm_matching_t), intent(in) :: matching
	integer, intent(in), optional :: unit
	end subroutine mlm_matching_write
	<<MLM matching: procedures>>=
	module subroutine mlm_matching_write (matching, unit)
	class(mlm_matching_t), intent(in) :: matching
	integer, intent(in), optional :: unit
	integer :: i, u
	u = given_output_unit (unit); if (u < 0) return

	write (u, "(1x,A)") "MLM matching:"
	call matching%settings%write (u)
	write (u, "(3x,A)") "Momenta of ME partons:"
	if (allocated (matching%P_ME)) then
	do i = 1, size (matching%P_ME)
	write (u, "(4x)", advance = "no")
	call vector4_write (matching%P_ME(i), unit = u)
	end do
	else
	write (u, "(5x,A)") "[empty]"
	end if
	call write_separator (u)
	write (u, "(3x,A)") "Momenta of ME jets:"
	if (allocated (matching%JETS_ME)) then
	do i = 1, size (matching%JETS_ME)
	write (u, "(4x)", advance = "no")
	call vector4_write (matching%JETS_ME(i), unit = u)
	end do
	else
	write (u, "(5x,A)") "[empty]"
	end if
	call write_separator (u)
	write(u, "(3x,A)") "Momenta of shower partons:"
	if (allocated (matching%P_PS)) then
	do i = 1, size (matching%P_PS)
	write (u, "(4x)", advance = "no")
	call vector4_write (matching%P_PS(i), unit = u)
	end do
	else
	write (u, "(5x,A)") "[empty]"
	end if
	call write_separator (u)
	write (u, "(3x,A)") "Momenta of shower jets:"
	if (allocated (matching%JETS_PS)) then
	do i = 1, size (matching%JETS_PS)
	write (u, "(4x)", advance = "no")
	call vector4_write (matching%JETS_PS(i), unit = u)
	end do
	else
	write (u, "(5x,A)") "[empty]"
	end if
	call write_separator (u)
	end subroutine mlm_matching_write

	@ %def mlm_matching_write
	@
	<<MLM matching: mlm matching: TBP>>=
	procedure :: get_method => mlm_matching_get_method
	<<MLM matching: sub interfaces>>=
	module function mlm_matching_get_method (matching) result (method)
	type(string_t) :: method
	class(mlm_matching_t), intent(in) :: matching
	end function mlm_matching_get_method
	<<MLM matching: procedures>>=
	module function mlm_matching_get_method (matching) result (method)
	type(string_t) :: method
	class(mlm_matching_t), intent(in) :: matching
	method = matching_method (MATCH_MLM)
	end function mlm_matching_get_method

	@ %def mlm_matching_get_method
	@
	<<MLM matching: mlm matching: TBP>>=
	procedure :: before_shower => mlm_matching_before_shower
	<<MLM matching: sub interfaces>>=
	module subroutine mlm_matching_before_shower &
	(matching, particle_set, vetoed)
	class(mlm_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	end subroutine mlm_matching_before_shower
	<<MLM matching: procedures>>=
	module subroutine mlm_matching_before_shower &
	(matching, particle_set, vetoed)
	class(mlm_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	vetoed = .false.
	end subroutine mlm_matching_before_shower

	@ %def mlm_matching_before_shower
	@
	<<MLM matching: mlm matching: TBP>>=
	procedure :: after_shower => mlm_matching_after_shower
	<<MLM matching: sub interfaces>>=
	module subroutine mlm_matching_after_shower (matching, particle_set, vetoed)
	class(mlm_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	end subroutine mlm_matching_after_shower
	<<MLM matching: procedures>>=
	module subroutine mlm_matching_after_shower (matching, particle_set, vetoed)
	class(mlm_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	if (debug_on) call msg_debug (D_MATCHING, "mlm_matching_after_shower")
	call matching%shower%get_final_colored_ME_momenta (matching%P_ME)
	call matching%fill_P_PS (particle_set)
	!!! MLM stage 3 -> reconstruct and possibly reject
	call matching%apply (vetoed)
	if (debug_active (D_MATCHING)) call matching%write ()
	if (allocated (matching%P_ME)) deallocate (matching%P_ME)
	if (allocated (matching%P_PS)) deallocate (matching%P_PS)
	if (allocated (matching%JETS_ME)) deallocate (matching%JETS_ME)
	if (allocated (matching%JETS_PS)) deallocate (matching%JETS_PS)
	end subroutine mlm_matching_after_shower

	@ %def mlm_matching_after_shower
	@ Transfer partons after parton shower to [[matching%P_PS]]
	<<MLM matching: mlm matching: TBP>>=
	procedure :: fill_P_PS => mlm_matching_fill_P_PS
	<<MLM matching: sub interfaces>>=
	module subroutine mlm_matching_fill_P_PS (matching, particle_set)
	class(mlm_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(in) :: particle_set
	end subroutine mlm_matching_fill_P_PS
	<<MLM matching: procedures>>=
	module subroutine mlm_matching_fill_P_PS (matching, particle_set)
	class(mlm_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(in) :: particle_set
	integer :: i, j, n_jets_PS
	integer, dimension(2) :: col
	type(particle_t) :: tempprt
	real(double) :: eta
	type(vector4_t) :: p_tmp

	!!! loop over particles and extract final colored ones with eta<etamax
	n_jets_PS = 0
	do i = 1, particle_set%get_n_tot ()
	if (signal_is_pending ()) return
	tempprt = particle_set%get_particle (i)
	if (tempprt%get_status () /= PRT_OUTGOING) cycle
	col = tempprt%get_color ()
	if (all (col == 0)) cycle
	! TODO: (bcn 2015-04-28) where is the corresponding part for lepton colliders?
	if (matching%is_hadron_collision) then
	p_tmp = tempprt%get_momentum ()
	if (energy (p_tmp) - longitudinal_part (p_tmp) < 1.E-10_default .or. &
	energy (p_tmp) + longitudinal_part (p_tmp) < 1.E-10_default) then
	eta = pseudorapidity (p_tmp)
	else
	eta = rapidity (p_tmp)
	end if
	if (eta > matching%settings%mlm_etaClusfactor * &
	matching%settings%mlm_etamax) then
	if (debug_active (D_MATCHING)) then
	call msg_debug (D_MATCHING, "Rejecting this particle")
	call tempprt%write ()
	end if
	cycle
	end if
	end if
	n_jets_PS = n_jets_PS + 1
	end do

	allocate (matching%P_PS(1:n_jets_PS))
	if (debug_on) call msg_debug (D_MATCHING, "n_jets_ps", n_jets_ps)

	j = 1
	do i = 1, particle_set%get_n_tot ()
	tempprt = particle_set%get_particle (i)
	if (tempprt%get_status () /= PRT_OUTGOING) cycle
	col = tempprt%get_color ()
	if (all(col == 0)) cycle
	! TODO: (bcn 2015-04-28) where is the corresponding part for lepton colliders?
	if (matching%is_hadron_collision) then
	p_tmp = tempprt%get_momentum ()
	if (energy (p_tmp) - longitudinal_part (p_tmp) < 1.E-10_default .or. &
	energy (p_tmp) + longitudinal_part (p_tmp) < 1.E-10_default) then
	eta = pseudorapidity (p_tmp)
	else
	eta = rapidity (p_tmp)
	end if
	if (eta > matching%settings%mlm_etaClusfactor * &
	matching%settings%mlm_etamax) cycle
	end if
	matching%P_PS(j) = tempprt%get_momentum ()
	j = j + 1
	end do
	end subroutine mlm_matching_fill_P_PS

	@ %def mlm_matching_fill_P_PS
	@
	<<MLM matching: mlm matching: TBP>>=
	procedure :: apply => mlm_matching_apply
	<<MLM matching: sub interfaces>>=
	module subroutine mlm_matching_apply (matching, vetoed)
	class(mlm_matching_t), intent(inout) :: matching
	logical, intent(out) :: vetoed
	end subroutine mlm_matching_apply
	<<MLM matching: procedures>>=
	module subroutine mlm_matching_apply (matching, vetoed)
	class(mlm_matching_t), intent(inout) :: matching
	logical, intent(out) :: vetoed
	integer :: i, j
	integer :: n_jets_ME, n_jets_PS, n_jets_PS_atycut
	real(double) :: ycut
	real(double), dimension(:, :), allocatable :: PP
	real(double), dimension(:), allocatable :: Y
	real(double), dimension(:,:), allocatable :: P_JETS
	real(double), dimension(:,:), allocatable :: P_ME
	integer, dimension(:), allocatable :: JET
	integer :: NJET, NSUB
	integer :: imode
	!!! TODO: (bcn 2014-03-26) Why is ECUT hard coded to 1?
	!!! It is the denominator of the KT measure. Candidate for removal
	real(double) :: ECUT = 1._double
	integer :: ip1,ip2

	! KTCLUS COMMON BLOCK
	INTEGER NMAX,NUM,HIST
	PARAMETER (NMAX=512)
	DOUBLE PRECISION P,KT,KTP,KTS,ETOT,RSQ,KTLAST
	COMMON /KTCOMM/ETOT,RSQ,P(9,NMAX),KTP(NMAX,NMAX),KTS(NMAX), &
	KT(NMAX),KTLAST(NMAX),HIST(NMAX),NUM

	vetoed = .true.
	if (signal_is_pending ()) return

	<<Set [[n_jets_ME/PS]] from [[matching]] (or equal zero)>>

	<<Jet clustering for partons after matrix element>>

	<<Jet clustering for partons after shower>>

	<<Veto: too many or not enough jets after PS>>

	<<Cluster ME jets with PS jets one at a time>>

	vetoed = .false.
	999 continue
	end subroutine mlm_matching_apply

	@ %def mlm_matching_apply
	@
	<<Set [[n_jets_ME/PS]] from [[matching]] (or equal zero)>>=
	if (allocated (matching%P_ME)) then
	! print *, "number of partons after ME: ", size(matching%P_ME)
	n_jets_ME = size (matching%P_ME)
	else
	n_jets_ME = 0
	end if
	if (allocated (matching%p_PS)) then
	! print *, "number of partons after PS: ", size(matching%p_PS)
	n_jets_PS = size (matching%p_PS)
	else
	n_jets_PS = 0
	end if
	@
	<<Jet clustering for partons after matrix element>>=
	if (n_jets_ME > 0) then
	ycut = (matching%settings%mlm_ptmin)**2
	allocate (PP(1:4, 1:N_jets_ME))
	do i = 1, n_jets_ME
	PP(1:3,i) = matching%p_ME(i)%p(1:3)
	PP(4,i) = matching%p_ME(i)%p(0)
	end do

	<<Set [[imode]] for lepton or hadron collisions>>

	allocate (P_ME(1:4,1:n_jets_ME))
	allocate (JET(1:n_jets_ME))
	allocate (Y(1:n_jets_ME))

	if (signal_is_pending ()) return
	call KTCLUR (imode, PP, n_jets_ME, &
	dble (matching%settings%mlm_Rclusfactor * matching%settings%mlm_Rmin), ECUT, y, *999)
	call KTRECO (1, PP, n_jets_ME, ECUT, ycut, ycut, P_ME, JET, &
	NJET, NSUB, *999)

	n_jets_ME = NJET
	if (NJET > 0) then
	allocate (matching%JETS_ME (1:NJET))
	do i = 1, NJET
	matching%JETS_ME(i) = vector4_moving (REAL(P_ME(4,i), default), &
	vector3_moving([REAL(P_ME(1,i), default), &
	REAL(P_ME(2,i), default), REAL(P_ME(3,i), default)]))
	end do
	end if
	deallocate (P_ME)
	deallocate (JET)
	deallocate (Y)
	deallocate (PP)
	end if
	@
	<<Jet clustering for partons after shower>>=
	if (n_jets_PS > 0) then
	ycut = (matching%settings%mlm_ptmin + max (matching%settings%mlm_ETclusminE, &
	matching%settings%mlm_ETclusfactor * matching%settings%mlm_ptmin))**2
	allocate (PP(1:4, 1:n_jets_PS))
	do i = 1, n_jets_PS
	PP(1:3,i) = matching%p_PS(i)%p(1:3)
	PP(4,i) = matching%p_PS(i)%p(0)
	end do

	<<Set [[imode]] for lepton or hadron collisions>>

	allocate (P_JETS(1:4,1:n_jets_PS))
	allocate (JET(1:n_jets_PS))
	allocate (Y(1:n_jets_PS))

	if (signal_is_pending ()) return
	call KTCLUR (imode, PP, n_jets_PS, &
	dble (matching%settings%mlm_Rclusfactor * matching%settings%mlm_Rmin), &
	ECUT, y, *999)
	call KTRECO (1, PP, n_jets_PS, ECUT, ycut, ycut, P_JETS, JET, &
	NJET, NSUB, *999)
	n_jets_PS_atycut = NJET
	if (n_jets_ME == matching%settings%mlm_nmaxMEjets .and. NJET > 0) then
	! print *, " resetting ycut to ", Y(matching%settings%mlm_nmaxMEjets)
	ycut = y(matching%settings%mlm_nmaxMEjets)
	call KTRECO (1, PP, n_jets_PS, ECUT, ycut, ycut, P_JETS, JET, &
	NJET, NSUB, *999)
	end if

	! !Sample of code for a FastJet interface
	! palg = 1d0 ! 1.0d0 = kt, 0.0d0 = Cam/Aachen, -1.0d0 = anti-kt
	! R = 0.7_double ! radius parameter
	! f = 0.75_double ! overlap threshold
	! !call fastjetppgenkt(PP,n,R,palg,P_JETS,NJET) ! KT-Algorithm
	! !call fastjetsiscone(PP,n,R,f,P_JETS,NJET) ! SiSCone-Algorithm

	if (NJET > 0) then
	allocate (matching%JETS_PS(1:NJET))
	do i = 1, NJET
	matching%JETS_PS(i) = vector4_moving (REAL(P_JETS(4,i), default), &
	vector3_moving([REAL(P_JETS(1,i), default), &
	REAL(P_JETS(2,i), default), REAL(P_JETS(3,i), default)]))
	end do
	end if

	deallocate (P_JETS)
	deallocate (JET)
	deallocate (Y)
	else
	n_jets_PS_atycut = 0
	end if
	@
	<<Set [[imode]] for lepton or hadron collisions>>=
	if (matching%is_hadron_collision) then
	imode = matching%settings%kt_imode_hadronic
	else
	imode = matching%settings%kt_imode_leptonic
	end if
	@
	<<Veto: too many or not enough jets after PS>>=
	if (n_jets_PS_atycut < n_jets_ME) then
	! print *, "DISCARDING: Not enough PS jets: ", n_jets_PS_atycut
	return
	end if
	if (n_jets_PS_atycut > n_jets_ME .and. n_jets_ME /= matching%settings%mlm_nmaxMEjets) then
	! print *, "DISCARDING: Too many PS jets: ", n_jets_PS_atycut
	return
	end if
	@
	<<Cluster ME jets with PS jets one at a time>>=
	if (allocated(matching%JETS_PS)) then
	! print *, "number of jets after PS: ", size(matching%JETS_PS)
	n_jets_PS = size (matching%JETS_PS)
	else
	n_jets_PS = 0
	end if
	if (n_jets_ME > 0 .and. n_jets_PS > 0) then
	n_jets_PS = size (matching%JETS_PS)
	if (allocated (PP)) deallocate(PP)
	allocate (PP(1:4, 1:n_jets_PS + 1))
	do i = 1, n_jets_PS
	if (signal_is_pending ()) return
	PP(1:3,i) = matching%JETS_PS(i)%p(1:3)
	PP(4,i) = matching%JETS_PS(i)%p(0)
	end do
	if (allocated (Y)) deallocate(Y)
	allocate (Y(1:n_jets_PS + 1))
	y = zero
	do i = 1, n_jets_ME
	PP(1:3,n_jets_PS + 2 - i) = matching%JETS_ME(i)%p(1:3)
	PP(4,n_jets_PS + 2 - i) = matching%JETS_ME(i)%p(0)
	!!! This makes more sense than hardcoding
	! call KTCLUS (4313, PP, (n_jets_PS + 2 - i), 1.0_double, Y, *999)
	call KTCLUR (imode, PP, (n_jets_PS + 2 - i), &
	dble (matching%settings%mlm_Rclusfactor * matching%settings%mlm_Rmin), &
	ECUT, y, *999)
	if (0.99 * y(n_jets_PS + 1 - (i - 1)).gt.ycut) then
	! print *, "DISCARDING: Jet ", i, " not clusterd"
	return
	end if
	!!! search for and remove PS jet clustered with ME Jet
	ip1 = HIST(n_jets_PS + 2 - i) / NMAX
	ip2 = mod(hist(n_jets_PS + 2 - i), NMAX)
	if ((ip2 /= n_jets_PS + 2 - i) .or. (ip1 <= 0)) then
	! print *, "DISCARDING: Jet ", i, " not clustered ", ip1, ip2, &
	! hist(n_jets_PS + 2 - i)
	return
	else
	! print *, "PARTON clustered", ip1, ip2, hist(n_jets_PS + 2 - i)
	PP(:,IP1) = zero
	do j = IP1, n_jets_PS - i
	PP(:, j) = PP(:,j + 1)
	end do
	end if
	end do
	end if
	@
	\section{CKKW matching}
	This module contains the CKKW matching.

	The type [[ckkw_pseudo_shower_weights_t]] gives the (relative) weights
	for different clusterings of the final particles, as given in Eq.~(2.7) of
	hep-ph/0503281v1. Each particle has a binary labelling (power of 2)
	(first particle = 1, second particle = 2, third particle = 4,
	...). Each recombination therefore corresponds to an integer, that is
	not a power of 2. Fur multiple subsequent recombinations, no different
	weights for different sequences of clustering are stored. It is
	assumed that the weight of a multiply recombined state is a
	combination of the states with one fewer recombination and that these
	states' contributions are proportional to their weights. For a $2->n$
	event, the weights array thus has the size $2^{(2 + n) - 1}$. The
	[[weights_by_type]] array gives the weights depending on the type of
	the particle, the first index is the same as for weights, the second
	index gives the type of the new mother particle:
	\begin{itemize}
	\item[0:] uncolored ($\gamma$, $Z$, $W$, Higgs)
	\item[1:] colored (quark)
	\item[2:] gluon
	\item[3:] squark
	\item[4:] gluino
	\end{itemize}
	[[alphaS]] gives the value for $alpha_s$ used in the generation of the
	matrix element. This is needed for the reweighting using the values
	for a running $alpha_s$ at the scales of the clusterings.
	<<[[ckkw_matching.f90]]>>=
	<<File header>>

	module ckkw_matching

	<<Use kinds with double>>
	<<Use strings>>
	use constants
	use lorentz
	use particles
	use rng_base
	use shower_base
	use shower_partons
	use variables
	use matching_base

	<<Standard module head>>

	<<CKKW matching: public>>

	<<CKKW matching: types>>

	interface
	<<CKKW matching: sub interfaces>>
	end interface

	end module ckkw_matching
	@ %def ckkw_matching
	@
	<<[[ckkw_matching_sub.f90]]>>=
	<<File header>>

	submodule (ckkw_matching) ckkw_matching_s

	<<Use debug>>
	use io_units
	use format_utils, only: write_separator
	use diagnostics
	use physics_defs
	use shower_core

	implicit none

	contains

	<<CKKW matching: procedures>>

	end submodule ckkw_matching_s

	@ %def ckkw_matching_s
	@ The fundamental CKKW matching parameter are defined here:
	<<CKKW matching: public>>=
	public :: ckkw_matching_settings_t
	<<CKKW matching: types>>=
	type :: ckkw_matching_settings_t
	real(default) :: alphaS = 0.118_default
	real(default) :: Qmin = one
	integer :: n_max_jets = 0
	contains
	<<CKKW matching: ckkw matching settings: TBP>>
	end type ckkw_matching_settings_t

	@ %def ckkw_matching_settings_t
	@ This is empty for the moment.
	<<CKKW matching: ckkw matching settings: TBP>>=
	procedure :: init => ckkw_matching_settings_init
	<<CKKW matching: sub interfaces>>=
	module subroutine ckkw_matching_settings_init (settings, var_list)
	class(ckkw_matching_settings_t), intent(out) :: settings
	type(var_list_t), intent(in) :: var_list
	end subroutine ckkw_matching_settings_init
	<<CKKW matching: procedures>>=
	module subroutine ckkw_matching_settings_init (settings, var_list)
	class(ckkw_matching_settings_t), intent(out) :: settings
	type(var_list_t), intent(in) :: var_list
	settings%alphaS = 1.0_default
	settings%Qmin = 1.0_default
	settings%n_max_jets = 3
	end subroutine ckkw_matching_settings_init

	@ %def ckkw_matching_settings_init
	@
	<<CKKW matching: ckkw matching settings: TBP>>=
	procedure :: write => ckkw_matching_settings_write
	<<CKKW matching: sub interfaces>>=
	module subroutine ckkw_matching_settings_write (settings, unit)
	class(ckkw_matching_settings_t), intent(in) :: settings
	integer, intent(in), optional :: unit
	end subroutine ckkw_matching_settings_write
	<<CKKW matching: procedures>>=
	module subroutine ckkw_matching_settings_write (settings, unit)
	class(ckkw_matching_settings_t), intent(in) :: settings
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "CKKW matching settings:"
	call write_separator (u)
	write (u, "(3x,A,1x,ES19.12)") &
	"alphaS = ", settings%alphaS
	write (u, "(3x,A,1x,ES19.12)") &
	"Qmin = ", settings%Qmin
	write (u, "(3x,A,1x,I0)") &
	"n_max_jets = ", settings%n_max_jets
	end subroutine ckkw_matching_settings_write

	@ %def ckkw_matching_settings_write
	@
	<<CKKW matching: public>>=
	public :: ckkw_pseudo_shower_weights_t
	<<CKKW matching: types>>=
	type :: ckkw_pseudo_shower_weights_t
	real(default) :: alphaS
	real(default), dimension(:), allocatable :: weights
	real(default), dimension(:,:), allocatable :: weights_by_type
	contains
	<<CKKW matching: ckkw pseudo shower weights: TBP>>
	end type ckkw_pseudo_shower_weights_t

	@ %def ckkw_pseudo_shower_weights_t
	@
	<<CKKW matching: ckkw pseudo shower weights: TBP>>=
	procedure :: init => ckkw_pseudo_shower_weights_init
	<<CKKW matching: sub interfaces>>=
	module subroutine ckkw_pseudo_shower_weights_init (weights)
	class(ckkw_pseudo_shower_weights_t), intent(out) :: weights
	end subroutine ckkw_pseudo_shower_weights_init
	<<CKKW matching: procedures>>=
	module subroutine ckkw_pseudo_shower_weights_init (weights)
	class(ckkw_pseudo_shower_weights_t), intent(out) :: weights
	weights%alphaS = zero
	end subroutine ckkw_pseudo_shower_weights_init

	@ %def ckkw_pseudo_shower_weights_init
	@
	<<CKKW matching: ckkw pseudo shower weights: TBP>>=
	procedure :: write => ckkw_pseudo_shower_weights_write
	<<CKKW matching: sub interfaces>>=
	module subroutine ckkw_pseudo_shower_weights_write (weights, unit)
	class(ckkw_pseudo_shower_weights_t), intent(in) :: weights
	integer, intent(in), optional :: unit
	end subroutine ckkw_pseudo_shower_weights_write
	<<CKKW matching: procedures>>=
	module subroutine ckkw_pseudo_shower_weights_write (weights, unit)
	class(ckkw_pseudo_shower_weights_t), intent(in) :: weights
	integer, intent(in), optional :: unit
	integer :: s, i, u
	u = given_output_unit (unit); if (u < 0) return
	s = size (weights%weights)
	write (u, "(1x,A)") "CKKW (pseudo) shower weights: "
	do i = 1, s
	write (u, "(3x,I0,2(ES19.12))") i, weights%weights(i), &
	weights%weights_by_type(i,:)
	end do
	write (u, "(3x,A,1x,I0)") "alphaS =", weights%alphaS
	end subroutine ckkw_pseudo_shower_weights_write

	@ %def ckkw_pseudo_shower_weights_write
	@ Generate fake ckkw weights. This can be dropped, once information
	from the matrix element generation is available.
	<<CKKW matching: ckkw pseudo shower weights: TBP>>=
	procedure :: fake => ckkw_pseudo_shower_weights_fake
	<<CKKW matching: sub interfaces>>=
	pure module subroutine ckkw_pseudo_shower_weights_fake &
	(weights, particle_set)
	class(ckkw_pseudo_shower_weights_t), intent(inout) :: weights
	type(particle_set_t), intent(in) :: particle_set
	end subroutine ckkw_pseudo_shower_weights_fake
	<<CKKW matching: procedures>>=
	pure module subroutine ckkw_pseudo_shower_weights_fake (weights, particle_set)
	class(ckkw_pseudo_shower_weights_t), intent(inout) :: weights
	type(particle_set_t), intent(in) :: particle_set
	integer :: i, j, n
	type(vector4_t) :: momentum
	n = 2**particle_set%n_tot
	if (allocated (weights%weights)) then
	deallocate (weights%weights)
	end if
	allocate (weights%weights (1:n))
	do i = 1, n
	momentum = vector4_null
	do j = 1, particle_set%n_tot
	if (btest (i,j-1)) then
	momentum = momentum + particle_set%prt(j)%p
	end if
	end do
	if (momentum**1 > 0.0) then
	weights%weights(i) = 1.0 / (momentum**2)
	end if
	end do
	! equally distribute the weights by type
	if (allocated (weights%weights_by_type)) then
	deallocate (weights%weights_by_type)
	end if
	allocate (weights%weights_by_type (1:n, 0:4))
	do i = 1, n
	do j = 0, 4
	weights%weights_by_type(i,j) = 0.2 * weights%weights(i)
	end do
	end do
	end subroutine ckkw_pseudo_shower_weights_fake

	@ %def ckkw_pseudo_shower_weights_fake
	@
	<<CKKW matching: public>>=
	public :: ckkw_matching_t
	<<CKKW matching: types>>=
	type, extends (matching_t) :: ckkw_matching_t
	type(ckkw_matching_settings_t) :: settings
	type(ckkw_pseudo_shower_weights_t) :: weights
	contains
	<<CKKW matching: ckkw matching: TBP>>
	end type ckkw_matching_t

	@ %def ckkw_matching_t
	@
	<<CKKW matching: ckkw matching: TBP>>=
	procedure :: init => ckkw_matching_init
	<<CKKW matching: sub interfaces>>=
	module subroutine ckkw_matching_init (matching, var_list, process_name)
	class(ckkw_matching_t), intent(out) :: matching
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_name
	end subroutine ckkw_matching_init
	<<CKKW matching: procedures>>=
	module subroutine ckkw_matching_init (matching, var_list, process_name)
	class(ckkw_matching_t), intent(out) :: matching
	<<default matching init>>
	end subroutine ckkw_matching_init

	@ %def ckkw_matching_init
	@
	<<CKKW matching: ckkw matching: TBP>>=
	procedure :: write => ckkw_matching_write
	<<CKKW matching: sub interfaces>>=
	module subroutine ckkw_matching_write (matching, unit)
	class(ckkw_matching_t), intent(in) :: matching
	integer, intent(in), optional :: unit
	end subroutine ckkw_matching_write
	<<CKKW matching: procedures>>=
	module subroutine ckkw_matching_write (matching, unit)
	class(ckkw_matching_t), intent(in) :: matching
	integer, intent(in), optional :: unit
	call matching%settings%write (unit)
	call matching%weights%write (unit)
	end subroutine ckkw_matching_write

	@ %def ckkw_matching_write
	@
	<<CKKW matching: ckkw matching: TBP>>=
	procedure :: get_method => ckkw_matching_get_method
	<<CKKW matching: sub interfaces>>=
	module function ckkw_matching_get_method (matching) result (method)
	type(string_t) :: method
	class(ckkw_matching_t), intent(in) :: matching
	end function ckkw_matching_get_method
	<<CKKW matching: procedures>>=
	module function ckkw_matching_get_method (matching) result (method)
	type(string_t) :: method
	class(ckkw_matching_t), intent(in) :: matching
	method = matching_method (MATCH_CKKW)
	end function ckkw_matching_get_method

	@ %def ckkw_matching_get_method
	@
	<<CKKW matching: ckkw matching: TBP>>=
	procedure :: before_shower => ckkw_matching_before_shower
	<<CKKW matching: sub interfaces>>=
	module subroutine ckkw_matching_before_shower &
	(matching, particle_set, vetoed)
	class(ckkw_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	end subroutine ckkw_matching_before_shower
	<<CKKW matching: procedures>>=
	module subroutine ckkw_matching_before_shower &
	(matching, particle_set, vetoed)
	class(ckkw_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	call matching%weights%init ()
	call matching%weights%fake (particle_set)
	select type (shower => matching%shower)
	type is (shower_t)
	call ckkw_matching_apply (shower%partons, &
	matching%settings, &
	matching%weights, matching%rng, vetoed)
	class default
	call msg_bug ("CKKW matching only works with WHIZARD shower.")
	end select
	end subroutine ckkw_matching_before_shower

	@ %def ckkw_matching_before_shower
	@
	<<CKKW matching: public>>=
	public :: ckkw_matching_apply
	<<CKKW matching: sub interfaces>>=
	module subroutine ckkw_matching_apply &
	(partons, settings, weights, rng, vetoed)
	type(parton_pointer_t), dimension(:), intent(inout), allocatable :: &
	partons
	type(ckkw_matching_settings_t), intent(in) :: settings
	type(ckkw_pseudo_shower_weights_t), intent(in) :: weights
	class(rng_t), intent(inout), allocatable :: rng
	logical, intent(out) :: vetoed
	end subroutine ckkw_matching_apply
	<<CKKW matching: procedures>>=
	module subroutine ckkw_matching_apply &
	(partons, settings, weights, rng, vetoed)
	type(parton_pointer_t), dimension(:), intent(inout), allocatable :: &
	partons
	type(ckkw_matching_settings_t), intent(in) :: settings
	type(ckkw_pseudo_shower_weights_t), intent(in) :: weights
	class(rng_t), intent(inout), allocatable :: rng
	logical, intent(out) :: vetoed

	real(default), dimension(:), allocatable :: scales
	real(double) :: weight, sf
	real(default) :: rand
	integer :: i, n_partons

	if (signal_is_pending ()) return
	weight = one

	n_partons = size (partons)

	do i = 1, n_partons
	call partons(i)%p%write ()
	end do

	!!! the pseudo parton shower is already simulated by shower_add_interaction
	!!! get the respective clustering scales
	allocate (scales (1:n_partons))
	do i = 1, n_partons
	if (.not. associated (partons(i)%p)) cycle
	if (partons(i)%p%type == INTERNAL) then
	scales(i) = two * min (partons(i)%p%child1%momentum%p(0), &
	partons(i)%p%child2%momentum%p(0))*2 &
	(1.0 - (space_part (partons(i)%p%child1%momentum) * &
	space_part (partons(i)%p%child2%momentum)) / &
	(space_part (partons(i)%p%child1%momentum)*1 &
	space_part (partons(i)%p%child2%momentum)**1))
	scales(i) = sqrt (scales(i))
	partons(i)%p%ckkwscale = scales(i)
	print *, scales(i)
	end if
	end do

	print *, " scales finished"
	!!! if (highest multiplicity) -> reweight with PDF(mu_F) / PDF(mu_cut)
	do i = 1, n_partons
	call partons(i)%p%write ()
	end do

	!!! Reweight and possibly veto the whole event

	!!! calculate the relative alpha_S weight

	!! calculate the Sudakov weights for internal lines
	!! calculate the Sudakov weights for external lines
	do i = 1, n_partons
	if (signal_is_pending ()) return
	if (.not. associated (partons(i)%p)) cycle
	if (partons(i)%p%type == INTERNAL) then
	!!! get type
	!!! check that all particles involved are colored
	if ((partons(i)%p%is_colored () .or. &
	partons(i)%p%ckkwtype > 0) .and. &
	(partons(i)%p%child1%is_colored () .or. &
	partons(i)%p%child1%ckkwtype > 0) .and. &
	(partons(i)%p%child1%is_colored () .or. &
	partons(i)%p%child1%ckkwtype > 0)) then
	print *, "reweight with alphaS(" , partons(i)%p%ckkwscale, &
	") for particle ", partons(i)%p%nr
	if (partons(i)%p%belongstoFSR) then
	print *, "FSR"
	weight = weight * D_alpha_s_fsr (partons(i)%p%ckkwscale**2, &
	partons(i)%p%settings) / settings%alphas
	else
	print *, "ISR"
	weight = weight * &
	D_alpha_s_isr (partons(i)%p%ckkwscale**2, &
	partons(i)%p%settings) / settings%alphas
	end if
	else
	print *, "no reweight with alphaS for ", partons(i)%p%nr
	end if
	if (partons(i)%p%child1%type == INTERNAL) then
	print *, "internal line from ", &
	partons(i)%p%child1%ckkwscale, &
	" to ", partons(i)%p%ckkwscale, &
	" for type ", partons(i)%p%child1%ckkwtype
	if (partons(i)%p%child1%ckkwtype == 0) then
	sf = 1.0
	else if (partons(i)%p%child1%ckkwtype == 1) then
	sf = SudakovQ (partons(i)%p%child1%ckkwscale, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFQ = ", sf
	else if (partons(i)%p%child1%ckkwtype == 2) then
	sf = SudakovG (partons(i)%p%child1%ckkwscale, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFG = ", sf
	else
	print *, "SUSY not yet implemented"
	end if
	weight = weight * min (one, sf)
	else
	print *, "external line from ", settings%Qmin, &
	partons(i)%p%ckkwscale
	if (partons(i)%p%child1%is_quark ()) then
	sf = SudakovQ (settings%Qmin, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFQ = ", sf
	else if (partons(i)%p%child1%is_gluon ()) then
	sf = SudakovG (settings%Qmin, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFG = ", sf
	else
	print *, "not yet implemented (", &
	partons(i)%p%child2%type, ")"
	sf = one
	end if
	weight = weight * min (one, sf)
	end if
	if (partons(i)%p%child2%type == INTERNAL) then
	print *, "internal line from ", partons(i)%p%child2%ckkwscale, &
	" to ", partons(i)%p%ckkwscale, &
	" for type ", partons(i)%p%child2%ckkwtype
	if (partons(i)%p%child2%ckkwtype == 0) then
	sf = 1.0
	else if (partons(i)%p%child2%ckkwtype == 1) then
	sf = SudakovQ (partons(i)%p%child2%ckkwscale, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFQ = ", sf
	else if (partons(i)%p%child2%ckkwtype == 2) then
	sf = SudakovG (partons(i)%p%child2%ckkwscale, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFG = ", sf
	else
	print *, "SUSY not yet implemented"
	end if
	weight = weight * min (one, sf)
	else
	print *, "external line from ", settings%Qmin, &
	partons(i)%p%ckkwscale
	if (partons(i)%p%child2%is_quark ()) then
	sf = SudakovQ (settings%Qmin, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFQ = ", sf
	else if (partons(i)%p%child2%is_gluon ()) then
	sf = SudakovG (settings%Qmin, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFG = ", sf
	else
	print *, "not yet implemented (", &
	partons(i)%p%child2%type, ")"
	sf = one
	end if
	weight = weight * min (one, sf)
	end if
	end if
	end do

	call rng%generate (rand)

	print *, "final weight: ", weight

	!!!!!!! WRONG
	vetoed = .false.
	! vetoed = (rand > weight)
	if (vetoed) then
	return
	end if

	!!! finally perform the parton shower
	!!! veto emissions that are too hard

	deallocate (scales)
	end subroutine ckkw_matching_apply

	@ %def ckkw_matching_apply
	@
	@
	<<CKKW matching: ckkw matching: TBP>>=
	procedure :: after_shower => ckkw_matching_after_shower
	<<CKKW matching: sub interfaces>>=
	module subroutine ckkw_matching_after_shower &
	(matching, particle_set, vetoed)
	class(ckkw_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	end subroutine ckkw_matching_after_shower
	<<CKKW matching: procedures>>=
	module subroutine ckkw_matching_after_shower (matching, particle_set, vetoed)
	class(ckkw_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	vetoed = .false.
	end subroutine ckkw_matching_after_shower

	@ %def ckkw_matching_after_shower
	<<CKKW matching: procedures>>=
	function GammaQ (smallq, largeq, settings, fsr) result (gamma)
	real(default), intent(in) :: smallq, largeq
	type(shower_settings_t), intent(in) :: settings
	logical, intent(in) :: fsr
	real(default) :: gamma
	gamma = (8._default / three) / (pi * smallq)
	gamma = gamma * (log(largeq / smallq) - 0.75)
	if (fsr) then
	gamma = gamma * D_alpha_s_fsr (smallq**2, settings)
	else
	gamma = gamma * D_alpha_s_isr (smallq**2, settings)
	end if
	end function GammaQ

	@ %def GammaQ
	@
	<<CKKW matching: procedures>>=
	function GammaG (smallq, largeq, settings, fsr) result (gamma)
	real(default), intent(in) :: smallq, largeq
	type(shower_settings_t), intent(in) :: settings
	logical, intent(in) :: fsr
	real(default) :: gamma
	gamma = 6._default / (pi * smallq)
	gamma = gamma *( log(largeq / smallq) - 11.0 / 12.0)
	if (fsr) then
	gamma = gamma * D_alpha_s_fsr (smallq**2, settings)
	else
	gamma = gamma * D_alpha_s_isr (smallq**2, settings)
	end if
	end function GammaG

	@ %def GammaG
	@
	<<CKKW matching: procedures>>=
	function GammaF (smallq, settings, fsr) result (gamma)
	real(default), intent(in) :: smallq
	type(shower_settings_t), intent(in) :: settings
	logical, intent(in) :: fsr
	real(default) :: gamma
	gamma = number_of_flavors (smallq, settings%max_n_flavors, &
	settings%min_virtuality) / (three * pi * smallq)
	if (fsr) then
	gamma = gamma * D_alpha_s_fsr (smallq**2, settings)
	else
	gamma = gamma * D_alpha_s_isr (smallq**2, settings)
	end if
	end function GammaF

	@ %def GammaF
	@
	<<CKKW matching: procedures>>=
	function SudakovQ (Q1, Q, settings, fsr, rng) result (sf)
	real(default), intent(in) :: Q1, Q
	type(shower_settings_t), intent(in) :: settings
	class(rng_t), intent(inout), allocatable :: rng
	logical, intent(in) :: fsr
	real(default) :: sf
	real(default) :: integral
	integer, parameter :: NTRIES = 100
	integer :: i
	real(default) :: rand
	integral = zero
	do i = 1, NTRIES
	call rng%generate (rand)
	integral = integral + GammaQ (Q1 + rand * (Q - Q1), Q, settings, fsr)
	end do
	integral = integral / NTRIES
	sf = exp (-integral)
	end function SudakovQ

	@ %def SudakovQ
	@
	<<CKKW matching: procedures>>=
	function SudakovG (Q1, Q, settings, fsr, rng) result (sf)
	real(default), intent(in) :: Q1, Q
	type(shower_settings_t), intent(in) :: settings
	logical, intent(in) :: fsr
	real(default) :: sf
	real(default) :: integral
	class(rng_t), intent(inout), allocatable :: rng
	integer, parameter :: NTRIES = 100
	integer :: i
	real(default) :: rand
	integral = zero
	do i = 1, NTRIES
	call rng%generate (rand)
	integral = integral + &
	GammaG (Q1 + rand * (Q - Q1), Q, settings, fsr) + &
	GammaF (Q1 + rand * (Q - Q1), settings, fsr)
	end do
	integral = integral / NTRIES
	sf = exp (-integral)
	end function SudakovG

	@ %def SudakovG
	@
	\section{POWHEG}
	This module generates radiation according to the POWHEG Sudakov form factor
	\begin{equation}
	\Delta^{f_b} (\Phi_n, p_\text{T}) = \prod_{\alpha_r \in \{\alpha_r \|f_b \}}
	\Delta^{f_b}_{\alpha_r} (\Phi_n,
	p_\text{T}),
	\end{equation}
	with
	\begin{equation}
	\Delta^{f_b}_{\alpha_r} (\Phi_n, p_\text{T}) = \exp \left\{ - \left[ \int d
	\Phi_{\text{rad}} \,\frac{R (\Phi_{n+1})}{B^{f_b} (\Phi_n)}
	\,\theta( k_\text{T} (\Phi_{n+1}) - p_\text{T}) \right]^{\bar{\bf \Phi}_n^{\alpha_r} =
	\Phi_n}_{\alpha_r} \right\}
	\end{equation}

	We expect that an underlying Born flavor structure $f_b$ has been
	generated with a probability proportional to its contribution to the
	$\tilde B$ at the given kinematic point.
	<<[[powheg_matching.f90]]>>=
	<<File header>>

	module powheg_matching

	use, intrinsic :: iso_fortran_env

	<<Use kinds with double>>
	<<Use strings>>
	use diagnostics
	use constants, only: ZERO, ONE, TWO, THREE, FOUR, FIVE, TINY_07, PI, TWOPI
	use pdf, only: pdf_data_t
	use lorentz
	use phs_points, only: assignment(=), operator(*)
	use sm_qcd, only: qcd_t, alpha_qcd_from_scale_t, alpha_qcd_from_lambda_t
	use particles
	use grids
	use solver
	use rng_base
	use variables

	use phs_fks, only: phs_fks_generator_t, compute_dalitz_bounds, beta_emitter
	use phs_fks, only: phs_point_set_t, phs_identifier_t, phs_fks_t
	use phs_fks, only: get_xi_max_isr
	use phs_fks, only: I_XI, I_Y, I_PLUS, I_MINUS, UBF_FSR_SIMPLE, UBF_FSR_MASSIVE, UBF_FSR_MASSLESS_RECOIL, UBF_ISR
	use matching_base
	use instances, only: process_instance_t, process_instance_hook_t
	use pcm, only: pcm_nlo_t, pcm_nlo_workspace_t

	<<Standard module head>>

	<<POWHEG matching: public>>

	<<POWHEG matching: types>>

	<<POWHEG matching: interfaces>>

	interface
	<<POWHEG matching: sub interfaces>>
	end interface

	contains

	<<POWHEG matching: main procedures>>

	end module powheg_matching
	@ %def powheg_matching
	@
	<<[[powheg_matching_sub.f90]]>>=
	<<File header>>

	submodule (powheg_matching) powheg_matching_s

	<<Use mpi f08>>
	<<Use debug>>
	use io_units, only: given_output_unit, free_unit
	use format_utils, only: write_separator
	use format_defs, only: FMT_16, FMT_19
	use string_utils, only: str
	use numeric_utils
	use os_interface, only: os_file_exist
	use physics_defs, only: CA, BORN, NLO_REAL, MZ_REF
	use pdg_arrays, only: is_gluon, is_quark
	use sf_lhapdf, only: alpha_qcd_lhapdf_t
	use sm_physics, only: Li2, coeff_b0, lambda_qcd
	use subevents, only: PRT_INCOMING, PRT_OUTGOING
	use colors
	use process_config, only: COMP_REAL_FIN
	+ use prc_external, only: prc_external_state_t
	+ use prc_omega, only: omega_state_t

	implicit none

	contains

	<<POWHEG matching: procedures>>

	end submodule powheg_matching_s

	@ %def powheg_matching_s
	@
	\subsection{Base types for settings and data}
	[[lambda]] is the lowest scale $\Lambda^(5)_{\bar{\text{MS}}}$
	where the radiation $\alpha_s^\text{rad}$ is still larger than
	the true $\alpha_s$. We relate $\alpha_s^\text{rad}$ and
	$\alpha_s^\text{true}$ at the scale $2\Lambda^(5)_{\bar{\text{MS}}}$.
	<<POWHEG matching: public>>=
	public :: powheg_settings_t
	<<POWHEG matching: types>>=
	type :: powheg_settings_t
	real(default) :: pt2_min = zero
	real(default) :: lambda = zero
	integer :: size_grid_xi = 0
	integer :: size_grid_y = 0
	integer :: upper_bound_func_type = UBF_FSR_SIMPLE
	logical :: test_sudakov = .false.
	logical :: disable_sudakov = .false.
	logical :: singular_jacobian = .false.
	contains
	<<POWHEG matching: powheg settings: TBP>>
	end type powheg_settings_t

	@ %def powheg_settings_t
	@
	<<POWHEG matching: powheg settings: TBP>>=
	procedure :: init => powheg_settings_init
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_settings_init (settings, var_list)
	class(powheg_settings_t), intent(out) :: settings
	type(var_list_t), intent(in) :: var_list
	end subroutine powheg_settings_init
	<<POWHEG matching: procedures>>=
	module subroutine powheg_settings_init (settings, var_list)
	class(powheg_settings_t), intent(out) :: settings
	type(var_list_t), intent(in) :: var_list
	settings%pt2_min = &
	var_list%get_rval (var_str ("powheg_pt_min"))**2
	settings%size_grid_xi = &
	var_list%get_ival (var_str ("powheg_grid_size_xi"))
	settings%size_grid_y = &
	var_list%get_ival (var_str ("powheg_grid_size_y"))
	settings%lambda = var_list%get_rval (var_str ("powheg_lambda"))
	settings%singular_jacobian = &
	var_list%get_lval (var_str ("?powheg_use_singular_jacobian"))
	settings%test_sudakov = &
	var_list%get_lval (var_str ("?powheg_test_sudakov"))
	settings%disable_sudakov = &
	var_list%get_lval (var_str ("?powheg_disable_sudakov"))
	end subroutine powheg_settings_init

	@ %def powheg_settings_init
	@
	<<POWHEG matching: powheg settings: TBP>>=
	procedure :: write => powheg_settings_write
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_settings_write (powheg_settings, unit)
	class(powheg_settings_t), intent(in) :: powheg_settings
	integer, intent(in), optional :: unit
	end subroutine powheg_settings_write
	<<POWHEG matching: procedures>>=
	module subroutine powheg_settings_write (powheg_settings, unit)
	class(powheg_settings_t), intent(in) :: powheg_settings
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1X,A)") "POWHEG settings:"
	write (u, "(3X,A," // FMT_16 //")") "pt2_min = ", powheg_settings%pt2_min
	write (u, "(3X,A," // FMT_16 //")") "lambda = ", powheg_settings%lambda
	write (u, "(3X,A,I12)") "size_grid_xi = ", powheg_settings%size_grid_xi
	write (u, "(3X,A,I12)") "size_grid_y = ", powheg_settings%size_grid_y
	write (u, "(3X,A,I12)") "upper_bound_func_type = ", powheg_settings%upper_bound_func_type
	end subroutine powheg_settings_write

	@ %def powheg_settings_write
	@
	<<POWHEG matching: public>>=
	public :: radiation_t
	<<POWHEG matching: types>>=
	type :: radiation_t
	real(default) :: xi, y, phi, pt2
	integer :: alr
	logical :: valid = .false.
	contains
	<<POWHEG matching: radiation: TBP>>
	end type radiation_t

	@ %def radiation_t
	@
	<<POWHEG matching: radiation: TBP>>=
	procedure :: write => radiation_write
	<<POWHEG matching: sub interfaces>>=
	module subroutine radiation_write (radiation, unit)
	class(radiation_t), intent(in) :: radiation
	integer, intent(in), optional :: unit
	end subroutine radiation_write
	<<POWHEG matching: procedures>>=
	module subroutine radiation_write (radiation, unit)
	class(radiation_t), intent(in) :: radiation
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1X, A)") "Radiation:"
	write (u, "(3X, A," // FMT_16 // ")") "xi = ", radiation%xi
	write (u, "(3X, A," // FMT_16 // ")") "y = ", radiation%y
	write (u, "(3X, A," // FMT_16 // ")") "phi = ", radiation%phi
	write (u, "(3X, A," // FMT_16 // ")") "pt2 = ", radiation%pt2
	write (u, "(3X, A, I12)") "alr = ", radiation%alr
	end subroutine radiation_write

	@ %def radiation_write
	@ [[lambda2_gen]] is the scale used in the (log integrated) upper bounding
	functions. It is not equivalent to [[lambda5MSB]] which is a reference
	scale for the $\alpha_s$ evolution.
	<<POWHEG matching: public>>=
	public :: process_deps_t
	<<POWHEG matching: types>>=
	type :: process_deps_t
	real(default) :: lambda2_gen, lambda5MSB, sqrts
	integer :: n_alr
	integer :: alpha_power, alphas_power
	logical :: lab_is_cm = .true.
	type(pdf_data_t) :: pdf_data
	type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers
	integer, dimension(:), allocatable :: alr_to_i_phs
	integer :: i_term_born
	integer, dimension(:), allocatable :: i_term_real
	contains
	<<POWHEG matching: process deps: TBP>>
	end type process_deps_t

	@ %def process_deps_t
	@
	<<POWHEG matching: process deps: TBP>>=
	procedure :: write => process_deps_write
	<<POWHEG matching: sub interfaces>>=
	module subroutine process_deps_write (process_deps, unit)
	class(process_deps_t), intent(in) :: process_deps
	integer, intent(in), optional :: unit
	end subroutine process_deps_write
	<<POWHEG matching: procedures>>=
	module subroutine process_deps_write (process_deps, unit)
	class(process_deps_t), intent(in) :: process_deps
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1X,A)") "Process dependencies:"
	write (u, "(3X,A," // FMT_19 // ")") "lambda2_gen = ", &
	process_deps%lambda2_gen
	write (u, "(3X,A," // FMT_19 // ")") "lambda5MSB = ", &
	process_deps%lambda5MSB
	write (u, "(3X,A, I12)") "n_alr = ", process_deps%n_alr
	write (u, "(3X,A, L12)") "lab_is_cm = ", process_deps%lab_is_cm
	write (u, "(3X,A, I10)") "alpha_power = ", process_deps%alpha_power
	write (u, "(3X,A, I9)") "alphas_power = ", process_deps%alphas_power
	write (u, "(3X,A, I10)") "i_term_born = ", process_deps%i_term_born
	do i = 1, size(process_deps%i_term_real)
	write (u, "(3X,A,I2,A, I6)") "i_term_real(",i,") = ", &
	process_deps%i_term_real(i)
	end do
	call process_deps%pdf_data%write(u)
	end subroutine process_deps_write

	@ %def process_deps_write
	@
	<<POWHEG matching: public>>=
	public :: event_deps_t
	<<POWHEG matching: types>>=
	type :: event_deps_t
	real(default) :: s_hat
	real(default), dimension(2) :: x_born
	real(default) :: s_had
	type(phs_point_set_t) :: p_born_cms
	type(phs_point_set_t) :: p_born_lab
	type(phs_point_set_t) :: p_real_cms
	type(phs_point_set_t) :: p_real_lab
	- real(default) :: sqme_born
	+ real(default), dimension(:), allocatable :: sqme_born
	contains
	<<POWHEG matching: event deps: TBP>>
	end type event_deps_t

	@ %def event_deps_t
	@
	<<POWHEG matching: event deps: TBP>>=
	procedure :: write => event_deps_write
	<<POWHEG matching: sub interfaces>>=
	module subroutine event_deps_write (event_deps, unit)
	class(event_deps_t), intent(in) :: event_deps
	integer, intent(in), optional :: unit
	end subroutine event_deps_write
	<<POWHEG matching: procedures>>=
	module subroutine event_deps_write (event_deps, unit)
	class(event_deps_t), intent(in) :: event_deps
	integer, intent(in), optional :: unit
	- integer :: u
	+ integer :: u, alr
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1X,A)") "Event dependencies:"
	write (u, "(3X,A," // FMT_19 // ")") "s_hat = ", event_deps%s_hat
	write (u, "(3X,A," // FMT_19 // ")") "x(+) = ", event_deps%x_born(I_PLUS)
	write (u, "(3X,A," // FMT_19 // ")") "x(-) = ", event_deps%x_born(I_MINUS)
	write (u, "(3X,A," // FMT_19 // ")") "s_had = ", event_deps%s_had
	- write (u, "(3X,A," // FMT_19 // ")") "sqme_born = ", event_deps%sqme_born
	+ do alr = 1, size(event_deps%sqme_born)
	+ write (u, "(3X,A,I3,A," // FMT_19 // ")") "sqme_born(",alr,") = ", &
	+ event_deps%sqme_born(alr)
	+ end do
	end subroutine event_deps_write

	@ %def event_deps_write
	@
	<<POWHEG matching: event deps: TBP>>=
	procedure :: update => event_deps_update
	<<POWHEG matching: sub interfaces>>=
	module subroutine event_deps_update (event_deps, sqme_born, &
	p_born, x_born, lt_lab_to_cms)
	class(event_deps_t), intent(inout) :: event_deps
	- real(default), intent(in) :: sqme_born
	+ real(default), dimension(:), intent(in) :: sqme_born
	type(vector4_t), dimension(:), intent(in) :: p_born
	real(default), dimension(2), intent(in) :: x_born
	type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
	end subroutine event_deps_update
	<<POWHEG matching: procedures>>=
	module subroutine event_deps_update (event_deps, sqme_born, &
	p_born, x_born, lt_lab_to_cms)
	class(event_deps_t), intent(inout) :: event_deps
	- real(default), intent(in) :: sqme_born
	+ real(default), dimension(:), intent(in) :: sqme_born
	type(vector4_t), dimension(:), intent(in) :: p_born
	real(default), dimension(2), intent(in) :: x_born
	type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
	integer :: n_born
	- event_deps%sqme_born = sqme_born
	+ if (allocated(event_deps%sqme_born)) then
	+ event_deps%sqme_born = sqme_born
	+ else
	+ allocate(event_deps%sqme_born, source=sqme_born)
	+ end if
	n_born = size (p_born)
	if (debug_active (D_MATCHING)) then
	if (n_born /= event_deps%p_born_lab%get_n_particles (1)) then
	call msg_fatal &
	("event_deps_update: number of born_momenta has changed")
	end if
	end if
	call event_deps%p_born_lab%set_momenta (1, p_born)
	call event_deps%set_cms (lt_lab_to_cms)
	event_deps%x_born = x_born
	event_deps%s_had = event_deps%s_hat / ( x_born(I_PLUS) * x_born(I_MINUS) )
	end subroutine event_deps_update

	@ %def event_deps_update
	@ Sets the Born momenta in the CMS boosting them if necessary.
	<<POWHEG matching: event deps: TBP>>=
	procedure :: set_cms => event_deps_set_cms
	<<POWHEG matching: sub interfaces>>=
	module subroutine event_deps_set_cms (event_deps, lt_lab_to_cms)
	class(event_deps_t), intent(inout) :: event_deps
	type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
	end subroutine event_deps_set_cms
	<<POWHEG matching: procedures>>=
	module subroutine event_deps_set_cms (event_deps, lt_lab_to_cms)
	class(event_deps_t), intent(inout) :: event_deps
	type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
	associate (pp => event_deps%p_born_lab%phs_point(1))
	event_deps%s_hat = pp%get_msq ([1,2])
	if (present (lt_lab_to_cms)) then
	event_deps%p_born_cms%phs_point(1) = lt_lab_to_cms * pp
	else
	event_deps%p_born_cms%phs_point(1) = pp
	end if
	end associate
	end subroutine event_deps_set_cms

	@ %def event_deps_set_cms
	@
	<<POWHEG matching: types>>=
	type :: veto_counter_t
	integer :: n_ubf = 0
	integer :: n_xi_max = 0
	integer :: n_norm = 0
	integer :: n_sqme = 0
	integer :: n_veto_ubf = 0
	integer :: n_veto_xi_max = 0
	integer :: n_veto_norm = 0
	integer :: n_veto_sqme = 0
	integer :: n_fail_ubf = 0
	contains
	<<POWHEG matching: veto counter: TBP>>
	end type veto_counter_t

	@ %def veto_counter_t
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: record_ubf => veto_counter_record_ubf
	<<POWHEG matching: sub interfaces>>=
	pure module subroutine veto_counter_record_ubf (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	end subroutine veto_counter_record_ubf
	<<POWHEG matching: procedures>>=
	pure module subroutine veto_counter_record_ubf (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	counter%n_ubf = counter%n_ubf + 1
	if (vetoed) counter%n_veto_ubf = counter%n_veto_ubf + 1
	end subroutine veto_counter_record_ubf

	@ %def veto_counter_record_ubf
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: record_xi_max => veto_counter_record_xi_max
	<<POWHEG matching: sub interfaces>>=
	module subroutine veto_counter_record_xi_max (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	end subroutine veto_counter_record_xi_max
	<<POWHEG matching: procedures>>=
	module subroutine veto_counter_record_xi_max (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	counter%n_xi_max = counter%n_xi_max + 1
	if (vetoed) counter%n_veto_xi_max = counter%n_veto_xi_max + 1
	end subroutine veto_counter_record_xi_max

	@ %def veto_counter_record_xi_max
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: record_norm => veto_counter_record_norm
	<<POWHEG matching: sub interfaces>>=
	module subroutine veto_counter_record_norm (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	end subroutine veto_counter_record_norm
	<<POWHEG matching: procedures>>=
	module subroutine veto_counter_record_norm (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	counter%n_norm = counter%n_norm + 1
	if (vetoed) counter%n_veto_norm = counter%n_veto_norm + 1
	end subroutine veto_counter_record_norm

	@ %def veto_counter_record_norm
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: record_sqme => veto_counter_record_sqme
	<<POWHEG matching: sub interfaces>>=
	module subroutine veto_counter_record_sqme (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	end subroutine veto_counter_record_sqme
	<<POWHEG matching: procedures>>=
	module subroutine veto_counter_record_sqme (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	counter%n_sqme = counter%n_sqme + 1
	if (vetoed) counter%n_veto_sqme = counter%n_veto_sqme + 1
	end subroutine veto_counter_record_sqme

	@ %def veto_counter_record_sqme
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: record_ubf_fail => veto_counter_record_ubf_fail
	<<POWHEG matching: sub interfaces>>=
	module subroutine veto_counter_record_ubf_fail (counter)
	class(veto_counter_t), intent(inout) :: counter
	end subroutine veto_counter_record_ubf_fail
	<<POWHEG matching: procedures>>=
	module subroutine veto_counter_record_ubf_fail (counter)
	class(veto_counter_t), intent(inout) :: counter
	counter%n_fail_ubf = counter%n_fail_ubf + 1
	end subroutine veto_counter_record_ubf_fail

	@ %def veto_counter_record_ubf_fail
	@ This routine fills the POWHEG veto log file with content showing how many
	events have been vetoed in which step of the sudakov veto algorithm.
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: write => veto_counter_write
	<<POWHEG matching: sub interfaces>>=
	module subroutine veto_counter_write (counter, unit)
	class(veto_counter_t), intent(in) :: counter
	integer, intent(in), optional :: unit
	end subroutine veto_counter_write
	<<POWHEG matching: procedures>>=
	module subroutine veto_counter_write (counter, unit)
	class(veto_counter_t), intent(in) :: counter
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A29,I10)") "Nr. of ubf-veto calls: ", counter%n_ubf
	write (u, "(A29,I10)") "Nr. of ubf-vetos: ", counter%n_veto_ubf
	if (counter%n_ubf > 0) &
	write (u, "(A29,F9.2,A1)") "Fraction of vetoed points: ", &
	one * counter%n_veto_ubf / counter%n_ubf * 100, "%"
	call write_separator (u)

	write (u, "(A29,I10)") "Nr. of xi_max-veto calls: ", counter%n_xi_max
	write (u, "(A29,I10)") "Nr. of xi_max-vetos: ", counter%n_veto_xi_max
	if (counter%n_xi_max > 0) &
	write (u, "(A29,F9.2,A1)") "Fraction of vetoed points: ", &
	one * counter%n_veto_xi_max / counter%n_xi_max * 100, "%"
	call write_separator (u)

	write (u, "(A29,I10)") "Nr. of norm-veto calls: ", counter%n_norm
	write (u, "(A29,I10)") "Nr. of norm-vetos: ", counter%n_veto_norm
	if (counter%n_norm > 0) &
	write (u, "(A29,F9.2,A1)") "Fraction of vetoed points: ", &
	one * counter%n_veto_norm / counter%n_norm * 100, "%"
	call write_separator (u)

	write (u, "(A29,I10)") "Nr. of sqme-veto calls: ", counter%n_sqme
	write (u, "(A29,I10)") "Nr. of sqme-vetos: ", counter%n_veto_sqme
	if (counter%n_sqme > 0) &
	write (u, "(A29,F9.2,A1)") "Fraction of vetoed points: ", &
	one * counter%n_veto_sqme / counter%n_sqme * 100, "%"
	call write_separator (u)
	write (u, "(A29,I10)") "Nr. of upper-bound failures: ", &
	counter%n_fail_ubf
	if (counter%n_sqme > 0) &
	write (u, "(A29,F9.2,A1)") "Fraction of failed points: ", &
	one * counter%n_fail_ubf / counter%n_sqme * 100, "%"
	end subroutine veto_counter_write

	@ %def veto_counter_write
	@
	\subsection{Upper bounding functions and [[sudakov]]s}
	\subsubsection{Abstract version}
	This contains the pieces that depend on the radiation region $\alpha_r$
	<<POWHEG matching: public>>=
	public :: sudakov_t
	<<POWHEG matching: types>>=
	type, abstract, extends (solver_function_t) :: sudakov_t
	type(process_deps_t), pointer :: process_deps => null()
	type(event_deps_t), pointer :: event_deps => null()
	type(powheg_settings_t), pointer :: powheg_settings => null()
	type(phs_fks_generator_t), pointer :: phs_fks_generator => null()
	type(qcd_t) :: qcd
	class(rng_t), pointer :: rng => null()
	real(default) :: xi2_max = zero
	real(default) :: norm_max = zero
	real(default) :: current_pt2_max = zero
	real(default) :: sum_log_rands = zero
	real(default) :: random = zero
	type(veto_counter_t) :: veto_counter
	integer :: i_phs = 0
	contains
	<<POWHEG matching: sudakov: TBP>>
	end type sudakov_t

	@ %def sudakov_t
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: write => sudakov_write
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_write (sudakov, unit)
	class(sudakov_t), intent(in) :: sudakov
	integer, intent(in), optional :: unit
	end subroutine sudakov_write
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_write (sudakov, unit)
	class(sudakov_t), intent(in) :: sudakov
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(3X,A," // FMT_19 // ")") "xi2_max = ", sudakov%xi2_max
	write (u, "(3X,A," // FMT_19 // ")") "norm_max = ", sudakov%norm_max
	write (u, "(3X,A," // FMT_19 // ")") &
	"current_pt2_max = ", sudakov%current_pt2_max
	write (u, "(3X,A," // FMT_19 // ")") "sum_log_rands = ", sudakov%sum_log_rands
	write (u, "(3X,A," // FMT_19 // ")") "random = ", sudakov%random
	end subroutine sudakov_write

	@ %def sudakov_write
	@ To allow for arrays of this class
	<<POWHEG matching: public>>=
	public :: sudakov_wrapper_t
	<<POWHEG matching: types>>=
	type :: sudakov_wrapper_t
	class(sudakov_t), allocatable :: s
	end type sudakov_wrapper_t

	@ %def sudakov_wrapper_t
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: init => sudakov_init
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_init (sudakov, process_deps, event_deps, &
	powheg_settings, qcd, phs_fks_generator, rng)
	class(sudakov_t), intent(out) :: sudakov
	type(process_deps_t), target, intent(in) :: process_deps
	type(event_deps_t), target, intent(in) :: event_deps
	type(powheg_settings_t), target, intent(in) :: powheg_settings
	type(qcd_t), intent(in) :: qcd
	type(phs_fks_generator_t), target, intent(in) :: phs_fks_generator
	class(rng_t), target, intent(in), optional :: rng
	end subroutine sudakov_init
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_init (sudakov, process_deps, event_deps, &
	powheg_settings, qcd, phs_fks_generator, rng)
	class(sudakov_t), intent(out) :: sudakov
	type(process_deps_t), target, intent(in) :: process_deps
	type(event_deps_t), target, intent(in) :: event_deps
	type(powheg_settings_t), target, intent(in) :: powheg_settings
	type(qcd_t), intent(in) :: qcd
	type(phs_fks_generator_t), target, intent(in) :: phs_fks_generator
	class(rng_t), target, intent(in), optional :: rng
	sudakov%process_deps => process_deps
	sudakov%event_deps => event_deps
	sudakov%powheg_settings => powheg_settings
	sudakov%qcd = qcd
	sudakov%phs_fks_generator => phs_fks_generator
	if (present (rng)) sudakov%rng => rng
	end subroutine sudakov_init

	@ %def sudakov_init
	@ This has to be done after the grids are initialized.
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: set_normalization => sudakov_set_normalization
	<<POWHEG matching: sub interfaces>>=
	pure module subroutine sudakov_set_normalization (sudakov, norm_max)
	class(sudakov_t), intent(inout) :: sudakov
	real(default), intent(in) :: norm_max
	end subroutine sudakov_set_normalization
	<<POWHEG matching: procedures>>=
	pure module subroutine sudakov_set_normalization (sudakov, norm_max)
	class(sudakov_t), intent(inout) :: sudakov
	real(default), intent(in) :: norm_max
	sudakov%norm_max = norm_max
	end subroutine sudakov_set_normalization

	@ %def sudakov_set_normalization
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: update_xi2_max => sudakov_update_xi2_max
	<<POWHEG matching: sub interfaces>>=
	pure module subroutine sudakov_update_xi2_max (sudakov, xi2_max)
	class(sudakov_t), intent(inout) :: sudakov
	real(default), intent(in) :: xi2_max
	end subroutine sudakov_update_xi2_max
	<<POWHEG matching: procedures>>=
	pure module subroutine sudakov_update_xi2_max (sudakov, xi2_max)
	class(sudakov_t), intent(inout) :: sudakov
	real(default), intent(in) :: xi2_max
	sudakov%xi2_max = xi2_max
	end subroutine sudakov_update_xi2_max

	@ %def sudakov_update_xi2_max
	@ [[upper_bound_func]] does \emph{not} contain the normalization $N$
	which is given by the grids. In the notation of [[1002.2581]], it is
	thus $\frac 1 N U(\xi,y)$
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_upper_bound_func), deferred :: upper_bound_func
	<<POWHEG matching: interfaces>>=
	abstract interface
	pure function sudakov_upper_bound_func (sudakov, xi, y, alpha_s) result (u)
	import
	real(default) :: u
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	end function sudakov_upper_bound_func
	end interface

	@ %def sudakov_upper_bound_func
	@ Similar to the [[upper_bound_func]], this is
	$-\frac 1 N \log\Delta(p_T^2)$ where
	\begin{equation}
	\Delta^{(U)} (p_T) = \exp\left[-N \int U(\xi,y)\theta(k_T - p_T) \; d\xi \, dy \, d\phi \right]
	\end{equation}
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_log_integrated_ubf), deferred :: log_integrated_ubf
	<<POWHEG matching: interfaces>>=
	abstract interface
	pure function sudakov_log_integrated_ubf (sudakov, pt2) result (y)
	import
	real(default) :: y
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	end function sudakov_log_integrated_ubf
	end interface

	@ %def sudakov_log_integrated_ubf
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_generate_xi_and_y_and_phi), deferred :: generate_xi_and_y_and_phi
	<<POWHEG matching: interfaces>>=
	abstract interface
	subroutine sudakov_generate_xi_and_y_and_phi (sudakov, r)
	import
	class(sudakov_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_generate_xi_and_y_and_phi
	end interface

	@ %def sudakov_generate_xi_and_y_and_phi
	@ Generating $\phi$ can be performed in a generic way for all UBF types.
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: generate_phi => sudakov_generate_phi
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_generate_phi (sudakov, r)
	class(sudakov_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_generate_phi
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_generate_phi (sudakov, r)
	class(sudakov_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	call sudakov%rng%generate (sudakov%random)
	r%phi = sudakov%random * twopi
	end subroutine sudakov_generate_phi

	@ %def sudakov_generate_phi
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_kt2), deferred :: kt2
	<<POWHEG matching: interfaces>>=
	abstract interface
	function sudakov_kt2 (sudakov, xi, y) result (kt2)
	import
	real(default) :: kt2
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	end function sudakov_kt2
	end interface

	@ %def sudakov_kt2
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_kt2_max), deferred :: kt2_max
	<<POWHEG matching: interfaces>>=
	abstract interface
	pure function sudakov_kt2_max (sudakov) result (kt2_max)
	import
	real(default) :: kt2_max
	class(sudakov_t), intent(in) :: sudakov
	end function sudakov_kt2_max
	end interface

	@ %def sudakov_kt2_max
	@ Veto routine for an overestimation of the UBF
	performed to simplify the log integrated UBF
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_reweight_ubf), deferred :: reweight_ubf
	<<POWHEG matching: interfaces>>=
	abstract interface
	function sudakov_reweight_ubf (sudakov, pt2) result (accepted)
	import
	logical :: accepted
	class(sudakov_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	end function sudakov_reweight_ubf
	end interface

	@ %def sudakov_reweight_ubf
	@ Veto routine to correct for an overestimation of $\xi_\text{max}$
	performed in the case of massive emitters.
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_reweight_xi_max), deferred :: reweight_xi_max
	<<POWHEG matching: interfaces>>=
	abstract interface
	function sudakov_reweight_xi_max (sudakov, xi) result (accepted)
	import
	logical :: accepted
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	end function sudakov_reweight_xi_max
	end interface

	@ %def sudakov_reweight_xi_max
	@ In the generation of $p_T^2$ via [[log_integrated_ubf]], we use the
	simplified version $\alpha_s^\text{rad}$ while the grids take the
	improved version.
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: alpha_s => sudakov_alpha_s
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_alpha_s (sudakov, kT2, use_correct, improve_nll) result (a)
	real(default) :: a
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: kT2
	logical, intent(in), optional :: use_correct, improve_nll
	end function sudakov_alpha_s
	<<POWHEG matching: procedures>>=
	module function sudakov_alpha_s (sudakov, kT2, use_correct, improve_nll) result (a)
	real(default) :: a
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: kT2
	logical, intent(in), optional :: use_correct, improve_nll
	logical :: correct, nll
	correct = .false.; if (present (use_correct)) correct = use_correct
	nll = .true.; if (present(improve_nll)) nll = improve_nll
	if (correct) then
	a = get_alpha_s (sudakov%qcd, kT2, improve_nll_opt=nll)
	else
	a = sudakov%alpha_s_rad (kT2)
	end if
	end function sudakov_alpha_s

	@ %def sudakov_alpha_s
	@ To generate the transverse momentum, we have to solve the equation
	\begin{equation*}
	\frac{\Delta^{(U)}(p_T)}{\Delta^{(U)}(p_T^{\mathrm{max}})} = r_1
	\end{equation*}
	iteratively for $p_T$.
	In log space and with initially $\Delta^{(U)}(p_T^{\mathrm{max}}) = 1$, this is
	\begin{equation*}
	\log\Delta^{(U)}(p_T) = \log r_1
	\end{equation*}
	If no solution is found, we set $p_T = p_T^{\mathrm{min}}$ to exit the event
	generation loop and generate an emissionless event.
	If a solution is found but the current emission is not accepted,
	we set $p_T = p_T^{\mathrm{max}}$ and thus
	in the next step it is $\Delta^{(U)}(p_T^{\mathrm{max}}) = r_1$,
	so that we have to solve the equation
	\begin{equation*}
	\log\Delta^{(U)}(p_T) = \log r_1 + \log r_2
	\end{equation*}
	using another random number $r_2$. We use [[sum_log_rands]] to remember
	the sum of the logarithms of all previous random numbers used for this event.
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: generate_pt2 => sudakov_generate_pt2
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_generate_pt2 (sudakov) result (pt2)
	real(default) :: pt2
	class(sudakov_t), intent(inout) :: sudakov
	end function sudakov_generate_pt2
	<<POWHEG matching: procedures>>=
	module function sudakov_generate_pt2 (sudakov) result (pt2)
	real(default) :: pt2
	class(sudakov_t), intent(inout) :: sudakov
	logical :: success
	success = .false.
	if (sudakov%current_pt2_max > sudakov%powheg_settings%pt2_min) then
	call sudakov%rng%generate (sudakov%random)
	sudakov%sum_log_rands = sudakov%sum_log_rands + log(sudakov%random)
	pt2 = solve_interval (sudakov, &
	sudakov%powheg_settings%pt2_min, &
	sudakov%current_pt2_max, success, &
	0.001_default)
	end if
	if (.not. success) then
	pt2 = sudakov%powheg_settings%pt2_min
	end if
	end function sudakov_generate_pt2

	@ %def sudakov_generate_pt2
	@ This could be activated [[if (debug_active (MATCHING))]].
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: check_solution_interval => sudakov_check_solution_interval
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_check_solution_interval (sudakov)
	class(sudakov_t), intent(inout) :: sudakov
	end subroutine sudakov_check_solution_interval
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_check_solution_interval (sudakov)
	class(sudakov_t), intent(inout) :: sudakov
	real(default) :: r
	real(default), parameter :: dr = 0.05
	real(default) :: pt2
	logical :: success
	r = 0._default
	do
	r = r + dr
	sudakov%random = r
	pt2 = solve_interval (sudakov, &
	sudakov%powheg_settings%pt2_min, &
	sudakov%current_pt2_max, success, &
	0.001_default)
	if (success) then
	print *, 'r: ', r, ' zero found'
	else
	print *, 'r: ', r, 'no zero found'
	end if
	if (r >= 1._default) exit
	end do
	end subroutine sudakov_check_solution_interval

	@ %def sudakov_check_solution_interval
	@ Generates the FKS variables $(\xi, y,\phi)$ and sets the emission hardness scale.
	In debug mode, we assert that the [[pt2]] saved in the [[radiation_t]]
	and the massive hardness scale are equal.
	This should hold as we compute [[kt2]] with the [[y]] we got from generating
	[[pt2]] so that this is a full circle.
	It then initiates the generation of the transverse momentum followed by
	a sequence of veto steps to get the correct distribution.
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: generate_emission => sudakov_generate_emission
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_generate_emission (sudakov, r, r_max)
	class(sudakov_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	type(radiation_t), intent(in) :: r_max
	end subroutine sudakov_generate_emission
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_generate_emission (sudakov, r, r_max)
	class(sudakov_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	type(radiation_t), intent(in) :: r_max
	logical :: accepted
	sudakov%current_pt2_max = r%pt2
	if (debug_on) call msg_debug2 (D_MATCHING, "sudakov_generate_emission")
	if (debug_on) call msg_debug2 (D_MATCHING, "sqrt (sudakov%current_pt2_max)", &
	sqrt (sudakov%current_pt2_max))
	if (debug_on) call msg_debug2 (D_MATCHING, "sudakov%sum_log_rands", sudakov%sum_log_rands)
	LOOP_UNTIL_ACCEPTED: do
	if (signal_is_pending ()) return
	r%valid = .false.
	r%pt2 = sudakov%generate_pt2 ()
	if (debug_on) call msg_debug2 (D_MATCHING, "sudakov_generate_emission: after generate_pt2")
	if (debug_on) call msg_debug2 (D_MATCHING, "sqrt (r%pt2)", sqrt (r%pt2))
	if (debug_on) call msg_debug2 (D_MATCHING, "sudakov%sum_log_rands", sudakov%sum_log_rands)
	if (r%pt2 <= sudakov%powheg_settings%pt2_min .or. r%pt2 <= r_max%pt2) then
	exit
	end if
	accepted = sudakov%reweight_ubf (r%pt2)
	call sudakov%veto_counter%record_ubf (.not. accepted)
	if (.not. accepted) then
	sudakov%current_pt2_max = r%pt2
	cycle
	end if
	call sudakov%generate_xi_and_y_and_phi (r)
	accepted = sudakov%reweight_xi_max (r%xi)
	call sudakov%veto_counter%record_xi_max (.not. accepted)
	if (.not. accepted) then
	sudakov%current_pt2_max = r%pt2
	cycle
	end if
	if (debug_active (D_MATCHING)) then
	call assert_equal (OUTPUT_UNIT, r%pt2, &
	sudakov%kt2 (r%xi, r%y), &
	"sudakov_generate_xi_and_y_and_phi: pt2 inconsistency")
	end if
	r%valid = .true.
	exit
	end do LOOP_UNTIL_ACCEPTED
	end subroutine sudakov_generate_emission

	@ %def sudakov_generate_emission
	@ Evaluates the Sudakov as needed for [[solve_interval]] to generate a $p_T$ value.
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: evaluate => sudakov_evaluate
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_evaluate (solver_f, x) result (f)
	complex(default) :: f
	class(sudakov_t), intent(in) :: solver_f
	real(default), intent(in) :: x
	end function sudakov_evaluate
	<<POWHEG matching: procedures>>=
	module function sudakov_evaluate (solver_f, x) result (f)
	complex(default) :: f
	class(sudakov_t), intent(in) :: solver_f
	real(default), intent(in) :: x
	f = solver_f%sum_log_rands + &
	solver_f%norm_max * solver_f%log_integrated_ubf (x)
	end function sudakov_evaluate

	@ %def sudakov_evaluate
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: associated_emitter => sudakov_associated_emitter
	<<POWHEG matching: sub interfaces>>=
	elemental module function sudakov_associated_emitter &
	(sudakov) result (emitter)
	integer :: emitter
	class(sudakov_t), intent(in) :: sudakov
	end function sudakov_associated_emitter
	<<POWHEG matching: procedures>>=
	elemental module function sudakov_associated_emitter &
	(sudakov) result (emitter)
	integer :: emitter
	class(sudakov_t), intent(in) :: sudakov
	emitter = sudakov%process_deps%phs_identifiers(sudakov%i_phs)%emitter
	end function sudakov_associated_emitter

	@ %def sudakov_associated_emitter
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: set_i_phs => sudakov_set_i_phs
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_set_i_phs (sudakov, alr)
	class(sudakov_t), intent(inout) :: sudakov
	integer, intent(in) :: alr
	end subroutine sudakov_set_i_phs
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_set_i_phs (sudakov, alr)
	class(sudakov_t), intent(inout) :: sudakov
	integer, intent(in) :: alr
	sudakov%i_phs = sudakov%process_deps%alr_to_i_phs(alr)
	end subroutine sudakov_set_i_phs

	@ %def sudakov_set_i_phs
	@
	\subsubsection{Simple FSR}
	This corresponds to Appendix C of [[1002.2581]].
	<<POWHEG matching: public>>=
	public :: sudakov_simple_fsr_t
	<<POWHEG matching: types>>=
	type, extends (sudakov_t) :: sudakov_simple_fsr_t
	contains
	<<POWHEG matching: sudakov simple fsr: TBP>>
	end type sudakov_simple_fsr_t

	@ %def sudakov_simple_fsr_t
	@ The simplest upper bounding function for final-state radiation is
	\begin{equation}
	\mathtt{upper\_bound\_func} = \frac {U(\xi,y)} N
	= \frac {\alpha_s}{\xi (1-y)}
	\end{equation}
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: upper_bound_func => sudakov_simple_fsr_upper_bound_func
	<<POWHEG matching: sub interfaces>>=
	pure module function sudakov_simple_fsr_upper_bound_func &
	(sudakov, xi, y, alpha_s) result (u)
	real(default) :: u
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	end function sudakov_simple_fsr_upper_bound_func
	<<POWHEG matching: procedures>>=
	pure module function sudakov_simple_fsr_upper_bound_func &
	(sudakov, xi, y, alpha_s) result (u)
	real(default) :: u
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	u = alpha_s / (xi * (1 - y))
	end function sudakov_simple_fsr_upper_bound_func

	@ %def sudakov_simple_fsr_upper_bound_func
	@ The above upper bounding function corresponds to the transverse momentum scale
	\begin{equation}
	k_T^2 = \frac{s}{2} \xi^2 (1-y).
	\end{equation}
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: kt2 => sudakov_simple_fsr_kt2
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_simple_fsr_kt2 (sudakov, xi, y) result (kt2)
	real(default) :: kt2
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	end function sudakov_simple_fsr_kt2
	<<POWHEG matching: procedures>>=
	module function sudakov_simple_fsr_kt2 (sudakov, xi, y) result (kt2)
	real(default) :: kt2
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	kt2 = sudakov%phs_fks_generator%real_kinematics%kt2 &
	(sudakov%i_phs, sudakov%associated_emitter (), UBF_FSR_SIMPLE, xi, y)
	end function sudakov_simple_fsr_kt2

	@ %def sudakov_simple_fsr_kt2
	@ For massless emitters, the upper bound on the radiated energy is
	\begin{equation*}
	t_{\mathrm{max}} = \xi_{\mathrm{max}}^2 \hat{s}
	\end{equation*}
	We use this as largest possible scale for the radiation.
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: kt2_max => sudakov_simple_fsr_kt2_max
	<<POWHEG matching: sub interfaces>>=
	pure module function sudakov_simple_fsr_kt2_max (sudakov) result (kt2_max)
	real(default) :: kt2_max
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	end function sudakov_simple_fsr_kt2_max
	<<POWHEG matching: procedures>>=
	pure module function sudakov_simple_fsr_kt2_max (sudakov) result (kt2_max)
	real(default) :: kt2_max
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default) :: s_hat
	s_hat = sudakov%event_deps%s_hat
	kt2_max = sudakov%xi2_max * s_hat
	end function sudakov_simple_fsr_kt2_max

	@ %def sudakov_simple_fsr_kt2_max
	@ This is
	\begin{equation}
	- \frac{\log{\Delta^{(U)}}(p_T)}{N} =
	\frac\pi{b_0} \theta\left(\xi_\text{max}^2-\frac{p_T^2}s\right)
	\left[\log{\frac{\xi^2_\text{max}s}{\Lambda^2}}
	\log{\frac{\log{{\xi^2_\text{max}s}/{\Lambda^2}}}
	{\log{p_T^2/\Lambda^2}}} -
	\log{\frac{\xi^2_\text{max}s}{p_T^2}}\right]
	\end{equation}
	with $p_\text{T,max}^2=\xi_\text{max}^2 s$.
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: log_integrated_ubf => sudakov_simple_fsr_log_integrated_ubf
	<<POWHEG matching: sub interfaces>>=
	pure module function sudakov_simple_fsr_log_integrated_ubf &
	(sudakov, pt2) result (log_sudakov)
	real(default) :: log_sudakov
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	end function sudakov_simple_fsr_log_integrated_ubf
	<<POWHEG matching: procedures>>=
	pure module function sudakov_simple_fsr_log_integrated_ubf &
	(sudakov, pt2) result (log_sudakov)
	real(default) :: log_sudakov
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	real(default) :: kt2_max, kt2_maxl, pt2l
	logical :: within_boundaries
	within_boundaries = pt2 <= sudakov%kt2_max () &
	.and. pt2 >= sudakov%powheg_settings%pt2_min
	if (within_boundaries) then
	kt2_max = sudakov%kt2_max ()
	kt2_maxl = kt2_max / sudakov%process_deps%lambda2_gen
	pt2l = pt2 / sudakov%process_deps%lambda2_gen
	log_sudakov = pi / b0rad () * (log (kt2_maxl) * &
	log (log (kt2_maxl) / log (pt2l)) - &
	log (kt2_max / pt2))
	else
	log_sudakov = 0
	end if
	end function sudakov_simple_fsr_log_integrated_ubf

	@ %def sudakov_simple_fsr_log_integrated_ubf
	@ For this upper bounding function, we just overestimated $\alpha_s$.
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: reweight_ubf => sudakov_simple_fsr_reweight_ubf
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_simple_fsr_reweight_ubf &
	(sudakov, pt2) result (accepted)
	logical :: accepted
	class(sudakov_simple_fsr_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	real(default) :: alpha_s_true, alpha_s_rad
	logical :: alpha_s_equal
	end function sudakov_simple_fsr_reweight_ubf
	<<POWHEG matching: procedures>>=
	module function sudakov_simple_fsr_reweight_ubf &
	(sudakov, pt2) result (accepted)
	logical :: accepted
	class(sudakov_simple_fsr_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	real(default) :: alpha_s_true, alpha_s_rad
	logical :: alpha_s_equal
	if (debug_on) call msg_debug2 (D_MATCHING, "sudakov_simple_fsr_reweight_ubf")
	alpha_s_true = sudakov%alpha_s (pt2, use_correct = .true.)
	alpha_s_rad = sudakov%alpha_s (pt2, use_correct = .false.)
	call sudakov%rng%generate (sudakov%random)
	alpha_s_equal = nearly_equal (alpha_s_true, alpha_s_rad)
	accepted = alpha_s_equal .or. sudakov%random < alpha_s_true / alpha_s_rad
	if (debug2_active (D_MATCHING)) then
	print *, ' sqrt(pt2) = ', sqrt(pt2)
	print *, ' alpha_s_true = ', alpha_s_true
	print *, ' sudakov%process_deps%lambda2_gen = ', &
	sudakov%process_deps%lambda2_gen
	print *, ' alpha_s_rad = ', alpha_s_rad
	print *, ' sudakov%random = ', sudakov%random
	print *, ' accepted = ', accepted
	if (alpha_s_rad < alpha_s_true .and. .not. alpha_s_equal) then
	call msg_fatal ("sudakov_simple_fsr_reweight_ubf: &
	&This should never happen. &
	&Have you chosen a running alpha_s?")
	end if
	end if
	end function sudakov_simple_fsr_reweight_ubf

	@ %def sudakov_simple_fsr_reweight_ubf
	@
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: reweight_xi_max => sudakov_simple_fsr_reweight_xi_max
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_simple_fsr_reweight_xi_max &
	(sudakov, xi) result (accepted)
	logical :: accepted
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	end function sudakov_simple_fsr_reweight_xi_max
	<<POWHEG matching: procedures>>=
	module function sudakov_simple_fsr_reweight_xi_max &
	(sudakov, xi) result (accepted)
	logical :: accepted
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	accepted = .true.
	end function sudakov_simple_fsr_reweight_xi_max

	@ %def sudakov_simple_fsr_reweight_xi_max
	@ This depends on the choice of $p_T$ and is tested in the assertion.
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: generate_xi_and_y_and_phi => &
	sudakov_simple_fsr_generate_xi_and_y_and_phi
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_simple_fsr_generate_xi_and_y_and_phi (sudakov, r)
	class(sudakov_simple_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_simple_fsr_generate_xi_and_y_and_phi
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_simple_fsr_generate_xi_and_y_and_phi (sudakov, r)
	class(sudakov_simple_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: s
	s = sudakov%event_deps%s_hat
	call sudakov%generate_xi (r)
	r%y = one - (two * r%pt2) / (s * r%xi**2)
	call sudakov%generate_phi (r)
	end subroutine sudakov_simple_fsr_generate_xi_and_y_and_phi

	@ %def sudakov_generate_xi_and_y_and_phi
	@ We generate $\xi \in [\frac{p_\text{T}}{\sqrt{s}}, \xi_\text{max}]$
	with a density $1 / \xi$ i.e. uniformly in $\log(\xi)$.
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: generate_xi => sudakov_simple_fsr_generate_xi
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_simple_fsr_generate_xi (sudakov, r)
	class(sudakov_simple_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_simple_fsr_generate_xi
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_simple_fsr_generate_xi (sudakov, r)
	class(sudakov_simple_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: s, xi2_max
	s = sudakov%event_deps%s_hat
	xi2_max = sudakov%xi2_max
	call sudakov%rng%generate (sudakov%random)
	r%xi = exp (((one - sudakov%random) * log (r%pt2 / s) + &
	sudakov%random * log (xi2_max)) / two)
	end subroutine sudakov_simple_fsr_generate_xi

	@ %def sudakov_simple_fsr_generate_xi
	@
	\subsubsection{Dijet production at lepton colliders}
	In the POWHEG method paper, $e^+e^-\to q\bar{q}$ requires a UBF different
	from the simple one to account for an additional divergence for $(\xi,y) \to (1,-1)$.
	<<POWHEG matching: public>>=
	public :: sudakov_eeqq_fsr_t
	<<POWHEG matching: types>>=
	type, extends (sudakov_t) :: sudakov_eeqq_fsr_t
	contains
	<<POWHEG matching: sudakov eeqq fsr: TBP>>
	end type sudakov_eeqq_fsr_t

	@ %def sudakov_eeqq_fsr_t
	@ This $k_T$ measure is the same as in the case for simple FSR up to
	$\mathcal{O}(\theta^4)$ when $y=\cos(\theta)$. It differs by just a factor
	of $2$ w.r.t. [[sudakov_simple_fsr_kt2]].
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: kt2 => sudakov_eeqq_fsr_kt2
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_eeqq_fsr_kt2 (sudakov, xi, y) result (kt2)
	real(default) :: kt2
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	end function sudakov_eeqq_fsr_kt2
	<<POWHEG matching: procedures>>=
	module function sudakov_eeqq_fsr_kt2 (sudakov, xi, y) result (kt2)
	real(default) :: kt2
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	kt2 = sudakov%phs_fks_generator%real_kinematics%kt2 &
	(sudakov%i_phs, sudakov%associated_emitter(), &
	UBF_FSR_MASSLESS_RECOIL, xi, y)
	end function sudakov_eeqq_fsr_kt2

	@ %def sudakov_eeqq_fsr_kt2
	@ For [[eeqq]], the shower starts at $k_\text{max} = \frac{q^0}{2}$.
	(c.f. eq. (7.86) in [0709.2092].)
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: kt2_max => sudakov_eeqq_fsr_kt2_max
	<<POWHEG matching: sub interfaces>>=
	pure module function sudakov_eeqq_fsr_kt2_max (sudakov) result (kt2_max)
	real(default) :: kt2_max
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	end function sudakov_eeqq_fsr_kt2_max
	<<POWHEG matching: procedures>>=
	pure module function sudakov_eeqq_fsr_kt2_max (sudakov) result (kt2_max)
	real(default) :: kt2_max
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	kt2_max = 0.25_default * sudakov%event_deps%s_hat
	end function sudakov_eeqq_fsr_kt2_max

	@ %def sudakov_eeqq_fsr_kt2_max
	@ This covers also the singularity at $(\xi,y)\to(1,-1)$ that occurs for
	a massless recoiling system.
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: upper_bound_func => sudakov_eeqq_fsr_upper_bound_func
	<<POWHEG matching: sub interfaces>>=
	pure module function sudakov_eeqq_fsr_upper_bound_func &
	(sudakov, xi, y, alpha_s) result (u)
	real(default) :: u
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	end function sudakov_eeqq_fsr_upper_bound_func
	<<POWHEG matching: procedures>>=
	pure module function sudakov_eeqq_fsr_upper_bound_func &
	(sudakov, xi, y, alpha_s) result (u)
	real(default) :: u
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	u = alpha_s / (xi * (1 - y**2))
	end function sudakov_eeqq_fsr_upper_bound_func

	@ %def sudakov_eeqq_fsr_upper_bound_func
	@ The logarithmic integrated UBF in the [[eeqq]] case as explained in
	[0709.2092], eq. (7.98), is given by
	\begin{align}
	-\frac{1}{N} \log\left[ \Delta^{U}(p_T) \right]
	&= 2 \pi \int_0^{k_\text{max}} \alpha_s(k_T)
	\log \left[ \frac{4k_\text{max}^2}{k_T^2} \right] \theta(k_T - p_T)
	\frac{dk_T}{k_T} \nonumber \\
	&= \frac{\pi}{b_0} \left( \log \left[ \frac{4k_\text{max}^2}{k_T^2} \right]
	\log \left[ \frac{\log(k_\text{max}^2/\Lambda^2)}{\log(p_T^2/\Lambda^2)} \right]
	- \log \left[ \frac{k_\text{max}^2}{p_T^2} \right] \right)
	\end{align}
	with $k_\text{max}=\frac{q^0}{2}$.
	We see that for these logarithms to be well defined, we need to set a lower bound
	for the transverse momentum $p_{T,\text{min}} > \Lambda =$ [[lambda2_gen]].
	% (PS 2021-05-05) Status: unvalidated
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: log_integrated_ubf => sudakov_eeqq_fsr_log_integrated_ubf
	<<POWHEG matching: sub interfaces>>=
	pure module function sudakov_eeqq_fsr_log_integrated_ubf &
	(sudakov, pt2) result (log_sudakov)
	real(default) :: log_sudakov
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	end function sudakov_eeqq_fsr_log_integrated_ubf
	<<POWHEG matching: procedures>>=
	pure module function sudakov_eeqq_fsr_log_integrated_ubf &
	(sudakov, pt2) result (log_sudakov)
	real(default) :: log_sudakov
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	real(default) :: kt2_max, Lambda2
	logical :: within_boundaries
	kt2_max = sudakov%kt2_max ()
	within_boundaries = pt2 >= sudakov%powheg_settings%pt2_min &
	.and. pt2 <= kt2_max
	if (within_boundaries) then
	Lambda2 = sudakov%process_deps%lambda2_gen
	log_sudakov = pi / b0rad () * ( log (4 * kt2_max / Lambda2) * &
	log (log (kt2_max/Lambda2) / log (pt2/Lambda2)) - log(kt2_max/pt2) )
	else
	log_sudakov = 0
	end if
	end function sudakov_eeqq_fsr_log_integrated_ubf

	@ %def sudakov_eeqq_fsr_log_integrated_ubf
	@ In order to arrive at the log integrated Sudakov
	implemented in [[sudakov_eeqq_fsr_log_integrated_ubf]], we overestimated
	\begin{equation}
	\log \left[ \frac{1 + \sqrt{1 - (k_T/k_\text{max})^2}}
	{1 - \sqrt{1 - (k_T/k_\text{max})^2}} \right]
	\leq \log \left[ \frac{4 k_\text{max}^2}{k_T^2} \right].
	\end{equation}
	We correct for this in this veto step.
	Additionally, we correct for overestimating $\alpha_s$.
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: reweight_ubf => sudakov_eeqq_fsr_reweight_ubf
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_eeqq_fsr_reweight_ubf &
	(sudakov, pt2) result (accepted)
	logical :: accepted
	class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	end function sudakov_eeqq_fsr_reweight_ubf
	<<POWHEG matching: procedures>>=
	module function sudakov_eeqq_fsr_reweight_ubf (sudakov, pt2) result (accepted)
	logical :: accepted
	class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	real(default) :: log_bound, k_max2
	real(default) :: alpha_s_true, alpha_s_rad
	alpha_s_true = sudakov%alpha_s (pt2, use_correct = .true.)
	alpha_s_rad = sudakov%alpha_s (pt2, use_correct = .false.)
	k_max2 = sudakov%kt2_max ()
	log_bound = log((1 + sqrt(1 - (pt2/k_max2))) &
	/ (1 - sqrt(1 - (pt2/k_max2))))
	call sudakov%rng%generate (sudakov%random)
	accepted = sudakov%random * log( 4 * k_max2 / pt2 ) * alpha_s_rad &
	<= log_bound * alpha_s_true
	if (debug2_active (D_MATCHING)) then
	print *, ' sqrt(pt2) = ', sqrt(pt2)
	print *, ' alpha_s_true = ', alpha_s_true
	print *, ' sudakov%process_deps%lambda2_gen = ', &
	sudakov%process_deps%lambda2_gen
	print *, ' alpha_s_rad = ', alpha_s_rad
	print *, ' sudakov%random = ', sudakov%random
	print *, ' accepted = ', accepted
	if (log( 4 * k_max2 / pt2 ) * alpha_s_rad < log_bound * alpha_s_true) then
	call msg_fatal ("sudakov_eeqq_fsr_reweight_ubf: &
	&This should never happen. &
	&Have you chosen a running alpha_s?")
	end if
	end if
	end function sudakov_eeqq_fsr_reweight_ubf

	@ %def sudakov_eeqq_fsr_reweight_ubf
	@ In the eeqq case, we did not overestimate $\xi$ with $\xi_\text{max}$.
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: reweight_xi_max => sudakov_eeqq_fsr_reweight_xi_max
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_eeqq_fsr_reweight_xi_max &
	(sudakov, xi) result (accepted)
	logical :: accepted
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	end function sudakov_eeqq_fsr_reweight_xi_max
	<<POWHEG matching: procedures>>=
	module function sudakov_eeqq_fsr_reweight_xi_max &
	(sudakov, xi) result (accepted)
	logical :: accepted
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	accepted = .true.
	end function sudakov_eeqq_fsr_reweight_xi_max

	@ %def sudakov_eeqq_fsr_reweight_xi_max
	@ In the eeqq case, we generate $y$ from a random number and afterwards compute
	$\xi(p_T,y)$ so the sequence is reversed in comparison to the simple case.
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: generate_xi_and_y_and_phi => &
	sudakov_eeqq_fsr_generate_xi_and_y_and_phi
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_eeqq_fsr_generate_xi_and_y_and_phi (sudakov, r)
	class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_eeqq_fsr_generate_xi_and_y_and_phi
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_eeqq_fsr_generate_xi_and_y_and_phi (sudakov, r)
	class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	call sudakov%generate_y (r)
	call sudakov%generate_xi (r)
	call sudakov%generate_phi (r)
	end subroutine sudakov_eeqq_fsr_generate_xi_and_y_and_phi

	@ %def sudakov_eeqq_fsr_generate_xi_and_y_and_phi
	@ To generate $y$ for the [[eeqq]] UBF, we take a random number
	\begin{equation}
	-\log \left[ \frac{1 + \sqrt{1 - (p_T / k_\text{max})^2 }}
	{1 - \sqrt{1 - (p_T / k_\text{max})^2 }} \right]
	< r_y <
	\log \left[ \frac{1 + \sqrt{1 - (p_T / k_\text{max})^2 }}
	{1 - \sqrt{1 - (p_T / k_\text{max})^2 }} \right]
	\end{equation}
	and then compute
	\begin{equation}
	y(r_y) = \frac{e^{r_y} - 1}{e^{r_y} + 1}
	\end{equation}
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: generate_y => sudakov_eeqq_fsr_generate_y
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_eeqq_fsr_generate_y (sudakov, r)
	class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_eeqq_fsr_generate_y
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_eeqq_fsr_generate_y (sudakov, r)
	class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: k_max2, log_bound, r_y
	k_max2 = sudakov%kt2_max ()
	call sudakov%rng%generate (sudakov%random)
	log_bound = log((1 + sqrt(1 - (r%pt2/k_max2))) &
	/ (1 - sqrt(1 - (r%pt2/k_max2))))
	r_y = -log_bound + sudakov%random * (two * log_bound)
	r%y = (exp(r_y) - 1) / (exp(r_y) + 1)
	end subroutine sudakov_eeqq_fsr_generate_y

	@ %def sudakov_eeqq_fsr_generate_y
	@ We generate $\xi$ for the [[eeqq]] UBF according to
	\begin{equation}
	\xi(p_T, y) = \frac{2 p_T}{\sqrt{s} \sqrt{1-y^2}}
	\end{equation}
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: generate_xi => sudakov_eeqq_fsr_generate_xi
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_eeqq_fsr_generate_xi (sudakov, r)
	class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_eeqq_fsr_generate_xi
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_eeqq_fsr_generate_xi (sudakov, r)
	class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: q0
	q0 = sqrt(sudakov%event_deps%s_hat)
	r%xi = (2 * sqrt(r%pt2)) / (q0 * sqrt(1 - r%y**2))
	end subroutine sudakov_eeqq_fsr_generate_xi

	@ %def sudakov_eeqq_fsr_generate_xi
	@
	\subsubsection{Massive FSR}
	<<POWHEG matching: public>>=
	public :: sudakov_massive_fsr_t
	<<POWHEG matching: types>>=
	type, extends (sudakov_t) :: sudakov_massive_fsr_t
	real(default) :: z, z1, z2 = 0._default
	real(default) :: xi_1, xi_min, xi_m = 0._default
	real(default) :: xi_max_extended = 1._default
	contains
	<<POWHEG matching: sudakov massive fsr: TBP>>
	end type sudakov_massive_fsr_t

	@ %def sudakov_massive_fsr_t
	@ According to eq. A.42 [[1202.0465]], during the radiation generation,
	an alternative expression for $\xi_{\mathrm{max}}$,
	\begin{equation*}
	\xi_{\mathrm{max}} = 1 - \frac{(m+m_{\mathrm{rec}})^2}{q^2},
	\end{equation*}
	is used, which corresponds to an extended Dalitz region.
	Phase space points outside of the original Dalitz region
	will be vetoed afterwards in [[sudakov_massive_fsr_reweight_xi_max]].
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: compute_xi_max_extended &
	=> sudakov_massive_fsr_compute_xi_max_extended
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_massive_fsr_compute_xi_max_extended &
	- (sudakov, i_phs)
	+ (sudakov)
	class(sudakov_massive_fsr_t), intent(inout) :: sudakov
	- integer, intent(in) :: i_phs
	end subroutine sudakov_massive_fsr_compute_xi_max_extended
	<<POWHEG matching: procedures>>=
	- module subroutine sudakov_massive_fsr_compute_xi_max_extended (sudakov, i_phs)
	+ module subroutine sudakov_massive_fsr_compute_xi_max_extended (sudakov)
	class(sudakov_massive_fsr_t), intent(inout) :: sudakov
	- integer, intent(in) :: i_phs
	real(default) :: m, mrec
	real(default) :: q0
	type(vector4_t) :: p
	q0 = sqrt(sudakov%event_deps%s_hat)
	p = sudakov%event_deps%p_born_lab%get_momentum &
	(1, sudakov%associated_emitter())
	m = p**1
	mrec = sqrt ((q0 - p%p(0))2 - p%p(1)2 - p%p(2)2 - p%p(3)2)
	sudakov%xi_max_extended = one - (m + mrec)2 / q02
	end subroutine sudakov_massive_fsr_compute_xi_max_extended

	@ %def sudakov_massive_fsr_compute_xi_max_extended
	@ As described in [[1202.0465]], App. A.5., for massive emitters,
	the radiation variable $\xi$ is constructed as follows. First,
	\begin{equation}
	\xi_{\mathrm{min}}(K_T^2)
	= \frac{\sqrt{K_T^2 \left(K_T^2z_2^2 + 8\bar{p}^0q(1-z_2)\right)} - K_T^2z_2}{2q^2(1-z_2)}
	\end{equation}
	is computed where $K_T$ is a hardness scale for the radiation that determines the
	upper limit of the integral for the Sudakov form factor and coincides with the
	usual one, i.e. the transverse momentum of the radiated particle, in the massless limit.
	Then $\xi_1$ is computed according to the same equation with $z_2 \leftrightarrow z_1$.
	Finally, $\xi$ is generated according to
	\begin{equation}
	\xi = \frac{1}{q^2}\left(\exp\left[\log\left(\xi_{\rm{min}}q^2-K_T^2\right)
	+ r\log\frac{\xi_m q^2 - K_T^2}{\xi_{\rm{min}}q^2-K_T^2}\right] + K_T^2\right),
	\end{equation}
	where $\xi_m = \rm{min}\left(\xi_{\rm{max}}, \xi_1\right)$.
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: generate_xi => sudakov_massive_fsr_generate_xi
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_massive_fsr_generate_xi (sudakov, r)
	class(sudakov_massive_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_massive_fsr_generate_xi
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_massive_fsr_generate_xi (sudakov, r)
	class(sudakov_massive_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: pt2, q0, q02
	real(default) :: E_em, xi_max_ext
	real(default) :: xi_1, xi_min, xi_m
	pt2 = r%pt2
	E_em = sudakov%event_deps%p_born_lab%get_energy &
	(1, sudakov%associated_emitter())
	q02 = sudakov%event_deps%s_hat; q0 = sqrt(q02)
	xi_max_ext = sudakov%xi_max_extended
	associate (z1 => sudakov%z1, z2 => sudakov%z2)
	xi_1 = (sqrt(pt2 * (pt2 * z1*2 + 8 E_em * q0 * (one - z1))) - pt2 * z1) / &
	(two * q02 * (one - z1))
	xi_min = (sqrt(pt2 * (pt2 * z2*2 + 8 E_em * q0 * (one - z2))) - pt2 * z2) / &
	(two * q02 * (one - z2))
	end associate
	xi_m = min (xi_max_ext, xi_1)
	call sudakov%rng%generate (sudakov%random)
	r%xi = (exp (log(xi_min * q02 - pt2) + sudakov%random * &
	log((xi_m * q02 - pt2) / (xi_min * q02 - pt2))) + pt2) / q02
	end subroutine sudakov_massive_fsr_generate_xi

	@ %def sudakov_massive_fsr_generate_xi
	@ Generates the FKS variables in the case of a massive emitter and
	additionally computes $z$ and $z_{1/2}$ as well as $\xi_\text{max}$
	to be stored in the Sudakov for later use when reweighting [[xi_max]]
	and retrieving the norm from the POWHEG grid.
	The corresponding derivations can be found in [[1202.0465]], App. A.
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: generate_xi_and_y_and_phi => &
	sudakov_massive_fsr_generate_xi_and_y_and_phi
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_massive_fsr_generate_xi_and_y_and_phi (sudakov, r)
	class(sudakov_massive_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_massive_fsr_generate_xi_and_y_and_phi
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_massive_fsr_generate_xi_and_y_and_phi (sudakov, r)
	class(sudakov_massive_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: q0
	real(default) :: m2, mrec2, k0_rec_max
	real(default) :: E_em
	type(vector4_t) :: p_emitter

	q0 = sqrt (sudakov%event_deps%s_hat)
	p_emitter = sudakov%event_deps%p_born_lab%get_momentum &
	(1, sudakov%associated_emitter())
	associate (p => p_emitter%p)
	mrec2 = (q0 - p(0))2 - p(1)2 - p(2)2 - p(3)2
	E_em = p(0)
	end associate
	m2 = p_emitter**2
	call compute_dalitz_bounds (q0, m2, mrec2, sudakov%z1, sudakov%z2, k0_rec_max)
	call sudakov%generate_xi (r)

	sudakov%z = (two * r%pt2 * E_em - r%xi*2 q0**3) / &
	(r%pt2 * r%xi * q0 - r%xi*2 q0**3)
	sudakov%xi2_max = - (q0*2 sudakov%z*2 - two q0 * k0_rec_max * sudakov%z + mrec2) / &
	(q0*2 sudakov%z * (one - sudakov%z))
	sudakov%xi2_max = sudakov%xi2_max**2
	r%y = two * (sudakov%z2 - sudakov%z) / (sudakov%z2 - sudakov%z1) - one
	call sudakov%generate_phi (r)
	end subroutine sudakov_massive_fsr_generate_xi_and_y_and_phi

	@ %def sudakov_massive_fsr_generate_xi_and_y_and_phi
	@ Computes the hardness scale as discussed in [[1202.0465]], App. A.2.
	\begin{equation}
	K_T^2 = \frac{\xi^2q^3 (1-z)}{2\bar{p}_{\rm{em}}^0 - z\xi q}
	\label{eq:HardnessMassiveFSR}
	\end{equation}
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: kt2 => sudakov_massive_fsr_kt2
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_massive_fsr_kt2 (sudakov, xi, y) result (kt2)
	real(default) :: kt2
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	end function sudakov_massive_fsr_kt2
	<<POWHEG matching: procedures>>=
	module function sudakov_massive_fsr_kt2 (sudakov, xi, y) result (kt2)
	real(default) :: kt2
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	kt2 = sudakov%phs_fks_generator%real_kinematics%kt2 &
	(sudakov%i_phs, sudakov%associated_emitter(), UBF_FSR_MASSIVE, xi, y)
	end function sudakov_massive_fsr_kt2

	@ %def sudakov_massive_fsr_kt2
	@ For massive emitters, the upper bound on the radiated $p_T$ is
	\begin{equation*}
	t_{\mathrm{max}} = \frac{\xi_{\mathrm{max}}^2q^3(1-z_2)}{2 \cdot \bar{p}^0 - z_2\xi_{\mathrm{max}}q}
	\end{equation*}
	For this, we have to compute $z_2$ from the Dalitz bounds as [[sudakov%z2]]
	has not yet been set for the current event.
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: kt2_max => sudakov_massive_fsr_kt2_max
	<<POWHEG matching: sub interfaces>>=
	pure module function sudakov_massive_fsr_kt2_max (sudakov) result (kt2_max)
	real(default) :: kt2_max
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	end function sudakov_massive_fsr_kt2_max
	<<POWHEG matching: procedures>>=
	pure module function sudakov_massive_fsr_kt2_max (sudakov) result (kt2_max)
	real(default) :: kt2_max
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default) :: q0, E_em, xi_max, z1, z2, m2, mrec2, k0_rec_max
	type(vector4_t) :: p_emitter
	q0 = sqrt(sudakov%event_deps%s_hat)
	p_emitter = sudakov%event_deps%p_born_lab%get_momentum &
	(1, sudakov%associated_emitter())
	associate (p => p_emitter%p)
	mrec2 = (q0 - p(0))2 - p(1)2 - p(2)2 - p(3)2
	E_em = p(0)
	end associate
	m2 = p_emitter**2
	call compute_dalitz_bounds (q0, m2, mrec2, z1, z2, k0_rec_max)
	xi_max = sudakov%xi_max_extended
	kt2_max = (xi_max*2 q0*3 (one - z2)) / (two * E_em - z2 * xi_max * q0)
	end function sudakov_massive_fsr_kt2_max

	@ %def sudakov_massive_fsr_kt2_max
	@ The upper bounding function for massive emitters according to Eq. A.56 in [1202.0465]
	(disregarding a possible factor of $\alpha_s$) is
	\begin{equation}
	U(\xi, y) \sim \frac{\sqrt{s}}{\bar{p}_{\rm{em}}} \frac{1}{\xi(1-z)}
	\label{eq:UBFMassiveFSR}
	\end{equation}
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: upper_bound_func => sudakov_massive_fsr_upper_bound_func
	<<POWHEG matching: sub interfaces>>=
	pure module function sudakov_massive_fsr_upper_bound_func &
	(sudakov, xi, y, alpha_s) result (u)
	real(default) :: u
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	end function sudakov_massive_fsr_upper_bound_func
	<<POWHEG matching: procedures>>=
	pure module function sudakov_massive_fsr_upper_bound_func &
	(sudakov, xi, y, alpha_s) result (u)
	real(default) :: u
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	real(default) :: q, p_em
	q = sqrt (sudakov%event_deps%s_hat)
	p_em = space_part_norm &
	(sudakov%event_deps%p_born_lab%get_momentum (1, &
	sudakov%associated_emitter()))
	u = alpha_s * q / p_em * one / (xi * (one - sudakov%z))
	end function sudakov_massive_fsr_upper_bound_func

	@ %def sudakov_massive_fsr_upper_bound_func
	@ The integrated upper-bounding function for massive final-state emitters is given by
	\begin{align*}
	I(t) &= \frac{q}{\bar{p}_{\rm{em}}}\left[\log\xi\log\left[(1-z_2)\frac{q}{k_T^2}\right] +
	\frac{1}{2} \log^2\xi + G(-k_T^2,q^2,\xi) - G(2\bar{p}_{\rm{em}},-q,\xi)\right]
	^{\rm{min}(\xi_1(k_T^2),\xi_{\rm{max}})}_{\xi_{\rm{min}}} \\
	&+ \frac{q}{\bar{p}_{\rm{em}}} \theta (\xi_{\rm{max}} - \xi_1(k_T^2))
	\log\frac{\xi_{\rm{max}}}{\xi_1(k_T^2)}\log\frac{1-z_2}{1-z_1},
	\end{align*}
	where the function $G(a,b,\xi)$ is given by
	\begin{equation}
	G(a,b,\xi) = \log(a+b\xi)\log\left(1-\frac{a+b\xi}{a}\right) + Li_2\left(\frac{a+b\xi}{a}\right),
	\label{GMinusMassiveFSR}
	\end{equation}
	for $a < 0$ and by
	\begin{equation}
	G(a,b,\xi) = \log\left\|\frac{b\xi}{a}\right\|\log a - Li_2\left(-\frac{b\xi}{a}\right) + \frac{\pi^2}{6},
	\label{GPlusMassiveFSR}
	\end{equation}
	for $a > 0$.
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: log_integrated_ubf => sudakov_massive_fsr_log_integrated_ubf
	<<POWHEG matching: sub interfaces>>=
	pure module function sudakov_massive_fsr_log_integrated_ubf &
	(sudakov, pt2) result (log_sudakov)
	real(default) :: log_sudakov
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	end function sudakov_massive_fsr_log_integrated_ubf
	<<POWHEG matching: procedures>>=
	pure module function sudakov_massive_fsr_log_integrated_ubf &
	(sudakov, pt2) result (log_sudakov)
	real(default) :: log_sudakov
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	real(default) :: xi, xi_max, xi_1, xi_min
	real(default) :: q0, p_em, E_em, m2, mrec2, k0_rec_max
	type(vector4_t) :: p_emitter
	real(default) :: log_sudakov_up, log_sudakov_down, z1, z2
	logical :: within_boundaries
	within_boundaries = pt2 >= sudakov%powheg_settings%pt2_min &
	.and. pt2 <= sudakov%kt2_max ()
	if (within_boundaries) then
	q0 = sqrt (sudakov%event_deps%s_hat)
	p_emitter = sudakov%event_deps%p_born_lab%get_momentum &
	(1, sudakov%associated_emitter())
	associate (p => p_emitter%p)
	mrec2 = (q0 - p(0))2 - p(1)2 - p(2)2 - p(3)2
	E_em = p(0)
	end associate
	m2 = p_emitter**2
	call compute_dalitz_bounds (q0, m2, mrec2, z1, z2, k0_rec_max)
	p_em = space_part_norm (p_emitter)
	xi_max = sudakov%xi_max_extended
	xi_1 = (sqrt (pt2 * (pt2 * z1*2 + 8 E_em * q0 * (one - z1))) - pt2 * z1) / &
	(two * q0*2 (one - z1))
	xi_min = (sqrt (pt2 * (pt2 * z2*2 + 8 E_em * q0 * (one - z2))) - pt2 * z2) / &
	(two * q0*2 (one - z2))
	xi = min (xi_1, xi_max)
	log_sudakov_up = log(xi) * log((one - z2) * q0 / pt2) + log(xi)**2 / two + &
	G_FSR(-pt2, q0*2, xi) - G_FSR(two E_em, -q0, xi)
	xi = xi_min
	log_sudakov_down = log(xi) * log((one - z2) * q0 / pt2) + log(xi)**2/two + &
	G_FSR(-pt2, q0*2, xi) - G_FSR(two E_em, -q0, xi)
	log_sudakov = log_sudakov_up - log_sudakov_down
	if (xi_max > xi_1) &
	log_sudakov = log_sudakov + log(xi_max / xi_1) * log((one - z2) / (one - z1))
	log_sudakov = twopi * q0 / p_em * log_sudakov
	else
	log_sudakov = 0
	end if
	end function sudakov_massive_fsr_log_integrated_ubf

	@ %def sudakov_massive_fsr_log_integrated_ubf
	@ For this UBF, we just overestimated $\alpha_s$.
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: reweight_ubf => sudakov_massive_fsr_reweight_ubf
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_massive_fsr_reweight_ubf &
	(sudakov, pt2) result (accepted)
	logical :: accepted
	class(sudakov_massive_fsr_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	end function sudakov_massive_fsr_reweight_ubf
	<<POWHEG matching: procedures>>=
	module function sudakov_massive_fsr_reweight_ubf &
	(sudakov, pt2) result (accepted)
	logical :: accepted
	class(sudakov_massive_fsr_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	real(default) :: alpha_s_true, alpha_s_rad
	logical :: alpha_s_equal
	if (debug_on) call msg_debug2 (D_MATCHING, "sudakov_massive_fsr_reweight_ubf")
	alpha_s_true = sudakov%alpha_s (pt2, use_correct = .true.)
	alpha_s_rad = sudakov%alpha_s (pt2, use_correct = .false.)
	call sudakov%rng%generate (sudakov%random)
	alpha_s_equal = nearly_equal (alpha_s_true, alpha_s_rad)
	accepted = alpha_s_equal .or. sudakov%random < alpha_s_true / alpha_s_rad
	if (debug2_active (D_MATCHING)) then
	print *, ' sqrt(pt2) = ', sqrt(pt2)
	print *, ' alpha_s_true = ', alpha_s_true
	print *, ' sudakov%process_deps%lambda2_gen = ', &
	sudakov%process_deps%lambda2_gen
	print *, ' alpha_s_rad = ', alpha_s_rad
	print *, ' sudakov%random = ', sudakov%random
	print *, ' accepted = ', accepted
	if (alpha_s_rad < alpha_s_true .and. .not. alpha_s_equal) then
	call msg_fatal ("sudakov_massive_fsr_reweight_ubf: &
	&This should never happen. &
	&Have you chosen a running alpha_s?")
	end if
	end if
	end function sudakov_massive_fsr_reweight_ubf

	@ %def sudakov_massive_fsr_reweight_ubf
	@
	In the massive case, we generated $0 < \xi < $[[xi_max_extended]]
	and thus we need to veto values of $\xi$ larger than $\xi_{\mathrm{max}}$
	in this extra veto step.
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: reweight_xi_max => sudakov_massive_fsr_reweight_xi_max
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_massive_fsr_reweight_xi_max &
	(sudakov, xi) result (accepted)
	logical :: accepted
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	end function sudakov_massive_fsr_reweight_xi_max
	<<POWHEG matching: procedures>>=
	module function sudakov_massive_fsr_reweight_xi_max &
	(sudakov, xi) result (accepted)
	logical :: accepted
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	accepted = xi < sqrt (sudakov%xi2_max)
	end function sudakov_massive_fsr_reweight_xi_max

	@ %def sudakov_massive_fsr_reweight_xi_max
	@
	\subsubsection{Auxiliary functions}
	Implements the function $G(a,b,\xi)$ given in eq. (\ref{GPlusMassiveFSR})
	and eq. (\ref{GMinusMassiveFSR}). Cannot be evaluated for $a = 0$.
	<<POWHEG matching: procedures>>=
	elemental function G_FSR (a,b,xi)
	real(default) :: G_FSR
	real(default), intent(in) :: a, b, xi
	if (a > 0) then
	G_FSR = G_FSR_Plus (a,b,xi)
	else if (a < 0) then
	G_FSR = G_FSR_Minus (a,b,xi)
	end if
	end function G_FSR

	elemental function G_FSR_Minus (a,b,xi)
	real(default) :: G_FSR_Minus
	real(default), intent(in) :: a, b, xi
	G_FSR_Minus = log(a+bxi)log(one - (a+bxi)/a) + Li2((a+bxi)/a)
	end function G_FSR_Minus

	elemental function G_FSR_Plus (a,b,xi)
	real(default) :: G_FSR_Plus
	real(default), intent(in) :: a, b, xi
	G_FSR_Plus = log(abs(bxi/a))log(a) - Li2(-bxi/a) + pi*2/6
	end function G_FSR_Plus

	@ %def G_FSR, G_FSR_Minus, G_FSR_Plus
	@
	\subsubsection{ISR}
	This is the Sudakov for ISR. This corresponds to [[1002.2581]], App. D.
	The [[ubf_variant]] determines which [[log_integrated_ubf]] is used.
	<<POWHEG matching: public>>=
	public :: sudakov_isr_t
	<<POWHEG matching: types>>=
	type, extends (sudakov_t) :: sudakov_isr_t
	real(default) :: xi_max_extended = 1._default
	integer :: ubf_variant = 2
	contains
	<<POWHEG matching: sudakov isr: TBP>>
	end type sudakov_isr_t

	@ %def sudakov_isr_t
	@ This $k_T$ measure differs by a factor of $\frac{1}{1-\xi}$ w.r.t.
	[[sudakov_eeqq_fsr_kt2]] to account for
	$s_\text{born} = s_\text{real} * (1 - \xi)$.
	<<POWHEG matching: sudakov isr: TBP>>=
	procedure :: kt2 => sudakov_isr_kt2
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_isr_kt2 (sudakov, xi, y) result (kt2)
	real(default) :: kt2
	class(sudakov_isr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	end function sudakov_isr_kt2
	<<POWHEG matching: procedures>>=
	module function sudakov_isr_kt2 (sudakov, xi, y) result (kt2)
	real(default) :: kt2
	class(sudakov_isr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	kt2 = sudakov%phs_fks_generator%real_kinematics%kt2 &
	(sudakov%i_phs, sudakov%associated_emitter(), UBF_ISR, xi, y)
	end function sudakov_isr_kt2

	@ %def sudakov_isr_kt2
	@ The maximal transverse momentum is given by (D.4) in [1002.2581].
	<<POWHEG matching: sudakov isr: TBP>>=
	procedure :: kt2_max => sudakov_isr_kt2_max
	<<POWHEG matching: sub interfaces>>=
	pure module function sudakov_isr_kt2_max (sudakov) result (kt2_max)
	real(default) :: kt2_max
	class(sudakov_isr_t), intent(in) :: sudakov
	end function sudakov_isr_kt2_max
	<<POWHEG matching: procedures>>=
	pure module function sudakov_isr_kt2_max (sudakov) result (kt2_max)
	real(default) :: kt2_max
	class(sudakov_isr_t), intent(in) :: sudakov
	real(default) :: s_hat, xb_plus, xb_minus
	s_hat = sudakov%event_deps%s_hat
	xb_plus = sudakov%event_deps%x_born(I_PLUS)
	xb_minus = sudakov%event_deps%x_born(I_MINUS)
	kt2_max = s_hat * (1 - xb_plus*2) (1 - xb_minus**2) &
	/ (xb_plus + xb_minus)**2
	end function sudakov_isr_kt2_max

	@ %def sudakov_isr_kt2_max
	@ This covers the soft singularity for $\xi \to 0$ and the collinear
	singularities to both beam axes $y \to \pm 1$.
	<<POWHEG matching: sudakov isr: TBP>>=
	procedure :: upper_bound_func => sudakov_isr_upper_bound_func
	<<POWHEG matching: sub interfaces>>=
	pure module function sudakov_isr_upper_bound_func &
	(sudakov, xi, y, alpha_s) result (u)
	real(default) :: u
	class(sudakov_isr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	end function sudakov_isr_upper_bound_func
	<<POWHEG matching: procedures>>=
	pure module function sudakov_isr_upper_bound_func &
	(sudakov, xi, y, alpha_s) result (u)
	real(default) :: u
	class(sudakov_isr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	u = alpha_s / (xi * (1 - y**2))
	end function sudakov_isr_upper_bound_func

	@ %def sudakov_isr_upper_bound_func
	@ This is eq. (D.14) and (D.18) in [1002.2581]. It is similar to the eeqq case
	with the only difference beeing that the first log here includes both,
	$k^2_\text{T, max}$ and $s_b$ via $q^2$.
	<<POWHEG matching: sudakov isr: TBP>>=
	procedure :: log_integrated_ubf => sudakov_isr_log_integrated_ubf
	<<POWHEG matching: sub interfaces>>=
	pure module function sudakov_isr_log_integrated_ubf &
	(sudakov, pt2) result (log_sudakov)
	real(default) :: log_sudakov
	class(sudakov_isr_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	end function sudakov_isr_log_integrated_ubf
	<<POWHEG matching: procedures>>=
	pure module function sudakov_isr_log_integrated_ubf &
	(sudakov, pt2) result (log_sudakov)
	real(default) :: log_sudakov
	class(sudakov_isr_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	real(default) :: kt2_max, Lambda2, s_hat, q2
	logical :: within_boundaries
	kt2_max = sudakov%kt2_max ()
	s_hat = sudakov%event_deps%s_hat
	q2 = kt2_max + s_hat
	Lambda2 = sudakov%process_deps%lambda2_gen
	within_boundaries = pt2 >= sudakov%powheg_settings%pt2_min &
	.and. pt2 <= kt2_max
	if (within_boundaries) then
	if (sudakov%ubf_variant == 1) then
	log_sudakov = pi / b0rad () * ( log (q2/Lambda2) * &
	log (log (kt2_max/Lambda2) / log (pt2/Lambda2)) - log (kt2_max/pt2) )
	elseif (sudakov%ubf_variant == 2) then
	if (pt2 < s_hat) then
	if (s_hat < kt2_max) then
	log_sudakov = pi / b0rad () * &
	( log (two * s_hat / Lambda2) &
	* log (log (s_hat / Lambda2) / log (pt2 / Lambda2)) &
	- log (s_hat / pt2) &
	+ log (two) * log ( log (kt2_max / Lambda2) / log (s_hat / Lambda2) ))
	else
	log_sudakov = pi / b0rad () * &
	(log (two * s_hat / Lambda2) &
	* log (log (kt2_max / Lambda2) / log (pt2 / Lambda2)) &
	- log (kt2_max / pt2) )
	end if
	else
	log_sudakov = pi / b0rad () * &
	(log (two) * log (log (kt2_max / Lambda2) / log (pt2 / Lambda2)))
	end if
	end if
	else
	log_sudakov = 0
	end if
	end function sudakov_isr_log_integrated_ubf

	@ %def sudakov_isr_log_integrated_ubf
	@ In order to arrive at the log integrated Sudakov
	implemented in [[sudakov_isr_log_integrated_ubf]], we overestimated
	\begin{equation}
	\log \left[ \frac{\sqrt{x_+ - \rho} + \sqrt{x_- - \rho}}
	{\sqrt{x_+ - \rho} - \sqrt{x_- - \rho}} \right]
	\leq \log \left[ \frac{\sqrt{x_+} + \sqrt{x_-}}
	{\sqrt{x_+} - \sqrt{x_-}} \right]
	= \frac12 \log \left[ \frac{k_T^2 + s_b}{k_T^2} \right]
	\leq \frac12 \log \left[ \frac{q^2}{k_T^2} \right]
	\end{equation}
	with
	\begin{equation}
	x_\pm = \left( \sqrt{1 + \frac{k_T^2}{s_b}} \pm \frac{k_T}{\sqrt{s_b}} \right)^2
	\quad , \quad \rho = \frac{s_b}{S}
	\quad \text{and} \quad q^2 = k^2_{T, \text{max}} + s_b.
	\end{equation}
	We correct for this in this veto step.
	Additionally, we correct for overestimating $\alpha_s$.
	<<POWHEG matching: sudakov isr: TBP>>=
	procedure :: reweight_ubf => sudakov_isr_reweight_ubf
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_isr_reweight_ubf (sudakov, pt2) result (accepted)
	logical :: accepted
	class(sudakov_isr_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	end function sudakov_isr_reweight_ubf
	<<POWHEG matching: procedures>>=
	module function sudakov_isr_reweight_ubf (sudakov, pt2) result (accepted)
	logical :: accepted
	class(sudakov_isr_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	real(default) :: log_bound, kT_max2, s_hat, s_had, rho, x_plus, x_minus, q2
	real(default) :: alpha_s_true, alpha_s_rad
	alpha_s_true = sudakov%alpha_s (pt2, use_correct = .true.)
	alpha_s_rad = sudakov%alpha_s (pt2, use_correct = .false.)
	s_hat = sudakov%event_deps%s_hat
	s_had = sudakov%event_deps%s_had
	rho = s_hat / s_had
	kT_max2 = sudakov%kt2_max ()
	q2 = kT_max2 + s_hat
	x_plus = ( sqrt( 1 + pt2 / s_hat ) + sqrt( pt2 / s_hat ) )**2
	x_minus = ( sqrt( 1 + pt2 / s_hat ) - sqrt( pt2 / s_hat ) )**2
	!!! These are not the ISR x values!
	call sudakov%rng%generate (sudakov%random)
	log_bound = log ((sqrt( x_plus - rho ) + sqrt( x_minus - rho )) &
	/ (sqrt( x_plus - rho ) - sqrt( x_minus - rho )))
	if (sudakov%ubf_variant == 1) then
	accepted = sudakov%random * log( q2 / pt2 ) * alpha_s_rad &
	<= 2 * log_bound * alpha_s_true
	elseif (sudakov%ubf_variant == 2) then
	if (pt2 < s_hat) then
	accepted = sudakov%random * log( two * s_hat / pt2 ) * alpha_s_rad &
	<= 2 * log_bound * alpha_s_true
	else
	accepted = sudakov%random * log( two ) * alpha_s_rad &
	<= 2 * log_bound * alpha_s_true
	end if
	else
	accepted = .false.
	call msg_error("sudakov variant not implemented")
	end if
	if (debug2_active (D_MATCHING)) then
	print *, 'sudakov_isr_reweight_ubf:'
	print *, ' sqrt(pt2) = ', sqrt(pt2)
	print *, ' alpha_s_true = ', alpha_s_true
	print *, ' sudakov%process_deps%lambda2_gen = ', &
	sudakov%process_deps%lambda2_gen
	print *, ' alpha_s_rad = ', alpha_s_rad
	print *, ' sudakov%random = ', sudakov%random
	print *, ' accepted = ', accepted
	if (log( q2 / pt2 ) * alpha_s_rad < 2 * log_bound * alpha_s_true) then
	call msg_fatal ("sudakov_isr_reweight_ubf: This should never happen. &
	&Have you chosen a running alpha_s?")
	end if
	end if
	end function sudakov_isr_reweight_ubf

	@ %def sudakov_isr_reweight_ubf
	@ In the ISR case, we overestimated $\xi_\text{max}$ with
	$\xi_\text{max}^{\text{ext}}$.
	We veto too large $\xi$ in this veto step.
	<<POWHEG matching: sudakov isr: TBP>>=
	procedure :: reweight_xi_max => sudakov_isr_reweight_xi_max
	<<POWHEG matching: sub interfaces>>=
	module function sudakov_isr_reweight_xi_max (sudakov, xi) result (accepted)
	logical :: accepted
	class(sudakov_isr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	end function sudakov_isr_reweight_xi_max
	<<POWHEG matching: procedures>>=
	module function sudakov_isr_reweight_xi_max (sudakov, xi) result (accepted)
	logical :: accepted
	class(sudakov_isr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	accepted = xi < sqrt (sudakov%xi2_max)
	if (debug2_active (D_MATCHING)) then
	print *, 'sudakov_isr_reweight_xi_max:'
	print *, ' xi = ', xi
	print *, ' xi_max = ', sqrt (sudakov%xi2_max)
	print *, ' xi accepted = ', accepted
	end if
	end function sudakov_isr_reweight_xi_max

	@ %def sudakov_isr_reweight_xi_max
	@ The actual $\xi_\text{max}$ for ISR is given by eq. (\ref{eqn:xi_max_isr})
	and depends on $y$ which will be known only after we generated $\xi$.
	We thus use an overestimated
	\begin{equation*}
	\xi_{\mathrm{max}}^{\text{ext}} = 1 - \frac{s_b}{S_\text{had}}
	\end{equation*}
	to generate both and veto $\xi > \xi_\text{max}$ later on
	in [[sudakov_isr_reweight_xi_max]].
	<<POWHEG matching: sudakov isr: TBP>>=
	procedure :: compute_xi_max_extended &
	=> sudakov_isr_compute_xi_max_extended
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_isr_compute_xi_max_extended (sudakov)
	class(sudakov_isr_t), intent(inout) :: sudakov
	real(default) :: s_hat, s_had
	end subroutine sudakov_isr_compute_xi_max_extended
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_isr_compute_xi_max_extended (sudakov)
	class(sudakov_isr_t), intent(inout) :: sudakov
	real(default) :: s_hat, s_had
	s_hat = sudakov%event_deps%s_hat
	s_had = sudakov%event_deps%s_had
	sudakov%xi_max_extended = one - s_hat / s_had
	end subroutine sudakov_isr_compute_xi_max_extended

	@ %def sudakov_isr_compute_xi_max_extended
	@ In the ISR case, we generate $\xi$ from a random number and
	afterwards compute $y(p_T,\xi)$ as in the simple case.
	<<POWHEG matching: sudakov isr: TBP>>=
	procedure :: generate_xi_and_y_and_phi => &
	sudakov_isr_generate_xi_and_y_and_phi
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_isr_generate_xi_and_y_and_phi (sudakov, r)
	class(sudakov_isr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_isr_generate_xi_and_y_and_phi
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_isr_generate_xi_and_y_and_phi (sudakov, r)
	class(sudakov_isr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	call sudakov%generate_xi (r)
	call sudakov%generate_y (r)
	call sudakov%generate_phi (r)
	call sudakov%compute_xi2_max (r)
	end subroutine sudakov_isr_generate_xi_and_y_and_phi

	@ %def sudakov_isr_generate_xi_and_y_and_phi
	@ Inverting [[real_kinematics_kt2]], we find
	\begin{equation}
	\|y(k_T^2, \xi)\| = \sqrt{1 - \frac{4 (1 - \xi)}{\xi^2}\frac{k_T^2}{s_b}}.
	\end{equation}
	We then determine the sign randomly as there is no preferred direction.
	<<POWHEG matching: sudakov isr: TBP>>=
	procedure :: generate_y => sudakov_isr_generate_y
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_isr_generate_y (sudakov, r)
	class(sudakov_isr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_isr_generate_y
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_isr_generate_y (sudakov, r)
	class(sudakov_isr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: s_hat
	s_hat = sudakov%event_deps%s_hat
	r%y = sqrt (1 - (4 * (1 - r%xi) * r%pt2 / (s_hat * r%xi**2)))
	call sudakov%rng%generate (sudakov%random)
	if (sudakov%random > 0.5_default) then
	r%y = - r%y
	end if
	end subroutine sudakov_isr_generate_y

	@ %def sudakov_isr_generate_y
	@ We want to generate $x := 1 - \xi$ for the ISR UBF with probability density
	\begin{equation}
	f(x) = \frac{1}{\sqrt{(x_+ - x)(x_- - x)}}.
	\end{equation}
	within the limits
	\begin{equation}
	\frac{s_b}{S} = x_{b,\oplus} x_{b,\ominus} = \rho \leq x \leq x_- = x_-
	= \left( \sqrt{1 + \frac{k_T^2}{s_b}} - \frac{k_T}{\sqrt{s_b}} \right)^2.
	\end{equation}
	To generate $x$ according to the distribution
	\begin{equation}
	F(x) = \int f(x) \, dx = = 2 \sinh^{-1} \left( \sqrt{ \frac{x_- - x}{x_+ - x_-} } \right)
	\end{equation}
	we use
	\begin{equation}
	x = x_- + (x_- - x_+) \sinh^2(\frac{r_x}{2})
	\end{equation}
	with a random number $r_x \in \text{Unif}[F(x_-),F(\rho)]
	= \text{Unif}\left[0,2 \sinh^{-1} \left( \sqrt{ \frac{x_- - \rho}{x_+ - x_-} } \right)
	\right]$.\\
	Alternatively, an implementation making extended use of rejection sampling is available.
	<<POWHEG matching: sudakov isr: TBP>>=
	procedure :: generate_xi => sudakov_isr_generate_xi
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_isr_generate_xi (sudakov, r)
	class(sudakov_isr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_isr_generate_xi
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_isr_generate_xi (sudakov, r)
	class(sudakov_isr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: s_hat, s_had, r_x, x, x_minus, x_plus, rho
	- integer :: variant = 1
	+ integer, parameter :: variant = 1
	logical :: valid
	s_hat = sudakov%event_deps%s_hat
	s_had = sudakov%event_deps%s_had
	- rho = 1 - sudakov%xi_max_extended
	+ rho = s_hat / s_had
	x_plus = ( sqrt( 1 + r%pt2 / s_hat ) + sqrt( r%pt2 / s_hat ) )**2
	x_minus = ( sqrt( 1 + r%pt2 / s_hat ) - sqrt( r%pt2 / s_hat ) )**2
	if (variant == 1) then
	call sudakov%rng%generate (sudakov%random)
	r_x = sudakov%random
	r_x = r_x * 2 * asinh (sqrt ( (x_minus - rho) / (x_plus - x_minus) ) )
	x = x_minus + (x_minus - x_plus) * sinh (r_x / 2)**2
	elseif (variant == 2) then
	valid = .false.
	do while (.not. valid)
	if (signal_is_pending ()) return
	call sudakov%rng%generate (sudakov%random)
	r_x = sudakov%random
	x = x_minus - (sqrt (x_minus - rho) * r_x)**2
	call sudakov%rng%generate (sudakov%random)
	r_x = sudakov%random
	valid = r_x < sqrt ((x_plus - x_minus) / (x_plus - x))
	end do
	end if
	r%xi = 1 - x
	end subroutine sudakov_isr_generate_xi

	@ %def sudakov_isr_generate_xi
	@ Computes the actual [[xi2_max]] for ISR.
	Can only be computed after y has been generated.
	Needs to be called before [[sudakov_isr_reweight_xi_max]].
	<<POWHEG matching: sudakov isr: TBP>>=
	procedure :: compute_xi2_max => sudakov_isr_compute_xi2_max
	<<POWHEG matching: sub interfaces>>=
	module subroutine sudakov_isr_compute_xi2_max (sudakov, r)
	class(sudakov_isr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_isr_compute_xi2_max
	<<POWHEG matching: procedures>>=
	module subroutine sudakov_isr_compute_xi2_max (sudakov, r)
	class(sudakov_isr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: xi_max
	xi_max = get_xi_max_isr (sudakov%event_deps%x_born, r%y)
	sudakov%xi2_max = xi_max**2
	end subroutine sudakov_isr_compute_xi2_max

	@ %def sudakov_isr_compute_xi2_max
	@
	\subsection{Main POWHEG class}
	<<POWHEG matching: public>>=
	public :: powheg_matching_t
	<<POWHEG matching: types>>=
	type, extends(matching_t) :: powheg_matching_t
	type(grid_t) :: grid
	type(phs_fks_generator_t) :: phs_fks_generator
	type(powheg_settings_t) :: settings
	type(event_deps_t) :: event_deps
	type(process_deps_t) :: process_deps
	type(sudakov_wrapper_t), dimension(:), allocatable :: sudakov
	integer :: n_emissions = 0
	logical :: active = .true.
	contains
	<<POWHEG matching: powheg matching: TBP>>
	end type powheg_matching_t

	@ %def powheg_matching_t
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: get_method => powheg_matching_get_method
	<<POWHEG matching: sub interfaces>>=
	module function powheg_matching_get_method (matching) result (method)
	type(string_t) :: method
	class(powheg_matching_t), intent(in) :: matching
	end function powheg_matching_get_method
	<<POWHEG matching: procedures>>=
	module function powheg_matching_get_method (matching) result (method)
	type(string_t) :: method
	class(powheg_matching_t), intent(in) :: matching
	method = matching_method (MATCH_POWHEG)
	end function powheg_matching_get_method

	@ %def powheg_matching_get_method
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: before_shower => powheg_matching_before_shower
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_before_shower &
	(matching, particle_set, vetoed)
	class(powheg_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	end subroutine powheg_matching_before_shower
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_before_shower &
	(matching, particle_set, vetoed)
	class(powheg_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	if (debug_on) call msg_debug2 (D_MATCHING, "powheg_matching_before_shower")
	if (signal_is_pending ()) return
	if (.not. matching%active) return
	call matching%update (particle_set)
	if (matching%settings%test_sudakov) then
	call matching%test_sudakov ()
	stop
	end if
	if (.not. matching%settings%disable_sudakov) &
	call matching%generate_emission (particle_set = particle_set)
	vetoed = .false.
	end subroutine powheg_matching_before_shower

	@ %def powheg_matching_before_shower
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: first_event => powheg_matching_first_event
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_first_event (matching)
	class(powheg_matching_t), intent(inout), target :: matching
	end subroutine powheg_matching_first_event
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_first_event (matching)
	class(powheg_matching_t), intent(inout), target :: matching
	associate (instance => matching%process_instance)
	matching%process_deps%lab_is_cm = instance%lab_is_cm (1)
	end associate
	call matching%setup_grids ()
	end subroutine powheg_matching_first_event

	@ %def powheg_matching_first_event
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: after_shower => powheg_matching_after_shower
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_after_shower &
	(matching, particle_set, vetoed)
	class(powheg_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	end subroutine powheg_matching_after_shower
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_after_shower &
	(matching, particle_set, vetoed)
	class(powheg_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	vetoed = .false.
	end subroutine powheg_matching_after_shower

	@ %def powheg_matching_after_shower
	@
	\subsubsection{Output}
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: write => powheg_write
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_write (matching, unit)
	class(powheg_matching_t), intent(in) :: matching
	integer, intent(in), optional :: unit
	end subroutine powheg_write
	<<POWHEG matching: procedures>>=
	module subroutine powheg_write (matching, unit)
	class(powheg_matching_t), intent(in) :: matching
	integer, intent(in), optional :: unit
	integer :: u, alr
	u = given_output_unit (unit); if (u < 0) return
	call write_separator (u, 2)
	write (u, "(1X,A)") "POWHEG Emission Generator"
	write (u, "(1X,A)") "Process name: " // char (matching%process_name)
	if (allocated (matching%rng)) then
	call matching%rng%write (u)
	else
	write (u, "(1X,A)") "RNG not allocated"
	end if
	call matching%qcd%write (u)
	call matching%settings%write (u)
	call matching%event_deps%write (u)
	call matching%process_deps%write (u)
	do alr = 1, size (matching%sudakov)
	call write_separator (u)
	write (u, "(1X,A,I12,A)") "sudakov (alr = ", alr, ")"
	call matching%sudakov(alr)%s%write (u)
	end do
	call write_separator (u, 2)
	end subroutine powheg_write

	@ %def powheg_write
	@ Finalization of the POWHEG matching.
	It creates a log file showing how many events failed at which stage of the
	POWHEG veto algorithm. It also issues a warning if too many POWHEG
	excess events occured. If this is the case, the chosen upper-bounding
	function is unsuitable for the considered process.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: final => powheg_matching_final
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_final (matching)
	class(powheg_matching_t), intent(in) :: matching
	end subroutine powheg_matching_final
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_final (matching)
	class(powheg_matching_t), intent(in) :: matching
	integer :: u, alr, n_fail_ubf_total, n_sqme_total
	real :: frac_ubf_fail
	type(string_t) :: filename
	n_fail_ubf_total = 0
	n_sqme_total = 0
	u = free_unit ()
	filename = matching%process_name // "_veto.log"
	open (file=char(filename), unit=u, action='write')
	write (u, '(A)') "Summary of POWHEG veto procedure"
	do alr = 1, matching%process_deps%n_alr
	write(u,'(A,I0)') 'alr: ', alr
	call matching%sudakov(alr)%s%veto_counter%write (u)
	call write_separator (u)
	n_fail_ubf_total = n_fail_ubf_total &
	+ matching%sudakov(alr)%s%veto_counter%n_fail_ubf
	n_sqme_total = n_sqme_total &
	+ matching%sudakov(alr)%s%veto_counter%n_sqme
	end do
	write (u,'(A,I0)') "Total number of events which radiate a gluon: ", &
	matching%n_emissions
	close (u)
	if (n_sqme_total > 0) then
	frac_ubf_fail = one * n_fail_ubf_total / n_sqme_total * 100
	if (frac_ubf_fail > 1) then
	- write (msg_buffer, "(A16,I4,A2,F6.2,A24)") "There have been ", &
	+ write (msg_buffer, "(A16,I6,A2,F6.2,A24)") "There have been ", &
	n_fail_ubf_total,&
	" (", frac_ubf_fail, "%) POWHEG grid excesses."
	call msg_warning
	end if
	end if
	end subroutine powheg_matching_final

	@ %def powheg_matching_final
	@
	\subsubsection{Initialization and Finalization}
	Setup the POWHEG grids. As they are filled during integration using
	the POWHEG hook, we can load them from file here.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: setup_grids => powheg_matching_setup_grids
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_setup_grids (matching)
	class(powheg_matching_t), intent(inout), target :: matching
	end subroutine powheg_matching_setup_grids
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_setup_grids (matching)
	class(powheg_matching_t), intent(inout), target :: matching
	call matching%prepare_for_events ()
	if (matching%check_grids ()) then
	call matching%load_grids ()
	else
	call msg_fatal ("POWHEG: POWHEG grids are invalid.")
	end if
	call matching%grid%compute_and_write_mean_and_max ()
	call matching%import_norms_from_grid ()
	end subroutine powheg_matching_setup_grids

	@ %def powheg_matching_setup_grids
	@ Sets up the Sudakovs and chooses the correct UBF type.
	To determine the UBF type, we check for massive or initial state emitters
	for each ALR. For consistency, we thus also check the eeqq case for each ALR.
	Gfortran 7/8/9 bug, has to remain in the main module:
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: setup_sudakovs => powheg_matching_setup_sudakovs
	<<POWHEG matching: main procedures>>=
	subroutine powheg_matching_setup_sudakovs (powheg)
	class(powheg_matching_t), intent(inout), target :: powheg
	integer :: alr, ubf_type, n_in, emitter
	logical :: is_fsr, is_massive, is_eeqq
	allocate (powheg%sudakov (powheg%process_deps%n_alr))
	do alr = 1, powheg%process_deps%n_alr
	select type (pcm => powheg%process_instance%pcm)
	type is (pcm_nlo_t)
	associate(reg_data => pcm%region_data, &
	phs => powheg%phs_fks_generator)
	n_in = reg_data%get_n_in()
	emitter = reg_data%get_emitter (alr)
	is_fsr = emitter > n_in
	if (is_fsr) then
	is_massive = phs%is_massive (emitter)
	else
	if (emitter == 0) then
	is_massive = phs%is_massive (1) .or. phs%is_massive (2)
	else
	is_massive = phs%is_massive (emitter)
	end if
	if (is_massive) call msg_bug ("setup_sudakovs: ISR " // &
	"off massive emitters not implemented.")
	end if
	is_eeqq = n_in == 2 .and. &
	reg_data%n_legs_born == 4 .and. &
	.not. phs%is_massive(3) .and. &
	.not. phs%is_massive(4)
	! (PS 2021-05-28) This includes FSR regions of pp -> jj.
	end associate
	end select
	if (is_fsr) then
	if (is_eeqq) then
	ubf_type = UBF_FSR_MASSLESS_RECOIL
	else if (is_massive) then
	ubf_type = UBF_FSR_MASSIVE
	else
	ubf_type = powheg%settings%upper_bound_func_type
	end if
	select case (ubf_type)
	case (UBF_FSR_SIMPLE)
	allocate (sudakov_simple_fsr_t :: powheg%sudakov(alr)%s)
	case (UBF_FSR_MASSLESS_RECOIL)
	allocate (sudakov_eeqq_fsr_t :: powheg%sudakov(alr)%s)
	case (UBF_FSR_MASSIVE)
	allocate (sudakov_massive_fsr_t :: powheg%sudakov(alr)%s)
	case default
	call msg_fatal ("powheg_setup_sudakovs: Please choose " // &
	"upper bounding function!")
	end select
	else
	allocate (sudakov_isr_t :: powheg%sudakov(alr)%s)
	end if
	if (allocated (powheg%rng)) then
	!!! generator mode
	call powheg%sudakov(alr)%s%init (powheg%process_deps, &
	powheg%event_deps, powheg%settings, &
	powheg%qcd, powheg%phs_fks_generator, powheg%rng)
	else
	!!! lookup mode
	call powheg%sudakov(alr)%s%init (powheg%process_deps, &
	powheg%event_deps, powheg%settings, &
	powheg%qcd, powheg%phs_fks_generator)
	end if
	call powheg%sudakov(alr)%s%set_i_phs (alr)
	end do
	end subroutine powheg_matching_setup_sudakovs

	@ %def powheg_matching_setup_sudakovs
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: init => powheg_matching_init
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_init (matching, var_list, process_name)
	class(powheg_matching_t), intent(out) :: matching
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_name
	end subroutine powheg_matching_init
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_init (matching, var_list, process_name)
	class(powheg_matching_t), intent(out) :: matching
	<<default matching init>>
	end subroutine powheg_matching_init

	@ %def powheg_matching_init
	@ Updates the Born momenta and the Born matrix element stored in the event dependencies.
	<<POWHEG matching: powheg matching: TBP>>=
	generic :: update => update_momenta, &
	update_particle_set
	procedure :: update_momenta => powheg_matching_update_momenta
	procedure :: update_particle_set => powheg_matching_update_particle_set
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_update_momenta (powheg, p_born)
	class(powheg_matching_t), intent(inout) :: powheg
	type(vector4_t), dimension(:), intent(in) :: p_born
	end subroutine powheg_matching_update_momenta
	module subroutine powheg_matching_update_particle_set (powheg, particle_set)
	class(powheg_matching_t), intent(inout) :: powheg
	type(particle_set_t), intent(in) :: particle_set
	end subroutine powheg_matching_update_particle_set
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_update_momenta (powheg, p_born)
	class(powheg_matching_t), intent(inout) :: powheg
	type(vector4_t), dimension(:), intent(in) :: p_born
	type(lorentz_transformation_t) :: lt_lab_to_cms
	- real(default) :: sqme_born
	+ real(default), dimension(:), allocatable :: sqme_born
	+ integer :: i_uborn, n_reg, alr
	real(default), dimension(2) :: x_born
	- sqme_born = powheg%process_instance%get_sqme &
	- (powheg%process_deps%i_term_born)
	+ select type (pcm => powheg%process_instance%pcm)
	+ type is (pcm_nlo_t)
	+ associate (reg_data => pcm%region_data)
	+ n_reg = reg_data%n_regions
	+ allocate(sqme_born(n_reg))
	+ do alr = 1, n_reg
	+ select type (pcm_work => powheg%process_instance%pcm_work)
	+ class is (pcm_nlo_workspace_t)
	+ i_uborn = reg_data%regions(alr)%uborn_index
	+ sqme_born(alr) = pcm_work%real_sub%sqme_born(i_uborn)
	+ end select
	+ end do
	+ end associate
	+ end select
	x_born = powheg%phs_fks_generator%isr_kinematics%x
	if (.not. powheg%process_deps%lab_is_cm) then
	lt_lab_to_cms = powheg%process_instance%get_boost_to_cms (1)
	call powheg%update_event_deps (sqme_born, p_born, x_born, lt_lab_to_cms)
	else
	call powheg%update_event_deps (sqme_born, p_born, x_born)
	end if
	end subroutine powheg_matching_update_momenta

	module subroutine powheg_matching_update_particle_set (powheg, particle_set)
	class(powheg_matching_t), intent(inout) :: powheg
	type(particle_set_t), intent(in) :: particle_set
	integer, dimension(:), allocatable :: indices
	logical, dimension(:), allocatable :: in_out_mask
	integer :: i
	allocate (in_out_mask (particle_set%get_n_tot()))
	do i = 1, particle_set%get_n_tot()
	in_out_mask(i) = particle_set%prt(i)%get_status () == PRT_INCOMING &
	.or. particle_set%prt(i)%get_status () == PRT_OUTGOING
	end do
	allocate (indices (size (particle_set%get_indices (in_out_mask))))
	indices = particle_set%get_indices (in_out_mask)
	call powheg%update_momenta (particle_set%get_momenta (indices))
	end subroutine powheg_matching_update_particle_set

	@ %def powheg_matching_update
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: update_event_deps => powheg_matching_update_event_deps
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_update_event_deps &
	(powheg, sqme_born, p_born, x_born, lt_lab_to_cms)
	class(powheg_matching_t), intent(inout) :: powheg
	- real(default), intent(in) :: sqme_born
	+ real(default), dimension(:), intent(in) :: sqme_born
	type(vector4_t), dimension(:), intent(in) :: p_born
	real(default), dimension(2), intent(in) :: x_born
	type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
	end subroutine powheg_matching_update_event_deps
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_update_event_deps &
	(powheg, sqme_born, p_born, x_born, lt_lab_to_cms)
	class(powheg_matching_t), intent(inout) :: powheg
	- real(default), intent(in) :: sqme_born
	+ real(default), dimension(:), intent(in) :: sqme_born
	type(vector4_t), dimension(:), intent(in) :: p_born
	real(default), dimension(2), intent(in) :: x_born
	type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
	call powheg%event_deps%update (sqme_born, p_born, x_born, lt_lab_to_cms)
	end subroutine powheg_matching_update_event_deps

	@ %def powheg_matching_update_event_deps
	@ Boosts the real momenta to the LAB frame.
	We call this only for FSR so we can take the boost from the Born term.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: boost_preal_to_lab_frame => &
	powheg_matching_boost_preal_to_lab_frame
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_boost_preal_to_lab_frame (powheg, i_phs)
	class(powheg_matching_t), intent(inout) :: powheg
	integer, intent(in) :: i_phs
	end subroutine powheg_matching_boost_preal_to_lab_frame
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_boost_preal_to_lab_frame (powheg, i_phs)
	class(powheg_matching_t), intent(inout) :: powheg
	type(lorentz_transformation_t) :: lt_cms_to_lab
	integer, intent(in) :: i_phs
	associate (event_deps => powheg%event_deps)
	if (powheg%process_deps%lab_is_cm) then
	event_deps%p_real_lab%phs_point(i_phs) = &
	event_deps%p_real_cms%phs_point(i_phs)
	else
	lt_cms_to_lab = powheg%process_instance%get_boost_to_lab (1)
	event_deps%p_real_lab%phs_point(i_phs) = &
	lt_cms_to_lab * event_deps%p_real_cms%phs_point(i_phs)
	end if
	end associate
	end subroutine powheg_matching_boost_preal_to_lab_frame

	@ %def powheg_matching_boost_preal_to_lab_frame
	@ Boosts the real momenta to the CM frame.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: boost_preal_to_cms => powheg_matching_boost_preal_to_cms
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_boost_preal_to_cms (powheg, i_phs)
	class(powheg_matching_t), intent(inout) :: powheg
	integer, intent(in) :: i_phs
	end subroutine powheg_matching_boost_preal_to_cms
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_boost_preal_to_cms (powheg, i_phs)
	class(powheg_matching_t), intent(inout) :: powheg
	type(lorentz_transformation_t) :: lt
	type(vector4_t), dimension(:), allocatable :: p_real
	integer, intent(in) :: i_phs
	real(default) :: sqrts_real
	type(vector4_t) :: p0, p1
	associate (event_deps => powheg%event_deps)
	if (powheg%process_deps%lab_is_cm) then
	event_deps%p_real_cms%phs_point(i_phs) = event_deps%p_real_lab%phs_point(i_phs)
	else
	p_real = event_deps%p_real_lab%phs_point(i_phs)
	p0 = p_real(1) + p_real(2)
	sqrts_real = (p0)**1
	lt = boost (p0, sqrts_real)
	p1 = inverse(lt) * p_real(1)
	lt = lt * rotation_to_2nd (3, space_part (p1))
	p_real = inverse (lt) * p_real
	event_deps%p_real_cms%phs_point(i_phs) = p_real
	end if
	end associate
	end subroutine powheg_matching_boost_preal_to_cms

	@ %def powheg_matching_boost_preal_to_cms
	@ This is the last step of the Sudakov veto algorithm removing the dependence on
	the normalization factor $N(\xi_i,y_i)$ and the upper bounding function
	$U(\xi,y,\alpha_s)$ from the final result.

	In cases where the Born kinematic failed the cuts, $\mathcal{B}$ was
	artificially set to zero, so we cannot use it in a denominator.
	We assume that the generator cuts applied for parton showering are weak cuts to
	avoid divergent phase space regions, thus $\mathcal{B}$ would have been large and
	the reweighting would have failed.
	Here, we can compute [[sqme_real]] directly with scale $p_T$
	but we still need to correct [[sqme_born]].
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: reweight_matrix_elements => &
	powheg_matching_reweight_matrix_elements
	<<POWHEG matching: sub interfaces>>=
	module function powheg_matching_reweight_matrix_elements &
	(powheg, r) result (accepted)
	logical :: accepted
	class(powheg_matching_t), intent(inout) :: powheg
	type(radiation_t), intent(in) :: r
	end function powheg_matching_reweight_matrix_elements
	<<POWHEG matching: procedures>>=
	module function powheg_matching_reweight_matrix_elements &
	(powheg, r) result (accepted)
	logical :: accepted
	class(powheg_matching_t), intent(inout) :: powheg
	type(radiation_t), intent(in) :: r
	integer :: emitter, n_in, i_phs, i_term_born, alphas_power, em
	real(default) :: sqme_real_x_jac, sqme_born
	real(default) :: norm, ubf, ubound, random, weight
	real(default) :: alpha_s_kt, alpha_s_muren, alpha_s_kt_noNLL
	real(default) :: muren, mufac, pt2
	integer, dimension(2) :: flv_born
	real(double), dimension(-6:6) :: pdf_dbl
	real(double) :: x_dbl, q_dbl
	type(vector4_t), dimension(:), allocatable :: p_real_cms, p_real_lab
	real(default), dimension(2) :: pdf_born_mufac, pdf_born_kt
	+ logical :: cuts_passed
	if (debug_on) call msg_debug (D_MATCHING, "reweight_matrix_elements")
	- sqme_born = powheg%event_deps%sqme_born
	- if (nearly_equal(sqme_born,zero) .or. sqme_born < 0) then
	+ cuts_passed = powheg%process_instance%get_sqme(powheg%process_deps%i_term_born) > 0
	+ if (cuts_passed) then
	+ sqme_born = powheg%event_deps%sqme_born(r%alr)
	+ else
	+ sqme_born = zero
	+ end if
	+ if (nearly_equal(sqme_born,zero)) then
	accepted = .false.
	return
	end if
	call powheg%rng%generate (random)
	i_phs = powheg%process_deps%alr_to_i_phs (r%alr)
	select type (pcm => powheg%process_instance%pcm)
	type is (pcm_nlo_t)
	emitter = pcm%region_data%get_emitter (r%alr)
	n_in = pcm%region_data%get_n_in()
	if (emitter <= n_in) then
	allocate(p_real_lab (pcm%region_data%get_n_legs_real()))
	call powheg%phs_fks_generator%generate_isr_from_xi_and_y (&
	r%xi, sqrt (powheg%sudakov(r%alr)%s%xi2_max), r%y, &
	r%phi, i_phs, powheg%event_deps%p_born_lab%get_momenta(1), &
	p_real_lab)
	powheg%event_deps%p_real_lab%phs_point(i_phs) = p_real_lab
	call powheg%boost_preal_to_cms (i_phs)
	else
	allocate(p_real_cms (pcm%region_data%get_n_legs_real()))
	call powheg%phs_fks_generator%generate_fsr_from_xi_and_y (r%xi, r%y, &
	r%phi, emitter, i_phs, &
	powheg%event_deps%p_born_cms%get_momenta(1), &
	p_real_cms)
	powheg%event_deps%p_real_cms%phs_point(i_phs) = p_real_cms
	call powheg%boost_preal_to_lab_frame (i_phs)
	end if
	if (debug_active (D_MATCHING)) then
	if (emitter <= n_in) then
	pt2 = (transverse_part (p_real_lab (size(p_real_lab))))**2
	else
	pt2 = (transverse_part (p_real_cms (size(p_real_cms))))**2
	end if
	call assert_equal (OUTPUT_UNIT, r%pt2, pt2, &
	"reweight_matrix_elements: generated p_real does not fit to sudakovs pt2")
	end if
	call powheg%copy_momenta (i_phs)
	norm = powheg%norm_from_xi_and_y (r)
	associate (s => powheg%sudakov(r%alr)%s)
	alpha_s_kt = s%alpha_s (r%pt2, use_correct=.true.)
	alpha_s_kt_noNLL = s%alpha_s (r%pt2, use_correct=.true., improve_nll=.false.)
	i_term_born = powheg%process_deps%i_term_born
	muren = powheg%process_instance%term(i_term_born)%get_ren_scale ()
	mufac = powheg%process_instance%term(i_term_born)%get_fac_scale ()
	alpha_s_muren = s%alpha_s (muren**2, use_correct=.true., improve_nll=.false.)
	ubf = s%upper_bound_func (r%xi, r%y, alpha_s_kt)

	sqme_real_x_jac = powheg%compute_sqme_real (r%alr, sqrt(r%pt2))

	select type (pcm_work => powheg%process_instance%pcm_work)
	class is (pcm_nlo_workspace_t)
	sqme_real_x_jac = pcm_work%powheg_kinematic_factors_real &
	(sqme_real_x_jac, r%alr)
	end select

	!!! Correct all factors of alphas to the NLL-corrected alphas(kt).
	alphas_power = powheg%process_deps%alphas_power
	sqme_born = (alpha_s_kt / alpha_s_muren)*alphas_power sqme_born
	sqme_real_x_jac = (alpha_s_kt / alpha_s_kt_noNLL)*(alphas_power+1) sqme_real_x_jac

	!!! Also correct the PDFs previously computed at mufac instead of kt
	- select type (pcm => powheg%process_instance%term(i_term_born)%pcm)
	+ select type (pcm => powheg%process_instance%pcm)
	type is (pcm_nlo_t)
	if (pcm%has_pdfs) then
	associate (reg_data => pcm%region_data)
	- flv_born = reg_data%flv_born(i_term_born)%flst(1:2)
	+ flv_born = reg_data%regions(r%alr)%flst_uborn%flst(1:2)
	where (flv_born == 21) flv_born = 0
	end associate
	associate (pdf_data => powheg%process_deps%pdf_data, &
	x_born => powheg%event_deps%x_born)
	do em = 1, 2
	x_dbl = x_born(em); q_dbl = mufac
	call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
	pdf_born_mufac(em) = pdf_dbl(flv_born(em)) / x_born(em)
	x_dbl = x_born(em); q_dbl = sqrt(r%pt2)
	call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
	pdf_born_kt(em) = pdf_dbl(flv_born(em)) / x_born(em)
	end do
	sqme_born = pdf_born_kt(1) * pdf_born_kt(2) / &
	(pdf_born_mufac(1) * pdf_born_mufac(2)) * sqme_born
	end associate
	end if
	end select

	if (nearly_equal(sqme_born,zero) .or. sqme_born < 0) then
	accepted = .false.
	return
	end if
	ubound = sqme_born * ubf * norm
	weight = sqme_real_x_jac / ubound
	if (weight > 1) call s%veto_counter%record_ubf_fail()
	if (debug_active (D_MATCHING)) then
	if (weight < 0) call msg_warning ("R/B < 0!")
	end if
	accepted = random < weight
	end associate

	if (debug_active (D_MATCHING)) then
	print *, ' r%alr = ', r%alr
	print *, ' r%xi = ', r%xi
	print *, ' r%y = ', r%y
	print *, ' r%phi = ', r%phi
	print *, ' r%pt = ', sqrt(r%pt2)
	print *, ' emitter = ', emitter
	print *, ' random = ', random
	print *, ' sqme_born = ', sqme_born
	print *, ' sqme_real_x_jac = ', sqme_real_x_jac
	print *, ' ubf = ', ubf
	print *, ' norm = ', norm
	print *, ' ubound = ', ubound
	print *, ' matrix element accepted = ', accepted
	end if
	end select
	end function powheg_matching_reweight_matrix_elements

	@ %def powheg_matching_reweight_matrix_elements
	@
	\subsubsection{Generation algorithm and grid initialization}
	[[compute_sqme_real]] is the projected real matrix element
	$R_{\alpha_r} = S_{\alpha_r} R$ whereby the current $\alpha_r$ is
	implied by the [[emitter]]. Furthermore, it is multiplied by the
	real and the random number Jacobian.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: compute_sqme_real => powheg_matching_compute_sqme_real
	<<POWHEG matching: sub interfaces>>=
	module function powheg_matching_compute_sqme_real &
	(powheg, alr, scale) result (sqme)
	real(default) :: sqme
	class(powheg_matching_t), intent(inout) :: powheg
	integer, intent(in) :: alr
	real(default), intent(in), optional :: scale
	end function powheg_matching_compute_sqme_real
	<<POWHEG matching: procedures>>=
	module function powheg_matching_compute_sqme_real &
	(powheg, alr, scale) result (sqme)
	real(default) :: sqme
	class(powheg_matching_t), intent(inout) :: powheg
	integer, intent(in) :: alr
	real(default), intent(in), optional :: scale
	real(default), allocatable :: q
	integer :: i_phs, i_term
	- logical :: is_subtraction
	+ logical :: is_subtraction, cuts_passed
	is_subtraction = .false.
	select type (pcm_work => powheg%process_instance%pcm_work)
	class is (pcm_nlo_workspace_t)
	i_phs = powheg%process_deps%alr_to_i_phs (alr)
	i_term = powheg%process_deps%i_term_real (i_phs)
	associate (instance => powheg%process_instance)
	if (present(scale)) then
	if (.not. allocated (q)) then
	allocate (q, source = scale)
	else
	q = scale
	end if
	call instance%compute_sqme_rad &
	(i_term, i_phs, is_subtraction, scale_forced=q)
	else
	call instance%compute_sqme_rad (i_term, i_phs, is_subtraction)
	end if
	- sqme = instance%get_sqme (i_term)
	+ cuts_passed = instance%get_sqme(i_term) > 0
	+ if (cuts_passed) then
	+ sqme = pcm_work%real_sub%sqme_real_arr(alr)
	+ else
	+ sqme = zero
	+ end if
	end associate
	end select
	end function powheg_matching_compute_sqme_real

	@ %def powheg_matching_compute_sqme_real
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: set_scale => powheg_matching_set_scale
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_set_scale (powheg, pT2)
	class(powheg_matching_t), intent(inout) :: powheg
	real(default), intent(in) :: pT2
	end subroutine powheg_matching_set_scale
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_set_scale (powheg, pT2)
	class(powheg_matching_t), intent(inout) :: powheg
	real(default), intent(in) :: pT2
	call powheg%process_instance%set_fac_scale (sqrt(pT2))
	end subroutine powheg_matching_set_scale

	@ %def powheg_matching_set_scale
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: update_sudakovs => powheg_matching_update_sudakovs
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_update_sudakovs (powheg, alr, i_phs, y)
	class(powheg_matching_t), intent(inout) :: powheg
	integer, intent(in) :: alr, i_phs
	real(default), intent(in) :: y
	end subroutine powheg_matching_update_sudakovs
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_update_sudakovs (powheg, alr, i_phs, y)
	class(powheg_matching_t), intent(inout) :: powheg
	integer, intent(in) :: alr, i_phs
	real(default), intent(in) :: y
	real(default) :: q0, m2, mrec2, k0_rec_max
	type(vector4_t) :: p_emitter
	select type (s => powheg%sudakov(alr)%s)
	type is (sudakov_massive_fsr_t)
	q0 = sqrt (s%event_deps%s_hat)
	p_emitter = s%event_deps%p_born_lab%get_momentum (1, &
	s%associated_emitter ())
	associate (p => p_emitter%p)
	mrec2 = (q0 - p(0))2 - p(1)2 - p(2)2 - p(3)2
	end associate
	m2 = p_emitter**2
	call compute_dalitz_bounds (q0, m2, mrec2, s%z1, s%z2, k0_rec_max)
	s%z = s%z2 - (s%z2 - s%z1) * (one + y) / two
	end select
	end subroutine powheg_matching_update_sudakovs

	@ %def powheg_matching_update_sudakovs
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: import_norms_from_grid => powheg_matching_import_norms_from_grid
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_import_norms_from_grid (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	end subroutine powheg_matching_import_norms_from_grid
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_import_norms_from_grid (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	integer :: alr
	real(default) :: norm_max
	do alr = 1, powheg%process_deps%n_alr
	norm_max = powheg%grid%get_maximum_in_3d (alr)
	call powheg%sudakov(alr)%s%set_normalization (norm_max)
	end do
	end subroutine powheg_matching_import_norms_from_grid

	@ %def powheg_matching_import_norms_from_grid
	@ We save the POWHEG grid to a file to be used for the event generation.
	If it has no non-zero entries, we assume that the integration was skipped
	because there were existing VAMP(2) and POWHEG grid files.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: save_grids => powheg_matching_save_grids
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_save_grids (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	end subroutine powheg_matching_save_grids
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_save_grids (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	type(string_t) :: filename, n_points
	filename = powheg%process_name // ".pg"
	if (powheg%grid%has_non_zero_entries()) then
	call powheg%grid%save_to_file (char (filename))
	else
	call msg_warning("POWHEG grid not saved to file. An existing " // &
	& char(filename) // " will be used for the events.")
	end if
	end subroutine powheg_matching_save_grids

	@ %def powheg_matching_save_grids
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: load_grids => powheg_matching_load_grids
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_load_grids (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	end subroutine powheg_matching_load_grids
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_load_grids (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	type(string_t) :: filename, n_points
	filename = powheg%process_name // ".pg"
	call powheg%grid%load_from_file (char (filename))
	if (powheg%grid%has_non_zero_entries()) then
	write (msg_buffer, "(A,A,A)") "POWHEG: using grids from file '", &
	char (filename), "'"
	else
	call msg_fatal("POWHEG grid in " // char(filename) // &
	& " is zero and cannot be used for event generation.")
	end if
	call msg_message ()
	end subroutine powheg_matching_load_grids

	@ %def powheg_matching_load_grids
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: check_grids => powheg_matching_check_grids
	<<POWHEG matching: sub interfaces>>=
	module function powheg_matching_check_grids (powheg) result (ok)
	logical :: ok
	class(powheg_matching_t), intent(in) :: powheg
	end function powheg_matching_check_grids
	<<POWHEG matching: procedures>>=
	module function powheg_matching_check_grids (powheg) result (ok)
	logical :: ok
	class(powheg_matching_t), intent(in) :: powheg
	type(string_t) :: filename, n_points
	filename = powheg%process_name // ".pg"
	ok = os_file_exist (filename) .and. &
	verify_points_for_grid (char (filename), &
	[powheg%settings%size_grid_xi, &
	powheg%settings%size_grid_y, &
	powheg%process_deps%n_alr])
	end function powheg_matching_check_grids

	@ %def powheg_matching_check_grids
	@ This routine implements the Sudakov veto algorithm as explained in
	[[[1002.2581]]], Sec. 7.1 and Bijans thesis, Sec. 3.3 and B.2.
	Here, we veto in order to correct for
	\begin{enumerate}
	\item an overestimation of parts of the upper bounding function
	for complicated UBFs in [[reweight_ubf]] as well as the usage of
	$\alpha_s^\text{rad}$ instead of $\alpha_s^\text{true}$.
	\item the usage of [[xi_max_extended]] instead of [[xi_max]] in [[reweight_xi_max]]
	which is only non-trivial for massive FSR and ISR.
	\item using the maximum of the entire POWHEG normalization grid $N_\text{max}$
	when generating $p_T$ instead of the correct bin value $N(\xi_i,y_i)$ in [[reweight_norm]].
	\item the normalization grid and the upper bounding function in the first place
	in [[reweight_matrix_elements]] to retrieve the correct fraction
	$\frac{\mathcal{R}(\xi,y) \mathcal{J}(\xi,y)}{\mathcal{B}}$.
	\end{enumerate}

	By looping over all ALRs and in the end choosing the ALR with the largest [[pt2]],
	we are effectively implementing the highest bid procedure.
	To save some time generating equivalent phase spaces again and again,
	we could instead loop over all radiation regions [[i_phs]],
	take the sum of all real matrix elements in the Sudakov and in the end
	pick the ALR with probability proportional to the corresponding
	$\mathcal{R}_{\alpha_r}$. We might implement this optimization in the future.

	We need to compute [[xi2_max]] before [[kt2_max]] here.
	In the simple case, it is given by $\xi_\text{max} = \frac{s-M_\text{rec}^2}{s}$
	but we can also take the $\xi_\text{max}$ from the phase space computed before;
	they coincide. This is possible already at this point because in the simple case,
	$\xi_\text{max}$ only depends on the Born momentum of the emitter and not on the
	real kinematics.
	In the eeqq case, $M_\text{rec} = 0$, so $\xi_\text{max} = 1$ and in the massive
	case as well as in the ISR case, we compute an extended $\xi_\text{max}^\text{ext}$
	because the actual $\xi_\text{max}$ depends on the real kinematics.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: generate_emission => powheg_matching_generate_emission
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_generate_emission &
	(powheg, particle_set, pt2_generated)
	class(powheg_matching_t), intent(inout) :: powheg
	type(particle_set_t), intent(inout), optional :: particle_set
	real(default), intent(out), optional :: pt2_generated
	end subroutine powheg_matching_generate_emission
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_generate_emission &
	(powheg, particle_set, pt2_generated)
	class(powheg_matching_t), intent(inout) :: powheg
	type(particle_set_t), intent(inout), optional :: particle_set
	real(default), intent(out), optional :: pt2_generated
	type(radiation_t) :: r, r_max
	real(default) :: xi2_max
	integer :: alr
	logical :: accepted
	+ logical, dimension(:), allocatable :: prt_status_mask
	type(vector4_t), dimension(:), allocatable :: p_real_max
	if (signal_is_pending ()) return
	+ if (debug_on) call msg_debug (D_MATCHING, "powheg_matching_generate_emission")
	+ allocate(prt_status_mask(particle_set%get_n_tot()))
	+ prt_status_mask = .false.
	+ where (particle_set%prt%get_status () == PRT_INCOMING &
	+ .or. particle_set%prt%get_status () == PRT_OUTGOING) &
	+ prt_status_mask = .true.
	r_max%pt2 = zero
	r_max%alr = 0
	- if (debug_on) call msg_debug (D_MATCHING, "powheg_matching_generate_emission")
	select type (pcm => powheg%process_instance%pcm)
	type is (pcm_nlo_t)
	allocate (p_real_max (pcm%region_data%n_legs_real))
	end select
	select type (pcm_work => powheg%process_instance%pcm_work)
	class is (pcm_nlo_workspace_t)
	do alr = 1, powheg%process_deps%n_alr
	if (signal_is_pending ()) return
	+ if (present (particle_set)) then
	+ select type (pcm => powheg%process_instance%pcm)
	+ type is (pcm_nlo_t)
	+ if (any (pack(particle_set%prt%get_pdg (), prt_status_mask) /= &
	+ pcm%region_data%regions(alr)%flst_uborn%flst)) then
	+ cycle
	+ end if
	+ end select
	+ end if
	associate (sudakov => powheg%sudakov(alr)%s)
	select type (sudakov)
	type is (sudakov_simple_fsr_t)
	xi2_max = pcm_work%get_xi_max (alr)**2
	call sudakov%update_xi2_max (xi2_max)
	if (debug2_active (D_MATCHING)) then
	call check_xi2_max (sudakov)
	end if
	type is (sudakov_eeqq_fsr_t)
	call sudakov%update_xi2_max (one)
	type is (sudakov_massive_fsr_t)
	- call sudakov%compute_xi_max_extended (sudakov%i_phs)
	+ call sudakov%compute_xi_max_extended ()
	type is (sudakov_isr_t)
	call sudakov%compute_xi_max_extended ()
	class default
	call msg_fatal ("powheg_matching_generate_emission: unknown Sudakov!")
	end select
	r%alr = alr
	r%pt2 = sudakov%kt2_max ()
	sudakov%sum_log_rands = 0
	if (debug_on) call msg_debug (D_MATCHING, "Starting evolution at r%pt2", r%pt2)
	PT_EVOLUTION: do
	if (signal_is_pending ()) return
	call sudakov%generate_emission (r, r_max)
	if (signal_is_pending ()) return
	if (r%valid) then
	accepted = powheg%reweight_norm (r)
	call sudakov%veto_counter%record_norm (.not. accepted)
	if (.not. accepted) cycle PT_EVOLUTION
	accepted = powheg%reweight_matrix_elements (r)
	call sudakov%veto_counter%record_sqme (.not. accepted)
	if (.not. accepted) cycle PT_EVOLUTION
	end if
	exit
	end do PT_EVOLUTION
	if (r%pt2 > r_max%pt2 .and. r%valid) then
	r_max = r
	p_real_max = powheg%event_deps%p_real_lab%get_momenta (sudakov%i_phs)
	end if
	end associate
	end do
	if (r_max%pt2 > powheg%settings%pt2_min) then
	powheg%n_emissions = powheg%n_emissions + 1
	- call powheg%set_scale (r_max%pt2)
	+ call update_event_data (powheg, r_max%alr, r_max%pt2)
	if (present (particle_set)) then
	call powheg%build_particle_set (particle_set, &
	p_real_max, r_max%alr, r_max%y)
	end if
	if (present (pt2_generated)) pt2_generated = r_max%pt2
	else
	- call powheg%set_scale (powheg%settings%pt2_min)
	+ call update_event_data (powheg, 1, powheg%settings%pt2_min)
	if (present (pt2_generated)) pt2_generated = powheg%settings%pt2_min
	end if
	end select
	contains
	subroutine check_xi2_max (sudakov)
	class(sudakov_t), intent(in) :: sudakov
	real(default) :: s_hat, mrec2, xi2_max
	type(vector4_t) :: p_emitter
	s_hat = sudakov%event_deps%s_hat
	p_emitter = sudakov%event_deps%p_born_lab%get_momentum &
	(1, sudakov%associated_emitter())
	associate (p => p_emitter%p)
	mrec2 = (sqrt(s_hat) - p(0))2 - p(1)2 - p(2)2 - p(3)2
	end associate
	xi2_max = (s_hat - mrec2) / s_hat
	xi2_max = xi2_max**2
	call assert_equal (OUTPUT_UNIT, sudakov%xi2_max, xi2_max, &
	"powheg_matching_generate_emission: xi_max inconsistent")
	end subroutine check_xi2_max
	+ !!! Force the scale pT and the value of alpha_s(p_T) into the event output.
	+ subroutine update_event_data (powheg, alr, pt2)
	+ class(powheg_matching_t), intent(inout) :: powheg
	+ integer, intent(in) :: alr
	+ real(default), intent(in) :: pt2
	+ real(default) :: alpha_s
	+ alpha_s = powheg%sudakov(alr)%s%alpha_s (pt2, use_correct = .true.)
	+ select type (core_state => powheg%process_instance%term(1)%core_state)
	+ class is (prc_external_state_t)
	+ core_state%alpha_qcd = alpha_s
	+ class is (omega_state_t)
	+ core_state%alpha_qcd = alpha_s
	+ end select
	+ call powheg%set_scale (pt2)
	+ end subroutine update_event_data
	end subroutine powheg_matching_generate_emission

	@ %def generate_emission
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: build_particle_set => powheg_matching_build_particle_set
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_build_particle_set &
	(powheg, particle_set, p_real, alr, y)
	class(powheg_matching_t), intent(inout) :: powheg
	type(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), dimension(:), intent(in) :: p_real
	integer, intent(in) :: alr
	real(default), intent(in) :: y
	end subroutine powheg_matching_build_particle_set
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_build_particle_set &
	(powheg, particle_set, p_real, alr, y)
	class(powheg_matching_t), intent(inout) :: powheg
	type(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), dimension(:), intent(in) :: p_real
	integer, intent(in) :: alr
	real(default), intent(in) :: y
	integer, dimension(:), allocatable :: i_flvs_real, flv_radiated
	real(default) :: r_col
	integer :: emitter, i_flv_real
	select type (pcm => powheg%process_instance%pcm)
	type is (pcm_nlo_t)
	i_flvs_real = pcm%region_data%get_flavor_indices (.false.)
	i_flv_real = i_flvs_real (alr)
	allocate (flv_radiated (size (pcm%region_data%get_flv_states_real (i_flv_real))))
	flv_radiated = pcm%region_data%get_flv_states_real (i_flv_real)
	emitter = pcm%region_data%get_emitter(alr)
	if (emitter == 0) then
	if (y > 0) then
	emitter = 1
	else
	emitter = 2
	end if
	end if
	end select
	call powheg%rng%generate (r_col)
	call particle_set%build_radiation (p_real, emitter, flv_radiated, &
	powheg%process_instance%process%get_model_ptr (), r_col)
	end subroutine powheg_matching_build_particle_set

	@ %def powheg_matching_build_particle_set
	@ When generating the transverse momentum in [[sudakov_generate_pt2]],
	we used $N^\mathrm{max}$ as normalization. In this veto step, we correct
	for this by keeping events with probability
	\begin{equation*}
	\frac{N(\xi_i,y_i)}{N^\mathrm{max}}.
	\end{equation*}
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: reweight_norm => powheg_matching_reweight_norm
	<<POWHEG matching: sub interfaces>>=
	module function powheg_matching_reweight_norm (powheg, r) result (accepted)
	logical :: accepted
	class(powheg_matching_t), intent(inout) :: powheg
	type(radiation_t), intent(in) :: r
	end function powheg_matching_reweight_norm
	<<POWHEG matching: procedures>>=
	module function powheg_matching_reweight_norm (powheg, r) result (accepted)
	logical :: accepted
	class(powheg_matching_t), intent(inout) :: powheg
	type(radiation_t), intent(in) :: r
	real(default) :: random, norm_max, norm_true
	if (debug_on) call msg_debug2 (D_MATCHING, "reweight_norm")
	call powheg%rng%generate (random)
	norm_true = powheg%norm_from_xi_and_y (r)
	norm_max = powheg%sudakov(r%alr)%s%norm_max
	accepted = random < norm_true / norm_max
	if (debug2_active (D_MATCHING)) then
	print *, ' r%alr = ', r%alr
	print *, ' random = ', random
	print *, ' norm_true = ', norm_true
	print *, ' norm_max = ', norm_max
	print *, ' norm accepted = ', accepted
	end if
	if (debug_active (D_MATCHING)) then
	if (.not. (zero < r%xi .and. &
	r%xi < sqrt(powheg%sudakov(r%alr)%s%xi2_max))) then
	call msg_bug ("powheg_matching_reweight_norm: xi is out of bounds")
	end if
	if (norm_true > norm_max) then
	call msg_bug ("powheg_matching_reweight_norm: norm shouldnt be larger than norm_max")
	end if
	end if
	end function powheg_matching_reweight_norm

	@ %def powheg_matching_reweight_norm
	@ Retrieves the value of the norm for given $\xi$ and $y$ from the pre-computed POWHEG grid.
	To find the correct bin we need to map $(\xi,y)$ in some way to $[0,1]^2$.
	This mapping is to the most extend arbitrary. We choose
	$y \mapsto \|y\|$ and
	-$\xi \mapsto \log(\frac{1}{1-\xi}) / \log(\frac{1}{1-\xi_{max}})$.
	+$\xi \mapsto \log(1-\xi) / \log(1-\xi_{max})$.
	It may be possible to improve these mappings to tune the performance for processes
	with expensive matrix elements.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: norm_from_xi_and_y => powheg_matching_norm_from_xi_and_y
	<<POWHEG matching: sub interfaces>>=
	module function powheg_matching_norm_from_xi_and_y &
	(powheg, r) result (norm_true)
	real(default) :: norm_true
	class(powheg_matching_t), intent(inout) :: powheg
	type(radiation_t), intent(in) :: r
	end function powheg_matching_norm_from_xi_and_y
	<<POWHEG matching: procedures>>=
	module function powheg_matching_norm_from_xi_and_y &
	(powheg, r) result (norm_true)
	real(default) :: norm_true
	class(powheg_matching_t), intent(inout) :: powheg
	type(radiation_t), intent(in) :: r
	real(default) :: f_alr, xi_max
	real(default), dimension(2) :: rands
	f_alr = (one * r%alr) / powheg%process_deps%n_alr - tiny_07
	rands(I_Y) = abs(r%y)
	xi_max = min(sqrt (powheg%sudakov(r%alr)%s%xi2_max), 1 - tiny_07)
	if (r%xi > xi_max) then
	rands(I_XI) = 1
	else
	- rands(I_XI) = log(1 / (1 - r%xi)) / log(1 / (1 - xi_max))
	+ rands(I_XI) = log(1 - r%xi) / log(1 - xi_max)
	end if
	norm_true = powheg%grid%get_value ([rands, f_alr])
	end function powheg_matching_norm_from_xi_and_y

	@ %def powheg_matching_norm_from_xi_and_y
	@
	\subsection{$\alpha_s$ and its reweighting}
	The main point to ensure here is that the simple fixed-flavor-1-loop
	expression $\alpha_s^\text{rad}$ is larger than the more accurate
	$\alpha_s$ such that we can use a reweighting veto and use
	$\alpha_s^\text{rad}$ for the generation of the emission. This can be
	done by setting
	\begin{equation}
	\alpha_s^\text{rad}(\mu_0) = \alpha_s (\mu_0)
	\end{equation}
	whereby $\mu_0^2$ is the [[scale_to_relate2]] that is taken to be
	$(2 \Lambda^{(5)}_{\overline{MS}})^2$.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: prepare_for_events => powheg_matching_prepare_for_events
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_prepare_for_events (matching)
	class(powheg_matching_t), intent(inout), target :: matching
	end subroutine powheg_matching_prepare_for_events
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_prepare_for_events (matching)
	class(powheg_matching_t), intent(inout), target :: matching
	if (debug_on) call msg_debug &
	(D_MATCHING, "powheg_matching_prepare_for_events")
	call matching%setup_nlo_environment ()
	call matching%grid%init ([matching%settings%size_grid_xi, &
	matching%settings%size_grid_y, matching%process_deps%n_alr])
	call matching%compute_lambda5MSB ()
	call matching%compute_lambda2_gen ()
	call matching%setup_sudakovs ()
	end subroutine powheg_matching_prepare_for_events

	@ %def powheg_matching_prepare_for_events
	@ Computes the scale $\Lambda$ used for the (log integrated) UBFs.
	By construction, it is always $p_{T,\text{min}} > \Lambda$.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: compute_lambda2_gen => powheg_matching_compute_lambda2_gen
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_compute_lambda2_gen (matching)
	class(powheg_matching_t), intent(inout) :: matching
	end subroutine powheg_matching_compute_lambda2_gen
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_compute_lambda2_gen (matching)
	class(powheg_matching_t), intent(inout) :: matching
	real(default) :: scale_to_relate2, alpha_s
	scale_to_relate2 = (2matching%process_deps%lambda5MSB)*2
	alpha_s = get_alpha_s (matching%qcd, scale_to_relate2, 3)
	matching%process_deps%lambda2_gen = exp (- one / (b0rad () * alpha_s)) * &
	scale_to_relate2
	end subroutine powheg_matching_compute_lambda2_gen

	@ %def powheg_matching_compute_lambda2_gen
	@ Computes the scale $\Lambda^{(5)}_{\overline{MS}}$ used to determine the scale
	at which we relate $\alpha_s^{\text{rad}}$ and $\alpha_s^{\text{true}}$.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: compute_lambda5MSB => powheg_matching_compute_lambda5MSB
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_compute_lambda5MSB (matching)
	class(powheg_matching_t), intent(inout) :: matching
	end subroutine powheg_matching_compute_lambda5MSB
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_compute_lambda5MSB (matching)
	class(powheg_matching_t), intent(inout) :: matching
	real(default) :: alpha_s
	integer :: nf, order
	logical :: print_once = .true.
	if (matching%settings%lambda == 0) then
	alpha_s = matching%qcd%alpha%get(MZ_REF)
	select type (alpha => matching%qcd%alpha)
	type is (alpha_qcd_from_scale_t)
	order = alpha%order
	type is (alpha_qcd_from_lambda_t)
	order = alpha%order
	type is (alpha_qcd_lhapdf_t)
	- if (print_once) then
	- call msg_warning ("compute_lambda5MSB: LHAPDF not fully supported" // &
	- " Assuming LO (1-loop) running!")
	- print_once = .false.
	- end if
	- !!! TODO (PS-2021-09-16) We'd need to get order from LHAPDF to continue here.
	- order = 1
	+ order = alpha%get_order ()
	class default
	if (print_once) then
	call msg_warning ("compute_lambda5MSB: alpha_qcd not running!" // &
	" Assuming LO (1-loop) running!")
	print_once = .false.
	end if
	order = 0
	end select
	nf = 5
	matching%process_deps%lambda5MSB = lambda_qcd(alpha_s, MZ_REF, nf, order)
	else if (matching%settings%lambda > 0) then
	matching%process_deps%lambda5MSB = matching%settings%lambda
	else
	call msg_fatal ("compute_lambda5MSB: lambda5MSB < 0")
	end if
	end subroutine powheg_matching_compute_lambda5MSB

	@ %def powheg_matching_compute_lambda5MSB
	@ This is the setup of the process dependencies stored for the matching.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: setup_nlo_environment => powheg_matching_setup_nlo_environment
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_setup_nlo_environment (matching)
	class(powheg_matching_t), intent(inout) :: matching
	end subroutine powheg_matching_setup_nlo_environment
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_setup_nlo_environment (matching)
	class(powheg_matching_t), intent(inout) :: matching
	integer :: n_tot_born, n_tot_real
	integer :: i_phs, i_term_real, i_term
	integer :: n_phs, nlo_type
	if (debug_on) call msg_debug &
	(D_MATCHING, "powheg_matching_setup_nlo_environment")
	select type (pcm_work => matching%process_instance%pcm_work)
	class is (pcm_nlo_workspace_t)
	matching%process_deps%sqrts = matching%process_instance%get_sqrts ()
	select type (pcm => matching%process_instance%pcm)
	type is (pcm_nlo_t)
	matching%process_deps%n_alr = pcm%region_data%n_regions
	n_tot_born = pcm%region_data%n_legs_born
	n_tot_real = pcm%region_data%n_legs_real
	call pcm%setup_phs_generator (pcm_work, &
	matching%phs_fks_generator, matching%process_deps%sqrts, &
	singular_jacobian = matching%settings%singular_jacobian)
	end select
	associate (instance => matching%process_instance)
	i_term_real = instance%process%get_first_real_component ()
	associate (process_deps => matching%process_deps)
	select type (phs => instance%kin(i_term_real)%phs)
	type is (phs_fks_t)
	n_phs = size (phs%phs_identifiers)
	allocate (process_deps%phs_identifiers (n_phs))
	process_deps%phs_identifiers = phs%phs_identifiers
	end select
	call instance%process%get_coupling_powers(process_deps%alpha_power, &
	process_deps%alphas_power)
	allocate (matching%process_deps%alr_to_i_phs &
	(size (pcm_work%real_kinematics%alr_to_i_phs)))
	process_deps%alr_to_i_phs = pcm_work%real_kinematics%alr_to_i_phs
	allocate (process_deps%i_term_real (n_phs))
	i_phs = 1
	do i_term = 1, size (instance%term)
	nlo_type = instance%term(i_term)%nlo_type
	if (nlo_type == BORN) then
	process_deps%i_term_born = i_term
	else if (nlo_type == NLO_REAL) then
	if (instance%kin(i_term)%emitter >= 0) then
	process_deps%i_term_real(i_phs) = i_term
	i_phs = i_phs + 1
	end if
	end if
	end do
	end associate
	end associate
	call matching%event_deps%p_born_lab%init (n_tot_born, 1)
	call matching%event_deps%p_born_cms%init (n_tot_born, 1)
	call matching%event_deps%p_real_lab%init (n_tot_real, n_phs)
	call matching%event_deps%p_real_cms%init (n_tot_real, n_phs)
	end select
	end subroutine powheg_matching_setup_nlo_environment

	@ %def powheg_matching_setup_nlo_environment
	@ Copy momenta from [[event_deps]] to [[real_kinematics]]
	for them to be available for the [[int_hard]] in [[compute_sqme_rad]].
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: copy_momenta => powheg_matching_copy_momenta
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_copy_momenta (matching, i_phs)
	class(powheg_matching_t), intent(inout) :: matching
	integer, intent(in) :: i_phs
	end subroutine powheg_matching_copy_momenta
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_copy_momenta (matching, i_phs)
	class(powheg_matching_t), intent(inout) :: matching
	integer, intent(in) :: i_phs
	select type (pcm_work => matching%process_instance%pcm_work)
	class is (pcm_nlo_workspace_t)
	call pcm_work%real_kinematics%p_real_cms%set_momenta &
	(i_phs, matching%event_deps%p_real_cms%get_momenta (i_phs))
	call pcm_work%real_kinematics%p_real_lab%set_momenta &
	(i_phs, matching%event_deps%p_real_lab%get_momenta (i_phs))
	end select
	end subroutine powheg_matching_copy_momenta

	@ %def powheg_matching_copy_momenta
	@ [[qcd%alpha%get]] should implement a variable-flavor result and
	optionally return [[n_flavors]] that are active at the scale.
	Optionally takes [[nf]] as input preceeding the PDFs value.
	We need this to compute $\alpha_s^{rad}$ always with [[nf=3]].
	<<POWHEG matching: procedures>>=
	function get_alpha_s (qcd, scale2, nf_in, improve_nll_opt) result (alpha_s)
	real(default) :: alpha_s
	class(qcd_t), intent(in) :: qcd
	real(default), intent(in) :: scale2
	integer, optional, intent(in) :: nf_in
	logical, optional, intent(in) :: improve_nll_opt
	logical :: improve_nll
	real(default) :: mb, mc
	integer :: nf
	logical :: print_once = .true.
	! TODO: (bcn 2015-01-30) implement variable flavor alpha_s for all types
	improve_nll = .true.; if (present(improve_nll_opt)) improve_nll = improve_nll_opt
	alpha_s = qcd%alpha%get (sqrt(scale2))
	select type (alpha => qcd%alpha)
	type is (alpha_qcd_from_scale_t)
	nf = alpha%nf
	type is (alpha_qcd_from_lambda_t)
	nf = alpha%nf
	type is (alpha_qcd_lhapdf_t)
	mc = alpha%get_qmass(4)
	mb = alpha%get_qmass(5)
	if (scale2 > mb**2) then
	nf = 5
	elseif (scale2 > mc**2) then
	nf = 4
	else
	nf = 3
	end if
	class default
	if (print_once) then
	call msg_warning ("get_alpha_s: QCD type is not running!" // &
	" Assuming 5-flavors and LO (1-loop) running!")
	print_once = .false.
	end if
	nf = 5
	end select
	if (present(nf_in)) then
	nf = nf_in
	end if
	if (improve_nll) then
	alpha_s = improve_nll_accuracy (alpha_s, nf)
	end if
	end function get_alpha_s

	@ %def get_alpha_s
	@ See Eq. (4.31) in [[0709.2092]]. Should be used everywhere in the Sudakov
	exponent.
	<<POWHEG matching: procedures>>=
	pure function improve_nll_accuracy (alpha_s, n_flavors) result (alpha_s_imp)
	real(default) :: alpha_s_imp
	real(default), intent(in) :: alpha_s
	integer, intent(in) :: n_flavors
	alpha_s_imp = alpha_s * (one + alpha_s / (twopi) &
	((67.0_default/18 - pi*2/6) CA - five/9 * n_flavors))
	end function improve_nll_accuracy

	@ %def improve_nll_accuracy
	@ Wrapper for $b_0(n_f=5)$ from the [[sm_physics]] module.
	It is fixed to $n_f=5$ for radiation generation and will be
	reweighted to the more precise $\alpha_s$.
	<<POWHEG matching: procedures>>=
	pure function b0rad () result (b0)
	real(default) :: b0
	b0 = coeff_b0(five)
	end function b0rad

	@ %def b0rad
	@ Computes the overestimated $\alpha_s$ for the sudakov before the $\alpha_s$-Veto.
	We do not NLL-correct $\alpha_s$ again. We did so already when computing [[lambda2_gen]].
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: alpha_s_rad => sudakov_alpha_s_rad
	<<POWHEG matching: sub interfaces>>=
	elemental module function sudakov_alpha_s_rad (sudakov, scale2) result (alpha_s_rad)
	real(default) :: alpha_s_rad
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: scale2
	end function sudakov_alpha_s_rad
	<<POWHEG matching: procedures>>=
	elemental module function sudakov_alpha_s_rad (sudakov, scale2) result (alpha_s_rad)
	real(default) :: alpha_s_rad
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: scale2
	alpha_s_rad = one / (b0rad () * log (scale2 / sudakov%process_deps%lambda2_gen))
	end function sudakov_alpha_s_rad

	@ %def sudakov_alpha_s_rad
	@
	\subsection{POWHEG hook}
	We provide a POWHEG hook to be called by [[process_instance_evaluate]] to
	prefill the adaptation grid.

	We store the actual [[powheg]] object, which does the computations.
	<<POWHEG matching: public>>=
	public :: powheg_matching_hook_t
	<<POWHEG matching: types>>=
	type, extends(process_instance_hook_t) :: powheg_matching_hook_t
	type(string_t) :: process_name
	type(powheg_matching_t) :: powheg
	contains
	<<POWHEG matching: powheg matching hook: TBP>>
	end type powheg_matching_hook_t

	@ %def powheg_matching_t
	@ Init the hook. The init procedure will be called in [[setup_process]], after
	everything is set up.

	Additionally, we have to include [[var_list]] in order to retrieve the grid size
	in [[xi]] and [[y]].
	<<POWHEG matching: powheg matching hook: TBP>>=
	procedure :: init => powheg_matching_hook_init
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_hook_init (hook, var_list, &
	instance, pdf_data)
	class(powheg_matching_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 powheg_matching_hook_init
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_hook_init (hook, var_list, &
	instance, pdf_data)
	class(powheg_matching_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
	if (debug_on) call msg_debug (D_MATCHING, "powheg_matching_hook_init")
	hook%process_name = instance%get_process_name ()
	call hook%powheg%init (var_list, hook%process_name)
	hook%powheg%qcd = instance%get_qcd ()
	call hook%powheg%connect (instance)
	hook%powheg%process_deps%lab_is_cm = &
	hook%powheg%process_instance%lab_is_cm (1)
	if (present(pdf_data)) then
	hook%powheg%process_deps%pdf_data = pdf_data
	end if
	call hook%powheg%prepare_for_events ()
	end subroutine powheg_matching_hook_init

	@ %def powheg_matching_hook_init
	@ We save the filled grid to file, such that it can be retrieved later on.
	The hook object will be deallocated when the instance gets deallocated.
	<<POWHEG matching: powheg matching hook: TBP>>=
	procedure :: final => powheg_matching_hook_final
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_hook_final (hook)
	class(powheg_matching_hook_t), intent(inout) :: hook
	end subroutine powheg_matching_hook_final
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_hook_final (hook)
	class(powheg_matching_hook_t), intent(inout) :: hook
	type(string_t) :: filename
	if (debug_on) call msg_debug (D_MATCHING, "powheg_matching_hook_final")
	<<POWHEG matching: powheg matching hook final: reduce>>
	call hook%powheg%save_grids ()
	end subroutine powheg_matching_hook_final

	@ %def powheg_matching_hook_final
	@
	<<POWHEG matching: powheg matching hook final: reduce>>=
	@ Reduce all grids to a single grid by using [[MPI_MAX]] on each element.
	<<MPI: POWHEG matching: powheg matching hook final: reduce>>=
	call hook%powheg%grid%mpi_reduce (MPI_MAX)

	@ This routine fills each bin of the POWHEG normalization grid $\{\tilde\xi, \tilde y\}$
	@ such that
	\begin{equation}
	N(\{\tilde\xi, \tilde y\}) = \max_{\forall \xi,y \in \{\tilde\xi, \tilde y\}}
	\frac{\mathcal{R}(\xi,y)\mathcal{J}(\xi,y)}{\mathcal{B}\,U(\xi,y,\alpha_s^\text{true})}
	\end{equation}
	where $\mathcal{R}(\xi,y)$ is the real cross section [[sqme_real]],
	$\mathcal{B}$ is the Born cross section [[sqme_born]],
	$\mathcal{J}$ is the Jacobian and $U$ the upper bounding function [[ubf]].

	For each underlying Born $f_b$, there is a number of radiation regions.
	A radiation region rr may correspond to multiple $\alpha_r$s. The phase
	space only depends upon the radiation region kinematics rr and not on
	the specific $\alpha_r$. $\alpha_r$ can be picked in the set
	$\{\alpha_r\|f_b,\text{rr}\}$ proportional to their $R_{\alpha_r}$.
	For now, we simplify things though and just work with the $\alpha_r$.

	References:
	\begin{itemize}
	\item \texttt{[1002.2581]}, Sec. 7.1
	\item Bijans Thesis, Sec. 3.3 and B.2
	\end{itemize}

	In cases where just the Born kinematic failed the cuts, $\mathcal{B}$ was artificially set
	to zero.
	Unfortunately, we lost information about the value of [[sqme_born]] in these cases
	but we assume that the generator cuts applied for parton showering are weak cuts to
	avoid divergent phase space regions, thus $\mathcal{B}$ is large and does not influence $N$
	so we can skip these phase space points.

	A more appropriate way to solve this problem of Born zeroes is given by the real partition.
	With real partition, there are two possible cases if $\mathcal{B} = 0$: if the real phase
	space point belongs to the real singular, the real kinematic is Born-like and very likely
	also fails the cuts. If the real kinematic is not Born-like, it belongs to the real finite.
	In both cases, it is $\mathcal{R} = \mathcal{B} = 0$ and we can savely skip the phase space
	point.

	In cases where just the real kinematic failed the cuts, $\mathcal{R}$ was artificially set
	to zero and we have no way to recover it. We skip these phase space points too. If we apply
	the same cuts during integration and event generation, these points are not relevant.
	We also skip points where either matrix element is negative. If just one of both is negative,
	their ratio is negative and thus cannot possibly be relevant for the grid. If both are negative,
	we are in an unphysical region for the PDFs.
	We also need to correct all scale dependences of [[sqme_born]] and [[sqme_real]] from
	the process' scale to $p_T$ as this is the scale of the entire Sudakov.
	This affects the PDFs and also $\alpha_s$.
	<<POWHEG matching: powheg matching hook: TBP>>=
	procedure :: evaluate => powheg_matching_hook_evaluate
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_matching_hook_evaluate (hook, instance)
	class(powheg_matching_hook_t), intent(inout) :: hook
	class(process_instance_t), intent(in), target :: instance
	end subroutine powheg_matching_hook_evaluate
	<<POWHEG matching: procedures>>=
	module subroutine powheg_matching_hook_evaluate (hook, instance)
	class(powheg_matching_hook_t), intent(inout) :: hook
	class(process_instance_t), intent(in), target :: instance
	type(vector4_t), dimension(:), allocatable :: p_hard_born
	real(default), dimension(:), allocatable :: x
	real(default) :: kt2, xi, y, xi_max, onepy, onemy
	real(default), dimension(2) :: x_real
	real(default) :: sqme_born, sqme_real_x_jac
	real(default) :: muren_born, mufac_born, muren_real, mufac_real
	real(default) :: alpha_s_kt, alpha_s_muren_born, alpha_s_muren_real
	real(default) :: f_alr, norm, ubf
	real(default) :: r_xi, r_y
	real(double), dimension(-6:6) :: pdf_dbl
	real(default), dimension(2) :: pdf_born_mufac, pdf_born_kt, &
	pdf_real_mufac, pdf_real_kt
	real(double) :: x_dbl, q_dbl
	integer, dimension(2) :: flv_born, flv_real
	- integer :: alr, i_phs, n_x, i_term_born, i_term_real, i_real, em
	- integer :: alphas_power
	+ integer :: alr, i_phs, n_x, i_term_born, i_term_real, em
	+ integer :: alphas_power, i_uborn
	logical :: is_isr
	if (instance%get_active_component_type () == COMP_REAL_FIN) return
	associate (powheg => hook%powheg)
	- allocate (p_hard_born (size (instance%get_p_hard (1))))
	- p_hard_born = instance%get_p_hard (1)
	- call powheg%update (p_hard_born)
	- do alr = 1, powheg%process_deps%n_alr
	- i_phs = powheg%process_deps%alr_to_i_phs (alr)
	- i_term_real = powheg%process_deps%i_term_real(i_phs)
	- i_term_born = powheg%process_deps%i_term_born
	- select type (phs => instance%kin(i_term_real)%phs)
	- type is (phs_fks_t)
	- call phs%generator%get_radiation_variables (i_phs, xi, y)
	- end select
	- call powheg%update_sudakovs (alr, i_phs, y)
	- if (powheg%sudakov(alr)%s%kt2 (xi, y) >= powheg%settings%pt2_min) then
	- sqme_born = instance%get_sqme (i_term_born)
	- sqme_real_x_jac = instance%get_sqme (i_term_real)
	- if (sqme_born <= 0 .or. sqme_real_x_jac <= 0) then
	- cycle
	- end if
	- is_isr = instance%kin(i_term_real)%emitter <= instance%kin(i_term_real)%n_in
	- select type (pcm_work => instance%pcm_work)
	- class is (pcm_nlo_workspace_t)
	- sqme_real_x_jac = pcm_work%powheg_kinematic_factors_real &
	- (sqme_real_x_jac, alr)
	- end select
	+ i_term_born = powheg%process_deps%i_term_born
	+ allocate (p_hard_born (size (instance%get_p_hard (i_term_born))))
	+ p_hard_born = instance%get_p_hard (i_term_born)
	+ call powheg%update (p_hard_born)
	+ do alr = 1, powheg%process_deps%n_alr
	+ i_phs = powheg%process_deps%alr_to_i_phs (alr)
	+ i_term_real = powheg%process_deps%i_term_real(i_phs)
	+ select type (phs => instance%kin(i_term_real)%phs)
	+ type is (phs_fks_t)
	+ call phs%generator%get_radiation_variables (i_phs, xi, y)
	+ end select
	+ call powheg%update_sudakovs (alr, i_phs, y)
	+ kt2 = powheg%sudakov(alr)%s%kt2 (xi, y)
	+ if (kt2 >= powheg%settings%pt2_min) then
	+ select type (pcm => instance%pcm)
	+ type is (pcm_nlo_t)
	+ associate (reg_data => pcm%region_data)
	+ i_uborn = reg_data%regions(alr)%uborn_index
	+ end associate
	+ end select
	+ is_isr = instance%kin(i_term_real)%emitter <= instance%kin(i_term_real)%n_in
	+ select type (pcm_work => instance%pcm_work)
	+ class is (pcm_nlo_workspace_t)
	+ sqme_born = pcm_work%real_sub%sqme_born(i_uborn)
	+ sqme_real_x_jac = pcm_work%real_sub%sqme_real_arr(alr)
	+ sqme_real_x_jac = pcm_work%powheg_kinematic_factors_real &
	+ (sqme_real_x_jac, alr)
	+ end select
	+ if (sqme_born == 0 .or. sqme_real_x_jac == 0) then
	+ cycle
	+ end if

	- associate (s => powheg%sudakov(alr)%s)
	- kt2 = s%kt2(xi, y)
	- alpha_s_kt = s%alpha_s (kt2, use_correct=.true.)
	- muren_born = instance%term(i_term_born)%get_ren_scale ()
	- mufac_born = instance%term(i_term_born)%get_fac_scale ()
	- muren_real = instance%term(i_term_real)%get_ren_scale ()
	- mufac_real = instance%term(i_term_real)%get_fac_scale ()
	- alpha_s_muren_born = s%alpha_s (muren_born**2, use_correct=.true., improve_nll=.false.)
	- alpha_s_muren_real = s%alpha_s (muren_real**2, use_correct=.true., improve_nll=.false.)
	- ubf = s%upper_bound_func (xi, y, alpha_s_kt)
	- end associate
	-
	- !!! Correct all factors of alphas(muren) to alphas(kt).
	- alphas_power = powheg%process_deps%alphas_power
	- sqme_born = (alpha_s_kt / alpha_s_muren_born)*alphas_power sqme_born
	- sqme_real_x_jac = (alpha_s_kt / alpha_s_muren_real)*(alphas_power+1) sqme_real_x_jac
	-
	- !!! Also correct the PDFs previously computed at mufac instead of kt
	- select type (pcm => instance%term(i_term_real)%pcm)
	- type is (pcm_nlo_t)
	- if (pcm%has_pdfs) then
	- associate (reg_data => pcm%region_data)
	- flv_born = reg_data%flv_born(i_term_born)%flst(1:2)
	- where (flv_born == 21) flv_born = 0
	- i_real = reg_data%regions(alr)%real_index
	- flv_real = reg_data%flv_real(i_real)%flst(1:2)
	- where (flv_real == 21) flv_real = 0
	- end associate
	- associate (pdf_data => powheg%process_deps%pdf_data, &
	- x_born => powheg%event_deps%x_born)
	- if (.not. pdfs_valid(instance, pdf_data, i_term_born, i_term_real, &
	- sqrt(kt2), x_born, is_isr)) cycle
	- do em = 1, 2
	- x_dbl = x_born(em) ; q_dbl = mufac_born
	- call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
	- pdf_born_mufac(em) = pdf_dbl(flv_born(em)) / x_born(em)
	- x_dbl = x_born(em) ; q_dbl = sqrt(kt2)
	- call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
	- pdf_born_kt(em) = pdf_dbl(flv_born(em)) / x_born(em)
	- end do
	- onepy = one + y; onemy = one - y
	- x_real(1) = x_born(1) * sqrt ((two - xi * onemy) / (two - xi * onepy))
	- x_real(2) = x_born(2) * sqrt ((two - xi * onepy) / (two - xi * onemy))
	- x_real = x_real / sqrt (one - xi)
	- do em = 1, 2
	- x_dbl = x_real(em) ; q_dbl = mufac_real
	- call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
	- pdf_real_mufac(em) = pdf_dbl(flv_real(em)) / x_real(em)
	- x_dbl = x_real(em) ; q_dbl = sqrt(kt2)
	- call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
	- pdf_real_kt(em) = pdf_dbl(flv_real(em)) / x_real(em)
	- end do
	- sqme_born = pdf_born_kt(1) * pdf_born_kt(2) / &
	- (pdf_born_mufac(1) * pdf_born_mufac(2)) * sqme_born
	- sqme_real_x_jac = pdf_real_kt(1) * pdf_real_kt(2) / &
	- (pdf_real_mufac(1) * pdf_real_mufac(2)) * sqme_real_x_jac
	- end associate
	- end if
	- end select
	+ associate (s => powheg%sudakov(alr)%s)
	+ alpha_s_kt = s%alpha_s (kt2, use_correct=.true.)
	+ muren_born = instance%term(i_term_born)%get_ren_scale ()
	+ mufac_born = instance%term(i_term_born)%get_fac_scale ()
	+ muren_real = instance%term(i_term_real)%get_ren_scale ()
	+ mufac_real = instance%term(i_term_real)%get_fac_scale ()
	+ alpha_s_muren_born = s%alpha_s (muren_born**2, use_correct=.true., improve_nll=.false.)
	+ alpha_s_muren_real = s%alpha_s (muren_real**2, use_correct=.true., improve_nll=.false.)
	+ ubf = s%upper_bound_func (xi, y, alpha_s_kt)
	+ end associate
	+
	+ !!! Correct all factors of alphas(muren) to alphas(kt).
	+ alphas_power = powheg%process_deps%alphas_power
	+ sqme_born = (alpha_s_kt / alpha_s_muren_born)*alphas_power sqme_born
	+ sqme_real_x_jac = (alpha_s_kt / alpha_s_muren_real)*(alphas_power+1) sqme_real_x_jac
	+
	+ !!! Also correct the PDFs previously computed at mufac instead of kt
	+ select type (pcm => instance%pcm)
	+ type is (pcm_nlo_t)
	+ if (pcm%has_pdfs) then
	+ associate (reg_data => pcm%region_data)
	+ flv_born = reg_data%regions(alr)%flst_uborn%flst(1:2)
	+ where (flv_born == 21) flv_born = 0
	+ flv_real = reg_data%regions(alr)%flst_real%flst(1:2)
	+ where (flv_real == 21) flv_real = 0
	+ end associate
	+ associate (pdf_data => powheg%process_deps%pdf_data, &
	+ x_born => powheg%event_deps%x_born)
	+ if (.not. pdfs_valid(instance, pdf_data, alr, &
	+ sqrt(kt2), x_born, is_isr)) cycle
	+ do em = 1, 2
	+ x_dbl = x_born(em) ; q_dbl = mufac_born
	+ call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
	+ pdf_born_mufac(em) = pdf_dbl(flv_born(em)) / x_born(em)
	+ x_dbl = x_born(em) ; q_dbl = sqrt(kt2)
	+ call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
	+ pdf_born_kt(em) = pdf_dbl(flv_born(em)) / x_born(em)
	+ end do
	+ if (is_isr) then
	+ onepy = one + y; onemy = one - y
	+ x_real(1) = x_born(1) * sqrt ((two - xi * onemy) / (two - xi * onepy))
	+ x_real(2) = x_born(2) * sqrt ((two - xi * onepy) / (two - xi * onemy))
	+ x_real = x_real / sqrt (one - xi)
	+ else
	+ x_real = x_born
	+ end if
	+ do em = 1, 2
	+ x_dbl = x_real(em) ; q_dbl = mufac_real
	+ call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
	+ pdf_real_mufac(em) = pdf_dbl(flv_real(em)) / x_real(em)
	+ x_dbl = x_real(em) ; q_dbl = sqrt(kt2)
	+ call pdf_data%evolve(x_dbl, q_dbl, pdf_dbl)
	+ pdf_real_kt(em) = pdf_dbl(flv_real(em)) / x_real(em)
	+ end do
	+ sqme_born = pdf_born_kt(1) * pdf_born_kt(2) / &
	+ (pdf_born_mufac(1) * pdf_born_mufac(2)) * sqme_born
	+ sqme_real_x_jac = pdf_real_kt(1) * pdf_real_kt(2) / &
	+ (pdf_real_mufac(1) * pdf_real_mufac(2)) * sqme_real_x_jac
	+ end associate
	+ end if
	+ end select

	- norm = sqme_real_x_jac / (sqme_born * ubf)
	- f_alr = (one * alr) / powheg%process_deps%n_alr - tiny_07
	+ if (sqme_born <= 0 .or. sqme_real_x_jac <= 0) then
	+ cycle
	+ end if

	- r_y = abs(y)
	- select type (pcm_work => instance%pcm_work)
	- class is (pcm_nlo_workspace_t)
	- xi_max = min(pcm_work%get_xi_max (alr), 1 - tiny_07)
	- end select
	- if (xi > xi_max) then
	- r_xi = 1
	- else
	- r_xi = log(1 / (1 - xi)) / log(1 / (1 - xi_max))
	- end if
	- call powheg%grid%update_maxima ([r_xi, r_y, f_alr], norm)
	- end if
	- end do
	+ norm = sqme_real_x_jac / (sqme_born * ubf)
	+ f_alr = (one * alr) / powheg%process_deps%n_alr - tiny_07
	+
	+ r_y = abs(y)
	+ select type (pcm_work => instance%pcm_work)
	+ class is (pcm_nlo_workspace_t)
	+ xi_max = min(pcm_work%get_xi_max (alr), 1 - tiny_07)
	+ end select
	+ if (xi > xi_max) then
	+ r_xi = 1
	+ else
	+ r_xi = log(1 - xi) / log(1 - xi_max)
	+ end if
	+ call powheg%grid%update_maxima ([r_xi, r_y, f_alr], norm)
	+ end if
	+ end do
	end associate
	contains
	<<POWHEG matching: powheg matching hook: evaluate: contained>>
	end subroutine powheg_matching_hook_evaluate

	@ %def powheg_matching_hook_evaluate
	@ In some phase space point, the quark PDF may vanish although the gluon PDF does not.
	This may lead to very large ratios $\mathcal{R} / \mathcal{B}$ which may spoil
	the reweighting performance of the POWHEG grid.
	Excluding these values when filling the grid is a minor approximation
	with a huge performance gain.
	The PDF veto we perform is independent on the actual emitter to not artificially
	favor specific ALRs.
	<<POWHEG matching: powheg matching hook: evaluate: contained>>=
	- function pdfs_valid (instance, pdf_data, i_term_born, i_term_real, q, x, is_isr) result (valid)
	+ function pdfs_valid (instance, pdf_data, alr, q, x, is_isr) result (valid)
	logical :: valid
	class(process_instance_t), intent(in), target :: instance
	type(pdf_data_t), intent(inout) :: pdf_data
	- integer, intent(in) :: i_term_born, i_term_real
	+ integer, intent(in) :: alr
	real(default), intent(in) :: q
	real(default), dimension(2), intent(in) :: x
	real(double) :: q_dbl
	real(double), dimension(2) :: x_dbl
	logical, intent(in) :: is_isr
	real(default) :: sum_pdf_q
	real(default), dimension(-6:6) :: pdf
	real(double), dimension(-6:6) :: pdf_dbl
	integer :: flv_born_em, em, i_q
	logical :: warned_once = .false.
	valid = .true.
	if (is_isr) then
	if (q**2 < two .or. any(x > 0.9_default)) then
	valid = .false.
	return
	end if
	x_dbl = x
	q_dbl = q
	do em = 1, 2
	call pdf_data%evolve(x_dbl(em), q_dbl, pdf_dbl)
	pdf = pdf_dbl / x(em)
	- select type (pcm => instance%term(i_term_real)%pcm)
	+ select type (pcm => instance%pcm)
	type is (pcm_nlo_t)
	- flv_born_em = pcm%region_data%flv_born(i_term_born)%flst(em)
	+ flv_born_em = pcm%region_data%regions(alr)%flst_uborn%flst(em)
	end select
	if (is_gluon(flv_born_em)) then
	sum_pdf_q = 0
	do i_q = 1, 6
	sum_pdf_q = sum_pdf_q + pdf(-i_q) + pdf(i_q)
	end do
	if (sum_pdf_q * x(em) * (1-x(em)) > 30._default * pdf(0)) then
	valid = .false.
	return
	end if
	elseif (is_quark(flv_born_em)) then
	if (pdf(0) * x(em) * (1-x(em)) > 30._default * pdf(flv_born_em)) then
	valid = .false.
	return
	end if
	else
	if (.not. warned_once) then
	call msg_warning ("powheg_matching_hook_evaluate: unexpected emitter flavor")
	warned_once = .true.
	end if
	end if
	end do
	end if
	end function pdfs_valid

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

	module powheg_matching_ut
	use unit_tests
	use powheg_matching_uti

	<<Standard module head>>

	<<POWHEG matching: public test>>

	contains

	<<POWHEG matching: test driver>>

	end module powheg_matching_ut
	@ %def powheg_matching_ut
	@
	<<[[powheg_matching_uti.f90]]>>=
	<<File header>>

	module powheg_matching_uti

	<<Use kinds>>
	<<Use strings>>
	use constants, only: zero, one
	use lorentz
	use physics_defs, only: LAMBDA_QCD_REF
	use sm_qcd
	use subevents, only: PRT_INCOMING, PRT_OUTGOING
	use model_data
	use particles
	use rng_base
	use variables
	use shower_base
	use shower_core

	use powheg_matching

	use rng_base_ut, only: rng_test_factory_t

	<<Standard module head>>

	<<POWHEG matching: test declarations>>

	contains

	<<POWHEG matching: tests>>

	end module powheg_matching_uti
	@ %def powheg_matching_ut
	@ API: driver for the unit tests below.
	<<POWHEG matching: public test>>=
	public :: powheg_test
	<<POWHEG matching: test driver>>=
	subroutine powheg_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<POWHEG matching: execute tests>>
	end subroutine powheg_test

	@ %def powheg_test
	@
	\subsubsection{Initialization}
	There are no Powheg unit tests so far.

	\subsubsection{Compare generated emission with Sudakov form factor}
	This is a nontrivial test of the generation algorithm and should be
	independent of the used upper bounding function (as long as all
	singularities are included).

	It runs for an extensive amount of time generating a file [[sudakov.dat]] containing
	a histogram for the Sudakov factor in bins of the radiation's transverse momentum $p_T^2$.

	So far, it is only designed to work for lepton collisions without beam spectra and cuts.
	In its current state however, it fills the histogram with either $1$ or [[NaN]] as the
	[[p_hard]] received in [[term_instance_evaluate_interaction]] is identically zero.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: test_sudakov => powheg_test_sudakov
	<<POWHEG matching: sub interfaces>>=
	module subroutine powheg_test_sudakov (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	end subroutine powheg_test_sudakov
	<<POWHEG matching: procedures>>=
	module subroutine powheg_test_sudakov (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	integer :: n_calls1, n_calls2
	integer, parameter :: n_bins = 20
	real(default) :: sqme_real_x_jac, sqme_born
	type(vector4_t), dimension(:), allocatable :: p_born
	real(default), dimension(3) :: random
	real(default) :: xi, y
	integer :: i_call, i_bin, alr, emitter, i_phs
	real(default) :: alpha_s, kT2, weight
	real(default) :: pt2_min, s, random_jacobian
	real(default), dimension(n_bins) :: histo1, histo2, histo1sq, histo2sq
	real(default), dimension(n_bins) :: tmp
	integer :: i_strip, n_in_strip, n_strips
	real(default), dimension(n_bins) :: average, average_sq, error
	real(default), dimension(n_bins) :: &
	sudakov_0, sudakov_p, sudakov_m, rel_error
	integer :: u

	p_born = powheg%event_deps%p_born_lab%get_momenta (1)
	- sqme_born = powheg%event_deps%sqme_born
	s = powheg%event_deps%s_hat
	pt2_min = powheg%settings%pt2_min
	n_calls1 = 100000; n_calls2 = 1000000
	histo1 = zero; histo2 = zero; histo1sq = zero; histo2sq = zero
	n_strips = 10

	call compute_integrals ()
	call generate_emissions ()
	call write_to_screen_and_file ()

	contains

	<<POWHEG matching: powheg test sudakov: procedures>>

	end subroutine powheg_test_sudakov

	@ %def powheg_test_sudakov
	@ This determines the binning of the Sudakov histogram.
	Linear and logarithmic binning are available.
	<<POWHEG matching: powheg test sudakov: procedures>>=
	pure function binning (i) result (pt2)
	real(default) :: pt2
	integer, intent(in) :: i
	!pt2 = pt2_min + (s-pt2_min) * (i-1) / (n_bins-1)
	pt2 = pt2_min * exp (log (s / pt2_min) * (i-1) / (n_bins-1))
	end function

	@ %def binning
	@
	<<POWHEG matching: powheg test sudakov: procedures>>=
	subroutine compute_integrals ()
	write (msg_buffer, "(A)") "POWHEG: test_sudakov: Computing integrals"
	call msg_message ()
	select type (pcm_work => powheg%process_instance%pcm_work)
	class is (pcm_nlo_workspace_t)
	associate (fks => powheg%phs_fks_generator)
	do i_call = 1, n_calls1
	do alr = 1, powheg%process_deps%n_alr
	call powheg%rng%generate (random)
	select type (pcm => powheg%process_instance%pcm)
	type is (pcm_nlo_t)
	emitter = pcm%region_data%get_emitter (alr)
	i_phs = powheg%process_deps%alr_to_i_phs(alr)
	end select
	!!! The sudakov test works only with lepton collisions without beam spectra
	!!! so we can identify the cms and lab momenta.
	powheg%event_deps%p_real_lab = powheg%event_deps%p_real_cms
	call powheg%copy_momenta (i_phs)
	call fks%get_radiation_variables (i_phs, xi, y)
	kT2 = powheg%sudakov(alr)%s%kt2(xi, y)
	if (kT2 >= pt2_min .and. xi < one - tiny_07) then
	alpha_s = get_alpha_s (powheg%qcd, kT2)
	+ sqme_born = powheg%event_deps%sqme_born(alr)
	sqme_real_x_jac = powheg%compute_sqme_real (alr, sqrt(kT2))
	random_jacobian = pcm_work%real_kinematics%jac_rand (emitter)
	weight = sqme_real_x_jac * random_jacobian / sqme_born
	do i_bin = 1, n_bins
	if (kT2 > binning(i_bin)) then
	histo1(i_bin) = histo1(i_bin) + weight
	histo1sq(i_bin) = histo1sq(i_bin) + weight**2
	end if
	end do
	end if
	! Do not cycle since there is a Heaviside in the exponent
	end do
	call msg_show_progress (i_call, n_calls1)
	end do
	end associate
	end select
	average = histo1 / n_calls1
	average_sq = histo1sq / n_calls1
	error = sqrt ((average_sq - average**2) / n_calls1)
	sudakov_0 = exp(-average)
	sudakov_p = exp(-(average + error))
	sudakov_m = exp(-(average - error))
	rel_error = (sudakov_m - sudakov_p) / (2 * sudakov_0) * 100
	end subroutine compute_integrals

	@ %def compute_integrals
	@
	<<POWHEG matching: powheg test sudakov: procedures>>=
	subroutine generate_emissions ()
	write (msg_buffer, "(A)") "POWHEG: test_sudakov: Generating emissions"
	call msg_message ()
	do i_strip = 1, n_strips
	tmp = 0
	n_in_strip = n_calls2 / n_strips
	do i_call = 1, n_in_strip
	if (signal_is_pending ()) return
	call powheg%generate_emission (pt2_generated = kT2)
	do i_bin = 1, n_bins
	if (kT2 > binning(i_bin)) then
	tmp(i_bin) = tmp(i_bin) + 1
	end if
	end do
	end do
	tmp = one - (one * tmp) / n_in_strip
	histo2 = histo2 + tmp
	histo2sq = histo2sq + tmp**2
	call msg_show_progress (i_strip, n_strips)
	end do
	average = histo2 / n_strips
	average_sq = histo2sq / n_strips
	error = sqrt ((average_sq - average**2) / n_strips)
	end subroutine generate_emissions

	@ %def generate_emissions
	@
	<<POWHEG matching: powheg test sudakov: procedures>>=
	subroutine write_to_screen_and_file ()
	u = free_unit ()
	open (file='sudakov.dat', unit=u, action='write')
	print *, 'exp(-Integrated R/B)-distribution: '
	print *, 'pT2 sudakov_+ sudakov_0 sudakov_- rel_err[%]: '
	do i_bin = 1, n_bins
	print *, binning(i_bin), &
	sudakov_p(i_bin), sudakov_0(i_bin), sudakov_m(i_bin), &
	rel_error(i_bin)
	write (u, "(6(" // FMT_16 // ",2X))") binning(i_bin), &
	sudakov_p(i_bin), sudakov_0(i_bin), sudakov_m(i_bin), &
	average(i_bin), error(i_bin)
	end do
	close (u)
	print , '******************************'
	print *, 'Noemission probability: '
	do i_bin = 1, n_bins
	print *, binning (i_bin), average (i_bin), error(i_bin)
	end do
	end subroutine write_to_screen_and_file

	@ %def write_to_screen_and_file
	@
	Index: trunk/tests/functional_tests/powheg_2.sh
	===================================================================
	--- trunk/tests/functional_tests/powheg_2.sh (revision 8835)
	+++ trunk/tests/functional_tests/powheg_2.sh (revision 8836)
	@@ -1,17 +1,21 @@
	#!/bin/sh
	### Check WHIZARD POWHEG matching for dd -> ee with dummy matrix-elements
	echo "Running script $0"
	if test -f OCAML_FLAG; then
	name=`basename @script@`
	rm -f ${name}_p1.pg
	./run_whizard.sh @script@ --no-logging
	echo "Contents of ${name}_p1.debug:" >> $name.log
	cat ${name}_p1.debug >> $name.log
	echo "Contents of ${name}_p1.pg:" >> $name.log
	cat ${name}_p1.pg \| sed -e 's/[0-9]E/XE/g' >> $name.log
	+ echo "Contents of ${name}_p2.debug:" >> $name.log
	+ cat ${name}_p2.debug >> $name.log
	+ echo "Contents of ${name}_p2.pg:" >> $name.log
	+ cat ${name}_p2.pg \| sed -e 's/[0-9]E/XE/g' >> $name.log
	diff -b ref-output/$name.ref $name.log
	else
	echo "\|=============================================================================\|"
	echo "No O'Mega matrix elements available, test skipped"
	exit 77
	fi
	Index: trunk/share/tests/functional_tests/ref-output-double/powheg_1.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-double/powheg_1.ref (revision 8835)
	+++ trunk/share/tests/functional_tests/ref-output-double/powheg_1.ref (revision 8836)
	@@ -1,723 +1,689 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	openmp_num_threads = 1
	?pacify = true
	seed = 0
	SM.wtop => 0.00000E+00
	SM.mtop => 1.75000E+02
	?use_vamp_equivalences = false
	$loop_me_method = "dummy"
	?alphas_is_fixed = false
	?alphas_from_mz = true
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = true
	?powheg_matching = true
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_pt_min = 1.00000E+00
	?powheg_use_singular_jacobian = false
	\| Process library 'powheg_1_lib': recorded process 'powheg_1_p1'
	sqrts = 5.00000E+02
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_1_lib': compiling ...
	\| Process library 'powheg_1_lib': writing makefile
	\| Process library 'powheg_1_lib': removing old files
	\| Process library 'powheg_1_lib': writing driver
	\| Process library 'powheg_1_lib': creating source code
	\| Process library 'powheg_1_lib': compiling sources
	\| Process library 'powheg_1_lib': linking
	\| Process library 'powheg_1_lib': loading
	\| Process library 'powheg_1_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process powheg_1_p1:
	\| 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 'powheg_1_p1.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p1.i3.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_1_p1'
	\| Library name = 'powheg_1_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'powheg_1_p1_i1': e+, e- => t, tbar [omega]
	\| 2: 'powheg_1_p1_i2': e+, e- => t, tbar, gl [omega], [real]
	\| 3: 'powheg_1_p1_i3': e+, e- => t, tbar [dummy], [virtual]
	\| 4: 'powheg_1_p1_i4': e+, e- => t, tbar [inactive], [subtraction]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| Using user-defined general scale.
	\| Starting integration for process 'powheg_1_p1'
	\| Integration hook: add POWHEG hook
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 1 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.682E+02 2.15E+01 4.59 0.46 45.9
	\|-----------------------------------------------------------------------------\|
	1 100 4.682E+02 2.15E+01 4.59 0.46 45.9
	\|=============================================================================\|
	n_events = 1
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?write_raw = false
	\| Starting simulation for process 'powheg_1_p1'
	\| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 2.1359E-03
	\| Events: writing to ASCII file 'powheg_1_p1.debug'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p1.pg'
	\| Grid: Mean value of the grid: 2.73541E-03
	\| Grid: Max value of the grid: 5.79027E-03
	\| Grid: Mean/Max value of the grid: 4.72416E-01
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 20.00 %
	\| Events: closing ASCII file 'powheg_1_p1.debug'
	n_events = 2
	\| Starting simulation for process 'powheg_1_p1'
	\| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 2
	\| corr. to luminosity [fb-1] = 4.2717E-03
	\| Events: writing to ASCII file 'powheg_1_p1.debug'
	\| Events: generating 2 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p1.pg'
	\| Grid: Mean value of the grid: 2.73541E-03
	\| Grid: Max value of the grid: 5.79027E-03
	\| Grid: Mean/Max value of the grid: 4.72416E-01
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 100.00 %
	\| Events: closing ASCII file 'powheg_1_p1.debug'
	-$real_partition_mode = "on"
	+$real_partition_mode = "singular"
	real_partition_scale = 5.00000E+00
	\| Process library 'powheg_1_lib': unloading
	\| Process library 'powheg_1_lib': open
	\| Process library 'powheg_1_lib': recorded process 'powheg_1_p2'
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_1_lib': compiling ...
	\| Process library 'powheg_1_lib': writing makefile
	\| Process library 'powheg_1_lib': removing old files
	\| Process library 'powheg_1_lib': writing driver
	\| Process library 'powheg_1_lib': creating source code
	\| Process library 'powheg_1_lib': compiling sources
	\| Process library 'powheg_1_lib': linking
	\| Process library 'powheg_1_lib': loading
	\| Process library 'powheg_1_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Initializing integration for process powheg_1_p2:
	\| 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 'powheg_1_p2.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p2.i3.phs'
	-\| Phase space: generating configuration ...
	-\| Phase space: ... success.
	-\| Phase space: writing configuration file 'powheg_1_p2.i5.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_1_p2'
	\| Library name = 'powheg_1_lib'
	\| Process index = 2
	\| Process components:
	\| 1: 'powheg_1_p2_i1': e+, e- => t, tbar [omega]
	\| 2: 'powheg_1_p2_i2': e+, e- => t, tbar, gl [omega], [real]
	\| 3: 'powheg_1_p2_i3': e+, e- => t, tbar [dummy], [virtual]
	\| 4: 'powheg_1_p2_i4': e+, e- => t, tbar [inactive], [subtraction]
	-\| 5: 'powheg_1_p2_i5': e+, e- => t, tbar, gl [omega], [real]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	-\| Phase space: 2 channels, 5 dimensions
	-\| Phase space: found 2 channels, collected in 1 grove.
	-\| Phase space: no equivalences between channels used.
	-\| Phase space: wood
	Warning: No cuts have been defined.
	\| Using user-defined general scale.
	+\| Starting integration for process 'powheg_1_p2'
	\| Integration hook: add POWHEG hook
	-\| Starting integration for process 'powheg_1_p2' part 'Combined'
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 1 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
	\|-----------------------------------------------------------------------------\|
	1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
	\|=============================================================================\|
	-\| Starting integration for process 'powheg_1_p2' part 'real'
	-\| Integrate: iterations = 1:100:"gw"
	-\| Integrator: 1 chains, 2 channels, 5 dimensions
	-\| Integrator: 100 initial calls, 20 bins, stratified = T
	-\| Integrator: VAMP
	-\|=============================================================================\|
	-\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	-\|=============================================================================\|
	- 1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
	-\|-----------------------------------------------------------------------------\|
	- 1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
	-\|=============================================================================\|
	-\| Integrate: sum of all components
	-\|=============================================================================\|
	-\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	-\|=============================================================================\|
	- 1 0 4.978E+02 2.90E+01 5.83 0.00 31.2
	-\|=============================================================================\|
	-tolerance = 1.08344E+02
	+tolerance = 9.87690E+01
	\| expect: success
	\| Starting simulation for process 'powheg_1_p2'
	\| Simulate: using integration grids from file 'powheg_1_p2.m1.vg'
	-\| Simulate: using integration grids from file 'powheg_1_p2.m2.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 4
	\| Simulation: requested number of events = 2
	-\| corr. to luminosity [fb-1] = 4.0174E-03
	+\| corr. to luminosity [fb-1] = 4.9309E-03
	\| Events: writing to ASCII file 'powheg_1_p2.debug'
	\| Events: generating 2 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p2.pg'
	\| Grid: Mean value of the grid: 5.27611E-04
	\| Grid: Max value of the grid: 6.09917E-03
	\| Grid: Mean/Max value of the grid: 8.65055E-02
	\| ... event sample complete.
	-\| Events: actual unweighting efficiency = 20.00 %
	+\| Events: actual unweighting efficiency = 14.29 %
	\| Events: closing ASCII file 'powheg_1_p2.debug'
	\| Summary of value checks:
	\| Failures: 0 / Total: 1
	\| There were no errors and 2 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Contents of powheg_1_p1.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.82009E-02
	Squared matrix el. (prc) = 2.82009E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 9.608533E+01 -1.236770E+02 -8.571236E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -9.608533E+01 1.236770E+02 8.571236E+01
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 8
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 250.000 96.085 -123.677 -85.712 30625.000
	4 [o] tbar 0 1 1-2 [none] 250.000 -96.085 123.677 85.712 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.82009E-02
	sqme_ref* => 2.82009E-02
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.5000000E+02; 9.6085328E+01,-1.2367700E+02,-8.5712364E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.5000000E+02;-9.6085328E+01, 1.2367700E+02, 8.5712364E+01\| 3.0625000E+04\| 4)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.76793E-02
	Squared matrix el. (prc) = 2.76793E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 1.688666E+02 3.093682E+01 -4.901007E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -1.688666E+02 -3.093682E+01 4.901007E+01
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 8
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 250.000 168.867 30.937 -49.010 30625.000
	4 [o] tbar 0 1 1-2 [none] 250.000 -168.867 -30.937 49.010 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.76793E-02
	sqme_ref* => 2.76793E-02
	event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.5000000E+02; 1.6886659E+02, 3.0936816E+01,-4.9010068E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.5000000E+02;-1.6886659E+02,-3.0936816E+01, 4.9010068E+01\| 3.0625000E+04\| 4)
	========================================================================
	Contents of powheg_1_p2.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.41607E-05
	- Squared matrix el. (prc) = 1.41607E-05
	+ Squared matrix el. (ref) = 3.51646E-02
	+ Squared matrix el. (prc) = 3.51646E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	- Selected MCI group = 2
	- Selected term = 6
	+ Selected MCI group = 1
	+ Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	- seed = 196611
	+ seed = 196610
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	- Children: 3 4 5
	+ Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	- Children: 3 4 5
	+ Children: 3 4
	Particle 3 [o] f(6)c(1 )
	- E = 2.219832E+02
	- P = -7.125693E+01 -1.137429E+02 -2.522963E+01
	+ E = 2.500000E+02
	+ P = 1.143154E+02 2.823158E+00 -1.371095E+02
	T = 3.062500000E+04
	Parents: 1 2
	- Particle 4 [o] f(-6)c(-2 )
	- E = 2.128305E+02
	- P = 1.983915E+01 1.013308E+02 6.332695E+01
	+ Particle 4 [o] f(-6)c(-1 )
	+ E = 2.500000E+02
	+ P = -1.143154E+02 -2.823158E+00 1.371095E+02
	T = 3.062500000E+04
	Parents: 1 2
	- Particle 5 [o] f(21)c(2 -1)
	- E = 6.518630E+01
	- P = 5.141778E+01 1.241207E+01 -3.809732E+01
	- T = 0.000000000E+00
	- Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	- seed = 196612
	+ seed = 196611
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	- 1 [i] e+ 0 0 [none] 3-5 250.000 0.000 0.000 250.000 0.000
	- 2 [i] e- 0 0 [none] 3-5 250.000 0.000 0.000 -250.000 0.000
	- 3 [o] t 1 0 1-2 [none] 221.983 -71.257 -113.743 -25.230 30625.000
	- 4 [o] tbar 0 2 1-2 [none] 212.831 19.839 101.331 63.327 30625.000
	- 5 [o] gl 2 1 1-2 [none] 65.186 51.418 12.412 -38.097 0.000
	+ 1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	+ 2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	+ 3 [o] t 1 0 1-2 [none] 250.000 114.315 2.823 -137.110 30625.000
	+ 4 [o] tbar 0 1 1-2 [none] 250.000 -114.315 -2.823 137.110 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	-n_out* => 3
	-n_tot* => 5
	+n_out* => 2
	+n_tot* => 4
	$process_id* => "powheg_1_p2"
	process_num_id* => [unknown integer]
	-sqme* => 1.41607E-05
	-sqme_ref* => 1.41607E-05
	+sqme* => 3.51646E-02
	+sqme_ref* => 3.51646E-02
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	- 3 prt(o:6\| 2.2198318E+02;-7.1256929E+01,-1.1374290E+02,-2.5229632E+01\| 3.0625000E+04\| 3)
	- 4 prt(o:-6\| 2.1283052E+02; 1.9839145E+01, 1.0133083E+02, 6.3326954E+01\| 3.0625000E+04\| 4)
	- 5 prt(o:21\| 6.5186300E+01; 5.1417783E+01, 1.2412066E+01,-3.8097321E+01\| 0.0000000E+00\| 5)
	+ 3 prt(o:6\| 2.5000000E+02; 1.1431539E+02, 2.8231580E+00,-1.3710953E+02\| 3.0625000E+04\| 3)
	+ 4 prt(o:-6\| 2.5000000E+02;-1.1431539E+02,-2.8231580E+00, 1.3710953E+02\| 3.0625000E+04\| 4)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 3.51646E-02
	- Squared matrix el. (prc) = 3.51646E-02
	- Event weight (ref) = 1.00000E+00
	- Event weight (prc) = 1.00000E+00
	+ Squared matrix el. (ref) = -1.50113E-02
	+ Squared matrix el. (prc) = -1.50113E-02
	+ Event weight (ref) = -1.00000E+00
	+ Event weight (prc) = -1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	- seed = 196611
	+ seed = 196610
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	- P = 1.143154E+02 2.823158E+00 -1.371095E+02
	+ P = 1.134181E+01 5.748522E+01 -1.686470E+02
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	- P = -1.143154E+02 -2.823158E+00 1.371095E+02
	+ P = -1.134181E+01 -5.748522E+01 1.686470E+02
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	- seed = 196612
	+ seed = 196611
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	- 3 [o] t 1 0 1-2 [none] 250.000 114.315 2.823 -137.110 30625.000
	- 4 [o] tbar 0 1 1-2 [none] 250.000 -114.315 -2.823 137.110 30625.000
	+ 3 [o] t 1 0 1-2 [none] 250.000 11.342 57.485 -168.647 30625.000
	+ 4 [o] tbar 0 1 1-2 [none] 250.000 -11.342 -57.485 168.647 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p2"
	process_num_id* => [unknown integer]
	-sqme* => 3.51646E-02
	-sqme_ref* => 3.51646E-02
	+sqme* => -1.50113E-02
	+sqme_ref* => -1.50113E-02
	event_index* => 2
	-event_weight* => 1.00000E+00
	-event_weight_ref* => 1.00000E+00
	+event_weight* => -1.00000E+00
	+event_weight_ref* => -1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	- 3 prt(o:6\| 2.5000000E+02; 1.1431539E+02, 2.8231580E+00,-1.3710953E+02\| 3.0625000E+04\| 3)
	- 4 prt(o:-6\| 2.5000000E+02;-1.1431539E+02,-2.8231580E+00, 1.3710953E+02\| 3.0625000E+04\| 4)
	+ 3 prt(o:6\| 2.5000000E+02; 1.1341807E+01, 5.7485218E+01,-1.6864701E+02\| 3.0625000E+04\| 3)
	+ 4 prt(o:-6\| 2.5000000E+02;-1.1341807E+01,-5.7485218E+01, 1.6864701E+02\| 3.0625000E+04\| 4)
	========================================================================
	Contents of powheg_1_p1.pg:
	3
	5 5 2
	5.790269644E-03 4.340795108E-03 3.956051847E-03 3.268282717E-03 2.051663025E-03 5.483521338E-03 4.862867184E-03 3.083117149E-03 1.719170734E-03 1.731060783E-03 4.642895497E-03 4.089380716E-03 3.278082328E-03 2.072774426E-03 0.000000000E+00 4.285080610E-03 2.703040559E-03 1.939544788E-03 1.808207664E-03 4.832499720E-04 1.725229448E-03 1.848229758E-03 1.666841200E-03 8.779275397E-04 5.973719500E-04 5.658020044E-03 4.797607112E-03 3.691638415E-03 2.563334950E-03 1.517565346E-03 5.487404533E-03 4.496578313E-03 3.894360323E-03 2.025323813E-03 2.321871855E-03 4.723770503E-03 3.748861818E-03 2.983344155E-03 2.071275780E-03 0.000000000E+00 4.306591537E-03 2.873724204E-03 2.416448227E-03 1.437407107E-03 9.061702013E-04 1.847228261E-03 1.615352333E-03 1.894684827E-03 7.407160321E-04 4.468086944E-04
	Contents of powheg_1_p2.pg:
	3
	5 5 2
	6.095585482E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 3.638455441E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 2.295080449E-03 7.908638236E-04 3.287240771E-04 0.000000000E+00 4.113170873E-05 6.099167083E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 3.638548619E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 2.236532849E-03 8.480150493E-04 3.249848815E-04 0.000000000E+00 4.348340652E-05
	Index: trunk/share/tests/functional_tests/ref-output-double/powheg_2.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-double/powheg_2.ref (revision 8835)
	+++ trunk/share/tests/functional_tests/ref-output-double/powheg_2.ref (revision 8836)
	@@ -1,1578 +1,1669 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	openmp_num_threads = 1
	?pacify = true
	?write_raw = false
	SM.mZ => 9.11880E+01
	SM.mW => 8.04190E+01
	SM.mH => 1.25000E+02
	SM.GF => 1.16639E-05
	SM.me => 0.00000E+00
	SM.mmu => 0.00000E+00
	SM.mtau => 1.77700E+00
	+SM.ms => 0.00000E+00
	+SM.mc => 0.00000E+00
	+SM.mb => 0.00000E+00
	?alphas_is_fixed = false
	?alphas_from_mz = true
	?alphas_from_lambda_qcd = false
	?alphas_from_lhapdf = false
	alphas_nf = 5
	alphas_order = 1
	-$exclude_gauge_splittings = "u:s:b:t"
	+[user variable] pr = PDG(1, -1, 2, -2, 3, -3, 4, -4, 5, -5)
	+$exclude_gauge_splittings = "t"
	$method = "dummy"
	$pdf_builtin_set = "mstw2008nlo"
	sqrts = 1.40000E+04
	?combined_nlo_integration = true
	\| Process library 'powheg_2_lib': recorded process 'powheg_2_p1'
	-seed = 130
	+\| Process library 'powheg_2_lib': recorded process 'powheg_2_p2'
	+seed = 487
	?fixed_order_nlo_events = false
	?unweighted = true
	?powheg_matching = true
	powheg_grid_size_xi = 10
	powheg_grid_size_y = 10
	powheg_pt_min = 1.00000E+00
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_2_lib': compiling ...
	\| Process library 'powheg_2_lib': writing makefile
	\| Process library 'powheg_2_lib': removing old files
	\| Process library 'powheg_2_lib': writing driver
	\| Process library 'powheg_2_lib': creating source code
	\| Process library 'powheg_2_lib': compiling sources
	\| Process library 'powheg_2_lib': linking
	\| Process library 'powheg_2_lib': loading
	\| Process library 'powheg_2_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	-\| RNG: Setting seed for random-number generator to 130
	+\| RNG: Setting seed for random-number generator to 487
	\| Initializing integration for process powheg_2_p1:
	\| Beam structure: p, p => pdf_builtin
	\| Beam data (collision):
	\| p (mass = 0.0000000E+00 GeV)
	\| p (mass = 0.0000000E+00 GeV)
	\| sqrts = 1.400000000000E+04 GeV
	\| Initialized builtin PDF MSTW2008NLO
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_2_p1.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_2_p1.i3.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_2_p1'
	\| Library name = 'powheg_2_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'powheg_2_p1_i1': d, dbar => e-, e+ [dummy]
	\| 2: 'powheg_2_p1_i2': d:gl, dbar:gl => e-, e+, gl:d:dbar [dummy], [real]
	\| 3: 'powheg_2_p1_i3': d, dbar => e-, e+ [dummy], [virtual]
	\| 4: 'powheg_2_p1_i4': d, dbar => e-, e+ [inactive], [subtraction]
	\| 5: 'powheg_2_p1_i5': d, dbar => e-, e+ [dummy], [dglap]
	\| ------------------------------------------------------------------------
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Beam structure: pdf_builtin, none => none, pdf_builtin
	\| Beam structure: 2 channels, 2 dimensions
	\| Applying user-defined cuts.
	\| Using user-defined general scale.
	\| Starting integration for process 'powheg_2_p1'
	\| Integration hook: add POWHEG hook
	\| Shower: interfacing PDF builtin set #8
	\| Integrate: iterations = 1:1000:"gw"
	\| Integrator: 2 chains, 2 channels, 7 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 1000 1.073E+10 4.88E+09 45.52 14.39 0.4
	+ 1 1000 2.223E+09 5.00E+08 22.48 7.11 0.8
	\|-----------------------------------------------------------------------------\|
	- 1 1000 1.073E+10 4.88E+09 45.52 14.39 0.4
	+ 1 1000 2.223E+09 5.00E+08 22.48 7.11 0.8
	\|=============================================================================\|
	-n_events = 10
	+n_events = 5
	?negative_weights = true
	?keep_failed_events = true
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	\| Starting simulation for process 'powheg_2_p1'
	\| Simulate: using integration grids from file 'powheg_2_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: interfacing PDF builtin set #8
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	-\| RNG: Setting seed for random-number generator to 131
	-\| Simulation: requested number of events = 10
	-\| corr. to luminosity [fb-1] = 9.3197E-10
	+\| RNG: Setting seed for random-number generator to 488
	+\| Simulation: requested number of events = 5
	+\| corr. to luminosity [fb-1] = 2.2496E-09
	\| Events: writing to ASCII file 'powheg_2_p1.debug'
	-\| Events: generating 10 unweighted, unpolarized events ...
	+\| Events: generating 5 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_2_p1.pg'
	-\| Grid: Mean value of the grid: 7.15782E+03
	-\| Grid: Max value of the grid: 1.18402E+05
	-\| Grid: Mean/Max value of the grid: 6.04533E-02
	+\| Grid: Mean value of the grid: 9.69764E+03
	+\| Grid: Max value of the grid: 4.48803E+05
	+\| Grid: Mean/Max value of the grid: 2.16078E-02
	\| ... event sample complete.
	-\| Events: actual unweighting efficiency = 0.34 %
	-Warning: Encountered events with excess weight: 4 events ( 40.000 %)
	-\| Maximum excess weight = 1.722E+01
	-\| Average excess weight = 1.950E+00
	+\| Events: actual unweighting efficiency = 1.46 %
	+Warning: Encountered events with excess weight: 2 events ( 40.000 %)
	+\| Maximum excess weight = 2.106E+01
	+\| Average excess weight = 5.062E+00
	\| Events: closing ASCII file 'powheg_2_p1.debug'
	-\| There were no errors and 1 warning(s).
	+\| QCD alpha: using a running strong coupling
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 489
	+\| Initializing integration for process powheg_2_p2:
	+\| Beam structure: p, p => pdf_builtin
	+\| Beam data (collision):
	+\| p (mass = 0.0000000E+00 GeV)
	+\| p (mass = 0.0000000E+00 GeV)
	+\| sqrts = 1.400000000000E+04 GeV
	+\| Phase space: generating configuration ...
	+\| Phase space: ... success.
	+\| Phase space: writing configuration file 'powheg_2_p2.i1.phs'
	+\| Phase space: generating configuration ...
	+\| Phase space: ... success.
	+\| Phase space: writing configuration file 'powheg_2_p2.i3.phs'
	+\| ------------------------------------------------------------------------
	+\| Process [scattering]: 'powheg_2_p2'
	+\| Library name = 'powheg_2_lib'
	+\| Process index = 2
	+\| Process components:
	+\| 1: 'powheg_2_p2_i1': d:dbar:u:ubar:s:sbar:c:cbar:b:bbar, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar => e-, e+ [dummy]
	+\| 2: 'powheg_2_p2_i2': gl:dbar:d:ubar:u:sbar:s:cbar:c:bbar:b:dbar:d:ubar:u:sbar:s:cbar:c:bbar:b, dbar:d:ubar:u:sbar:s:cbar:c:bbar:b:gl:dbar:d:ubar:u:sbar:s:cbar:c:bbar:b => e-, e+, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar:d:dbar:u:ubar:s:sbar:c:cbar:b:bbar:gl [dummy], [real]
	+\| 3: 'powheg_2_p2_i3': d:dbar:u:ubar:s:sbar:c:cbar:b:bbar, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar => e-, e+ [dummy], [virtual]
	+\| 4: 'powheg_2_p2_i4': d:dbar:u:ubar:s:sbar:c:cbar:b:bbar, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar => e-, e+ [inactive], [subtraction]
	+\| 5: 'powheg_2_p2_i5': d:dbar:u:ubar:s:sbar:c:cbar:b:bbar, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar => e-, e+ [dummy], [dglap]
	+\| ------------------------------------------------------------------------
	+\| Phase space: 2 channels, 5 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Phase space: 2 channels, 5 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Phase space: 2 channels, 5 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Phase space: 2 channels, 5 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Beam structure: pdf_builtin, none => none, pdf_builtin
	+\| Beam structure: 2 channels, 2 dimensions
	+\| Applying user-defined cuts.
	+\| Using user-defined general scale.
	+\| Starting integration for process 'powheg_2_p2'
	+\| Integration hook: add POWHEG hook
	+\| Shower: interfacing PDF builtin set #8
	+\| Integrate: iterations = 1:1000:"gw"
	+\| Integrator: 2 chains, 2 channels, 7 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 1000 5.130E+10 2.21E+10 43.06 13.62 0.4
	+\|-----------------------------------------------------------------------------\|
	+ 1 1000 5.130E+10 2.21E+10 43.06 13.62 0.4
	+\|=============================================================================\|
	+\| Starting simulation for process 'powheg_2_p2'
	+\| Simulate: using integration grids from file 'powheg_2_p2.m1.vg'
	+\| Simulate: activating parton shower
	+\| Shower: interfacing PDF builtin set #8
	+\| Shower: Using WHIZARD internal shower
	+\| Simulate: applying POWHEG matching
	+\| QCD alpha: using a running strong coupling
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 490
	+\| Simulation: requested number of events = 5
	+\| corr. to luminosity [fb-1] = 9.7474E-11
	+\| Events: writing to ASCII file 'powheg_2_p2.debug'
	+\| Events: generating 5 unweighted, unpolarized events ...
	+\| Events: event normalization mode '1'
	+\| POWHEG: using grids from file 'powheg_2_p2.pg'
	+\| Grid: Mean value of the grid: 4.13447E+04
	+\| Grid: Max value of the grid: 5.16344E+06
	+\| Grid: Mean/Max value of the grid: 8.00719E-03
	+\| ... event sample complete.
	+\| Events: actual unweighting efficiency = 0.45 %
	+Warning: Encountered events with excess weight: 1 events ( 20.000 %)
	+\| Maximum excess weight = 2.022E+00
	+\| Average excess weight = 4.045E-01
	+\| Events: closing ASCII file 'powheg_2_p2.debug'
	+\| There were no errors and 2 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Contents of powheg_2_p1.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.73082E+07
	- Squared matrix el. (prc) = 1.73082E+07
	- Event weight (ref) = 1.00000E+00
	- Event weight (prc) = 1.00000E+00
	+ Squared matrix el. (ref) = -1.02632E+06
	+ Squared matrix el. (prc) = -1.02632E+06
	+ Event weight (ref) = -1.00000E+00
	+ Event weight (prc) = -1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 6.899492E+02
	- P = 0.000000E+00 0.000000E+00 6.899492E+02
	+ E = 4.144810E+00
	+ P = 0.000000E+00 0.000000E+00 4.144810E+00
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 4.215047E-01
	- P = 0.000000E+00 0.000000E+00 -4.215047E-01
	+ E = 1.701568E+01
	+ P = 0.000000E+00 0.000000E+00 -1.701568E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.310051E+03
	- P = 0.000000E+00 0.000000E+00 6.310051E+03
	+ E = 6.995855E+03
	+ P = 0.000000E+00 0.000000E+00 6.995855E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.999578E+03
	- P = 0.000000E+00 0.000000E+00 -6.999578E+03
	+ E = 6.982984E+03
	+ P = 0.000000E+00 0.000000E+00 -6.982984E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 6.087387E+02
	- P = -9.888752E+00 -4.804441E+00 6.086394E+02
	+ E = 6.597124E+00
	+ P = -5.692672E+00 -3.332077E+00 1.130586E-01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 8.163209E+01
	- P = 9.888752E+00 4.804441E+00 8.088837E+01
	+ E = 1.456337E+01
	+ P = 5.692672E+00 3.332077E+00 -1.298393E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 689.949 0.000 0.000 689.949 0.000
	- 4 [i] dbar 0 0 2 7-8 0.422 0.000 0.000 -0.422 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6310.051 0.000 0.000 6310.051 0.000
	- 6 [x] hr3 0 0 2 [none] 6999.578 0.000 0.000 -6999.578 0.000
	- 7 [o] e- 0 0 3-4 [none] 608.739 -9.889 -4.804 608.639 0.000
	- 8 [o] e+ 0 0 3-4 [none] 81.632 9.889 4.804 80.888 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 690.371 0.000 0.000 689.528
	-Sum of beam remnant momenta: p(0:3) = 13309.629 0.000 0.000 -689.528
	-Sum of outgoing momenta: p(0:3) = 690.371 0.000 0.000 689.528
	+ 3 [i] d 0 0 1 7-8 4.145 0.000 0.000 4.145 0.000
	+ 4 [i] dbar 0 0 2 7-8 17.016 0.000 0.000 -17.016 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6995.855 0.000 0.000 6995.855 0.000
	+ 6 [x] hr3 0 0 2 [none] 6982.984 0.000 0.000 -6982.984 0.000
	+ 7 [o] e- 0 0 3-4 [none] 6.597 -5.693 -3.332 0.113 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 14.563 5.693 3.332 -12.984 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 21.160 0.000 0.000 -12.871
	+Sum of beam remnant momenta: p(0:3) = 13978.840 0.000 0.000 12.871
	+Sum of outgoing momenta: p(0:3) = 21.160 0.000 0.000 -12.871
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 3.41067E+01
	+sqrts_hat* => 1.67960E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 1.73082E+07
	-sqme_ref* => 1.73082E+07
	+sqme* => -1.02632E+06
	+sqme_ref* => -1.02632E+06
	event_index* => 1
	-event_weight* => 1.00000E+00
	-event_weight_ref* => 1.00000E+00
	-event_excess* => 2.70702E-01
	+event_weight* => -1.00000E+00
	+event_weight_ref* => -1.00000E+00
	+event_excess* => 4.24806E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-6.8994924E+02; 0.0000000E+00, 0.0000000E+00,-6.8994924E+02\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-4.2150470E-01; 0.0000000E+00, 0.0000000E+00, 4.2150470E-01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.3100508E+03; 0.0000000E+00, 0.0000000E+00, 6.3100508E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9995785E+03; 0.0000000E+00, 0.0000000E+00,-6.9995785E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.0873866E+02;-9.8887519E+00,-4.8044408E+00, 6.0863937E+02\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 8.1632087E+01; 9.8887519E+00, 4.8044408E+00, 8.0888365E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-4.1448102E+00; 0.0000000E+00, 0.0000000E+00,-4.1448102E+00\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-1.7015683E+01; 0.0000000E+00, 0.0000000E+00, 1.7015683E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9958552E+03; 0.0000000E+00, 0.0000000E+00, 6.9958552E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9829843E+03; 0.0000000E+00, 0.0000000E+00,-6.9829843E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 6.5971236E+00;-5.6926722E+00,-3.3320775E+00, 1.1305860E-01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 1.4563369E+01; 5.6926722E+00, 3.3320775E+00,-1.2983931E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 2.00716E+06
	- Squared matrix el. (prc) = 2.00716E+06
	+ Squared matrix el. (ref) = 1.56786E+07
	+ Squared matrix el. (prc) = 1.56786E+07
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 1.446225E+03
	- P = 0.000000E+00 0.000000E+00 1.446225E+03
	+ E = 4.777759E-01
	+ P = 0.000000E+00 0.000000E+00 4.777759E-01
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 1.042581E+01
	- P = 0.000000E+00 0.000000E+00 -1.042581E+01
	+ E = 4.041187E+02
	+ P = 0.000000E+00 0.000000E+00 -4.041187E+02
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 5.553775E+03
	- P = 0.000000E+00 0.000000E+00 5.553775E+03
	+ E = 6.999522E+03
	+ P = 0.000000E+00 0.000000E+00 6.999522E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.989574E+03
	- P = 0.000000E+00 0.000000E+00 -6.989574E+03
	+ E = 6.595881E+03
	+ P = 0.000000E+00 0.000000E+00 -6.595881E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 5.692890E+02
	- P = -1.196264E+02 5.256740E+00 5.565536E+02
	+ E = 3.631332E+02
	+ P = -8.208406E+00 -1.754884E+00 -3.630361E+02
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 8.873620E+02
	- P = 1.196264E+02 -5.256740E+00 8.792458E+02
	+ E = 4.146331E+01
	+ P = 8.208406E+00 1.754884E+00 -4.060478E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 1446.225 0.000 0.000 1446.225 0.000
	- 4 [i] dbar 0 0 2 7-8 10.426 0.000 0.000 -10.426 0.000
	- 5 [x] hr3bar 0 0 1 [none] 5553.775 0.000 0.000 5553.775 0.000
	- 6 [x] hr3 0 0 2 [none] 6989.574 0.000 0.000 -6989.574 0.000
	- 7 [o] e- 0 0 3-4 [none] 569.289 -119.626 5.257 556.554 0.000
	- 8 [o] e+ 0 0 3-4 [none] 887.362 119.626 -5.257 879.246 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 1456.651 0.000 0.000 1435.799
	-Sum of beam remnant momenta: p(0:3) = 12543.349 0.000 0.000 -1435.799
	-Sum of outgoing momenta: p(0:3) = 1456.651 0.000 0.000 1435.799
	+ 3 [i] d 0 0 1 7-8 0.478 0.000 0.000 0.478 0.000
	+ 4 [i] dbar 0 0 2 7-8 404.119 0.000 0.000 -404.119 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6999.522 0.000 0.000 6999.522 0.000
	+ 6 [x] hr3 0 0 2 [none] 6595.881 0.000 0.000 -6595.881 0.000
	+ 7 [o] e- 0 0 3-4 [none] 363.133 -8.208 -1.755 -363.036 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 41.463 8.208 1.755 -40.605 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 404.596 0.000 0.000 -403.641
	+Sum of beam remnant momenta: p(0:3) = 13595.404 0.000 0.000 403.641
	+Sum of outgoing momenta: p(0:3) = 404.596 0.000 0.000 -403.641
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 2.45586E+02
	+sqrts_hat* => 2.77905E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 2.00716E+06
	-sqme_ref* => 2.00716E+06
	+sqme* => 1.56786E+07
	+sqme_ref* => 1.56786E+07
	event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	-event_excess* => 0.00000E+00
	+event_excess* => 2.10630E+01
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.4462252E+03; 0.0000000E+00, 0.0000000E+00,-1.4462252E+03\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-1.0425811E+01; 0.0000000E+00, 0.0000000E+00, 1.0425811E+01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 5.5537748E+03; 0.0000000E+00, 0.0000000E+00, 5.5537748E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9895742E+03; 0.0000000E+00, 0.0000000E+00,-6.9895742E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 5.6928904E+02;-1.1962638E+02, 5.2567405E+00, 5.5655360E+02\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 8.8736197E+02; 1.1962638E+02,-5.2567405E+00, 8.7924579E+02\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-4.7777590E-01; 0.0000000E+00, 0.0000000E+00,-4.7777590E-01\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-4.0411871E+02; 0.0000000E+00, 0.0000000E+00, 4.0411871E+02\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9995222E+03; 0.0000000E+00, 0.0000000E+00, 6.9995222E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.5958813E+03; 0.0000000E+00, 0.0000000E+00,-6.5958813E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 3.6313317E+02;-8.2084060E+00,-1.7548845E+00,-3.6303615E+02\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 4.1463310E+01; 8.2084060E+00, 1.7548845E+00,-4.0604784E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	Event #3
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 2.38562E+07
	- Squared matrix el. (prc) = 2.38562E+07
	+ Squared matrix el. (ref) = 1.40236E+07
	+ Squared matrix el. (prc) = 1.40236E+07
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 9
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 8.712482E+01
	- P = 0.000000E+00 0.000000E+00 8.712482E+01
	+ E = 2.289819E+02
	+ P = 0.000000E+00 0.000000E+00 2.289819E+02
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 3.936136E+00
	- P = 0.000000E+00 0.000000E+00 -3.936136E+00
	+ E = 7.287631E+00
	+ P = 0.000000E+00 0.000000E+00 -7.287631E+00
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.912875E+03
	- P = 0.000000E+00 0.000000E+00 6.912875E+03
	+ E = 6.771018E+03
	+ P = 0.000000E+00 0.000000E+00 6.771018E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.996064E+03
	- P = 0.000000E+00 0.000000E+00 -6.996064E+03
	+ E = 6.992712E+03
	+ P = 0.000000E+00 0.000000E+00 -6.992712E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 5.371039E+01
	- P = 1.850581E+00 -1.806232E+01 5.054833E+01
	+ E = 1.673149E+02
	+ P = -2.049955E+01 -3.033179E+01 1.632606E+02
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 3.735057E+01
	- P = -1.850581E+00 1.806232E+01 3.264036E+01
	+ E = 6.895466E+01
	+ P = 2.049955E+01 3.033179E+01 5.843369E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 3
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 87.125 0.000 0.000 87.125 0.000
	- 4 [i] dbar 0 0 2 7-8 3.936 0.000 0.000 -3.936 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6912.875 0.000 0.000 6912.875 0.000
	- 6 [x] hr3 0 0 2 [none] 6996.064 0.000 0.000 -6996.064 0.000
	- 7 [o] e- 0 0 3-4 [none] 53.710 1.851 -18.062 50.548 0.000
	- 8 [o] e+ 0 0 3-4 [none] 37.351 -1.851 18.062 32.640 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 91.061 0.000 0.000 83.189
	-Sum of beam remnant momenta: p(0:3) = 13908.939 0.000 0.000 -83.189
	-Sum of outgoing momenta: p(0:3) = 91.061 0.000 0.000 83.189
	+ 3 [i] d 0 0 1 7-8 228.982 0.000 0.000 228.982 0.000
	+ 4 [i] dbar 0 0 2 7-8 7.288 0.000 0.000 -7.288 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6771.018 0.000 0.000 6771.018 0.000
	+ 6 [x] hr3 0 0 2 [none] 6992.712 0.000 0.000 -6992.712 0.000
	+ 7 [o] e- 0 0 3-4 [none] 167.315 -20.500 -30.332 163.261 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 68.955 20.500 30.332 58.434 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 236.270 0.000 0.000 221.694
	+Sum of beam remnant momenta: p(0:3) = 13763.730 0.000 0.000 -221.694
	+Sum of outgoing momenta: p(0:3) = 236.270 0.000 0.000 221.694
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 3.70370E+01
	+sqrts_hat* => 8.17003E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 2.38562E+07
	-sqme_ref* => 2.38562E+07
	+sqme* => 1.40236E+07
	+sqme_ref* => 1.40236E+07
	event_index* => 3
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	-event_excess* => 4.63589E-01
	+event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-8.7124821E+01; 0.0000000E+00, 0.0000000E+00,-8.7124821E+01\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-3.9361364E+00; 0.0000000E+00, 0.0000000E+00, 3.9361364E+00\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9128752E+03; 0.0000000E+00, 0.0000000E+00, 6.9128752E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9960639E+03; 0.0000000E+00, 0.0000000E+00,-6.9960639E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 5.3710386E+01; 1.8505811E+00,-1.8062325E+01, 5.0548327E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 3.7350571E+01;-1.8505811E+00, 1.8062325E+01, 3.2640357E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-2.2898188E+02; 0.0000000E+00, 0.0000000E+00,-2.2898188E+02\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-7.2876314E+00; 0.0000000E+00, 0.0000000E+00, 7.2876314E+00\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.7710181E+03; 0.0000000E+00, 0.0000000E+00, 6.7710181E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9927124E+03; 0.0000000E+00, 0.0000000E+00,-6.9927124E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 1.6731485E+02;-2.0499548E+01,-3.0331794E+01, 1.6326056E+02\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 6.8954662E+01; 2.0499548E+01, 3.0331794E+01, 5.8433691E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	Event #4
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.48421E+07
	- Squared matrix el. (prc) = 1.48421E+07
	+ Squared matrix el. (ref) = 5.08214E+06
	+ Squared matrix el. (prc) = 5.08214E+06
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 12
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 1.939732E+02
	- P = 0.000000E+00 0.000000E+00 1.939732E+02
	+ E = 5.930977E+01
	+ P = 0.000000E+00 0.000000E+00 5.930977E+01
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 4.051484E+00
	- P = 0.000000E+00 0.000000E+00 -4.051484E+00
	+ E = 3.380226E+01
	+ P = 0.000000E+00 0.000000E+00 -3.380226E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.806027E+03
	- P = 0.000000E+00 0.000000E+00 6.806027E+03
	+ E = 6.940690E+03
	+ P = 0.000000E+00 0.000000E+00 6.940690E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.995949E+03
	- P = 0.000000E+00 0.000000E+00 -6.995949E+03
	+ E = 6.966198E+03
	+ P = 0.000000E+00 0.000000E+00 -6.966198E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 1.889687E+02
	- P = -8.729125E+00 -2.109992E+00 1.887552E+02
	+ E = 4.975970E+01
	+ P = -3.488349E+01 -2.571858E+01 2.444840E+01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 9.055960E+00
	- P = 8.729125E+00 2.109992E+00 1.166507E+00
	+ E = 4.335233E+01
	+ P = 3.488349E+01 2.571858E+01 1.059111E+00
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 4
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 193.973 0.000 0.000 193.973 0.000
	- 4 [i] dbar 0 0 2 7-8 4.051 0.000 0.000 -4.051 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6806.027 0.000 0.000 6806.027 0.000
	- 6 [x] hr3 0 0 2 [none] 6995.949 0.000 0.000 -6995.949 0.000
	- 7 [o] e- 0 0 3-4 [none] 188.969 -8.729 -2.110 188.755 0.000
	- 8 [o] e+ 0 0 3-4 [none] 9.056 8.729 2.110 1.167 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 198.025 0.000 0.000 189.922
	-Sum of beam remnant momenta: p(0:3) = 13801.975 0.000 0.000 -189.922
	-Sum of outgoing momenta: p(0:3) = 198.025 0.000 0.000 189.922
	+ 3 [i] d 0 0 1 7-8 59.310 0.000 0.000 59.310 0.000
	+ 4 [i] dbar 0 0 2 7-8 33.802 0.000 0.000 -33.802 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6940.690 0.000 0.000 6940.690 0.000
	+ 6 [x] hr3 0 0 2 [none] 6966.198 0.000 0.000 -6966.198 0.000
	+ 7 [o] e- 0 0 3-4 [none] 49.760 -34.883 -25.719 24.448 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 43.352 34.883 25.719 1.059 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 93.112 0.000 0.000 25.508
	+Sum of beam remnant momenta: p(0:3) = 13906.888 0.000 0.000 -25.508
	+Sum of outgoing momenta: p(0:3) = 93.112 0.000 0.000 25.508
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 5.60671E+01
	+sqrts_hat* => 8.95501E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 1.48421E+07
	-sqme_ref* => 1.48421E+07
	+sqme* => 5.08214E+06
	+sqme_ref* => 5.08214E+06
	event_index* => 4
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.9397318E+02; 0.0000000E+00, 0.0000000E+00,-1.9397318E+02\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-4.0514843E+00; 0.0000000E+00, 0.0000000E+00, 4.0514843E+00\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.8060268E+03; 0.0000000E+00, 0.0000000E+00, 6.8060268E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9959485E+03; 0.0000000E+00, 0.0000000E+00,-6.9959485E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 1.8896870E+02;-8.7291246E+00,-2.1099918E+00, 1.8875519E+02\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 9.0559605E+00; 8.7291246E+00, 2.1099918E+00, 1.1665068E+00\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-5.9309772E+01; 0.0000000E+00, 0.0000000E+00,-5.9309772E+01\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-3.3802260E+01; 0.0000000E+00, 0.0000000E+00, 3.3802260E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9406902E+03; 0.0000000E+00, 0.0000000E+00, 6.9406902E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9661977E+03; 0.0000000E+00, 0.0000000E+00,-6.9661977E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 4.9759698E+01;-3.4883490E+01,-2.5718579E+01, 2.4448401E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 4.3352335E+01; 3.4883490E+01, 2.5718579E+01, 1.0591113E+00\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	Event #5
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.12189E+07
	- Squared matrix el. (prc) = 1.12189E+07
	+ Squared matrix el. (ref) = 3.14741E+06
	+ Squared matrix el. (prc) = 3.14741E+06
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 15
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 2.299967E+00
	- P = 0.000000E+00 0.000000E+00 2.299967E+00
	+ E = 1.411403E+03
	+ P = 0.000000E+00 0.000000E+00 1.411403E+03
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 1.055385E+02
	- P = 0.000000E+00 0.000000E+00 -1.055385E+02
	+ E = 6.193471E+00
	+ P = 0.000000E+00 0.000000E+00 -6.193471E+00
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.997700E+03
	- P = 0.000000E+00 0.000000E+00 6.997700E+03
	+ E = 5.588597E+03
	+ P = 0.000000E+00 0.000000E+00 5.588597E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.894461E+03
	- P = 0.000000E+00 0.000000E+00 -6.894461E+03
	+ E = 6.993807E+03
	+ P = 0.000000E+00 0.000000E+00 -6.993807E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 6.359252E+01
	- P = -1.344828E+00 -1.524474E+01 -6.172356E+01
	+ E = 2.523280E+02
	+ P = -4.531771E+01 5.475505E+01 2.421107E+02
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 4.424595E+01
	- P = 1.344828E+00 1.524474E+01 -4.151498E+01
	+ E = 1.165269E+03
	+ P = 4.531771E+01 -5.475505E+01 1.163099E+03
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 5
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 2.300 0.000 0.000 2.300 0.000
	- 4 [i] dbar 0 0 2 7-8 105.539 0.000 0.000 -105.539 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6997.700 0.000 0.000 6997.700 0.000
	- 6 [x] hr3 0 0 2 [none] 6894.461 0.000 0.000 -6894.461 0.000
	- 7 [o] e- 0 0 3-4 [none] 63.593 -1.345 -15.245 -61.724 0.000
	- 8 [o] e+ 0 0 3-4 [none] 44.246 1.345 15.245 -41.515 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 107.838 0.000 0.000 -103.239
	-Sum of beam remnant momenta: p(0:3) = 13892.162 0.000 0.000 103.239
	-Sum of outgoing momenta: p(0:3) = 107.838 0.000 0.000 -103.239
	+ 3 [i] d 0 0 1 7-8 1411.403 0.000 0.000 1411.403 0.000
	+ 4 [i] dbar 0 0 2 7-8 6.193 0.000 0.000 -6.193 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 5588.597 0.000 0.000 5588.597 0.000
	+ 6 [x] hr3 0 0 2 [none] 6993.807 0.000 0.000 -6993.807 0.000
	+ 7 [o] e- 0 0 3-4 [none] 252.328 -45.318 54.755 242.111 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 1165.269 45.318 -54.755 1163.099 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1417.597 0.000 0.000 1405.210
	+Sum of beam remnant momenta: p(0:3) = 12582.403 0.000 0.000 -1405.210
	+Sum of outgoing momenta: p(0:3) = 1417.597 0.000 0.000 1405.210
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 3.11599E+01
	+sqrts_hat* => 1.86992E+02
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 1.12189E+07
	-sqme_ref* => 1.12189E+07
	+sqme* => 3.14741E+06
	+sqme_ref* => 3.14741E+06
	event_index* => 5
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-2.2999667E+00; 0.0000000E+00, 0.0000000E+00,-2.2999667E+00\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-1.0553851E+02; 0.0000000E+00, 0.0000000E+00, 1.0553851E+02\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9977000E+03; 0.0000000E+00, 0.0000000E+00, 6.9977000E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.8944615E+03; 0.0000000E+00, 0.0000000E+00,-6.8944615E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.3592525E+01;-1.3448283E+00,-1.5244744E+01,-6.1723565E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 4.4245950E+01; 1.3448283E+00, 1.5244744E+01,-4.1514977E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-1.4114032E+03; 0.0000000E+00, 0.0000000E+00,-1.4114032E+03\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-6.1934706E+00; 0.0000000E+00, 0.0000000E+00, 6.1934706E+00\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 5.5885968E+03; 0.0000000E+00, 0.0000000E+00, 5.5885968E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9938065E+03; 0.0000000E+00, 0.0000000E+00,-6.9938065E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 2.5232798E+02;-4.5317706E+01, 5.4755050E+01, 2.4211072E+02\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 1.1652687E+03; 4.5317706E+01,-5.4755050E+01, 1.1630990E+03\| 0.0000000E+00\| 8)
	========================================================================
	+Contents of powheg_2_p1.pg:
	+ 3
	+ 10 10 3
	+ 9.36377972XE+02 1.27014725XE+03 7.12222239XE+02 5.07011069XE+02 1.58749782XE+02 1.68256432XE+02 2.04915805XE+04 2.28789927XE+01 0.00000000XE+00 3.35534962XE-01 3.74922833XE+02 3.41570486XE+02 3.42219159XE+02 8.83085071XE+02 3.74067497XE+02 0.00000000XE+00 4.33587330XE+01 3.46136760XE+03 1.05220475XE+01 5.10677892XE+02 4.87298317XE+01 1.85394291XE+03 7.66400906XE+02 4.36909971XE+02 7.32149141XE+00 1.65926221XE+01 0.00000000XE+00 5.09151024XE+02 0.00000000XE+00 3.90881158XE-01 3.21481091XE+02 1.22859103XE+03 1.30321710XE+03 9.35994508XE+02 8.78441415XE+01 3.22652689XE+02 3.16402956XE-02 1.61173549XE+01 3.07645142XE-01 2.30893062XE-01 6.70813579XE+02 9.05752936XE+02 8.89378826XE+02 1.60866309XE+02 7.18468684XE+02 0.00000000XE+00 2.68929454XE-02 1.79687328XE+04 1.95252097XE+03 0.00000000XE+00 4.38342311XE+02 3.64933048XE+02 8.51062451XE+02 7.37261273XE+00 8.09800971XE+03 3.56291493XE+00 5.31629831XE+00 1.14766036XE+00 3.06511798XE+01 1.71718011XE+03 1.38911155XE+02 9.10591468XE+02 4.48805050XE+02 4.79915259XE+02 4.61034527XE+02 1.91231435XE+02 3.14357525XE+00 1.11847405XE-01 1.50598010XE+00 2.44719731XE-01 1.18397005XE+02 4.83960203XE+02 6.96477409XE+02 1.08227342XE+04 1.49336843XE+02 1.50931004XE+02 3.67336925XE+02 4.26851654XE+02 1.15544003XE+01 1.65875294XE-04 1.96947793XE+02 9.54019292XE+02 4.80477630XE+02 3.48280443XE+02 3.80277082XE+01 8.23227927XE+01 2.24930033XE+02 1.77461828XE+01 1.87405713XE+01 1.22158007XE+02 4.55642417XE+01 2.53844641XE+02 2.80608779XE+02 1.63073440XE+02 4.61520313XE+00 3.97537969XE+01 3.91394260XE-01 1.12920636XE+02 5.78902604XE-01 2.67928166XE+02 2.59939454XE+04 5.51963074XE+04 5.50676497XE+04 3.30863082XE+03 5.52731753XE+03 1.06808990XE+03 7.46852287XE+04 1.29824192XE+04 0.00000000XE+00 1.02588742XE+01 1.58867726XE+04 3.12931927XE+04 1.56391260XE+04 2.01682986XE+04 9.98401986XE+03 0.00000000XE+00 8.95046635XE+03 2.06560729XE+05 1.08234236XE+02 4.74778420XE+04 8.76982937XE+02 1.46595212XE+05 1.57310306XE+04 2.86003508XE+04 1.47286796XE+02 5.06101561XE+03 0.00000000XE+00 1.68235043XE+04 0.00000000XE+00 2.36848567XE+00 2.95678701XE+04 1.16030011XE+04 9.07304476XE+04 6.91457443XE+04 1.93435270XE+04 2.22261615XE+04 7.39508706XE-01 1.47628132XE+02 1.92706543XE+01 2.17768456XE+00 1.00642630XE+05 3.69719274XE+04 6.34531246XE+04 7.75383737XE+03 4.44561783XE+04 0.00000000XE+00 3.87635087XE+03 5.04119206XE+04 1.29470475XE+04 0.00000000XE+00 4.43620549XE+04 3.43723330XE+04 1.75125479XE+04 2.53147635XE+02 2.16560537XE+05 7.31396697XE+01 2.40454006XE+03 7.91847065XE+00 9.04023105XE+02 5.96366823XE+03 8.99357606XE+03 3.64205446XE+04 1.93248008XE+04 8.17540812XE+03 1.75234263XE+04 1.62807049XE+04 2.22402574XE+01 2.51831158XE+00 1.03842513XE+02 1.12047595XE+02 6.32427650XE+03 2.86584520XE+04 6.48296397XE+04 4.48802870XE+05 1.01682275XE+04 1.06414215XE+04 2.20477871XE+03 1.43412399XE+04 4.59390816XE+02 3.52899898XE-03 2.28558833XE+04 7.49840472XE+04 4.12386846XE+04 7.96273731XE+04 9.97734075XE+03 7.86231295XE+03 3.61980549XE+04 1.04974679XE+03 5.81383202XE+02 2.76254379XE+02 9.93511480XE+02 3.37010439XE+04 1.34246270XE+04 1.20502870XE+04 1.37759049XE+03 1.16831142XE+03 1.90767171XE+01 4.79967626XE+03 3.75004736XE+01 2.09319136XE+03 1.04230233XE+03 7.07802260XE+02 1.19405282XE+03 7.53277555XE+02 1.05969180XE+02 5.76208606XE+01 1.12237079XE+04 9.12228569XE+01 0.00000000XE+00 7.38411989XE-01 5.00502981XE+02 2.45820530XE+02 2.11455341XE+02 3.33389936XE+02 6.97003703XE+03 0.00000000XE+00 1.34340878XE+01 8.79922945XE+03 3.50906061XE+01 1.08950387XE+03 7.14175676XE+01 9.19865255XE+02 6.75782498XE+02 1.40738755XE+02 5.40666265XE+01 6.94314211XE+00 0.00000000XE+00 1.53917845XE+02 0.00000000XE+00 2.13462225XE+00 1.76862348XE+02 1.27182748XE+03 4.37140771XE+02 9.43675787XE+02 3.21933646XE+02 1.69537243XE+03 6.14216260XE-02 1.28819982XE+02 1.92305664XE+00 5.29673186XE-01 8.26190305XE+02 1.58499791XE+03 6.59699789XE+02 2.04384952XE+03 6.68001900XE+03 0.00000000XE+00 5.35014249XE-01 6.58557152XE+03 6.09543785XE+02 0.00000000XE+00 1.06687940XE+03 1.51550408XE+02 6.74906147XE+02 9.18931382XE+01 6.21968578XE+03 2.27383855XE+00 2.23678240XE+00 2.41910162XE+00 8.19895341XE+01 7.16327364XE+02 1.06895277XE+02 4.38286299XE+02 2.63507710XE+02 2.34650688XE+02 2.34215271XE+02 6.15299896XE+01 8.20697542XE+01 6.38001173XE-02 2.00097976XE+01 6.14291530XE-01 2.43087456XE+02 2.54858533XE+02 7.95447208XE+02 3.98388863XE+03 1.27467144XE+02 5.71429470XE+01 2.95906381XE+03 1.71427943XE+03 4.21716263XE+01 5.75844847XE-04 7.20591226XE+02 1.70503147XE+03 1.69564123XE+03 4.76607854XE+02 4.18131816XE+01 1.30822460XE+03 1.30235077XE+03 1.15360023XE+02 1.29196411XE+01 7.71026784XE+01 1.53353304XE+02 2.14527513XE+02 9.07102570XE+02 5.74565955XE+01 1.11835760XE+01 4.70031209XE+01 6.60728011XE-01 8.40923638XE+01 1.34318237XE+00 4.31199193XE+02
	+Contents of powheg_2_p2.debug:
	========================================================================
	- Event #6
	+ Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = -7.01412E+06
	- Squared matrix el. (prc) = -7.01412E+06
	- Event weight (ref) = -1.00000E+00
	- Event weight (prc) = -1.00000E+00
	+ Squared matrix el. (ref) = 1.97921E+08
	+ Squared matrix el. (prc) = 1.97921E+08
	+ Event weight (ref) = 1.00000E+00
	+ Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	- Selected channel = 2
	+ Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 18
	+ seed = 32047106
	+ calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	- Particle 3 [i] f(1)
	- E = 6.920607E+00
	- P = 0.000000E+00 0.000000E+00 6.920607E+00
	+ Particle 3 [i] f(2)
	+ E = 5.136964E+00
	+ P = 0.000000E+00 0.000000E+00 5.136964E+00
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	- Particle 4 [i] f(-1)
	- E = 6.366500E+00
	- P = 0.000000E+00 0.000000E+00 -6.366500E+00
	+ Particle 4 [i] f(-2)
	+ E = 5.762733E+01
	+ P = 0.000000E+00 0.000000E+00 -5.762733E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.993079E+03
	- P = 0.000000E+00 0.000000E+00 6.993079E+03
	+ E = 6.994863E+03
	+ P = 0.000000E+00 0.000000E+00 6.994863E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.993634E+03
	- P = 0.000000E+00 0.000000E+00 -6.993634E+03
	+ E = 6.942373E+03
	+ P = 0.000000E+00 0.000000E+00 -6.942373E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 6.520088E+00
	- P = 2.767436E+00 5.258452E+00 -2.683566E+00
	+ E = 3.629243E+01
	+ P = 4.503508E-01 -1.689570E+01 -3.211656E+01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 6.767019E+00
	- P = -2.767436E+00 -5.258452E+00 3.237673E+00
	+ E = 2.647186E+01
	+ P = -4.503508E-01 1.689570E+01 -2.037381E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 6
	+ seed = 32047107
	+ calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 6.921 0.000 0.000 6.921 0.000
	- 4 [i] dbar 0 0 2 7-8 6.366 0.000 0.000 -6.366 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6993.079 0.000 0.000 6993.079 0.000
	- 6 [x] hr3 0 0 2 [none] 6993.634 0.000 0.000 -6993.634 0.000
	- 7 [o] e- 0 0 3-4 [none] 6.520 2.767 5.258 -2.684 0.000
	- 8 [o] e+ 0 0 3-4 [none] 6.767 -2.767 -5.258 3.238 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 13.287 0.000 0.000 0.554
	-Sum of beam remnant momenta: p(0:3) = 13986.713 0.000 0.000 -0.554
	-Sum of outgoing momenta: p(0:3) = 13.287 0.000 0.000 0.554
	+ 3 [i] u 0 0 1 7-8 5.137 0.000 0.000 5.137 0.000
	+ 4 [i] ubar 0 0 2 7-8 57.627 0.000 0.000 -57.627 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6994.863 0.000 0.000 6994.863 0.000
	+ 6 [x] hr3 0 0 2 [none] 6942.373 0.000 0.000 -6942.373 0.000
	+ 7 [o] e- 0 0 3-4 [none] 36.292 0.450 -16.896 -32.117 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 26.472 -0.450 16.896 -20.374 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 62.764 0.000 0.000 -52.490
	+Sum of beam remnant momenta: p(0:3) = 13937.236 0.000 0.000 52.490
	+Sum of outgoing momenta: p(0:3) = 62.764 0.000 0.000 -52.490
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 1.32755E+01
	+sqrts_hat* => 3.44110E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	-$process_id* => "powheg_2_p1"
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => -7.01412E+06
	-sqme_ref* => -7.01412E+06
	-event_index* => 6
	-event_weight* => -1.00000E+00
	-event_weight_ref* => -1.00000E+00
	-event_excess* => 1.54958E+00
	+sqme* => 1.97921E+08
	+sqme_ref* => 1.97921E+08
	+event_index* => 1
	+event_weight* => 1.00000E+00
	+event_weight_ref* => 1.00000E+00
	+event_excess* => 2.02245E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-6.9206073E+00; 0.0000000E+00, 0.0000000E+00,-6.9206073E+00\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-6.3664998E+00; 0.0000000E+00, 0.0000000E+00, 6.3664998E+00\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9930794E+03; 0.0000000E+00, 0.0000000E+00, 6.9930794E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9936335E+03; 0.0000000E+00, 0.0000000E+00,-6.9936335E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.5200879E+00; 2.7674357E+00, 5.2584523E+00,-2.6835658E+00\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 6.7670193E+00;-2.7674357E+00,-5.2584523E+00, 3.2376733E+00\| 0.0000000E+00\| 8)
	+ 3 prt(i:2\|-5.1369640E+00; 0.0000000E+00, 0.0000000E+00,-5.1369640E+00\| 0.0000000E+00\| 3)
	+ 4 prt(i:-2\|-5.7627330E+01; 0.0000000E+00, 0.0000000E+00, 5.7627330E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9948630E+03; 0.0000000E+00, 0.0000000E+00, 6.9948630E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9423727E+03; 0.0000000E+00, 0.0000000E+00,-6.9423727E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 3.6292433E+01; 4.5035076E-01,-1.6895697E+01,-3.2116558E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 2.6471861E+01;-4.5035076E-01, 1.6895697E+01,-2.0373808E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	- Event #7
	+ Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 4.68463E+07
	- Squared matrix el. (prc) = 4.68463E+07
	+ Squared matrix el. (ref) = 9.22764E+06
	+ Squared matrix el. (prc) = 9.22764E+06
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	- Selected channel = 2
	+ Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 21
	+ seed = 32047106
	+ calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 5.667369E-01
	- P = 0.000000E+00 0.000000E+00 5.667369E-01
	+ E = 1.899744E-01
	+ P = 0.000000E+00 0.000000E+00 1.899744E-01
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 7.081701E+01
	- P = 0.000000E+00 0.000000E+00 -7.081701E+01
	+ E = 1.454586E+03
	+ P = 0.000000E+00 0.000000E+00 -1.454586E+03
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.999433E+03
	- P = 0.000000E+00 0.000000E+00 6.999433E+03
	+ E = 6.999810E+03
	+ P = 0.000000E+00 0.000000E+00 6.999810E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.929183E+03
	- P = 0.000000E+00 0.000000E+00 -6.929183E+03
	+ E = 5.545414E+03
	+ P = 0.000000E+00 0.000000E+00 -5.545414E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 6.467810E+01
	- P = 2.796685E+00 -2.231923E+00 -6.457905E+01
	+ E = 7.434569E+01
	+ P = -4.000748E+00 -6.121976E+00 -7.398512E+01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 6.705646E+00
	- P = -2.796685E+00 2.231923E+00 -5.671222E+00
	+ E = 1.380430E+03
	+ P = 4.000748E+00 6.121976E+00 -1.380411E+03
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 7
	+ seed = 32047107
	+ calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 0.567 0.000 0.000 0.567 0.000
	- 4 [i] dbar 0 0 2 7-8 70.817 0.000 0.000 -70.817 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6999.433 0.000 0.000 6999.433 0.000
	- 6 [x] hr3 0 0 2 [none] 6929.183 0.000 0.000 -6929.183 0.000
	- 7 [o] e- 0 0 3-4 [none] 64.678 2.797 -2.232 -64.579 0.000
	- 8 [o] e+ 0 0 3-4 [none] 6.706 -2.797 2.232 -5.671 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 71.384 0.000 0.000 -70.250
	-Sum of beam remnant momenta: p(0:3) = 13928.616 0.000 0.000 70.250
	-Sum of outgoing momenta: p(0:3) = 71.384 0.000 0.000 -70.250
	+ 3 [i] d 0 0 1 7-8 0.190 0.000 0.000 0.190 0.000
	+ 4 [i] dbar 0 0 2 7-8 1454.586 0.000 0.000 -1454.586 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6999.810 0.000 0.000 6999.810 0.000
	+ 6 [x] hr3 0 0 2 [none] 5545.414 0.000 0.000 -5545.414 0.000
	+ 7 [o] e- 0 0 3-4 [none] 74.346 -4.001 -6.122 -73.985 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 1380.430 4.001 6.122 -1380.411 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1454.776 0.000 0.000 -1454.396
	+Sum of beam remnant momenta: p(0:3) = 12545.224 0.000 0.000 1454.396
	+Sum of outgoing momenta: p(0:3) = 1454.776 0.000 0.000 -1454.396
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 1.26704E+01
	+sqrts_hat* => 3.32466E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	-$process_id* => "powheg_2_p1"
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => 4.68463E+07
	-sqme_ref* => 4.68463E+07
	-event_index* => 7
	+sqme* => 9.22764E+06
	+sqme_ref* => 9.22764E+06
	+event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	-event_excess* => 1.72180E+01
	+event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-5.6673690E-01; 0.0000000E+00, 0.0000000E+00,-5.6673690E-01\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-7.0817012E+01; 0.0000000E+00, 0.0000000E+00, 7.0817012E+01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9994333E+03; 0.0000000E+00, 0.0000000E+00, 6.9994333E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9291830E+03; 0.0000000E+00, 0.0000000E+00,-6.9291830E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.4678103E+01; 2.7966851E+00,-2.2319227E+00,-6.4579053E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 6.7056461E+00;-2.7966851E+00, 2.2319227E+00,-5.6712224E+00\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-1.8997443E-01; 0.0000000E+00, 0.0000000E+00,-1.8997443E-01\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-1.4545857E+03; 0.0000000E+00, 0.0000000E+00, 1.4545857E+03\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9998100E+03; 0.0000000E+00, 0.0000000E+00, 6.9998100E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 5.5454143E+03; 0.0000000E+00, 0.0000000E+00,-5.5454143E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 7.4345695E+01;-4.0007478E+00,-6.1219761E+00,-7.3985118E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 1.3804300E+03; 4.0007478E+00, 6.1219761E+00,-1.3804106E+03\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	- Event #8
	+ Event #3
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.47022E+07
	- Squared matrix el. (prc) = 1.47022E+07
	+ Squared matrix el. (ref) = 3.30803E+07
	+ Squared matrix el. (prc) = 3.30803E+07
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	- Selected channel = 2
	+ Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 24
	+ seed = 32047106
	+ calls = 9
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	- Particle 3 [i] f(1)
	- E = 1.748870E+01
	- P = 0.000000E+00 0.000000E+00 1.748870E+01
	+ Particle 3 [i] f(2)
	+ E = 3.284086E+02
	+ P = 0.000000E+00 0.000000E+00 3.284086E+02
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	- Particle 4 [i] f(-1)
	- E = 6.169637E+01
	- P = 0.000000E+00 0.000000E+00 -6.169637E+01
	+ Particle 4 [i] f(-2)
	+ E = 2.154928E+01
	+ P = 0.000000E+00 0.000000E+00 -2.154928E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.982511E+03
	- P = 0.000000E+00 0.000000E+00 6.982511E+03
	+ E = 6.671591E+03
	+ P = 0.000000E+00 0.000000E+00 6.671591E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.938304E+03
	- P = 0.000000E+00 0.000000E+00 -6.938304E+03
	+ E = 6.978451E+03
	+ P = 0.000000E+00 0.000000E+00 -6.978451E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 2.709141E+01
	- P = 2.658050E+01 -5.228591E+00 2.882695E-01
	+ E = 1.674570E+02
	+ P = 5.460604E+01 -6.386031E+01 1.448513E+02
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 5.209366E+01
	- P = -2.658050E+01 5.228591E+00 -4.449594E+01
	+ E = 1.825009E+02
	+ P = -5.460604E+01 6.386031E+01 1.620080E+02
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 8
	+ seed = 32047107
	+ calls = 3
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 17.489 0.000 0.000 17.489 0.000
	- 4 [i] dbar 0 0 2 7-8 61.696 0.000 0.000 -61.696 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6982.511 0.000 0.000 6982.511 0.000
	- 6 [x] hr3 0 0 2 [none] 6938.304 0.000 0.000 -6938.304 0.000
	- 7 [o] e- 0 0 3-4 [none] 27.091 26.581 -5.229 0.288 0.000
	- 8 [o] e+ 0 0 3-4 [none] 52.094 -26.581 5.229 -44.496 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 79.185 0.000 0.000 -44.208
	-Sum of beam remnant momenta: p(0:3) = 13920.815 0.000 0.000 44.208
	-Sum of outgoing momenta: p(0:3) = 79.185 0.000 0.000 -44.208
	+ 3 [i] u 0 0 1 7-8 328.409 0.000 0.000 328.409 0.000
	+ 4 [i] ubar 0 0 2 7-8 21.549 0.000 0.000 -21.549 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6671.591 0.000 0.000 6671.591 0.000
	+ 6 [x] hr3 0 0 2 [none] 6978.451 0.000 0.000 -6978.451 0.000
	+ 7 [o] e- 0 0 3-4 [none] 167.457 54.606 -63.860 144.851 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 182.501 -54.606 63.860 162.008 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 349.958 0.000 0.000 306.859
	+Sum of beam remnant momenta: p(0:3) = 13650.042 0.000 0.000 -306.859
	+Sum of outgoing momenta: p(0:3) = 349.958 0.000 0.000 306.859
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 6.56959E+01
	+sqrts_hat* => 1.68249E+02
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	-$process_id* => "powheg_2_p1"
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => 1.47022E+07
	-sqme_ref* => 1.47022E+07
	-event_index* => 8
	+sqme* => 3.30803E+07
	+sqme_ref* => 3.30803E+07
	+event_index* => 3
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.7488700E+01; 0.0000000E+00, 0.0000000E+00,-1.7488700E+01\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-6.1696367E+01; 0.0000000E+00, 0.0000000E+00, 6.1696367E+01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9825113E+03; 0.0000000E+00, 0.0000000E+00, 6.9825113E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9383036E+03; 0.0000000E+00, 0.0000000E+00,-6.9383036E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 2.7091406E+01; 2.6580500E+01,-5.2285908E+00, 2.8826949E-01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 5.2093661E+01;-2.6580500E+01, 5.2285908E+00,-4.4495937E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:2\|-3.2840858E+02; 0.0000000E+00, 0.0000000E+00,-3.2840858E+02\| 0.0000000E+00\| 3)
	+ 4 prt(i:-2\|-2.1549277E+01; 0.0000000E+00, 0.0000000E+00, 2.1549277E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.6715914E+03; 0.0000000E+00, 0.0000000E+00, 6.6715914E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9784507E+03; 0.0000000E+00, 0.0000000E+00,-6.9784507E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 1.6745700E+02; 5.4606036E+01,-6.3860309E+01, 1.4485126E+02\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 1.8250085E+02;-5.4606036E+01, 6.3860309E+01, 1.6200803E+02\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	- Event #9
	+ Event #4
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.35334E+07
	- Squared matrix el. (prc) = 1.35334E+07
	+ Squared matrix el. (ref) = 3.22507E+07
	+ Squared matrix el. (prc) = 3.22507E+07
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 27
	+ seed = 32047106
	+ calls = 12
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 1.067593E+02
	- P = 0.000000E+00 0.000000E+00 1.067593E+02
	+ E = 1.157900E+02
	+ P = 0.000000E+00 0.000000E+00 1.157900E+02
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 8.464686E+00
	- P = 0.000000E+00 0.000000E+00 -8.464686E+00
	+ E = 8.366189E+00
	+ P = 0.000000E+00 0.000000E+00 -8.366189E+00
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.893241E+03
	- P = 0.000000E+00 0.000000E+00 6.893241E+03
	+ E = 6.884210E+03
	+ P = 0.000000E+00 0.000000E+00 6.884210E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.991535E+03
	- P = 0.000000E+00 0.000000E+00 -6.991535E+03
	+ E = 6.991634E+03
	+ P = 0.000000E+00 0.000000E+00 -6.991634E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 3.781862E+01
	- P = 1.174670E+01 -2.488222E+01 2.594491E+01
	+ E = 4.529865E+01
	+ P = 1.670697E+01 -2.439383E+01 3.431889E+01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 7.740532E+01
	- P = -1.174670E+01 2.488222E+01 7.234966E+01
	+ E = 7.885752E+01
	+ P = -1.670697E+01 2.439383E+01 7.310490E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 9
	+ seed = 32047107
	+ calls = 4
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 106.759 0.000 0.000 106.759 0.000
	- 4 [i] dbar 0 0 2 7-8 8.465 0.000 0.000 -8.465 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6893.241 0.000 0.000 6893.241 0.000
	- 6 [x] hr3 0 0 2 [none] 6991.535 0.000 0.000 -6991.535 0.000
	- 7 [o] e- 0 0 3-4 [none] 37.819 11.747 -24.882 25.945 0.000
	- 8 [o] e+ 0 0 3-4 [none] 77.405 -11.747 24.882 72.350 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 115.224 0.000 0.000 98.295
	-Sum of beam remnant momenta: p(0:3) = 13884.776 0.000 0.000 -98.295
	-Sum of outgoing momenta: p(0:3) = 115.224 0.000 0.000 98.295
	+ 3 [i] d 0 0 1 7-8 115.790 0.000 0.000 115.790 0.000
	+ 4 [i] dbar 0 0 2 7-8 8.366 0.000 0.000 -8.366 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6884.210 0.000 0.000 6884.210 0.000
	+ 6 [x] hr3 0 0 2 [none] 6991.634 0.000 0.000 -6991.634 0.000
	+ 7 [o] e- 0 0 3-4 [none] 45.299 16.707 -24.394 34.319 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 78.858 -16.707 24.394 73.105 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 124.156 0.000 0.000 107.424
	+Sum of beam remnant momenta: p(0:3) = 13875.844 0.000 0.000 -107.424
	+Sum of outgoing momenta: p(0:3) = 124.156 0.000 0.000 107.424
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 6.01227E+01
	+sqrts_hat* => 6.22486E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	-$process_id* => "powheg_2_p1"
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => 1.35334E+07
	-sqme_ref* => 1.35334E+07
	-event_index* => 9
	+sqme* => 3.22507E+07
	+sqme_ref* => 3.22507E+07
	+event_index* => 4
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.0675926E+02; 0.0000000E+00, 0.0000000E+00,-1.0675926E+02\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-8.4646859E+00; 0.0000000E+00, 0.0000000E+00, 8.4646859E+00\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.8932407E+03; 0.0000000E+00, 0.0000000E+00, 6.8932407E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9915353E+03; 0.0000000E+00, 0.0000000E+00,-6.9915353E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 3.7818625E+01; 1.1746697E+01,-2.4882224E+01, 2.5944911E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 7.7405319E+01;-1.1746697E+01, 2.4882224E+01, 7.2349661E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-1.1578998E+02; 0.0000000E+00, 0.0000000E+00,-1.1578998E+02\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-8.3661890E+00; 0.0000000E+00, 0.0000000E+00, 8.3661890E+00\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.8842100E+03; 0.0000000E+00, 0.0000000E+00, 6.8842100E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9916338E+03; 0.0000000E+00, 0.0000000E+00,-6.9916338E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 4.5298654E+01; 1.6706971E+01,-2.4393826E+01, 3.4318893E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 7.8857517E+01;-1.6706971E+01, 2.4393826E+01, 7.3104900E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	- Event #10
	+ Event #5
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 6.32254E+06
	- Squared matrix el. (prc) = 6.32254E+06
	+ Squared matrix el. (ref) = 1.32591E+08
	+ Squared matrix el. (prc) = 1.32591E+08
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	- Selected channel = 2
	+ Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 30
	+ seed = 32047106
	+ calls = 15
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	- Particle 3 [i] f(1)
	- E = 3.840213E+02
	- P = 0.000000E+00 0.000000E+00 3.840213E+02
	+ Particle 3 [i] f(4)
	+ E = 4.109889E+01
	+ P = 0.000000E+00 0.000000E+00 4.109889E+01
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	- Particle 4 [i] f(-1)
	- E = 2.304886E+01
	- P = 0.000000E+00 0.000000E+00 -2.304886E+01
	+ Particle 4 [i] f(-4)
	+ E = 1.548717E+01
	+ P = 0.000000E+00 0.000000E+00 -1.548717E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.615979E+03
	- P = 0.000000E+00 0.000000E+00 6.615979E+03
	+ E = 6.958901E+03
	+ P = 0.000000E+00 0.000000E+00 6.958901E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.976951E+03
	- P = 0.000000E+00 0.000000E+00 -6.976951E+03
	+ E = 6.984513E+03
	+ P = 0.000000E+00 0.000000E+00 -6.984513E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 1.317678E+02
	- P = -7.259226E+01 4.671327E+01 9.955395E+01
	+ E = 2.427756E+01
	+ P = 2.050577E+01 1.238692E+01 3.934155E+00
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 2.753024E+02
	- P = 7.259226E+01 -4.671327E+01 2.614185E+02
	+ E = 3.230850E+01
	+ P = -2.050577E+01 -1.238692E+01 2.167757E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 10
	+ seed = 32047107
	+ calls = 5
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 1692.873 0.000 0.000 1692.873 0.000
	- 4 [i] dbar 1 0 2 7-8 124.175 0.000 0.000 -124.175 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6615.979 0.000 0.000 6615.979 0.000
	- 6 [x] hr3 0 0 2 [none] 6976.951 0.000 0.000 -6976.951 0.000
	- 7 [v] e- 0 0 3-4 9-11 131.768 -72.592 46.713 99.554 0.000
	- 8 [v] e+ 0 0 3-4 9-11 275.302 72.592 -46.713 261.419 0.000
	- 9 [o] e- 0 0 7-8 [none] 698.223 -348.873 -59.705 601.862 0.000
	- 10 [o] e+ 0 0 7-8 [none] 330.260 -58.529 -97.219 310.153 0.000
	- 11 [o] gl 1 0 7-8 [none] 788.564 407.402 156.924 656.683 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 1817.048 0.000 0.000 1568.698
	-Sum of beam remnant momenta: p(0:3) = 13592.930 0.000 0.000 -360.972
	-Sum of outgoing momenta: p(0:3) = 1817.048 0.000 0.000 1568.698
	+ 3 [i] c 0 0 1 7-8 41.099 0.000 0.000 41.099 0.000
	+ 4 [i] cbar 0 0 2 7-8 15.487 0.000 0.000 -15.487 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6958.901 0.000 0.000 6958.901 0.000
	+ 6 [x] hr3 0 0 2 [none] 6984.513 0.000 0.000 -6984.513 0.000
	+ 7 [o] e- 0 0 3-4 [none] 24.278 20.506 12.387 3.934 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 32.309 -20.506 -12.387 21.678 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 56.586 0.000 0.000 25.612
	+Sum of beam remnant momenta: p(0:3) = 13943.414 0.000 0.000 -25.612
	+Sum of outgoing momenta: p(0:3) = 56.586 0.000 0.000 25.612
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 9.16978E+02
	+sqrts_hat* => 5.04581E+01
	n_in* => 2
	-n_out* => 5
	-n_tot* => 7
	-$process_id* => "powheg_2_p1"
	+n_out* => 4
	+n_tot* => 6
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => 6.32254E+06
	-sqme_ref* => 6.32254E+06
	-event_index* => 10
	+sqme* => 1.32591E+08
	+sqme_ref* => 1.32591E+08
	+event_index* => 5
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.6928730E+03; 0.0000000E+00, 0.0000000E+00,-1.6928730E+03\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-1.2417487E+02; 0.0000000E+00, 0.0000000E+00, 1.2417487E+02\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.6159787E+03; 0.0000000E+00, 0.0000000E+00, 6.6159787E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9769511E+03; 0.0000000E+00, 0.0000000E+00,-6.9769511E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.9822309E+02;-3.4887324E+02,-5.9705153E+01, 6.0186231E+02\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 3.3026026E+02;-5.8528671E+01,-9.7218670E+01, 3.1015281E+02\| 0.0000000E+00\| 8)
	- 9 prt(o:21\| 7.8856447E+02; 4.0740191E+02, 1.5692382E+02, 6.5668297E+02\| 0.0000000E+00\| 9)
	+ 3 prt(i:4\|-4.1098893E+01; 0.0000000E+00, 0.0000000E+00,-4.1098893E+01\| 0.0000000E+00\| 3)
	+ 4 prt(i:-4\|-1.5487167E+01; 0.0000000E+00, 0.0000000E+00, 1.5487167E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9589011E+03; 0.0000000E+00, 0.0000000E+00, 6.9589011E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9845128E+03; 0.0000000E+00, 0.0000000E+00,-6.9845128E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 2.4277558E+01; 2.0505765E+01, 1.2386922E+01, 3.9341550E+00\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 3.2308503E+01;-2.0505765E+01,-1.2386922E+01, 2.1677571E+01\| 0.0000000E+00\| 8)
	========================================================================
	-Contents of powheg_2_p1.pg:
	+Contents of powheg_2_p2.pg:
	3
	- 10 10 3
	- 4.56013578XE+02 1.08397020XE+03 1.00704479XE+03 4.07472627XE+02 8.20830928XE+02 4.39687604XE+03 0.00000000XE+00 4.55870345XE-01 1.14106342XE-02 4.72900230XE-04 6.22467429XE+02 1.19665176XE+03 8.12747634XE+02 1.70251906XE+02 5.64633238XE+00 9.34587090XE+01 1.35499942XE-02 1.21124252XE+00 3.40843441XE+03 2.19908423XE+02 1.98718064XE+02 1.45199337XE+03 4.41860589XE+02 2.49687829XE+03 4.72284960XE+02 3.97752741XE+01 4.55486952XE+03 4.22391347XE+00 2.21709298XE+03 4.11771464XE-01 7.47343368XE+00 1.53156045XE+03 1.19616309XE+03 2.63299272XE+02 1.24425983XE+02 0.00000000XE+00 1.07269847XE+01 3.80759835XE+00 0.00000000XE+00 3.15864639XE+02 2.88693259XE+02 8.09073778XE+02 5.41970287XE+02 5.59608734XE+02 3.92235497XE+02 6.42227270XE+01 3.62917580XE-02 1.20057681XE+03 8.14524661XE-02 1.33714876XE-05 2.27514411XE+02 7.99680453XE+00 1.68336533XE+03 3.21077920XE+02 4.79703447XE+00 3.99098600XE+01 1.17274027XE+01 2.68422917XE-01 8.27410251XE-01 1.32660504XE+02 1.57786926XE+02 9.26496230XE+02 1.26447323XE+03 1.07803854XE+03 6.87400484XE+01 3.67249737XE+00 1.91701894XE-01 2.26546874XE+02 7.91240308XE+01 1.24206038XE+01 7.85128825XE+01 1.67516150XE+02 7.20842274XE+02 1.41705920XE+03 7.16519574XE+01 4.53820158XE+02 8.48846550XE+01 1.90318069XE+02 0.00000000XE+00 1.67054613XE-05 1.54449040XE+02 5.68536486XE+02 5.06741240XE+02 9.71321157XE+02 5.72484274XE+02 1.28170386XE+01 1.66992793XE+01 3.17799959XE+02 1.67890066XE+00 3.75739432XE-01 7.72394314XE+01 2.83518229XE+02 1.72285704XE+02 5.06604934XE+01 3.08067850XE+02 1.38671059XE+02 3.92063296XE-01 0.00000000XE+00 8.33119688XE+01 1.69887744XE-01 4.38437094XE+04 1.90741276XE+04 8.15629882XE+04 3.65322884XE+03 4.96087648XE+04 9.94585038XE+04 1.27216637XE+03 1.86389560XE+01 2.58184106XE-01 1.06270993XE-02 4.22977026XE+03 9.12874726XE+04 4.37268643XE+04 1.21456219XE+04 1.19977753XE+02 7.98331335XE+02 1.50225377XE+03 1.18084318XE+02 1.20765859XE+04 4.94609367XE+02 2.31762700XE+03 6.12365981XE+04 5.83180126XE+04 6.86143644XE+04 2.78957402XE+04 6.35915270XE+02 2.77947598XE+04 1.02625383XE+02 1.44037342XE+04 1.85886118XE+00 1.35134417XE+02 1.12766456XE+05 9.25910777XE+04 3.68062578XE+04 8.85962242XE+03 0.00000000XE+00 6.61357416XE+01 3.68096686XE+01 0.00000000XE+00 1.03176651XE+03 2.67067694XE+04 6.17092042XE+04 9.03706221XE+03 1.09777439XE+04 3.18375098XE+04 4.55529527XE+03 8.37358223XE-01 2.68198586XE+04 1.88761002XE+00 6.00681655XE-04 2.31855709XE+04 1.41970329XE+02 1.18402319XE+05 3.91924596XE+04 9.54437551XE+01 2.30254455XE+03 7.61035149XE+02 2.09863589XE+02 5.04642452XE+01 3.31661816XE+02 1.09681177XE+03 1.15703652XE+05 4.54305367XE+04 7.17001095XE+04 5.21015596XE+03 3.25661784XE+03 1.21356163XE+01 1.52317494XE+03 5.41094232XE+03 2.96164416XE+01 3.47212321XE+03 1.29138551XE+03 2.55455724XE+04 8.98099572XE+04 1.27433571XE+04 2.89926436XE+04 4.99848188XE+03 7.54277539XE+03 5.16507620XE-02 1.77463262XE-02 1.63522636XE+03 9.43880275XE+03 4.28834091XE+04 4.38952544XE+04 4.09396789XE+04 4.87312302XE+03 1.60017933XE+03 8.49515977XE+03 1.04087194XE+01 2.43065740XE+00 1.64981959XE+03 2.91710503XE+04 5.77166771XE+03 4.58519858XE+03 2.34559231XE+04 2.18709497XE+04 8.23459585XE+02 0.00000000XE+00 7.31739795XE+03 1.66696711XE+01 5.74915784XE+02 7.60546487XE+02 6.41111253XE+02 9.94046559XE+02 3.34234689XE+02 9.19758213XE+03 0.00000000XE+00 1.14217535XE+00 5.32901441XE-02 1.06934098XE-03 4.91519854XE+02 1.70834707XE+03 7.84915034XE+02 1.85236792XE+03 1.25897337XE+01 6.66936076XE+02 1.86072926XE-01 1.86517949XE+01 1.03606718XE+03 8.14813064XE+01 2.19280411XE+02 1.17615729XE+03 1.67095533XE+03 2.91682064XE+03 2.31557253XE+02 1.34735945XE+01 4.52642167XE+04 8.26060634XE+00 7.03374575XE+02 9.58538738XE+00 8.38348321XE+01 1.13299230XE+03 4.21334200XE+02 8.45632039XE+01 7.26825874XE+01 0.00000000XE+00 1.64462082XE+02 1.28488832XE+00 0.00000000XE+00 1.34747020XE+02 7.20105528XE+02 5.01306089XE+02 3.63116948XE+02 6.15780720XE+02 1.87026144XE+02 4.14903490XE+02 4.32021164XE-02 3.31866555XE+03 3.00732696XE-01 2.37775333XE-04 1.25316717XE+02 1.02100438XE+02 2.59471357XE+03 4.81787216XE+02 3.62026458XE+00 1.20412499XE+01 1.98899815XE+02 1.19585655XE-01 1.65422625XE+01 3.46348340XE+02 1.05034877XE+02 1.86978254XE+03 6.91365818XE+02 3.57985450XE+02 4.19191816XE+02 2.46793629XE+00 1.71620026XE+00 7.25239602XE+02 2.15169636XE+02 4.10345286XE+00 4.84964380XE+01 7.66811231XE+01 2.62483542XE+02 6.77516723XE+02 1.26104807XE+02 1.49113685XE+02 1.82647489XE+02 7.65572591XE+01 0.00000000XE+00 1.93989223XE-04 6.65425558XE+01 3.67292176XE+02 6.86976099XE+02 3.33608694XE+02 1.97871200XE+02 3.41392618XE+01 7.67650755XE+00 1.18473717XE+02 1.01140814XE+01 1.22605750XE+00 4.73479568XE+01 8.03683754XE+02 6.76379909XE+01 3.86277412XE+01 1.05897559XE+02 4.61603996XE+01 1.66781927XE+00 0.00000000XE+00 2.55855351XE+02 5.31988960XE-01
	+ 10 10 30
	+ 8.54595951XE+02 6.90464779XE+02 3.07229279XE+03 6.26648748XE-01 1.53720470XE+02 1.28801566XE+04 1.89270404XE-01 9.87965338XE-01 3.45386897XE+02 7.22045168XE-04 4.39819792XE+02 1.01039357XE+03 6.65244471XE+02 3.28919127XE+00 3.30914364XE+02 7.22201824XE-01 2.45728168XE+04 1.10363256XE+03 0.00000000XE+00 2.74369582XE+02 1.07883468XE+03 1.08283545XE+03 1.36824675XE+03 4.28035175XE+03 1.18723705XE+02 1.14992417XE+04 1.06580362XE+04 0.00000000XE+00 1.78507410XE+02 4.94459624XE-02 3.38573234XE+02 8.30724957XE+01 2.51694265XE+03 4.72415402XE+02 1.24517753XE+03 4.87644157XE+03 3.45198849XE+02 4.00679418XE+01 4.77269429XE+03 1.28608850XE+02 7.10416708XE+02 5.84766603XE+02 8.81408175XE+02 3.91689054XE+03 5.18458834XE+03 5.17474710XE+01 1.21003471XE+03 2.48710266XE+00 2.60934440XE+04 1.87850381XE+04 5.45041247XE+02 8.52544550XE+02 7.45973164XE+02 4.77114178XE+02 7.83679769XE+01 1.52948314XE+02 1.01201799XE+04 4.62058650XE+02 1.10850247XE+03 5.94143915XE+01 1.74467873XE+02 1.01377686XE+03 3.71464980XE+02 2.57912351XE+02 3.50525002XE+03 1.97026760XE+02 5.28936054XE+04 1.60984330XE+04 4.88694288XE+04 6.06987777XE+03 4.03744521XE+02 6.17662218XE+01 1.35625612XE+03 3.09502512XE+03 2.50720318XE+02 6.21317656XE+01 4.69954220XE+03 1.63808010XE+01 2.34336876XE+03 4.29406892XE+02 1.08214330XE+02 5.35269961XE+02 6.63715766XE+02 1.85231705XE+02 1.66933381XE+02 4.43742867XE+01 4.41374567XE+01 1.29515450XE+02 8.95880072XE+02 3.10384918XE+03 1.74635986XE+02 4.35088060XE+01 2.27869054XE+02 1.41683100XE+02 8.21779828XE+02 3.89741792XE+01 5.88911364XE+00 8.95171287XE+01 6.17098302XE+01 2.27450500XE+01 2.73302970XE+04 5.17432395XE+04 3.70585735XE+05 1.80239548XE+01 1.65620946XE+04 6.37868767XE+05 8.07634133XE+00 2.28696556XE+01 1.84172657XE+03 1.90100603XE-02 1.13414594XE+04 4.00769106XE+04 1.87395948XE+04 7.21252156XE+01 1.61605735XE+04 1.68594473XE+01 9.01432529XE+05 2.27158756XE+04 0.00000000XE+00 7.06980286XE+03 3.17782450XE+04 3.46023164XE+04 6.05462444XE+04 2.08757958XE+05 5.88473901XE+03 4.70382897XE+05 9.47460648XE+05 5.15974525XE-01 2.62918741XE+03 8.18464474XE-01 2.16159702XE+04 2.27138873XE+03 7.18854363XE+04 2.89824428XE+04 7.71136610XE+04 1.62233631XE+05 1.82248172XE+04 1.42872581XE+03 3.22377256XE+04 1.58762565XE+03 2.25812810XE+04 1.46709904XE+04 2.44947041XE+04 1.51100160XE+05 1.64908681XE+05 5.61437964XE+03 4.26312332XE+04 2.22543688XE+02 6.25302670XE+04 7.75233933XE+05 2.62918272XE+04 3.56600217XE+04 5.79748302XE+04 1.37611787XE+04 1.79032262XE+03 3.21767802XE+03 1.33040731XE+06 1.75604545XE+04 1.23908268XE+04 1.31048363XE+02 1.77737166XE+04 6.79597951XE+04 8.56951829XE+03 2.75362852XE+04 5.61074268XE+05 1.08091999XE+04 1.96047194XE+06 5.14132908XE+05 1.60418318XE+05 1.51471236XE+05 2.58907360XE+04 4.74020082XE+03 7.29171804XE+04 8.86600081XE+04 1.00650999XE+04 2.65004743XE+03 6.14141992XE+05 1.17921303XE+03 5.43230057XE+04 9.63860106XE+03 3.07600562XE+03 1.74896023XE+04 2.30253263XE+04 1.45424575XE+04 5.14224979XE+03 2.22804429XE+03 1.27539398XE+03 5.05090839XE+03 2.20146572XE+04 1.51481150XE+05 5.81534451XE+03 1.66257089XE+03 1.06678448XE+04 8.39647810XE+03 1.87323117XE+04 1.55814373XE+03 7.66169804XE+02 2.51012619XE+03 1.38616663XE+03 1.08577454XE+03 9.51955088XE+02 5.47432551XE+02 1.76973649XE+01 3.86276666XE-01 5.85447409XE+02 2.15950577XE+04 3.61968183XE+00 4.34560587XE+00 2.05001010XE+00 1.51378686XE-04 5.41963624XE+02 1.00251004XE+03 1.83269393XE+03 1.76413096XE+01 1.52503805XE+03 0.00000000XE+00 8.13386351XE+04 1.91619152XE+03 0.00000000XE+00 4.33757893XE+02 1.24199929XE+03 1.68913676XE+03 4.38312444XE+02 2.84613609XE+03 3.56808893XE+02 6.37690272XE+02 4.51577170XE+04 3.10606749XE-02 8.86752144XE+00 6.91610438XE-03 3.31931173XE+02 1.58194278XE+02 1.92145765XE+03 1.29733731XE+03 2.88284512XE+02 1.60767140XE+02 2.10667620XE+03 1.37709020XE+01 1.37566651XE+01 1.39921940XE+02 7.82678730XE+02 6.01896927XE+02 6.35140403XE+01 1.47498658XE+02 3.35202062XE+02 4.64285694XE+02 3.78182012XE+02 7.33183721XE+01 1.09761388XE+01 7.84783738XE+03 5.46062358XE+02 1.13470523XE+03 1.74932391XE+03 1.40949423XE+03 3.08680388XE+02 1.12918307XE+02 2.81821763XE+04 4.17147833XE+02 4.92168266XE+02 3.10092828XE-03 1.83359301XE+02 1.36136403XE+03 5.67723592XE+02 9.43578558XE+02 1.97222873XE+03 6.32646089XE+02 2.14259645XE+04 1.07608363XE+04 3.09435690XE+01 9.75038196XE+01 4.67930047XE+02 5.44776956XE+01 5.60268114XE+02 1.97496817XE+04 1.20091900XE+03 3.35978138XE+02 1.63287452XE+02 8.75664768XE+02 0.00000000XE+00 3.30054938XE+02 1.20589233XE+02 7.06215121XE+02 1.37043071XE+03 7.21710715XE+02 1.14480650XE+03 4.31091978XE+02 3.78183184XE+02 1.03055498XE+02 7.71912465XE+00 1.70429266XE+02 1.72676127XE+02 5.18111601XE+01 2.34758582XE+02 3.47116876XE+02 4.08360470XE+02 2.45195392XE+02 9.81406850XE+01 1.00623620XE+01 2.60765969XE+00 7.43131564XE+00 1.70101801XE+02 3.05343928XE+02 1.21277467XE+02 8.66428634XE+00 4.15478618XE+01 9.17334681XE+02 3.79922657XE-01 1.07306791XE+00 1.25520842XE+00 3.29130798XE-03 3.94862414XE+02 1.33654657XE+03 3.26807414XE+02 6.67846330XE+01 4.93308392XE+01 0.00000000XE+00 5.76075583XE+03 4.02915338XE+03 0.00000000XE+00 6.04524917XE+01 2.69018576XE+02 4.80946823XE+02 1.33336642XE+02 1.21103957XE+03 2.64089505XE+01 2.08590790XE+01 8.12289061XE+02 8.60810570XE-04 2.29182982XE+00 1.53886111XE-01 1.01079536XE+02 1.13114718XE+02 3.14485296XE+02 9.63162144XE+01 5.00922614XE+01 1.85441456XE+01 5.47208289XE+01 7.83974071XE-01 6.74143587XE+00 4.59487963XE+01 1.49995013XE+02 1.07729272XE+03 6.16535758XE+00 7.85737934XE+01 3.97203516XE+01 1.58888144XE+01 9.62173839XE+02 8.33128709XE-01 3.00931428XE+01 3.57652030XE+02 8.23985072XE+02 2.31369190XE+02 9.25191783XE+01 1.65230061XE+02 8.70964524XE+01 1.15729836XE+02 4.89987210XE+02 2.40161414XE+01 5.57431500XE+02 5.68181763XE-03 7.09092892XE+01 5.89238851XE+02 6.50167675XE+02 6.75704842XE+02 2.83880337XE+01 2.97085023XE+01 1.64874863XE+03 1.52595166XE+02 5.42772688XE+01 1.71786017XE+01 2.15536652XE+02 2.11403643XE+02 2.66932565XE+01 3.09594213XE+03 2.09636260XE+02 4.63974600XE+01 2.63052561XE+00 1.12978921XE+01 0.00000000XE+00 3.75421768XE+02 1.39397765XE+02 1.64596426XE+02 1.49935458XE+02 4.93090529XE+01 2.00541401XE+02 1.57078559XE+01 9.56602862XE+01 1.95957700XE+00 2.96261323XE-01 1.21074451XE+01 1.22733753XE+02 5.29374775XE+01 1.09591765XE+02 1.57729774XE+01 9.11705597XE+01 2.03291549XE+01 1.62918587XE+00 4.16343617XE-01 2.41322000XE-01 3.17232237XE-01 1.04661521XE+03 4.97334127XE+02 1.51550012XE+01 1.67172087XE+00 1.05903237XE+02 6.35309851XE+02 3.30175595XE-01 5.44584182XE+01 4.17964409XE+02 2.52696552XE-03 5.26003666XE+02 1.49802785XE+03 1.36081291XE+03 1.31930285XE+01 3.02902663XE+02 8.58711700XE+00 9.62430470XE+01 2.19257327XE+01 0.00000000XE+00 2.84629418XE-01 1.41488109XE+03 1.93180327XE+03 3.46576800XE+03 3.37653224XE+02 7.32724542XE+02 3.96632410XE+02 1.51670296XE+03 8.60097643XE-03 1.32757834XE+02 1.50379098XE-01 3.81950976XE+02 1.05403783XE+02 1.81622038XE+03 6.16636960XE+02 1.57758438XE+03 2.00548224XE+02 9.82760302XE+00 3.67899300XE+01 6.67579003XE+03 4.11374078XE+00 8.60299767XE+02 8.17594757XE+02 8.60373500XE+02 1.34046832XE+01 2.26522377XE+04 2.59030628XE+01 3.52245731XE+03 7.81041556XE-02 7.87683182XE+04 2.46655571XE-03 6.62583072XE+02 8.87627563XE+02 1.37755030XE+03 1.09851661XE+03 8.29961565XE+02 1.84192629XE+02 4.63433517XE+01 4.68920407XE+01 4.44504176XE+02 1.05809676XE-03 1.84476366XE+02 1.29448920XE+03 8.57541587XE+02 6.57016939XE+02 4.33387841XE+02 2.29788224XE+02 7.89072510XE+01 1.94783505XE+00 4.46982895XE+02 1.47155482XE+01 4.65817947XE+02 3.78886978XE+01 3.98716853XE+02 1.01433433XE+03 5.92558139XE+02 4.46298982XE+02 4.09153224XE+01 6.83620919XE+01 7.31096222XE-01 4.02862094XE-02 1.51514334XE+02 1.03051383XE+03 1.53986045XE+03 4.78880446XE+02 7.45635482XE+02 2.69469482XE+01 3.94027886XE+01 7.83880628XE+01 3.45530108XE+00 9.52587231XE+02 1.65195912XE+02 7.35009411XE+01 5.19932173XE+02 9.35980414XE+01 5.50049021XE+03 4.26464099XE+01 8.04470431XE+01 7.90868612XE+01 2.72594745XE+01 1.29484088XE-02 9.00160325XE+03 3.99848781XE+03 2.96784456XE+02 3.80175947XE+01 1.61813136XE+04 3.88707829XE+03 3.26725435XE+00 3.35981824XE+02 2.22498618XE+03 5.61772296XE-02 4.46688305XE+03 2.24779003XE+04 8.84663983XE+03 1.83678955XE+02 9.16160247XE+03 1.50794034XE+02 1.15165003XE+03 2.04190970XE+02 0.00000000XE+00 1.73770379XE+00 9.60192632XE+03 3.06507867XE+04 1.67850382XE+05 6.25741276XE+04 4.85769319XE+03 4.49771303XE+04 5.70728751XE+04 1.96979104XE-01 1.95948182XE+03 1.81324344XE+00 1.81892010XE+04 9.14237436XE+02 2.01335877XE+04 1.41594136XE+04 9.99477743XE+03 1.23126481XE+03 2.87010903XE+02 1.43793031XE+03 4.50053946XE+04 9.41186226XE+00 6.02774833XE+03 6.97266008XE+03 5.92888923XE+03 2.52394571XE+02 7.39718606XE+05 5.92003934XE+03 1.32375652XE+05 1.03462308XE+02 1.88301698XE+05 5.52963966XE-02 9.68199762XE+03 1.06929473XE+04 6.54067758XE+04 7.40751686XE+03 5.40095787XE+03 1.52228405XE+03 6.24099697XE+03 5.50777064XE+02 4.81885961XE+03 6.89015425XE-03 1.07541504XE+04 9.63551721XE+03 7.44065847XE+03 7.41594172XE+04 4.37964013XE+03 1.15590381XE+04 3.07542082XE+03 9.99432226XE+02 1.46390078XE+03 3.71767003XE+02 1.23434522XE+04 4.24768564XE+02 3.69574326XE+04 7.39873729XE+03 5.18451393XE+03 3.69709195XE+03 8.07624512XE+03 5.20528664XE+02 6.26712678XE+00 3.45307916XE-01 1.33421667XE+03 7.37225328XE+03 1.33941273XE+04 1.13245408XE+04 6.16011399XE+03 8.27714411XE+02 5.81005867XE+02 3.34333834XE+03 1.67754426XE+02 2.33037257XE+03 1.24563843XE+03 6.75550888XE+02 7.58643654XE+03 5.68441454XE+03 1.26518831XE+05 4.39209058XE+02 5.07415318XE+03 2.22996008XE+03 6.17173754XE+02 1.31069655XE-01 8.54595951XE+02 6.90464779XE+02 3.07229279XE+03 6.26648748XE-01 1.53720470XE+02 1.28801566XE+04 1.89270404XE-01 9.87965338XE-01 3.45386897XE+02 7.22045168XE-04 4.39819792XE+02 1.01039357XE+03 6.65244471XE+02 3.28919127XE+00 3.30914364XE+02 7.22201824XE-01 2.45728168XE+04 1.10363256XE+03 0.00000000XE+00 2.74369582XE+02 1.07883468XE+03 1.08283545XE+03 1.36824675XE+03 4.28035175XE+03 1.18723705XE+02 1.14992417XE+04 1.06580362XE+04 0.00000000XE+00 1.78507410XE+02 4.94459624XE-02 3.38573234XE+02 8.30724957XE+01 2.51694265XE+03 4.72415402XE+02 1.24517753XE+03 4.87644157XE+03 3.45198849XE+02 4.00679418XE+01 4.77269429XE+03 1.28608850XE+02 7.10416708XE+02 5.84766603XE+02 8.81408175XE+02 3.91689054XE+03 5.18458834XE+03 5.17474710XE+01 1.21003471XE+03 2.48710266XE+00 2.60934440XE+04 1.87850381XE+04 5.45041247XE+02 8.52544550XE+02 7.45973164XE+02 4.77114178XE+02 7.83679769XE+01 1.52948314XE+02 1.01201799XE+04 4.62058650XE+02 1.10850247XE+03 5.94143915XE+01 1.74467873XE+02 1.01377686XE+03 3.71464980XE+02 2.57912351XE+02 3.50525002XE+03 1.97026760XE+02 5.28936054XE+04 1.60984330XE+04 4.88694288XE+04 6.06987777XE+03 4.03744521XE+02 6.17662218XE+01 1.35625612XE+03 3.09502512XE+03 2.50720318XE+02 6.21317656XE+01 4.69954220XE+03 1.63808010XE+01 2.34336876XE+03 4.29406892XE+02 1.08214330XE+02 5.35269961XE+02 6.63715766XE+02 1.85231705XE+02 1.66933381XE+02 4.43742867XE+01 4.41374567XE+01 1.29515450XE+02 8.95880072XE+02 3.10384918XE+03 1.74635986XE+02 4.35088060XE+01 2.27869054XE+02 1.41683100XE+02 8.21779828XE+02 3.89741792XE+01 5.88911364XE+00 8.95171287XE+01 6.17098302XE+01 2.27450500XE+01 2.73302970XE+04 5.17432395XE+04 3.70585735XE+05 1.80239548XE+01 1.65620946XE+04 6.37868767XE+05 8.07634133XE+00 2.28696556XE+01 1.84172657XE+03 1.90100603XE-02 1.13414594XE+04 4.00769106XE+04 1.87395948XE+04 7.21252156XE+01 1.61605735XE+04 1.68594473XE+01 9.01432529XE+05 2.27158756XE+04 0.00000000XE+00 7.06980286XE+03 3.17782450XE+04 3.46023164XE+04 6.05462444XE+04 2.08757958XE+05 5.88473901XE+03 4.70382897XE+05 9.47460648XE+05 5.15974525XE-01 2.62918741XE+03 8.18464474XE-01 2.16159702XE+04 2.27138873XE+03 7.18854363XE+04 2.89824428XE+04 7.71136610XE+04 1.62233631XE+05 1.82248172XE+04 1.42872581XE+03 3.22377256XE+04 1.58762565XE+03 2.25812810XE+04 1.46709904XE+04 2.44947041XE+04 1.51100160XE+05 1.64908681XE+05 5.61437964XE+03 4.26312332XE+04 2.22543688XE+02 6.25302670XE+04 7.75233933XE+05 2.62918272XE+04 3.56600217XE+04 5.79748302XE+04 1.37611787XE+04 1.79032262XE+03 3.21767802XE+03 1.33040731XE+06 1.75604545XE+04 1.23908268XE+04 1.31048363XE+02 1.77737166XE+04 6.79597951XE+04 8.56951829XE+03 2.75362852XE+04 5.61074268XE+05 1.08091999XE+04 1.96047194XE+06 5.14132908XE+05 1.60418318XE+05 1.51471236XE+05 2.58907360XE+04 4.74020082XE+03 7.29171804XE+04 8.86600081XE+04 1.00650999XE+04 2.65004743XE+03 6.14141992XE+05 1.17921303XE+03 5.43230057XE+04 9.63860106XE+03 3.07600562XE+03 1.74896023XE+04 2.30253263XE+04 1.45424575XE+04 5.14224979XE+03 2.22804429XE+03 1.27539398XE+03 5.05090839XE+03 2.20146572XE+04 1.51481150XE+05 5.81534451XE+03 1.66257089XE+03 1.06678448XE+04 8.39647810XE+03 1.87323117XE+04 1.55814373XE+03 7.66169804XE+02 2.51012619XE+03 1.38616663XE+03 1.08577454XE+03 8.35240746XE+02 3.27525222XE+02 2.52753753XE+03 0.00000000XE+00 3.20735142XE+02 1.33395919XE+04 1.46350916XE-01 7.49928449XE-01 5.95433078XE+02 1.09850903XE-03 4.31134524XE+02 1.01246285XE+03 6.05865708XE+02 2.75438343XE+00 3.11860777XE+02 0.00000000XE+00 2.24494201XE+04 1.32056389XE+03 0.00000000XE+00 4.62939564XE+02 1.04885462XE+03 1.02707015XE+03 1.27475212XE+03 3.31758343XE+03 2.22067997XE+02 9.09426577XE+03 1.34869673XE+04 0.00000000XE+00 3.09317514XE+02 1.73831350XE-01 1.26720536XE+01 7.91953266XE+01 1.86949135XE+03 4.87822742XE+02 1.48947813XE+03 3.28978642XE+03 4.32309722XE+02 7.16558571XE+01 7.10223431XE+03 3.67294656XE+02 7.03552821XE+02 5.93240473XE+02 1.07473346XE+03 2.86412181XE+03 4.20045526XE+03 7.67622069XE+01 1.47274472XE+03 4.98500869XE+00 3.51157089XE+04 1.38878895XE+04 5.37575672XE+02 8.50202253XE+02 7.83556859XE+02 4.21007096XE+02 5.49871808XE+01 2.62189143XE+02 3.13631695XE+01 6.95749114XE+02 2.37359473XE+03 6.53524026XE+01 4.26209569XE+00 8.93761984XE+02 3.49837839XE+02 3.11750830XE+02 2.52187805XE+03 3.74851652XE+02 3.88975026XE+04 1.28322689XE+04 8.58860639XE+04 9.29327702XE+03 1.04683418XE+02 4.84065714XE+01 1.04656392XE+03 2.42728000XE+03 2.25979977XE+02 2.05893496XE+03 1.29765642XE+01 2.86970025XE+01 0.00000000XE+00 1.46847294XE+01 1.06162830XE+02 5.08839760XE+02 6.47071800XE+02 2.00097661XE+02 1.43862933XE+02 4.01160303XE+01 5.37712201XE+01 2.14416886XE+02 3.15215873XE+01 2.40876542XE+03 1.63802644XE+02 4.18189463XE+01 2.19505936XE+02 1.40442028XE+02 6.99052293XE+02 3.42212931XE+01 8.63483251XE+00 2.03952408XE+00 1.20385356XE+02 4.36052882XE+01 5.12075447XE+04 2.41672931XE+04 2.44516484XE+05 0.00000000XE+00 2.95162148XE+04 1.32835444XE+06 1.31320655XE+01 2.92553107XE+01 3.27287408XE+03 3.70391839XE-02 1.95006003XE+04 8.04836127XE+04 3.11256736XE+04 1.07352667XE+02 2.93559014XE+04 0.00000000XE+00 1.60401127XE+06 4.21212936XE+04 0.00000000XE+00 2.11466493XE+04 5.73223639XE+04 6.47190846XE+04 9.14949248XE+04 3.23103918XE+05 1.09065109XE+04 7.35481595XE+05 1.85577181XE+06 0.00000000XE+00 4.89249268XE+03 2.20394524XE+00 5.47698382XE+02 3.92871755XE+03 9.77971720XE+04 5.65539204XE+04 9.29388787XE+04 1.27738559XE+05 4.23675262XE+04 2.76286598XE+03 5.00093192XE+04 4.44491037XE+03 4.27998730XE+04 2.56881219XE+04 5.40596931XE+04 1.29403122XE+05 1.54274908XE+05 1.03374254XE+04 5.79943094XE+04 3.92923160XE+02 8.75829557XE+04 6.24528953XE+05 5.45362139XE+04 7.22671114XE+04 1.07219082XE+05 2.23944426XE+04 2.27943557XE+03 8.70741449XE+03 1.06717911XE+03 5.19382679XE+04 2.72275274XE+04 1.48192029XE+02 1.93243192XE+02 6.00169518XE+04 1.33491454XE+04 4.64263639XE+04 3.04240899XE+05 4.04080916XE+04 1.67479941XE+06 1.08718365XE+06 2.91571000XE+05 2.58233078XE+05 1.17165071XE+04 4.57766943XE+03 6.24399990XE+04 1.27708883XE+05 1.79698718XE+04 3.45845924XE+05 2.04767166XE+03 1.85650375XE+03 0.00000000XE+00 4.78594409XE+02 5.60843920XE+03 3.20891319XE+04 4.23901897XE+04 2.32146822XE+04 8.35414576XE+03 3.96947838XE+03 2.62321110XE+03 9.46462435XE+03 3.84272577XE+03 1.26488356XE+05 1.07699739XE+04 2.39023333XE+03 2.13259961XE+04 1.73805243XE+04 1.78116957XE+04 2.77833806XE+03 1.51936350XE+03 2.16618041XE+02 3.02948331XE+03 4.16431626XE+03 8.13541230XE+02 3.62692493XE+02 8.18413616XE+00 5.39866541XE-01 6.02608267XE+00 1.52132778XE+04 1.57519047XE-01 7.53208471XE-01 2.52123975XE+02 3.91347484XE-04 4.42430012XE+02 9.02922467XE+02 6.30864743XE+02 4.40895921XE+00 2.53129476XE+02 0.00000000XE+00 4.75074043XE+04 0.00000000XE+00 0.00000000XE+00 1.95768375XE+02 1.01826792XE+03 1.07015095XE+03 2.07204596XE+03 2.64247555XE+03 8.14541078XE+01 4.69079572XE+02 8.11029417XE+03 0.00000000XE+00 1.38051313XE+02 2.00674071XE-02 2.77016626XE+02 9.01343374XE+01 7.86805979XE+02 3.56336301XE+02 3.04481415XE+02 8.62630399XE+00 2.12894105XE-01 2.52223190XE+01 6.06018410XE+03 9.95131122XE+01 6.71989388XE+02 5.53047172XE+02 2.69036702XE+01 3.95735561XE+00 1.16948246XE+04 1.08071809XE+01 3.63279662XE+02 0.00000000XE+00 2.45907250XE+04 2.79224637XE-02 5.22277630XE+02 7.68050723XE+02 6.54599959XE+02 3.76885865XE+02 7.38333312XE+01 7.68287709XE+01 4.92470677XE+00 4.47522231XE+02 6.57280002XE+02 9.29753793XE-05 1.68177957XE+02 9.10047813XE+02 3.81147742XE+02 2.44344611XE+02 1.06414757XE+00 5.70885481XE+01 2.12858946XE+04 0.00000000XE+00 5.79555388XE+04 1.53614931XE+04 3.93600354XE+02 3.32553828XE+01 1.66774678XE+02 7.31630590XE+03 1.90799129XE+02 5.03998863XE+01 1.89996869XE+00 6.05566486XE+00 0.00000000XE+00 4.43186902XE+02 1.13458483XE+02 5.20497053XE+02 6.37956246XE+02 1.47322465XE+02 1.38104348XE+02 3.02630609XE+01 9.31448010XE-01 1.06921095XE+02 1.09565895XE+01 8.46117984XE+02 1.27366215XE+02 4.10143220XE+01 2.03683424XE+02 1.22516590XE+02 9.38394867XE+02 2.95211537XE+01 3.51904691XE+00 7.40584214XE-01 1.44059778XE+01 1.63350717XE+01 1.44581342XE+04 4.61033725XE+03 1.32702626XE+02 1.38748990XE+01 1.43229973XE+04 5.80155207XE+05 4.25162680XE+00 9.43956929XE+00 1.34234408XE+03 9.47440712XE-03 5.56671168XE+03 2.48075669XE+04 9.96103859XE+03 7.42825904XE+01 1.00881566XE+04 0.00000000XE+00 1.18247078XE+06 0.00000000XE+00 0.00000000XE+00 2.98706821XE+03 1.60814472XE+04 2.82852738XE+04 1.05368264XE+05 5.40135885XE+04 3.40215807XE+03 4.86915414XE+04 1.03160318XE+06 3.14386923XE-01 2.03809976XE+03 4.95603417XE-01 9.49525948XE+03 1.17414251XE+03 2.04633910XE+04 2.13176072XE+04 4.65585963XE+03 1.20223844XE+02 4.09568442XE+00 9.94818572XE+02 4.08595244XE+04 7.48258388XE+02 1.16827100XE+04 6.83932638XE+03 8.93777849XE+02 7.87953994XE+01 3.83567233XE+05 4.52613681XE+03 4.61571544XE+03 1.35629768XE+02 6.05793559XE+04 1.02716143XE+00 1.77560434XE+04 2.23170086XE+04 4.75315575XE+04 6.65729076XE+03 9.43983893XE+02 8.76842881XE+02 2.62090483XE+02 1.21189408XE+04 7.75909000XE+03 1.57116909XE-03 1.57551319XE+04 1.15162604XE+04 4.60343091XE+03 2.68315972XE+04 3.73543151XE+04 4.60043364XE+03 6.04615879XE+05 0.00000000XE+00 1.89813529XE+05 3.88356380XE+05 1.95976054XE+04 5.00016618XE+02 3.14038968XE+04 1.20609036XE+05 5.54025502XE+03 1.22898734XE+03 6.96996318XE+02 2.35715770XE+03 0.00000000XE+00 5.30304607XE+03 1.51222932XE+03 9.76202256XE+03 1.47152206XE+04 6.46731640XE+03 2.59387675XE+03 1.33886056XE+03 8.66233189XE+02 4.58402915XE+03 7.79966306XE+02 6.16613770XE+03 1.86434700XE+03 1.20357383XE+03 6.78868518XE+03 5.61783116XE+03 2.16245474XE+04 7.85110259XE+02 5.10806512XE+02 7.40400916XE+01 3.65092779XE+02 5.97769559XE+02 7.62809598XE+02 5.24379918XE+02 1.42186837XE+01 3.66786723XE-02 7.12849657XE+01 1.77491532XE+04 1.56499596XE+00 1.03379965XE+00 7.34190555XE-01 3.10771032XE-04 5.08931243XE+02 1.41038855XE+03 1.42436140XE+03 1.22653608XE+01 3.37538316XE+02 0.00000000XE+00 6.06846550XE+04 0.00000000XE+00 0.00000000XE+00 9.12258805XE+02 1.16758455XE+03 1.30918678XE+03 3.77941985XE+02 2.90311322XE+03 3.28531763XE+02 1.68872637XE+02 2.00290612XE+04 1.75527213XE-03 9.24738954XE-01 6.58864326XE-02 1.42629943XE+02 1.39894036XE+02 4.77287143XE+02 8.02031424XE+02 6.78010009XE+02 6.23618025XE+01 2.44848343XE+00 1.69572744XE+00 1.46329643XE+01 2.62983018XE+02 8.76521356XE+02 7.10123223XE+02 4.55237599XE+01 1.33391956XE+02 1.72655109XE+02 9.33342217XE+01 8.80875436XE+00 2.46799176XE+00 1.89766824XE+03 4.22774144XE+03 5.25544677XE+02 1.06973296XE+03 8.93022444XE+02 1.14600050XE+03 1.33636096XE+02 1.55251404XE+02 2.47662025XE+04 6.36571685XE+02 8.57949979XE+02 1.22235618XE-01 1.51606504XE+02 1.51338423XE+03 4.50782752XE+02 6.33059115XE+02 5.53619418XE+02 1.93842150XE+02 2.20661434XE+04 5.77216126XE+01 2.80460974XE+02 1.91293073XE+02 3.74108506XE+02 4.86025286XE+01 3.95950653XE+02 1.44029376XE+04 4.45764913XE+02 1.41806229XE+02 2.21702016XE+01 5.37422238XE+01 0.00000000XE+00 5.73673790XE+02 1.26030042XE+02 4.41138872XE+02 1.15028365XE+03 6.73889432XE+02 5.55839379XE+02 1.12683816XE+02 1.94994385XE+01 5.18838894XE+00 3.21488298XE+01 4.25391130XE+02 1.57441182XE+02 4.67929503XE+01 2.12055783XE+02 1.91210416XE+02 2.19493538XE+02 1.26339756XE+02 1.40423925XE+01 7.09486480XE-01 1.10246059XE-01 4.42973998XE+01 4.09117630XE+02 7.32758963XE+02 1.36087160XE+02 2.90333348XE-01 8.40902896XE+01 6.06689228XE+03 6.78384269XE-01 6.57864877XE-01 3.88237268XE+00 6.83772179XE-03 6.63013829XE+02 1.13228642XE+03 7.46238333XE+02 8.11956807XE+01 1.09800839XE+02 0.00000000XE+00 2.10341210XE+04 0.00000000XE+00 0.00000000XE+00 4.02538471XE+02 7.00122426XE+02 1.01998598XE+03 2.82516157XE+03 2.78810425XE+03 1.02258483XE+02 1.14235757XE+02 8.00193504XE+03 3.86182259XE-03 1.27093263XE+01 1.48163371XE+00 1.18510309XE+02 1.98443281XE+02 3.99489798XE+02 2.54412794XE+02 3.46950653XE+02 1.14101308XE+03 1.34194424XE+00 1.49800396XE+01 9.75733522XE+01 2.05170549XE+02 4.90915849XE+02 2.04156246XE+03 2.04052665XE+01 5.74619362XE+02 3.28102762XE+03 4.13889515XE+01 1.29574697XE+02 1.57259997XE+00 4.67635191XE+03 3.14038314XE+04 1.04318114XE+03 3.86698509XE+02 3.44593300XE+02 4.68285512XE+02 9.40478753XE+01 2.86175756XE+02 1.22433724XE+04 2.08275537XE+02 1.71091148XE+03 2.69313709XE-01 7.58256414XE+01 1.46452369XE+03 7.57294195XE+02 8.89758316XE+02 2.79374003XE+02 7.32366276XE+01 8.36649153XE+03 4.56282689XE+02 9.19818710XE+02 3.61233806XE+03 2.26451893XE+02 2.50015978XE+02 1.17403436XE+03 6.97585928XE+03 2.42733076XE+02 4.46835909XE+01 1.03883009XE+01 4.88054774XE+01 0.00000000XE+00 1.14897146XE+03 1.87727425XE+02 2.18004428XE+02 4.67211186XE+02 4.62766683XE+02 2.33546572XE+02 3.73484640XE+01 9.67904001XE+00 2.78313815XE+01 1.15246549XE+01 1.46332697XE+02 1.52411417XE+02 5.56062415XE+01 9.08540911XE+01 7.33682728XE+01 7.60815980XE+02 8.19975123XE+01 7.09511467XE+00 7.85409758XE-01 2.53217545XE+00 1.48574181XE+01 7.77034070XE+02 4.17796723XE+02 1.25257326XE+01 9.35536680XE-01 3.25045320XE+01 2.12367314XE+03 2.61045250XE-02 5.86986517XE+00 7.87012710XE+02 2.70033196XE-05 4.94496755XE+02 1.20975605XE+03 4.77523972XE+02 1.05549168XE+01 7.04098510XE+02 1.64384214XE+00 7.33659948XE+02 5.76565231XE+00 0.00000000XE+00 7.16302060XE-01 9.68929296XE+02 1.31964674XE+03 2.56587096XE+03 2.33639055XE+02 2.51632235XE+02 6.66904660XE+02 7.56726120XE+02 1.93673336XE-02 3.38557797XE+02 7.02447238XE-02 3.92353440XE+02 9.86959186XE+01 1.53003977XE+03 8.75594348XE+02 4.59592709XE+02 3.79242351XE+01 5.11860476XE+00 6.63752942XE+01 9.04133954XE+03 1.45019677XE+00 5.98289378XE+02 6.39728326XE+02 4.16800182XE+02 1.01643013XE+01 1.55250263XE+04 3.22058778XE+01 7.03937916XE+00 5.36076795XE-03 4.80326816XE+04 1.25861527XE-03 6.39350258XE+02 9.13618459XE+02 1.98739995XE+03 1.75122486XE+02 2.91172533XE+02 3.73850625XE+01 4.57996123XE+00 5.24425552XE+00 3.51998719XE+02 3.57887817XE-06 1.83327887XE+02 9.29890949XE+02 7.18963473XE+02 4.29130583XE+02 1.17781115XE+02 1.38113634XE+02 1.15881098XE+03 7.16951704XE-01 1.48363740XE+04 1.15262347XE+02 4.84074762XE+02 4.03895253XE+01 2.36472738XE+02 4.76336963XE+02 3.52013577XE+02 1.82792319XE+02 4.71640840XE+00 3.49823547XE+00 9.10745435XE+00 2.15813741XE+00 1.39937521XE+02 7.89509671XE+02 1.12188014XE+03 2.60728700XE+02 4.84673156XE+02 1.99127420XE+01 5.43654188XE+00 1.48711344XE+02 5.30993069XE+00 1.51778403XE+03 1.18218144XE+02 6.30179325XE+01 3.46223743XE+02 2.34576532XE+02 3.45285896XE+03 1.21697279XE+01 1.65093500XE+01 7.43821603XE+00 6.29476422XE+01 2.00507750XE-01 1.96975382XE+04 2.78765138XE+03 2.35209326XE+02 2.12716420XE+01 2.71185558XE+04 1.46249384XE+05 2.31880002XE+00 5.39750375XE+01 4.19020388XE+03 6.00056372XE-04 3.15786872XE+03 9.85218556XE+04 2.54367229XE+04 1.42355805XE+02 4.32470029XE+04 2.87041537XE+01 5.49318424XE+04 4.27721765XE+01 0.00000000XE+00 1.46640655XE+01 1.39559522XE+04 2.88806024XE+04 1.30472025XE+05 1.56306734XE+04 1.51955588XE+04 6.91493630XE+04 1.14118996XE+05 4.43502633XE-01 4.99813927XE+03 8.45358953XE-01 3.90686392XE+04 6.46771257XE+02 1.06925022XE+05 5.40864073XE+04 7.63593633XE+03 4.85440941XE+02 3.22693381XE+02 2.61806868XE+03 6.09593495XE+04 3.31786737XE+00 1.14394198XE+04 2.03050696XE+04 4.29775549XE+03 1.85491974XE+02 5.09189161XE+05 1.71083862XE+04 5.57352244XE+01 5.40482087XE+02 1.14819850XE+05 6.80203666XE-02 5.90256999XE+04 7.72665435XE+04 1.25040644XE+05 5.76488242XE+03 2.53934873XE+03 2.27660359XE+02 2.76421932XE+02 3.70310976XE+02 3.81662223XE+03 1.21438617XE-04 2.27400054XE+04 6.61311887XE+03 4.53712143XE+03 5.94278535XE+04 9.25033386XE+03 1.55608955XE+04 1.04241425XE+05 3.64928405XE+03 4.85912478XE+04 2.91387468XE+03 4.14399499XE+04 3.94016203XE+02 5.67419319XE+04 7.13819140XE+03 7.28745408XE+03 5.21558696XE+03 2.30828670XE+03 1.80502051XE+02 5.67901673XE+01 1.36594319XE+01 9.32651871XE+02 3.30282808XE+04 7.64936151XE+04 1.97900158XE+04 3.36362987XE+03 1.96408891XE+03 2.21616461XE+03 6.37582862XE+03 2.18771956XE+02 3.71287605XE+03 1.45254814XE+03 4.95207774XE+02 3.01142120XE+04 1.87953167XE+04 7.95671144XE+04 1.29009479XE+03 1.86380650XE+03 1.88838056XE+02 1.42887202XE+03 1.34779684XE+01 8.12685200XE+02 3.66106561XE+02 8.11128443XE+00 5.21031783XE-01 5.95072062XE+00 1.52950194XE+04 1.69126862XE-01 6.63447132XE-01 2.42344728XE+02 3.51759796XE-04 4.39114008XE+02 9.04418689XE+02 6.62924095XE+02 4.60975684XE+00 2.55864906XE+02 0.00000000XE+00 4.82535169XE+04 0.00000000XE+00 0.00000000XE+00 2.02633780XE+02 1.01908940XE+03 1.08276951XE+03 2.06864857XE+03 2.64631562XE+03 8.26287762XE+01 4.64512033XE+02 8.14686254XE+03 0.00000000XE+00 1.36997603XE+02 1.91067138XE-02 2.78148830XE+02 8.88058333XE+01 7.72474067XE+02 3.62136897XE+02 2.98570264XE+02 9.08552529XE+00 2.06821957XE-01 2.50770952XE+01 5.97611237XE+03 1.00141114XE+02 6.77052233XE+02 5.50184386XE+02 2.79428420XE+01 4.21263869XE+00 1.14619120XE+04 1.10646670XE+01 3.52782267XE+02 0.00000000XE+00 2.45070543XE+04 2.68489916XE-02 5.18407641XE+02 7.78140639XE+02 6.45951173XE+02 3.89564241XE+02 7.68830276XE+01 7.37250012XE+01 5.53489400XE+00 4.49760974XE+02 6.52069409XE+02 8.01816742XE-05 1.67319409XE+02 9.04900392XE+02 3.78799321XE+02 2.31945225XE+02 1.04006866XE+00 5.70396482XE+01 2.13320798XE+04 0.00000000XE+00 5.81426897XE+04 1.52640539XE+04 3.92047453XE+02 3.24216121XE+01 1.66290488XE+02 7.57808413XE+03 2.02246588XE+02 4.60921959XE+01 1.99566394XE+00 5.96546320XE+00 0.00000000XE+00 4.40607451XE+02 1.15412672XE+02 5.17603376XE+02 6.43460921XE+02 1.46063800XE+02 1.45877696XE+02 3.27010711XE+01 8.91001881XE-01 1.07005603XE+02 1.07677888XE+01 8.48808312XE+02 1.27721954XE+02 3.99058900XE+01 1.97439919XE+02 1.24995094XE+02 8.95557940XE+02 3.22484755XE+01 3.29774519XE+00 6.61096269XE-01 1.44870024XE+01 1.59908361XE+01 1.57351705XE+04 5.29530699XE+03 1.34280241XE+02 1.33768109XE+01 1.40155023XE+04 5.89677020XE+05 4.77267461XE+00 9.23690146XE+00 1.29027797XE+03 8.50712319XE-03 6.27804680XE+03 2.55159837XE+04 1.14258282XE+04 7.83594278XE+01 1.02738119XE+04 0.00000000XE+00 1.23788944XE+06 0.00000000XE+00 0.00000000XE+00 3.33156888XE+03 1.77632750XE+04 2.82448583XE+04 1.05195497XE+05 5.39701291XE+04 3.47264411XE+03 4.82177932XE+04 1.03899286XE+06 3.27126598XE-01 2.02254348XE+03 4.71417613XE-01 9.76213374XE+03 1.31916324XE+03 2.05690770XE+04 2.13002315XE+04 4.97878693XE+03 1.39087020XE+02 4.33055187XE+00 9.89090867XE+02 4.02926883XE+04 8.18767253XE+02 1.28832854XE+04 7.72685877XE+03 9.61604534XE+02 8.41103426XE+01 3.75928158XE+05 4.65090433XE+03 4.77251586XE+03 1.38829666XE+02 6.03732328XE+04 9.94262534XE-01 1.80033083XE+04 2.31893633XE+04 4.66534261XE+04 7.32080539XE+03 1.09846519XE+03 9.36484695XE+02 2.95985230XE+02 1.24504013XE+04 8.56167175XE+03 1.43336700XE-03 1.57437791XE+04 1.29737670XE+04 5.11571494XE+03 2.62129437XE+04 3.76042476XE+04 4.69201042XE+03 6.24447221XE+05 0.00000000XE+00 1.90426477XE+05 3.85893007XE+05 1.97072937XE+04 5.11641501XE+02 3.24604847XE+04 1.35268244XE+05 5.98566900XE+03 1.33265162XE+03 7.21909195XE+02 2.48604493XE+03 0.00000000XE+00 5.87230059XE+03 1.75807414XE+03 1.04753693XE+04 1.54960242XE+04 6.47489588XE+03 2.91333371XE+03 1.34850079XE+03 8.78842221XE+02 4.58765216XE+03 7.69097923XE+02 6.34109657XE+03 2.13120664XE+03 1.22003070XE+03 6.71379577XE+03 5.78896491XE+03 2.06374052XE+04 8.87775282XE+02 5.27210513XE+02 7.54097607XE+01 3.67146191XE+02 5.91875286XE+02 8.35240746XE+02 3.27525222XE+02 2.52753753XE+03 0.00000000XE+00 3.20735142XE+02 1.33395919XE+04 1.46350916XE-01 7.49928449XE-01 5.95433078XE+02 1.09850903XE-03 4.31134524XE+02 1.01246285XE+03 6.05865708XE+02 2.75438343XE+00 3.11860777XE+02 0.00000000XE+00 2.24494201XE+04 1.32056389XE+03 0.00000000XE+00 4.62939564XE+02 1.04885462XE+03 1.02707015XE+03 1.27475212XE+03 3.31758343XE+03 2.22067997XE+02 9.09426577XE+03 1.34869673XE+04 0.00000000XE+00 3.09317514XE+02 1.73831350XE-01 1.26720536XE+01 7.91953266XE+01 1.86949135XE+03 4.87822742XE+02 1.48947813XE+03 3.28978642XE+03 4.32309722XE+02 7.16558571XE+01 7.10223431XE+03 3.67294656XE+02 7.03552821XE+02 5.93240473XE+02 1.07473346XE+03 2.86412181XE+03 4.20045526XE+03 7.67622069XE+01 1.47274472XE+03 4.98500869XE+00 3.51157089XE+04 1.38878895XE+04 5.37575672XE+02 8.50202253XE+02 7.83556859XE+02 4.21007096XE+02 5.49871808XE+01 2.62189143XE+02 3.13631695XE+01 6.95749114XE+02 2.37359473XE+03 6.53524026XE+01 4.26209569XE+00 8.93761984XE+02 3.49837839XE+02 3.11750830XE+02 2.52187805XE+03 3.74851652XE+02 3.88975026XE+04 1.28322689XE+04 8.58860639XE+04 9.29327702XE+03 1.04683418XE+02 4.84065714XE+01 1.04656392XE+03 2.42728000XE+03 2.25979977XE+02 2.05893496XE+03 1.29765642XE+01 2.86970025XE+01 0.00000000XE+00 1.46847294XE+01 1.06162830XE+02 5.08839760XE+02 6.47071800XE+02 2.00097661XE+02 1.43862933XE+02 4.01160303XE+01 5.37712201XE+01 2.14416886XE+02 3.15215873XE+01 2.40876542XE+03 1.63802644XE+02 4.18189463XE+01 2.19505936XE+02 1.40442028XE+02 6.99052293XE+02 3.42212931XE+01 8.63483251XE+00 2.03952408XE+00 1.20385356XE+02 4.36052882XE+01 5.12075447XE+04 2.41672931XE+04 2.44516484XE+05 0.00000000XE+00 2.95162148XE+04 1.32835444XE+06 1.31320655XE+01 2.92553107XE+01 3.27287408XE+03 3.70391839XE-02 1.95006003XE+04 8.04836127XE+04 3.11256736XE+04 1.07352667XE+02 2.93559014XE+04 0.00000000XE+00 1.60401127XE+06 4.21212936XE+04 0.00000000XE+00 2.11466493XE+04 5.73223639XE+04 6.47190846XE+04 9.14949248XE+04 3.23103918XE+05 1.09065109XE+04 7.35481595XE+05 1.85577181XE+06 0.00000000XE+00 4.89249268XE+03 2.20394524XE+00 5.47698382XE+02 3.92871755XE+03 9.77971720XE+04 5.65539204XE+04 9.29388787XE+04 1.27738559XE+05 4.23675262XE+04 2.76286598XE+03 5.00093192XE+04 4.44491037XE+03 4.27998730XE+04 2.56881219XE+04 5.40596931XE+04 1.29403122XE+05 1.54274908XE+05 1.03374254XE+04 5.79943094XE+04 3.92923160XE+02 8.75829557XE+04 6.24528953XE+05 5.45362139XE+04 7.22671114XE+04 1.07219082XE+05 2.23944426XE+04 2.27943557XE+03 8.70741449XE+03 1.06717911XE+03 5.19382679XE+04 2.72275274XE+04 1.48192029XE+02 1.93243192XE+02 6.00169518XE+04 1.33491454XE+04 4.64263639XE+04 3.04240899XE+05 4.04080916XE+04 1.67479941XE+06 1.08718365XE+06 2.91571000XE+05 2.58233078XE+05 1.17165071XE+04 4.57766943XE+03 6.24399990XE+04 1.27708883XE+05 1.79698718XE+04 3.45845924XE+05 2.04767166XE+03 1.85650375XE+03 0.00000000XE+00 4.78594409XE+02 5.60843920XE+03 3.20891319XE+04 4.23901897XE+04 2.32146822XE+04 8.35414576XE+03 3.96947838XE+03 2.62321110XE+03 9.46462435XE+03 3.84272577XE+03 1.26488356XE+05 1.07699739XE+04 2.39023333XE+03 2.13259961XE+04 1.73805243XE+04 1.78116957XE+04 2.77833806XE+03 1.51936350XE+03 2.16618041XE+02 3.02948331XE+03 4.16431626XE+03 3.25444350XE+04 1.28143538XE+05 1.57816185XE+05 7.05098463XE+01 4.61274051XE+03 9.38206736XE+04 4.48857967XE+00 4.57881062XE+01 1.02734803XE+04 2.92626681XE-02 1.30021902XE+04 5.56281704XE+04 6.28425887XE+04 7.38034584XE+01 8.81746685XE+03 3.61514693XE+02 1.78352125XE+05 2.47984828XE+04 0.00000000XE+00 6.87132525XE+02 4.29574721XE+04 2.83282057XE+04 1.10720283XE+05 1.66614109XE+05 1.49087659XE+04 2.02669798XE+05 6.37888183XE+04 0.00000000XE+00 4.42089008XE+03 3.25617385XE+00 4.50408150XE+04 1.81309235XE+03 1.42611239XE+05 2.76210244XE+04 1.46583614XE+05 1.10239716XE+05 1.16234160XE+04 1.83955439XE+03 1.48689073XE+05 3.98859119XE+03 4.15238802XE+04 4.29099719XE+04 1.26909236XE+05 4.69924297XE+05 1.84766857XE+05 1.16729769XE+03 2.98149550XE+04 6.36766508XE+01 3.79915580XE+06 3.91325206XE+04 2.35989469XE+04 5.41720070XE+04 3.03934025XE+04 1.75326093XE+04 7.52624933XE+03 1.00352678XE+04 8.85594610XE+04 1.69014219XE+04 7.63226555XE+04 3.67789225XE+03 7.41991947XE+03 4.21436389XE+04 1.00120503XE+04 2.55982970XE+04 1.06819411XE+05 1.41887986XE+04 3.59417125XE+05 5.74928783XE+05 2.70606435XE+05 1.90338267XE+04 1.19909982XE+04 1.46016015XE+03 3.42746284XE+04 1.19495158XE+05 7.32328392XE+03 4.01453472XE+03 1.14799253XE+05 7.07002679XE+02 7.78390197XE+03 9.20877807XE+02 2.74064812XE+03 1.60384890XE+04 4.62274510XE+04 1.45933200XE+04 5.61018361XE+03 1.37399260XE+03 2.64017677XE+03 4.89830390XE+03 8.20193483XE+03 1.40881060XE+05 2.35461110XE+04 1.71147721XE+03 1.07763302XE+04 4.69440374XE+03 2.36573703XE+04 1.69303082XE+03 4.90150627XE+02 1.26211240XE+04 8.46051859XE+03 4.90390104XE+01 1.05808474XE+02 1.45682979XE+03 1.34936982XE+02 1.45611095XE-01 5.73148283XE+01 6.71293063XE+01 5.87161349XE+00 1.58082428XE+00 3.43285220XE+01 2.12424386XE-04 8.21286865XE+02 1.55975185XE+03 1.07365550XE+03 7.22418863XE+01 2.30085488XE+02 1.38460201XE-01 4.94938687XE+01 3.68620628XE+00 0.00000000XE+00 7.27665305XE-01 1.69110207XE+02 8.98707100XE+02 5.58916065XE+02 9.28530202XE+01 1.07569149XE+01 4.57898024XE+01 1.78223407XE+01 3.01751252XE-03 2.89188139XE+01 1.76024422XE-03 1.98231351XE+02 9.08488799XE+02 2.35285449XE+02 3.09956457XE+01 5.48481281XE+01 4.23497404XE+01 7.32531013XE+00 1.15601819XE+00 6.28327586XE+02 5.88999224XE-01 8.49822946XE+01 5.64060502XE+02 3.18192283XE+02 6.75178464XE+01 1.77779753XE+03 2.35401991XE+01 8.65114548XE+02 2.03688733XE-03 5.39725235XE+03 1.76403776XE-03 1.12970816XE+02 3.48003085XE+02 2.93613885XE+02 6.11529810XE+01 2.16249643XE+02 2.30747590XE+01 1.82990192XE+01 4.48585874XE+00 6.09644737XE+00 1.79050165XE-04 7.09203761XE+01 2.78673777XE+02 5.61374668XE+02 2.63855083XE+02 8.38193047XE+00 8.50289925XE+00 5.52523842XE+01 1.08115123XE+00 2.83013351XE+02 2.70010925XE+01 2.80937664XE+02 2.24907113XE+02 1.35779037XE+03 6.72395738XE+01 9.13912550XE+01 2.26741277XE+01 6.30150929XE+00 1.01420827XE+00 1.17412975XE+00 2.85953265XE-01 2.41115699XE+02 3.25787496XE+02 5.53780949XE+02 1.39061165XE+01 1.83914709XE+02 1.16926248XE+01 1.44502442XE+00 5.48443378XE+00 1.15745342XE+00 2.32410987XE+01 2.53076516XE+01 3.44443239XE+01 1.41282479XE+02 2.61761781XE+01 7.98438334XE+02 4.33666105XE+01 2.41395503XE+00 1.63756217XE+00 1.30340491XE+00 7.15184878XE-02 8.53540984XE+03 5.57125410XE+03 3.12293506XE+02 1.38394985XE+01 4.15130253XE+03 1.56764391XE+05 6.92212621XE+01 9.93650893XE+01 1.55343095XE+01 6.49583504XE-03 4.98701701XE+03 3.68620786XE+04 5.59329135XE+04 2.89349482XE+02 9.54313687XE+03 2.01729259XE+02 5.88857433XE+05 4.33507052XE+04 0.00000000XE+00 1.08437958XE+03 2.16639118XE+04 1.26581902XE+04 1.22305850XE+05 9.83479684XE+04 1.52835824XE+04 4.56952290XE+03 1.65398878XE+05 7.45696193XE-01 5.50927428XE+01 1.09560989XE-01 4.28657796XE+04 2.18282445XE+03 1.27271151XE+04 2.79358655XE+04 3.03053205XE+04 1.33522286XE+03 7.44638072XE+04 2.95586882XE+02 1.04450497XE+02 3.04780226XE+02 1.90259334XE+04 2.40271889XE+04 9.99130991XE+02 4.27203604XE+03 3.12200476XE+03 3.27146119XE+03 1.79887682XE+04 4.47251059XE+02 7.48566649XE+01 1.63116205XE+04 8.87728640XE+03 3.59302999XE+04 1.17445313XE+04 1.61532212XE+04 1.98281841XE+03 1.87778381XE+04 2.45663891XE+05 1.60356200XE+04 5.60227288XE+03 8.83068551XE-02 3.22592398XE+03 2.03336597XE+04 5.41632124XE+03 1.50324722XE+04 7.48080979XE+04 1.31173507XE+04 8.08559493XE+04 6.73390369XE+04 1.70983212XE+02 3.05112346XE+02 3.47710236XE+03 6.79308021XE+02 2.66964407XE+04 8.04830240XE+05 7.99308802XE+03 1.75873040XE+04 1.10316499XE+03 1.50331923XE+04 0.00000000XE+00 7.05768203XE+02 1.15707127XE+03 7.17234784XE+03 5.92395660XE+04 2.88176855XE+04 7.56873441XE+03 3.08955783XE+03 4.69339866XE+04 3.66218715XE+03 2.16955890XE+02 3.79860806XE+02 1.37962799XE+03 4.74537140XE+02 2.57145073XE+03 2.49311582XE+03 7.34600852XE+03 3.60258008XE+03 6.52608543XE+02 7.08888080XE+01 6.54557050XE+01 1.59825064XE+01 3.25444350XE+04 1.28143538XE+05 1.57816185XE+05 7.05098463XE+01 4.61274051XE+03 9.38206736XE+04 4.48857967XE+00 4.57881062XE+01 1.02734803XE+04 2.92626681XE-02 1.30021902XE+04 5.56281704XE+04 6.28425887XE+04 7.38034584XE+01 8.81746685XE+03 3.61514693XE+02 1.78352125XE+05 2.47984828XE+04 0.00000000XE+00 6.87132525XE+02 4.29574721XE+04 2.83282057XE+04 1.10720283XE+05 1.66614109XE+05 1.49087659XE+04 2.02669798XE+05 6.37888183XE+04 0.00000000XE+00 4.42089008XE+03 3.25617385XE+00 4.50408150XE+04 1.81309235XE+03 1.42611239XE+05 2.76210244XE+04 1.46583614XE+05 1.10239716XE+05 1.16234160XE+04 1.83955439XE+03 1.48689073XE+05 3.98859119XE+03 4.15238802XE+04 4.29099719XE+04 1.26909236XE+05 4.69924297XE+05 1.84766857XE+05 1.16729769XE+03 2.98149550XE+04 6.36766508XE+01 3.79915580XE+06 3.91325206XE+04 2.35989469XE+04 5.41720070XE+04 3.03934025XE+04 1.75326093XE+04 7.52624933XE+03 1.00352678XE+04 8.85594610XE+04 1.69014219XE+04 7.63226555XE+04 3.67789225XE+03 7.41991947XE+03 4.21436389XE+04 1.00120503XE+04 2.55982970XE+04 1.06819411XE+05 1.41887986XE+04 3.59417125XE+05 5.74928783XE+05 2.70606435XE+05 1.90338267XE+04 1.19909982XE+04 1.46016015XE+03 3.42746284XE+04 1.19495158XE+05 7.32328392XE+03 4.01453472XE+03 1.14799253XE+05 7.07002679XE+02 7.78390197XE+03 9.20877807XE+02 2.74064812XE+03 1.60384890XE+04 4.62274510XE+04 1.45933200XE+04 5.61018361XE+03 1.37399260XE+03 2.64017677XE+03 4.89830390XE+03 8.20193483XE+03 1.40881060XE+05 2.35461110XE+04 1.71147721XE+03 1.07763302XE+04 4.69440374XE+03 2.36573703XE+04 1.69303082XE+03 4.90150627XE+02 1.26211240XE+04 8.46051859XE+03 4.90390104XE+01 6.41891472XE+04 3.35063729XE+04 1.41779293XE+05 0.00000000XE+00 1.79822533XE+04 1.02848947XE+05 4.58404344XE+00 6.54740176XE+01 3.29773325XE+04 5.77155968XE-02 2.37716077XE+04 1.11303602XE+05 2.16523419XE+04 1.60321493XE+02 1.48610854XE+04 0.00000000XE+00 1.71131419XE+05 3.34902615XE+04 0.00000000XE+00 1.19289297XE+03 8.45415967XE+04 4.90814736XE+04 1.95675042XE+05 1.45550359XE+05 2.70814580XE+04 1.75394836XE+05 1.19648235XE+05 0.00000000XE+00 1.32733117XE+04 1.03965524XE+01 4.89430016XE+02 2.64412702XE+03 1.13383381XE+05 5.33706230XE+04 2.47646978XE+05 1.21734684XE+05 1.62128194XE+04 6.27314496XE+03 4.18039339XE+05 1.27558446XE+04 8.53994575XE+04 8.67281668XE+04 1.19925945XE+05 2.75069070XE+05 2.93229545XE+05 2.85452575XE+03 6.26123439XE+04 2.25069337XE+02 5.16344009XE+06 3.00170385XE+04 4.84119545XE+04 1.07357527XE+05 6.37954150XE+04 3.00969603XE+04 2.32672939XE+03 1.63120154XE+04 2.30576783XE+03 2.91764926XE+04 1.48521377XE+05 6.84977251XE+03 2.86247927XE+02 8.31168769XE+04 1.68320616XE+04 5.08500510XE+04 9.05222283XE+04 2.50755341XE+04 2.78498763XE+05 9.02401879XE+05 4.93006645XE+05 3.00532185XE+04 4.53453178XE+03 1.86957448XE+03 3.85847199XE+04 1.04036960XE+05 1.22156457XE+04 8.84394160XE+04 5.70021226XE+02 1.36256666XE+03 0.00000000XE+00 4.21361463XE+01 4.84313218XE+03 3.33083472XE+04 8.38739853XE+04 3.02382207XE+04 1.11210460XE+04 2.34510979XE+03 3.35833722XE+03 1.60734294XE+04 9.83702647XE+02 3.62725761XE+05 1.82803746XE+04 3.48879783XE+03 2.15530665XE+04 9.04738123XE+03 3.70437036XE+04 3.33315518XE+03 4.38069161XE+02 1.75755497XE+02 1.38022669XE+04 9.79189930XE+01 1.96733150XE+04 4.96900439XE+03 1.44386853XE+02 4.11797448XE+01 1.86014293XE+03 1.11019361XE+05 3.58126022XE+00 2.55712461XE+01 4.75045356XE+03 1.50582097XE-02 6.41702490XE+03 4.38350364XE+04 6.91608191XE+04 7.27690665XE+01 4.62261447XE+03 3.26605774XE+02 3.49371139XE+05 0.00000000XE+00 0.00000000XE+00 5.06576557XE+02 2.72107810XE+04 1.49826876XE+04 1.60471275XE+05 9.13104061XE+04 1.27916039XE+04 8.85009578XE+03 2.98393302XE+04 0.00000000XE+00 1.85448093XE+03 1.51911724XE+00 5.43351241XE+04 1.49725748XE+03 1.32820870XE+04 1.88993372XE+04 1.17468949XE+04 1.23183954XE+02 4.14969025XE+00 9.38008114XE+02 1.19517597XE+05 3.18548716XE+03 3.07143335XE+04 3.52255541XE+04 5.17563967XE+02 5.78718803XE+01 2.73405062XE+05 1.28850004XE+02 1.68134643XE+04 7.78777303XE-01 3.91168755XE+05 1.24440437XE-01 1.49974649XE+04 4.16000391XE+04 1.64785090XE+04 1.02427268XE+04 1.00526796XE+03 1.26266453XE+04 9.57545046XE+02 1.73222076XE+04 7.42425017XE+03 2.28114357XE-03 5.25456519XE+03 2.98440195XE+04 5.08586200XE+03 2.11351387XE+04 1.43270893XE+04 1.47905342XE+04 8.05003019XE+04 0.00000000XE+00 3.21304601XE+05 4.77656890XE+04 5.74445987XE+03 5.21678638XE+02 1.36962278XE+04 3.10308448XE+05 3.48510051XE+03 2.68474112XE+03 2.49962642XE+01 4.92581950XE+02 0.00000000XE+00 9.42146381XE+02 1.53429901XE+03 1.13218400XE+04 3.63231570XE+04 1.07729523XE+04 4.65624190XE+03 6.23694228XE+02 7.33572584XE+01 2.77875783XE+03 3.02815087XE+02 3.49038469XE+04 2.75355420XE+03 8.25099305XE+02 6.67700038XE+03 2.31270823XE+03 1.50807081XE+04 6.14926028XE+02 2.80370919XE+02 6.44023719XE+01 3.27389505XE+02 3.43895055XE+01 3.18823999XE+02 1.72831900XE+03 1.64994616XE+02 5.85888394XE-01 4.91112327XE+01 1.53201631XE+04 4.76086001XE-01 1.76135022XE+00 2.70160868XE+02 5.74410909XE-04 1.07959430XE+03 1.19361785XE+03 7.21727964XE+02 9.52058053XE+01 3.46878058XE+02 1.82298648XE+00 5.24603564XE+03 1.07073592XE+02 0.00000000XE+00 1.79093115XE+00 3.86883007XE+02 1.34476397XE+03 1.32359356XE+03 3.50862253XE+03 7.65636838XE+01 3.11698059XE+03 2.77675751XE+03 1.41219965XE-01 1.98958979XE+02 5.02406745XE-02 2.13375190XE+02 9.54490688XE+02 1.08768324XE+03 2.95004064XE+02 1.48561009XE+02 2.18008186XE+01 8.30672267XE+01 2.01857864XE+01 3.36362097XE+03 2.90043026XE+01 2.26670801XE+02 4.59555303XE+02 3.52678159XE+02 4.00556851XE+01 5.56637669XE+03 3.05715907XE+01 6.02921631XE+01 9.44665173XE-03 2.60966569XE+04 5.80488571XE-03 2.68375162XE+02 3.41104880XE+02 1.15856781XE+03 5.57793379XE+01 1.93844199XE+02 6.35689543XE+01 9.31799963XE+00 9.35991166XE+01 3.82847474XE+02 7.12458192XE-05 8.93011868XE+01 4.79049192XE+02 7.76648860XE+02 5.35119616XE+02 7.99776180XE+01 7.44200699XE+01 4.38118957XE+03 4.44321587XE+00 8.13971461XE+04 3.61101278XE+02 4.03510250XE+02 2.89230379XE+02 1.16020871XE+03 1.32794244XE+03 1.44864300XE+02 6.18636755XE+01 1.45066856XE+01 4.63086562XE+00 3.01732213XE+01 4.61881129XE+00 3.64166767XE+02 6.11564226XE+02 9.47446955XE+02 1.06856385XE+02 2.76661240XE+02 1.04664810XE+01 7.29434140XE+01 5.21166674XE+01 3.05206089XE+01 7.16336570XE+02 1.94146099XE+02 4.99846541XE+01 2.69396312XE+02 1.24414769XE+02 1.59728654XE+03 1.07825205XE+01 2.09125910XE+01 2.90491459XE+00 4.16753781XE+01 4.31552146XE-01 5.52580112XE+04 1.61482933XE+04 2.49538415XE+02 6.55707325XE-01 3.81258329XE+03 1.28831413XE+05 2.98561428XE+01 5.81903251XE+01 3.88509610XE+01 1.33040916XE-02 4.34640945XE+03 9.83151803XE+04 9.30796765XE+04 1.99245666XE+02 1.64285757XE+04 4.48619827XE+02 4.39375883XE+05 0.00000000XE+00 0.00000000XE+00 2.28060429XE+03 1.00048174XE+05 1.12556906XE+04 5.82620741XE+04 1.00166063XE+05 2.92879745XE+04 3.67354938XE+03 7.33598511XE+04 4.21365380XE-02 1.03576305XE+01 2.48083803XE-01 2.75048945XE+03 1.86340486XE+03 1.33950025XE+04 5.58852044XE+04 4.26020942XE+04 3.80593068XE+02 4.36306783XE+01 9.76662290XE+01 7.50522249XE+02 5.72825445XE+02 6.89748809XE+04 6.23787067XE+04 7.05882450XE+02 8.77100042XE+03 1.25561984XE+04 6.14270987XE+02 8.75198271XE+01 4.01480046XE+01 2.79584988XE+04 8.78689404XE+03 5.05647605XE+04 8.21290662XE+04 6.49392838XE+04 7.70849146XE+04 1.25864753XE+03 2.65697215XE+04 2.15875493XE+05 2.45160218XE+04 9.76816795XE+03 9.68931677XE+00 9.73489778XE+03 1.18618039XE+05 3.43122874XE+03 3.23872020XE+04 2.10946328XE+04 2.00910883XE+04 8.32707330XE+04 4.01289949XE+03 1.54986442XE+03 5.98612570XE+02 3.51686756XE+03 5.62315482XE+02 2.33048665XE+04 5.89763430XE+05 1.16649996XE+04 1.31487322XE+04 1.91146052XE+02 1.46729823XE+03 0.00000000XE+00 1.22667926XE+03 2.59275498XE+03 3.64541784XE+04 9.70805339XE+04 2.68580224XE+04 7.07163001XE+03 4.48941803XE+03 1.93319594XE+03 1.84416869XE+02 9.04073459XE+02 9.48086731XE+02 5.08684113XE+03 6.55407907XE+02 1.82368337XE+04 4.57155022XE+03 6.56419142XE+03 3.20243752XE+03 5.11633111XE+02 1.01884757XE+02 6.42320798XE+00 9.52650687XE+01 2.06157868XE+04 5.22344800XE+03 1.52764938XE+02 4.33035780XE+01 1.89007665XE+03 1.10426037XE+05 3.33104661XE+00 2.92273581XE+01 5.15438564XE+03 1.67528880XE-02 7.29674437XE+03 4.39537710XE+04 6.88573050XE+04 7.93916997XE+01 4.69272223XE+03 3.28237664XE+02 3.43969041XE+05 0.00000000XE+00 0.00000000XE+00 4.89413312XE+02 2.80979799XE+04 1.55125970XE+04 1.61360149XE+05 9.11779069XE+04 1.27671641XE+04 9.48143064XE+03 2.97053920XE+04 0.00000000XE+00 2.06458628XE+03 1.49267556XE+00 5.42745309XE+04 1.53535615XE+03 1.44803422XE+04 1.86846326XE+04 1.20783850XE+04 1.29014900XE+02 4.26730519XE+00 9.50674444XE+02 1.27113682XE+05 3.16551035XE+03 3.07852114XE+04 3.55906197XE+04 4.99334882XE+02 5.85492522XE+01 2.88936076XE+05 1.41946655XE+02 1.73137711XE+04 8.07713306XE-01 4.33023004XE+05 1.29415795XE-01 1.56054657XE+04 4.13120577XE+04 1.71730617XE+04 1.01262450XE+04 1.07544405XE+03 1.31585103XE+04 9.70063940XE+02 1.72359832XE+04 7.48357627XE+03 2.64512047XE-03 5.28010187XE+03 3.05548935XE+04 5.78556121XE+03 2.12299796XE+04 1.43057095XE+04 1.48037718XE+04 8.03260140XE+04 0.00000000XE+00 3.20270379XE+05 4.80706047XE+04 6.51084026XE+03 5.49014355XE+02 1.37914800XE+04 2.99589102XE+05 3.53309681XE+03 2.50517990XE+03 2.57382070XE+01 4.97743785XE+02 0.00000000XE+00 9.47661993XE+02 1.66999365XE+03 1.13693591XE+04 3.49310741XE+04 1.09108173XE+04 4.67088344XE+03 6.11989177XE+02 7.69138958XE+01 2.85784549XE+03 3.08124602XE+02 3.50893041XE+04 2.97660033XE+03 9.31015996XE+02 7.02252084XE+03 2.46345544XE+03 1.70291063XE+04 5.63060682XE+02 3.00230015XE+02 6.48962086XE+01 3.43372489XE+02 3.51298104XE+01 6.41891472XE+04 3.35063729XE+04 1.41779293XE+05 0.00000000XE+00 1.79822533XE+04 1.02848947XE+05 4.58404344XE+00 6.54740176XE+01 3.29773325XE+04 5.77155968XE-02 2.37716077XE+04 1.11303602XE+05 2.16523419XE+04 1.60321493XE+02 1.48610854XE+04 0.00000000XE+00 1.71131419XE+05 3.34902615XE+04 0.00000000XE+00 1.19289297XE+03 8.45415967XE+04 4.90814736XE+04 1.95675042XE+05 1.45550359XE+05 2.70814580XE+04 1.75394836XE+05 1.19648235XE+05 0.00000000XE+00 1.32733117XE+04 1.03965524XE+01 4.89430016XE+02 2.64412702XE+03 1.13383381XE+05 5.33706230XE+04 2.47646978XE+05 1.21734684XE+05 1.62128194XE+04 6.27314496XE+03 4.18039339XE+05 1.27558446XE+04 8.53994575XE+04 8.67281668XE+04 1.19925945XE+05 2.75069070XE+05 2.93229545XE+05 2.85452575XE+03 6.26123439XE+04 2.25069337XE+02 5.16344009XE+06 3.00170385XE+04 4.84119545XE+04 1.07357527XE+05 6.37954150XE+04 3.00969603XE+04 2.32672939XE+03 1.63120154XE+04 2.30576783XE+03 2.91764926XE+04 1.48521377XE+05 6.84977251XE+03 2.86247927XE+02 8.31168769XE+04 1.68320616XE+04 5.08500510XE+04 9.05222283XE+04 2.50755341XE+04 2.78498763XE+05 9.02401879XE+05 4.93006645XE+05 3.00532185XE+04 4.53453178XE+03 1.86957448XE+03 3.85847199XE+04 1.04036960XE+05 1.22156457XE+04 8.84394160XE+04 5.70021226XE+02 1.36256666XE+03 0.00000000XE+00 4.21361463XE+01 4.84313218XE+03 3.33083472XE+04 8.38739853XE+04 3.02382207XE+04 1.11210460XE+04 2.34510979XE+03 3.35833722XE+03 1.60734294XE+04 9.83702647XE+02 3.62725761XE+05 1.82803746XE+04 3.48879783XE+03 2.15530665XE+04 9.04738123XE+03 3.70437036XE+04 3.33315518XE+03 4.38069161XE+02 1.75755497XE+02 1.38022669XE+04 9.79189930XE+01
	Index: trunk/share/tests/functional_tests/ref-output-ext/powheg_1.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-ext/powheg_1.ref (revision 8835)
	+++ trunk/share/tests/functional_tests/ref-output-ext/powheg_1.ref (revision 8836)
	@@ -1,723 +1,689 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	openmp_num_threads = 1
	?pacify = true
	seed = 0
	SM.wtop => 0.00000E+00
	SM.mtop => 1.75000E+02
	?use_vamp_equivalences = false
	$loop_me_method = "dummy"
	?alphas_is_fixed = false
	?alphas_from_mz = true
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = true
	?powheg_matching = true
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_pt_min = 1.00000E+00
	?powheg_use_singular_jacobian = false
	\| Process library 'powheg_1_lib': recorded process 'powheg_1_p1'
	sqrts = 5.00000E+02
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_1_lib': compiling ...
	\| Process library 'powheg_1_lib': writing makefile
	\| Process library 'powheg_1_lib': removing old files
	\| Process library 'powheg_1_lib': writing driver
	\| Process library 'powheg_1_lib': creating source code
	\| Process library 'powheg_1_lib': compiling sources
	\| Process library 'powheg_1_lib': linking
	\| Process library 'powheg_1_lib': loading
	\| Process library 'powheg_1_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process powheg_1_p1:
	\| 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 'powheg_1_p1.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p1.i3.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_1_p1'
	\| Library name = 'powheg_1_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'powheg_1_p1_i1': e+, e- => t, tbar [omega]
	\| 2: 'powheg_1_p1_i2': e+, e- => t, tbar, gl [omega], [real]
	\| 3: 'powheg_1_p1_i3': e+, e- => t, tbar [dummy], [virtual]
	\| 4: 'powheg_1_p1_i4': e+, e- => t, tbar [inactive], [subtraction]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| Using user-defined general scale.
	\| Starting integration for process 'powheg_1_p1'
	\| Integration hook: add POWHEG hook
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 1 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.682E+02 2.15E+01 4.59 0.46 45.9
	\|-----------------------------------------------------------------------------\|
	1 100 4.682E+02 2.15E+01 4.59 0.46 45.9
	\|=============================================================================\|
	n_events = 1
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?write_raw = false
	\| Starting simulation for process 'powheg_1_p1'
	\| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 2.1359E-03
	\| Events: writing to ASCII file 'powheg_1_p1.debug'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p1.pg'
	\| Grid: Mean value of the grid: 2.73542E-03
	\| Grid: Max value of the grid: 5.79027E-03
	\| Grid: Mean/Max value of the grid: 4.72416E-01
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 20.00 %
	\| Events: closing ASCII file 'powheg_1_p1.debug'
	n_events = 2
	\| Starting simulation for process 'powheg_1_p1'
	\| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 2
	\| corr. to luminosity [fb-1] = 4.2717E-03
	\| Events: writing to ASCII file 'powheg_1_p1.debug'
	\| Events: generating 2 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p1.pg'
	\| Grid: Mean value of the grid: 2.73542E-03
	\| Grid: Max value of the grid: 5.79027E-03
	\| Grid: Mean/Max value of the grid: 4.72416E-01
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 100.00 %
	\| Events: closing ASCII file 'powheg_1_p1.debug'
	-$real_partition_mode = "on"
	+$real_partition_mode = "singular"
	real_partition_scale = 5.00000E+00
	\| Process library 'powheg_1_lib': unloading
	\| Process library 'powheg_1_lib': open
	\| Process library 'powheg_1_lib': recorded process 'powheg_1_p2'
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_1_lib': compiling ...
	\| Process library 'powheg_1_lib': writing makefile
	\| Process library 'powheg_1_lib': removing old files
	\| Process library 'powheg_1_lib': writing driver
	\| Process library 'powheg_1_lib': creating source code
	\| Process library 'powheg_1_lib': compiling sources
	\| Process library 'powheg_1_lib': linking
	\| Process library 'powheg_1_lib': loading
	\| Process library 'powheg_1_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Initializing integration for process powheg_1_p2:
	\| 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 'powheg_1_p2.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p2.i3.phs'
	-\| Phase space: generating configuration ...
	-\| Phase space: ... success.
	-\| Phase space: writing configuration file 'powheg_1_p2.i5.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_1_p2'
	\| Library name = 'powheg_1_lib'
	\| Process index = 2
	\| Process components:
	\| 1: 'powheg_1_p2_i1': e+, e- => t, tbar [omega]
	\| 2: 'powheg_1_p2_i2': e+, e- => t, tbar, gl [omega], [real]
	\| 3: 'powheg_1_p2_i3': e+, e- => t, tbar [dummy], [virtual]
	\| 4: 'powheg_1_p2_i4': e+, e- => t, tbar [inactive], [subtraction]
	-\| 5: 'powheg_1_p2_i5': e+, e- => t, tbar, gl [omega], [real]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	-\| Phase space: 2 channels, 5 dimensions
	-\| Phase space: found 2 channels, collected in 1 grove.
	-\| Phase space: no equivalences between channels used.
	-\| Phase space: wood
	Warning: No cuts have been defined.
	\| Using user-defined general scale.
	+\| Starting integration for process 'powheg_1_p2'
	\| Integration hook: add POWHEG hook
	-\| Starting integration for process 'powheg_1_p2' part 'Combined'
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 1 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
	\|-----------------------------------------------------------------------------\|
	1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
	\|=============================================================================\|
	-\| Starting integration for process 'powheg_1_p2' part 'real'
	-\| Integrate: iterations = 1:100:"gw"
	-\| Integrator: 1 chains, 2 channels, 5 dimensions
	-\| Integrator: 100 initial calls, 20 bins, stratified = T
	-\| Integrator: VAMP
	-\|=============================================================================\|
	-\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	-\|=============================================================================\|
	- 1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
	-\|-----------------------------------------------------------------------------\|
	- 1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
	-\|=============================================================================\|
	-\| Integrate: sum of all components
	-\|=============================================================================\|
	-\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	-\|=============================================================================\|
	- 1 0 4.978E+02 2.90E+01 5.83 0.00 31.2
	-\|=============================================================================\|
	-tolerance = 1.08344E+02
	+tolerance = 9.87691E+01
	\| expect: success
	\| Starting simulation for process 'powheg_1_p2'
	\| Simulate: using integration grids from file 'powheg_1_p2.m1.vg'
	-\| Simulate: using integration grids from file 'powheg_1_p2.m2.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 4
	\| Simulation: requested number of events = 2
	-\| corr. to luminosity [fb-1] = 4.0174E-03
	+\| corr. to luminosity [fb-1] = 4.9309E-03
	\| Events: writing to ASCII file 'powheg_1_p2.debug'
	\| Events: generating 2 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p2.pg'
	\| Grid: Mean value of the grid: 5.27612E-04
	\| Grid: Max value of the grid: 6.09917E-03
	\| Grid: Mean/Max value of the grid: 8.65055E-02
	\| ... event sample complete.
	-\| Events: actual unweighting efficiency = 20.00 %
	+\| Events: actual unweighting efficiency = 14.29 %
	\| Events: closing ASCII file 'powheg_1_p2.debug'
	\| Summary of value checks:
	\| Failures: 0 / Total: 1
	\| There were no errors and 2 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Contents of powheg_1_p1.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.82009E-02
	Squared matrix el. (prc) = 2.82009E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 9.608533E+01 -1.236770E+02 -8.571236E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -9.608533E+01 1.236770E+02 8.571236E+01
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 8
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 250.000 96.085 -123.677 -85.712 30625.000
	4 [o] tbar 0 1 1-2 [none] 250.000 -96.085 123.677 85.712 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.82009E-02
	sqme_ref* => 2.82009E-02
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.5000000E+02; 9.6085328E+01,-1.2367700E+02,-8.5712364E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.5000000E+02;-9.6085328E+01, 1.2367700E+02, 8.5712364E+01\| 3.0625000E+04\| 4)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.76793E-02
	Squared matrix el. (prc) = 2.76793E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 1.688666E+02 3.093682E+01 -4.901007E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -1.688666E+02 -3.093682E+01 4.901007E+01
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 8
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 250.000 168.867 30.937 -49.010 30625.000
	4 [o] tbar 0 1 1-2 [none] 250.000 -168.867 -30.937 49.010 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.76793E-02
	sqme_ref* => 2.76793E-02
	event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.5000000E+02; 1.6886659E+02, 3.0936816E+01,-4.9010068E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.5000000E+02;-1.6886659E+02,-3.0936816E+01, 4.9010068E+01\| 3.0625000E+04\| 4)
	========================================================================
	Contents of powheg_1_p2.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.41607E-05
	- Squared matrix el. (prc) = 1.41607E-05
	+ Squared matrix el. (ref) = 3.51646E-02
	+ Squared matrix el. (prc) = 3.51646E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	- Selected MCI group = 2
	- Selected term = 6
	+ Selected MCI group = 1
	+ Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	- seed = 196611
	+ seed = 196610
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	- Children: 3 4 5
	+ Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	- Children: 3 4 5
	+ Children: 3 4
	Particle 3 [o] f(6)c(1 )
	- E = 2.219832E+02
	- P = -7.125693E+01 -1.137429E+02 -2.522963E+01
	+ E = 2.500000E+02
	+ P = 1.143154E+02 2.823158E+00 -1.371095E+02
	T = 3.062500000E+04
	Parents: 1 2
	- Particle 4 [o] f(-6)c(-2 )
	- E = 2.128305E+02
	- P = 1.983915E+01 1.013308E+02 6.332695E+01
	+ Particle 4 [o] f(-6)c(-1 )
	+ E = 2.500000E+02
	+ P = -1.143154E+02 -2.823158E+00 1.371095E+02
	T = 3.062500000E+04
	Parents: 1 2
	- Particle 5 [o] f(21)c(2 -1)
	- E = 6.518630E+01
	- P = 5.141778E+01 1.241207E+01 -3.809732E+01
	- T = 0.000000000E+00
	- Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	- seed = 196612
	+ seed = 196611
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	- 1 [i] e+ 0 0 [none] 3-5 250.000 0.000 0.000 250.000 0.000
	- 2 [i] e- 0 0 [none] 3-5 250.000 0.000 0.000 -250.000 0.000
	- 3 [o] t 1 0 1-2 [none] 221.983 -71.257 -113.743 -25.230 30625.000
	- 4 [o] tbar 0 2 1-2 [none] 212.831 19.839 101.331 63.327 30625.000
	- 5 [o] gl 2 1 1-2 [none] 65.186 51.418 12.412 -38.097 0.000
	+ 1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	+ 2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	+ 3 [o] t 1 0 1-2 [none] 250.000 114.315 2.823 -137.110 30625.000
	+ 4 [o] tbar 0 1 1-2 [none] 250.000 -114.315 -2.823 137.110 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	-n_out* => 3
	-n_tot* => 5
	+n_out* => 2
	+n_tot* => 4
	$process_id* => "powheg_1_p2"
	process_num_id* => [unknown integer]
	-sqme* => 1.41607E-05
	-sqme_ref* => 1.41607E-05
	+sqme* => 3.51646E-02
	+sqme_ref* => 3.51646E-02
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	- 3 prt(o:6\| 2.2198318E+02;-7.1256929E+01,-1.1374290E+02,-2.5229632E+01\| 3.0625000E+04\| 3)
	- 4 prt(o:-6\| 2.1283052E+02; 1.9839145E+01, 1.0133083E+02, 6.3326954E+01\| 3.0625000E+04\| 4)
	- 5 prt(o:21\| 6.5186300E+01; 5.1417783E+01, 1.2412066E+01,-3.8097321E+01\| 0.0000000E+00\| 5)
	+ 3 prt(o:6\| 2.5000000E+02; 1.1431539E+02, 2.8231580E+00,-1.3710953E+02\| 3.0625000E+04\| 3)
	+ 4 prt(o:-6\| 2.5000000E+02;-1.1431539E+02,-2.8231580E+00, 1.3710953E+02\| 3.0625000E+04\| 4)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 3.51646E-02
	- Squared matrix el. (prc) = 3.51646E-02
	- Event weight (ref) = 1.00000E+00
	- Event weight (prc) = 1.00000E+00
	+ Squared matrix el. (ref) = -1.50114E-02
	+ Squared matrix el. (prc) = -1.50114E-02
	+ Event weight (ref) = -1.00000E+00
	+ Event weight (prc) = -1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	- seed = 196611
	+ seed = 196610
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	- P = 1.143154E+02 2.823158E+00 -1.371095E+02
	+ P = 1.134181E+01 5.748522E+01 -1.686470E+02
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	- P = -1.143154E+02 -2.823158E+00 1.371095E+02
	+ P = -1.134181E+01 -5.748522E+01 1.686470E+02
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	- seed = 196612
	+ seed = 196611
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	- 3 [o] t 1 0 1-2 [none] 250.000 114.315 2.823 -137.110 30625.000
	- 4 [o] tbar 0 1 1-2 [none] 250.000 -114.315 -2.823 137.110 30625.000
	+ 3 [o] t 1 0 1-2 [none] 250.000 11.342 57.485 -168.647 30625.000
	+ 4 [o] tbar 0 1 1-2 [none] 250.000 -11.342 -57.485 168.647 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p2"
	process_num_id* => [unknown integer]
	-sqme* => 3.51646E-02
	-sqme_ref* => 3.51646E-02
	+sqme* => -1.50114E-02
	+sqme_ref* => -1.50114E-02
	event_index* => 2
	-event_weight* => 1.00000E+00
	-event_weight_ref* => 1.00000E+00
	+event_weight* => -1.00000E+00
	+event_weight_ref* => -1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	- 3 prt(o:6\| 2.5000000E+02; 1.1431539E+02, 2.8231580E+00,-1.3710953E+02\| 3.0625000E+04\| 3)
	- 4 prt(o:-6\| 2.5000000E+02;-1.1431539E+02,-2.8231580E+00, 1.3710953E+02\| 3.0625000E+04\| 4)
	+ 3 prt(o:6\| 2.5000000E+02; 1.1341807E+01, 5.7485218E+01,-1.6864701E+02\| 3.0625000E+04\| 3)
	+ 4 prt(o:-6\| 2.5000000E+02;-1.1341807E+01,-5.7485218E+01, 1.6864701E+02\| 3.0625000E+04\| 4)
	========================================================================
	Contents of powheg_1_p1.pg:
	3
	5 5 2
	5.790270664E-03 4.340796144E-03 3.956052276E-03 3.268282917E-03 2.051663009E-03 5.483522583E-03 4.862867872E-03 3.083117535E-03 1.719170940E-03 1.731060881E-03 4.642896596E-03 4.089381442E-03 3.278082860E-03 2.072774721E-03 0.000000000E+00 4.285081626E-03 2.703041104E-03 1.939545191E-03 1.808207863E-03 4.832500063E-04 1.725229895E-03 1.848230090E-03 1.666841566E-03 8.779276888E-04 5.973720333E-04 5.658021588E-03 4.797607918E-03 3.691638808E-03 2.563335143E-03 1.517565363E-03 5.487405765E-03 4.496579172E-03 3.894360742E-03 2.025323977E-03 2.321871929E-03 4.723771507E-03 3.748862492E-03 2.983344600E-03 2.071276052E-03 0.000000000E+00 4.306592486E-03 2.873724641E-03 2.416448613E-03 1.437407351E-03 9.061702788E-04 1.847228600E-03 1.615352727E-03 1.894685168E-03 7.407161765E-04 4.468087711E-04
	Contents of powheg_1_p2.pg:
	3
	5 5 2
	6.095586897E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 3.638456151E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 2.295080904E-03 7.908640171E-04 3.287241452E-04 0.000000000E+00 4.113171729E-05 6.099168392E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 3.638549328E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 2.236533403E-03 8.480152142E-04 3.249849498E-04 0.000000000E+00 4.348341527E-05
	Index: trunk/share/tests/functional_tests/ref-output-ext/powheg_2.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-ext/powheg_2.ref (revision 8835)
	+++ trunk/share/tests/functional_tests/ref-output-ext/powheg_2.ref (revision 8836)
	@@ -1,1578 +1,1671 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	openmp_num_threads = 1
	?pacify = true
	?write_raw = false
	SM.mZ => 9.11880E+01
	SM.mW => 8.04190E+01
	SM.mH => 1.25000E+02
	SM.GF => 1.16639E-05
	SM.me => 0.00000E+00
	SM.mmu => 0.00000E+00
	SM.mtau => 1.77700E+00
	+SM.ms => 0.00000E+00
	+SM.mc => 0.00000E+00
	+SM.mb => 0.00000E+00
	?alphas_is_fixed = false
	?alphas_from_mz = true
	?alphas_from_lambda_qcd = false
	?alphas_from_lhapdf = false
	alphas_nf = 5
	alphas_order = 1
	-$exclude_gauge_splittings = "u:s:b:t"
	+[user variable] pr = PDG(1, -1, 2, -2, 3, -3, 4, -4, 5, -5)
	+$exclude_gauge_splittings = "t"
	$method = "dummy"
	$pdf_builtin_set = "mstw2008nlo"
	sqrts = 1.40000E+04
	?combined_nlo_integration = true
	\| Process library 'powheg_2_lib': recorded process 'powheg_2_p1'
	-seed = 130
	+\| Process library 'powheg_2_lib': recorded process 'powheg_2_p2'
	+seed = 487
	?fixed_order_nlo_events = false
	?unweighted = true
	?powheg_matching = true
	powheg_grid_size_xi = 10
	powheg_grid_size_y = 10
	powheg_pt_min = 1.00000E+00
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_2_lib': compiling ...
	\| Process library 'powheg_2_lib': writing makefile
	\| Process library 'powheg_2_lib': removing old files
	\| Process library 'powheg_2_lib': writing driver
	\| Process library 'powheg_2_lib': creating source code
	\| Process library 'powheg_2_lib': compiling sources
	\| Process library 'powheg_2_lib': linking
	\| Process library 'powheg_2_lib': loading
	\| Process library 'powheg_2_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	-\| RNG: Setting seed for random-number generator to 130
	+\| RNG: Setting seed for random-number generator to 487
	\| Initializing integration for process powheg_2_p1:
	\| Beam structure: p, p => pdf_builtin
	\| Beam data (collision):
	\| p (mass = 0.0000000E+00 GeV)
	\| p (mass = 0.0000000E+00 GeV)
	\| sqrts = 1.400000000000E+04 GeV
	\| Initialized builtin PDF MSTW2008NLO
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_2_p1.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_2_p1.i3.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_2_p1'
	\| Library name = 'powheg_2_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'powheg_2_p1_i1': d, dbar => e-, e+ [dummy]
	\| 2: 'powheg_2_p1_i2': d:gl, dbar:gl => e-, e+, gl:d:dbar [dummy], [real]
	\| 3: 'powheg_2_p1_i3': d, dbar => e-, e+ [dummy], [virtual]
	\| 4: 'powheg_2_p1_i4': d, dbar => e-, e+ [inactive], [subtraction]
	\| 5: 'powheg_2_p1_i5': d, dbar => e-, e+ [dummy], [dglap]
	\| ------------------------------------------------------------------------
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Beam structure: pdf_builtin, none => none, pdf_builtin
	\| Beam structure: 2 channels, 2 dimensions
	\| Applying user-defined cuts.
	\| Using user-defined general scale.
	\| Starting integration for process 'powheg_2_p1'
	\| Integration hook: add POWHEG hook
	\| Shower: interfacing PDF builtin set #8
	\| Integrate: iterations = 1:1000:"gw"
	\| Integrator: 2 chains, 2 channels, 7 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 1000 1.073E+10 4.88E+09 45.52 14.39 0.4
	+ 1 1000 2.223E+09 5.00E+08 22.48 7.11 0.8
	\|-----------------------------------------------------------------------------\|
	- 1 1000 1.073E+10 4.88E+09 45.52 14.39 0.4
	+ 1 1000 2.223E+09 5.00E+08 22.48 7.11 0.8
	\|=============================================================================\|
	-n_events = 10
	+n_events = 5
	?negative_weights = true
	?keep_failed_events = true
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	\| Starting simulation for process 'powheg_2_p1'
	\| Simulate: using integration grids from file 'powheg_2_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: interfacing PDF builtin set #8
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	-\| RNG: Setting seed for random-number generator to 131
	-\| Simulation: requested number of events = 10
	-\| corr. to luminosity [fb-1] = 9.3197E-10
	+\| RNG: Setting seed for random-number generator to 488
	+\| Simulation: requested number of events = 5
	+\| corr. to luminosity [fb-1] = 2.2496E-09
	\| Events: writing to ASCII file 'powheg_2_p1.debug'
	-\| Events: generating 10 unweighted, unpolarized events ...
	+\| Events: generating 5 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_2_p1.pg'
	-\| Grid: Mean value of the grid: 7.15782E+03
	-\| Grid: Max value of the grid: 1.18402E+05
	-\| Grid: Mean/Max value of the grid: 6.04533E-02
	+\| Grid: Mean value of the grid: 9.69764E+03
	+\| Grid: Max value of the grid: 4.48803E+05
	+\| Grid: Mean/Max value of the grid: 2.16078E-02
	\| ... event sample complete.
	-\| Events: actual unweighting efficiency = 0.34 %
	-Warning: Encountered events with excess weight: 4 events ( 40.000 %)
	-\| Maximum excess weight = 1.722E+01
	-\| Average excess weight = 1.950E+00
	+\| Events: actual unweighting efficiency = 1.46 %
	+Warning: Encountered events with excess weight: 2 events ( 40.000 %)
	+\| Maximum excess weight = 2.106E+01
	+\| Average excess weight = 5.062E+00
	\| Events: closing ASCII file 'powheg_2_p1.debug'
	-\| There were no errors and 1 warning(s).
	+\| QCD alpha: using a running strong coupling
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 489
	+\| Initializing integration for process powheg_2_p2:
	+\| Beam structure: p, p => pdf_builtin
	+\| Beam data (collision):
	+\| p (mass = 0.0000000E+00 GeV)
	+\| p (mass = 0.0000000E+00 GeV)
	+\| sqrts = 1.400000000000E+04 GeV
	+\| Phase space: generating configuration ...
	+\| Phase space: ... success.
	+\| Phase space: writing configuration file 'powheg_2_p2.i1.phs'
	+\| Phase space: generating configuration ...
	+\| Phase space: ... success.
	+\| Phase space: writing configuration file 'powheg_2_p2.i3.phs'
	+\| ------------------------------------------------------------------------
	+\| Process [scattering]: 'powheg_2_p2'
	+\| Library name = 'powheg_2_lib'
	+\| Process index = 2
	+\| Process components:
	+\| 1: 'powheg_2_p2_i1': d:dbar:u:ubar:s:sbar:c:cbar:b:bbar, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar => e-, e+ [dummy]
	+\| 2: 'powheg_2_p2_i2': gl:dbar:d:ubar:u:sbar:s:cbar:c:bbar:b:dbar:d:ubar:u:sbar:s:cbar:c:bbar:b, dbar:d:ubar:u:sbar:s:cbar:c:bbar:b:gl:dbar:d:ubar:u:sbar:s:cbar:c:bbar:b => e-, e+, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar:d:dbar:u:ubar:s:sbar:c:cbar:b:bbar:gl [dummy], [real]
	+\| 3: 'powheg_2_p2_i3': d:dbar:u:ubar:s:sbar:c:cbar:b:bbar, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar => e-, e+ [dummy], [virtual]
	+\| 4: 'powheg_2_p2_i4': d:dbar:u:ubar:s:sbar:c:cbar:b:bbar, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar => e-, e+ [inactive], [subtraction]
	+\| 5: 'powheg_2_p2_i5': d:dbar:u:ubar:s:sbar:c:cbar:b:bbar, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar => e-, e+ [dummy], [dglap]
	+\| ------------------------------------------------------------------------
	+\| Phase space: 2 channels, 5 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Phase space: 2 channels, 5 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Phase space: 2 channels, 5 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Phase space: 2 channels, 5 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Beam structure: pdf_builtin, none => none, pdf_builtin
	+\| Beam structure: 2 channels, 2 dimensions
	+\| Applying user-defined cuts.
	+\| Using user-defined general scale.
	+\| Starting integration for process 'powheg_2_p2'
	+\| Integration hook: add POWHEG hook
	+\| Shower: interfacing PDF builtin set #8
	+\| Integrate: iterations = 1:1000:"gw"
	+\| Integrator: 2 chains, 2 channels, 7 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 1000 5.130E+10 2.21E+10 43.06 13.62 0.4
	+\|-----------------------------------------------------------------------------\|
	+ 1 1000 5.130E+10 2.21E+10 43.06 13.62 0.4
	+\|=============================================================================\|
	+\| Starting simulation for process 'powheg_2_p2'
	+\| Simulate: using integration grids from file 'powheg_2_p2.m1.vg'
	+\| Simulate: activating parton shower
	+\| Shower: interfacing PDF builtin set #8
	+\| Shower: Using WHIZARD internal shower
	+\| Simulate: applying POWHEG matching
	+\| QCD alpha: using a running strong coupling
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 490
	+\| Simulation: requested number of events = 5
	+\| corr. to luminosity [fb-1] = 9.7474E-11
	+\| Events: writing to ASCII file 'powheg_2_p2.debug'
	+\| Events: generating 5 unweighted, unpolarized events ...
	+\| Events: event normalization mode '1'
	+\| POWHEG: using grids from file 'powheg_2_p2.pg'
	+\| Grid: Mean value of the grid: 4.13447E+04
	+\| Grid: Max value of the grid: 5.16344E+06
	+\| Grid: Mean/Max value of the grid: 8.00719E-03
	+\| ... event sample complete.
	+\| Events: actual unweighting efficiency = 0.45 %
	+Warning: Encountered events with excess weight: 1 events ( 20.000 %)
	+\| Maximum excess weight = 2.022E+00
	+\| Average excess weight = 4.045E-01
	+\| Events: closing ASCII file 'powheg_2_p2.debug'
	+\| There were no errors and 2 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Contents of powheg_2_p1.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.73082E+07
	- Squared matrix el. (prc) = 1.73082E+07
	- Event weight (ref) = 1.00000E+00
	- Event weight (prc) = 1.00000E+00
	+ Squared matrix el. (ref) = -1.02633E+06
	+ Squared matrix el. (prc) = -1.02633E+06
	+ Event weight (ref) = -1.00000E+00
	+ Event weight (prc) = -1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 6.899492E+02
	- P = 0.000000E+00 0.000000E+00 6.899492E+02
	+ E = 4.144810E+00
	+ P = 0.000000E+00 0.000000E+00 4.144810E+00
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 4.215047E-01
	- P = 0.000000E+00 0.000000E+00 -4.215047E-01
	+ E = 1.701568E+01
	+ P = 0.000000E+00 0.000000E+00 -1.701568E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.310051E+03
	- P = 0.000000E+00 0.000000E+00 6.310051E+03
	+ E = 6.995855E+03
	+ P = 0.000000E+00 0.000000E+00 6.995855E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.999578E+03
	- P = 0.000000E+00 0.000000E+00 -6.999578E+03
	+ E = 6.982984E+03
	+ P = 0.000000E+00 0.000000E+00 -6.982984E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 6.087387E+02
	- P = -9.888752E+00 -4.804441E+00 6.086394E+02
	+ E = 6.597124E+00
	+ P = -5.692672E+00 -3.332077E+00 1.130586E-01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 8.163209E+01
	- P = 9.888752E+00 4.804441E+00 8.088837E+01
	+ E = 1.456337E+01
	+ P = 5.692672E+00 3.332077E+00 -1.298393E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 689.949 0.000 0.000 689.949 0.000
	- 4 [i] dbar 0 0 2 7-8 0.422 0.000 0.000 -0.422 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6310.051 0.000 0.000 6310.051 0.000
	- 6 [x] hr3 0 0 2 [none] 6999.578 0.000 0.000 -6999.578 0.000
	- 7 [o] e- 0 0 3-4 [none] 608.739 -9.889 -4.804 608.639 0.000
	- 8 [o] e+ 0 0 3-4 [none] 81.632 9.889 4.804 80.888 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 690.371 0.000 0.000 689.528
	-Sum of beam remnant momenta: p(0:3) = 13309.629 0.000 0.000 -689.528
	-Sum of outgoing momenta: p(0:3) = 690.371 0.000 0.000 689.528
	+ 3 [i] d 0 0 1 7-8 4.145 0.000 0.000 4.145 0.000
	+ 4 [i] dbar 0 0 2 7-8 17.016 0.000 0.000 -17.016 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6995.855 0.000 0.000 6995.855 0.000
	+ 6 [x] hr3 0 0 2 [none] 6982.984 0.000 0.000 -6982.984 0.000
	+ 7 [o] e- 0 0 3-4 [none] 6.597 -5.693 -3.332 0.113 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 14.563 5.693 3.332 -12.984 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 21.160 0.000 0.000 -12.871
	+Sum of beam remnant momenta: p(0:3) = 13978.840 0.000 0.000 12.871
	+Sum of outgoing momenta: p(0:3) = 21.160 0.000 0.000 -12.871
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 3.41067E+01
	+sqrts_hat* => 1.67960E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 1.73082E+07
	-sqme_ref* => 1.73082E+07
	+sqme* => -1.02633E+06
	+sqme_ref* => -1.02633E+06
	event_index* => 1
	-event_weight* => 1.00000E+00
	-event_weight_ref* => 1.00000E+00
	-event_excess* => 2.70702E-01
	+event_weight* => -1.00000E+00
	+event_weight_ref* => -1.00000E+00
	+event_excess* => 4.24812E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-6.8994924E+02; 0.0000000E+00, 0.0000000E+00,-6.8994924E+02\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-4.2150470E-01; 0.0000000E+00, 0.0000000E+00, 4.2150470E-01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.3100508E+03; 0.0000000E+00, 0.0000000E+00, 6.3100508E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9995785E+03; 0.0000000E+00, 0.0000000E+00,-6.9995785E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.0873866E+02;-9.8887519E+00,-4.8044408E+00, 6.0863937E+02\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 8.1632087E+01; 9.8887519E+00, 4.8044408E+00, 8.0888365E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-4.1448102E+00; 0.0000000E+00, 0.0000000E+00,-4.1448102E+00\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-1.7015683E+01; 0.0000000E+00, 0.0000000E+00, 1.7015683E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9958552E+03; 0.0000000E+00, 0.0000000E+00, 6.9958552E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9829843E+03; 0.0000000E+00, 0.0000000E+00,-6.9829843E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 6.5971236E+00;-5.6926722E+00,-3.3320775E+00, 1.1305860E-01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 1.4563369E+01; 5.6926722E+00, 3.3320775E+00,-1.2983931E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 2.00716E+06
	- Squared matrix el. (prc) = 2.00716E+06
	+ Squared matrix el. (ref) = 1.56786E+07
	+ Squared matrix el. (prc) = 1.56786E+07
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 1.446225E+03
	- P = 0.000000E+00 0.000000E+00 1.446225E+03
	+ E = 4.777759E-01
	+ P = 0.000000E+00 0.000000E+00 4.777759E-01
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 1.042581E+01
	- P = 0.000000E+00 0.000000E+00 -1.042581E+01
	+ E = 4.041187E+02
	+ P = 0.000000E+00 0.000000E+00 -4.041187E+02
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 5.553775E+03
	- P = 0.000000E+00 0.000000E+00 5.553775E+03
	+ E = 6.999522E+03
	+ P = 0.000000E+00 0.000000E+00 6.999522E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.989574E+03
	- P = 0.000000E+00 0.000000E+00 -6.989574E+03
	+ E = 6.595881E+03
	+ P = 0.000000E+00 0.000000E+00 -6.595881E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 5.692890E+02
	- P = -1.196264E+02 5.256740E+00 5.565536E+02
	+ E = 3.631332E+02
	+ P = -8.208406E+00 -1.754884E+00 -3.630361E+02
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 8.873620E+02
	- P = 1.196264E+02 -5.256740E+00 8.792458E+02
	+ E = 4.146331E+01
	+ P = 8.208406E+00 1.754884E+00 -4.060478E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 1446.225 0.000 0.000 1446.225 0.000
	- 4 [i] dbar 0 0 2 7-8 10.426 0.000 0.000 -10.426 0.000
	- 5 [x] hr3bar 0 0 1 [none] 5553.775 0.000 0.000 5553.775 0.000
	- 6 [x] hr3 0 0 2 [none] 6989.574 0.000 0.000 -6989.574 0.000
	- 7 [o] e- 0 0 3-4 [none] 569.289 -119.626 5.257 556.554 0.000
	- 8 [o] e+ 0 0 3-4 [none] 887.362 119.626 -5.257 879.246 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 1456.651 0.000 0.000 1435.799
	-Sum of beam remnant momenta: p(0:3) = 12543.349 0.000 0.000 -1435.799
	-Sum of outgoing momenta: p(0:3) = 1456.651 0.000 0.000 1435.799
	+ 3 [i] d 0 0 1 7-8 0.478 0.000 0.000 0.478 0.000
	+ 4 [i] dbar 0 0 2 7-8 404.119 0.000 0.000 -404.119 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6999.522 0.000 0.000 6999.522 0.000
	+ 6 [x] hr3 0 0 2 [none] 6595.881 0.000 0.000 -6595.881 0.000
	+ 7 [o] e- 0 0 3-4 [none] 363.133 -8.208 -1.755 -363.036 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 41.463 8.208 1.755 -40.605 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 404.596 0.000 0.000 -403.641
	+Sum of beam remnant momenta: p(0:3) = 13595.404 0.000 0.000 403.641
	+Sum of outgoing momenta: p(0:3) = 404.596 0.000 0.000 -403.641
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 2.45586E+02
	+sqrts_hat* => 2.77905E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 2.00716E+06
	-sqme_ref* => 2.00716E+06
	+sqme* => 1.56786E+07
	+sqme_ref* => 1.56786E+07
	event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	-event_excess* => 0.00000E+00
	+event_excess* => 2.10630E+01
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.4462252E+03; 0.0000000E+00, 0.0000000E+00,-1.4462252E+03\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-1.0425811E+01; 0.0000000E+00, 0.0000000E+00, 1.0425811E+01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 5.5537748E+03; 0.0000000E+00, 0.0000000E+00, 5.5537748E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9895742E+03; 0.0000000E+00, 0.0000000E+00,-6.9895742E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 5.6928904E+02;-1.1962638E+02, 5.2567405E+00, 5.5655360E+02\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 8.8736197E+02; 1.1962638E+02,-5.2567405E+00, 8.7924579E+02\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-4.7777590E-01; 0.0000000E+00, 0.0000000E+00,-4.7777590E-01\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-4.0411871E+02; 0.0000000E+00, 0.0000000E+00, 4.0411871E+02\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9995222E+03; 0.0000000E+00, 0.0000000E+00, 6.9995222E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.5958813E+03; 0.0000000E+00, 0.0000000E+00,-6.5958813E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 3.6313317E+02;-8.2084060E+00,-1.7548845E+00,-3.6303615E+02\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 4.1463310E+01; 8.2084060E+00, 1.7548845E+00,-4.0604784E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	Event #3
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 2.38562E+07
	- Squared matrix el. (prc) = 2.38562E+07
	+ Squared matrix el. (ref) = 1.40236E+07
	+ Squared matrix el. (prc) = 1.40236E+07
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 9
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 8.712482E+01
	- P = 0.000000E+00 0.000000E+00 8.712482E+01
	+ E = 2.289819E+02
	+ P = 0.000000E+00 0.000000E+00 2.289819E+02
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 3.936136E+00
	- P = 0.000000E+00 0.000000E+00 -3.936136E+00
	+ E = 7.287631E+00
	+ P = 0.000000E+00 0.000000E+00 -7.287631E+00
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.912875E+03
	- P = 0.000000E+00 0.000000E+00 6.912875E+03
	+ E = 6.771018E+03
	+ P = 0.000000E+00 0.000000E+00 6.771018E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.996064E+03
	- P = 0.000000E+00 0.000000E+00 -6.996064E+03
	+ E = 6.992712E+03
	+ P = 0.000000E+00 0.000000E+00 -6.992712E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 5.371039E+01
	- P = 1.850581E+00 -1.806232E+01 5.054833E+01
	+ E = 1.673149E+02
	+ P = -2.049955E+01 -3.033179E+01 1.632606E+02
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 3.735057E+01
	- P = -1.850581E+00 1.806232E+01 3.264036E+01
	+ E = 6.895466E+01
	+ P = 2.049955E+01 3.033179E+01 5.843369E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 3
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 87.125 0.000 0.000 87.125 0.000
	- 4 [i] dbar 0 0 2 7-8 3.936 0.000 0.000 -3.936 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6912.875 0.000 0.000 6912.875 0.000
	- 6 [x] hr3 0 0 2 [none] 6996.064 0.000 0.000 -6996.064 0.000
	- 7 [o] e- 0 0 3-4 [none] 53.710 1.851 -18.062 50.548 0.000
	- 8 [o] e+ 0 0 3-4 [none] 37.351 -1.851 18.062 32.640 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 91.061 0.000 0.000 83.189
	-Sum of beam remnant momenta: p(0:3) = 13908.939 0.000 0.000 -83.189
	-Sum of outgoing momenta: p(0:3) = 91.061 0.000 0.000 83.189
	+ 3 [i] d 0 0 1 7-8 228.982 0.000 0.000 228.982 0.000
	+ 4 [i] dbar 0 0 2 7-8 7.288 0.000 0.000 -7.288 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6771.018 0.000 0.000 6771.018 0.000
	+ 6 [x] hr3 0 0 2 [none] 6992.712 0.000 0.000 -6992.712 0.000
	+ 7 [o] e- 0 0 3-4 [none] 167.315 -20.500 -30.332 163.261 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 68.955 20.500 30.332 58.434 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 236.270 0.000 0.000 221.694
	+Sum of beam remnant momenta: p(0:3) = 13763.730 0.000 0.000 -221.694
	+Sum of outgoing momenta: p(0:3) = 236.270 0.000 0.000 221.694
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 3.70370E+01
	+sqrts_hat* => 8.17003E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 2.38562E+07
	-sqme_ref* => 2.38562E+07
	+sqme* => 1.40236E+07
	+sqme_ref* => 1.40236E+07
	event_index* => 3
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	-event_excess* => 4.63589E-01
	+event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-8.7124821E+01; 0.0000000E+00, 0.0000000E+00,-8.7124821E+01\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-3.9361364E+00; 0.0000000E+00, 0.0000000E+00, 3.9361364E+00\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9128752E+03; 0.0000000E+00, 0.0000000E+00, 6.9128752E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9960639E+03; 0.0000000E+00, 0.0000000E+00,-6.9960639E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 5.3710386E+01; 1.8505811E+00,-1.8062325E+01, 5.0548327E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 3.7350571E+01;-1.8505811E+00, 1.8062325E+01, 3.2640357E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-2.2898188E+02; 0.0000000E+00, 0.0000000E+00,-2.2898188E+02\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-7.2876314E+00; 0.0000000E+00, 0.0000000E+00, 7.2876314E+00\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.7710181E+03; 0.0000000E+00, 0.0000000E+00, 6.7710181E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9927124E+03; 0.0000000E+00, 0.0000000E+00,-6.9927124E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 1.6731485E+02;-2.0499548E+01,-3.0331794E+01, 1.6326056E+02\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 6.8954662E+01; 2.0499548E+01, 3.0331794E+01, 5.8433691E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	Event #4
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.48421E+07
	- Squared matrix el. (prc) = 1.48421E+07
	+ Squared matrix el. (ref) = 5.08214E+06
	+ Squared matrix el. (prc) = 5.08214E+06
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 12
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 1.939732E+02
	- P = 0.000000E+00 0.000000E+00 1.939732E+02
	+ E = 5.930977E+01
	+ P = 0.000000E+00 0.000000E+00 5.930977E+01
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 4.051484E+00
	- P = 0.000000E+00 0.000000E+00 -4.051484E+00
	+ E = 3.380226E+01
	+ P = 0.000000E+00 0.000000E+00 -3.380226E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.806027E+03
	- P = 0.000000E+00 0.000000E+00 6.806027E+03
	+ E = 6.940690E+03
	+ P = 0.000000E+00 0.000000E+00 6.940690E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.995949E+03
	- P = 0.000000E+00 0.000000E+00 -6.995949E+03
	+ E = 6.966198E+03
	+ P = 0.000000E+00 0.000000E+00 -6.966198E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 1.889687E+02
	- P = -8.729125E+00 -2.109992E+00 1.887552E+02
	+ E = 4.975970E+01
	+ P = -3.488349E+01 -2.571858E+01 2.444840E+01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 9.055960E+00
	- P = 8.729125E+00 2.109992E+00 1.166507E+00
	+ E = 4.335233E+01
	+ P = 3.488349E+01 2.571858E+01 1.059111E+00
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 4
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 193.973 0.000 0.000 193.973 0.000
	- 4 [i] dbar 0 0 2 7-8 4.051 0.000 0.000 -4.051 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6806.027 0.000 0.000 6806.027 0.000
	- 6 [x] hr3 0 0 2 [none] 6995.949 0.000 0.000 -6995.949 0.000
	- 7 [o] e- 0 0 3-4 [none] 188.969 -8.729 -2.110 188.755 0.000
	- 8 [o] e+ 0 0 3-4 [none] 9.056 8.729 2.110 1.167 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 198.025 0.000 0.000 189.922
	-Sum of beam remnant momenta: p(0:3) = 13801.975 0.000 0.000 -189.922
	-Sum of outgoing momenta: p(0:3) = 198.025 0.000 0.000 189.922
	+ 3 [i] d 0 0 1 7-8 59.310 0.000 0.000 59.310 0.000
	+ 4 [i] dbar 0 0 2 7-8 33.802 0.000 0.000 -33.802 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6940.690 0.000 0.000 6940.690 0.000
	+ 6 [x] hr3 0 0 2 [none] 6966.198 0.000 0.000 -6966.198 0.000
	+ 7 [o] e- 0 0 3-4 [none] 49.760 -34.883 -25.719 24.448 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 43.352 34.883 25.719 1.059 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 93.112 0.000 0.000 25.508
	+Sum of beam remnant momenta: p(0:3) = 13906.888 0.000 0.000 -25.508
	+Sum of outgoing momenta: p(0:3) = 93.112 0.000 0.000 25.508
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 5.60671E+01
	+sqrts_hat* => 8.95501E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 1.48421E+07
	-sqme_ref* => 1.48421E+07
	+sqme* => 5.08214E+06
	+sqme_ref* => 5.08214E+06
	event_index* => 4
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.9397318E+02; 0.0000000E+00, 0.0000000E+00,-1.9397318E+02\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-4.0514843E+00; 0.0000000E+00, 0.0000000E+00, 4.0514843E+00\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.8060268E+03; 0.0000000E+00, 0.0000000E+00, 6.8060268E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9959485E+03; 0.0000000E+00, 0.0000000E+00,-6.9959485E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 1.8896870E+02;-8.7291246E+00,-2.1099918E+00, 1.8875519E+02\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 9.0559605E+00; 8.7291246E+00, 2.1099918E+00, 1.1665068E+00\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-5.9309772E+01; 0.0000000E+00, 0.0000000E+00,-5.9309772E+01\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-3.3802260E+01; 0.0000000E+00, 0.0000000E+00, 3.3802260E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9406902E+03; 0.0000000E+00, 0.0000000E+00, 6.9406902E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9661977E+03; 0.0000000E+00, 0.0000000E+00,-6.9661977E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 4.9759698E+01;-3.4883490E+01,-2.5718579E+01, 2.4448401E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 4.3352335E+01; 3.4883490E+01, 2.5718579E+01, 1.0591113E+00\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	Event #5
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.12189E+07
	- Squared matrix el. (prc) = 1.12189E+07
	+ Squared matrix el. (ref) = 3.14741E+06
	+ Squared matrix el. (prc) = 3.14741E+06
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 15
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 2.299967E+00
	- P = 0.000000E+00 0.000000E+00 2.299967E+00
	+ E = 1.411403E+03
	+ P = 0.000000E+00 0.000000E+00 1.411403E+03
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 1.055385E+02
	- P = 0.000000E+00 0.000000E+00 -1.055385E+02
	+ E = 6.193471E+00
	+ P = 0.000000E+00 0.000000E+00 -6.193471E+00
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.997700E+03
	- P = 0.000000E+00 0.000000E+00 6.997700E+03
	+ E = 5.588597E+03
	+ P = 0.000000E+00 0.000000E+00 5.588597E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.894461E+03
	- P = 0.000000E+00 0.000000E+00 -6.894461E+03
	+ E = 6.993807E+03
	+ P = 0.000000E+00 0.000000E+00 -6.993807E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 6.359252E+01
	- P = -1.344828E+00 -1.524474E+01 -6.172356E+01
	+ E = 2.523280E+02
	+ P = -4.531771E+01 5.475505E+01 2.421107E+02
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 4.424595E+01
	- P = 1.344828E+00 1.524474E+01 -4.151498E+01
	+ E = 1.165269E+03
	+ P = 4.531771E+01 -5.475505E+01 1.163099E+03
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 5
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 2.300 0.000 0.000 2.300 0.000
	- 4 [i] dbar 0 0 2 7-8 105.539 0.000 0.000 -105.539 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6997.700 0.000 0.000 6997.700 0.000
	- 6 [x] hr3 0 0 2 [none] 6894.461 0.000 0.000 -6894.461 0.000
	- 7 [o] e- 0 0 3-4 [none] 63.593 -1.345 -15.245 -61.724 0.000
	- 8 [o] e+ 0 0 3-4 [none] 44.246 1.345 15.245 -41.515 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 107.838 0.000 0.000 -103.239
	-Sum of beam remnant momenta: p(0:3) = 13892.162 0.000 0.000 103.239
	-Sum of outgoing momenta: p(0:3) = 107.838 0.000 0.000 -103.239
	+ 3 [i] gl 0 1 1 7-8 2194.094 0.000 0.000 2194.094 0.000
	+ 4 [i] dbar 0 0 2 7-8 19.305 0.000 0.000 -19.305 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 5588.597 0.000 0.000 5588.597 0.000
	+ 6 [x] hr3 0 0 2 [none] 6993.807 0.000 0.000 -6993.807 0.000
	+ 7 [o] e- 0 0 3-4 [none] 311.604 -81.086 0.376 300.869 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 1462.247 3.793 -117.886 1457.482 0.000
	+ 9 [o] dbar 0 1 3-4 [none] 439.549 77.293 117.510 416.438 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 2213.400 0.000 0.000 2174.789
	+Sum of beam remnant momenta: p(0:3) = 12582.403 0.000 0.000 -1405.210
	+Sum of outgoing momenta: p(0:3) = 2213.400 0.000 0.000 2174.789
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 3.11599E+01
	+sqrts_hat* => 4.11621E+02
	n_in* => 2
	-n_out* => 4
	-n_tot* => 6
	+n_out* => 5
	+n_tot* => 7
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 1.12189E+07
	-sqme_ref* => 1.12189E+07
	+sqme* => 3.14741E+06
	+sqme_ref* => 3.14741E+06
	event_index* => 5
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-2.2999667E+00; 0.0000000E+00, 0.0000000E+00,-2.2999667E+00\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-1.0553851E+02; 0.0000000E+00, 0.0000000E+00, 1.0553851E+02\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9977000E+03; 0.0000000E+00, 0.0000000E+00, 6.9977000E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.8944615E+03; 0.0000000E+00, 0.0000000E+00,-6.8944615E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.3592525E+01;-1.3448283E+00,-1.5244744E+01,-6.1723565E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 4.4245950E+01; 1.3448283E+00, 1.5244744E+01,-4.1514977E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:21\|-2.1940945E+03; 0.0000000E+00, 0.0000000E+00,-2.1940945E+03\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-1.9305463E+01; 0.0000000E+00, 0.0000000E+00, 1.9305463E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 5.5885968E+03; 0.0000000E+00, 0.0000000E+00, 5.5885968E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9938065E+03; 0.0000000E+00, 0.0000000E+00,-6.9938065E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 3.1160379E+02;-8.1085635E+01, 3.7616812E-01, 3.0086858E+02\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 1.4622468E+03; 3.7929365E+00,-1.1788620E+02, 1.4574821E+03\| 0.0000000E+00\| 8)
	+ 9 prt(o:-1\| 4.3954937E+02; 7.7292699E+01, 1.1751003E+02, 4.1643833E+02\| 0.0000000E+00\| 9)
	========================================================================
	+Contents of powheg_2_p1.pg:
	+ 3
	+ 10 10 3
	+ 9.36377257XE+02 1.27014741XE+03 7.12222177XE+02 5.07011266XE+02 1.58749958XE+02 1.68256557XE+02 2.04915785XE+04 2.28789515XE+01 0.00000000XE+00 3.35535033XE-01 3.74922361XE+02 3.41570023XE+02 3.42219318XE+02 8.83085516XE+02 3.74067159XE+02 0.00000000XE+00 4.33586467XE+01 3.46136758XE+03 1.05220451XE+01 5.10677999XE+02 4.87293088XE+01 1.85394224XE+03 7.66401188XE+02 4.36910286XE+02 7.32149252XE+00 1.65926331XE+01 0.00000000XE+00 5.09150960XE+02 0.00000000XE+00 3.90881039XE-01 3.21479907XE+02 1.22859050XE+03 1.30321734XE+03 9.35995276XE+02 8.78442315XE+01 3.22652660XE+02 3.16403250XE-02 1.61173392XE+01 3.07645474XE-01 2.30893094XE-01 6.70812709XE+02 9.05752792XE+02 8.89378818XE+02 1.60866366XE+02 7.18468198XE+02 0.00000000XE+00 2.68929718XE-02 1.79687358XE+04 1.95251995XE+03 0.00000000XE+00 4.38341252XE+02 3.64932577XE+02 8.51062784XE+02 7.37261343XE+00 8.09800625XE+03 3.56291593XE+00 5.31629269XE+00 1.14766153XE+00 3.06511689XE+01 1.71717974XE+03 1.38910665XE+02 9.10591454XE+02 4.48805134XE+02 4.79915338XE+02 4.61034745XE+02 1.91231663XE+02 3.14357545XE+00 1.11847499XE-01 1.50597886XE+00 2.44719775XE-01 1.18396536XE+02 4.83959669XE+02 6.96477770XE+02 1.08227376XE+04 1.49336914XE+02 1.50931140XE+02 3.67336752XE+02 4.26851425XE+02 1.15543956XE+01 1.65875325XE-04 1.96947342XE+02 9.54018715XE+02 4.80477608XE+02 3.48280682XE+02 3.80277350XE+01 8.23228324XE+01 2.24929849XE+02 1.77461733XE+01 1.87405579XE+01 1.22158024XE+02 4.55641587XE+01 2.53844481XE+02 2.80608916XE+02 1.63073516XE+02 4.61520328XE+00 3.97538267XE+01 3.91394676XE-01 1.12920582XE+02 5.78903320XE-01 2.67928199XE+02 2.59939178XE+04 5.51963277XE+04 5.50676449XE+04 3.30863190XE+03 5.52732276XE+03 1.06809073XE+03 7.46852435XE+04 1.29824158XE+04 0.00000000XE+00 1.02588764XE+01 1.58867468XE+04 3.12931622XE+04 1.56391320XE+04 2.01683087XE+04 9.98403244XE+03 0.00000000XE+00 8.95046873XE+03 2.06560727XE+05 1.08234211XE+02 4.74778517XE+04 8.76973801XE+02 1.46595179XE+05 1.57310302XE+04 2.86003734XE+04 1.47286819XE+02 5.06101869XE+03 0.00000000XE+00 1.68235091XE+04 0.00000000XE+00 2.36848495XE+00 2.95677806XE+04 1.16029950XE+04 9.07304825XE+04 6.91457882XE+04 1.93435468XE+04 2.22261751XE+04 7.39509390XE-01 1.47627990XE+02 1.92706752XE+01 2.17768486XE+00 1.00642504XE+05 3.69719030XE+04 6.34531317XE+04 7.75383943XE+03 4.44561447XE+04 0.00000000XE+00 3.87635317XE+03 5.04119350XE+04 1.29470488XE+04 0.00000000XE+00 4.43619684XE+04 3.43722982XE+04 1.75125514XE+04 2.53147685XE+02 2.16560539XE+05 7.31396905XE+01 2.40454289XE+03 7.91847889XE+00 9.04023324XE+02 5.96366845XE+03 8.99351916XE+03 3.64205275XE+04 1.93248018XE+04 8.17541394XE+03 1.75234411XE+04 1.62807182XE+04 2.22402590XE+01 2.51831370XE+00 1.03842429XE+02 1.12047608XE+02 6.32425280XE+03 2.86584387XE+04 6.48296465XE+04 4.48803109XE+05 1.01682331XE+04 1.06414315XE+04 2.20477767XE+03 1.43412322XE+04 4.59390834XE+02 3.52899962XE-03 2.28558396XE+04 7.49840124XE+04 4.12386847XE+04 7.96273903XE+04 9.97734629XE+03 7.86230446XE+03 3.61980253XE+04 1.04974794XE+03 5.81383233XE+02 2.76254428XE+02 9.93509750XE+02 3.37010266XE+04 1.34246297XE+04 1.20502906XE+04 1.37759140XE+03 1.16831230XE+03 1.90767377XE+01 4.79967608XE+03 3.75005201XE+01 2.09319171XE+03 1.04230151XE+03 7.07802466XE+02 1.19405284XE+03 7.53277771XE+02 1.05969258XE+02 5.76209011XE+01 1.12237063XE+04 9.12227211XE+01 0.00000000XE+00 7.38412148XE-01 5.00502436XE+02 2.45820208XE+02 2.11455406XE+02 3.33390142XE+02 6.97003435XE+03 0.00000000XE+00 1.34340613XE+01 8.79923011XE+03 3.50906078XE+01 1.08950411XE+03 7.14175226XE+01 9.19865098XE+02 6.75782827XE+02 1.40738867XE+02 5.40666455XE+01 6.94314634XE+00 0.00000000XE+00 1.53917825XE+02 0.00000000XE+00 2.13462243XE+00 1.76861768XE+02 1.27182719XE+03 4.37140868XE+02 9.43675595XE+02 3.21933586XE+02 1.69537210XE+03 6.14216695XE-02 1.28819974XE+02 1.92305696XE+00 5.29673279XE-01 8.26189436XE+02 1.58499797XE+03 6.59699829XE+02 2.04384899XE+03 6.68001896XE+03 0.00000000XE+00 5.35014779XE-01 6.58557245XE+03 6.09543469XE+02 0.00000000XE+00 1.06687885XE+03 1.51550231XE+02 6.74906543XE+02 9.18931511XE+01 6.21968392XE+03 2.27383952XE+00 2.23677960XE+00 2.41910174XE+00 8.19895417XE+01 7.16327510XE+02 1.06894928XE+02 4.38286328XE+02 2.63507739XE+02 2.34650745XE+02 2.34215421XE+02 6.15300643XE+01 8.20697421XE+01 6.38001655XE-02 2.00097989XE+01 6.14291672XE-01 2.43086577XE+02 2.54858335XE+02 7.95447781XE+02 3.98389036XE+03 1.27467209XE+02 5.71429927XE+01 2.95906390XE+03 1.71427929XE+03 4.21716095XE+01 5.75844961XE-04 7.20590664XE+02 1.70503083XE+03 1.69564145XE+03 4.76608274XE+02 4.18132003XE+01 1.30822425XE+03 1.30235064XE+03 1.15360014XE+02 1.29196293XE+01 7.71026896XE+01 1.53353062XE+02 2.14527431XE+02 9.07102528XE+02 5.74566236XE+01 1.11835787XE+01 4.70031055XE+01 6.60728706XE-01 8.40923244XE+01 1.34318239XE+00 4.31199246XE+02
	+Contents of powheg_2_p2.debug:
	========================================================================
	- Event #6
	+ Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = -7.01417E+06
	- Squared matrix el. (prc) = -7.01417E+06
	- Event weight (ref) = -1.00000E+00
	- Event weight (prc) = -1.00000E+00
	+ Squared matrix el. (ref) = 1.97921E+08
	+ Squared matrix el. (prc) = 1.97921E+08
	+ Event weight (ref) = 1.00000E+00
	+ Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	- Selected channel = 2
	+ Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 18
	+ seed = 32047106
	+ calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	- Particle 3 [i] f(1)
	- E = 6.920607E+00
	- P = 0.000000E+00 0.000000E+00 6.920607E+00
	+ Particle 3 [i] f(2)
	+ E = 5.136964E+00
	+ P = 0.000000E+00 0.000000E+00 5.136964E+00
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	- Particle 4 [i] f(-1)
	- E = 6.366500E+00
	- P = 0.000000E+00 0.000000E+00 -6.366500E+00
	+ Particle 4 [i] f(-2)
	+ E = 5.762733E+01
	+ P = 0.000000E+00 0.000000E+00 -5.762733E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.993079E+03
	- P = 0.000000E+00 0.000000E+00 6.993079E+03
	+ E = 6.994863E+03
	+ P = 0.000000E+00 0.000000E+00 6.994863E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.993634E+03
	- P = 0.000000E+00 0.000000E+00 -6.993634E+03
	+ E = 6.942373E+03
	+ P = 0.000000E+00 0.000000E+00 -6.942373E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 6.520088E+00
	- P = 2.767436E+00 5.258452E+00 -2.683566E+00
	+ E = 3.629243E+01
	+ P = 4.503508E-01 -1.689570E+01 -3.211656E+01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 6.767019E+00
	- P = -2.767436E+00 -5.258452E+00 3.237673E+00
	+ E = 2.647186E+01
	+ P = -4.503508E-01 1.689570E+01 -2.037381E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 6
	+ seed = 32047107
	+ calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 6.921 0.000 0.000 6.921 0.000
	- 4 [i] dbar 0 0 2 7-8 6.366 0.000 0.000 -6.366 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6993.079 0.000 0.000 6993.079 0.000
	- 6 [x] hr3 0 0 2 [none] 6993.634 0.000 0.000 -6993.634 0.000
	- 7 [o] e- 0 0 3-4 [none] 6.520 2.767 5.258 -2.684 0.000
	- 8 [o] e+ 0 0 3-4 [none] 6.767 -2.767 -5.258 3.238 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 13.287 0.000 0.000 0.554
	-Sum of beam remnant momenta: p(0:3) = 13986.713 0.000 0.000 -0.554
	-Sum of outgoing momenta: p(0:3) = 13.287 0.000 0.000 0.554
	+ 3 [i] u 0 0 1 7-8 5.137 0.000 0.000 5.137 0.000
	+ 4 [i] ubar 0 0 2 7-8 57.627 0.000 0.000 -57.627 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6994.863 0.000 0.000 6994.863 0.000
	+ 6 [x] hr3 0 0 2 [none] 6942.373 0.000 0.000 -6942.373 0.000
	+ 7 [o] e- 0 0 3-4 [none] 36.292 0.450 -16.896 -32.117 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 26.472 -0.450 16.896 -20.374 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 62.764 0.000 0.000 -52.490
	+Sum of beam remnant momenta: p(0:3) = 13937.236 0.000 0.000 52.490
	+Sum of outgoing momenta: p(0:3) = 62.764 0.000 0.000 -52.490
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 1.32755E+01
	+sqrts_hat* => 3.44110E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	-$process_id* => "powheg_2_p1"
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => -7.01417E+06
	-sqme_ref* => -7.01417E+06
	-event_index* => 6
	-event_weight* => -1.00000E+00
	-event_weight_ref* => -1.00000E+00
	-event_excess* => 1.54959E+00
	+sqme* => 1.97921E+08
	+sqme_ref* => 1.97921E+08
	+event_index* => 1
	+event_weight* => 1.00000E+00
	+event_weight_ref* => 1.00000E+00
	+event_excess* => 2.02245E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-6.9206073E+00; 0.0000000E+00, 0.0000000E+00,-6.9206073E+00\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-6.3664998E+00; 0.0000000E+00, 0.0000000E+00, 6.3664998E+00\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9930794E+03; 0.0000000E+00, 0.0000000E+00, 6.9930794E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9936335E+03; 0.0000000E+00, 0.0000000E+00,-6.9936335E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.5200879E+00; 2.7674357E+00, 5.2584523E+00,-2.6835658E+00\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 6.7670193E+00;-2.7674357E+00,-5.2584523E+00, 3.2376733E+00\| 0.0000000E+00\| 8)
	+ 3 prt(i:2\|-5.1369640E+00; 0.0000000E+00, 0.0000000E+00,-5.1369640E+00\| 0.0000000E+00\| 3)
	+ 4 prt(i:-2\|-5.7627330E+01; 0.0000000E+00, 0.0000000E+00, 5.7627330E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9948630E+03; 0.0000000E+00, 0.0000000E+00, 6.9948630E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9423727E+03; 0.0000000E+00, 0.0000000E+00,-6.9423727E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 3.6292433E+01; 4.5035076E-01,-1.6895697E+01,-3.2116558E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 2.6471861E+01;-4.5035076E-01, 1.6895697E+01,-2.0373808E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	- Event #7
	+ Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 4.68463E+07
	- Squared matrix el. (prc) = 4.68463E+07
	+ Squared matrix el. (ref) = 9.22764E+06
	+ Squared matrix el. (prc) = 9.22764E+06
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	- Selected channel = 2
	+ Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 21
	+ seed = 32047106
	+ calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 5.667369E-01
	- P = 0.000000E+00 0.000000E+00 5.667369E-01
	+ E = 1.899744E-01
	+ P = 0.000000E+00 0.000000E+00 1.899744E-01
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 7.081701E+01
	- P = 0.000000E+00 0.000000E+00 -7.081701E+01
	+ E = 1.454586E+03
	+ P = 0.000000E+00 0.000000E+00 -1.454586E+03
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.999433E+03
	- P = 0.000000E+00 0.000000E+00 6.999433E+03
	+ E = 6.999810E+03
	+ P = 0.000000E+00 0.000000E+00 6.999810E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.929183E+03
	- P = 0.000000E+00 0.000000E+00 -6.929183E+03
	+ E = 5.545414E+03
	+ P = 0.000000E+00 0.000000E+00 -5.545414E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 6.467810E+01
	- P = 2.796685E+00 -2.231923E+00 -6.457905E+01
	+ E = 7.434569E+01
	+ P = -4.000748E+00 -6.121976E+00 -7.398512E+01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 6.705646E+00
	- P = -2.796685E+00 2.231923E+00 -5.671222E+00
	+ E = 1.380430E+03
	+ P = 4.000748E+00 6.121976E+00 -1.380411E+03
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 7
	+ seed = 32047107
	+ calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 0.567 0.000 0.000 0.567 0.000
	- 4 [i] dbar 0 0 2 7-8 70.817 0.000 0.000 -70.817 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6999.433 0.000 0.000 6999.433 0.000
	- 6 [x] hr3 0 0 2 [none] 6929.183 0.000 0.000 -6929.183 0.000
	- 7 [o] e- 0 0 3-4 [none] 64.678 2.797 -2.232 -64.579 0.000
	- 8 [o] e+ 0 0 3-4 [none] 6.706 -2.797 2.232 -5.671 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 71.384 0.000 0.000 -70.250
	-Sum of beam remnant momenta: p(0:3) = 13928.616 0.000 0.000 70.250
	-Sum of outgoing momenta: p(0:3) = 71.384 0.000 0.000 -70.250
	+ 3 [i] d 0 0 1 7-8 0.190 0.000 0.000 0.190 0.000
	+ 4 [i] dbar 0 0 2 7-8 1454.586 0.000 0.000 -1454.586 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6999.810 0.000 0.000 6999.810 0.000
	+ 6 [x] hr3 0 0 2 [none] 5545.414 0.000 0.000 -5545.414 0.000
	+ 7 [o] e- 0 0 3-4 [none] 74.346 -4.001 -6.122 -73.985 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 1380.430 4.001 6.122 -1380.411 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1454.776 0.000 0.000 -1454.396
	+Sum of beam remnant momenta: p(0:3) = 12545.224 0.000 0.000 1454.396
	+Sum of outgoing momenta: p(0:3) = 1454.776 0.000 0.000 -1454.396
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 1.26704E+01
	+sqrts_hat* => 3.32466E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	-$process_id* => "powheg_2_p1"
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => 4.68463E+07
	-sqme_ref* => 4.68463E+07
	-event_index* => 7
	+sqme* => 9.22764E+06
	+sqme_ref* => 9.22764E+06
	+event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	-event_excess* => 1.72180E+01
	+event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-5.6673690E-01; 0.0000000E+00, 0.0000000E+00,-5.6673690E-01\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-7.0817012E+01; 0.0000000E+00, 0.0000000E+00, 7.0817012E+01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9994333E+03; 0.0000000E+00, 0.0000000E+00, 6.9994333E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9291830E+03; 0.0000000E+00, 0.0000000E+00,-6.9291830E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.4678103E+01; 2.7966851E+00,-2.2319227E+00,-6.4579053E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 6.7056461E+00;-2.7966851E+00, 2.2319227E+00,-5.6712224E+00\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-1.8997443E-01; 0.0000000E+00, 0.0000000E+00,-1.8997443E-01\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-1.4545857E+03; 0.0000000E+00, 0.0000000E+00, 1.4545857E+03\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9998100E+03; 0.0000000E+00, 0.0000000E+00, 6.9998100E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 5.5454143E+03; 0.0000000E+00, 0.0000000E+00,-5.5454143E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 7.4345695E+01;-4.0007478E+00,-6.1219761E+00,-7.3985118E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 1.3804300E+03; 4.0007478E+00, 6.1219761E+00,-1.3804106E+03\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	- Event #8
	+ Event #3
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.47022E+07
	- Squared matrix el. (prc) = 1.47022E+07
	+ Squared matrix el. (ref) = 3.30803E+07
	+ Squared matrix el. (prc) = 3.30803E+07
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	- Selected channel = 2
	+ Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 24
	+ seed = 32047106
	+ calls = 9
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	- Particle 3 [i] f(1)
	- E = 1.748870E+01
	- P = 0.000000E+00 0.000000E+00 1.748870E+01
	+ Particle 3 [i] f(2)
	+ E = 3.284086E+02
	+ P = 0.000000E+00 0.000000E+00 3.284086E+02
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	- Particle 4 [i] f(-1)
	- E = 6.169637E+01
	- P = 0.000000E+00 0.000000E+00 -6.169637E+01
	+ Particle 4 [i] f(-2)
	+ E = 2.154928E+01
	+ P = 0.000000E+00 0.000000E+00 -2.154928E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.982511E+03
	- P = 0.000000E+00 0.000000E+00 6.982511E+03
	+ E = 6.671591E+03
	+ P = 0.000000E+00 0.000000E+00 6.671591E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.938304E+03
	- P = 0.000000E+00 0.000000E+00 -6.938304E+03
	+ E = 6.978451E+03
	+ P = 0.000000E+00 0.000000E+00 -6.978451E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 2.709141E+01
	- P = 2.658050E+01 -5.228591E+00 2.882695E-01
	+ E = 1.674570E+02
	+ P = 5.460604E+01 -6.386031E+01 1.448513E+02
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 5.209366E+01
	- P = -2.658050E+01 5.228591E+00 -4.449594E+01
	+ E = 1.825009E+02
	+ P = -5.460604E+01 6.386031E+01 1.620080E+02
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 8
	+ seed = 32047107
	+ calls = 3
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 17.489 0.000 0.000 17.489 0.000
	- 4 [i] dbar 0 0 2 7-8 61.696 0.000 0.000 -61.696 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6982.511 0.000 0.000 6982.511 0.000
	- 6 [x] hr3 0 0 2 [none] 6938.304 0.000 0.000 -6938.304 0.000
	- 7 [o] e- 0 0 3-4 [none] 27.091 26.581 -5.229 0.288 0.000
	- 8 [o] e+ 0 0 3-4 [none] 52.094 -26.581 5.229 -44.496 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 79.185 0.000 0.000 -44.208
	-Sum of beam remnant momenta: p(0:3) = 13920.815 0.000 0.000 44.208
	-Sum of outgoing momenta: p(0:3) = 79.185 0.000 0.000 -44.208
	+ 3 [i] u 0 0 1 7-8 328.409 0.000 0.000 328.409 0.000
	+ 4 [i] ubar 0 0 2 7-8 21.549 0.000 0.000 -21.549 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6671.591 0.000 0.000 6671.591 0.000
	+ 6 [x] hr3 0 0 2 [none] 6978.451 0.000 0.000 -6978.451 0.000
	+ 7 [o] e- 0 0 3-4 [none] 167.457 54.606 -63.860 144.851 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 182.501 -54.606 63.860 162.008 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 349.958 0.000 0.000 306.859
	+Sum of beam remnant momenta: p(0:3) = 13650.042 0.000 0.000 -306.859
	+Sum of outgoing momenta: p(0:3) = 349.958 0.000 0.000 306.859
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 6.56959E+01
	+sqrts_hat* => 1.68249E+02
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	-$process_id* => "powheg_2_p1"
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => 1.47022E+07
	-sqme_ref* => 1.47022E+07
	-event_index* => 8
	+sqme* => 3.30803E+07
	+sqme_ref* => 3.30803E+07
	+event_index* => 3
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.7488700E+01; 0.0000000E+00, 0.0000000E+00,-1.7488700E+01\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-6.1696367E+01; 0.0000000E+00, 0.0000000E+00, 6.1696367E+01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9825113E+03; 0.0000000E+00, 0.0000000E+00, 6.9825113E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9383036E+03; 0.0000000E+00, 0.0000000E+00,-6.9383036E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 2.7091406E+01; 2.6580500E+01,-5.2285908E+00, 2.8826949E-01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 5.2093661E+01;-2.6580500E+01, 5.2285908E+00,-4.4495937E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:2\|-3.2840858E+02; 0.0000000E+00, 0.0000000E+00,-3.2840858E+02\| 0.0000000E+00\| 3)
	+ 4 prt(i:-2\|-2.1549277E+01; 0.0000000E+00, 0.0000000E+00, 2.1549277E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.6715914E+03; 0.0000000E+00, 0.0000000E+00, 6.6715914E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9784507E+03; 0.0000000E+00, 0.0000000E+00,-6.9784507E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 1.6745700E+02; 5.4606036E+01,-6.3860309E+01, 1.4485126E+02\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 1.8250085E+02;-5.4606036E+01, 6.3860309E+01, 1.6200803E+02\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	- Event #9
	+ Event #4
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.35334E+07
	- Squared matrix el. (prc) = 1.35334E+07
	+ Squared matrix el. (ref) = 3.22507E+07
	+ Squared matrix el. (prc) = 3.22507E+07
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 27
	+ seed = 32047106
	+ calls = 12
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 1.067593E+02
	- P = 0.000000E+00 0.000000E+00 1.067593E+02
	+ E = 1.157900E+02
	+ P = 0.000000E+00 0.000000E+00 1.157900E+02
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 8.464686E+00
	- P = 0.000000E+00 0.000000E+00 -8.464686E+00
	+ E = 8.366189E+00
	+ P = 0.000000E+00 0.000000E+00 -8.366189E+00
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.893241E+03
	- P = 0.000000E+00 0.000000E+00 6.893241E+03
	+ E = 6.884210E+03
	+ P = 0.000000E+00 0.000000E+00 6.884210E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.991535E+03
	- P = 0.000000E+00 0.000000E+00 -6.991535E+03
	+ E = 6.991634E+03
	+ P = 0.000000E+00 0.000000E+00 -6.991634E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 3.781862E+01
	- P = 1.174670E+01 -2.488222E+01 2.594491E+01
	+ E = 4.529865E+01
	+ P = 1.670697E+01 -2.439383E+01 3.431889E+01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 7.740532E+01
	- P = -1.174670E+01 2.488222E+01 7.234966E+01
	+ E = 7.885752E+01
	+ P = -1.670697E+01 2.439383E+01 7.310490E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 9
	+ seed = 32047107
	+ calls = 4
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 106.759 0.000 0.000 106.759 0.000
	- 4 [i] dbar 0 0 2 7-8 8.465 0.000 0.000 -8.465 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6893.241 0.000 0.000 6893.241 0.000
	- 6 [x] hr3 0 0 2 [none] 6991.535 0.000 0.000 -6991.535 0.000
	- 7 [o] e- 0 0 3-4 [none] 37.819 11.747 -24.882 25.945 0.000
	- 8 [o] e+ 0 0 3-4 [none] 77.405 -11.747 24.882 72.350 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 115.224 0.000 0.000 98.295
	-Sum of beam remnant momenta: p(0:3) = 13884.776 0.000 0.000 -98.295
	-Sum of outgoing momenta: p(0:3) = 115.224 0.000 0.000 98.295
	+ 3 [i] d 0 0 1 7-8 115.790 0.000 0.000 115.790 0.000
	+ 4 [i] dbar 0 0 2 7-8 8.366 0.000 0.000 -8.366 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6884.210 0.000 0.000 6884.210 0.000
	+ 6 [x] hr3 0 0 2 [none] 6991.634 0.000 0.000 -6991.634 0.000
	+ 7 [o] e- 0 0 3-4 [none] 45.299 16.707 -24.394 34.319 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 78.858 -16.707 24.394 73.105 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 124.156 0.000 0.000 107.424
	+Sum of beam remnant momenta: p(0:3) = 13875.844 0.000 0.000 -107.424
	+Sum of outgoing momenta: p(0:3) = 124.156 0.000 0.000 107.424
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 6.01227E+01
	+sqrts_hat* => 6.22486E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	-$process_id* => "powheg_2_p1"
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => 1.35334E+07
	-sqme_ref* => 1.35334E+07
	-event_index* => 9
	+sqme* => 3.22507E+07
	+sqme_ref* => 3.22507E+07
	+event_index* => 4
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.0675926E+02; 0.0000000E+00, 0.0000000E+00,-1.0675926E+02\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-8.4646859E+00; 0.0000000E+00, 0.0000000E+00, 8.4646859E+00\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.8932407E+03; 0.0000000E+00, 0.0000000E+00, 6.8932407E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9915353E+03; 0.0000000E+00, 0.0000000E+00,-6.9915353E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 3.7818625E+01; 1.1746697E+01,-2.4882224E+01, 2.5944911E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 7.7405319E+01;-1.1746697E+01, 2.4882224E+01, 7.2349661E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-1.1578998E+02; 0.0000000E+00, 0.0000000E+00,-1.1578998E+02\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-8.3661890E+00; 0.0000000E+00, 0.0000000E+00, 8.3661890E+00\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.8842100E+03; 0.0000000E+00, 0.0000000E+00, 6.8842100E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9916338E+03; 0.0000000E+00, 0.0000000E+00,-6.9916338E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 4.5298654E+01; 1.6706971E+01,-2.4393826E+01, 3.4318893E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 7.8857517E+01;-1.6706971E+01, 2.4393826E+01, 7.3104900E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	- Event #10
	+ Event #5
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 6.32254E+06
	- Squared matrix el. (prc) = 6.32254E+06
	+ Squared matrix el. (ref) = 1.32591E+08
	+ Squared matrix el. (prc) = 1.32591E+08
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	- Selected channel = 2
	+ Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 30
	+ seed = 32047106
	+ calls = 15
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	- Particle 3 [i] f(1)
	- E = 3.840213E+02
	- P = 0.000000E+00 0.000000E+00 3.840213E+02
	+ Particle 3 [i] f(4)
	+ E = 4.109889E+01
	+ P = 0.000000E+00 0.000000E+00 4.109889E+01
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	- Particle 4 [i] f(-1)
	- E = 2.304886E+01
	- P = 0.000000E+00 0.000000E+00 -2.304886E+01
	+ Particle 4 [i] f(-4)
	+ E = 1.548717E+01
	+ P = 0.000000E+00 0.000000E+00 -1.548717E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.615979E+03
	- P = 0.000000E+00 0.000000E+00 6.615979E+03
	+ E = 6.958901E+03
	+ P = 0.000000E+00 0.000000E+00 6.958901E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.976951E+03
	- P = 0.000000E+00 0.000000E+00 -6.976951E+03
	+ E = 6.984513E+03
	+ P = 0.000000E+00 0.000000E+00 -6.984513E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 1.317678E+02
	- P = -7.259226E+01 4.671327E+01 9.955395E+01
	+ E = 2.427756E+01
	+ P = 2.050577E+01 1.238692E+01 3.934155E+00
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 2.753024E+02
	- P = 7.259226E+01 -4.671327E+01 2.614185E+02
	+ E = 3.230850E+01
	+ P = -2.050577E+01 -1.238692E+01 2.167757E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 10
	+ seed = 32047107
	+ calls = 5
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 1238.461 0.000 0.000 1238.461 0.000
	- 4 [i] dbar 1 0 2 7-8 76.676 0.000 0.000 -76.676 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6615.979 0.000 0.000 6615.979 0.000
	- 6 [x] hr3 0 0 2 [none] 6976.951 0.000 0.000 -6976.951 0.000
	- 7 [v] e- 0 0 3-4 9-11 131.768 -72.592 46.713 99.554 0.000
	- 8 [v] e+ 0 0 3-4 9-11 275.302 72.592 -46.713 261.419 0.000
	- 9 [o] e- 0 0 7-8 [none] 476.698 -250.725 -3.146 405.424 0.000
	- 10 [o] e+ 0 0 7-8 [none] 252.020 -18.319 -72.159 240.772 0.000
	- 11 [o] gl 1 0 7-8 [none] 586.419 269.044 75.306 515.589 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 1315.137 0.000 0.000 1161.785
	-Sum of beam remnant momenta: p(0:3) = 13592.930 0.000 0.000 -360.972
	-Sum of outgoing momenta: p(0:3) = 1315.137 0.000 0.000 1161.785
	+ 3 [i] c 0 0 1 7-8 41.099 0.000 0.000 41.099 0.000
	+ 4 [i] cbar 0 0 2 7-8 15.487 0.000 0.000 -15.487 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6958.901 0.000 0.000 6958.901 0.000
	+ 6 [x] hr3 0 0 2 [none] 6984.513 0.000 0.000 -6984.513 0.000
	+ 7 [o] e- 0 0 3-4 [none] 24.278 20.506 12.387 3.934 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 32.309 -20.506 -12.387 21.678 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 56.586 0.000 0.000 25.612
	+Sum of beam remnant momenta: p(0:3) = 13943.414 0.000 0.000 -25.612
	+Sum of outgoing momenta: p(0:3) = 56.586 0.000 0.000 25.612
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 6.16313E+02
	+sqrts_hat* => 5.04581E+01
	n_in* => 2
	-n_out* => 5
	-n_tot* => 7
	-$process_id* => "powheg_2_p1"
	+n_out* => 4
	+n_tot* => 6
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => 6.32254E+06
	-sqme_ref* => 6.32254E+06
	-event_index* => 10
	+sqme* => 1.32591E+08
	+sqme_ref* => 1.32591E+08
	+event_index* => 5
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.2384610E+03; 0.0000000E+00, 0.0000000E+00,-1.2384610E+03\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-7.6676176E+01; 0.0000000E+00, 0.0000000E+00, 7.6676176E+01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.6159787E+03; 0.0000000E+00, 0.0000000E+00, 6.6159787E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9769511E+03; 0.0000000E+00, 0.0000000E+00,-6.9769511E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 4.7669847E+02;-2.5072520E+02,-3.1464403E+00, 4.0542373E+02\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 2.5201954E+02;-1.8318762E+01,-7.2159414E+01, 2.4077228E+02\| 0.0000000E+00\| 8)
	- 9 prt(o:21\| 5.8641920E+02; 2.6904396E+02, 7.5305854E+01, 5.1558885E+02\| 0.0000000E+00\| 9)
	+ 3 prt(i:4\|-4.1098893E+01; 0.0000000E+00, 0.0000000E+00,-4.1098893E+01\| 0.0000000E+00\| 3)
	+ 4 prt(i:-4\|-1.5487167E+01; 0.0000000E+00, 0.0000000E+00, 1.5487167E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9589011E+03; 0.0000000E+00, 0.0000000E+00, 6.9589011E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9845128E+03; 0.0000000E+00, 0.0000000E+00,-6.9845128E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 2.4277558E+01; 2.0505765E+01, 1.2386922E+01, 3.9341550E+00\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 3.2308503E+01;-2.0505765E+01,-1.2386922E+01, 2.1677571E+01\| 0.0000000E+00\| 8)
	========================================================================
	-Contents of powheg_2_p1.pg:
	+Contents of powheg_2_p2.pg:
	3
	- 10 10 3
	- 4.56011905XE+02 1.08396964XE+03 1.00704509XE+03 4.07472766XE+02 8.20831522XE+02 4.39687151XE+03 0.00000000XE+00 4.55870940XE-01 1.14106308XE-02 4.72900300XE-04 6.22466761XE+02 1.19665109XE+03 8.12748191XE+02 1.70252009XE+02 5.64633339XE+00 9.34588042XE+01 1.35500082XE-02 1.21124128XE+00 3.40843391XE+03 2.19908469XE+02 1.98717907XE+02 1.45199305XE+03 4.41860587XE+02 2.49687654XE+03 4.72285318XE+02 3.97752966XE+01 4.55486415XE+03 4.22391825XE+00 2.21709182XE+03 4.11771296XE-01 7.47343130XE+00 1.53156015XE+03 1.19616305XE+03 2.63299545XE+02 1.24426105XE+02 0.00000000XE+00 1.07269899XE+01 3.80760159XE+00 0.00000000XE+00 3.15864697XE+02 2.88692057XE+02 8.09073336XE+02 5.41970240XE+02 5.59608958XE+02 3.92235948XE+02 6.42227705XE+01 3.62917919XE-02 1.20057662XE+03 8.14524536XE-02 1.33714831XE-05 2.27513287XE+02 7.99680334XE+00 1.68336575XE+03 3.21078101XE+02 4.79703551XE+00 3.99098986XE+01 1.17274094XE+01 2.68423116XE-01 8.27410328XE-01 1.32660515XE+02 1.57786383XE+02 9.26495925XE+02 1.26447340XE+03 1.07803890XE+03 6.87400894XE+01 3.67249837XE+00 1.91702208XE-01 2.26546800XE+02 7.91240282XE+01 1.24206058XE+01 7.85126970XE+01 1.67516040XE+02 7.20842242XE+02 1.41705966XE+03 7.16520373XE+01 4.53820466XE+02 8.48845944XE+01 1.90318064XE+02 0.00000000XE+00 1.67054751XE-05 1.54448608XE+02 5.68536233XE+02 5.06741063XE+02 9.71321469XE+02 5.72484596XE+02 1.28170456XE+01 1.66992992XE+01 3.17799680XE+02 1.67889947XE+00 3.75739367XE-01 7.72391304XE+01 2.83518121XE+02 1.72285713XE+02 5.06605140XE+01 3.08068016XE+02 1.38671167XE+02 3.92063423XE-01 0.00000000XE+00 8.33119487XE+01 1.69887715XE-01 4.38435788XE+04 1.90741123XE+04 8.15629779XE+04 3.65322950XE+03 4.96087992XE+04 9.94584441XE+04 1.27216778XE+03 1.86389782XE+01 2.58184028XE-01 1.06271008XE-02 4.22976604XE+03 9.12874394XE+04 4.37268874XE+04 1.21456301XE+04 1.19977776XE+02 7.98332114XE+02 1.50225380XE+03 1.18084312XE+02 1.20765870XE+04 4.94609476XE+02 2.31762531XE+03 6.12365174XE+04 5.83180540XE+04 6.86143416XE+04 2.78957606XE+04 6.35915636XE+02 2.77947376XE+04 1.02625515XE+02 1.44037355XE+04 1.85886130XE+00 1.35134376XE+02 1.12766452XE+05 9.25910893XE+04 3.68062850XE+04 8.85963148XE+03 0.00000000XE+00 6.61357737XE+01 3.68097007XE+01 0.00000000XE+00 1.03176661XE+03 2.67066772XE+04 6.17091872XE+04 9.03706325XE+03 1.09777514XE+04 3.18375364XE+04 4.55529858XE+03 8.37358999XE-01 2.68198470XE+04 1.88760973XE+00 6.00681729XE-04 2.31855365XE+04 1.41970305XE+02 1.18402359XE+05 3.91924725XE+04 9.54437765XE+01 2.30254674XE+03 7.61035587XE+02 2.09863660XE+02 5.04642500XE+01 3.31661865XE+02 1.09680801XE+03 1.15703562XE+05 4.54305466XE+04 7.17001382XE+04 5.21015932XE+03 3.25662039XE+03 1.21356338XE+01 1.52317444XE+03 5.41094214XE+03 2.96164473XE+01 3.47211572XE+03 1.29138470XE+03 2.55455705XE+04 8.98099893XE+04 1.27433696XE+04 2.89926646XE+04 4.99848148XE+03 7.54277563XE+03 5.16508113XE-02 1.77463296XE-02 1.63522145XE+03 9.43879954XE+03 4.28834065XE+04 4.38952749XE+04 4.09397032XE+04 4.87312659XE+03 1.60018116XE+03 8.49515968XE+03 1.04087121XE+01 2.43065698XE+00 1.64981234XE+03 2.91710330XE+04 5.77166880XE+03 4.58520094XE+03 2.34559365XE+04 2.18709658XE+04 8.23460272XE+02 0.00000000XE+00 7.31739628XE+03 1.66696682XE+01 5.74914737XE+02 7.60546237XE+02 6.41111638XE+02 9.94047015XE+02 3.34234958XE+02 9.19758166XE+03 0.00000000XE+00 1.14217564XE+00 5.32901455XE-02 1.06934118XE-03 4.91519412XE+02 1.70834719XE+03 7.84914314XE+02 1.85236703XE+03 1.25897374XE+01 6.66935929XE+02 1.86072905XE-01 1.86517758XE+01 1.03606703XE+03 8.14813234XE+01 2.19280269XE+02 1.17615689XE+03 1.67095547XE+03 2.91681873XE+03 2.31557457XE+02 1.34736024XE+01 4.52641971XE+04 8.26060646XE+00 7.03374211XE+02 9.58538346XE+00 8.38347918XE+01 1.13299192XE+03 4.21334200XE+02 8.45632906XE+01 7.26826395XE+01 0.00000000XE+00 1.64462061XE+02 1.28488936XE+00 0.00000000XE+00 1.34747045XE+02 7.20104667XE+02 5.01305878XE+02 3.63117036XE+02 6.15781021XE+02 1.87026389XE+02 4.14903395XE+02 4.32021485XE-02 3.31866553XE+03 3.00732711XE-01 2.37775254XE-04 1.25316548XE+02 1.02100430XE+02 2.59471355XE+03 4.81787378XE+02 3.62026593XE+00 1.20412618XE+01 1.98899809XE+02 1.19585741XE-01 1.65422641XE+01 3.46348369XE+02 1.05034543XE+02 1.86978133XE+03 6.91366044XE+02 3.57985584XE+02 4.19191612XE+02 2.46793733XE+00 1.71620202XE+00 7.25239563XE+02 2.15169655XE+02 4.10345353XE+00 4.84963355XE+01 7.66811202XE+01 2.62483559XE+02 6.77517067XE+02 1.26104759XE+02 1.49113799XE+02 1.82647360XE+02 7.65572570XE+01 0.00000000XE+00 1.93989226XE-04 6.65423887XE+01 3.67292036XE+02 6.86976225XE+02 3.33608807XE+02 1.97871128XE+02 3.41392821XE+01 7.67651048XE+00 1.18473614XE+02 1.01140815XE+01 1.22605760XE+00 4.73478002XE+01 8.03683331XE+02 6.76379987XE+01 3.86277513XE+01 1.05897622XE+02 4.61604355XE+01 1.66781894XE+00 0.00000000XE+00 2.55855352XE+02 5.31989006XE-01
	+ 10 10 30
	+ 8.54594478XE+02 6.90463624XE+02 3.07228873XE+03 6.26648970XE-01 1.53720504XE+02 1.28801480XE+04 1.89270518XE-01 9.87966456XE-01 3.45386773XE+02 7.22045194XE-04 4.39818998XE+02 1.01039355XE+03 6.65244665XE+02 3.28919195XE+00 3.30914655XE+02 7.22201789XE-01 2.45728037XE+04 1.10363170XE+03 0.00000000XE+00 2.74369617XE+02 1.07883355XE+03 1.08283525XE+03 1.36824562XE+03 4.28035118XE+03 1.18723858XE+02 1.14992310XE+04 1.06580358XE+04 0.00000000XE+00 1.78507225XE+02 4.94459076XE-02 3.38572113XE+02 8.30724797XE+01 2.51694015XE+03 4.72415883XE+02 1.24517681XE+03 4.87643867XE+03 3.45199047XE+02 4.00679358XE+01 4.77269184XE+03 1.28608870XE+02 7.10415419XE+02 5.84766082XE+02 8.81407205XE+02 3.91688752XE+03 5.18458505XE+03 5.17475220XE+01 1.21003487XE+03 2.48710360XE+00 2.60934467XE+04 1.87850421XE+04 5.45040267XE+02 8.52544201XE+02 7.45973602XE+02 4.77114532XE+02 7.83679088XE+01 1.52948277XE+02 1.01201732XE+04 4.62058591XE+02 1.10850141XE+03 5.94144062XE+01 1.74466861XE+02 1.01377492XE+03 3.71464973XE+02 2.57912591XE+02 3.50524718XE+03 1.97026660XE+02 5.28935739XE+04 1.60984237XE+04 4.88694168XE+04 6.06987638XE+03 4.03743591XE+02 6.17661284XE+01 1.35625510XE+03 3.09502549XE+03 2.50720494XE+02 6.21318137XE+01 4.69953872XE+03 1.63807934XE+01 2.34336816XE+03 4.29406959XE+02 1.08214213XE+02 5.35269853XE+02 6.63716017XE+02 1.85231798XE+02 1.66933480XE+02 4.43743275XE+01 4.41374658XE+01 1.29515440XE+02 8.95879202XE+02 3.10384986XE+03 1.74635664XE+02 4.35087849XE+01 2.27869107XE+02 1.41683145XE+02 8.21779818XE+02 3.89742041XE+01 5.88912002XE+00 8.95171088XE+01 6.17097739XE+01 2.27450540XE+01 2.73302539XE+04 5.17431957XE+04 3.70585529XE+05 1.80239613XE+01 1.65621059XE+04 6.37868345XE+05 8.07634569XE+00 2.28696812XE+01 1.84172681XE+03 1.90100610XE-02 1.13414403XE+04 4.00769118XE+04 1.87395999XE+04 7.21252326XE+01 1.61605854XE+04 1.68594467XE+01 9.01432208XE+05 2.27158580XE+04 0.00000000XE+00 7.06980374XE+03 3.17782147XE+04 3.46022961XE+04 6.05462160XE+04 2.08757927XE+05 5.88474569XE+03 4.70382453XE+05 9.47460542XE+05 5.15974963XE-01 2.62918763XE+03 8.18464247XE-01 2.16159244XE+04 2.27138833XE+03 7.18853681XE+04 2.89824601XE+04 7.71136533XE+04 1.62233614XE+05 1.82248259XE+04 1.42872607XE+03 3.22377272XE+04 1.58762598XE+03 2.25812433XE+04 1.46709785XE+04 2.44946783XE+04 1.51100092XE+05 1.64908673XE+05 5.61438413XE+03 4.26312366XE+04 2.22543859XE+02 6.25302764XE+04 7.75234099XE+05 2.62917856XE+04 3.56600077XE+04 5.79748597XE+04 1.37611883XE+04 1.79032111XE+03 3.21767725XE+03 1.33040643XE+06 1.75604523XE+04 1.23908194XE+04 1.31048396XE+02 1.77736276XE+04 6.79597063XE+04 8.56951840XE+03 2.75363100XE+04 5.61073959XE+05 1.08091946XE+04 1.96047086XE+06 5.14132693XE+05 1.60418314XE+05 1.51471217XE+05 2.58906834XE+04 4.74019719XE+03 7.29171514XE+04 8.86600171XE+04 1.00651060XE+04 2.65004987XE+03 6.14141545XE+05 1.17921299XE+03 5.43229921XE+04 9.63860257XE+03 3.07600264XE+03 1.74895997XE+04 2.30253295XE+04 1.45424619XE+04 5.14225254XE+03 2.22804598XE+03 1.27539490XE+03 5.05090832XE+03 2.20146359XE+04 1.51481182XE+05 5.81533452XE+03 1.66256899XE+03 1.06678479XE+04 8.39647985XE+03 1.87323212XE+04 1.55814459XE+03 7.66170446XE+02 2.51012613XE+03 1.38616668XE+03 1.08577473XE+03 9.51953291XE+02 5.47432262XE+02 1.76973646XE+01 3.86276868XE-01 5.85447792XE+02 2.15950422XE+04 3.61968298XE+00 4.34561111XE+00 2.05001166XE+00 1.51378678XE-04 5.41962500XE+02 1.00251010XE+03 1.83269393XE+03 1.76413105XE+01 1.52503874XE+03 0.00000000XE+00 8.13385990XE+04 1.91618982XE+03 0.00000000XE+00 4.33757941XE+02 1.24199780XE+03 1.68913604XE+03 4.38312789XE+02 2.84613414XE+03 3.56809234XE+02 6.37690593XE+02 4.51577093XE+04 3.10606952XE-02 8.86752923XE+00 6.91610246XE-03 3.31930112XE+02 1.58194207XE+02 1.92145843XE+03 1.29733769XE+03 2.88284795XE+02 1.60767226XE+02 2.10667682XE+03 1.37709154XE+01 1.37566748XE+01 1.39921969XE+02 7.82677242XE+02 6.01896405XE+02 6.35140201XE+01 1.47498830XE+02 3.35202276XE+02 4.64285953XE+02 3.78181797XE+02 7.33184306XE+01 1.09761439XE+01 7.84783910XE+03 5.46061415XE+02 1.13470448XE+03 1.74932443XE+03 1.40949490XE+03 3.08680507XE+02 1.12918149XE+02 2.81821629XE+04 4.17147744XE+02 4.92167966XE+02 3.10092668XE-03 1.83358210XE+02 1.36136324XE+03 5.67723536XE+02 9.43578588XE+02 1.97222937XE+03 6.32646448XE+02 2.14259548XE+04 1.07608315XE+04 3.09435744XE+01 9.75038150XE+01 4.67928857XE+02 5.44776786XE+01 5.60268109XE+02 1.97496901XE+04 1.20091936XE+03 3.35978371XE+02 1.63287551XE+02 8.75665075XE+02 0.00000000XE+00 3.30054989XE+02 1.20589093XE+02 7.06214880XE+02 1.37043081XE+03 7.21710445XE+02 1.14480675XE+03 4.31092181XE+02 3.78182939XE+02 1.03055572XE+02 7.71911816XE+00 1.70429294XE+02 1.72675805XE+02 5.18110986XE+01 2.34758569XE+02 3.47116829XE+02 4.08360540XE+02 2.45195451XE+02 9.81407421XE+01 1.00623689XE+01 2.60766206XE+00 7.43131695XE+00 1.70101537XE+02 3.05343829XE+02 1.21277480XE+02 8.66429072XE+00 4.15478751XE+01 9.17334079XE+02 3.79922859XE-01 1.07306934XE+00 1.25520859XE+00 3.29130782XE-03 3.94861712XE+02 1.33654635XE+03 3.26807492XE+02 6.67846448XE+01 4.93308751XE+01 0.00000000XE+00 5.76075359XE+03 4.02914992XE+03 0.00000000XE+00 6.04524993XE+01 2.69018340XE+02 4.80946706XE+02 1.33336647XE+02 1.21103884XE+03 2.64089568XE+01 2.08590951XE+01 8.12288994XE+02 8.60811295XE-04 2.29183001XE+00 1.53886068XE-01 1.01079513XE+02 1.13114695XE+02 3.14485337XE+02 9.63162284XE+01 5.00923151XE+01 1.85441583XE+01 5.47208536XE+01 7.83974247XE-01 6.74143622XE+00 4.59488059XE+01 1.49994790XE+02 1.07729230XE+03 6.16535757XE+00 7.85738043XE+01 3.97203459XE+01 1.58888208XE+01 9.62173351XE+02 8.33129347XE-01 3.00931445XE+01 3.57652107XE+02 8.23984244XE+02 2.31369154XE+02 9.25191891XE+01 1.65230188XE+02 8.70964979XE+01 1.15729687XE+02 4.89986999XE+02 2.40161369XE+01 5.57431165XE+02 5.68181914XE-03 7.09092752XE+01 5.89238698XE+02 6.50167839XE+02 6.75705031XE+02 2.83880496XE+01 2.97085279XE+01 1.64874791XE+03 1.52595100XE+02 5.42772674XE+01 1.71785993XE+01 2.15536294XE+02 2.11403618XE+02 2.66932600XE+01 3.09594413XE+03 2.09636399XE+02 4.63975060XE+01 2.63052791XE+00 1.12978913XE+01 0.00000000XE+00 3.75421827XE+02 1.39397256XE+02 1.64596315XE+02 1.49935517XE+02 4.93090588XE+01 2.00541482XE+02 1.57078678XE+01 9.56602455XE+01 1.95957698XE+00 2.96261346XE-01 1.21074470XE+01 1.22733675XE+02 5.29374723XE+01 1.09591780XE+02 1.57729806XE+01 9.11705863XE+01 2.03291660XE+01 1.62918723XE+00 4.16344228XE-01 2.41322004XE-01 3.17232293XE-01 1.04661310XE+03 4.97333882XE+02 1.51550005XE+01 1.67172086XE+00 1.05903274XE+02 6.35310268XE+02 3.30175820XE-01 5.44584553XE+01 4.17964245XE+02 2.52696777XE-03 5.26002592XE+02 1.49802734XE+03 1.36081308XE+03 1.31930292XE+01 3.02902938XE+02 8.58712110XE+00 9.62431143XE+01 2.19257501XE+01 0.00000000XE+00 2.84629527XE-01 1.41487919XE+03 1.93180234XE+03 3.46576211XE+03 3.37653455XE+02 7.32724923XE+02 3.96631812XE+02 1.51670321XE+03 8.60098143XE-03 1.32757692XE+02 1.50378960XE-01 3.81949603XE+02 1.05403752XE+02 1.81622109XE+03 6.16637551XE+02 1.57758492XE+03 2.00548319XE+02 9.82761589XE+00 3.67899184XE+01 6.67578643XE+03 4.11374175XE+00 8.60297947XE+02 8.17593736XE+02 8.60373203XE+02 1.34046836XE+01 2.26522256XE+04 2.59031171XE+01 3.52245735XE+03 7.81042069XE-02 7.87683268XE+04 2.46655777XE-03 6.62581677XE+02 8.87627178XE+02 1.37755090XE+03 1.09851728XE+03 8.29961804XE+02 1.84192734XE+02 4.63433818XE+01 4.68920764XE+01 4.44503804XE+02 1.05809777XE-03 1.84475270XE+02 1.29448849XE+03 8.57541293XE+02 6.57017062XE+02 4.33388041XE+02 2.29788403XE+02 7.89073160XE+01 1.94783692XE+00 4.46982857XE+02 1.47155498XE+01 4.65816730XE+02 3.78886906XE+01 3.98716645XE+02 1.01433460XE+03 5.92558264XE+02 4.46299139XE+02 4.09153498XE+01 6.83621440XE+01 7.31096328XE-01 4.02862198XE-02 1.51514127XE+02 1.03051328XE+03 1.53986014XE+03 4.78880431XE+02 7.45635559XE+02 2.69469809XE+01 3.94028166XE+01 7.83880470XE+01 3.45530425XE+00 9.52587319XE+02 1.65195616XE+02 7.35008794XE+01 5.19932088XE+02 9.35980947XE+01 5.50048839XE+03 4.26464434XE+01 8.04470874XE+01 7.90868417XE+01 2.72594490XE+01 1.29484112XE-02 9.00158272XE+03 3.99848609XE+03 2.96784446XE+02 3.80175939XE+01 1.61813230XE+04 3.88708083XE+03 3.26725607XE+00 3.35982060XE+02 2.22498640XE+03 5.61772798XE-02 4.46687443XE+03 2.24778724XE+04 8.84664096XE+03 1.83678970XE+02 9.16161006XE+03 1.50794106XE+02 1.15165115XE+03 2.04191134XE+02 0.00000000XE+00 1.73770445XE+00 9.60191424XE+03 3.06507595XE+04 1.67850200XE+05 6.25741505XE+04 4.85769587XE+03 4.49771229XE+04 5.70728854XE+04 1.96979218XE-01 1.95948195XE+03 1.81324402XE+00 1.81891664XE+04 9.14237216XE+02 2.01335929XE+04 1.41594206XE+04 9.99478097XE+03 1.23126540XE+03 2.87011219XE+02 1.43793048XE+03 4.50053956XE+04 9.41186459XE+00 6.02773621XE+03 6.97264895XE+03 5.92888757XE+03 2.52394561XE+02 7.39718688XE+05 5.92004321XE+03 1.32375653XE+05 1.03462383XE+02 1.88301728XE+05 5.52964404XE-02 9.68197802XE+03 1.06929406XE+04 6.54067799XE+04 7.40752075XE+03 5.40095959XE+03 1.52228495XE+03 6.24100269XE+03 5.50777478XE+02 4.81886018XE+03 6.89016069XE-03 1.07540857XE+04 9.63551284XE+03 7.44065611XE+03 7.41594469XE+04 4.37964213XE+03 1.15590460XE+04 3.07542353XE+03 9.99433005XE+02 1.46390097XE+03 3.71767082XE+02 1.23434239XE+04 4.24768507XE+02 3.69574346XE+04 7.39873972XE+03 5.18451509XE+03 3.69709329XE+03 8.07625208XE+03 5.20529058XE+02 6.26712771XE+00 3.45308005XE-01 1.33421494XE+03 7.37224958XE+03 1.33941245XE+04 1.13245410XE+04 6.16011471XE+03 8.27714966XE+02 5.81006265XE+02 3.34333824XE+03 1.67754578XE+02 2.33037291XE+03 1.24563637XE+03 6.75550353XE+02 7.58643553XE+03 5.68441243XE+03 1.26518857XE+05 4.39209293XE+02 5.07415610XE+03 2.22996002XE+03 6.17173777XE+02 1.31069733XE-01 8.54594478XE+02 6.90463624XE+02 3.07228873XE+03 6.26648970XE-01 1.53720504XE+02 1.28801480XE+04 1.89270518XE-01 9.87966456XE-01 3.45386773XE+02 7.22045194XE-04 4.39818998XE+02 1.01039355XE+03 6.65244665XE+02 3.28919195XE+00 3.30914655XE+02 7.22201789XE-01 2.45728037XE+04 1.10363170XE+03 0.00000000XE+00 2.74369617XE+02 1.07883355XE+03 1.08283525XE+03 1.36824562XE+03 4.28035118XE+03 1.18723858XE+02 1.14992310XE+04 1.06580358XE+04 0.00000000XE+00 1.78507225XE+02 4.94459076XE-02 3.38572113XE+02 8.30724797XE+01 2.51694015XE+03 4.72415883XE+02 1.24517681XE+03 4.87643867XE+03 3.45199047XE+02 4.00679358XE+01 4.77269184XE+03 1.28608870XE+02 7.10415419XE+02 5.84766082XE+02 8.81407205XE+02 3.91688752XE+03 5.18458505XE+03 5.17475220XE+01 1.21003487XE+03 2.48710360XE+00 2.60934467XE+04 1.87850421XE+04 5.45040267XE+02 8.52544201XE+02 7.45973602XE+02 4.77114532XE+02 7.83679088XE+01 1.52948277XE+02 1.01201732XE+04 4.62058591XE+02 1.10850141XE+03 5.94144062XE+01 1.74466861XE+02 1.01377492XE+03 3.71464973XE+02 2.57912591XE+02 3.50524718XE+03 1.97026660XE+02 5.28935739XE+04 1.60984237XE+04 4.88694168XE+04 6.06987638XE+03 4.03743591XE+02 6.17661284XE+01 1.35625510XE+03 3.09502549XE+03 2.50720494XE+02 6.21318137XE+01 4.69953872XE+03 1.63807934XE+01 2.34336816XE+03 4.29406959XE+02 1.08214213XE+02 5.35269853XE+02 6.63716017XE+02 1.85231798XE+02 1.66933480XE+02 4.43743275XE+01 4.41374658XE+01 1.29515440XE+02 8.95879202XE+02 3.10384986XE+03 1.74635664XE+02 4.35087849XE+01 2.27869107XE+02 1.41683145XE+02 8.21779818XE+02 3.89742041XE+01 5.88912002XE+00 8.95171088XE+01 6.17097739XE+01 2.27450540XE+01 2.73302539XE+04 5.17431957XE+04 3.70585529XE+05 1.80239613XE+01 1.65621059XE+04 6.37868345XE+05 8.07634569XE+00 2.28696812XE+01 1.84172681XE+03 1.90100610XE-02 1.13414403XE+04 4.00769118XE+04 1.87395999XE+04 7.21252326XE+01 1.61605854XE+04 1.68594467XE+01 9.01432208XE+05 2.27158580XE+04 0.00000000XE+00 7.06980374XE+03 3.17782147XE+04 3.46022961XE+04 6.05462160XE+04 2.08757927XE+05 5.88474569XE+03 4.70382453XE+05 9.47460542XE+05 5.15974963XE-01 2.62918763XE+03 8.18464247XE-01 2.16159244XE+04 2.27138833XE+03 7.18853681XE+04 2.89824601XE+04 7.71136533XE+04 1.62233614XE+05 1.82248259XE+04 1.42872607XE+03 3.22377272XE+04 1.58762598XE+03 2.25812433XE+04 1.46709785XE+04 2.44946783XE+04 1.51100092XE+05 1.64908673XE+05 5.61438413XE+03 4.26312366XE+04 2.22543859XE+02 6.25302764XE+04 7.75234099XE+05 2.62917856XE+04 3.56600077XE+04 5.79748597XE+04 1.37611883XE+04 1.79032111XE+03 3.21767725XE+03 1.33040643XE+06 1.75604523XE+04 1.23908194XE+04 1.31048396XE+02 1.77736276XE+04 6.79597063XE+04 8.56951840XE+03 2.75363100XE+04 5.61073959XE+05 1.08091946XE+04 1.96047086XE+06 5.14132693XE+05 1.60418314XE+05 1.51471217XE+05 2.58906834XE+04 4.74019719XE+03 7.29171514XE+04 8.86600171XE+04 1.00651060XE+04 2.65004987XE+03 6.14141545XE+05 1.17921299XE+03 5.43229921XE+04 9.63860257XE+03 3.07600264XE+03 1.74895997XE+04 2.30253295XE+04 1.45424619XE+04 5.14225254XE+03 2.22804598XE+03 1.27539490XE+03 5.05090832XE+03 2.20146359XE+04 1.51481182XE+05 5.81533452XE+03 1.66256899XE+03 1.06678479XE+04 8.39647985XE+03 1.87323212XE+04 1.55814459XE+03 7.66170446XE+02 2.51012613XE+03 1.38616668XE+03 1.08577473XE+03 8.35239334XE+02 3.27525128XE+02 2.52753455XE+03 0.00000000XE+00 3.20735196XE+02 1.33395828XE+04 1.46351007XE-01 7.49929284XE-01 5.95432860XE+02 1.09850917XE-03 4.31133757XE+02 1.01246282XE+03 6.05865902XE+02 2.75438403XE+00 3.11861045XE+02 0.00000000XE+00 2.24494076XE+04 1.32056278XE+03 0.00000000XE+00 4.62939623XE+02 1.04885356XE+03 1.02706999XE+03 1.27475102XE+03 3.31758305XE+03 2.22068086XE+02 9.09425647XE+03 1.34869659XE+04 0.00000000XE+00 3.09317173XE+02 1.73831149XE-01 1.26720511XE+01 7.91953128XE+01 1.86948956XE+03 4.87823214XE+02 1.48947739XE+03 3.28978429XE+03 4.32309982XE+02 7.16558486XE+01 7.10223059XE+03 3.67294716XE+02 7.03551553XE+02 5.93239930XE+02 1.07473252XE+03 2.86411969XE+03 4.20045237XE+03 7.67622634XE+01 1.47274502XE+03 4.98501021XE+00 3.51157119XE+04 1.38878924XE+04 5.37574716XE+02 8.50201901XE+02 7.83557257XE+02 4.21007421XE+02 5.49872161XE+01 2.62189117XE+02 3.13631624XE+01 6.95749054XE+02 2.37359241XE+03 6.53524185XE+01 4.26209506XE+00 8.93761717XE+02 3.49837841XE+02 3.11751086XE+02 2.52187590XE+03 3.74851537XE+02 3.88974786XE+04 1.28322612XE+04 8.58860429XE+04 9.29327481XE+03 1.04683127XE+02 4.84064952XE+01 1.04656315XE+03 2.42728038XE+03 2.25980138XE+02 2.05893383XE+03 1.29765757XE+01 2.86969915XE+01 0.00000000XE+00 1.46847292XE+01 1.06162717XE+02 5.08839671XE+02 6.47072048XE+02 2.00097744XE+02 1.43863022XE+02 4.01160664XE+01 5.37712365XE+01 2.14416884XE+02 3.15215603XE+01 2.40876565XE+03 1.63802347XE+02 4.18189272XE+01 2.19505989XE+02 1.40442071XE+02 6.99052270XE+02 3.42213157XE+01 8.63483961XE+00 2.03952402XE+00 1.20385236XE+02 4.36052959XE+01 5.12074688XE+04 2.41672454XE+04 2.44516345XE+05 0.00000000XE+00 2.95162353XE+04 1.32835355XE+06 1.31320728XE+01 2.92553427XE+01 3.27287452XE+03 3.70391885XE-02 1.95005695XE+04 8.04836158XE+04 3.11256827XE+04 1.07352694XE+02 2.93559236XE+04 0.00000000XE+00 1.60401039XE+06 4.21212587XE+04 0.00000000XE+00 2.11466520XE+04 5.73223130XE+04 6.47190499XE+04 9.14949649XE+04 3.23103881XE+05 1.09065232XE+04 7.35480838XE+05 1.85577161XE+06 0.00000000XE+00 4.89249310XE+03 2.20394551XE+00 5.47698309XE+02 3.92871700XE+03 9.77970846XE+04 5.65539553XE+04 9.29388636XE+04 1.27738543XE+05 4.23675490XE+04 2.76286648XE+03 5.00093218XE+04 4.44491130XE+03 4.27998050XE+04 2.56881017XE+04 5.40596496XE+04 1.29403065XE+05 1.54274900XE+05 1.03374338XE+04 5.79943146XE+04 3.92923465XE+02 8.75829676XE+04 6.24529087XE+05 5.45361334XE+04 7.22670849XE+04 1.07219139XE+05 2.23944585XE+04 2.27943701XE+03 8.70741363XE+03 1.06717888XE+03 5.19382637XE+04 2.72275278XE+04 1.48192066XE+02 1.93243182XE+02 6.00168657XE+04 1.33491462XE+04 4.64264049XE+04 3.04240700XE+05 4.04080799XE+04 1.67479844XE+06 1.08718319XE+06 2.91570992XE+05 2.58233045XE+05 1.17164803XE+04 4.57766512XE+03 6.24399708XE+04 1.27708901XE+05 1.79698828XE+04 3.45845770XE+05 2.04767347XE+03 1.85650364XE+03 0.00000000XE+00 4.78594406XE+02 5.60843428XE+03 3.20891289XE+04 4.23901973XE+04 2.32146938XE+04 8.35415031XE+03 3.96948142XE+03 2.62321298XE+03 9.46462425XE+03 3.84272249XE+03 1.26488384XE+05 1.07699566XE+04 2.39023170XE+03 2.13260030XE+04 1.73805284XE+04 1.78117052XE+04 2.77833962XE+03 1.51936478XE+03 2.16618161XE+02 3.02948340XE+03 4.16431700XE+03 8.13539884XE+02 3.62692374XE+02 8.18413691XE+00 5.39866761XE-01 6.02609666XE+00 1.52132682XE+04 1.57519149XE-01 7.53209396XE-01 2.52123885XE+02 3.91347466XE-04 4.42429213XE+02 9.02922543XE+02 6.30864948XE+02 4.40895998XE+00 2.53129722XE+02 0.00000000XE+00 4.75073827XE+04 0.00000000XE+00 0.00000000XE+00 1.95768400XE+02 1.01826693XE+03 1.07015076XE+03 2.07204487XE+03 2.64247321XE+03 8.14542237XE+01 4.69078953XE+02 8.11029551XE+03 0.00000000XE+00 1.38051168XE+02 2.00674015XE-02 2.77015890XE+02 9.01343184XE+01 7.86806510XE+02 3.56336718XE+02 3.04481677XE+02 8.62631100XE+00 2.12894222XE-01 2.52223123XE+01 6.06018099XE+03 9.95131280XE+01 6.71988231XE+02 5.53046721XE+02 2.69036729XE+01 3.95735629XE+00 1.16948191XE+04 1.08072136XE+01 3.63279485XE+02 0.00000000XE+00 2.45907255XE+04 2.79224569XE-02 5.22276723XE+02 7.68050484XE+02 6.54600387XE+02 3.76886174XE+02 7.38333786XE+01 7.68286507XE+01 4.92471260XE+00 4.47522146XE+02 6.57279603XE+02 9.29753374XE-05 1.68177004XE+02 9.10047545XE+02 3.81147738XE+02 2.44344684XE+02 1.06414853XE+00 5.70883609XE+01 2.12858855XE+04 0.00000000XE+00 5.79555247XE+04 1.53614898XE+04 3.93599466XE+02 3.32553777XE+01 1.66774715XE+02 7.31630847XE+03 1.90799274XE+02 5.03999278XE+01 1.89997255XE+00 6.05566075XE+00 0.00000000XE+00 4.43186971XE+02 1.13458357XE+02 5.20496961XE+02 6.37956330XE+02 1.47322570XE+02 1.38104438XE+02 3.02630912XE+01 9.31449331XE-01 1.06921076XE+02 1.09565805XE+01 8.46118023XE+02 1.27366023XE+02 4.10143038XE+01 2.03683483XE+02 1.22516639XE+02 9.38394896XE+02 2.95211744XE+01 3.51905169XE+00 7.40585256XE-01 1.44059737XE+01 1.63350746XE+01 1.44581111XE+04 4.61033578XE+03 1.32702642XE+02 1.38749046XE+01 1.43230072XE+04 5.80154834XE+05 4.25162907XE+00 9.43958064XE+00 1.34234426XE+03 9.47440670XE-03 5.56670204XE+03 2.48075691XE+04 9.96104114XE+03 7.42826048XE+01 1.00881641XE+04 0.00000000XE+00 1.18247023XE+06 0.00000000XE+00 0.00000000XE+00 2.98706859XE+03 1.60814316XE+04 2.82852495XE+04 1.05368269XE+05 5.40136234XE+04 3.40216206XE+03 4.86915373XE+04 1.03160308XE+06 3.14387188XE-01 2.03809994XE+03 4.95603280XE-01 9.49523651XE+03 1.17414227XE+03 2.04634036XE+04 2.13176201XE+04 4.65586359XE+03 1.20223936XE+02 4.09568630XE+00 9.94818764XE+02 4.08595265XE+04 7.48258545XE+02 1.16826903XE+04 6.83932116XE+03 8.93777845XE+02 7.87954146XE+01 3.83567301XE+05 4.52614043XE+03 4.61571326XE+03 1.35629873XE+02 6.05793618XE+04 1.02716116XE+00 1.77560154XE+04 2.23170004XE+04 4.75315834XE+04 6.65729549XE+03 9.43984476XE+02 8.76841520XE+02 2.62090704XE+02 1.21189384XE+04 7.75908532XE+03 1.57116835XE-03 1.57550523XE+04 1.15162569XE+04 4.60343097XE+03 2.68316237XE+04 3.73543349XE+04 4.60043778XE+03 6.04615625XE+05 0.00000000XE+00 1.89813524XE+05 3.88356337XE+05 1.95975654XE+04 5.00016565XE+02 3.14039021XE+04 1.20609071XE+05 5.54025836XE+03 1.22898853XE+03 6.96996931XE+02 2.35715772XE+03 0.00000000XE+00 5.30304690XE+03 1.51222773XE+03 9.76202117XE+03 1.47152227XE+04 6.46732132XE+03 2.59387813XE+03 1.33886147XE+03 8.66233822XE+02 4.58402908XE+03 7.79965659XE+02 6.16613872XE+03 1.86434423XE+03 1.20357241XE+03 6.78868747XE+03 5.61783229XE+03 2.16245597XE+04 7.85110685XE+02 5.10806939XE+02 7.40401323XE+01 3.65092785XE+02 5.97769665XE+02 7.62808316XE+02 5.24379652XE+02 1.42186839XE+01 3.66786861XE-02 7.12850543XE+01 1.77491414XE+04 1.56499667XE+00 1.03380062XE+00 7.34190310XE-01 3.10771018XE-04 5.08930706XE+02 1.41038825XE+03 1.42436154XE+03 1.22653619XE+01 3.37538619XE+02 0.00000000XE+00 6.06846254XE+04 0.00000000XE+00 0.00000000XE+00 9.12258912XE+02 1.16758312XE+03 1.30918646XE+03 3.77942389XE+02 2.90311053XE+03 3.28532118XE+02 1.68872778XE+02 2.00290598XE+04 1.75527410XE-03 9.24738213XE-01 6.58864144XE-02 1.42629597XE+02 1.39893980XE+02 4.77287591XE+02 8.02032155XE+02 6.78010418XE+02 6.23618004XE+01 2.44848425XE+00 1.69572907XE+00 1.46329572XE+01 2.62983073XE+02 8.76519504XE+02 7.10122479XE+02 4.55237543XE+01 1.33392144XE+02 1.72655091XE+02 9.33343122XE+01 8.80876247XE+00 2.46799514XE+00 1.89766821XE+03 4.22774237XE+03 5.25543638XE+02 1.06973238XE+03 8.93022660XE+02 1.14600102XE+03 1.33636190XE+02 1.55251149XE+02 2.47661882XE+04 6.36571557XE+02 8.57949456XE+02 1.22235649XE-01 1.51605684XE+02 1.51338326XE+03 4.50782731XE+02 6.33059192XE+02 5.53619806XE+02 1.93842337XE+02 2.20661339XE+04 5.77215799XE+01 2.80460906XE+02 1.91293040XE+02 3.74107706XE+02 4.86025154XE+01 3.95950704XE+02 1.44029399XE+04 4.45765182XE+02 1.41806367XE+02 2.21702253XE+01 5.37422681XE+01 0.00000000XE+00 5.73673879XE+02 1.26029892XE+02 4.41138868XE+02 1.15028386XE+03 6.73889189XE+02 5.55839607XE+02 1.12683906XE+02 1.94994602XE+01 5.18839474XE+00 3.21488032XE+01 4.25391200XE+02 1.57440905XE+02 4.67928988XE+01 2.12055757XE+02 1.91210452XE+02 2.19493621XE+02 1.26339813XE+02 1.40424068XE+01 7.09487332XE-01 1.10246045XE-01 4.42974076XE+01 4.09117040XE+02 7.32756758XE+02 1.36087177XE+02 2.90333453XE-01 8.40904930XE+01 6.06688836XE+03 6.78384629XE-01 6.57865548XE-01 3.88237328XE+00 6.83772148XE-03 6.63012753XE+02 1.13228662XE+03 7.46238522XE+02 8.11956933XE+01 1.09800946XE+02 0.00000000XE+00 2.10341113XE+04 0.00000000XE+00 0.00000000XE+00 4.02538522XE+02 7.00121725XE+02 1.01998354XE+03 2.82515927XE+03 2.78810185XE+03 1.02258591XE+02 1.14235752XE+02 8.00193425XE+03 3.86182583XE-03 1.27093276XE+01 1.48163330XE+00 1.18510282XE+02 1.98443239XE+02 3.99489844XE+02 2.54413031XE+02 3.46950883XE+02 1.14101283XE+03 1.34194485XE+00 1.49800420XE+01 9.75733586XE+01 2.05170592XE+02 4.90914956XE+02 2.04156127XE+03 2.04052662XE+01 5.74619577XE+02 3.28102705XE+03 4.13889861XE+01 1.29574715XE+02 1.57260126XE+00 4.67635220XE+03 3.14038382XE+04 1.04318017XE+03 3.86698352XE+02 3.44593387XE+02 4.68285796XE+02 9.40479507XE+01 2.86175312XE+02 1.22433654XE+04 2.08275497XE+02 1.71091045XE+03 2.69313779XE-01 7.58252822XE+01 1.46452310XE+03 7.57294404XE+02 8.89758592XE+02 2.79374150XE+02 7.32366907XE+01 8.36648802XE+03 4.56282671XE+02 9.19818685XE+02 3.61233757XE+03 2.26451566XE+02 2.50015947XE+02 1.17403347XE+03 6.97586131XE+03 2.42733185XE+02 4.46836338XE+01 1.03883101XE+01 4.88054780XE+01 0.00000000XE+00 1.14897164XE+03 1.87726747XE+02 2.18004439XE+02 4.67211345XE+02 4.62766559XE+02 2.33546703XE+02 3.73484931XE+01 9.67904705XE+00 2.78313809XE+01 1.15246453XE+01 1.46332721XE+02 1.52411194XE+02 5.56062362XE+01 9.08541199XE+01 7.33682881XE+01 7.60816659XE+02 8.19974939XE+01 7.09512063XE+00 7.85410191XE-01 2.53217549XE+00 1.48574208XE+01 7.77032850XE+02 4.17796566XE+02 1.25257332XE+01 9.35536900XE-01 3.25045552XE+01 2.12367154XE+03 2.61045474XE-02 5.86987162XE+00 7.87012413XE+02 2.70033466XE-05 4.94495794XE+02 1.20975582XE+03 4.77524211XE+02 1.05549177XE+01 7.04098998XE+02 1.64384367XE+00 7.33659508XE+02 5.76565057XE+00 0.00000000XE+00 7.16302165XE-01 9.68928427XE+02 1.31964639XE+03 2.56586913XE+03 2.33639225XE+02 2.51632518XE+02 6.66903760XE+02 7.56726187XE+02 1.93673188XE-02 3.38557436XE+02 7.02446696XE-02 3.92351982XE+02 9.86958968XE+01 1.53004022XE+03 8.75595039XE+02 4.59593050XE+02 3.79242651XE+01 5.11861070XE+00 6.63752747XE+01 9.04133481XE+03 1.45019705XE+00 5.98288468XE+02 6.39727704XE+02 4.16800242XE+02 1.01643019XE+01 1.55250178XE+04 3.22059815XE+01 7.03938656XE+00 5.36077442XE-03 4.80326875XE+04 1.25861495XE-03 6.39348955XE+02 9.13617882XE+02 1.98740056XE+03 1.75122687XE+02 2.91172678XE+02 3.73850947XE+01 4.57996597XE+00 5.24425802XE+00 3.51998448XE+02 3.57887848XE-06 1.83326800XE+02 9.29890699XE+02 7.18963281XE+02 4.29130683XE+02 1.17781229XE+02 1.38113840XE+02 1.15881038XE+03 7.16952450XE-01 1.48363703XE+04 1.15262322XE+02 4.84073504XE+02 4.03895166XE+01 2.36472708XE+02 4.76337240XE+02 3.52013706XE+02 1.82792432XE+02 4.71641808XE+00 3.49823988XE+00 9.10745200XE+00 2.15813775XE+00 1.39937340XE+02 7.89509355XE+02 1.12188002XE+03 2.60728784XE+02 4.84673258XE+02 1.99127571XE+01 5.43654820XE+00 1.48711317XE+02 5.30992969XE+00 1.51778417XE+03 1.18217980XE+02 6.30178870XE+01 3.46223677XE+02 2.34576567XE+02 3.45285820XE+03 1.21697404XE+01 1.65093651XE+01 7.43822335XE+00 6.29475839XE+01 2.00507785XE-01 1.96975057XE+04 2.78765023XE+03 2.35209327XE+02 2.12716466XE+01 2.71185725XE+04 1.46249280XE+05 2.31880124XE+00 5.39750907XE+01 4.19020436XE+03 6.00056973XE-04 3.15786269XE+03 9.85218518XE+04 2.54367251XE+04 1.42355820XE+02 4.32470314XE+04 2.87041805XE+01 5.49318102XE+04 4.27721641XE+01 0.00000000XE+00 1.46640673XE+01 1.39559362XE+04 2.88805770XE+04 1.30472007XE+05 1.56306857XE+04 1.51955749XE+04 6.91493552XE+04 1.14118978XE+05 4.43502290XE-01 4.99813962XE+03 8.45359343XE-01 3.90685259XE+04 6.46771103XE+02 1.06925065XE+05 5.40864529XE+04 7.63594122XE+03 4.85441211XE+02 3.22693731XE+02 2.61806911XE+03 6.09593520XE+04 3.31786805XE+00 1.14393984XE+04 2.03050479XE+04 4.29775564XE+03 1.85491976XE+02 5.09189212XE+05 1.71083980XE+04 5.57352844XE+01 5.40482487XE+02 1.14819870XE+05 6.80203486XE-02 5.90255957XE+04 7.72665115XE+04 1.25040686XE+05 5.76488599XE+03 2.53934972XE+03 2.27660560XE+02 2.76422157XE+02 3.70311160XE+02 3.81662294XE+03 1.21438618XE-04 2.27398863XE+04 6.61311632XE+03 4.53712032XE+03 5.94278980XE+04 9.25034322XE+03 1.55609090XE+04 1.04241373XE+05 3.64928257XE+03 4.85912460XE+04 2.91387435XE+03 4.14398588XE+04 3.94016152XE+02 5.67419348XE+04 7.13819419XE+03 7.28745856XE+03 5.21559205XE+03 2.30828871XE+03 1.80502275XE+02 5.67901527XE+01 1.36594340XE+01 9.32650696XE+02 3.30282610XE+04 7.64936073XE+04 1.97900238XE+04 3.36363188XE+03 1.96409023XE+03 2.21616620XE+03 6.37582851XE+03 2.18771972XE+02 3.71287661XE+03 1.45254580XE+03 4.95207318XE+02 3.01142174XE+04 1.87953212XE+04 7.95671394XE+04 1.29009570XE+03 1.86380823XE+03 1.88838160XE+02 1.42887209XE+03 1.34779708XE+01 8.12683855XE+02 3.66106439XE+02 8.11128518XE+00 5.21031998XE-01 5.95073442XE+00 1.52950096XE+04 1.69126970XE-01 6.63447946XE-01 2.42344642XE+02 3.51759780XE-04 4.39113218XE+02 9.04418763XE+02 6.62924299XE+02 4.60975762XE+00 2.55865154XE+02 0.00000000XE+00 4.82534949XE+04 0.00000000XE+00 0.00000000XE+00 2.02633806XE+02 1.01908840XE+03 1.08276933XE+03 2.06864748XE+03 2.64631328XE+03 8.26288938XE+01 4.64511421XE+02 8.14686389XE+03 0.00000000XE+00 1.36997460XE+02 1.91067085XE-02 2.78148088XE+02 8.88058147XE+01 7.72474596XE+02 3.62137319XE+02 2.98570521XE+02 9.08553268XE+00 2.06822068XE-01 2.50770886XE+01 5.97610931XE+03 1.00141130XE+02 6.77051059XE+02 5.50183939XE+02 2.79428444XE+01 4.21263938XE+00 1.14619066XE+04 1.10647005XE+01 3.52782096XE+02 0.00000000XE+00 2.45070548XE+04 2.68489851XE-02 5.18406745XE+02 7.78140389XE+02 6.45951602XE+02 3.89564555XE+02 7.68830774XE+01 7.37248862XE+01 5.53490053XE+00 4.49760888XE+02 6.52069014XE+02 8.01816378XE-05 1.67318463XE+02 9.04900124XE+02 3.78799320XE+02 2.31945296XE+02 1.04006960XE+00 5.70394611XE+01 2.13320707XE+04 0.00000000XE+00 5.81426755XE+04 1.52640506XE+04 3.92046571XE+02 3.24216074XE+01 1.66290525XE+02 7.57808670XE+03 2.02246740XE+02 4.60922342XE+01 1.99566799XE+00 5.96545915XE+00 0.00000000XE+00 4.40607520XE+02 1.15412542XE+02 5.17603289XE+02 6.43461009XE+02 1.46063905XE+02 1.45877789XE+02 3.27011038XE+01 8.91003130XE-01 1.07005584XE+02 1.07677799XE+01 8.48808351XE+02 1.27721760XE+02 3.99058732XE+01 1.97439978XE+02 1.24995144XE+02 8.95557984XE+02 3.22484976XE+01 3.29774967XE+00 6.61097199XE-01 1.44869982XE+01 1.59908389XE+01 1.57351457XE+04 5.29530528XE+03 1.34280256XE+02 1.33768164XE+01 1.40155120XE+04 5.89676641XE+05 4.77267716XE+00 9.23691260XE+00 1.29027814XE+03 8.50712282XE-03 6.27803602XE+03 2.55159861XE+04 1.14258311XE+04 7.83594425XE+01 1.02738196XE+04 0.00000000XE+00 1.23788887XE+06 0.00000000XE+00 0.00000000XE+00 3.33156930XE+03 1.77632582XE+04 2.82448341XE+04 1.05195502XE+05 5.39701641XE+04 3.47264819XE+03 4.82177894XE+04 1.03899276XE+06 3.27126875XE-01 2.02254365XE+03 4.71417482XE-01 9.76211017XE+03 1.31916297XE+03 2.05690900XE+04 2.13002444XE+04 4.97879119XE+03 1.39087127XE+02 4.33055386XE+00 9.89091058XE+02 4.02926904XE+04 8.18767425XE+02 1.28832639XE+04 7.72685292XE+03 9.61604531XE+02 8.41103585XE+01 3.75928226XE+05 4.65090805XE+03 4.77251360XE+03 1.38829774XE+02 6.03732387XE+04 9.94262267XE-01 1.80032803XE+04 2.31893548XE+04 4.66534520XE+04 7.32081062XE+03 1.09846588XE+03 9.36483240XE+02 2.95985479XE+02 1.24503989XE+04 8.56166658XE+03 1.43336633XE-03 1.57436999XE+04 1.29737631XE+04 5.11571505XE+03 2.62129696XE+04 3.76042675XE+04 4.69201465XE+03 6.24446959XE+05 0.00000000XE+00 1.90426472XE+05 3.85892964XE+05 1.97072537XE+04 5.11641446XE+02 3.24604899XE+04 1.35268283XE+05 5.98567261XE+03 1.33265292XE+03 7.21909830XE+02 2.48604496XE+03 0.00000000XE+00 5.87230151XE+03 1.75807228XE+03 1.04753679XE+04 1.54960266XE+04 6.47490083XE+03 2.91333527XE+03 1.34850171XE+03 8.78842864XE+02 4.58765209XE+03 7.69097285XE+02 6.34109762XE+03 2.13120350XE+03 1.22002926XE+03 6.71379810XE+03 5.78896608XE+03 2.06374173XE+04 8.87775765XE+02 5.27210954XE+02 7.54098023XE+01 3.67146197XE+02 5.91875391XE+02 8.35239334XE+02 3.27525128XE+02 2.52753455XE+03 0.00000000XE+00 3.20735196XE+02 1.33395828XE+04 1.46351007XE-01 7.49929284XE-01 5.95432860XE+02 1.09850917XE-03 4.31133757XE+02 1.01246282XE+03 6.05865902XE+02 2.75438403XE+00 3.11861045XE+02 0.00000000XE+00 2.24494076XE+04 1.32056278XE+03 0.00000000XE+00 4.62939623XE+02 1.04885356XE+03 1.02706999XE+03 1.27475102XE+03 3.31758305XE+03 2.22068086XE+02 9.09425647XE+03 1.34869659XE+04 0.00000000XE+00 3.09317173XE+02 1.73831149XE-01 1.26720511XE+01 7.91953128XE+01 1.86948956XE+03 4.87823214XE+02 1.48947739XE+03 3.28978429XE+03 4.32309982XE+02 7.16558486XE+01 7.10223059XE+03 3.67294716XE+02 7.03551553XE+02 5.93239930XE+02 1.07473252XE+03 2.86411969XE+03 4.20045237XE+03 7.67622634XE+01 1.47274502XE+03 4.98501021XE+00 3.51157119XE+04 1.38878924XE+04 5.37574716XE+02 8.50201901XE+02 7.83557257XE+02 4.21007421XE+02 5.49872161XE+01 2.62189117XE+02 3.13631624XE+01 6.95749054XE+02 2.37359241XE+03 6.53524185XE+01 4.26209506XE+00 8.93761717XE+02 3.49837841XE+02 3.11751086XE+02 2.52187590XE+03 3.74851537XE+02 3.88974786XE+04 1.28322612XE+04 8.58860429XE+04 9.29327481XE+03 1.04683127XE+02 4.84064952XE+01 1.04656315XE+03 2.42728038XE+03 2.25980138XE+02 2.05893383XE+03 1.29765757XE+01 2.86969915XE+01 0.00000000XE+00 1.46847292XE+01 1.06162717XE+02 5.08839671XE+02 6.47072048XE+02 2.00097744XE+02 1.43863022XE+02 4.01160664XE+01 5.37712365XE+01 2.14416884XE+02 3.15215603XE+01 2.40876565XE+03 1.63802347XE+02 4.18189272XE+01 2.19505989XE+02 1.40442071XE+02 6.99052270XE+02 3.42213157XE+01 8.63483961XE+00 2.03952402XE+00 1.20385236XE+02 4.36052959XE+01 5.12074688XE+04 2.41672454XE+04 2.44516345XE+05 0.00000000XE+00 2.95162353XE+04 1.32835355XE+06 1.31320728XE+01 2.92553427XE+01 3.27287452XE+03 3.70391885XE-02 1.95005695XE+04 8.04836158XE+04 3.11256827XE+04 1.07352694XE+02 2.93559236XE+04 0.00000000XE+00 1.60401039XE+06 4.21212587XE+04 0.00000000XE+00 2.11466520XE+04 5.73223130XE+04 6.47190499XE+04 9.14949649XE+04 3.23103881XE+05 1.09065232XE+04 7.35480838XE+05 1.85577161XE+06 0.00000000XE+00 4.89249310XE+03 2.20394551XE+00 5.47698309XE+02 3.92871700XE+03 9.77970846XE+04 5.65539553XE+04 9.29388636XE+04 1.27738543XE+05 4.23675490XE+04 2.76286648XE+03 5.00093218XE+04 4.44491130XE+03 4.27998050XE+04 2.56881017XE+04 5.40596496XE+04 1.29403065XE+05 1.54274900XE+05 1.03374338XE+04 5.79943146XE+04 3.92923465XE+02 8.75829676XE+04 6.24529087XE+05 5.45361334XE+04 7.22670849XE+04 1.07219139XE+05 2.23944585XE+04 2.27943701XE+03 8.70741363XE+03 1.06717888XE+03 5.19382637XE+04 2.72275278XE+04 1.48192066XE+02 1.93243182XE+02 6.00168657XE+04 1.33491462XE+04 4.64264049XE+04 3.04240700XE+05 4.04080799XE+04 1.67479844XE+06 1.08718319XE+06 2.91570992XE+05 2.58233045XE+05 1.17164803XE+04 4.57766512XE+03 6.24399708XE+04 1.27708901XE+05 1.79698828XE+04 3.45845770XE+05 2.04767347XE+03 1.85650364XE+03 0.00000000XE+00 4.78594406XE+02 5.60843428XE+03 3.20891289XE+04 4.23901973XE+04 2.32146938XE+04 8.35415031XE+03 3.96948142XE+03 2.62321298XE+03 9.46462425XE+03 3.84272249XE+03 1.26488384XE+05 1.07699566XE+04 2.39023170XE+03 2.13260030XE+04 1.73805284XE+04 1.78117052XE+04 2.77833962XE+03 1.51936478XE+03 2.16618161XE+02 3.02948340XE+03 4.16431700XE+03 3.25443835XE+04 1.28143340XE+05 1.57816052XE+05 7.05098666XE+01 4.61274152XE+03 9.38206675XE+04 4.48858242XE+00 4.57881509XE+01 1.02734765XE+04 2.92626710XE-02 1.30021686XE+04 5.56281666XE+04 6.28425877XE+04 7.38034737XE+01 8.81747456XE+03 3.61514939XE+02 1.78352129XE+05 2.47984821XE+04 0.00000000XE+00 6.87132644XE+02 4.29574310XE+04 2.83281900XE+04 1.10720191XE+05 1.66614105XE+05 1.49087768XE+04 2.02669814XE+05 6.37888286XE+04 0.00000000XE+00 4.42088549XE+03 3.25617052XE+00 4.50406821XE+04 1.81309205XE+03 1.42611158XE+05 2.76210502XE+04 1.46583527XE+05 1.10239652XE+05 1.16234217XE+04 1.83955408XE+03 1.48688997XE+05 3.98859192XE+03 4.15238120XE+04 4.29099359XE+04 1.26909230XE+05 4.69924119XE+05 1.84766739XE+05 1.16729883XE+03 2.98149589XE+04 6.36766746XE+01 3.79915620XE+06 3.91325290XE+04 2.35989076XE+04 5.41719888XE+04 3.03934181XE+04 1.75326220XE+04 7.52624943XE+03 1.00352681XE+04 8.85594593XE+04 1.69014219XE+04 7.63225880XE+04 3.67789313XE+03 7.41988060XE+03 4.21436276XE+04 1.00120501XE+04 2.55983078XE+04 1.06819381XE+05 1.41887970XE+04 3.59417103XE+05 5.74928455XE+05 2.70606387XE+05 1.90338258XE+04 1.19909726XE+04 1.46015806XE+03 3.42745825XE+04 1.19495063XE+05 7.32328916XE+03 4.01453892XE+03 1.14799245XE+05 7.07002784XE+02 7.78390233XE+03 9.20877975XE+02 2.74064536XE+03 1.60384791XE+04 4.62274686XE+04 1.45933244XE+04 5.61018723XE+03 1.37399388XE+03 2.64017773XE+03 4.89830356XE+03 8.20193472XE+03 1.40881074XE+05 2.35461012XE+04 1.71147643XE+03 1.07763319XE+04 4.69440551XE+03 2.36573689XE+04 1.69303192XE+03 4.90151027XE+02 1.26211214XE+04 8.46051110XE+03 4.90390199XE+01 1.05808303XE+02 1.45682929XE+03 1.34936998XE+02 1.45611133XE-01 5.73148423XE+01 6.71292976XE+01 5.87161758XE+00 1.58082576XE+00 3.43285095XE+01 2.12424407XE-04 8.21286154XE+02 1.55975166XE+03 1.07365579XE+03 7.22419017XE+01 2.30085555XE+02 1.38460294XE-01 4.94938674XE+01 3.68620615XE+00 0.00000000XE+00 7.27665430XE-01 1.69109951XE+02 8.98706898XE+02 5.58916309XE+02 9.28530365XE+01 1.07569175XE+01 4.57897357XE+01 1.78223429XE+01 3.01751242XE-03 2.89187835XE+01 1.76024240XE-03 1.98231305XE+02 9.08488578XE+02 2.35285607XE+02 3.09956864XE+01 5.48481628XE+01 4.23497698XE+01 7.32531379XE+00 1.15601788XE+00 6.28327260XE+02 5.88999332XE-01 8.49822727XE+01 5.64059928XE+02 3.18192343XE+02 6.75178620XE+01 1.77779681XE+03 2.35402108XE+01 8.65114629XE+02 2.03688914XE-03 5.39725246XE+03 1.76403815XE-03 1.12970704XE+02 3.48002946XE+02 2.93614097XE+02 6.11530269XE+01 2.16249759XE+02 2.30747675XE+01 1.82990165XE+01 4.48585880XE+00 6.09644191XE+00 1.79050206XE-04 7.09203659XE+01 2.78673534XE+02 5.61374743XE+02 2.63855152XE+02 8.38193629XE+00 8.50290922XE+00 5.52523771XE+01 1.08115148XE+00 2.83013296XE+02 2.70010913XE+01 2.80936911XE+02 2.24907079XE+02 1.35779044XE+03 6.72396004XE+01 9.13912913XE+01 2.26741424XE+01 6.30150791XE+00 1.01420842XE+00 1.17412980XE+00 2.85953317XE-01 2.41115445XE+02 3.25787427XE+02 5.53781010XE+02 1.39061208XE+01 1.83914803XE+02 1.16926299XE+01 1.44502426XE+00 5.48443276XE+00 1.15745341XE+00 2.32410998XE+01 2.53076140XE+01 3.44442980XE+01 1.41282483XE+02 2.61761800XE+01 7.98438297XE+02 4.33666455XE+01 2.41395652XE+00 1.63756179XE+00 1.30340414XE+00 7.15185018XE-02 8.53539373XE+03 5.57125141XE+03 3.12293506XE+02 1.38395018XE+01 4.15130514XE+03 1.56764373XE+05 6.92212848XE+01 9.93651729XE+01 1.55343211XE+01 6.49583568XE-03 4.98701181XE+03 3.68620222XE+04 5.59329080XE+04 2.89349502XE+02 9.54314122XE+03 2.01729393XE+02 5.88857499XE+05 4.33507004XE+04 0.00000000XE+00 1.08437975XE+03 2.16638261XE+04 1.26581857XE+04 1.22305884XE+05 9.83479531XE+04 1.52835922XE+04 4.56952531XE+03 1.65398897XE+05 7.45696676XE-01 5.50927914XE+01 1.09561098XE-01 4.28656293XE+04 2.18282353XE+03 1.27271196XE+04 2.79358801XE+04 3.03053368XE+04 1.33522360XE+03 7.44638259XE+04 2.95587150XE+02 1.04450570XE+02 3.04780290XE+02 1.90258946XE+04 2.40271627XE+04 9.99130689XE+02 4.27204018XE+03 3.12200657XE+03 3.27146313XE+03 1.79887670XE+04 4.47251417XE+02 7.48567003XE+01 1.63116241XE+04 8.87726710XE+03 3.59302723XE+04 1.17445340XE+04 1.61532272XE+04 1.98281927XE+03 1.87778363XE+04 2.45663931XE+05 1.60356197XE+04 5.60227288XE+03 8.83068701XE-02 3.22589428XE+03 2.03336474XE+04 5.41632080XE+03 1.50324771XE+04 7.48081350XE+04 1.31173485XE+04 8.08559457XE+04 6.73390393XE+04 1.70983254XE+02 3.05112386XE+02 3.47709414XE+03 6.79307822XE+02 2.66964625XE+04 8.04830658XE+05 7.99309047XE+03 1.75873143XE+04 1.10316567XE+03 1.50332037XE+04 0.00000000XE+00 7.05768332XE+02 1.15707001XE+03 7.17234196XE+03 5.92395645XE+04 2.88176789XE+04 7.56873621XE+03 3.08955929XE+03 4.69339915XE+04 3.66219001XE+03 2.16955905XE+02 3.79860876XE+02 1.37962558XE+03 4.74536607XE+02 2.57145104XE+03 2.49311556XE+03 7.34601004XE+03 3.60258130XE+03 6.52608928XE+02 7.08888573XE+01 6.54557643XE+01 1.59825095XE+01 3.25443835XE+04 1.28143340XE+05 1.57816052XE+05 7.05098666XE+01 4.61274152XE+03 9.38206675XE+04 4.48858242XE+00 4.57881509XE+01 1.02734765XE+04 2.92626710XE-02 1.30021686XE+04 5.56281666XE+04 6.28425877XE+04 7.38034737XE+01 8.81747456XE+03 3.61514939XE+02 1.78352129XE+05 2.47984821XE+04 0.00000000XE+00 6.87132644XE+02 4.29574310XE+04 2.83281900XE+04 1.10720191XE+05 1.66614105XE+05 1.49087768XE+04 2.02669814XE+05 6.37888286XE+04 0.00000000XE+00 4.42088549XE+03 3.25617052XE+00 4.50406821XE+04 1.81309205XE+03 1.42611158XE+05 2.76210502XE+04 1.46583527XE+05 1.10239652XE+05 1.16234217XE+04 1.83955408XE+03 1.48688997XE+05 3.98859192XE+03 4.15238120XE+04 4.29099359XE+04 1.26909230XE+05 4.69924119XE+05 1.84766739XE+05 1.16729883XE+03 2.98149589XE+04 6.36766746XE+01 3.79915620XE+06 3.91325290XE+04 2.35989076XE+04 5.41719888XE+04 3.03934181XE+04 1.75326220XE+04 7.52624943XE+03 1.00352681XE+04 8.85594593XE+04 1.69014219XE+04 7.63225880XE+04 3.67789313XE+03 7.41988060XE+03 4.21436276XE+04 1.00120501XE+04 2.55983078XE+04 1.06819381XE+05 1.41887970XE+04 3.59417103XE+05 5.74928455XE+05 2.70606387XE+05 1.90338258XE+04 1.19909726XE+04 1.46015806XE+03 3.42745825XE+04 1.19495063XE+05 7.32328916XE+03 4.01453892XE+03 1.14799245XE+05 7.07002784XE+02 7.78390233XE+03 9.20877975XE+02 2.74064536XE+03 1.60384791XE+04 4.62274686XE+04 1.45933244XE+04 5.61018723XE+03 1.37399388XE+03 2.64017773XE+03 4.89830356XE+03 8.20193472XE+03 1.40881074XE+05 2.35461012XE+04 1.71147643XE+03 1.07763319XE+04 4.69440551XE+03 2.36573689XE+04 1.69303192XE+03 4.90151027XE+02 1.26211214XE+04 8.46051110XE+03 4.90390199XE+01 6.41890518XE+04 3.35062921XE+04 1.41779183XE+05 0.00000000XE+00 1.79822563XE+04 1.02848941XE+05 4.58404636XE+00 6.54740823XE+01 3.29773202XE+04 5.77156027XE-02 2.37715705XE+04 1.11303599XE+05 2.16523491XE+04 1.60321551XE+02 1.48610981XE+04 0.00000000XE+00 1.71131421XE+05 3.34902608XE+04 0.00000000XE+00 1.19289318XE+03 8.45415222XE+04 4.90814494XE+04 1.95674890XE+05 1.45550350XE+05 2.70814781XE+04 1.75394848XE+05 1.19648262XE+05 0.00000000XE+00 1.32732971XE+04 1.03965412XE+01 4.89429947XE+02 2.64412670XE+03 1.13383308XE+05 5.33706731XE+04 2.47646872XE+05 1.21734608XE+05 1.62128268XE+04 6.27314414XE+03 4.18039121XE+05 1.27558469XE+04 8.53993269XE+04 8.67281000XE+04 1.19925941XE+05 2.75068949XE+05 2.93229344XE+05 2.85452782XE+03 6.26123559XE+04 2.25069405XE+02 5.16344064XE+06 3.00170449XE+04 4.84118785XE+04 1.07357496XE+05 6.37954449XE+04 3.00969830XE+04 2.32673077XE+03 1.63120161XE+04 2.30576785XE+03 2.91764929XE+04 1.48521240XE+05 6.84977415XE+03 2.86247846XE+02 8.31168589XE+04 1.68320616XE+04 5.08500734XE+04 9.05222012XE+04 2.50755313XE+04 2.78498744XE+05 9.02401348XE+05 4.93006558XE+05 3.00532167XE+04 4.53452074XE+03 1.86957186XE+03 3.85846931XE+04 1.04036976XE+05 1.22156547XE+04 8.84394005XE+04 5.70021737XE+02 1.36256686XE+03 0.00000000XE+00 4.21361513XE+01 4.84311758XE+03 3.33083286XE+04 8.38740208XE+04 3.02382306XE+04 1.11210533XE+04 2.34511193XE+03 3.35833780XE+03 1.60734294XE+04 9.83702727XE+02 3.62725796XE+05 1.82803608XE+04 3.48879648XE+03 2.15530706XE+04 9.04738472XE+03 3.70436999XE+04 3.33315739XE+03 4.38069528XE+02 1.75755653XE+02 1.38022536XE+04 9.79190122XE+01 1.96732836XE+04 4.96900295XE+03 1.44386873XE+02 4.11797557XE+01 1.86014406XE+03 1.11019357XE+05 3.58126254XE+00 2.55712712XE+01 4.75045182XE+03 1.50582112XE-02 6.41701376XE+03 4.38350029XE+04 6.91608178XE+04 7.27690836XE+01 4.62261718XE+03 3.26605995XE+02 3.49371173XE+05 0.00000000XE+00 0.00000000XE+00 5.06576645XE+02 2.72107549XE+04 1.49826617XE+04 1.60471172XE+05 9.13103761XE+04 1.27916132XE+04 8.85008412XE+03 2.98393438XE+04 0.00000000XE+00 1.85447898XE+03 1.51911568XE+00 5.43349621XE+04 1.49725721XE+03 1.32820949XE+04 1.88993560XE+04 1.17469024XE+04 1.23184046XE+02 4.14969252XE+00 9.38007836XE+02 1.19517536XE+05 3.18548774XE+03 3.07142832XE+04 3.52255236XE+04 5.17564022XE+02 5.78718913XE+01 2.73404927XE+05 1.28850392XE+02 1.68134644XE+04 7.78777992XE-01 3.91168763XE+05 1.24440462XE-01 1.49974396XE+04 4.16000263XE+04 1.64785199XE+04 1.02427345XE+04 1.00526855XE+03 1.26266455XE+04 9.57545047XE+02 1.73222077XE+04 7.42425021XE+03 2.28114409XE-03 5.25452770XE+03 2.98440113XE+04 5.08586178XE+03 2.11351477XE+04 1.43270984XE+04 1.47905325XE+04 8.05003002XE+04 0.00000000XE+00 3.21304544XE+05 4.77656874XE+04 5.74444729XE+03 5.21678575XE+02 1.36962259XE+04 3.10308583XE+05 3.48510314XE+03 2.68474412XE+03 2.49963151XE+01 4.92582023XE+02 0.00000000XE+00 9.42146553XE+02 1.53429741XE+03 1.13218332XE+04 3.63231722XE+04 1.07729556XE+04 4.65624490XE+03 6.23694853XE+02 7.33573388XE+01 2.77875735XE+03 3.02815114XE+02 3.49038485XE+04 2.75355040XE+03 8.25098899XE+02 6.67700142XE+03 2.31270924XE+03 1.50807072XE+04 6.14926545XE+02 2.80371148XE+02 6.44023787XE+01 3.27389411XE+02 3.43895122XE+01 3.18823571XE+02 1.72831855XE+03 1.64994632XE+02 5.85888539XE-01 4.91112423XE+01 1.53201604XE+04 4.76086415XE-01 1.76135211XE+00 2.70160769XE+02 5.74410966XE-04 1.07959353XE+03 1.19361809XE+03 7.21728404XE+02 9.52058252XE+01 3.46878326XE+02 1.82298770XE+00 5.24603533XE+03 1.07073587XE+02 0.00000000XE+00 1.79093149XE+00 3.86882546XE+02 1.34476388XE+03 1.32359372XE+03 3.50861990XE+03 7.65637705XE+01 3.11698040XE+03 2.77675857XE+03 1.41219960XE-01 1.98958770XE+02 5.02406227XE-02 2.13375139XE+02 9.54490520XE+02 1.08768234XE+03 2.95004295XE+02 1.48561118XE+02 2.18008391XE+01 8.30672649XE+01 2.01857805XE+01 3.36361925XE+03 2.90043080XE+01 2.26670502XE+02 4.59554975XE+02 3.52678127XE+02 4.00556922XE+01 5.56637393XE+03 3.05716923XE+01 6.02921624XE+01 9.44666006XE-03 2.60966600XE+04 5.80488678XE-03 2.68374883XE+02 3.41104698XE+02 1.15856839XE+03 5.57794041XE+01 1.93844329XE+02 6.35689545XE+01 9.31800943XE+00 9.35991154XE+01 3.82847130XE+02 7.12458397XE-05 8.93007067XE+01 4.79048890XE+02 7.76649042XE+02 5.35119783XE+02 7.99776677XE+01 7.44200604XE+01 4.38118910XE+03 4.44322261XE+00 8.13971306XE+04 3.61101265XE+02 4.03509155XE+02 2.89230326XE+02 1.16020876XE+03 1.32794286XE+03 1.44864372XE+02 6.18637155XE+01 1.45067156XE+01 4.63086637XE+00 3.01732226XE+01 4.61881213XE+00 3.64166383XE+02 6.11564125XE+02 9.47447071XE+02 1.06856415XE+02 2.76661352XE+02 1.04664883XE+01 7.29434056XE+01 5.21166584XE+01 3.05206084XE+01 7.16336639XE+02 1.94145832XE+02 4.99846161XE+01 2.69396321XE+02 1.24414793XE+02 1.59728645XE+03 1.07825282XE+01 2.09125884XE+01 2.90491715XE+00 4.16753393XE+01 4.31552230XE-01 5.52579151XE+04 1.61482778XE+04 2.49538423XE+02 6.55707470XE-01 3.81258558XE+03 1.28831405XE+05 2.98561567XE+01 5.81903760XE+01 3.88509469XE+01 1.33040929XE-02 4.34640101XE+03 9.83151685XE+04 9.30796699XE+04 1.99245687XE+02 1.64285937XE+04 4.48620131XE+02 4.39375913XE+05 0.00000000XE+00 0.00000000XE+00 2.28060466XE+03 1.00048066XE+05 1.12556818XE+04 5.82620948XE+04 1.00166026XE+05 2.92879929XE+04 3.67355379XE+03 7.33598672XE+04 4.21365851XE-02 1.03576220XE+01 2.48083826XE-01 2.75048291XE+03 1.86340418XE+03 1.33950088XE+04 5.58852500XE+04 4.26021194XE+04 3.80593058XE+02 4.36306934XE+01 9.76663226XE+01 7.50521868XE+02 5.72825567XE+02 6.89747566XE+04 6.23786448XE+04 7.05882374XE+02 8.77101220XE+03 1.25561969XE+04 6.14271552XE+02 8.75199009XE+01 4.01480573XE+01 2.79584983XE+04 8.78689598XE+03 5.05646780XE+04 8.21290284XE+04 6.49393121XE+04 7.70849549XE+04 1.25864812XE+03 2.65697200XE+04 2.15875506XE+05 2.45160217XE+04 9.76816797XE+03 9.68931908XE+00 9.73484545XE+03 1.18617984XE+05 3.43122868XE+03 3.23872146XE+04 2.10946513XE+04 2.00910857XE+04 8.32707310XE+04 4.01289724XE+03 1.54986414XE+03 5.98612574XE+02 3.51685940XE+03 5.62315342XE+02 2.33048635XE+04 5.89763581XE+05 1.16650061XE+04 1.31487440XE+04 1.91146255XE+02 1.46729844XE+03 0.00000000XE+00 1.22667948XE+03 2.59274560XE+03 3.64541586XE+04 9.70805513XE+04 2.68580165XE+04 7.07163450XE+03 4.48942155XE+03 1.93319758XE+03 1.84417086XE+02 9.04073532XE+02 9.48086907XE+02 5.08683265XE+03 6.55407076XE+02 1.82368367XE+04 4.57155114XE+03 6.56419393XE+03 3.20243952XE+03 5.11633526XE+02 1.01884768XE+02 6.42320720XE+00 9.52650873XE+01 2.06157542XE+04 5.22344650XE+03 1.52764958XE+02 4.33035895XE+01 1.89007780XE+03 1.10426034XE+05 3.33104882XE+00 2.92273869XE+01 5.15438375XE+03 1.67528897XE-02 7.29673174XE+03 4.39537375XE+04 6.88573041XE+04 7.93917178XE+01 4.69272496XE+03 3.28237886XE+02 3.43969076XE+05 0.00000000XE+00 0.00000000XE+00 4.89413398XE+02 2.80979534XE+04 1.55125703XE+04 1.61360045XE+05 9.11778771XE+04 1.27671735XE+04 9.48141815XE+03 2.97054056XE+04 0.00000000XE+00 2.06458411XE+03 1.49267402XE+00 5.42743696XE+04 1.53535586XE+03 1.44803509XE+04 1.86846512XE+04 1.20783929XE+04 1.29014998XE+02 4.26730758XE+00 9.50674163XE+02 1.27113617XE+05 3.16551093XE+03 3.07851615XE+04 3.55905889XE+04 4.99334942XE+02 5.85492633XE+01 2.88935933XE+05 1.41947083XE+02 1.73137712XE+04 8.07714021XE-01 4.33023014XE+05 1.29415821XE-01 1.56054395XE+04 4.13120455XE+04 1.71730730XE+04 1.01262529XE+04 1.07544468XE+03 1.31585105XE+04 9.70063940XE+02 1.72359833XE+04 7.48357631XE+03 2.64512109XE-03 5.28006421XE+03 3.05548852XE+04 5.78556096XE+03 2.12299888XE+04 1.43057186XE+04 1.48037702XE+04 8.03260123XE+04 0.00000000XE+00 3.20270322XE+05 4.80706031XE+04 6.51082609XE+03 5.49014283XE+02 1.37914781XE+04 2.99589237XE+05 3.53309952XE+03 2.50518271XE+03 2.57382595XE+01 4.97743859XE+02 0.00000000XE+00 9.47662166XE+02 1.66999191XE+03 1.13693523XE+04 3.49310893XE+04 1.09108206XE+04 4.67088645XE+03 6.11989793XE+02 7.69139814XE+01 2.85784500XE+03 3.08124629XE+02 3.50893058XE+04 2.97659627XE+03 9.31015543XE+02 7.02252195XE+03 2.46345653XE+03 1.70291053XE+04 5.63061161XE+02 3.00230260XE+02 6.48962156XE+01 3.43372392XE+02 3.51298172XE+01 6.41890518XE+04 3.35062921XE+04 1.41779183XE+05 0.00000000XE+00 1.79822563XE+04 1.02848941XE+05 4.58404636XE+00 6.54740823XE+01 3.29773202XE+04 5.77156027XE-02 2.37715705XE+04 1.11303599XE+05 2.16523491XE+04 1.60321551XE+02 1.48610981XE+04 0.00000000XE+00 1.71131421XE+05 3.34902608XE+04 0.00000000XE+00 1.19289318XE+03 8.45415222XE+04 4.90814494XE+04 1.95674890XE+05 1.45550350XE+05 2.70814781XE+04 1.75394848XE+05 1.19648262XE+05 0.00000000XE+00 1.32732971XE+04 1.03965412XE+01 4.89429947XE+02 2.64412670XE+03 1.13383308XE+05 5.33706731XE+04 2.47646872XE+05 1.21734608XE+05 1.62128268XE+04 6.27314414XE+03 4.18039121XE+05 1.27558469XE+04 8.53993269XE+04 8.67281000XE+04 1.19925941XE+05 2.75068949XE+05 2.93229344XE+05 2.85452782XE+03 6.26123559XE+04 2.25069405XE+02 5.16344064XE+06 3.00170449XE+04 4.84118785XE+04 1.07357496XE+05 6.37954449XE+04 3.00969830XE+04 2.32673077XE+03 1.63120161XE+04 2.30576785XE+03 2.91764929XE+04 1.48521240XE+05 6.84977415XE+03 2.86247846XE+02 8.31168589XE+04 1.68320616XE+04 5.08500734XE+04 9.05222012XE+04 2.50755313XE+04 2.78498744XE+05 9.02401348XE+05 4.93006558XE+05 3.00532167XE+04 4.53452074XE+03 1.86957186XE+03 3.85846931XE+04 1.04036976XE+05 1.22156547XE+04 8.84394005XE+04 5.70021737XE+02 1.36256686XE+03 0.00000000XE+00 4.21361513XE+01 4.84311758XE+03 3.33083286XE+04 8.38740208XE+04 3.02382306XE+04 1.11210533XE+04 2.34511193XE+03 3.35833780XE+03 1.60734294XE+04 9.83702727XE+02 3.62725796XE+05 1.82803608XE+04 3.48879648XE+03 2.15530706XE+04 9.04738472XE+03 3.70436999XE+04 3.33315739XE+03 4.38069528XE+02 1.75755653XE+02 1.38022536XE+04 9.79190122XE+01
	Index: trunk/share/tests/functional_tests/powheg_1.sin
	===================================================================
	--- trunk/share/tests/functional_tests/powheg_1.sin (revision 8835)
	+++ trunk/share/tests/functional_tests/powheg_1.sin (revision 8836)
	@@ -1,65 +1,63 @@
	# SINDARIN input for WHIZARD self-test
	# Testing POWHEG matching for the process ee -> tt
	# The second part of this test tests powheg matching together with a
	# separation of the real contribution into finite and singular part.

	model = SM
	?logging = true
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	openmp_num_threads = 1
	?pacify = true

	seed = 0

	wtop = 0
	mtop = 175 GeV

	?use_vamp_equivalences = false
	$loop_me_method = "dummy"
	?alphas_is_fixed = false
	?alphas_from_mz = true
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = true

	?powheg_matching = true
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_pt_min = 1
	?powheg_use_singular_jacobian = false

	-!?powheg_test_sudakov = true
	-
	# hardest jet pT
	scale = eval Pt [sort by -Pt [colored]]

	process powheg_1_p1 = E1, e1 => t, T { nlo_calculation = full }

	sqrts = 500 GeV

	integrate (powheg_1_p1) { iterations = 1:100:"gw" }

	n_events = 1
	sample_format = debug
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?write_raw = false

	simulate (powheg_1_p1)
	n_events = 2
	simulate (powheg_1_p1)

	-$real_partition_mode = "on"
	+$real_partition_mode = "singular"
	real_partition_scale = 5 GeV

	process powheg_1_p2 = E1, e1 => t, T { nlo_calculation = full }
	integrate (powheg_1_p2) { iterations = 1:100:"gw" }

	expect (integral(powheg_1_p1) == integral(powheg_1_p2))
	{tolerance = 3 * sqrt(error(powheg_1_p1)2 + error(powheg_1_p2)2)}

	simulate (powheg_1_p2)
	Index: trunk/share/tests/functional_tests/powheg_2.sin
	===================================================================
	--- trunk/share/tests/functional_tests/powheg_2.sin (revision 8835)
	+++ trunk/share/tests/functional_tests/powheg_2.sin (revision 8836)
	@@ -1,75 +1,85 @@
	# SINDARIN input for WHIZARD self-test
	# Testing POWHEG matching for the process dd -> ee

	model = SM
	?logging = true
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	openmp_num_threads = 1
	?pacify = true
	?write_raw = false

	mZ = 91.188
	mW = 80.419
	mH = 125.0
	GF = 1.16639E-5

	me = 0
	mmu = 0
	mtau = 1.777

	+ms = 0
	+mc = 0
	+mb = 0
	+
	?alphas_is_fixed = false
	?alphas_from_mz = true
	?alphas_from_lambda_qcd = false
	?alphas_from_lhapdf = false
	alphas_nf = 5
	alphas_order = 1

	-$exclude_gauge_splittings = "u:s:b:t"
	+alias pr = d:D:u:U:s:S:c:C:b:B
	+$exclude_gauge_splittings = "t"

	$method = "dummy"

	beams = p, p => pdf_builtin
	$pdf_builtin_set = "mstw2008nlo"
	sqrts = 14 TeV

	cuts = all M > 10 GeV [e1, E1]

	scale = mZ

	?combined_nlo_integration = true

	process powheg_2_p1 = d, D => e1, E1 { nlo_calculation = full }
	+process powheg_2_p2 = pr, pr => e1, E1 { nlo_calculation = full }

	-seed = 130
	+seed = 487
	! chosen to produce Born-like and real-like events, positive and negative weights.

	# Options for POWHEG matching
	## These need to be set before the integration!
	# We do not want to generate fixed order events anymore
	?fixed_order_nlo_events = false
	?unweighted = true
	# Instead we want to use POWHEG matching
	?powheg_matching = true
	# This sets up a grid required for POWHEG matching
	powheg_grid_size_xi = 10
	powheg_grid_size_y = 10
	# minimum scale for the POWHEG evolution
	powheg_pt_min = 1 GeV

	integrate (powheg_2_p1) { iterations = 1:1000:"gw" }

	## Event settings:
	-n_events = 10
	+n_events = 5

	?negative_weights = true
	?keep_failed_events = true

	sample_format = debug
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true

	simulate(powheg_2_p1)
	+
	+integrate (powheg_2_p2) { iterations = 1:1000:"gw" }
	+simulate(powheg_2_p2)
	+
	Index: trunk/share/tests/functional_tests/ref-output-quad/powheg_1.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-quad/powheg_1.ref (revision 8835)
	+++ trunk/share/tests/functional_tests/ref-output-quad/powheg_1.ref (revision 8836)
	@@ -1,723 +1,689 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	openmp_num_threads = 1
	?pacify = true
	seed = 0
	SM.wtop => 0.00000E+00
	SM.mtop => 1.75000E+02
	?use_vamp_equivalences = false
	$loop_me_method = "dummy"
	?alphas_is_fixed = false
	?alphas_from_mz = true
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = true
	?powheg_matching = true
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_pt_min = 1.00000E+00
	?powheg_use_singular_jacobian = false
	\| Process library 'powheg_1_lib': recorded process 'powheg_1_p1'
	sqrts = 5.00000E+02
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_1_lib': compiling ...
	\| Process library 'powheg_1_lib': writing makefile
	\| Process library 'powheg_1_lib': removing old files
	\| Process library 'powheg_1_lib': writing driver
	\| Process library 'powheg_1_lib': creating source code
	\| Process library 'powheg_1_lib': compiling sources
	\| Process library 'powheg_1_lib': linking
	\| Process library 'powheg_1_lib': loading
	\| Process library 'powheg_1_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process powheg_1_p1:
	\| 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 'powheg_1_p1.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p1.i3.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_1_p1'
	\| Library name = 'powheg_1_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'powheg_1_p1_i1': e+, e- => t, tbar [omega]
	\| 2: 'powheg_1_p1_i2': e+, e- => t, tbar, gl [omega], [real]
	\| 3: 'powheg_1_p1_i3': e+, e- => t, tbar [dummy], [virtual]
	\| 4: 'powheg_1_p1_i4': e+, e- => t, tbar [inactive], [subtraction]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| Using user-defined general scale.
	\| Starting integration for process 'powheg_1_p1'
	\| Integration hook: add POWHEG hook
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 1 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.682E+02 2.15E+01 4.59 0.46 45.9
	\|-----------------------------------------------------------------------------\|
	1 100 4.682E+02 2.15E+01 4.59 0.46 45.9
	\|=============================================================================\|
	n_events = 1
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?write_raw = false
	\| Starting simulation for process 'powheg_1_p1'
	\| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 2.1359E-03
	\| Events: writing to ASCII file 'powheg_1_p1.debug'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p1.pg'
	\| Grid: Mean value of the grid: 2.73542E-03
	\| Grid: Max value of the grid: 5.79027E-03
	\| Grid: Mean/Max value of the grid: 4.72416E-01
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 20.00 %
	\| Events: closing ASCII file 'powheg_1_p1.debug'
	n_events = 2
	\| Starting simulation for process 'powheg_1_p1'
	\| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 2
	\| corr. to luminosity [fb-1] = 4.2717E-03
	\| Events: writing to ASCII file 'powheg_1_p1.debug'
	\| Events: generating 2 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p1.pg'
	\| Grid: Mean value of the grid: 2.73542E-03
	\| Grid: Max value of the grid: 5.79027E-03
	\| Grid: Mean/Max value of the grid: 4.72416E-01
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 100.00 %
	\| Events: closing ASCII file 'powheg_1_p1.debug'
	-$real_partition_mode = "on"
	+$real_partition_mode = "singular"
	real_partition_scale = 5.00000E+00
	\| Process library 'powheg_1_lib': unloading
	\| Process library 'powheg_1_lib': open
	\| Process library 'powheg_1_lib': recorded process 'powheg_1_p2'
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_1_lib': compiling ...
	\| Process library 'powheg_1_lib': writing makefile
	\| Process library 'powheg_1_lib': removing old files
	\| Process library 'powheg_1_lib': writing driver
	\| Process library 'powheg_1_lib': creating source code
	\| Process library 'powheg_1_lib': compiling sources
	\| Process library 'powheg_1_lib': linking
	\| Process library 'powheg_1_lib': loading
	\| Process library 'powheg_1_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Initializing integration for process powheg_1_p2:
	\| 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 'powheg_1_p2.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p2.i3.phs'
	-\| Phase space: generating configuration ...
	-\| Phase space: ... success.
	-\| Phase space: writing configuration file 'powheg_1_p2.i5.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_1_p2'
	\| Library name = 'powheg_1_lib'
	\| Process index = 2
	\| Process components:
	\| 1: 'powheg_1_p2_i1': e+, e- => t, tbar [omega]
	\| 2: 'powheg_1_p2_i2': e+, e- => t, tbar, gl [omega], [real]
	\| 3: 'powheg_1_p2_i3': e+, e- => t, tbar [dummy], [virtual]
	\| 4: 'powheg_1_p2_i4': e+, e- => t, tbar [inactive], [subtraction]
	-\| 5: 'powheg_1_p2_i5': e+, e- => t, tbar, gl [omega], [real]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	-\| Phase space: 2 channels, 5 dimensions
	-\| Phase space: found 2 channels, collected in 1 grove.
	-\| Phase space: no equivalences between channels used.
	-\| Phase space: wood
	Warning: No cuts have been defined.
	\| Using user-defined general scale.
	+\| Starting integration for process 'powheg_1_p2'
	\| Integration hook: add POWHEG hook
	-\| Starting integration for process 'powheg_1_p2' part 'Combined'
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 1 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
	\|-----------------------------------------------------------------------------\|
	1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
	\|=============================================================================\|
	-\| Starting integration for process 'powheg_1_p2' part 'real'
	-\| Integrate: iterations = 1:100:"gw"
	-\| Integrator: 1 chains, 2 channels, 5 dimensions
	-\| Integrator: 100 initial calls, 20 bins, stratified = T
	-\| Integrator: VAMP
	-\|=============================================================================\|
	-\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	-\|=============================================================================\|
	- 1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
	-\|-----------------------------------------------------------------------------\|
	- 1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
	-\|=============================================================================\|
	-\| Integrate: sum of all components
	-\|=============================================================================\|
	-\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	-\|=============================================================================\|
	- 1 0 4.978E+02 2.90E+01 5.83 0.00 31.2
	-\|=============================================================================\|
	-tolerance = 1.08344E+02
	+tolerance = 9.87691E+01
	\| expect: success
	\| Starting simulation for process 'powheg_1_p2'
	\| Simulate: using integration grids from file 'powheg_1_p2.m1.vg'
	-\| Simulate: using integration grids from file 'powheg_1_p2.m2.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 4
	\| Simulation: requested number of events = 2
	-\| corr. to luminosity [fb-1] = 4.0174E-03
	+\| corr. to luminosity [fb-1] = 4.9309E-03
	\| Events: writing to ASCII file 'powheg_1_p2.debug'
	\| Events: generating 2 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p2.pg'
	\| Grid: Mean value of the grid: 5.27612E-04
	\| Grid: Max value of the grid: 6.09917E-03
	\| Grid: Mean/Max value of the grid: 8.65055E-02
	\| ... event sample complete.
	-\| Events: actual unweighting efficiency = 20.00 %
	+\| Events: actual unweighting efficiency = 14.29 %
	\| Events: closing ASCII file 'powheg_1_p2.debug'
	\| Summary of value checks:
	\| Failures: 0 / Total: 1
	\| There were no errors and 2 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Contents of powheg_1_p1.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.82009E-02
	Squared matrix el. (prc) = 2.82009E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 9.608533E+01 -1.236770E+02 -8.571236E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -9.608533E+01 1.236770E+02 8.571236E+01
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 8
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 250.000 96.085 -123.677 -85.712 30625.000
	4 [o] tbar 0 1 1-2 [none] 250.000 -96.085 123.677 85.712 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.82009E-02
	sqme_ref* => 2.82009E-02
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.5000000E+02; 9.6085328E+01,-1.2367700E+02,-8.5712364E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.5000000E+02;-9.6085328E+01, 1.2367700E+02, 8.5712364E+01\| 3.0625000E+04\| 4)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.76793E-02
	Squared matrix el. (prc) = 2.76793E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 1.688666E+02 3.093682E+01 -4.901007E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -1.688666E+02 -3.093682E+01 4.901007E+01
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 8
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 250.000 168.867 30.937 -49.010 30625.000
	4 [o] tbar 0 1 1-2 [none] 250.000 -168.867 -30.937 49.010 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.76793E-02
	sqme_ref* => 2.76793E-02
	event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.5000000E+02; 1.6886659E+02, 3.0936816E+01,-4.9010068E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.5000000E+02;-1.6886659E+02,-3.0936816E+01, 4.9010068E+01\| 3.0625000E+04\| 4)
	========================================================================
	Contents of powheg_1_p2.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.41607E-05
	- Squared matrix el. (prc) = 1.41607E-05
	+ Squared matrix el. (ref) = 3.51646E-02
	+ Squared matrix el. (prc) = 3.51646E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	- Selected MCI group = 2
	- Selected term = 6
	+ Selected MCI group = 1
	+ Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	- seed = 196611
	+ seed = 196610
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	- Children: 3 4 5
	+ Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	- Children: 3 4 5
	+ Children: 3 4
	Particle 3 [o] f(6)c(1 )
	- E = 2.219832E+02
	- P = -7.125693E+01 -1.137429E+02 -2.522963E+01
	+ E = 2.500000E+02
	+ P = 1.143154E+02 2.823158E+00 -1.371095E+02
	T = 3.062500000E+04
	Parents: 1 2
	- Particle 4 [o] f(-6)c(-2 )
	- E = 2.128305E+02
	- P = 1.983915E+01 1.013308E+02 6.332695E+01
	+ Particle 4 [o] f(-6)c(-1 )
	+ E = 2.500000E+02
	+ P = -1.143154E+02 -2.823158E+00 1.371095E+02
	T = 3.062500000E+04
	Parents: 1 2
	- Particle 5 [o] f(21)c(2 -1)
	- E = 6.518630E+01
	- P = 5.141778E+01 1.241207E+01 -3.809732E+01
	- T = 0.000000000E+00
	- Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	- seed = 196612
	+ seed = 196611
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	- 1 [i] e+ 0 0 [none] 3-5 250.000 0.000 0.000 250.000 0.000
	- 2 [i] e- 0 0 [none] 3-5 250.000 0.000 0.000 -250.000 0.000
	- 3 [o] t 1 0 1-2 [none] 221.983 -71.257 -113.743 -25.230 30625.000
	- 4 [o] tbar 0 2 1-2 [none] 212.831 19.839 101.331 63.327 30625.000
	- 5 [o] gl 2 1 1-2 [none] 65.186 51.418 12.412 -38.097 0.000
	+ 1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	+ 2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	+ 3 [o] t 1 0 1-2 [none] 250.000 114.315 2.823 -137.110 30625.000
	+ 4 [o] tbar 0 1 1-2 [none] 250.000 -114.315 -2.823 137.110 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	-n_out* => 3
	-n_tot* => 5
	+n_out* => 2
	+n_tot* => 4
	$process_id* => "powheg_1_p2"
	process_num_id* => [unknown integer]
	-sqme* => 1.41607E-05
	-sqme_ref* => 1.41607E-05
	+sqme* => 3.51646E-02
	+sqme_ref* => 3.51646E-02
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	- 3 prt(o:6\| 2.2198318E+02;-7.1256929E+01,-1.1374290E+02,-2.5229632E+01\| 3.0625000E+04\| 3)
	- 4 prt(o:-6\| 2.1283052E+02; 1.9839145E+01, 1.0133083E+02, 6.3326954E+01\| 3.0625000E+04\| 4)
	- 5 prt(o:21\| 6.5186300E+01; 5.1417783E+01, 1.2412066E+01,-3.8097321E+01\| 0.0000000E+00\| 5)
	+ 3 prt(o:6\| 2.5000000E+02; 1.1431539E+02, 2.8231580E+00,-1.3710953E+02\| 3.0625000E+04\| 3)
	+ 4 prt(o:-6\| 2.5000000E+02;-1.1431539E+02,-2.8231580E+00, 1.3710953E+02\| 3.0625000E+04\| 4)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 3.51646E-02
	- Squared matrix el. (prc) = 3.51646E-02
	- Event weight (ref) = 1.00000E+00
	- Event weight (prc) = 1.00000E+00
	+ Squared matrix el. (ref) = -1.50114E-02
	+ Squared matrix el. (prc) = -1.50114E-02
	+ Event weight (ref) = -1.00000E+00
	+ Event weight (prc) = -1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	- seed = 196611
	+ seed = 196610
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	- P = 1.143154E+02 2.823158E+00 -1.371095E+02
	+ P = 1.134181E+01 5.748522E+01 -1.686470E+02
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	- P = -1.143154E+02 -2.823158E+00 1.371095E+02
	+ P = -1.134181E+01 -5.748522E+01 1.686470E+02
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	- seed = 196612
	+ seed = 196611
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	- 3 [o] t 1 0 1-2 [none] 250.000 114.315 2.823 -137.110 30625.000
	- 4 [o] tbar 0 1 1-2 [none] 250.000 -114.315 -2.823 137.110 30625.000
	+ 3 [o] t 1 0 1-2 [none] 250.000 11.342 57.485 -168.647 30625.000
	+ 4 [o] tbar 0 1 1-2 [none] 250.000 -11.342 -57.485 168.647 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p2"
	process_num_id* => [unknown integer]
	-sqme* => 3.51646E-02
	-sqme_ref* => 3.51646E-02
	+sqme* => -1.50114E-02
	+sqme_ref* => -1.50114E-02
	event_index* => 2
	-event_weight* => 1.00000E+00
	-event_weight_ref* => 1.00000E+00
	+event_weight* => -1.00000E+00
	+event_weight_ref* => -1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	- 3 prt(o:6\| 2.5000000E+02; 1.1431539E+02, 2.8231580E+00,-1.3710953E+02\| 3.0625000E+04\| 3)
	- 4 prt(o:-6\| 2.5000000E+02;-1.1431539E+02,-2.8231580E+00, 1.3710953E+02\| 3.0625000E+04\| 4)
	+ 3 prt(o:6\| 2.5000000E+02; 1.1341807E+01, 5.7485218E+01,-1.6864701E+02\| 3.0625000E+04\| 3)
	+ 4 prt(o:-6\| 2.5000000E+02;-1.1341807E+01,-5.7485218E+01, 1.6864701E+02\| 3.0625000E+04\| 4)
	========================================================================
	Contents of powheg_1_p1.pg:
	3
	5 5 2
	5.790270664E-03 4.340796144E-03 3.956052276E-03 3.268282917E-03 2.051663009E-03 5.483522583E-03 4.862867872E-03 3.083117535E-03 1.719170940E-03 1.731060881E-03 4.642896596E-03 4.089381443E-03 3.278082860E-03 2.072774722E-03 0.000000000E+00 4.285081627E-03 2.703041105E-03 1.939545192E-03 1.808207863E-03 4.832500064E-04 1.725229895E-03 1.848230090E-03 1.666841567E-03 8.779276888E-04 5.973720333E-04 5.658021589E-03 4.797607918E-03 3.691638808E-03 2.563335143E-03 1.517565363E-03 5.487405766E-03 4.496579173E-03 3.894360742E-03 2.025323977E-03 2.321871929E-03 4.723771507E-03 3.748862492E-03 2.983344600E-03 2.071276052E-03 0.000000000E+00 4.306592486E-03 2.873724641E-03 2.416448613E-03 1.437407351E-03 9.061702789E-04 1.847228600E-03 1.615352727E-03 1.894685168E-03 7.407161766E-04 4.468087712E-04
	Contents of powheg_1_p2.pg:
	3
	5 5 2
	6.095586898E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 3.638456151E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 2.295080905E-03 7.908640172E-04 3.287241452E-04 0.000000000E+00 4.113171730E-05 6.099168393E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 3.638549329E-03 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 2.236533404E-03 8.480152143E-04 3.249849498E-04 0.000000000E+00 4.348341527E-05
	Index: trunk/share/tests/functional_tests/ref-output-quad/powheg_2.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-quad/powheg_2.ref (revision 8835)
	+++ trunk/share/tests/functional_tests/ref-output-quad/powheg_2.ref (revision 8836)
	@@ -1,1578 +1,1671 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	openmp_num_threads = 1
	?pacify = true
	?write_raw = false
	SM.mZ => 9.11880E+01
	SM.mW => 8.04190E+01
	SM.mH => 1.25000E+02
	SM.GF => 1.16639E-05
	SM.me => 0.00000E+00
	SM.mmu => 0.00000E+00
	SM.mtau => 1.77700E+00
	+SM.ms => 0.00000E+00
	+SM.mc => 0.00000E+00
	+SM.mb => 0.00000E+00
	?alphas_is_fixed = false
	?alphas_from_mz = true
	?alphas_from_lambda_qcd = false
	?alphas_from_lhapdf = false
	alphas_nf = 5
	alphas_order = 1
	-$exclude_gauge_splittings = "u:s:b:t"
	+[user variable] pr = PDG(1, -1, 2, -2, 3, -3, 4, -4, 5, -5)
	+$exclude_gauge_splittings = "t"
	$method = "dummy"
	$pdf_builtin_set = "mstw2008nlo"
	sqrts = 1.40000E+04
	?combined_nlo_integration = true
	\| Process library 'powheg_2_lib': recorded process 'powheg_2_p1'
	-seed = 130
	+\| Process library 'powheg_2_lib': recorded process 'powheg_2_p2'
	+seed = 487
	?fixed_order_nlo_events = false
	?unweighted = true
	?powheg_matching = true
	powheg_grid_size_xi = 10
	powheg_grid_size_y = 10
	powheg_pt_min = 1.00000E+00
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_2_lib': compiling ...
	\| Process library 'powheg_2_lib': writing makefile
	\| Process library 'powheg_2_lib': removing old files
	\| Process library 'powheg_2_lib': writing driver
	\| Process library 'powheg_2_lib': creating source code
	\| Process library 'powheg_2_lib': compiling sources
	\| Process library 'powheg_2_lib': linking
	\| Process library 'powheg_2_lib': loading
	\| Process library 'powheg_2_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	-\| RNG: Setting seed for random-number generator to 130
	+\| RNG: Setting seed for random-number generator to 487
	\| Initializing integration for process powheg_2_p1:
	\| Beam structure: p, p => pdf_builtin
	\| Beam data (collision):
	\| p (mass = 0.0000000E+00 GeV)
	\| p (mass = 0.0000000E+00 GeV)
	\| sqrts = 1.400000000000E+04 GeV
	\| Initialized builtin PDF MSTW2008NLO
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_2_p1.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_2_p1.i3.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_2_p1'
	\| Library name = 'powheg_2_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'powheg_2_p1_i1': d, dbar => e-, e+ [dummy]
	\| 2: 'powheg_2_p1_i2': d:gl, dbar:gl => e-, e+, gl:d:dbar [dummy], [real]
	\| 3: 'powheg_2_p1_i3': d, dbar => e-, e+ [dummy], [virtual]
	\| 4: 'powheg_2_p1_i4': d, dbar => e-, e+ [inactive], [subtraction]
	\| 5: 'powheg_2_p1_i5': d, dbar => e-, e+ [dummy], [dglap]
	\| ------------------------------------------------------------------------
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Beam structure: pdf_builtin, none => none, pdf_builtin
	\| Beam structure: 2 channels, 2 dimensions
	\| Applying user-defined cuts.
	\| Using user-defined general scale.
	\| Starting integration for process 'powheg_2_p1'
	\| Integration hook: add POWHEG hook
	\| Shower: interfacing PDF builtin set #8
	\| Integrate: iterations = 1:1000:"gw"
	\| Integrator: 2 chains, 2 channels, 7 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 1000 1.073E+10 4.88E+09 45.52 14.39 0.4
	+ 1 1000 2.223E+09 5.00E+08 22.48 7.11 0.8
	\|-----------------------------------------------------------------------------\|
	- 1 1000 1.073E+10 4.88E+09 45.52 14.39 0.4
	+ 1 1000 2.223E+09 5.00E+08 22.48 7.11 0.8
	\|=============================================================================\|
	-n_events = 10
	+n_events = 5
	?negative_weights = true
	?keep_failed_events = true
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	\| Starting simulation for process 'powheg_2_p1'
	\| Simulate: using integration grids from file 'powheg_2_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: interfacing PDF builtin set #8
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	-\| RNG: Setting seed for random-number generator to 131
	-\| Simulation: requested number of events = 10
	-\| corr. to luminosity [fb-1] = 9.3197E-10
	+\| RNG: Setting seed for random-number generator to 488
	+\| Simulation: requested number of events = 5
	+\| corr. to luminosity [fb-1] = 2.2496E-09
	\| Events: writing to ASCII file 'powheg_2_p1.debug'
	-\| Events: generating 10 unweighted, unpolarized events ...
	+\| Events: generating 5 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_2_p1.pg'
	-\| Grid: Mean value of the grid: 7.15782E+03
	-\| Grid: Max value of the grid: 1.18402E+05
	-\| Grid: Mean/Max value of the grid: 6.04533E-02
	+\| Grid: Mean value of the grid: 9.69764E+03
	+\| Grid: Max value of the grid: 4.48803E+05
	+\| Grid: Mean/Max value of the grid: 2.16078E-02
	\| ... event sample complete.
	-\| Events: actual unweighting efficiency = 0.34 %
	-Warning: Encountered events with excess weight: 4 events ( 40.000 %)
	-\| Maximum excess weight = 1.722E+01
	-\| Average excess weight = 1.950E+00
	+\| Events: actual unweighting efficiency = 1.46 %
	+Warning: Encountered events with excess weight: 2 events ( 40.000 %)
	+\| Maximum excess weight = 2.106E+01
	+\| Average excess weight = 5.062E+00
	\| Events: closing ASCII file 'powheg_2_p1.debug'
	-\| There were no errors and 1 warning(s).
	+\| QCD alpha: using a running strong coupling
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 489
	+\| Initializing integration for process powheg_2_p2:
	+\| Beam structure: p, p => pdf_builtin
	+\| Beam data (collision):
	+\| p (mass = 0.0000000E+00 GeV)
	+\| p (mass = 0.0000000E+00 GeV)
	+\| sqrts = 1.400000000000E+04 GeV
	+\| Phase space: generating configuration ...
	+\| Phase space: ... success.
	+\| Phase space: writing configuration file 'powheg_2_p2.i1.phs'
	+\| Phase space: generating configuration ...
	+\| Phase space: ... success.
	+\| Phase space: writing configuration file 'powheg_2_p2.i3.phs'
	+\| ------------------------------------------------------------------------
	+\| Process [scattering]: 'powheg_2_p2'
	+\| Library name = 'powheg_2_lib'
	+\| Process index = 2
	+\| Process components:
	+\| 1: 'powheg_2_p2_i1': d:dbar:u:ubar:s:sbar:c:cbar:b:bbar, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar => e-, e+ [dummy]
	+\| 2: 'powheg_2_p2_i2': gl:dbar:d:ubar:u:sbar:s:cbar:c:bbar:b:dbar:d:ubar:u:sbar:s:cbar:c:bbar:b, dbar:d:ubar:u:sbar:s:cbar:c:bbar:b:gl:dbar:d:ubar:u:sbar:s:cbar:c:bbar:b => e-, e+, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar:d:dbar:u:ubar:s:sbar:c:cbar:b:bbar:gl [dummy], [real]
	+\| 3: 'powheg_2_p2_i3': d:dbar:u:ubar:s:sbar:c:cbar:b:bbar, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar => e-, e+ [dummy], [virtual]
	+\| 4: 'powheg_2_p2_i4': d:dbar:u:ubar:s:sbar:c:cbar:b:bbar, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar => e-, e+ [inactive], [subtraction]
	+\| 5: 'powheg_2_p2_i5': d:dbar:u:ubar:s:sbar:c:cbar:b:bbar, d:dbar:u:ubar:s:sbar:c:cbar:b:bbar => e-, e+ [dummy], [dglap]
	+\| ------------------------------------------------------------------------
	+\| Phase space: 2 channels, 5 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Phase space: 2 channels, 5 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Phase space: 2 channels, 5 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Phase space: 2 channels, 5 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Beam structure: pdf_builtin, none => none, pdf_builtin
	+\| Beam structure: 2 channels, 2 dimensions
	+\| Applying user-defined cuts.
	+\| Using user-defined general scale.
	+\| Starting integration for process 'powheg_2_p2'
	+\| Integration hook: add POWHEG hook
	+\| Shower: interfacing PDF builtin set #8
	+\| Integrate: iterations = 1:1000:"gw"
	+\| Integrator: 2 chains, 2 channels, 7 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 1000 5.130E+10 2.21E+10 43.06 13.62 0.4
	+\|-----------------------------------------------------------------------------\|
	+ 1 1000 5.130E+10 2.21E+10 43.06 13.62 0.4
	+\|=============================================================================\|
	+\| Starting simulation for process 'powheg_2_p2'
	+\| Simulate: using integration grids from file 'powheg_2_p2.m1.vg'
	+\| Simulate: activating parton shower
	+\| Shower: interfacing PDF builtin set #8
	+\| Shower: Using WHIZARD internal shower
	+\| Simulate: applying POWHEG matching
	+\| QCD alpha: using a running strong coupling
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 490
	+\| Simulation: requested number of events = 5
	+\| corr. to luminosity [fb-1] = 9.7474E-11
	+\| Events: writing to ASCII file 'powheg_2_p2.debug'
	+\| Events: generating 5 unweighted, unpolarized events ...
	+\| Events: event normalization mode '1'
	+\| POWHEG: using grids from file 'powheg_2_p2.pg'
	+\| Grid: Mean value of the grid: 4.13447E+04
	+\| Grid: Max value of the grid: 5.16344E+06
	+\| Grid: Mean/Max value of the grid: 8.00719E-03
	+\| ... event sample complete.
	+\| Events: actual unweighting efficiency = 0.45 %
	+Warning: Encountered events with excess weight: 1 events ( 20.000 %)
	+\| Maximum excess weight = 2.022E+00
	+\| Average excess weight = 4.045E-01
	+\| Events: closing ASCII file 'powheg_2_p2.debug'
	+\| There were no errors and 2 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Contents of powheg_2_p1.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.73082E+07
	- Squared matrix el. (prc) = 1.73082E+07
	- Event weight (ref) = 1.00000E+00
	- Event weight (prc) = 1.00000E+00
	+ Squared matrix el. (ref) = -1.02633E+06
	+ Squared matrix el. (prc) = -1.02633E+06
	+ Event weight (ref) = -1.00000E+00
	+ Event weight (prc) = -1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 6.899492E+02
	- P = 0.000000E+00 0.000000E+00 6.899492E+02
	+ E = 4.144810E+00
	+ P = 0.000000E+00 0.000000E+00 4.144810E+00
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 4.215047E-01
	- P = 0.000000E+00 0.000000E+00 -4.215047E-01
	+ E = 1.701568E+01
	+ P = 0.000000E+00 0.000000E+00 -1.701568E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.310051E+03
	- P = 0.000000E+00 0.000000E+00 6.310051E+03
	+ E = 6.995855E+03
	+ P = 0.000000E+00 0.000000E+00 6.995855E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.999578E+03
	- P = 0.000000E+00 0.000000E+00 -6.999578E+03
	+ E = 6.982984E+03
	+ P = 0.000000E+00 0.000000E+00 -6.982984E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 6.087387E+02
	- P = -9.888752E+00 -4.804441E+00 6.086394E+02
	+ E = 6.597124E+00
	+ P = -5.692672E+00 -3.332077E+00 1.130586E-01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 8.163209E+01
	- P = 9.888752E+00 4.804441E+00 8.088837E+01
	+ E = 1.456337E+01
	+ P = 5.692672E+00 3.332077E+00 -1.298393E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 689.949 0.000 0.000 689.949 0.000
	- 4 [i] dbar 0 0 2 7-8 0.422 0.000 0.000 -0.422 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6310.051 0.000 0.000 6310.051 0.000
	- 6 [x] hr3 0 0 2 [none] 6999.578 0.000 0.000 -6999.578 0.000
	- 7 [o] e- 0 0 3-4 [none] 608.739 -9.889 -4.804 608.639 0.000
	- 8 [o] e+ 0 0 3-4 [none] 81.632 9.889 4.804 80.888 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 690.371 0.000 0.000 689.528
	-Sum of beam remnant momenta: p(0:3) = 13309.629 0.000 0.000 -689.528
	-Sum of outgoing momenta: p(0:3) = 690.371 0.000 0.000 689.528
	+ 3 [i] d 0 0 1 7-8 4.145 0.000 0.000 4.145 0.000
	+ 4 [i] dbar 0 0 2 7-8 17.016 0.000 0.000 -17.016 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6995.855 0.000 0.000 6995.855 0.000
	+ 6 [x] hr3 0 0 2 [none] 6982.984 0.000 0.000 -6982.984 0.000
	+ 7 [o] e- 0 0 3-4 [none] 6.597 -5.693 -3.332 0.113 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 14.563 5.693 3.332 -12.984 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 21.160 0.000 0.000 -12.871
	+Sum of beam remnant momenta: p(0:3) = 13978.840 0.000 0.000 12.871
	+Sum of outgoing momenta: p(0:3) = 21.160 0.000 0.000 -12.871
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 3.41067E+01
	+sqrts_hat* => 1.67960E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 1.73082E+07
	-sqme_ref* => 1.73082E+07
	+sqme* => -1.02633E+06
	+sqme_ref* => -1.02633E+06
	event_index* => 1
	-event_weight* => 1.00000E+00
	-event_weight_ref* => 1.00000E+00
	-event_excess* => 2.70702E-01
	+event_weight* => -1.00000E+00
	+event_weight_ref* => -1.00000E+00
	+event_excess* => 4.24812E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-6.8994924E+02; 0.0000000E+00, 0.0000000E+00,-6.8994924E+02\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-4.2150470E-01; 0.0000000E+00, 0.0000000E+00, 4.2150470E-01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.3100508E+03; 0.0000000E+00, 0.0000000E+00, 6.3100508E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9995785E+03; 0.0000000E+00, 0.0000000E+00,-6.9995785E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.0873866E+02;-9.8887519E+00,-4.8044408E+00, 6.0863937E+02\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 8.1632087E+01; 9.8887519E+00, 4.8044408E+00, 8.0888365E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-4.1448102E+00; 0.0000000E+00, 0.0000000E+00,-4.1448102E+00\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-1.7015683E+01; 0.0000000E+00, 0.0000000E+00, 1.7015683E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9958552E+03; 0.0000000E+00, 0.0000000E+00, 6.9958552E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9829843E+03; 0.0000000E+00, 0.0000000E+00,-6.9829843E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 6.5971236E+00;-5.6926722E+00,-3.3320775E+00, 1.1305860E-01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 1.4563369E+01; 5.6926722E+00, 3.3320775E+00,-1.2983931E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 2.00716E+06
	- Squared matrix el. (prc) = 2.00716E+06
	+ Squared matrix el. (ref) = 1.56786E+07
	+ Squared matrix el. (prc) = 1.56786E+07
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 1.446225E+03
	- P = 0.000000E+00 0.000000E+00 1.446225E+03
	+ E = 4.777759E-01
	+ P = 0.000000E+00 0.000000E+00 4.777759E-01
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 1.042581E+01
	- P = 0.000000E+00 0.000000E+00 -1.042581E+01
	+ E = 4.041187E+02
	+ P = 0.000000E+00 0.000000E+00 -4.041187E+02
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 5.553775E+03
	- P = 0.000000E+00 0.000000E+00 5.553775E+03
	+ E = 6.999522E+03
	+ P = 0.000000E+00 0.000000E+00 6.999522E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.989574E+03
	- P = 0.000000E+00 0.000000E+00 -6.989574E+03
	+ E = 6.595881E+03
	+ P = 0.000000E+00 0.000000E+00 -6.595881E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 5.692890E+02
	- P = -1.196264E+02 5.256740E+00 5.565536E+02
	+ E = 3.631332E+02
	+ P = -8.208406E+00 -1.754884E+00 -3.630361E+02
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 8.873620E+02
	- P = 1.196264E+02 -5.256740E+00 8.792458E+02
	+ E = 4.146331E+01
	+ P = 8.208406E+00 1.754884E+00 -4.060478E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 1446.225 0.000 0.000 1446.225 0.000
	- 4 [i] dbar 0 0 2 7-8 10.426 0.000 0.000 -10.426 0.000
	- 5 [x] hr3bar 0 0 1 [none] 5553.775 0.000 0.000 5553.775 0.000
	- 6 [x] hr3 0 0 2 [none] 6989.574 0.000 0.000 -6989.574 0.000
	- 7 [o] e- 0 0 3-4 [none] 569.289 -119.626 5.257 556.554 0.000
	- 8 [o] e+ 0 0 3-4 [none] 887.362 119.626 -5.257 879.246 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 1456.651 0.000 0.000 1435.799
	-Sum of beam remnant momenta: p(0:3) = 12543.349 0.000 0.000 -1435.799
	-Sum of outgoing momenta: p(0:3) = 1456.651 0.000 0.000 1435.799
	+ 3 [i] d 0 0 1 7-8 0.478 0.000 0.000 0.478 0.000
	+ 4 [i] dbar 0 0 2 7-8 404.119 0.000 0.000 -404.119 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6999.522 0.000 0.000 6999.522 0.000
	+ 6 [x] hr3 0 0 2 [none] 6595.881 0.000 0.000 -6595.881 0.000
	+ 7 [o] e- 0 0 3-4 [none] 363.133 -8.208 -1.755 -363.036 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 41.463 8.208 1.755 -40.605 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 404.596 0.000 0.000 -403.641
	+Sum of beam remnant momenta: p(0:3) = 13595.404 0.000 0.000 403.641
	+Sum of outgoing momenta: p(0:3) = 404.596 0.000 0.000 -403.641
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 2.45586E+02
	+sqrts_hat* => 2.77905E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 2.00716E+06
	-sqme_ref* => 2.00716E+06
	+sqme* => 1.56786E+07
	+sqme_ref* => 1.56786E+07
	event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	-event_excess* => 0.00000E+00
	+event_excess* => 2.10630E+01
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.4462252E+03; 0.0000000E+00, 0.0000000E+00,-1.4462252E+03\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-1.0425811E+01; 0.0000000E+00, 0.0000000E+00, 1.0425811E+01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 5.5537748E+03; 0.0000000E+00, 0.0000000E+00, 5.5537748E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9895742E+03; 0.0000000E+00, 0.0000000E+00,-6.9895742E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 5.6928904E+02;-1.1962638E+02, 5.2567405E+00, 5.5655360E+02\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 8.8736197E+02; 1.1962638E+02,-5.2567405E+00, 8.7924579E+02\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-4.7777590E-01; 0.0000000E+00, 0.0000000E+00,-4.7777590E-01\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-4.0411871E+02; 0.0000000E+00, 0.0000000E+00, 4.0411871E+02\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9995222E+03; 0.0000000E+00, 0.0000000E+00, 6.9995222E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.5958813E+03; 0.0000000E+00, 0.0000000E+00,-6.5958813E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 3.6313317E+02;-8.2084060E+00,-1.7548845E+00,-3.6303615E+02\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 4.1463310E+01; 8.2084060E+00, 1.7548845E+00,-4.0604784E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	Event #3
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 2.38562E+07
	- Squared matrix el. (prc) = 2.38562E+07
	+ Squared matrix el. (ref) = 1.40236E+07
	+ Squared matrix el. (prc) = 1.40236E+07
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 9
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 8.712482E+01
	- P = 0.000000E+00 0.000000E+00 8.712482E+01
	+ E = 2.289819E+02
	+ P = 0.000000E+00 0.000000E+00 2.289819E+02
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 3.936136E+00
	- P = 0.000000E+00 0.000000E+00 -3.936136E+00
	+ E = 7.287631E+00
	+ P = 0.000000E+00 0.000000E+00 -7.287631E+00
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.912875E+03
	- P = 0.000000E+00 0.000000E+00 6.912875E+03
	+ E = 6.771018E+03
	+ P = 0.000000E+00 0.000000E+00 6.771018E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.996064E+03
	- P = 0.000000E+00 0.000000E+00 -6.996064E+03
	+ E = 6.992712E+03
	+ P = 0.000000E+00 0.000000E+00 -6.992712E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 5.371039E+01
	- P = 1.850581E+00 -1.806232E+01 5.054833E+01
	+ E = 1.673149E+02
	+ P = -2.049955E+01 -3.033179E+01 1.632606E+02
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 3.735057E+01
	- P = -1.850581E+00 1.806232E+01 3.264036E+01
	+ E = 6.895466E+01
	+ P = 2.049955E+01 3.033179E+01 5.843369E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 3
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 87.125 0.000 0.000 87.125 0.000
	- 4 [i] dbar 0 0 2 7-8 3.936 0.000 0.000 -3.936 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6912.875 0.000 0.000 6912.875 0.000
	- 6 [x] hr3 0 0 2 [none] 6996.064 0.000 0.000 -6996.064 0.000
	- 7 [o] e- 0 0 3-4 [none] 53.710 1.851 -18.062 50.548 0.000
	- 8 [o] e+ 0 0 3-4 [none] 37.351 -1.851 18.062 32.640 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 91.061 0.000 0.000 83.189
	-Sum of beam remnant momenta: p(0:3) = 13908.939 0.000 0.000 -83.189
	-Sum of outgoing momenta: p(0:3) = 91.061 0.000 0.000 83.189
	+ 3 [i] d 0 0 1 7-8 228.982 0.000 0.000 228.982 0.000
	+ 4 [i] dbar 0 0 2 7-8 7.288 0.000 0.000 -7.288 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6771.018 0.000 0.000 6771.018 0.000
	+ 6 [x] hr3 0 0 2 [none] 6992.712 0.000 0.000 -6992.712 0.000
	+ 7 [o] e- 0 0 3-4 [none] 167.315 -20.500 -30.332 163.261 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 68.955 20.500 30.332 58.434 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 236.270 0.000 0.000 221.694
	+Sum of beam remnant momenta: p(0:3) = 13763.730 0.000 0.000 -221.694
	+Sum of outgoing momenta: p(0:3) = 236.270 0.000 0.000 221.694
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 3.70370E+01
	+sqrts_hat* => 8.17003E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 2.38562E+07
	-sqme_ref* => 2.38562E+07
	+sqme* => 1.40236E+07
	+sqme_ref* => 1.40236E+07
	event_index* => 3
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	-event_excess* => 4.63589E-01
	+event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-8.7124821E+01; 0.0000000E+00, 0.0000000E+00,-8.7124821E+01\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-3.9361364E+00; 0.0000000E+00, 0.0000000E+00, 3.9361364E+00\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9128752E+03; 0.0000000E+00, 0.0000000E+00, 6.9128752E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9960639E+03; 0.0000000E+00, 0.0000000E+00,-6.9960639E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 5.3710386E+01; 1.8505811E+00,-1.8062325E+01, 5.0548327E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 3.7350571E+01;-1.8505811E+00, 1.8062325E+01, 3.2640357E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-2.2898188E+02; 0.0000000E+00, 0.0000000E+00,-2.2898188E+02\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-7.2876314E+00; 0.0000000E+00, 0.0000000E+00, 7.2876314E+00\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.7710181E+03; 0.0000000E+00, 0.0000000E+00, 6.7710181E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9927124E+03; 0.0000000E+00, 0.0000000E+00,-6.9927124E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 1.6731485E+02;-2.0499548E+01,-3.0331794E+01, 1.6326056E+02\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 6.8954662E+01; 2.0499548E+01, 3.0331794E+01, 5.8433691E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	Event #4
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.48421E+07
	- Squared matrix el. (prc) = 1.48421E+07
	+ Squared matrix el. (ref) = 5.08214E+06
	+ Squared matrix el. (prc) = 5.08214E+06
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 12
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 1.939732E+02
	- P = 0.000000E+00 0.000000E+00 1.939732E+02
	+ E = 5.930977E+01
	+ P = 0.000000E+00 0.000000E+00 5.930977E+01
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 4.051484E+00
	- P = 0.000000E+00 0.000000E+00 -4.051484E+00
	+ E = 3.380226E+01
	+ P = 0.000000E+00 0.000000E+00 -3.380226E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.806027E+03
	- P = 0.000000E+00 0.000000E+00 6.806027E+03
	+ E = 6.940690E+03
	+ P = 0.000000E+00 0.000000E+00 6.940690E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.995949E+03
	- P = 0.000000E+00 0.000000E+00 -6.995949E+03
	+ E = 6.966198E+03
	+ P = 0.000000E+00 0.000000E+00 -6.966198E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 1.889687E+02
	- P = -8.729125E+00 -2.109992E+00 1.887552E+02
	+ E = 4.975970E+01
	+ P = -3.488349E+01 -2.571858E+01 2.444840E+01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 9.055960E+00
	- P = 8.729125E+00 2.109992E+00 1.166507E+00
	+ E = 4.335233E+01
	+ P = 3.488349E+01 2.571858E+01 1.059111E+00
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 4
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 193.973 0.000 0.000 193.973 0.000
	- 4 [i] dbar 0 0 2 7-8 4.051 0.000 0.000 -4.051 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6806.027 0.000 0.000 6806.027 0.000
	- 6 [x] hr3 0 0 2 [none] 6995.949 0.000 0.000 -6995.949 0.000
	- 7 [o] e- 0 0 3-4 [none] 188.969 -8.729 -2.110 188.755 0.000
	- 8 [o] e+ 0 0 3-4 [none] 9.056 8.729 2.110 1.167 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 198.025 0.000 0.000 189.922
	-Sum of beam remnant momenta: p(0:3) = 13801.975 0.000 0.000 -189.922
	-Sum of outgoing momenta: p(0:3) = 198.025 0.000 0.000 189.922
	+ 3 [i] d 0 0 1 7-8 59.310 0.000 0.000 59.310 0.000
	+ 4 [i] dbar 0 0 2 7-8 33.802 0.000 0.000 -33.802 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6940.690 0.000 0.000 6940.690 0.000
	+ 6 [x] hr3 0 0 2 [none] 6966.198 0.000 0.000 -6966.198 0.000
	+ 7 [o] e- 0 0 3-4 [none] 49.760 -34.883 -25.719 24.448 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 43.352 34.883 25.719 1.059 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 93.112 0.000 0.000 25.508
	+Sum of beam remnant momenta: p(0:3) = 13906.888 0.000 0.000 -25.508
	+Sum of outgoing momenta: p(0:3) = 93.112 0.000 0.000 25.508
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 5.60671E+01
	+sqrts_hat* => 8.95501E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 1.48421E+07
	-sqme_ref* => 1.48421E+07
	+sqme* => 5.08214E+06
	+sqme_ref* => 5.08214E+06
	event_index* => 4
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.9397318E+02; 0.0000000E+00, 0.0000000E+00,-1.9397318E+02\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-4.0514843E+00; 0.0000000E+00, 0.0000000E+00, 4.0514843E+00\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.8060268E+03; 0.0000000E+00, 0.0000000E+00, 6.8060268E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9959485E+03; 0.0000000E+00, 0.0000000E+00,-6.9959485E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 1.8896870E+02;-8.7291246E+00,-2.1099918E+00, 1.8875519E+02\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 9.0559605E+00; 8.7291246E+00, 2.1099918E+00, 1.1665068E+00\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-5.9309772E+01; 0.0000000E+00, 0.0000000E+00,-5.9309772E+01\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-3.3802260E+01; 0.0000000E+00, 0.0000000E+00, 3.3802260E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9406902E+03; 0.0000000E+00, 0.0000000E+00, 6.9406902E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9661977E+03; 0.0000000E+00, 0.0000000E+00,-6.9661977E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 4.9759698E+01;-3.4883490E+01,-2.5718579E+01, 2.4448401E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 4.3352335E+01; 3.4883490E+01, 2.5718579E+01, 1.0591113E+00\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	Event #5
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.12189E+07
	- Squared matrix el. (prc) = 1.12189E+07
	+ Squared matrix el. (ref) = 3.14741E+06
	+ Squared matrix el. (prc) = 3.14741E+06
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519682
	+ seed = 31916034
	calls = 15
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 2.299967E+00
	- P = 0.000000E+00 0.000000E+00 2.299967E+00
	+ E = 1.411403E+03
	+ P = 0.000000E+00 0.000000E+00 1.411403E+03
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 1.055385E+02
	- P = 0.000000E+00 0.000000E+00 -1.055385E+02
	+ E = 6.193471E+00
	+ P = 0.000000E+00 0.000000E+00 -6.193471E+00
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.997700E+03
	- P = 0.000000E+00 0.000000E+00 6.997700E+03
	+ E = 5.588597E+03
	+ P = 0.000000E+00 0.000000E+00 5.588597E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.894461E+03
	- P = 0.000000E+00 0.000000E+00 -6.894461E+03
	+ E = 6.993807E+03
	+ P = 0.000000E+00 0.000000E+00 -6.993807E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 6.359252E+01
	- P = -1.344828E+00 -1.524474E+01 -6.172356E+01
	+ E = 2.523280E+02
	+ P = -4.531771E+01 5.475505E+01 2.421107E+02
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 4.424595E+01
	- P = 1.344828E+00 1.524474E+01 -4.151498E+01
	+ E = 1.165269E+03
	+ P = 4.531771E+01 -5.475505E+01 1.163099E+03
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_2_p1'
	TAO random-number generator:
	- seed = 8519683
	+ seed = 31916035
	calls = 5
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 2.300 0.000 0.000 2.300 0.000
	- 4 [i] dbar 0 0 2 7-8 105.539 0.000 0.000 -105.539 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6997.700 0.000 0.000 6997.700 0.000
	- 6 [x] hr3 0 0 2 [none] 6894.461 0.000 0.000 -6894.461 0.000
	- 7 [o] e- 0 0 3-4 [none] 63.593 -1.345 -15.245 -61.724 0.000
	- 8 [o] e+ 0 0 3-4 [none] 44.246 1.345 15.245 -41.515 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 107.838 0.000 0.000 -103.239
	-Sum of beam remnant momenta: p(0:3) = 13892.162 0.000 0.000 103.239
	-Sum of outgoing momenta: p(0:3) = 107.838 0.000 0.000 -103.239
	+ 3 [i] gl 0 1 1 7-8 2194.094 0.000 0.000 2194.094 0.000
	+ 4 [i] dbar 0 0 2 7-8 19.305 0.000 0.000 -19.305 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 5588.597 0.000 0.000 5588.597 0.000
	+ 6 [x] hr3 0 0 2 [none] 6993.807 0.000 0.000 -6993.807 0.000
	+ 7 [o] e- 0 0 3-4 [none] 311.604 -81.086 0.376 300.869 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 1462.247 3.793 -117.886 1457.482 0.000
	+ 9 [o] dbar 0 1 3-4 [none] 439.549 77.293 117.510 416.438 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 2213.400 0.000 0.000 2174.789
	+Sum of beam remnant momenta: p(0:3) = 12582.403 0.000 0.000 -1405.210
	+Sum of outgoing momenta: p(0:3) = 2213.400 0.000 0.000 2174.789
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 3.11599E+01
	+sqrts_hat* => 4.11621E+02
	n_in* => 2
	-n_out* => 4
	-n_tot* => 6
	+n_out* => 5
	+n_tot* => 7
	$process_id* => "powheg_2_p1"
	process_num_id* => [unknown integer]
	-sqme* => 1.12189E+07
	-sqme_ref* => 1.12189E+07
	+sqme* => 3.14741E+06
	+sqme_ref* => 3.14741E+06
	event_index* => 5
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-2.2999667E+00; 0.0000000E+00, 0.0000000E+00,-2.2999667E+00\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-1.0553851E+02; 0.0000000E+00, 0.0000000E+00, 1.0553851E+02\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9977000E+03; 0.0000000E+00, 0.0000000E+00, 6.9977000E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.8944615E+03; 0.0000000E+00, 0.0000000E+00,-6.8944615E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.3592525E+01;-1.3448283E+00,-1.5244744E+01,-6.1723565E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 4.4245950E+01; 1.3448283E+00, 1.5244744E+01,-4.1514977E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:21\|-2.1940945E+03; 0.0000000E+00, 0.0000000E+00,-2.1940945E+03\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-1.9305463E+01; 0.0000000E+00, 0.0000000E+00, 1.9305463E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 5.5885968E+03; 0.0000000E+00, 0.0000000E+00, 5.5885968E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9938065E+03; 0.0000000E+00, 0.0000000E+00,-6.9938065E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 3.1160379E+02;-8.1085635E+01, 3.7616812E-01, 3.0086858E+02\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 1.4622468E+03; 3.7929365E+00,-1.1788620E+02, 1.4574821E+03\| 0.0000000E+00\| 8)
	+ 9 prt(o:-1\| 4.3954937E+02; 7.7292699E+01, 1.1751003E+02, 4.1643833E+02\| 0.0000000E+00\| 9)
	========================================================================
	+Contents of powheg_2_p1.pg:
	+ 3
	+ 10 10 3
	+ 9.36377257XE+02 1.27014741XE+03 7.12222177XE+02 5.07011266XE+02 1.58749958XE+02 1.68256557XE+02 2.04915785XE+04 2.28789515XE+01 0.00000000XE+00 3.35535033XE-01 3.74922360XE+02 3.41570022XE+02 3.42219318XE+02 8.83085517XE+02 3.74067159XE+02 0.00000000XE+00 4.33586467XE+01 3.46136758XE+03 1.05220451XE+01 5.10677999XE+02 4.87293085XE+01 1.85394224XE+03 7.66401188XE+02 4.36910286XE+02 7.32149252XE+00 1.65926331XE+01 0.00000000XE+00 5.09150960XE+02 0.00000000XE+00 3.90881039XE-01 3.21479907XE+02 1.22859050XE+03 1.30321734XE+03 9.35995276XE+02 8.78442315XE+01 3.22652660XE+02 3.16403250XE-02 1.61173392XE+01 3.07645475XE-01 2.30893094XE-01 6.70812708XE+02 9.05752792XE+02 8.89378818XE+02 1.60866366XE+02 7.18468198XE+02 0.00000000XE+00 2.68929718XE-02 1.79687358XE+04 1.95251995XE+03 0.00000000XE+00 4.38341251XE+02 3.64932577XE+02 8.51062784XE+02 7.37261343XE+00 8.09800625XE+03 3.56291593XE+00 5.31629268XE+00 1.14766153XE+00 3.06511689XE+01 1.71717974XE+03 1.38910665XE+02 9.10591454XE+02 4.48805134XE+02 4.79915338XE+02 4.61034745XE+02 1.91231663XE+02 3.14357545XE+00 1.11847499XE-01 1.50597886XE+00 2.44719775XE-01 1.18396536XE+02 4.83959668XE+02 6.96477771XE+02 1.08227376XE+04 1.49336914XE+02 1.50931140XE+02 3.67336752XE+02 4.26851425XE+02 1.15543956XE+01 1.65875325XE-04 1.96947342XE+02 9.54018714XE+02 4.80477608XE+02 3.48280682XE+02 3.80277350XE+01 8.23228325XE+01 2.24929848XE+02 1.77461733XE+01 1.87405578XE+01 1.22158024XE+02 4.55641586XE+01 2.53844481XE+02 2.80608916XE+02 1.63073516XE+02 4.61520328XE+00 3.97538267XE+01 3.91394676XE-01 1.12920582XE+02 5.78903320XE-01 2.67928199XE+02 2.59939177XE+04 5.51963277XE+04 5.50676449XE+04 3.30863190XE+03 5.52732276XE+03 1.06809073XE+03 7.46852435XE+04 1.29824158XE+04 0.00000000XE+00 1.02588764XE+01 1.58867468XE+04 3.12931621XE+04 1.56391320XE+04 2.01683087XE+04 9.98403245XE+03 0.00000000XE+00 8.95046873XE+03 2.06560727XE+05 1.08234211XE+02 4.74778517XE+04 8.76973796XE+02 1.46595179XE+05 1.57310302XE+04 2.86003734XE+04 1.47286819XE+02 5.06101869XE+03 0.00000000XE+00 1.68235091XE+04 0.00000000XE+00 2.36848495XE+00 2.95677805XE+04 1.16029950XE+04 9.07304825XE+04 6.91457882XE+04 1.93435468XE+04 2.22261751XE+04 7.39509391XE-01 1.47627990XE+02 1.92706752XE+01 2.17768486XE+00 1.00642504XE+05 3.69719030XE+04 6.34531317XE+04 7.75383943XE+03 4.44561447XE+04 0.00000000XE+00 3.87635318XE+03 5.04119350XE+04 1.29470488XE+04 0.00000000XE+00 4.43619684XE+04 3.43722982XE+04 1.75125514XE+04 2.53147685XE+02 2.16560539XE+05 7.31396905XE+01 2.40454289XE+03 7.91847889XE+00 9.04023324XE+02 5.96366845XE+03 8.99351913XE+03 3.64205275XE+04 1.93248018XE+04 8.17541395XE+03 1.75234411XE+04 1.62807182XE+04 2.22402590XE+01 2.51831370XE+00 1.03842429XE+02 1.12047608XE+02 6.32425279XE+03 2.86584387XE+04 6.48296465XE+04 4.48803110XE+05 1.01682331XE+04 1.06414315XE+04 2.20477767XE+03 1.43412322XE+04 4.59390834XE+02 3.52899962XE-03 2.28558396XE+04 7.49840124XE+04 4.12386847XE+04 7.96273903XE+04 9.97734630XE+03 7.86230446XE+03 3.61980253XE+04 1.04974794XE+03 5.81383233XE+02 2.76254428XE+02 9.93509749XE+02 3.37010266XE+04 1.34246297XE+04 1.20502906XE+04 1.37759140XE+03 1.16831230XE+03 1.90767377XE+01 4.79967608XE+03 3.75005201XE+01 2.09319171XE+03 1.04230151XE+03 7.07802466XE+02 1.19405284XE+03 7.53277771XE+02 1.05969258XE+02 5.76209011XE+01 1.12237063XE+04 9.12227210XE+01 0.00000000XE+00 7.38412148XE-01 5.00502435XE+02 2.45820208XE+02 2.11455406XE+02 3.33390142XE+02 6.97003435XE+03 0.00000000XE+00 1.34340613XE+01 8.79923011XE+03 3.50906078XE+01 1.08950411XE+03 7.14175226XE+01 9.19865098XE+02 6.75782827XE+02 1.40738867XE+02 5.40666455XE+01 6.94314634XE+00 0.00000000XE+00 1.53917825XE+02 0.00000000XE+00 2.13462243XE+00 1.76861768XE+02 1.27182719XE+03 4.37140868XE+02 9.43675595XE+02 3.21933586XE+02 1.69537210XE+03 6.14216696XE-02 1.28819974XE+02 1.92305696XE+00 5.29673279XE-01 8.26189435XE+02 1.58499797XE+03 6.59699829XE+02 2.04384899XE+03 6.68001896XE+03 0.00000000XE+00 5.35014779XE-01 6.58557245XE+03 6.09543469XE+02 0.00000000XE+00 1.06687885XE+03 1.51550231XE+02 6.74906543XE+02 9.18931511XE+01 6.21968392XE+03 2.27383952XE+00 2.23677960XE+00 2.41910174XE+00 8.19895417XE+01 7.16327510XE+02 1.06894927XE+02 4.38286328XE+02 2.63507739XE+02 2.34650745XE+02 2.34215421XE+02 6.15300644XE+01 8.20697421XE+01 6.38001656XE-02 2.00097989XE+01 6.14291672XE-01 2.43086577XE+02 2.54858335XE+02 7.95447781XE+02 3.98389036XE+03 1.27467209XE+02 5.71429927XE+01 2.95906390XE+03 1.71427929XE+03 4.21716095XE+01 5.75844961XE-04 7.20590664XE+02 1.70503083XE+03 1.69564145XE+03 4.76608274XE+02 4.18132003XE+01 1.30822425XE+03 1.30235064XE+03 1.15360014XE+02 1.29196293XE+01 7.71026896XE+01 1.53353062XE+02 2.14527431XE+02 9.07102528XE+02 5.74566237XE+01 1.11835787XE+01 4.70031054XE+01 6.60728706XE-01 8.40923244XE+01 1.34318239XE+00 4.31199246XE+02
	+Contents of powheg_2_p2.debug:
	========================================================================
	- Event #6
	+ Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = -7.01417E+06
	- Squared matrix el. (prc) = -7.01417E+06
	- Event weight (ref) = -1.00000E+00
	- Event weight (prc) = -1.00000E+00
	+ Squared matrix el. (ref) = 1.97921E+08
	+ Squared matrix el. (prc) = 1.97921E+08
	+ Event weight (ref) = 1.00000E+00
	+ Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	- Selected channel = 2
	+ Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 18
	+ seed = 32047106
	+ calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	- Particle 3 [i] f(1)
	- E = 6.920607E+00
	- P = 0.000000E+00 0.000000E+00 6.920607E+00
	+ Particle 3 [i] f(2)
	+ E = 5.136964E+00
	+ P = 0.000000E+00 0.000000E+00 5.136964E+00
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	- Particle 4 [i] f(-1)
	- E = 6.366500E+00
	- P = 0.000000E+00 0.000000E+00 -6.366500E+00
	+ Particle 4 [i] f(-2)
	+ E = 5.762733E+01
	+ P = 0.000000E+00 0.000000E+00 -5.762733E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.993079E+03
	- P = 0.000000E+00 0.000000E+00 6.993079E+03
	+ E = 6.994863E+03
	+ P = 0.000000E+00 0.000000E+00 6.994863E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.993634E+03
	- P = 0.000000E+00 0.000000E+00 -6.993634E+03
	+ E = 6.942373E+03
	+ P = 0.000000E+00 0.000000E+00 -6.942373E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 6.520088E+00
	- P = 2.767436E+00 5.258452E+00 -2.683566E+00
	+ E = 3.629243E+01
	+ P = 4.503508E-01 -1.689570E+01 -3.211656E+01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 6.767019E+00
	- P = -2.767436E+00 -5.258452E+00 3.237673E+00
	+ E = 2.647186E+01
	+ P = -4.503508E-01 1.689570E+01 -2.037381E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 6
	+ seed = 32047107
	+ calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 6.921 0.000 0.000 6.921 0.000
	- 4 [i] dbar 0 0 2 7-8 6.366 0.000 0.000 -6.366 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6993.079 0.000 0.000 6993.079 0.000
	- 6 [x] hr3 0 0 2 [none] 6993.634 0.000 0.000 -6993.634 0.000
	- 7 [o] e- 0 0 3-4 [none] 6.520 2.767 5.258 -2.684 0.000
	- 8 [o] e+ 0 0 3-4 [none] 6.767 -2.767 -5.258 3.238 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 13.287 0.000 0.000 0.554
	-Sum of beam remnant momenta: p(0:3) = 13986.713 0.000 0.000 -0.554
	-Sum of outgoing momenta: p(0:3) = 13.287 0.000 0.000 0.554
	+ 3 [i] u 0 0 1 7-8 5.137 0.000 0.000 5.137 0.000
	+ 4 [i] ubar 0 0 2 7-8 57.627 0.000 0.000 -57.627 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6994.863 0.000 0.000 6994.863 0.000
	+ 6 [x] hr3 0 0 2 [none] 6942.373 0.000 0.000 -6942.373 0.000
	+ 7 [o] e- 0 0 3-4 [none] 36.292 0.450 -16.896 -32.117 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 26.472 -0.450 16.896 -20.374 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 62.764 0.000 0.000 -52.490
	+Sum of beam remnant momenta: p(0:3) = 13937.236 0.000 0.000 52.490
	+Sum of outgoing momenta: p(0:3) = 62.764 0.000 0.000 -52.490
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 1.32755E+01
	+sqrts_hat* => 3.44110E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	-$process_id* => "powheg_2_p1"
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => -7.01417E+06
	-sqme_ref* => -7.01417E+06
	-event_index* => 6
	-event_weight* => -1.00000E+00
	-event_weight_ref* => -1.00000E+00
	-event_excess* => 1.54959E+00
	+sqme* => 1.97921E+08
	+sqme_ref* => 1.97921E+08
	+event_index* => 1
	+event_weight* => 1.00000E+00
	+event_weight_ref* => 1.00000E+00
	+event_excess* => 2.02245E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-6.9206073E+00; 0.0000000E+00, 0.0000000E+00,-6.9206073E+00\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-6.3664998E+00; 0.0000000E+00, 0.0000000E+00, 6.3664998E+00\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9930794E+03; 0.0000000E+00, 0.0000000E+00, 6.9930794E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9936335E+03; 0.0000000E+00, 0.0000000E+00,-6.9936335E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.5200879E+00; 2.7674357E+00, 5.2584523E+00,-2.6835658E+00\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 6.7670193E+00;-2.7674357E+00,-5.2584523E+00, 3.2376733E+00\| 0.0000000E+00\| 8)
	+ 3 prt(i:2\|-5.1369640E+00; 0.0000000E+00, 0.0000000E+00,-5.1369640E+00\| 0.0000000E+00\| 3)
	+ 4 prt(i:-2\|-5.7627330E+01; 0.0000000E+00, 0.0000000E+00, 5.7627330E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9948630E+03; 0.0000000E+00, 0.0000000E+00, 6.9948630E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9423727E+03; 0.0000000E+00, 0.0000000E+00,-6.9423727E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 3.6292433E+01; 4.5035076E-01,-1.6895697E+01,-3.2116558E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 2.6471861E+01;-4.5035076E-01, 1.6895697E+01,-2.0373808E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	- Event #7
	+ Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 4.68463E+07
	- Squared matrix el. (prc) = 4.68463E+07
	+ Squared matrix el. (ref) = 9.22764E+06
	+ Squared matrix el. (prc) = 9.22764E+06
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	- Selected channel = 2
	+ Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 21
	+ seed = 32047106
	+ calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 5.667369E-01
	- P = 0.000000E+00 0.000000E+00 5.667369E-01
	+ E = 1.899744E-01
	+ P = 0.000000E+00 0.000000E+00 1.899744E-01
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 7.081701E+01
	- P = 0.000000E+00 0.000000E+00 -7.081701E+01
	+ E = 1.454586E+03
	+ P = 0.000000E+00 0.000000E+00 -1.454586E+03
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.999433E+03
	- P = 0.000000E+00 0.000000E+00 6.999433E+03
	+ E = 6.999810E+03
	+ P = 0.000000E+00 0.000000E+00 6.999810E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.929183E+03
	- P = 0.000000E+00 0.000000E+00 -6.929183E+03
	+ E = 5.545414E+03
	+ P = 0.000000E+00 0.000000E+00 -5.545414E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 6.467810E+01
	- P = 2.796685E+00 -2.231923E+00 -6.457905E+01
	+ E = 7.434569E+01
	+ P = -4.000748E+00 -6.121976E+00 -7.398512E+01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 6.705646E+00
	- P = -2.796685E+00 2.231923E+00 -5.671222E+00
	+ E = 1.380430E+03
	+ P = 4.000748E+00 6.121976E+00 -1.380411E+03
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 7
	+ seed = 32047107
	+ calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 0.567 0.000 0.000 0.567 0.000
	- 4 [i] dbar 0 0 2 7-8 70.817 0.000 0.000 -70.817 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6999.433 0.000 0.000 6999.433 0.000
	- 6 [x] hr3 0 0 2 [none] 6929.183 0.000 0.000 -6929.183 0.000
	- 7 [o] e- 0 0 3-4 [none] 64.678 2.797 -2.232 -64.579 0.000
	- 8 [o] e+ 0 0 3-4 [none] 6.706 -2.797 2.232 -5.671 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 71.384 0.000 0.000 -70.250
	-Sum of beam remnant momenta: p(0:3) = 13928.616 0.000 0.000 70.250
	-Sum of outgoing momenta: p(0:3) = 71.384 0.000 0.000 -70.250
	+ 3 [i] d 0 0 1 7-8 0.190 0.000 0.000 0.190 0.000
	+ 4 [i] dbar 0 0 2 7-8 1454.586 0.000 0.000 -1454.586 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6999.810 0.000 0.000 6999.810 0.000
	+ 6 [x] hr3 0 0 2 [none] 5545.414 0.000 0.000 -5545.414 0.000
	+ 7 [o] e- 0 0 3-4 [none] 74.346 -4.001 -6.122 -73.985 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 1380.430 4.001 6.122 -1380.411 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1454.776 0.000 0.000 -1454.396
	+Sum of beam remnant momenta: p(0:3) = 12545.224 0.000 0.000 1454.396
	+Sum of outgoing momenta: p(0:3) = 1454.776 0.000 0.000 -1454.396
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 1.26704E+01
	+sqrts_hat* => 3.32466E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	-$process_id* => "powheg_2_p1"
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => 4.68463E+07
	-sqme_ref* => 4.68463E+07
	-event_index* => 7
	+sqme* => 9.22764E+06
	+sqme_ref* => 9.22764E+06
	+event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	-event_excess* => 1.72180E+01
	+event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-5.6673690E-01; 0.0000000E+00, 0.0000000E+00,-5.6673690E-01\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-7.0817012E+01; 0.0000000E+00, 0.0000000E+00, 7.0817012E+01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9994333E+03; 0.0000000E+00, 0.0000000E+00, 6.9994333E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9291830E+03; 0.0000000E+00, 0.0000000E+00,-6.9291830E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 6.4678103E+01; 2.7966851E+00,-2.2319227E+00,-6.4579053E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 6.7056461E+00;-2.7966851E+00, 2.2319227E+00,-5.6712224E+00\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-1.8997443E-01; 0.0000000E+00, 0.0000000E+00,-1.8997443E-01\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-1.4545857E+03; 0.0000000E+00, 0.0000000E+00, 1.4545857E+03\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9998100E+03; 0.0000000E+00, 0.0000000E+00, 6.9998100E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 5.5454143E+03; 0.0000000E+00, 0.0000000E+00,-5.5454143E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 7.4345695E+01;-4.0007478E+00,-6.1219761E+00,-7.3985118E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 1.3804300E+03; 4.0007478E+00, 6.1219761E+00,-1.3804106E+03\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	- Event #8
	+ Event #3
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.47022E+07
	- Squared matrix el. (prc) = 1.47022E+07
	+ Squared matrix el. (ref) = 3.30803E+07
	+ Squared matrix el. (prc) = 3.30803E+07
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	- Selected channel = 2
	+ Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 24
	+ seed = 32047106
	+ calls = 9
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	- Particle 3 [i] f(1)
	- E = 1.748870E+01
	- P = 0.000000E+00 0.000000E+00 1.748870E+01
	+ Particle 3 [i] f(2)
	+ E = 3.284086E+02
	+ P = 0.000000E+00 0.000000E+00 3.284086E+02
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	- Particle 4 [i] f(-1)
	- E = 6.169637E+01
	- P = 0.000000E+00 0.000000E+00 -6.169637E+01
	+ Particle 4 [i] f(-2)
	+ E = 2.154928E+01
	+ P = 0.000000E+00 0.000000E+00 -2.154928E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.982511E+03
	- P = 0.000000E+00 0.000000E+00 6.982511E+03
	+ E = 6.671591E+03
	+ P = 0.000000E+00 0.000000E+00 6.671591E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.938304E+03
	- P = 0.000000E+00 0.000000E+00 -6.938304E+03
	+ E = 6.978451E+03
	+ P = 0.000000E+00 0.000000E+00 -6.978451E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 2.709141E+01
	- P = 2.658050E+01 -5.228591E+00 2.882695E-01
	+ E = 1.674570E+02
	+ P = 5.460604E+01 -6.386031E+01 1.448513E+02
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 5.209366E+01
	- P = -2.658050E+01 5.228591E+00 -4.449594E+01
	+ E = 1.825009E+02
	+ P = -5.460604E+01 6.386031E+01 1.620080E+02
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 8
	+ seed = 32047107
	+ calls = 3
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 17.489 0.000 0.000 17.489 0.000
	- 4 [i] dbar 0 0 2 7-8 61.696 0.000 0.000 -61.696 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6982.511 0.000 0.000 6982.511 0.000
	- 6 [x] hr3 0 0 2 [none] 6938.304 0.000 0.000 -6938.304 0.000
	- 7 [o] e- 0 0 3-4 [none] 27.091 26.581 -5.229 0.288 0.000
	- 8 [o] e+ 0 0 3-4 [none] 52.094 -26.581 5.229 -44.496 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 79.185 0.000 0.000 -44.208
	-Sum of beam remnant momenta: p(0:3) = 13920.815 0.000 0.000 44.208
	-Sum of outgoing momenta: p(0:3) = 79.185 0.000 0.000 -44.208
	+ 3 [i] u 0 0 1 7-8 328.409 0.000 0.000 328.409 0.000
	+ 4 [i] ubar 0 0 2 7-8 21.549 0.000 0.000 -21.549 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6671.591 0.000 0.000 6671.591 0.000
	+ 6 [x] hr3 0 0 2 [none] 6978.451 0.000 0.000 -6978.451 0.000
	+ 7 [o] e- 0 0 3-4 [none] 167.457 54.606 -63.860 144.851 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 182.501 -54.606 63.860 162.008 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 349.958 0.000 0.000 306.859
	+Sum of beam remnant momenta: p(0:3) = 13650.042 0.000 0.000 -306.859
	+Sum of outgoing momenta: p(0:3) = 349.958 0.000 0.000 306.859
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 6.56959E+01
	+sqrts_hat* => 1.68249E+02
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	-$process_id* => "powheg_2_p1"
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => 1.47022E+07
	-sqme_ref* => 1.47022E+07
	-event_index* => 8
	+sqme* => 3.30803E+07
	+sqme_ref* => 3.30803E+07
	+event_index* => 3
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.7488700E+01; 0.0000000E+00, 0.0000000E+00,-1.7488700E+01\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-6.1696367E+01; 0.0000000E+00, 0.0000000E+00, 6.1696367E+01\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.9825113E+03; 0.0000000E+00, 0.0000000E+00, 6.9825113E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9383036E+03; 0.0000000E+00, 0.0000000E+00,-6.9383036E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 2.7091406E+01; 2.6580500E+01,-5.2285908E+00, 2.8826949E-01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 5.2093661E+01;-2.6580500E+01, 5.2285908E+00,-4.4495937E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:2\|-3.2840858E+02; 0.0000000E+00, 0.0000000E+00,-3.2840858E+02\| 0.0000000E+00\| 3)
	+ 4 prt(i:-2\|-2.1549277E+01; 0.0000000E+00, 0.0000000E+00, 2.1549277E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.6715914E+03; 0.0000000E+00, 0.0000000E+00, 6.6715914E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9784507E+03; 0.0000000E+00, 0.0000000E+00,-6.9784507E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 1.6745700E+02; 5.4606036E+01,-6.3860309E+01, 1.4485126E+02\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 1.8250085E+02;-5.4606036E+01, 6.3860309E+01, 1.6200803E+02\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	- Event #9
	+ Event #4
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 1.35334E+07
	- Squared matrix el. (prc) = 1.35334E+07
	+ Squared matrix el. (ref) = 3.22507E+07
	+ Squared matrix el. (prc) = 3.22507E+07
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 2
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 27
	+ seed = 32047106
	+ calls = 12
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	Particle 3 [i] f(1)
	- E = 1.067593E+02
	- P = 0.000000E+00 0.000000E+00 1.067593E+02
	+ E = 1.157900E+02
	+ P = 0.000000E+00 0.000000E+00 1.157900E+02
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	Particle 4 [i] f(-1)
	- E = 8.464686E+00
	- P = 0.000000E+00 0.000000E+00 -8.464686E+00
	+ E = 8.366189E+00
	+ P = 0.000000E+00 0.000000E+00 -8.366189E+00
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.893241E+03
	- P = 0.000000E+00 0.000000E+00 6.893241E+03
	+ E = 6.884210E+03
	+ P = 0.000000E+00 0.000000E+00 6.884210E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.991535E+03
	- P = 0.000000E+00 0.000000E+00 -6.991535E+03
	+ E = 6.991634E+03
	+ P = 0.000000E+00 0.000000E+00 -6.991634E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 3.781862E+01
	- P = 1.174670E+01 -2.488222E+01 2.594491E+01
	+ E = 4.529865E+01
	+ P = 1.670697E+01 -2.439383E+01 3.431889E+01
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 7.740532E+01
	- P = -1.174670E+01 2.488222E+01 7.234966E+01
	+ E = 7.885752E+01
	+ P = -1.670697E+01 2.439383E+01 7.310490E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 9
	+ seed = 32047107
	+ calls = 4
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 106.759 0.000 0.000 106.759 0.000
	- 4 [i] dbar 0 0 2 7-8 8.465 0.000 0.000 -8.465 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6893.241 0.000 0.000 6893.241 0.000
	- 6 [x] hr3 0 0 2 [none] 6991.535 0.000 0.000 -6991.535 0.000
	- 7 [o] e- 0 0 3-4 [none] 37.819 11.747 -24.882 25.945 0.000
	- 8 [o] e+ 0 0 3-4 [none] 77.405 -11.747 24.882 72.350 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 115.224 0.000 0.000 98.295
	-Sum of beam remnant momenta: p(0:3) = 13884.776 0.000 0.000 -98.295
	-Sum of outgoing momenta: p(0:3) = 115.224 0.000 0.000 98.295
	+ 3 [i] d 0 0 1 7-8 115.790 0.000 0.000 115.790 0.000
	+ 4 [i] dbar 0 0 2 7-8 8.366 0.000 0.000 -8.366 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6884.210 0.000 0.000 6884.210 0.000
	+ 6 [x] hr3 0 0 2 [none] 6991.634 0.000 0.000 -6991.634 0.000
	+ 7 [o] e- 0 0 3-4 [none] 45.299 16.707 -24.394 34.319 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 78.858 -16.707 24.394 73.105 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 124.156 0.000 0.000 107.424
	+Sum of beam remnant momenta: p(0:3) = 13875.844 0.000 0.000 -107.424
	+Sum of outgoing momenta: p(0:3) = 124.156 0.000 0.000 107.424
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 6.01227E+01
	+sqrts_hat* => 6.22486E+01
	n_in* => 2
	n_out* => 4
	n_tot* => 6
	-$process_id* => "powheg_2_p1"
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => 1.35334E+07
	-sqme_ref* => 1.35334E+07
	-event_index* => 9
	+sqme* => 3.22507E+07
	+sqme_ref* => 3.22507E+07
	+event_index* => 4
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.0675926E+02; 0.0000000E+00, 0.0000000E+00,-1.0675926E+02\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-8.4646859E+00; 0.0000000E+00, 0.0000000E+00, 8.4646859E+00\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.8932407E+03; 0.0000000E+00, 0.0000000E+00, 6.8932407E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9915353E+03; 0.0000000E+00, 0.0000000E+00,-6.9915353E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 3.7818625E+01; 1.1746697E+01,-2.4882224E+01, 2.5944911E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 7.7405319E+01;-1.1746697E+01, 2.4882224E+01, 7.2349661E+01\| 0.0000000E+00\| 8)
	+ 3 prt(i:1\|-1.1578998E+02; 0.0000000E+00, 0.0000000E+00,-1.1578998E+02\| 0.0000000E+00\| 3)
	+ 4 prt(i:-1\|-8.3661890E+00; 0.0000000E+00, 0.0000000E+00, 8.3661890E+00\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.8842100E+03; 0.0000000E+00, 0.0000000E+00, 6.8842100E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9916338E+03; 0.0000000E+00, 0.0000000E+00,-6.9916338E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 4.5298654E+01; 1.6706971E+01,-2.4393826E+01, 3.4318893E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 7.8857517E+01;-1.6706971E+01, 2.4393826E+01, 7.3104900E+01\| 0.0000000E+00\| 8)
	========================================================================
	========================================================================
	- Event #10
	+ Event #5
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	- Squared matrix el. (ref) = 6.32254E+06
	- Squared matrix el. (prc) = 6.32254E+06
	+ Squared matrix el. (ref) = 1.32591E+08
	+ Squared matrix el. (prc) = 1.32591E+08
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	- Selected channel = 2
	+ Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519682
	- calls = 30
	+ seed = 32047106
	+ calls = 15
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 7.000000E+03
	T = 0.000000000E+00
	Children: 3 5
	Particle 2 [b] f(2212)
	E = 7.000000E+03
	P = 0.000000E+00 0.000000E+00 -7.000000E+03
	T = 0.000000000E+00
	Children: 4 6
	- Particle 3 [i] f(1)
	- E = 3.840213E+02
	- P = 0.000000E+00 0.000000E+00 3.840213E+02
	+ Particle 3 [i] f(4)
	+ E = 4.109889E+01
	+ P = 0.000000E+00 0.000000E+00 4.109889E+01
	T = 0.000000000E+00
	Parents: 1
	Children: 7 8
	- Particle 4 [i] f(-1)
	- E = 2.304886E+01
	- P = 0.000000E+00 0.000000E+00 -2.304886E+01
	+ Particle 4 [i] f(-4)
	+ E = 1.548717E+01
	+ P = 0.000000E+00 0.000000E+00 -1.548717E+01
	T = 0.000000000E+00
	Parents: 2
	Children: 7 8
	Particle 5 [x] f(-92*)
	- E = 6.615979E+03
	- P = 0.000000E+00 0.000000E+00 6.615979E+03
	+ E = 6.958901E+03
	+ P = 0.000000E+00 0.000000E+00 6.958901E+03
	T = 0.000000000E+00
	Parents: 1
	Particle 6 [x] f(92*)
	- E = 6.976951E+03
	- P = 0.000000E+00 0.000000E+00 -6.976951E+03
	+ E = 6.984513E+03
	+ P = 0.000000E+00 0.000000E+00 -6.984513E+03
	T = 0.000000000E+00
	Parents: 2
	Particle 7 [o] f(11)
	- E = 1.317678E+02
	- P = -7.259226E+01 4.671327E+01 9.955395E+01
	+ E = 2.427756E+01
	+ P = 2.050577E+01 1.238692E+01 3.934155E+00
	T = 0.000000000E+00
	Parents: 3 4
	Particle 8 [o] f(-11)
	- E = 2.753024E+02
	- P = 7.259226E+01 -4.671327E+01 2.614185E+02
	+ E = 3.230850E+01
	+ P = -2.050577E+01 -1.238692E+01 2.167757E+01
	T = 0.000000000E+00
	Parents: 3 4
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	- Associated process: 'powheg_2_p1'
	+ Associated process: 'powheg_2_p2'
	TAO random-number generator:
	- seed = 8519683
	- calls = 10
	+ seed = 32047107
	+ calls = 5
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] p 0 0 [none] 3,5 7000.000 0.000 0.000 7000.000 0.000
	2 [b] p 0 0 [none] 4,6 7000.000 0.000 0.000 -7000.000 0.000
	- 3 [i] d 0 0 1 7-8 1418.257 0.000 0.000 1418.257 0.000
	- 4 [i] dbar 1 0 2 7-8 226.061 0.000 0.000 -226.061 0.000
	- 5 [x] hr3bar 0 0 1 [none] 6615.979 0.000 0.000 6615.979 0.000
	- 6 [x] hr3 0 0 2 [none] 6976.951 0.000 0.000 -6976.951 0.000
	- 7 [v] e- 0 0 3-4 9-11 131.768 -72.592 46.713 99.554 0.000
	- 8 [v] e+ 0 0 3-4 9-11 275.302 72.592 -46.713 261.419 0.000
	- 9 [o] e- 0 0 7-8 [none] 39.603 -12.884 -32.933 17.826 0.000
	- 10 [o] e+ 0 0 7-8 [none] 1082.684 302.860 -353.876 977.370 0.000
	- 11 [o] gl 1 0 7-8 [none] 522.031 -289.976 386.809 196.999 0.000
	-------------------------------------------------------------------------
	-Sum of incoming momenta: p(0:3) = 1644.318 0.000 0.000 1192.196
	-Sum of beam remnant momenta: p(0:3) = 13592.930 0.000 0.000 -360.972
	-Sum of outgoing momenta: p(0:3) = 1644.318 0.000 0.000 1192.196
	+ 3 [i] c 0 0 1 7-8 41.099 0.000 0.000 41.099 0.000
	+ 4 [i] cbar 0 0 2 7-8 15.487 0.000 0.000 -15.487 0.000
	+ 5 [x] hr3bar 0 0 1 [none] 6958.901 0.000 0.000 6958.901 0.000
	+ 6 [x] hr3 0 0 2 [none] 6984.513 0.000 0.000 -6984.513 0.000
	+ 7 [o] e- 0 0 3-4 [none] 24.278 20.506 12.387 3.934 0.000
	+ 8 [o] e+ 0 0 3-4 [none] 32.309 -20.506 -12.387 21.678 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 56.586 0.000 0.000 25.612
	+Sum of beam remnant momenta: p(0:3) = 13943.414 0.000 0.000 -25.612
	+Sum of outgoing momenta: p(0:3) = 56.586 0.000 0.000 25.612
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	PYTHIA8 specific settings:
	ps_PYTHIA8_config = ''
	ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.40000E+04
	-sqrts_hat* => 1.13245E+03
	+sqrts_hat* => 5.04581E+01
	n_in* => 2
	-n_out* => 5
	-n_tot* => 7
	-$process_id* => "powheg_2_p1"
	+n_out* => 4
	+n_tot* => 6
	+$process_id* => "powheg_2_p2"
	process_num_id* => [unknown integer]
	-sqme* => 6.32254E+06
	-sqme_ref* => 6.32254E+06
	-event_index* => 10
	+sqme* => 1.32591E+08
	+sqme_ref* => 1.32591E+08
	+event_index* => 5
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00,-7.0000000E+03\| 0.0000000E+00\| 1)
	2 prt(b:2212\|-7.0000000E+03; 0.0000000E+00, 0.0000000E+00, 7.0000000E+03\| 0.0000000E+00\| 2)
	- 3 prt(i:1\|-1.4182569E+03; 0.0000000E+00, 0.0000000E+00,-1.4182569E+03\| 0.0000000E+00\| 3)
	- 4 prt(i:-1\|-2.2606130E+02; 0.0000000E+00, 0.0000000E+00, 2.2606130E+02\| 0.0000000E+00\| 4)
	- 5 prt(o:-92\| 6.6159787E+03; 0.0000000E+00, 0.0000000E+00, 6.6159787E+03\| 0.0000000E+00\| 5)
	- 6 prt(o:92\| 6.9769511E+03; 0.0000000E+00, 0.0000000E+00,-6.9769511E+03\| 0.0000000E+00\| 6)
	- 7 prt(o:11\| 3.9602661E+01;-1.2884171E+01,-3.2933394E+01, 1.7825837E+01\| 0.0000000E+00\| 7)
	- 8 prt(o:-11\| 1.0826845E+03; 3.0286048E+02,-3.5387591E+02, 9.7737047E+02\| 0.0000000E+00\| 8)
	- 9 prt(o:21\| 5.2203104E+02;-2.8997631E+02, 3.8680931E+02, 1.9699926E+02\| 0.0000000E+00\| 9)
	+ 3 prt(i:4\|-4.1098893E+01; 0.0000000E+00, 0.0000000E+00,-4.1098893E+01\| 0.0000000E+00\| 3)
	+ 4 prt(i:-4\|-1.5487167E+01; 0.0000000E+00, 0.0000000E+00, 1.5487167E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:-92\| 6.9589011E+03; 0.0000000E+00, 0.0000000E+00, 6.9589011E+03\| 0.0000000E+00\| 5)
	+ 6 prt(o:92\| 6.9845128E+03; 0.0000000E+00, 0.0000000E+00,-6.9845128E+03\| 0.0000000E+00\| 6)
	+ 7 prt(o:11\| 2.4277558E+01; 2.0505765E+01, 1.2386922E+01, 3.9341550E+00\| 0.0000000E+00\| 7)
	+ 8 prt(o:-11\| 3.2308503E+01;-2.0505765E+01,-1.2386922E+01, 2.1677571E+01\| 0.0000000E+00\| 8)
	========================================================================
	-Contents of powheg_2_p1.pg:
	+Contents of powheg_2_p2.pg:
	3
	- 10 10 3
	- 4.56011904XE+02 1.08396964XE+03 1.00704509XE+03 4.07472766XE+02 8.20831522XE+02 4.39687151XE+03 0.00000000XE+00 4.55870940XE-01 1.14106308XE-02 4.72900300XE-04 6.22466761XE+02 1.19665108XE+03 8.12748192XE+02 1.70252010XE+02 5.64633339XE+00 9.34588042XE+01 1.35500082XE-02 1.21124127XE+00 3.40843391XE+03 2.19908469XE+02 1.98717907XE+02 1.45199305XE+03 4.41860587XE+02 2.49687654XE+03 4.72285319XE+02 3.97752966XE+01 4.55486415XE+03 4.22391825XE+00 2.21709182XE+03 4.11771296XE-01 7.47343130XE+00 1.53156015XE+03 1.19616305XE+03 2.63299545XE+02 1.24426106XE+02 0.00000000XE+00 1.07269899XE+01 3.80760159XE+00 0.00000000XE+00 3.15864697XE+02 2.88692056XE+02 8.09073336XE+02 5.41970240XE+02 5.59608958XE+02 3.92235948XE+02 6.42227705XE+01 3.62917919XE-02 1.20057662XE+03 8.14524536XE-02 1.33714831XE-05 2.27513287XE+02 7.99680334XE+00 1.68336575XE+03 3.21078101XE+02 4.79703551XE+00 3.99098986XE+01 1.17274094XE+01 2.68423116XE-01 8.27410328XE-01 1.32660515XE+02 1.57786383XE+02 9.26495925XE+02 1.26447340XE+03 1.07803890XE+03 6.87400894XE+01 3.67249837XE+00 1.91702208XE-01 2.26546800XE+02 7.91240282XE+01 1.24206058XE+01 7.85126970XE+01 1.67516040XE+02 7.20842242XE+02 1.41705966XE+03 7.16520374XE+01 4.53820466XE+02 8.48845944XE+01 1.90318064XE+02 0.00000000XE+00 1.67054751XE-05 1.54448607XE+02 5.68536233XE+02 5.06741063XE+02 9.71321469XE+02 5.72484596XE+02 1.28170456XE+01 1.66992993XE+01 3.17799679XE+02 1.67889947XE+00 3.75739367XE-01 7.72391302XE+01 2.83518121XE+02 1.72285713XE+02 5.06605141XE+01 3.08068016XE+02 1.38671167XE+02 3.92063423XE-01 0.00000000XE+00 8.33119487XE+01 1.69887715XE-01 4.38435788XE+04 1.90741123XE+04 8.15629779XE+04 3.65322951XE+03 4.96087992XE+04 9.94584441XE+04 1.27216778XE+03 1.86389783XE+01 2.58184028XE-01 1.06271008XE-02 4.22976604XE+03 9.12874394XE+04 4.37268874XE+04 1.21456301XE+04 1.19977776XE+02 7.98332114XE+02 1.50225380XE+03 1.18084312XE+02 1.20765870XE+04 4.94609476XE+02 2.31762531XE+03 6.12365174XE+04 5.83180540XE+04 6.86143415XE+04 2.78957607XE+04 6.35915636XE+02 2.77947376XE+04 1.02625515XE+02 1.44037355XE+04 1.85886130XE+00 1.35134376XE+02 1.12766452XE+05 9.25910893XE+04 3.68062850XE+04 8.85963148XE+03 0.00000000XE+00 6.61357737XE+01 3.68097007XE+01 0.00000000XE+00 1.03176661XE+03 2.67066771XE+04 6.17091872XE+04 9.03706325XE+03 1.09777514XE+04 3.18375365XE+04 4.55529858XE+03 8.37358999XE-01 2.68198470XE+04 1.88760973XE+00 6.00681729XE-04 2.31855365XE+04 1.41970305XE+02 1.18402359XE+05 3.91924725XE+04 9.54437765XE+01 2.30254674XE+03 7.61035587XE+02 2.09863660XE+02 5.04642500XE+01 3.31661865XE+02 1.09680801XE+03 1.15703562XE+05 4.54305466XE+04 7.17001382XE+04 5.21015932XE+03 3.25662039XE+03 1.21356338XE+01 1.52317444XE+03 5.41094214XE+03 2.96164473XE+01 3.47211572XE+03 1.29138470XE+03 2.55455705XE+04 8.98099893XE+04 1.27433696XE+04 2.89926646XE+04 4.99848148XE+03 7.54277563XE+03 5.16508113XE-02 1.77463296XE-02 1.63522145XE+03 9.43879954XE+03 4.28834065XE+04 4.38952749XE+04 4.09397032XE+04 4.87312659XE+03 1.60018116XE+03 8.49515968XE+03 1.04087121XE+01 2.43065698XE+00 1.64981234XE+03 2.91710330XE+04 5.77166880XE+03 4.58520094XE+03 2.34559365XE+04 2.18709658XE+04 8.23460272XE+02 0.00000000XE+00 7.31739628XE+03 1.66696682XE+01 5.74914736XE+02 7.60546237XE+02 6.41111638XE+02 9.94047016XE+02 3.34234958XE+02 9.19758166XE+03 0.00000000XE+00 1.14217564XE+00 5.32901455XE-02 1.06934118XE-03 4.91519412XE+02 1.70834719XE+03 7.84914313XE+02 1.85236703XE+03 1.25897374XE+01 6.66935928XE+02 1.86072905XE-01 1.86517758XE+01 1.03606703XE+03 8.14813234XE+01 2.19280269XE+02 1.17615689XE+03 1.67095547XE+03 2.91681872XE+03 2.31557457XE+02 1.34736024XE+01 4.52641971XE+04 8.26060646XE+00 7.03374211XE+02 9.58538346XE+00 8.38347918XE+01 1.13299192XE+03 4.21334200XE+02 8.45632907XE+01 7.26826395XE+01 0.00000000XE+00 1.64462061XE+02 1.28488936XE+00 0.00000000XE+00 1.34747045XE+02 7.20104666XE+02 5.01305878XE+02 3.63117036XE+02 6.15781021XE+02 1.87026389XE+02 4.14903395XE+02 4.32021485XE-02 3.31866553XE+03 3.00732711XE-01 2.37775254XE-04 1.25316548XE+02 1.02100430XE+02 2.59471355XE+03 4.81787378XE+02 3.62026593XE+00 1.20412618XE+01 1.98899809XE+02 1.19585741XE-01 1.65422641XE+01 3.46348369XE+02 1.05034543XE+02 1.86978133XE+03 6.91366044XE+02 3.57985584XE+02 4.19191611XE+02 2.46793733XE+00 1.71620202XE+00 7.25239563XE+02 2.15169655XE+02 4.10345353XE+00 4.84963354XE+01 7.66811202XE+01 2.62483559XE+02 6.77517067XE+02 1.26104759XE+02 1.49113799XE+02 1.82647360XE+02 7.65572570XE+01 0.00000000XE+00 1.93989226XE-04 6.65423887XE+01 3.67292036XE+02 6.86976225XE+02 3.33608807XE+02 1.97871128XE+02 3.41392821XE+01 7.67651048XE+00 1.18473614XE+02 1.01140815XE+01 1.22605760XE+00 4.73478001XE+01 8.03683331XE+02 6.76379987XE+01 3.86277513XE+01 1.05897622XE+02 4.61604355XE+01 1.66781894XE+00 0.00000000XE+00 2.55855352XE+02 5.31989006XE-01
	+ 10 10 30
	+ 8.54594477XE+02 6.90463623XE+02 3.07228873XE+03 6.26648970XE-01 1.53720504XE+02 1.28801480XE+04 1.89270518XE-01 9.87966457XE-01 3.45386773XE+02 7.22045194XE-04 4.39818998XE+02 1.01039355XE+03 6.65244665XE+02 3.28919195XE+00 3.30914655XE+02 7.22201789XE-01 2.45728037XE+04 1.10363170XE+03 0.00000000XE+00 2.74369617XE+02 1.07883355XE+03 1.08283525XE+03 1.36824562XE+03 4.28035118XE+03 1.18723858XE+02 1.14992309XE+04 1.06580358XE+04 0.00000000XE+00 1.78507225XE+02 4.94459076XE-02 3.38572112XE+02 8.30724797XE+01 2.51694014XE+03 4.72415883XE+02 1.24517681XE+03 4.87643866XE+03 3.45199048XE+02 4.00679358XE+01 4.77269184XE+03 1.28608870XE+02 7.10415418XE+02 5.84766082XE+02 8.81407205XE+02 3.91688752XE+03 5.18458505XE+03 5.17475220XE+01 1.21003487XE+03 2.48710360XE+00 2.60934467XE+04 1.87850421XE+04 5.45040266XE+02 8.52544200XE+02 7.45973602XE+02 4.77114532XE+02 7.83679087XE+01 1.52948277XE+02 1.01201732XE+04 4.62058591XE+02 1.10850141XE+03 5.94144062XE+01 1.74466861XE+02 1.01377492XE+03 3.71464973XE+02 2.57912592XE+02 3.50524718XE+03 1.97026660XE+02 5.28935739XE+04 1.60984237XE+04 4.88694168XE+04 6.06987638XE+03 4.03743591XE+02 6.17661284XE+01 1.35625510XE+03 3.09502549XE+03 2.50720494XE+02 6.21318137XE+01 4.69953872XE+03 1.63807934XE+01 2.34336816XE+03 4.29406959XE+02 1.08214213XE+02 5.35269853XE+02 6.63716017XE+02 1.85231798XE+02 1.66933480XE+02 4.43743275XE+01 4.41374658XE+01 1.29515440XE+02 8.95879202XE+02 3.10384986XE+03 1.74635663XE+02 4.35087849XE+01 2.27869107XE+02 1.41683145XE+02 8.21779818XE+02 3.89742041XE+01 5.88912002XE+00 8.95171088XE+01 6.17097738XE+01 2.27450540XE+01 2.73302538XE+04 5.17431957XE+04 3.70585528XE+05 1.80239613XE+01 1.65621059XE+04 6.37868345XE+05 8.07634569XE+00 2.28696812XE+01 1.84172681XE+03 1.90100610XE-02 1.13414403XE+04 4.00769118XE+04 1.87395999XE+04 7.21252326XE+01 1.61605854XE+04 1.68594467XE+01 9.01432207XE+05 2.27158580XE+04 0.00000000XE+00 7.06980374XE+03 3.17782146XE+04 3.46022961XE+04 6.05462160XE+04 2.08757927XE+05 5.88474569XE+03 4.70382452XE+05 9.47460542XE+05 5.15974963XE-01 2.62918763XE+03 8.18464246XE-01 2.16159244XE+04 2.27138833XE+03 7.18853681XE+04 2.89824601XE+04 7.71136533XE+04 1.62233614XE+05 1.82248259XE+04 1.42872607XE+03 3.22377272XE+04 1.58762598XE+03 2.25812433XE+04 1.46709785XE+04 2.44946783XE+04 1.51100092XE+05 1.64908673XE+05 5.61438413XE+03 4.26312366XE+04 2.22543860XE+02 6.25302764XE+04 7.75234099XE+05 2.62917856XE+04 3.56600077XE+04 5.79748597XE+04 1.37611883XE+04 1.79032111XE+03 3.21767725XE+03 1.33040643XE+06 1.75604523XE+04 1.23908194XE+04 1.31048396XE+02 1.77736276XE+04 6.79597063XE+04 8.56951840XE+03 2.75363100XE+04 5.61073959XE+05 1.08091946XE+04 1.96047085XE+06 5.14132693XE+05 1.60418314XE+05 1.51471217XE+05 2.58906834XE+04 4.74019718XE+03 7.29171514XE+04 8.86600171XE+04 1.00651060XE+04 2.65004987XE+03 6.14141544XE+05 1.17921299XE+03 5.43229921XE+04 9.63860257XE+03 3.07600264XE+03 1.74895997XE+04 2.30253295XE+04 1.45424619XE+04 5.14225254XE+03 2.22804598XE+03 1.27539490XE+03 5.05090832XE+03 2.20146359XE+04 1.51481182XE+05 5.81533452XE+03 1.66256899XE+03 1.06678479XE+04 8.39647986XE+03 1.87323212XE+04 1.55814459XE+03 7.66170447XE+02 2.51012613XE+03 1.38616668XE+03 1.08577473XE+03 9.51953290XE+02 5.47432262XE+02 1.76973646XE+01 3.86276868XE-01 5.85447792XE+02 2.15950422XE+04 3.61968298XE+00 4.34561112XE+00 2.05001166XE+00 1.51378678XE-04 5.41962499XE+02 1.00251010XE+03 1.83269393XE+03 1.76413105XE+01 1.52503874XE+03 0.00000000XE+00 8.13385990XE+04 1.91618982XE+03 0.00000000XE+00 4.33757941XE+02 1.24199780XE+03 1.68913604XE+03 4.38312789XE+02 2.84613414XE+03 3.56809234XE+02 6.37690593XE+02 4.51577093XE+04 3.10606952XE-02 8.86752923XE+00 6.91610246XE-03 3.31930111XE+02 1.58194207XE+02 1.92145843XE+03 1.29733769XE+03 2.88284795XE+02 1.60767226XE+02 2.10667682XE+03 1.37709154XE+01 1.37566748XE+01 1.39921969XE+02 7.82677242XE+02 6.01896405XE+02 6.35140201XE+01 1.47498830XE+02 3.35202276XE+02 4.64285953XE+02 3.78181797XE+02 7.33184307XE+01 1.09761439XE+01 7.84783910XE+03 5.46061414XE+02 1.13470448XE+03 1.74932443XE+03 1.40949490XE+03 3.08680507XE+02 1.12918149XE+02 2.81821629XE+04 4.17147744XE+02 4.92167966XE+02 3.10092668XE-03 1.83358209XE+02 1.36136324XE+03 5.67723536XE+02 9.43578588XE+02 1.97222937XE+03 6.32646448XE+02 2.14259548XE+04 1.07608315XE+04 3.09435744XE+01 9.75038149XE+01 4.67928856XE+02 5.44776786XE+01 5.60268109XE+02 1.97496901XE+04 1.20091936XE+03 3.35978371XE+02 1.63287551XE+02 8.75665075XE+02 0.00000000XE+00 3.30054989XE+02 1.20589093XE+02 7.06214880XE+02 1.37043081XE+03 7.21710444XE+02 1.14480675XE+03 4.31092181XE+02 3.78182939XE+02 1.03055572XE+02 7.71911815XE+00 1.70429294XE+02 1.72675805XE+02 5.18110986XE+01 2.34758569XE+02 3.47116829XE+02 4.08360540XE+02 2.45195451XE+02 9.81407422XE+01 1.00623689XE+01 2.60766206XE+00 7.43131695XE+00 1.70101537XE+02 3.05343829XE+02 1.21277480XE+02 8.66429072XE+00 4.15478751XE+01 9.17334078XE+02 3.79922859XE-01 1.07306934XE+00 1.25520859XE+00 3.29130782XE-03 3.94861712XE+02 1.33654635XE+03 3.26807492XE+02 6.67846448XE+01 4.93308751XE+01 0.00000000XE+00 5.76075359XE+03 4.02914992XE+03 0.00000000XE+00 6.04524993XE+01 2.69018340XE+02 4.80946706XE+02 1.33336647XE+02 1.21103884XE+03 2.64089568XE+01 2.08590951XE+01 8.12288994XE+02 8.60811296XE-04 2.29183001XE+00 1.53886068XE-01 1.01079513XE+02 1.13114695XE+02 3.14485337XE+02 9.63162284XE+01 5.00923151XE+01 1.85441583XE+01 5.47208536XE+01 7.83974247XE-01 6.74143622XE+00 4.59488059XE+01 1.49994790XE+02 1.07729230XE+03 6.16535757XE+00 7.85738043XE+01 3.97203459XE+01 1.58888208XE+01 9.62173350XE+02 8.33129347XE-01 3.00931445XE+01 3.57652108XE+02 8.23984244XE+02 2.31369154XE+02 9.25191891XE+01 1.65230188XE+02 8.70964979XE+01 1.15729687XE+02 4.89986999XE+02 2.40161369XE+01 5.57431165XE+02 5.68181914XE-03 7.09092752XE+01 5.89238698XE+02 6.50167839XE+02 6.75705031XE+02 2.83880496XE+01 2.97085279XE+01 1.64874791XE+03 1.52595100XE+02 5.42772674XE+01 1.71785993XE+01 2.15536294XE+02 2.11403618XE+02 2.66932600XE+01 3.09594413XE+03 2.09636399XE+02 4.63975061XE+01 2.63052791XE+00 1.12978913XE+01 0.00000000XE+00 3.75421827XE+02 1.39397256XE+02 1.64596315XE+02 1.49935517XE+02 4.93090588XE+01 2.00541482XE+02 1.57078678XE+01 9.56602455XE+01 1.95957698XE+00 2.96261346XE-01 1.21074470XE+01 1.22733675XE+02 5.29374723XE+01 1.09591780XE+02 1.57729806XE+01 9.11705863XE+01 2.03291660XE+01 1.62918723XE+00 4.16344229XE-01 2.41322004XE-01 3.17232293XE-01 1.04661310XE+03 4.97333882XE+02 1.51550005XE+01 1.67172086XE+00 1.05903274XE+02 6.35310268XE+02 3.30175820XE-01 5.44584554XE+01 4.17964245XE+02 2.52696778XE-03 5.26002592XE+02 1.49802733XE+03 1.36081308XE+03 1.31930292XE+01 3.02902938XE+02 8.58712110XE+00 9.62431143XE+01 2.19257501XE+01 0.00000000XE+00 2.84629527XE-01 1.41487919XE+03 1.93180234XE+03 3.46576211XE+03 3.37653456XE+02 7.32724923XE+02 3.96631812XE+02 1.51670321XE+03 8.60098143XE-03 1.32757692XE+02 1.50378960XE-01 3.81949602XE+02 1.05403752XE+02 1.81622109XE+03 6.16637551XE+02 1.57758492XE+03 2.00548319XE+02 9.82761590XE+00 3.67899184XE+01 6.67578643XE+03 4.11374175XE+00 8.60297946XE+02 8.17593735XE+02 8.60373203XE+02 1.34046836XE+01 2.26522256XE+04 2.59031172XE+01 3.52245735XE+03 7.81042069XE-02 7.87683268XE+04 2.46655777XE-03 6.62581676XE+02 8.87627178XE+02 1.37755090XE+03 1.09851728XE+03 8.29961804XE+02 1.84192734XE+02 4.63433818XE+01 4.68920764XE+01 4.44503804XE+02 1.05809777XE-03 1.84475270XE+02 1.29448849XE+03 8.57541293XE+02 6.57017062XE+02 4.33388041XE+02 2.29788403XE+02 7.89073160XE+01 1.94783692XE+00 4.46982857XE+02 1.47155498XE+01 4.65816729XE+02 3.78886906XE+01 3.98716645XE+02 1.01433460XE+03 5.92558264XE+02 4.46299139XE+02 4.09153498XE+01 6.83621440XE+01 7.31096328XE-01 4.02862198XE-02 1.51514127XE+02 1.03051328XE+03 1.53986014XE+03 4.78880431XE+02 7.45635559XE+02 2.69469809XE+01 3.94028167XE+01 7.83880470XE+01 3.45530425XE+00 9.52587319XE+02 1.65195616XE+02 7.35008794XE+01 5.19932088XE+02 9.35980947XE+01 5.50048839XE+03 4.26464434XE+01 8.04470874XE+01 7.90868417XE+01 2.72594489XE+01 1.29484112XE-02 9.00158271XE+03 3.99848609XE+03 2.96784446XE+02 3.80175939XE+01 1.61813230XE+04 3.88708083XE+03 3.26725607XE+00 3.35982060XE+02 2.22498640XE+03 5.61772798XE-02 4.46687443XE+03 2.24778724XE+04 8.84664096XE+03 1.83678970XE+02 9.16161007XE+03 1.50794106XE+02 1.15165115XE+03 2.04191134XE+02 0.00000000XE+00 1.73770445XE+00 9.60191423XE+03 3.06507595XE+04 1.67850200XE+05 6.25741505XE+04 4.85769587XE+03 4.49771229XE+04 5.70728854XE+04 1.96979218XE-01 1.95948195XE+03 1.81324402XE+00 1.81891664XE+04 9.14237216XE+02 2.01335929XE+04 1.41594206XE+04 9.99478098XE+03 1.23126540XE+03 2.87011219XE+02 1.43793048XE+03 4.50053956XE+04 9.41186459XE+00 6.02773620XE+03 6.97264894XE+03 5.92888757XE+03 2.52394561XE+02 7.39718688XE+05 5.92004321XE+03 1.32375653XE+05 1.03462383XE+02 1.88301728XE+05 5.52964404XE-02 9.68197801XE+03 1.06929406XE+04 6.54067799XE+04 7.40752076XE+03 5.40095959XE+03 1.52228495XE+03 6.24100269XE+03 5.50777478XE+02 4.81886018XE+03 6.89016069XE-03 1.07540857XE+04 9.63551284XE+03 7.44065611XE+03 7.41594470XE+04 4.37964213XE+03 1.15590460XE+04 3.07542353XE+03 9.99433005XE+02 1.46390097XE+03 3.71767082XE+02 1.23434239XE+04 4.24768506XE+02 3.69574346XE+04 7.39873972XE+03 5.18451509XE+03 3.69709329XE+03 8.07625208XE+03 5.20529059XE+02 6.26712771XE+00 3.45308005XE-01 1.33421494XE+03 7.37224957XE+03 1.33941245XE+04 1.13245410XE+04 6.16011471XE+03 8.27714967XE+02 5.81006265XE+02 3.34333824XE+03 1.67754578XE+02 2.33037291XE+03 1.24563637XE+03 6.75550352XE+02 7.58643553XE+03 5.68441243XE+03 1.26518857XE+05 4.39209293XE+02 5.07415610XE+03 2.22996002XE+03 6.17173777XE+02 1.31069734XE-01 8.54594477XE+02 6.90463623XE+02 3.07228873XE+03 6.26648970XE-01 1.53720504XE+02 1.28801480XE+04 1.89270518XE-01 9.87966457XE-01 3.45386773XE+02 7.22045194XE-04 4.39818998XE+02 1.01039355XE+03 6.65244665XE+02 3.28919195XE+00 3.30914655XE+02 7.22201789XE-01 2.45728037XE+04 1.10363170XE+03 0.00000000XE+00 2.74369617XE+02 1.07883355XE+03 1.08283525XE+03 1.36824562XE+03 4.28035118XE+03 1.18723858XE+02 1.14992309XE+04 1.06580358XE+04 0.00000000XE+00 1.78507225XE+02 4.94459076XE-02 3.38572112XE+02 8.30724797XE+01 2.51694014XE+03 4.72415883XE+02 1.24517681XE+03 4.87643866XE+03 3.45199048XE+02 4.00679358XE+01 4.77269184XE+03 1.28608870XE+02 7.10415418XE+02 5.84766082XE+02 8.81407205XE+02 3.91688752XE+03 5.18458505XE+03 5.17475220XE+01 1.21003487XE+03 2.48710360XE+00 2.60934467XE+04 1.87850421XE+04 5.45040266XE+02 8.52544200XE+02 7.45973602XE+02 4.77114532XE+02 7.83679087XE+01 1.52948277XE+02 1.01201732XE+04 4.62058591XE+02 1.10850141XE+03 5.94144062XE+01 1.74466861XE+02 1.01377492XE+03 3.71464973XE+02 2.57912592XE+02 3.50524718XE+03 1.97026660XE+02 5.28935739XE+04 1.60984237XE+04 4.88694168XE+04 6.06987638XE+03 4.03743591XE+02 6.17661284XE+01 1.35625510XE+03 3.09502549XE+03 2.50720494XE+02 6.21318137XE+01 4.69953872XE+03 1.63807934XE+01 2.34336816XE+03 4.29406959XE+02 1.08214213XE+02 5.35269853XE+02 6.63716017XE+02 1.85231798XE+02 1.66933480XE+02 4.43743275XE+01 4.41374658XE+01 1.29515440XE+02 8.95879202XE+02 3.10384986XE+03 1.74635663XE+02 4.35087849XE+01 2.27869107XE+02 1.41683145XE+02 8.21779818XE+02 3.89742041XE+01 5.88912002XE+00 8.95171088XE+01 6.17097738XE+01 2.27450540XE+01 2.73302538XE+04 5.17431957XE+04 3.70585528XE+05 1.80239613XE+01 1.65621059XE+04 6.37868345XE+05 8.07634569XE+00 2.28696812XE+01 1.84172681XE+03 1.90100610XE-02 1.13414403XE+04 4.00769118XE+04 1.87395999XE+04 7.21252326XE+01 1.61605854XE+04 1.68594467XE+01 9.01432207XE+05 2.27158580XE+04 0.00000000XE+00 7.06980374XE+03 3.17782146XE+04 3.46022961XE+04 6.05462160XE+04 2.08757927XE+05 5.88474569XE+03 4.70382452XE+05 9.47460542XE+05 5.15974963XE-01 2.62918763XE+03 8.18464246XE-01 2.16159244XE+04 2.27138833XE+03 7.18853681XE+04 2.89824601XE+04 7.71136533XE+04 1.62233614XE+05 1.82248259XE+04 1.42872607XE+03 3.22377272XE+04 1.58762598XE+03 2.25812433XE+04 1.46709785XE+04 2.44946783XE+04 1.51100092XE+05 1.64908673XE+05 5.61438413XE+03 4.26312366XE+04 2.22543860XE+02 6.25302764XE+04 7.75234099XE+05 2.62917856XE+04 3.56600077XE+04 5.79748597XE+04 1.37611883XE+04 1.79032111XE+03 3.21767725XE+03 1.33040643XE+06 1.75604523XE+04 1.23908194XE+04 1.31048396XE+02 1.77736276XE+04 6.79597063XE+04 8.56951840XE+03 2.75363100XE+04 5.61073959XE+05 1.08091946XE+04 1.96047085XE+06 5.14132693XE+05 1.60418314XE+05 1.51471217XE+05 2.58906834XE+04 4.74019718XE+03 7.29171514XE+04 8.86600171XE+04 1.00651060XE+04 2.65004987XE+03 6.14141544XE+05 1.17921299XE+03 5.43229921XE+04 9.63860257XE+03 3.07600264XE+03 1.74895997XE+04 2.30253295XE+04 1.45424619XE+04 5.14225254XE+03 2.22804598XE+03 1.27539490XE+03 5.05090832XE+03 2.20146359XE+04 1.51481182XE+05 5.81533452XE+03 1.66256899XE+03 1.06678479XE+04 8.39647986XE+03 1.87323212XE+04 1.55814459XE+03 7.66170447XE+02 2.51012613XE+03 1.38616668XE+03 1.08577473XE+03 8.35239333XE+02 3.27525128XE+02 2.52753455XE+03 0.00000000XE+00 3.20735196XE+02 1.33395828XE+04 1.46351007XE-01 7.49929284XE-01 5.95432860XE+02 1.09850917XE-03 4.31133757XE+02 1.01246282XE+03 6.05865902XE+02 2.75438403XE+00 3.11861045XE+02 0.00000000XE+00 2.24494076XE+04 1.32056278XE+03 0.00000000XE+00 4.62939623XE+02 1.04885356XE+03 1.02706999XE+03 1.27475102XE+03 3.31758305XE+03 2.22068086XE+02 9.09425646XE+03 1.34869659XE+04 0.00000000XE+00 3.09317173XE+02 1.73831148XE-01 1.26720511XE+01 7.91953128XE+01 1.86948956XE+03 4.87823215XE+02 1.48947739XE+03 3.28978429XE+03 4.32309982XE+02 7.16558486XE+01 7.10223059XE+03 3.67294716XE+02 7.03551553XE+02 5.93239930XE+02 1.07473252XE+03 2.86411968XE+03 4.20045237XE+03 7.67622634XE+01 1.47274502XE+03 4.98501021XE+00 3.51157119XE+04 1.38878924XE+04 5.37574715XE+02 8.50201901XE+02 7.83557258XE+02 4.21007422XE+02 5.49872161XE+01 2.62189117XE+02 3.13631624XE+01 6.95749054XE+02 2.37359241XE+03 6.53524185XE+01 4.26209505XE+00 8.93761717XE+02 3.49837841XE+02 3.11751086XE+02 2.52187590XE+03 3.74851537XE+02 3.88974786XE+04 1.28322612XE+04 8.58860429XE+04 9.29327481XE+03 1.04683127XE+02 4.84064952XE+01 1.04656315XE+03 2.42728038XE+03 2.25980138XE+02 2.05893383XE+03 1.29765757XE+01 2.86969915XE+01 0.00000000XE+00 1.46847292XE+01 1.06162717XE+02 5.08839671XE+02 6.47072048XE+02 2.00097744XE+02 1.43863022XE+02 4.01160664XE+01 5.37712365XE+01 2.14416884XE+02 3.15215603XE+01 2.40876565XE+03 1.63802347XE+02 4.18189272XE+01 2.19505990XE+02 1.40442071XE+02 6.99052270XE+02 3.42213157XE+01 8.63483962XE+00 2.03952402XE+00 1.20385236XE+02 4.36052959XE+01 5.12074687XE+04 2.41672453XE+04 2.44516345XE+05 0.00000000XE+00 2.95162354XE+04 1.32835355XE+06 1.31320728XE+01 2.92553427XE+01 3.27287452XE+03 3.70391886XE-02 1.95005695XE+04 8.04836158XE+04 3.11256827XE+04 1.07352694XE+02 2.93559236XE+04 0.00000000XE+00 1.60401039XE+06 4.21212586XE+04 0.00000000XE+00 2.11466520XE+04 5.73223130XE+04 6.47190498XE+04 9.14949649XE+04 3.23103881XE+05 1.09065232XE+04 7.35480837XE+05 1.85577161XE+06 0.00000000XE+00 4.89249310XE+03 2.20394551XE+00 5.47698309XE+02 3.92871700XE+03 9.77970846XE+04 5.65539553XE+04 9.29388636XE+04 1.27738543XE+05 4.23675490XE+04 2.76286648XE+03 5.00093218XE+04 4.44491130XE+03 4.27998050XE+04 2.56881017XE+04 5.40596496XE+04 1.29403065XE+05 1.54274900XE+05 1.03374338XE+04 5.79943146XE+04 3.92923465XE+02 8.75829676XE+04 6.24529088XE+05 5.45361333XE+04 7.22670849XE+04 1.07219139XE+05 2.23944585XE+04 2.27943701XE+03 8.70741362XE+03 1.06717888XE+03 5.19382637XE+04 2.72275278XE+04 1.48192066XE+02 1.93243182XE+02 6.00168657XE+04 1.33491462XE+04 4.64264049XE+04 3.04240699XE+05 4.04080799XE+04 1.67479844XE+06 1.08718319XE+06 2.91570992XE+05 2.58233045XE+05 1.17164803XE+04 4.57766512XE+03 6.24399708XE+04 1.27708901XE+05 1.79698828XE+04 3.45845770XE+05 2.04767347XE+03 1.85650364XE+03 0.00000000XE+00 4.78594406XE+02 5.60843428XE+03 3.20891289XE+04 4.23901973XE+04 2.32146938XE+04 8.35415031XE+03 3.96948142XE+03 2.62321299XE+03 9.46462425XE+03 3.84272248XE+03 1.26488384XE+05 1.07699566XE+04 2.39023170XE+03 2.13260030XE+04 1.73805284XE+04 1.78117052XE+04 2.77833962XE+03 1.51936478XE+03 2.16618161XE+02 3.02948340XE+03 4.16431700XE+03 8.13539883XE+02 3.62692374XE+02 8.18413691XE+00 5.39866761XE-01 6.02609667XE+00 1.52132681XE+04 1.57519150XE-01 7.53209397XE-01 2.52123885XE+02 3.91347466XE-04 4.42429212XE+02 9.02922543XE+02 6.30864948XE+02 4.40895998XE+00 2.53129722XE+02 0.00000000XE+00 4.75073827XE+04 0.00000000XE+00 0.00000000XE+00 1.95768400XE+02 1.01826692XE+03 1.07015076XE+03 2.07204487XE+03 2.64247321XE+03 8.14542238XE+01 4.69078953XE+02 8.11029551XE+03 0.00000000XE+00 1.38051168XE+02 2.00674015XE-02 2.77015890XE+02 9.01343184XE+01 7.86806511XE+02 3.56336718XE+02 3.04481677XE+02 8.62631100XE+00 2.12894222XE-01 2.52223123XE+01 6.06018099XE+03 9.95131280XE+01 6.71988230XE+02 5.53046721XE+02 2.69036729XE+01 3.95735629XE+00 1.16948191XE+04 1.08072136XE+01 3.63279485XE+02 0.00000000XE+00 2.45907255XE+04 2.79224569XE-02 5.22276722XE+02 7.68050484XE+02 6.54600387XE+02 3.76886174XE+02 7.38333786XE+01 7.68286506XE+01 4.92471260XE+00 4.47522146XE+02 6.57279603XE+02 9.29753374XE-05 1.68177003XE+02 9.10047545XE+02 3.81147738XE+02 2.44344685XE+02 1.06414853XE+00 5.70883608XE+01 2.12858855XE+04 0.00000000XE+00 5.79555247XE+04 1.53614898XE+04 3.93599465XE+02 3.32553777XE+01 1.66774715XE+02 7.31630847XE+03 1.90799275XE+02 5.03999278XE+01 1.89997255XE+00 6.05566074XE+00 0.00000000XE+00 4.43186971XE+02 1.13458357XE+02 5.20496961XE+02 6.37956330XE+02 1.47322570XE+02 1.38104438XE+02 3.02630913XE+01 9.31449331XE-01 1.06921076XE+02 1.09565805XE+01 8.46118023XE+02 1.27366022XE+02 4.10143038XE+01 2.03683483XE+02 1.22516639XE+02 9.38394896XE+02 2.95211744XE+01 3.51905169XE+00 7.40585257XE-01 1.44059737XE+01 1.63350746XE+01 1.44581111XE+04 4.61033578XE+03 1.32702642XE+02 1.38749046XE+01 1.43230072XE+04 5.80154834XE+05 4.25162907XE+00 9.43958064XE+00 1.34234426XE+03 9.47440670XE-03 5.56670204XE+03 2.48075691XE+04 9.96104114XE+03 7.42826048XE+01 1.00881641XE+04 0.00000000XE+00 1.18247023XE+06 0.00000000XE+00 0.00000000XE+00 2.98706859XE+03 1.60814316XE+04 2.82852495XE+04 1.05368269XE+05 5.40136235XE+04 3.40216206XE+03 4.86915373XE+04 1.03160308XE+06 3.14387188XE-01 2.03809994XE+03 4.95603280XE-01 9.49523650XE+03 1.17414227XE+03 2.04634036XE+04 2.13176201XE+04 4.65586359XE+03 1.20223936XE+02 4.09568630XE+00 9.94818764XE+02 4.08595265XE+04 7.48258545XE+02 1.16826903XE+04 6.83932116XE+03 8.93777845XE+02 7.87954146XE+01 3.83567301XE+05 4.52614043XE+03 4.61571326XE+03 1.35629874XE+02 6.05793618XE+04 1.02716116XE+00 1.77560154XE+04 2.23170004XE+04 4.75315834XE+04 6.65729549XE+03 9.43984476XE+02 8.76841519XE+02 2.62090704XE+02 1.21189384XE+04 7.75908532XE+03 1.57116835XE-03 1.57550523XE+04 1.15162569XE+04 4.60343097XE+03 2.68316237XE+04 3.73543349XE+04 4.60043778XE+03 6.04615625XE+05 0.00000000XE+00 1.89813524XE+05 3.88356337XE+05 1.95975653XE+04 5.00016565XE+02 3.14039021XE+04 1.20609071XE+05 5.54025836XE+03 1.22898854XE+03 6.96996931XE+02 2.35715772XE+03 0.00000000XE+00 5.30304690XE+03 1.51222773XE+03 9.76202116XE+03 1.47152227XE+04 6.46732133XE+03 2.59387813XE+03 1.33886147XE+03 8.66233823XE+02 4.58402908XE+03 7.79965659XE+02 6.16613872XE+03 1.86434423XE+03 1.20357241XE+03 6.78868747XE+03 5.61783229XE+03 2.16245597XE+04 7.85110685XE+02 5.10806939XE+02 7.40401323XE+01 3.65092785XE+02 5.97769665XE+02 7.62808315XE+02 5.24379652XE+02 1.42186839XE+01 3.66786861XE-02 7.12850543XE+01 1.77491414XE+04 1.56499667XE+00 1.03380062XE+00 7.34190310XE-01 3.10771018XE-04 5.08930705XE+02 1.41038825XE+03 1.42436154XE+03 1.22653619XE+01 3.37538619XE+02 0.00000000XE+00 6.06846254XE+04 0.00000000XE+00 0.00000000XE+00 9.12258912XE+02 1.16758312XE+03 1.30918646XE+03 3.77942389XE+02 2.90311053XE+03 3.28532118XE+02 1.68872778XE+02 2.00290598XE+04 1.75527410XE-03 9.24738213XE-01 6.58864144XE-02 1.42629597XE+02 1.39893980XE+02 4.77287591XE+02 8.02032156XE+02 6.78010419XE+02 6.23618004XE+01 2.44848425XE+00 1.69572907XE+00 1.46329572XE+01 2.62983073XE+02 8.76519503XE+02 7.10122479XE+02 4.55237543XE+01 1.33392145XE+02 1.72655091XE+02 9.33343122XE+01 8.80876247XE+00 2.46799514XE+00 1.89766821XE+03 4.22774237XE+03 5.25543637XE+02 1.06973238XE+03 8.93022660XE+02 1.14600102XE+03 1.33636190XE+02 1.55251149XE+02 2.47661882XE+04 6.36571557XE+02 8.57949456XE+02 1.22235649XE-01 1.51605684XE+02 1.51338326XE+03 4.50782731XE+02 6.33059192XE+02 5.53619806XE+02 1.93842337XE+02 2.20661339XE+04 5.77215798XE+01 2.80460905XE+02 1.91293040XE+02 3.74107705XE+02 4.86025154XE+01 3.95950704XE+02 1.44029399XE+04 4.45765182XE+02 1.41806368XE+02 2.21702253XE+01 5.37422682XE+01 0.00000000XE+00 5.73673879XE+02 1.26029892XE+02 4.41138867XE+02 1.15028386XE+03 6.73889188XE+02 5.55839607XE+02 1.12683906XE+02 1.94994602XE+01 5.18839474XE+00 3.21488032XE+01 4.25391200XE+02 1.57440905XE+02 4.67928987XE+01 2.12055757XE+02 1.91210452XE+02 2.19493621XE+02 1.26339813XE+02 1.40424068XE+01 7.09487332XE-01 1.10246045XE-01 4.42974077XE+01 4.09117039XE+02 7.32756757XE+02 1.36087177XE+02 2.90333453XE-01 8.40904931XE+01 6.06688836XE+03 6.78384629XE-01 6.57865549XE-01 3.88237328XE+00 6.83772148XE-03 6.63012752XE+02 1.13228662XE+03 7.46238522XE+02 8.11956933XE+01 1.09800946XE+02 0.00000000XE+00 2.10341113XE+04 0.00000000XE+00 0.00000000XE+00 4.02538522XE+02 7.00121725XE+02 1.01998354XE+03 2.82515927XE+03 2.78810185XE+03 1.02258591XE+02 1.14235752XE+02 8.00193425XE+03 3.86182583XE-03 1.27093276XE+01 1.48163330XE+00 1.18510282XE+02 1.98443239XE+02 3.99489844XE+02 2.54413031XE+02 3.46950883XE+02 1.14101283XE+03 1.34194485XE+00 1.49800420XE+01 9.75733586XE+01 2.05170592XE+02 4.90914955XE+02 2.04156126XE+03 2.04052662XE+01 5.74619577XE+02 3.28102705XE+03 4.13889861XE+01 1.29574715XE+02 1.57260126XE+00 4.67635220XE+03 3.14038382XE+04 1.04318017XE+03 3.86698352XE+02 3.44593387XE+02 4.68285796XE+02 9.40479508XE+01 2.86175311XE+02 1.22433654XE+04 2.08275497XE+02 1.71091045XE+03 2.69313779XE-01 7.58252820XE+01 1.46452310XE+03 7.57294404XE+02 8.89758592XE+02 2.79374150XE+02 7.32366907XE+01 8.36648801XE+03 4.56282671XE+02 9.19818685XE+02 3.61233757XE+03 2.26451566XE+02 2.50015947XE+02 1.17403347XE+03 6.97586131XE+03 2.42733185XE+02 4.46836338XE+01 1.03883101XE+01 4.88054780XE+01 0.00000000XE+00 1.14897164XE+03 1.87726747XE+02 2.18004439XE+02 4.67211346XE+02 4.62766559XE+02 2.33546703XE+02 3.73484932XE+01 9.67904705XE+00 2.78313809XE+01 1.15246453XE+01 1.46332721XE+02 1.52411194XE+02 5.56062362XE+01 9.08541200XE+01 7.33682881XE+01 7.60816659XE+02 8.19974939XE+01 7.09512063XE+00 7.85410191XE-01 2.53217549XE+00 1.48574208XE+01 7.77032849XE+02 4.17796565XE+02 1.25257332XE+01 9.35536901XE-01 3.25045552XE+01 2.12367154XE+03 2.61045474XE-02 5.86987163XE+00 7.87012413XE+02 2.70033466XE-05 4.94495794XE+02 1.20975582XE+03 4.77524211XE+02 1.05549177XE+01 7.04098998XE+02 1.64384367XE+00 7.33659508XE+02 5.76565057XE+00 0.00000000XE+00 7.16302165XE-01 9.68928427XE+02 1.31964639XE+03 2.56586913XE+03 2.33639225XE+02 2.51632518XE+02 6.66903760XE+02 7.56726187XE+02 1.93673188XE-02 3.38557436XE+02 7.02446696XE-02 3.92351982XE+02 9.86958967XE+01 1.53004022XE+03 8.75595039XE+02 4.59593051XE+02 3.79242651XE+01 5.11861070XE+00 6.63752747XE+01 9.04133481XE+03 1.45019705XE+00 5.98288468XE+02 6.39727703XE+02 4.16800242XE+02 1.01643019XE+01 1.55250178XE+04 3.22059816XE+01 7.03938657XE+00 5.36077442XE-03 4.80326875XE+04 1.25861495XE-03 6.39348955XE+02 9.13617882XE+02 1.98740056XE+03 1.75122687XE+02 2.91172678XE+02 3.73850947XE+01 4.57996597XE+00 5.24425802XE+00 3.51998448XE+02 3.57887848XE-06 1.83326799XE+02 9.29890699XE+02 7.18963280XE+02 4.29130683XE+02 1.17781229XE+02 1.38113840XE+02 1.15881038XE+03 7.16952450XE-01 1.48363703XE+04 1.15262322XE+02 4.84073504XE+02 4.03895166XE+01 2.36472708XE+02 4.76337240XE+02 3.52013706XE+02 1.82792432XE+02 4.71641808XE+00 3.49823988XE+00 9.10745200XE+00 2.15813775XE+00 1.39937339XE+02 7.89509355XE+02 1.12188002XE+03 2.60728784XE+02 4.84673258XE+02 1.99127571XE+01 5.43654821XE+00 1.48711317XE+02 5.30992969XE+00 1.51778417XE+03 1.18217980XE+02 6.30178870XE+01 3.46223677XE+02 2.34576567XE+02 3.45285820XE+03 1.21697404XE+01 1.65093651XE+01 7.43822335XE+00 6.29475838XE+01 2.00507785XE-01 1.96975057XE+04 2.78765023XE+03 2.35209327XE+02 2.12716466XE+01 2.71185725XE+04 1.46249280XE+05 2.31880124XE+00 5.39750908XE+01 4.19020436XE+03 6.00056974XE-04 3.15786269XE+03 9.85218518XE+04 2.54367251XE+04 1.42355820XE+02 4.32470314XE+04 2.87041805XE+01 5.49318102XE+04 4.27721641XE+01 0.00000000XE+00 1.46640673XE+01 1.39559362XE+04 2.88805769XE+04 1.30472007XE+05 1.56306857XE+04 1.51955749XE+04 6.91493552XE+04 1.14118978XE+05 4.43502290XE-01 4.99813962XE+03 8.45359343XE-01 3.90685258XE+04 6.46771103XE+02 1.06925065XE+05 5.40864529XE+04 7.63594122XE+03 4.85441211XE+02 3.22693731XE+02 2.61806911XE+03 6.09593520XE+04 3.31786805XE+00 1.14393984XE+04 2.03050479XE+04 4.29775564XE+03 1.85491976XE+02 5.09189212XE+05 1.71083980XE+04 5.57352845XE+01 5.40482487XE+02 1.14819870XE+05 6.80203486XE-02 5.90255956XE+04 7.72665115XE+04 1.25040686XE+05 5.76488600XE+03 2.53934972XE+03 2.27660560XE+02 2.76422157XE+02 3.70311161XE+02 3.81662294XE+03 1.21438618XE-04 2.27398863XE+04 6.61311632XE+03 4.53712032XE+03 5.94278981XE+04 9.25034322XE+03 1.55609090XE+04 1.04241373XE+05 3.64928257XE+03 4.85912460XE+04 2.91387435XE+03 4.14398588XE+04 3.94016152XE+02 5.67419348XE+04 7.13819419XE+03 7.28745857XE+03 5.21559205XE+03 2.30828871XE+03 1.80502275XE+02 5.67901527XE+01 1.36594340XE+01 9.32650696XE+02 3.30282610XE+04 7.64936073XE+04 1.97900238XE+04 3.36363188XE+03 1.96409024XE+03 2.21616620XE+03 6.37582851XE+03 2.18771972XE+02 3.71287661XE+03 1.45254580XE+03 4.95207318XE+02 3.01142174XE+04 1.87953212XE+04 7.95671395XE+04 1.29009570XE+03 1.86380823XE+03 1.88838161XE+02 1.42887209XE+03 1.34779708XE+01 8.12683855XE+02 3.66106438XE+02 8.11128518XE+00 5.21031998XE-01 5.95073443XE+00 1.52950096XE+04 1.69126970XE-01 6.63447947XE-01 2.42344642XE+02 3.51759780XE-04 4.39113217XE+02 9.04418763XE+02 6.62924299XE+02 4.60975762XE+00 2.55865155XE+02 0.00000000XE+00 4.82534949XE+04 0.00000000XE+00 0.00000000XE+00 2.02633806XE+02 1.01908840XE+03 1.08276933XE+03 2.06864748XE+03 2.64631328XE+03 8.26288938XE+01 4.64511421XE+02 8.14686389XE+03 0.00000000XE+00 1.36997460XE+02 1.91067085XE-02 2.78148088XE+02 8.88058147XE+01 7.72474596XE+02 3.62137319XE+02 2.98570521XE+02 9.08553269XE+00 2.06822068XE-01 2.50770886XE+01 5.97610931XE+03 1.00141130XE+02 6.77051058XE+02 5.50183939XE+02 2.79428444XE+01 4.21263938XE+00 1.14619066XE+04 1.10647006XE+01 3.52782096XE+02 0.00000000XE+00 2.45070548XE+04 2.68489851XE-02 5.18406745XE+02 7.78140388XE+02 6.45951603XE+02 3.89564555XE+02 7.68830774XE+01 7.37248861XE+01 5.53490054XE+00 4.49760888XE+02 6.52069014XE+02 8.01816378XE-05 1.67318463XE+02 9.04900123XE+02 3.78799320XE+02 2.31945296XE+02 1.04006960XE+00 5.70394610XE+01 2.13320707XE+04 0.00000000XE+00 5.81426755XE+04 1.52640506XE+04 3.92046571XE+02 3.24216074XE+01 1.66290525XE+02 7.57808670XE+03 2.02246740XE+02 4.60922342XE+01 1.99566800XE+00 5.96545915XE+00 0.00000000XE+00 4.40607520XE+02 1.15412542XE+02 5.17603289XE+02 6.43461009XE+02 1.46063905XE+02 1.45877789XE+02 3.27011038XE+01 8.91003130XE-01 1.07005584XE+02 1.07677799XE+01 8.48808351XE+02 1.27721760XE+02 3.99058731XE+01 1.97439978XE+02 1.24995144XE+02 8.95557984XE+02 3.22484976XE+01 3.29774967XE+00 6.61097200XE-01 1.44869982XE+01 1.59908389XE+01 1.57351457XE+04 5.29530528XE+03 1.34280256XE+02 1.33768164XE+01 1.40155121XE+04 5.89676641XE+05 4.77267716XE+00 9.23691260XE+00 1.29027814XE+03 8.50712282XE-03 6.27803601XE+03 2.55159861XE+04 1.14258311XE+04 7.83594425XE+01 1.02738196XE+04 0.00000000XE+00 1.23788887XE+06 0.00000000XE+00 0.00000000XE+00 3.33156930XE+03 1.77632581XE+04 2.82448341XE+04 1.05195502XE+05 5.39701641XE+04 3.47264819XE+03 4.82177894XE+04 1.03899276XE+06 3.27126875XE-01 2.02254365XE+03 4.71417482XE-01 9.76211016XE+03 1.31916297XE+03 2.05690900XE+04 2.13002444XE+04 4.97879119XE+03 1.39087127XE+02 4.33055386XE+00 9.89091058XE+02 4.02926904XE+04 8.18767425XE+02 1.28832639XE+04 7.72685292XE+03 9.61604531XE+02 8.41103585XE+01 3.75928226XE+05 4.65090805XE+03 4.77251360XE+03 1.38829774XE+02 6.03732387XE+04 9.94262266XE-01 1.80032802XE+04 2.31893548XE+04 4.66534520XE+04 7.32081062XE+03 1.09846588XE+03 9.36483240XE+02 2.95985479XE+02 1.24503989XE+04 8.56166658XE+03 1.43336633XE-03 1.57436999XE+04 1.29737631XE+04 5.11571505XE+03 2.62129696XE+04 3.76042676XE+04 4.69201465XE+03 6.24446959XE+05 0.00000000XE+00 1.90426472XE+05 3.85892964XE+05 1.97072537XE+04 5.11641446XE+02 3.24604899XE+04 1.35268283XE+05 5.98567262XE+03 1.33265292XE+03 7.21909830XE+02 2.48604496XE+03 0.00000000XE+00 5.87230151XE+03 1.75807228XE+03 1.04753679XE+04 1.54960266XE+04 6.47490083XE+03 2.91333527XE+03 1.34850171XE+03 8.78842864XE+02 4.58765209XE+03 7.69097285XE+02 6.34109762XE+03 2.13120350XE+03 1.22002926XE+03 6.71379810XE+03 5.78896608XE+03 2.06374173XE+04 8.87775765XE+02 5.27210954XE+02 7.54098023XE+01 3.67146197XE+02 5.91875391XE+02 8.35239333XE+02 3.27525128XE+02 2.52753455XE+03 0.00000000XE+00 3.20735196XE+02 1.33395828XE+04 1.46351007XE-01 7.49929284XE-01 5.95432860XE+02 1.09850917XE-03 4.31133757XE+02 1.01246282XE+03 6.05865902XE+02 2.75438403XE+00 3.11861045XE+02 0.00000000XE+00 2.24494076XE+04 1.32056278XE+03 0.00000000XE+00 4.62939623XE+02 1.04885356XE+03 1.02706999XE+03 1.27475102XE+03 3.31758305XE+03 2.22068086XE+02 9.09425646XE+03 1.34869659XE+04 0.00000000XE+00 3.09317173XE+02 1.73831148XE-01 1.26720511XE+01 7.91953128XE+01 1.86948956XE+03 4.87823215XE+02 1.48947739XE+03 3.28978429XE+03 4.32309982XE+02 7.16558486XE+01 7.10223059XE+03 3.67294716XE+02 7.03551553XE+02 5.93239930XE+02 1.07473252XE+03 2.86411968XE+03 4.20045237XE+03 7.67622634XE+01 1.47274502XE+03 4.98501021XE+00 3.51157119XE+04 1.38878924XE+04 5.37574715XE+02 8.50201901XE+02 7.83557258XE+02 4.21007422XE+02 5.49872161XE+01 2.62189117XE+02 3.13631624XE+01 6.95749054XE+02 2.37359241XE+03 6.53524185XE+01 4.26209505XE+00 8.93761717XE+02 3.49837841XE+02 3.11751086XE+02 2.52187590XE+03 3.74851537XE+02 3.88974786XE+04 1.28322612XE+04 8.58860429XE+04 9.29327481XE+03 1.04683127XE+02 4.84064952XE+01 1.04656315XE+03 2.42728038XE+03 2.25980138XE+02 2.05893383XE+03 1.29765757XE+01 2.86969915XE+01 0.00000000XE+00 1.46847292XE+01 1.06162717XE+02 5.08839671XE+02 6.47072048XE+02 2.00097744XE+02 1.43863022XE+02 4.01160664XE+01 5.37712365XE+01 2.14416884XE+02 3.15215603XE+01 2.40876565XE+03 1.63802347XE+02 4.18189272XE+01 2.19505990XE+02 1.40442071XE+02 6.99052270XE+02 3.42213157XE+01 8.63483962XE+00 2.03952402XE+00 1.20385236XE+02 4.36052959XE+01 5.12074687XE+04 2.41672453XE+04 2.44516345XE+05 0.00000000XE+00 2.95162354XE+04 1.32835355XE+06 1.31320728XE+01 2.92553427XE+01 3.27287452XE+03 3.70391886XE-02 1.95005695XE+04 8.04836158XE+04 3.11256827XE+04 1.07352694XE+02 2.93559236XE+04 0.00000000XE+00 1.60401039XE+06 4.21212586XE+04 0.00000000XE+00 2.11466520XE+04 5.73223130XE+04 6.47190498XE+04 9.14949649XE+04 3.23103881XE+05 1.09065232XE+04 7.35480837XE+05 1.85577161XE+06 0.00000000XE+00 4.89249310XE+03 2.20394551XE+00 5.47698309XE+02 3.92871700XE+03 9.77970846XE+04 5.65539553XE+04 9.29388636XE+04 1.27738543XE+05 4.23675490XE+04 2.76286648XE+03 5.00093218XE+04 4.44491130XE+03 4.27998050XE+04 2.56881017XE+04 5.40596496XE+04 1.29403065XE+05 1.54274900XE+05 1.03374338XE+04 5.79943146XE+04 3.92923465XE+02 8.75829676XE+04 6.24529088XE+05 5.45361333XE+04 7.22670849XE+04 1.07219139XE+05 2.23944585XE+04 2.27943701XE+03 8.70741362XE+03 1.06717888XE+03 5.19382637XE+04 2.72275278XE+04 1.48192066XE+02 1.93243182XE+02 6.00168657XE+04 1.33491462XE+04 4.64264049XE+04 3.04240699XE+05 4.04080799XE+04 1.67479844XE+06 1.08718319XE+06 2.91570992XE+05 2.58233045XE+05 1.17164803XE+04 4.57766512XE+03 6.24399708XE+04 1.27708901XE+05 1.79698828XE+04 3.45845770XE+05 2.04767347XE+03 1.85650364XE+03 0.00000000XE+00 4.78594406XE+02 5.60843428XE+03 3.20891289XE+04 4.23901973XE+04 2.32146938XE+04 8.35415031XE+03 3.96948142XE+03 2.62321299XE+03 9.46462425XE+03 3.84272248XE+03 1.26488384XE+05 1.07699566XE+04 2.39023170XE+03 2.13260030XE+04 1.73805284XE+04 1.78117052XE+04 2.77833962XE+03 1.51936478XE+03 2.16618161XE+02 3.02948340XE+03 4.16431700XE+03 3.25443835XE+04 1.28143340XE+05 1.57816052XE+05 7.05098666XE+01 4.61274152XE+03 9.38206675XE+04 4.48858242XE+00 4.57881509XE+01 1.02734765XE+04 2.92626710XE-02 1.30021686XE+04 5.56281666XE+04 6.28425877XE+04 7.38034737XE+01 8.81747457XE+03 3.61514939XE+02 1.78352129XE+05 2.47984821XE+04 0.00000000XE+00 6.87132644XE+02 4.29574310XE+04 2.83281900XE+04 1.10720191XE+05 1.66614105XE+05 1.49087768XE+04 2.02669814XE+05 6.37888286XE+04 0.00000000XE+00 4.42088549XE+03 3.25617052XE+00 4.50406820XE+04 1.81309205XE+03 1.42611158XE+05 2.76210502XE+04 1.46583527XE+05 1.10239652XE+05 1.16234217XE+04 1.83955408XE+03 1.48688997XE+05 3.98859192XE+03 4.15238120XE+04 4.29099359XE+04 1.26909230XE+05 4.69924119XE+05 1.84766739XE+05 1.16729883XE+03 2.98149589XE+04 6.36766746XE+01 3.79915620XE+06 3.91325290XE+04 2.35989076XE+04 5.41719888XE+04 3.03934182XE+04 1.75326220XE+04 7.52624943XE+03 1.00352681XE+04 8.85594593XE+04 1.69014219XE+04 7.63225880XE+04 3.67789313XE+03 7.41988058XE+03 4.21436276XE+04 1.00120501XE+04 2.55983078XE+04 1.06819381XE+05 1.41887970XE+04 3.59417103XE+05 5.74928455XE+05 2.70606387XE+05 1.90338258XE+04 1.19909726XE+04 1.46015806XE+03 3.42745825XE+04 1.19495063XE+05 7.32328916XE+03 4.01453892XE+03 1.14799245XE+05 7.07002784XE+02 7.78390233XE+03 9.20877975XE+02 2.74064536XE+03 1.60384791XE+04 4.62274687XE+04 1.45933244XE+04 5.61018723XE+03 1.37399388XE+03 2.64017773XE+03 4.89830356XE+03 8.20193472XE+03 1.40881074XE+05 2.35461012XE+04 1.71147643XE+03 1.07763319XE+04 4.69440551XE+03 2.36573689XE+04 1.69303192XE+03 4.90151027XE+02 1.26211214XE+04 8.46051109XE+03 4.90390199XE+01 1.05808303XE+02 1.45682929XE+03 1.34936998XE+02 1.45611133XE-01 5.73148423XE+01 6.71292976XE+01 5.87161758XE+00 1.58082576XE+00 3.43285095XE+01 2.12424407XE-04 8.21286154XE+02 1.55975166XE+03 1.07365579XE+03 7.22419017XE+01 2.30085555XE+02 1.38460295XE-01 4.94938674XE+01 3.68620615XE+00 0.00000000XE+00 7.27665430XE-01 1.69109951XE+02 8.98706898XE+02 5.58916309XE+02 9.28530365XE+01 1.07569175XE+01 4.57897357XE+01 1.78223429XE+01 3.01751241XE-03 2.89187835XE+01 1.76024240XE-03 1.98231305XE+02 9.08488578XE+02 2.35285607XE+02 3.09956865XE+01 5.48481628XE+01 4.23497698XE+01 7.32531379XE+00 1.15601788XE+00 6.28327259XE+02 5.88999332XE-01 8.49822726XE+01 5.64059927XE+02 3.18192343XE+02 6.75178620XE+01 1.77779681XE+03 2.35402108XE+01 8.65114629XE+02 2.03688914XE-03 5.39725246XE+03 1.76403815XE-03 1.12970704XE+02 3.48002945XE+02 2.93614097XE+02 6.11530269XE+01 2.16249759XE+02 2.30747675XE+01 1.82990165XE+01 4.48585880XE+00 6.09644190XE+00 1.79050206XE-04 7.09203659XE+01 2.78673534XE+02 5.61374743XE+02 2.63855152XE+02 8.38193629XE+00 8.50290923XE+00 5.52523771XE+01 1.08115148XE+00 2.83013296XE+02 2.70010913XE+01 2.80936910XE+02 2.24907079XE+02 1.35779044XE+03 6.72396004XE+01 9.13912913XE+01 2.26741424XE+01 6.30150791XE+00 1.01420842XE+00 1.17412980XE+00 2.85953317XE-01 2.41115445XE+02 3.25787427XE+02 5.53781010XE+02 1.39061208XE+01 1.83914803XE+02 1.16926299XE+01 1.44502426XE+00 5.48443276XE+00 1.15745341XE+00 2.32410998XE+01 2.53076140XE+01 3.44442980XE+01 1.41282483XE+02 2.61761800XE+01 7.98438297XE+02 4.33666456XE+01 2.41395652XE+00 1.63756179XE+00 1.30340414XE+00 7.15185018XE-02 8.53539372XE+03 5.57125141XE+03 3.12293506XE+02 1.38395018XE+01 4.15130514XE+03 1.56764373XE+05 6.92212848XE+01 9.93651730XE+01 1.55343211XE+01 6.49583568XE-03 4.98701180XE+03 3.68620222XE+04 5.59329080XE+04 2.89349502XE+02 9.54314122XE+03 2.01729393XE+02 5.88857499XE+05 4.33507004XE+04 0.00000000XE+00 1.08437975XE+03 2.16638260XE+04 1.26581857XE+04 1.22305884XE+05 9.83479531XE+04 1.52835922XE+04 4.56952531XE+03 1.65398897XE+05 7.45696676XE-01 5.50927914XE+01 1.09561098XE-01 4.28656293XE+04 2.18282353XE+03 1.27271196XE+04 2.79358801XE+04 3.03053368XE+04 1.33522360XE+03 7.44638260XE+04 2.95587150XE+02 1.04450570XE+02 3.04780290XE+02 1.90258946XE+04 2.40271627XE+04 9.99130689XE+02 4.27204018XE+03 3.12200657XE+03 3.27146313XE+03 1.79887670XE+04 4.47251418XE+02 7.48567003XE+01 1.63116241XE+04 8.87726709XE+03 3.59302723XE+04 1.17445340XE+04 1.61532272XE+04 1.98281927XE+03 1.87778363XE+04 2.45663931XE+05 1.60356197XE+04 5.60227288XE+03 8.83068701XE-02 3.22589426XE+03 2.03336473XE+04 5.41632080XE+03 1.50324771XE+04 7.48081350XE+04 1.31173485XE+04 8.08559457XE+04 6.73390393XE+04 1.70983254XE+02 3.05112386XE+02 3.47709414XE+03 6.79307822XE+02 2.66964625XE+04 8.04830658XE+05 7.99309047XE+03 1.75873143XE+04 1.10316567XE+03 1.50332037XE+04 0.00000000XE+00 7.05768332XE+02 1.15707001XE+03 7.17234196XE+03 5.92395645XE+04 2.88176789XE+04 7.56873621XE+03 3.08955929XE+03 4.69339915XE+04 3.66219001XE+03 2.16955905XE+02 3.79860876XE+02 1.37962558XE+03 4.74536607XE+02 2.57145104XE+03 2.49311556XE+03 7.34601004XE+03 3.60258130XE+03 6.52608928XE+02 7.08888573XE+01 6.54557644XE+01 1.59825095XE+01 3.25443835XE+04 1.28143340XE+05 1.57816052XE+05 7.05098666XE+01 4.61274152XE+03 9.38206675XE+04 4.48858242XE+00 4.57881509XE+01 1.02734765XE+04 2.92626710XE-02 1.30021686XE+04 5.56281666XE+04 6.28425877XE+04 7.38034737XE+01 8.81747457XE+03 3.61514939XE+02 1.78352129XE+05 2.47984821XE+04 0.00000000XE+00 6.87132644XE+02 4.29574310XE+04 2.83281900XE+04 1.10720191XE+05 1.66614105XE+05 1.49087768XE+04 2.02669814XE+05 6.37888286XE+04 0.00000000XE+00 4.42088549XE+03 3.25617052XE+00 4.50406820XE+04 1.81309205XE+03 1.42611158XE+05 2.76210502XE+04 1.46583527XE+05 1.10239652XE+05 1.16234217XE+04 1.83955408XE+03 1.48688997XE+05 3.98859192XE+03 4.15238120XE+04 4.29099359XE+04 1.26909230XE+05 4.69924119XE+05 1.84766739XE+05 1.16729883XE+03 2.98149589XE+04 6.36766746XE+01 3.79915620XE+06 3.91325290XE+04 2.35989076XE+04 5.41719888XE+04 3.03934182XE+04 1.75326220XE+04 7.52624943XE+03 1.00352681XE+04 8.85594593XE+04 1.69014219XE+04 7.63225880XE+04 3.67789313XE+03 7.41988058XE+03 4.21436276XE+04 1.00120501XE+04 2.55983078XE+04 1.06819381XE+05 1.41887970XE+04 3.59417103XE+05 5.74928455XE+05 2.70606387XE+05 1.90338258XE+04 1.19909726XE+04 1.46015806XE+03 3.42745825XE+04 1.19495063XE+05 7.32328916XE+03 4.01453892XE+03 1.14799245XE+05 7.07002784XE+02 7.78390233XE+03 9.20877975XE+02 2.74064536XE+03 1.60384791XE+04 4.62274687XE+04 1.45933244XE+04 5.61018723XE+03 1.37399388XE+03 2.64017773XE+03 4.89830356XE+03 8.20193472XE+03 1.40881074XE+05 2.35461012XE+04 1.71147643XE+03 1.07763319XE+04 4.69440551XE+03 2.36573689XE+04 1.69303192XE+03 4.90151027XE+02 1.26211214XE+04 8.46051109XE+03 4.90390199XE+01 6.41890518XE+04 3.35062920XE+04 1.41779183XE+05 0.00000000XE+00 1.79822563XE+04 1.02848941XE+05 4.58404636XE+00 6.54740823XE+01 3.29773202XE+04 5.77156027XE-02 2.37715704XE+04 1.11303599XE+05 2.16523491XE+04 1.60321551XE+02 1.48610981XE+04 0.00000000XE+00 1.71131421XE+05 3.34902608XE+04 0.00000000XE+00 1.19289318XE+03 8.45415222XE+04 4.90814494XE+04 1.95674890XE+05 1.45550350XE+05 2.70814781XE+04 1.75394848XE+05 1.19648262XE+05 0.00000000XE+00 1.32732971XE+04 1.03965412XE+01 4.89429947XE+02 2.64412670XE+03 1.13383308XE+05 5.33706731XE+04 2.47646872XE+05 1.21734608XE+05 1.62128268XE+04 6.27314414XE+03 4.18039121XE+05 1.27558469XE+04 8.53993268XE+04 8.67280999XE+04 1.19925941XE+05 2.75068949XE+05 2.93229344XE+05 2.85452782XE+03 6.26123559XE+04 2.25069405XE+02 5.16344064XE+06 3.00170449XE+04 4.84118784XE+04 1.07357496XE+05 6.37954449XE+04 3.00969830XE+04 2.32673078XE+03 1.63120161XE+04 2.30576785XE+03 2.91764929XE+04 1.48521240XE+05 6.84977415XE+03 2.86247846XE+02 8.31168588XE+04 1.68320616XE+04 5.08500734XE+04 9.05222012XE+04 2.50755313XE+04 2.78498744XE+05 9.02401348XE+05 4.93006558XE+05 3.00532167XE+04 4.53452074XE+03 1.86957186XE+03 3.85846931XE+04 1.04036976XE+05 1.22156547XE+04 8.84394005XE+04 5.70021737XE+02 1.36256686XE+03 0.00000000XE+00 4.21361513XE+01 4.84311757XE+03 3.33083286XE+04 8.38740208XE+04 3.02382306XE+04 1.11210533XE+04 2.34511193XE+03 3.35833780XE+03 1.60734294XE+04 9.83702727XE+02 3.62725796XE+05 1.82803608XE+04 3.48879648XE+03 2.15530706XE+04 9.04738472XE+03 3.70436999XE+04 3.33315739XE+03 4.38069528XE+02 1.75755653XE+02 1.38022536XE+04 9.79190122XE+01 1.96732836XE+04 4.96900295XE+03 1.44386873XE+02 4.11797557XE+01 1.86014406XE+03 1.11019357XE+05 3.58126254XE+00 2.55712712XE+01 4.75045182XE+03 1.50582112XE-02 6.41701376XE+03 4.38350029XE+04 6.91608178XE+04 7.27690837XE+01 4.62261718XE+03 3.26605995XE+02 3.49371173XE+05 0.00000000XE+00 0.00000000XE+00 5.06576645XE+02 2.72107549XE+04 1.49826617XE+04 1.60471172XE+05 9.13103761XE+04 1.27916132XE+04 8.85008412XE+03 2.98393438XE+04 0.00000000XE+00 1.85447898XE+03 1.51911568XE+00 5.43349620XE+04 1.49725721XE+03 1.32820949XE+04 1.88993560XE+04 1.17469024XE+04 1.23184046XE+02 4.14969252XE+00 9.38007836XE+02 1.19517536XE+05 3.18548774XE+03 3.07142832XE+04 3.52255236XE+04 5.17564022XE+02 5.78718913XE+01 2.73404927XE+05 1.28850393XE+02 1.68134644XE+04 7.78777993XE-01 3.91168763XE+05 1.24440462XE-01 1.49974396XE+04 4.16000263XE+04 1.64785199XE+04 1.02427345XE+04 1.00526855XE+03 1.26266455XE+04 9.57545047XE+02 1.73222077XE+04 7.42425021XE+03 2.28114409XE-03 5.25452768XE+03 2.98440112XE+04 5.08586178XE+03 2.11351478XE+04 1.43270984XE+04 1.47905325XE+04 8.05003002XE+04 0.00000000XE+00 3.21304544XE+05 4.77656874XE+04 5.74444728XE+03 5.21678575XE+02 1.36962258XE+04 3.10308584XE+05 3.48510314XE+03 2.68474413XE+03 2.49963152XE+01 4.92582023XE+02 0.00000000XE+00 9.42146553XE+02 1.53429741XE+03 1.13218332XE+04 3.63231722XE+04 1.07729556XE+04 4.65624490XE+03 6.23694853XE+02 7.33573389XE+01 2.77875735XE+03 3.02815114XE+02 3.49038485XE+04 2.75355040XE+03 8.25098899XE+02 6.67700142XE+03 2.31270924XE+03 1.50807072XE+04 6.14926546XE+02 2.80371148XE+02 6.44023787XE+01 3.27389411XE+02 3.43895122XE+01 3.18823571XE+02 1.72831855XE+03 1.64994632XE+02 5.85888539XE-01 4.91112423XE+01 1.53201604XE+04 4.76086415XE-01 1.76135211XE+00 2.70160769XE+02 5.74410966XE-04 1.07959353XE+03 1.19361809XE+03 7.21728404XE+02 9.52058252XE+01 3.46878326XE+02 1.82298770XE+00 5.24603533XE+03 1.07073587XE+02 0.00000000XE+00 1.79093149XE+00 3.86882546XE+02 1.34476388XE+03 1.32359372XE+03 3.50861990XE+03 7.65637705XE+01 3.11698040XE+03 2.77675857XE+03 1.41219960XE-01 1.98958770XE+02 5.02406227XE-02 2.13375139XE+02 9.54490520XE+02 1.08768234XE+03 2.95004295XE+02 1.48561118XE+02 2.18008391XE+01 8.30672649XE+01 2.01857805XE+01 3.36361925XE+03 2.90043080XE+01 2.26670502XE+02 4.59554975XE+02 3.52678127XE+02 4.00556922XE+01 5.56637393XE+03 3.05716923XE+01 6.02921624XE+01 9.44666006XE-03 2.60966600XE+04 5.80488678XE-03 2.68374883XE+02 3.41104698XE+02 1.15856839XE+03 5.57794042XE+01 1.93844329XE+02 6.35689545XE+01 9.31800944XE+00 9.35991154XE+01 3.82847130XE+02 7.12458397XE-05 8.93007065XE+01 4.79048890XE+02 7.76649042XE+02 5.35119783XE+02 7.99776677XE+01 7.44200604XE+01 4.38118910XE+03 4.44322262XE+00 8.13971306XE+04 3.61101265XE+02 4.03509154XE+02 2.89230326XE+02 1.16020876XE+03 1.32794286XE+03 1.44864372XE+02 6.18637155XE+01 1.45067156XE+01 4.63086637XE+00 3.01732226XE+01 4.61881213XE+00 3.64166382XE+02 6.11564125XE+02 9.47447071XE+02 1.06856415XE+02 2.76661352XE+02 1.04664883XE+01 7.29434056XE+01 5.21166584XE+01 3.05206084XE+01 7.16336639XE+02 1.94145832XE+02 4.99846161XE+01 2.69396321XE+02 1.24414793XE+02 1.59728645XE+03 1.07825282XE+01 2.09125884XE+01 2.90491716XE+00 4.16753392XE+01 4.31552230XE-01 5.52579151XE+04 1.61482778XE+04 2.49538423XE+02 6.55707470XE-01 3.81258558XE+03 1.28831405XE+05 2.98561567XE+01 5.81903760XE+01 3.88509469XE+01 1.33040929XE-02 4.34640101XE+03 9.83151685XE+04 9.30796699XE+04 1.99245687XE+02 1.64285937XE+04 4.48620131XE+02 4.39375913XE+05 0.00000000XE+00 0.00000000XE+00 2.28060466XE+03 1.00048065XE+05 1.12556818XE+04 5.82620948XE+04 1.00166026XE+05 2.92879929XE+04 3.67355379XE+03 7.33598672XE+04 4.21365851XE-02 1.03576220XE+01 2.48083826XE-01 2.75048291XE+03 1.86340417XE+03 1.33950088XE+04 5.58852500XE+04 4.26021194XE+04 3.80593058XE+02 4.36306934XE+01 9.76663227XE+01 7.50521867XE+02 5.72825567XE+02 6.89747566XE+04 6.23786447XE+04 7.05882374XE+02 8.77101220XE+03 1.25561969XE+04 6.14271552XE+02 8.75199009XE+01 4.01480573XE+01 2.79584983XE+04 8.78689599XE+03 5.05646780XE+04 8.21290283XE+04 6.49393122XE+04 7.70849549XE+04 1.25864812XE+03 2.65697200XE+04 2.15875506XE+05 2.45160217XE+04 9.76816797XE+03 9.68931908XE+00 9.73484542XE+03 1.18617984XE+05 3.43122868XE+03 3.23872146XE+04 2.10946513XE+04 2.00910857XE+04 8.32707310XE+04 4.01289724XE+03 1.54986414XE+03 5.98612574XE+02 3.51685940XE+03 5.62315342XE+02 2.33048635XE+04 5.89763581XE+05 1.16650061XE+04 1.31487441XE+04 1.91146255XE+02 1.46729844XE+03 0.00000000XE+00 1.22667948XE+03 2.59274560XE+03 3.64541586XE+04 9.70805513XE+04 2.68580165XE+04 7.07163450XE+03 4.48942155XE+03 1.93319758XE+03 1.84417086XE+02 9.04073532XE+02 9.48086907XE+02 5.08683264XE+03 6.55407075XE+02 1.82368367XE+04 4.57155114XE+03 6.56419393XE+03 3.20243952XE+03 5.11633526XE+02 1.01884768XE+02 6.42320719XE+00 9.52650874XE+01 2.06157542XE+04 5.22344650XE+03 1.52764958XE+02 4.33035895XE+01 1.89007780XE+03 1.10426034XE+05 3.33104882XE+00 2.92273870XE+01 5.15438375XE+03 1.67528897XE-02 7.29673174XE+03 4.39537375XE+04 6.88573041XE+04 7.93917178XE+01 4.69272496XE+03 3.28237886XE+02 3.43969076XE+05 0.00000000XE+00 0.00000000XE+00 4.89413398XE+02 2.80979534XE+04 1.55125702XE+04 1.61360045XE+05 9.11778771XE+04 1.27671735XE+04 9.48141815XE+03 2.97054056XE+04 0.00000000XE+00 2.06458411XE+03 1.49267402XE+00 5.42743696XE+04 1.53535586XE+03 1.44803509XE+04 1.86846512XE+04 1.20783929XE+04 1.29014998XE+02 4.26730759XE+00 9.50674163XE+02 1.27113617XE+05 3.16551093XE+03 3.07851615XE+04 3.55905888XE+04 4.99334942XE+02 5.85492634XE+01 2.88935933XE+05 1.41947083XE+02 1.73137712XE+04 8.07714021XE-01 4.33023014XE+05 1.29415821XE-01 1.56054395XE+04 4.13120455XE+04 1.71730730XE+04 1.01262529XE+04 1.07544468XE+03 1.31585105XE+04 9.70063940XE+02 1.72359833XE+04 7.48357631XE+03 2.64512109XE-03 5.28006419XE+03 3.05548852XE+04 5.78556096XE+03 2.12299888XE+04 1.43057186XE+04 1.48037702XE+04 8.03260123XE+04 0.00000000XE+00 3.20270322XE+05 4.80706031XE+04 6.51082608XE+03 5.49014283XE+02 1.37914781XE+04 2.99589237XE+05 3.53309952XE+03 2.50518271XE+03 2.57382595XE+01 4.97743859XE+02 0.00000000XE+00 9.47662166XE+02 1.66999191XE+03 1.13693523XE+04 3.49310893XE+04 1.09108206XE+04 4.67088645XE+03 6.11989793XE+02 7.69139815XE+01 2.85784499XE+03 3.08124629XE+02 3.50893058XE+04 2.97659627XE+03 9.31015543XE+02 7.02252195XE+03 2.46345653XE+03 1.70291053XE+04 5.63061161XE+02 3.00230260XE+02 6.48962156XE+01 3.43372392XE+02 3.51298172XE+01 6.41890518XE+04 3.35062920XE+04 1.41779183XE+05 0.00000000XE+00 1.79822563XE+04 1.02848941XE+05 4.58404636XE+00 6.54740823XE+01 3.29773202XE+04 5.77156027XE-02 2.37715704XE+04 1.11303599XE+05 2.16523491XE+04 1.60321551XE+02 1.48610981XE+04 0.00000000XE+00 1.71131421XE+05 3.34902608XE+04 0.00000000XE+00 1.19289318XE+03 8.45415222XE+04 4.90814494XE+04 1.95674890XE+05 1.45550350XE+05 2.70814781XE+04 1.75394848XE+05 1.19648262XE+05 0.00000000XE+00 1.32732971XE+04 1.03965412XE+01 4.89429947XE+02 2.64412670XE+03 1.13383308XE+05 5.33706731XE+04 2.47646872XE+05 1.21734608XE+05 1.62128268XE+04 6.27314414XE+03 4.18039121XE+05 1.27558469XE+04 8.53993268XE+04 8.67280999XE+04 1.19925941XE+05 2.75068949XE+05 2.93229344XE+05 2.85452782XE+03 6.26123559XE+04 2.25069405XE+02 5.16344064XE+06 3.00170449XE+04 4.84118784XE+04 1.07357496XE+05 6.37954449XE+04 3.00969830XE+04 2.32673078XE+03 1.63120161XE+04 2.30576785XE+03 2.91764929XE+04 1.48521240XE+05 6.84977415XE+03 2.86247846XE+02 8.31168588XE+04 1.68320616XE+04 5.08500734XE+04 9.05222012XE+04 2.50755313XE+04 2.78498744XE+05 9.02401348XE+05 4.93006558XE+05 3.00532167XE+04 4.53452074XE+03 1.86957186XE+03 3.85846931XE+04 1.04036976XE+05 1.22156547XE+04 8.84394005XE+04 5.70021737XE+02 1.36256686XE+03 0.00000000XE+00 4.21361513XE+01 4.84311757XE+03 3.33083286XE+04 8.38740208XE+04 3.02382306XE+04 1.11210533XE+04 2.34511193XE+03 3.35833780XE+03 1.60734294XE+04 9.83702727XE+02 3.62725796XE+05 1.82803608XE+04 3.48879648XE+03 2.15530706XE+04 9.04738472XE+03 3.70436999XE+04 3.33315739XE+03 4.38069528XE+02 1.75755653XE+02 1.38022536XE+04 9.79190122XE+01
	Index: trunk/ChangeLog
	===================================================================
	--- trunk/ChangeLog (revision 8835)
	+++ trunk/ChangeLog (revision 8836)
	@@ -1,2322 +1,2325 @@
	ChangeLog -- Summary of changes to the WHIZARD package

	Use svn log to see detailed changes.

	Version 3.0.3+

	+2022-06-22
	+ POWHEG matching for Drell-Yan and similar processes
	+
	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: Mon, Apr 22, 5:29 AM (2 d)
Storage Engine: chunks
Storage Format: Chunks
Storage Handle: .0BxLP0n26hZ
Default Alt Text: (4 MB)

Offset	End	Complete
0	4194304	Yes
4194304	4391262	Yes

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions