process_integration.nw
No OneTemporary
Actions

Size

752 KB

Subscribers

None

process_integration.nw
View Options

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

	% -- 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 constants, only: zero, one
	use io_units
	use format_utils, only: write_separator
	use diagnostics
	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>>

	contains

	<<Subevt expr: procedures>>

	end module subevt_expr
	@ %def subevt_expr
	@
	\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: procedures>>=
	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 var_list_write (object%var_list, 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: procedures>>=
	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: procedures>>=
	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 var_list_append_real (expr%var_list, &
	var_str ("sqrts"), sqrts, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call var_list_append_real_ptr (expr%var_list, &
	var_str ("sqrts_hat"), expr%sqrts_hat, &
	is_known = expr%subevt_filled, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call var_list_append_int_ptr (expr%var_list, &
	var_str ("n_in"), expr%n_in, &
	is_known = expr%subevt_filled, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call var_list_append_int_ptr (expr%var_list, &
	var_str ("n_out"), expr%n_out, &
	is_known = expr%subevt_filled, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call var_list_append_int_ptr (expr%var_list, &
	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: procedures>>=
	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 var_list_append_subevt_ptr &
	(expr%var_list, &
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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

	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: procedures>>=
	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: procedures>>=
	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 subevt_set_pdg_beam (expr%subevt_t, f_beam%get_pdg ())
	call subevt_set_pdg_incoming (expr%subevt_t, f_in%get_pdg ())
	call subevt_set_pdg_outgoing (expr%subevt_t, f_out%get_pdg ())
	call subevt_set_p2_beam (expr%subevt_t, f_beam%get_mass () ** 2)
	call subevt_set_p2_incoming (expr%subevt_t, f_in%get_mass () ** 2)
	call subevt_set_p2_outgoing (expr%subevt_t, 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
	@ 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: 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 (subevt, 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 (subevt, 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 (subevt, n_beam + n_in + i, &
	flv(j)%get_pdg (), &
	vector4_null, &
	flv(j)%get_mass () ** 2)
	end do
	end subroutine interaction_to_subevt

	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 (subevt, - int%get_momenta (j_beam))
	call subevt_set_p_incoming (subevt, - int%get_momenta (j_in))
	call subevt_set_p_outgoing (subevt, int%get_momenta (j_out))
	end subroutine interaction_momenta_to_subevt_id

	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 &
	(subevt, - lt * int%get_momenta (j_beam))
	call subevt_set_p_incoming &
	(subevt, - lt * int%get_momenta (j_in))
	call subevt_set_p_outgoing &
	(subevt, 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: procedures>>=
	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 = subevt_get_sqrts_hat (expr%subevt_t)
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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 var_list_append_string_ptr (expr%var_list, &
	var_str ("$process_id"), expr%id, &
	is_known = expr%has_id, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call var_list_append_int_ptr (expr%var_list, &
	var_str ("process_num_id"), expr%num_id, &
	is_known = expr%has_num_id, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call var_list_append_real_ptr (expr%var_list, &
	var_str ("sqme"), expr%sqme_prc, &
	is_known = expr%has_sqme_prc, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call var_list_append_real_ptr (expr%var_list, &
	var_str ("sqme_ref"), expr%sqme_ref, &
	is_known = expr%has_sqme_ref, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call var_list_append_int_ptr (expr%var_list, &
	var_str ("event_index"), expr%index, &
	is_known = expr%has_index, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call var_list_append_real_ptr (expr%var_list, &
	var_str ("event_weight"), expr%weight_prc, &
	is_known = expr%has_weight_prc, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call var_list_append_real_ptr (expr%var_list, &
	var_str ("event_weight_ref"), expr%weight_ref, &
	is_known = expr%has_weight_ref, &
	locked = .true., verbose = .false., intrinsic = .true.)
	call var_list_append_real_ptr (expr%var_list, &
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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

	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: procedures>>=
	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

	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: procedures>>=
	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

	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

	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: procedures>>=
	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 = subevt_get_sqrts_hat (expr%subevt_t)
	expr%n_in = subevt_get_n_in (expr%subevt_t)
	expr%n_out = subevt_get_n_out (expr%subevt_t)
	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: procedures>>=
	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 debug>>
	use io_units
	use format_utils, only: write_separator
	use diagnostics
	use lorentz
	use subevents
	use variables
	use expr_base
	use model_data
	use flavors
	use helicities
	use colors
	use quantum_numbers
	use state_matrices
	use polarizations
	use interactions
	use evaluators

	use beams
	use sf_base
	use process_constants
	use prc_core
	use subevt_expr

	<<Standard module head>>

	<<Parton states: public>>

	<<Parton states: types>>

	contains

	<<Parton states: procedures>>

	end module parton_states
	@ %def parton_states
	@
	\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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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 interaction_get_flv_content &
	(state%matrix%interaction_t, 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: procedures>>=
	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: procedures>>=
	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
	@ 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: procedures>>=
	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: procedures>>=
	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

	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

	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

	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	subroutine parton_state_send_kinematics (state)
	class(parton_state_t), intent(inout), target :: state
	if (state%has_trace) then
	call interaction_send_momenta (state%trace%interaction_t)
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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

	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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 io_units
	use diagnostics
	use format_utils, only: write_integer_array
	use format_utils, only: write_separator
	use physics_defs, only: BORN, NLO_REAL
	<<Use strings>>
	use os_interface, only: os_data_t

	use process_libraries, only: process_component_def_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>>

	contains

	<<PCM base: procedures>>

	end module pcm_base
	@ %def pcm_base
	@
	\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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	pure 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 io_units
	use format_utils, only: write_separator
	use constants
	use diagnostics
	use numeric_utils
	use lorentz
	use cputime
	use md5
	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 integration_results
	use mci_base
	use flavors
	use model_data
	use models
	use physics_defs
	use process_libraries
	use process_constants
	use particles
	use variables
	use beam_structures
	use beams
	use interactions
	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 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 phs_base
	use mappings, only: mapping_defaults_t
	use phs_forests, only: phs_parameters_t
	use phs_wood, only: phs_wood_config_t
	use dispatch_phase_space, only: dispatch_phs
	use blha_config, only: blha_master_t
	use nlo_data, only: FKS_DEFAULT, FKS_RESONANCES

	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: public parameters>>

	<<Process: types>>

	<<Process: interfaces>>

	contains

	<<Process: procedures>>

	end module process
	@ %def process
	@
	\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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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.
	<<Process: process: TBP>>=
	procedure :: init => process_init
	<<Process: 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.
	<<Process: 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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
	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, &
	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"))
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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 (component%component_type /= 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)
	singular_real = component%get_nlo_type () == NLO_REAL &
	.and. component%component_type /= COMP_REAL_FIN
	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: procedures>>=
	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_array_get_length (pdg_in) == 1) .and. &
	all (pdg_in(1,:) == pdg_in(1,i0)) .and. &
	all (pdg_in(2,:) == pdg_in(2,i0))) then
	pdg_scattering = pdg_array_get (pdg_in(:,i0), 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: procedures>>=
	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_array_get_length (pdg_in) == 1) &
	.and. all (pdg_in(1,:) == pdg_in(1,i0))) then
	pdg_decay = pdg_array_get (pdg_in(:,i0), 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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
	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: procedures>>=
	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
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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 (component%component_type /= 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: procedures>>=
	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: procedures>>=
	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

	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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

	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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

	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

	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

	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

	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

	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: procedures>>=
	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

	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
	@
	<<Process: process: TBP>>=
	procedure :: lab_is_cm => process_lab_is_cm
	<<Process: procedures>>=
	pure 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
	! This asks beam_config for the frame
	end function process_lab_is_cm

	@ %def process_lab_is_cm
	@
	<<Process: process: TBP>>=
	procedure :: get_component_ptr => process_get_component_ptr
	<<Process: procedures>>=
	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: procedures>>=
	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: procedures>>=
	elemental 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	pure 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: procedures>>=
	pure 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: procedures>>=
	pure 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: procedures>>=
	pure 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	integer function process_get_i_core (process, i_term) result (i_core)
	class(process_t), intent(in) :: process
	integer, intent(in) :: i_term
	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: procedures>>=
	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: procedures>>=
	pure 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: procedures>>=
	elemental 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: procedures>>=
	elemental 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: procedures>>=
	elemental 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: procedures>>=
	pure 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: procedures>>=
	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

	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

	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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

	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

	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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 interaction_get_flv_out (int, 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	function process_get_polarization (process) result (pol)
	class(process_t), intent(in) :: process
	real(default), dimension(2) :: 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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_component_type => process_set_component_type
	<<Process: procedures>>=
	subroutine process_set_component_type (process, i_component, i_type)
	class(process_t), intent(inout) :: process
	integer, intent(in) :: i_component, i_type
	process%component(i_component)%component_type = i_type
	end subroutine process_set_component_type

	@ %def process_set_component_type
	@
	<<Process: process: TBP>>=
	procedure :: set_counter_mci_entry => process_set_counter_mci_entry
	<<Process: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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

	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: procedures>>=
	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.
	<<Process: process: TBP>>=
	procedure :: setup_test_cores => process_setup_test_cores
	<<Process: procedures>>=
	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

	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

	@ %def process_setup_test_cores
	@
	<<Process: process: TBP>>=
	procedure :: get_connected_states => process_get_connected_states
	<<Process: procedures>>=
	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: procedures>>=
	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: procedures>>=
	elemental 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: procedures>>=
	pure 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	pure 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: procedures>>=
	elemental 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	elemental 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: procedures>>=
	pure 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: procedures>>=
	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 format_utils, only: write_separator
	use io_units
	use md5
	use os_interface
	use diagnostics
	use sf_base
	use sf_mappings
	use mappings, only: mapping_defaults_t
	use phs_forests, only: phs_parameters_t
	use sm_qcd
	use physics_defs
	use integration_results
	use model_data
	use models
	use interactions
	use quantum_numbers
	use flavors
	use helicities
	use colors
	use rng_base
	use state_matrices
	use process_libraries
	use process_constants
	use prc_core
	use prc_external
	use prc_openloops, only: prc_openloops_t
	use prc_threshold, only: prc_threshold_t
	use beams
	use dispatch_beams, only: dispatch_qcd
	use mci_base
	use beam_structures
	use phs_base
	use variables
	use expr_base
	use blha_olp_interfaces, only: prc_blha_t

	<<Standard module head>>

	<<Process config: public>>

	<<Process config: parameters>>

	<<Process config: types>>

	contains

	<<Process config: procedures>>

	end module process_config
	@ %def process_config
	@ 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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.
	<<Process config: process config data: TBP>>=
	procedure :: init => process_config_data_init
	<<Process config: 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	pure 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	pure 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: procedures>>=
	pure 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	elemental 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	pure 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	elemental 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: procedures>>=
	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: procedures>>=
	elemental 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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 a 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: procedures>>=
	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: procedures>>=
	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_userdef_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: procedures>>=
	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

	use io_units

	<<Standard module head>>

	<<Process counter: public>>

	<<Process counter: parameters>>

	<<Process counter: types>>

	contains

	<<Process counter: procedures>>

	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: procedures>>=
	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
	@ Reset. Just enforce default initialization.
	<<Process counter: process counter: TBP>>=
	procedure :: reset => process_counter_reset
	<<Process counter: procedures>>=
	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: procedures>>=
	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 debug>>
	use io_units
	use diagnostics
	use physics_defs
	use md5
	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>>

	contains

	<<Process mci: procedures>>

	end module process_mci
	@ %def process_mci
	\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: procedures>>=
	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: procedures>>=
	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 a
	MCI entry.
	<<Process mci: process mci entry: TBP>>=
	procedure :: configure => process_mci_entry_configure
	<<Process mci: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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

	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

	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

	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

	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

	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: procedures>>=
	pure 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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

	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: procedures>>=
	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: procedures>>=
	pure 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 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: procedures>>=
	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

	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: procedures>>=
	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

	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 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 debug>>
	use constants, only: zero, two
	use diagnostics
	use lorentz
	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 model_data, only: model_data_t
	use models, only: model_t
	use interactions, only: interaction_t
	use quantum_numbers, only: quantum_numbers_t, quantum_numbers_mask_t
	use flavors, only: flavor_t
	use variables, only: var_list_t
	use nlo_data, only: nlo_settings_t
	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 dispatch_fks, only: dispatch_fks_s
	use fks_regions, only: region_data_t
	use nlo_data, only: fks_template_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 process_libraries, only: process_component_def_t
	use real_subtraction, only: real_subtraction_t, soft_mismatch_t
	use real_subtraction, only: FIXED_ORDER_EVENTS, POWHEG
	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 prc_threshold, only: threshold_def_t
	use resonances, only: resonance_history_t, resonance_history_set_t
	use nlo_data, only: FKS_DEFAULT, FKS_RESONANCES
	use blha_config, only: blha_master_t
	use blha_olp_interfaces, only: prc_blha_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>>

	contains

	<<Pcm: procedures>>

	end module pcm
	@ %def pcm
	@
	\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
	<<Pcm: pcm default: TBP>>=
	procedure :: allocate_workspace => pcm_default_allocate_workspace
	<<Pcm: 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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_s (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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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
	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
	integer, intent(in) :: alpha_power, alphas_power
	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.
	<<Pcm: pcm nlo: TBP>>=
	procedure :: setup_real_partition => pcm_nlo_setup_real_partition
	<<Pcm: 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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
	@
	<<Pcm: pcm nlo: TBP>>=
	procedure :: allocate_workspace => pcm_nlo_allocate_workspace
	<<Pcm: 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: procedures>>=
	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
	@
	<<Pcm: pcm nlo: TBP>>=
	procedure :: allocate_ps_matching => pcm_nlo_allocate_ps_matching
	<<Pcm: 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	<<Pcm: pcm instance: TBP>>=
	procedure :: set_powheg_mode => pcm_nlo_workspace_set_powheg_mode
	<<Pcm: procedures>>=
	subroutine pcm_nlo_workspace_set_powheg_mode (pcm_work)
	class(pcm_nlo_workspace_t), intent(inout) :: pcm_work
	pcm_work%real_sub%purpose = POWHEG
	end subroutine pcm_nlo_workspace_set_powheg_mode

	@ %def pcm_nlo_workspace_set_fixed_order_event_mode
	@ %def pcm_nlo_workspace_set_powheg_mode
	@
	<<Pcm: pcm instance: TBP>>=
	procedure :: init_soft_mismatch => pcm_nlo_workspace_init_soft_mismatch
	<<Pcm: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\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 debug>>
	use format_utils, only: write_separator
	use diagnostics
	use io_units
	use lorentz
	use phs_points, only: assignment(=), size
	use physics_defs
	use sf_base
	use phs_base
	use interactions
	use mci_base
	use phs_fks
	use fks_regions
	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
	use ttv_formfactors, only: m1s_to_mpole

	<<Standard module head>>

	<<Kinematics: public>>

	<<Kinematics: types>>

	contains

	<<Kinematics: procedures>>

	end module kinematics
	@ %def kinematics
	<<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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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 debug>>
	use io_units
	use format_utils, only: write_separator
	use constants
	use diagnostics
	use os_interface
	use numeric_utils
	use lorentz
	use mci_base
	use particles
	use sm_qcd, only: qcd_t
	use interactions
	use quantum_numbers
	use model_data
	use helicities
	use flavors
	use beam_structures
	use variables
	use pdg_arrays, only: is_quark
	use sf_base
	use physics_defs
	use process_constants
	use process_libraries
	use state_matrices
	use integration_results
	use phs_base
	use prc_core, only: prc_core_t, prc_core_state_t

	!!! 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_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
	!!! 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>>

	contains

	<<Instances: procedures>>

	end module instances
	@ %def instances
	@
	\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.
	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.
	contains
	<<Instances: term instance: TBP>>
	end type term_instance_t

	@ %def term_instance_t
	@
	<<Instances: term instance: TBP>>=
	procedure :: write => term_instance_write
	<<Instances: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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 ()

	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 ())
	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: procedures>>=
	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: procedures>>=
	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
	@
	<<Instances: term instance: TBP>>=
	procedure :: init_interaction_qn_index => term_instance_init_interaction_qn_index
	<<Instances: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	subroutine term_instance_apply_real_partition (term, kin, process)
	class(term_instance_t), intent(inout) :: term
	type(kinematics_t), intent(in) :: kin
	type(process_t), intent(in) :: process
	real(default) :: f, sqme
	integer :: i_component
	integer :: i_amp, n_amps, qn_index
	logical :: is_subtraction
	i_component = term%config%i_component
	if (process%component_is_selected (i_component) .and. &
	process%get_component_nlo_type (i_component) == NLO_REAL) then
	is_subtraction = process%get_component_type (i_component) == COMP_REAL_SING &
	.and. kin%emitter < 0
	if (is_subtraction) return
	select case (process%get_component_type (i_component))
	case (COMP_REAL_FIN)
	call term%connected%trace%set_duplicate_flv_zero()
	end select
	select type (pcm => process%get_pcm_ptr ())
	type is (pcm_nlo_t)
	f = pcm%real_partition%get_f (term%p_hard)
	end select
	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)
	sqme = real (term%connected%trace%get_matrix_element (qn_index))
	if (debug_on) call msg_debug2 (D_PROCESS_INTEGRATION, "term_instance_apply_real_partition")
	select type (pcm => term%pcm)
	type is (pcm_nlo_t)
	select case (process%get_component_type (i_component))
	case (COMP_REAL_FIN, COMP_REAL_SING)
	select case (process%get_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
	end select
	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 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: procedures>>=
	pure 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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
	real(default), dimension(:), allocatable :: sqme
	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 ()
	sqme(i_sub) = real(term%connected%trace%get_matrix_element ( &
	term%connected%trace%get_qn_index (i_flv, i_sub = i_sub + n_offset)), &
	default)
	end do
	call blha_color_c_fill_offdiag (pcm%region_data%n_legs_born, &
	sqme, sqme_color_c)
	call blha_color_c_fill_diag (real(term%connected%trace%get_matrix_element ( &
	term%connected%trace%get_qn_index (i_flv, i_sub = 0)), default), &
	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: procedures>>=
	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: procedures>>=
	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
	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
	sqme_spin_c_all(i_sub) = real(term%connected%trace%get_matrix_element &
	(term%connected%trace%get_qn_index (i_flv, &
	i_sub = i_sub + n_offset + n_sub_color)), default)
	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: procedures>>=
	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
	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 ()
	pcm_work%real_sub%sqme_real_non_sub (i, i_phs) = &
	real (term%connected%trace%get_matrix_element ( &
	term%connected%trace%get_qn_index (i)))
	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: procedures>>=
	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
	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 ()
	virtual%sqme_born(i_flv) = &
	real (term%connected%trace%get_matrix_element ( &
	term%connected%trace%get_qn_index (i_flv, i_sub = 0)))
	virtual%sqme_virt_fin(i_flv) = &
	real (term%connected%trace%get_matrix_element ( &
	term%connected%trace%get_qn_index (i_flv, i_sub = 1)))
	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
	@
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_sqme_mismatch => term_instance_evaluate_sqme_mismatch
	<<Instances: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	subroutine term_instance_evaluate_expressions (term, scale_forced)
	class(term_instance_t), intent(inout) :: term
	real(default), intent(in), allocatable, optional :: scale_forced
	call term%connected%evaluate_expressions (term%passed, &
	term%scale, term%fac_scale, term%ren_scale, term%weight, &
	scale_forced, force_evaluation = .true.)
	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: procedures>>=
	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_userdef (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: procedures>>=
	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_userdef &
	=> term_instance_evaluate_interaction_userdef
	<<Instances: procedures>>=
	subroutine term_instance_evaluate_interaction_userdef (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_userdef")
	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_userdef_loop (core)
	else
	call term%evaluate_interaction_userdef_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_userdef

	@ %def term_instance_evaluate_interaction_userdef
	@ 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_userdef_tree &
	=> term_instance_evaluate_interaction_userdef_tree
	<<Instances: procedures>>=
	subroutine term_instance_evaluate_interaction_userdef_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_userdef_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
	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_userdef_tree

	@ %def term_instance_evaluate_interaction_userdef_tree
	@ Same as for [[term_instance_evaluate_interaction_userdef_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_userdef_loop &
	=> term_instance_evaluate_interaction_userdef_loop
	<<Instances: procedures>>=
	subroutine term_instance_evaluate_interaction_userdef_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_userdef_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
	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_userdef_loop

	@ %def term_instance_evaluate_interaction_userdef_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: procedures>>=
	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]].\\
	References: arXiv:0709.2092, (2.35)-(2.42).\\
	Obviously, it is completely irrelevant, which beam is treated.
	It becomes problematic when handling [[e, p]]-beams.
	<<Instances: term instance: TBP>>=
	procedure :: evaluate_scaled_sf_chains => term_instance_evaluate_scaled_sf_chains
	<<Instances: 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	elemental 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: procedures>>=
	elemental 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: procedures>>=
	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

	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

	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 a [[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)
	import :: process_instance_hook_t, var_list_t, process_instance_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
	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	pure 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: procedures>>=
	pure 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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 (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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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
	real(default) :: alpha_s, alpha_qed
	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
	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, instance%process)
	if (term%config%i_component /= i_real_fin) then
	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 ()
	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: procedures>>=
	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)
	sqme = real (term%connected%trace%get_matrix_element (ii_flv))
	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)]].
	Altough 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: procedures>>=
	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: procedures>>=
	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)), &
	process)
	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: procedures>>=
	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: procedures>>=
	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. Also, e.g. for Powheg, there is the possibility
	to supply an external $\alpha_s$.
	<<Instances: process instance: TBP>>=
	procedure :: compute_sqme_rad => process_instance_compute_sqme_rad
	<<Instances: procedures>>=
	subroutine process_instance_compute_sqme_rad &
	(instance, i_term, i_phs, is_subtraction, alpha_s_external)
	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
	class(prc_core_t), pointer :: core
	integer :: i_real_fin
	logical :: has_pdfs
	has_pdfs = instance%process%pcm_contains_pdfs ()
	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)) &
	call term%set_alpha_qcd_forced (alpha_s_external)
	call term%compute_eff_kinematics ()
	call term%evaluate_expressions ()
	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 ())
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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

	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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

	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.
	<<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: procedures>>=
	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

	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

	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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

	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 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: procedures>>=
	pure 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	pure 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	function process_instance_get_polarization (instance) result (pol)
	class(process_instance_t), intent(in) :: instance
	real(default), dimension(2) :: 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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

	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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 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)
	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
	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 io_units
	use format_utils, only: write_separator
	use diagnostics
	use os_interface
	use sm_qcd
	use model_data
	use rng_base
	use variables
	use observables
	use process_libraries
	use process

	<<Standard module head>>

	<<Process stacks: public>>

	<<Process stacks: types>>

	contains

	<<Process stacks: procedures>>

	end module process_stacks
	@ %def process_stacks
	@
	\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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	recursive 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: procedures>>=
	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 var_list_write (object%var_list, 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: procedures>>=
	recursive 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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	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: procedures>>=
	recursive 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
	@

File Metadata

Mime Type: text/x-tex
Expires: Sun, Feb 23, 2:52 PM (22 h, 50 m)
Storage Engine: blob
Storage Format: Raw Data
Storage Handle: 4486723
Default Alt Text: process_integration.nw (752 KB)

process_integration.nwNo OneTemporaryActions

process_integration.nwView Options

File Metadata

Event Timeline

process_integration.nw
No OneTemporary
Actions

process_integration.nw
View Options