mci.nw
No OneTemporary
Actions

Size

336 KB

Subscribers

None

mci.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 event generation
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Multi-Channel Integration}

	The abstract representation of multi-channel
	Monte Carlo algorithms for integration and event generation.
	\begin{description}
	\item[Module [[mci_base]]:]
	The abstract types and their methods. It provides a test integrator
	that is referenced in later unit tests.
	\item[iterations]
	Container for defining integration call and pass settings.
	\item[integration\_results]
	This module handles results from integrating processes. It records passes
	and iterations, calculates statistical averages, and provides the user
	output of integration results.
	\end{description}

	These are the implementations:
	\begin{description}
	\item[Module [[mci_midpoint]]:]
	A simple integrator that uses the midpoint rule to sample the
	integrand uniformly over the unit hypercube. There is only one
	integration channel, so this can be matched only to single-channel
	phase space.
	\item[Module [[mci_vamp]]:]
	Interface for the VAMP package.
	\end{description}


	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\clearpage
	\section{Generic Integrator}
	This module provides a multi-channel integrator (MCI) base type, a
	corresponding configuration type, and methods for integration and event
	generation.

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

	module mci_base

	use kinds
	<<Use strings>>
	use io_units
	use format_utils, only: pac_fmt
	use format_defs, only: FMT_14, FMT_17
	use unit_tests
	use diagnostics
	use cputime
	use phs_base
	use rng_base

	<<Standard module head>>

	<<MCI base: public>>

	<<MCI base: types>>

	<<MCI base: interfaces>>

	<<MCI base: test types>>

	contains

	<<MCI base: procedures>>

	<<MCI base: tests>>

	end module mci_base
	@ %def mci_base
	@
	\subsection{MCI: integrator}
	The MCI object contains the methods for integration and event generation.
	For the actual work and data storage, it spawns an MCI instance object.

	The base object contains the number of integration dimensions and the number
	of channels as configuration data. Further configuration data are stored in
	the concrete extensions.

	The MCI sum contains all relevant information about the integrand. It can be
	used for comparing the current configuration against a previous one. If they
	match, we can skip an actual integration. (Implemented only for the VAMP
	version.)

	There is a random-number generator (its state with associated methods)
	available as [[rng]]. It may or may not be used for integration. It
	will be used for event generation.
	<<MCI base: public>>=
	public :: mci_t
	<<MCI base: types>>=
	type, abstract :: mci_t
	integer :: n_dim = 0
	integer :: n_channel = 0
	integer :: n_chain = 0
	integer, dimension(:), allocatable :: chain
	real(default), dimension(:), allocatable :: chain_weights
	character(32) :: md5sum = ""
	logical :: integral_known = .false.
	logical :: error_known = .false.
	logical :: efficiency_known = .false.
	real(default) :: integral = 0
	real(default) :: error = 0
	real(default) :: efficiency = 0
	logical :: use_timer = .false.
	type(timer_t) :: timer
	class(rng_t), allocatable :: rng
	contains
	<<MCI base: mci: TBP>>
	end type mci_t

	@ %def mci_t
	@ Finalizer: the random-number generator may need one.
	<<MCI base: mci: TBP>>=
	procedure :: base_final => mci_final
	procedure (mci_final), deferred :: final
	<<MCI base: procedures>>=
	subroutine mci_final (object)
	class(mci_t), intent(inout) :: object
	if (allocated (object%rng)) call object%rng%final ()
	end subroutine mci_final

	@ %def mci_final
	@ Output: basic and extended output.
	<<MCI base: mci: TBP>>=
	procedure :: base_write => mci_write
	procedure (mci_write), deferred :: write
	<<MCI base: procedures>>=
	subroutine mci_write (object, unit, pacify, md5sum_version)
	class(mci_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacify
	logical, intent(in), optional :: md5sum_version
	logical :: md5sum_ver
	integer :: u, i, j
	character(len=7) :: fmt
	call pac_fmt (fmt, FMT_17, FMT_14, pacify)
	u = given_output_unit (unit)
	md5sum_ver = .false.
	if (present (md5sum_version)) md5sum_ver = md5sum_version
	if (object%use_timer .and. .not. md5sum_ver) then
	write (u, "(2x)", advance="no")
	call object%timer%write (u)
	end if
	if (object%integral_known) then
	write (u, "(3x,A," // fmt // ")") &
	"Integral = ", object%integral
	end if
	if (object%error_known) then
	write (u, "(3x,A," // fmt // ")") &
	"Error = ", object%error
	end if
	if (object%efficiency_known) then
	write (u, "(3x,A," // fmt // ")") &
	"Efficiency = ", object%efficiency
	end if
	write (u, "(3x,A,I0)") "Number of channels = ", object%n_channel
	write (u, "(3x,A,I0)") "Number of dimensions = ", object%n_dim
	if (object%n_chain > 0) then
	write (u, "(3x,A,I0)") "Number of chains = ", object%n_chain
	write (u, "(3x,A)") "Chains:"
	do i = 1, object%n_chain
	write (u, "(5x,I0,':')", advance = "no") i
	do j = 1, object%n_channel
	if (object%chain(j) == i) &
	write (u, "(1x,I0)", advance = "no") j
	end do
	write (u, "(A)")
	end do
	end if
	end subroutine mci_write

	@ %def mci_write
	@ Print an informative message when starting integration.
	<<MCI base: mci: TBP>>=
	procedure (mci_startup_message), deferred :: startup_message
	procedure :: base_startup_message => mci_startup_message
	<<MCI base: procedures>>=
	subroutine mci_startup_message (mci, unit, n_calls)
	class(mci_t), intent(in) :: mci
	integer, intent(in), optional :: unit, n_calls
	if (mci%n_chain > 0) then
	write (msg_buffer, "(A,3(1x,I0,1x,A))") &
	"Integrator:", mci%n_chain, "chains,", &
	mci%n_channel, "channels,", &
	mci%n_dim, "dimensions"
	else
	write (msg_buffer, "(A,3(1x,I0,1x,A))") &
	"Integrator:", &
	mci%n_channel, "channels,", &
	mci%n_dim, "dimensions"
	end if
	call msg_message (unit = unit)
	end subroutine mci_startup_message

	@ %def mci_startup_message
	@ Record the index of the MCI object within a process. For
	multi-component processes with more than one integrator, the
	integrator should know about its own index, so file names can be
	unique, etc. The default implementation does nothing, however.
	<<MCI base: mci: TBP>>=
	procedure :: record_index => mci_record_index
	<<MCI base: procedures>>=
	subroutine mci_record_index (mci, i_mci)
	class(mci_t), intent(inout) :: mci
	integer, intent(in) :: i_mci
	end subroutine mci_record_index

	@ %def mci_record_index
	@ There is no Initializer for the abstract type, but a generic setter
	for the number of channels and dimensions. We make two aliases
	available, to be able to override it.
	<<MCI base: mci: TBP>>=
	procedure :: set_dimensions => mci_set_dimensions
	procedure :: base_set_dimensions => mci_set_dimensions
	<<MCI base: procedures>>=
	subroutine mci_set_dimensions (mci, n_dim, n_channel)
	class(mci_t), intent(inout) :: mci
	integer, intent(in) :: n_dim
	integer, intent(in) :: n_channel
	mci%n_dim = n_dim
	mci%n_channel = n_channel
	end subroutine mci_set_dimensions

	@ %def mci_set_dimensions
	@ Declare particular dimensions as flat. This information can be used
	to simplify integration. When generating events, the flat dimensions
	should be sampled with uniform and uncorrelated distribution. It
	depends on the integrator what to do with that information.
	<<MCI base: mci: TBP>>=
	procedure (mci_declare_flat_dimensions), deferred :: declare_flat_dimensions
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_declare_flat_dimensions (mci, dim_flat)
	import
	class(mci_t), intent(inout) :: mci
	integer, dimension(:), intent(in) :: dim_flat
	end subroutine mci_declare_flat_dimensions
	end interface

	@ %def mci_declare_flat_dimensions
	@ Declare particular channels as equivalent, possibly allowing for
	permutations or reflections of dimensions. We use the information
	stored in the [[phs_channel_t]] object array that the phase-space module
	provides.

	(We do not test this here, deferring the unit test to the [[mci_vamp]]
	implementation where we actually use this feature.)
	<<MCI base: mci: TBP>>=
	procedure (mci_declare_equivalences), deferred :: declare_equivalences
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_declare_equivalences (mci, channel, dim_offset)
	import
	class(mci_t), intent(inout) :: mci
	type(phs_channel_t), dimension(:), intent(in) :: channel
	integer, intent(in) :: dim_offset
	end subroutine mci_declare_equivalences
	end interface

	@ %def mci_declare_equivalences
	@ Declare particular channels as chained together. The implementation may use
	this array for keeping their weights equal to each other, etc.

	The chain array is an array sized by the number of channels. For each
	channel, there is an integer entry that indicates the correponding
	chains. The total number of chains is the maximum value of this
	entry.
	<<MCI base: mci: TBP>>=
	procedure :: declare_chains => mci_declare_chains
	<<MCI base: procedures>>=
	subroutine mci_declare_chains (mci, chain)
	class(mci_t), intent(inout) :: mci
	integer, dimension(:), intent(in) :: chain
	allocate (mci%chain (size (chain)))
	mci%n_chain = maxval (chain)
	allocate (mci%chain_weights (mci%n_chain), source = 0._default)
	mci%chain = chain
	end subroutine mci_declare_chains

	@ %def mci_declare_chains
	@ Collect channel weights according to chains and store them in the
	[[chain_weights]] for output. We sum up the weights for all channels that
	share the same [[chain]] index and store the results in the [[chain_weights]]
	array.
	<<MCI base: mci: TBP>>=
	procedure :: collect_chain_weights => mci_collect_chain_weights
	<<MCI base: procedures>>=
	subroutine mci_collect_chain_weights (mci, weight)
	class(mci_t), intent(inout) :: mci
	real(default), dimension(:), intent(in) :: weight
	integer :: i, c
	if (allocated (mci%chain)) then
	mci%chain_weights = 0
	do i = 1, size (mci%chain)
	c = mci%chain(i)
	mci%chain_weights(c) = mci%chain_weights(c) + weight(i)
	end do
	end if
	end subroutine mci_collect_chain_weights

	@ %def mci_collect_chain_weights
	@ Check if there are chains.
	<<MCI base: mci: TBP>>=
	procedure :: has_chains => mci_has_chains
	<<MCI base: procedures>>=
	function mci_has_chains (mci) result (flag)
	class(mci_t), intent(in) :: mci
	logical :: flag
	flag = allocated (mci%chain)
	end function mci_has_chains

	@ %def mci_has_chains
	@ Output of the chain weights, kept separate from the main [[write]] method.

	[The formatting will work as long as the number of chains is less than
	$10^{10}$\ldots]
	<<MCI base: mci: TBP>>=
	procedure :: write_chain_weights => mci_write_chain_weights
	<<MCI base: procedures>>=
	subroutine mci_write_chain_weights (mci, unit)
	class(mci_t), intent(in) :: mci
	integer, intent(in), optional :: unit
	integer :: u, i, n, n_digits
	character(4) :: ifmt
	u = given_output_unit (unit)
	if (allocated (mci%chain_weights)) then
	write (u, "(1x,A)") "Weights of channel chains (groves):"
	n_digits = 0
	n = size (mci%chain_weights)
	do while (n > 0)
	n = n / 10
	n_digits = n_digits + 1
	end do
	write (ifmt, "(A1,I1)") "I", n_digits
	do i = 1, size (mci%chain_weights)
	write (u, "(3x," // ifmt // ",F13.10)") i, mci%chain_weights(i)
	end do
	end if
	end subroutine mci_write_chain_weights

	@ %def mci_write_chain_weights
	@ Set the MD5 sum, independent of initialization.
	<<MCI base: mci: TBP>>=
	procedure :: set_md5sum => mci_set_md5sum
	<<MCI base: procedures>>=
	subroutine mci_set_md5sum (mci, md5sum)
	class(mci_t), intent(inout) :: mci
	character(32), intent(in) :: md5sum
	mci%md5sum = md5sum
	end subroutine mci_set_md5sum

	@ %def mci_set_md5sum
	@ Initialize a new integration pass. This is not necessarily
	meaningful, so we provide an empty base method. The [[mci_vamp]]
	implementation overrides this.
	<<MCI base: mci: TBP>>=
	procedure :: add_pass => mci_add_pass
	<<MCI base: procedures>>=
	subroutine mci_add_pass (mci, adapt_grids, adapt_weights, final)
	class(mci_t), intent(inout) :: mci
	logical, intent(in), optional :: adapt_grids
	logical, intent(in), optional :: adapt_weights
	logical, intent(in), optional :: final
	end subroutine mci_add_pass

	@ %def mci_add_pass
	@ Allocate an instance with matching type. This must be deferred.
	<<MCI base: mci: TBP>>=
	procedure (mci_allocate_instance), deferred :: allocate_instance
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_allocate_instance (mci, mci_instance)
	import
	class(mci_t), intent(in) :: mci
	class(mci_instance_t), intent(out), pointer :: mci_instance
	end subroutine mci_allocate_instance
	end interface

	@ %def mci_allocate_instance
	@ Import a random-number generator. We transfer the allocation of an
	existing generator state into the object. The generator state may
	already be initialized, or we can reset it by its [[init]]
	method.
	<<MCI base: mci: TBP>>=
	procedure :: import_rng => mci_import_rng
	<<MCI base: procedures>>=
	subroutine mci_import_rng (mci, rng)
	class(mci_t), intent(inout) :: mci
	class(rng_t), intent(inout), allocatable :: rng
	call move_alloc (rng, mci%rng)
	end subroutine mci_import_rng

	@ %def mci_import_rng
	@ Activate or deactivate the timer.
	<<MCI base: mci: TBP>>=
	procedure :: set_timer => mci_set_timer
	<<MCI base: procedures>>=
	subroutine mci_set_timer (mci, active)
	class(mci_t), intent(inout) :: mci
	logical, intent(in) :: active
	mci%use_timer = active
	end subroutine mci_set_timer

	@ %def mci_set_timer
	@ Start and stop signal for the timer, if active. The elapsed time
	can then be retrieved from the MCI record.
	<<MCI base: mci: TBP>>=
	procedure :: start_timer => mci_start_timer
	procedure :: stop_timer => mci_stop_timer
	<<MCI base: procedures>>=
	subroutine mci_start_timer (mci)
	class(mci_t), intent(inout) :: mci
	if (mci%use_timer) call mci%timer%start ()
	end subroutine mci_start_timer

	subroutine mci_stop_timer (mci)
	class(mci_t), intent(inout) :: mci
	if (mci%use_timer) call mci%timer%stop ()
	end subroutine mci_stop_timer

	@ %def mci_start_timer
	@ %def mci_stop_timer
	@ Sampler test. Evaluate the sampler a given number of times. Results are
	discarded, so we don't need the MCI instance which would record them.

	The evaluation channel is iterated, and the [[x]] parameters are randomly
	chosen.
	<<MCI base: mci: TBP>>=
	procedure :: sampler_test => mci_sampler_test
	<<MCI base: procedures>>=
	subroutine mci_sampler_test (mci, sampler, n_calls)
	class(mci_t), intent(inout) :: mci
	class(mci_sampler_t), intent(inout), target :: sampler
	integer, intent(in) :: n_calls
	real(default), dimension(:), allocatable :: x_in, f
	real(default), dimension(:,:), allocatable :: x_out
	real(default) :: val
	integer :: i, c
	allocate (x_in (mci%n_dim))
	allocate (f (mci%n_channel))
	allocate (x_out (mci%n_dim, mci%n_channel))
	do i = 1, n_calls
	c = mod (i, mci%n_channel) + 1
	call mci%rng%generate_array (x_in)
	call sampler%evaluate (c, x_in, val, x_out, f)
	end do
	end subroutine mci_sampler_test

	@ %def mci_sampler_test
	@ Integrate: this depends on the implementation. We foresee a pacify
	flag to take care of small numerical noise on different platforms.
	<<MCI base: mci: TBP>>=
	procedure (mci_integrate), deferred :: integrate
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_integrate (mci, instance, sampler, &
	n_it, n_calls, results, pacify)
	import
	class(mci_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout) :: instance
	class(mci_sampler_t), intent(inout) :: sampler
	integer, intent(in) :: n_it
	integer, intent(in) :: n_calls
	logical, intent(in), optional :: pacify
	class(mci_results_t), intent(inout), optional :: results
	end subroutine mci_integrate
	end interface

	@ %def mci_integrate
	@ Event generation. Depending on the implementation,
	event generation may or may not require a previous integration pass.

	Instead of a black-box [[simulate]] method, we require an initializer,
	a finalizer, and procedures for generating a single event. This
	allows us to interface simulation event by event from the outside, and
	it facilitates the further processing of an event after successful
	generation. For integration, this is not necessary.

	The initializer has [[intent(inout)]] for the [[mci]] passed object. The
	reason is that the initializer can read integration results and grids from
	file, where the results can modify the [[mci]] record.
	<<MCI base: mci: TBP>>=
	procedure (mci_prepare_simulation), deferred :: prepare_simulation
	@ %def mci_final_simulation
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_prepare_simulation (mci)
	import
	class(mci_t), intent(inout) :: mci
	end subroutine mci_prepare_simulation
	end interface

	@ %def mci_prepare_simulation
	@
	The generated event will reside in in the [[instance]] object (overall
	results and weight) and in the [[sampler]] object (detailed data). In
	the real application, we can subsequently call methods of the
	[[sampler]] in order to further process the generated event.

	The [[target]] attributes are required by the VAMP implementation,
	which uses pointers to refer to the instance and sampler objects from
	within the integration function.
	<<MCI base: mci: TBP>>=
	procedure (mci_generate), deferred :: generate_weighted_event
	procedure (mci_generate), deferred :: generate_unweighted_event
	@ %def mci_generate_weighted_event
	@ %def mci_generate_unweighted_event
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_generate (mci, instance, sampler)
	import
	class(mci_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout), target :: instance
	class(mci_sampler_t), intent(inout), target :: sampler
	end subroutine mci_generate
	end interface

	@ %def mci_generate
	@ This is analogous, but we rebuild the event from the information
	stored in [[state]] instead of generating it.

	Note: currently unused outside of tests, might be deleted later.
	<<MCI base: mci: TBP>>=
	procedure (mci_rebuild), deferred :: rebuild_event
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_rebuild (mci, instance, sampler, state)
	import
	class(mci_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout) :: instance
	class(mci_sampler_t), intent(inout) :: sampler
	class(mci_state_t), intent(in) :: state
	end subroutine mci_rebuild
	end interface

	@ %def mci_rebuild
	@ Return the value of the integral, error, efficiency, and time per call.
	<<MCI base: mci: TBP>>=
	procedure :: get_integral => mci_get_integral
	procedure :: get_error => mci_get_error
	procedure :: get_efficiency => mci_get_efficiency
	procedure :: get_time => mci_get_time
	<<MCI base: procedures>>=
	function mci_get_integral (mci) result (integral)
	class(mci_t), intent(in) :: mci
	real(default) :: integral
	if (mci%integral_known) then
	integral = mci%integral
	else
	call msg_bug ("The integral is unknown. This is presumably a" // &
	"WHIZARD bug.")
	end if
	end function mci_get_integral

	function mci_get_error (mci) result (error)
	class(mci_t), intent(in) :: mci
	real(default) :: error
	if (mci%error_known) then
	error = mci%error
	else
	error = 0
	end if
	end function mci_get_error

	function mci_get_efficiency (mci) result (efficiency)
	class(mci_t), intent(in) :: mci
	real(default) :: efficiency
	if (mci%efficiency_known) then
	efficiency = mci%efficiency
	else
	efficiency = 0
	end if
	end function mci_get_efficiency

	function mci_get_time (mci) result (time)
	class(mci_t), intent(in) :: mci
	real(default) :: time
	if (mci%use_timer) then
	time = mci%timer
	else
	time = 0
	end if
	end function mci_get_time

	@ %def mci_get_integral
	@ %def mci_get_error
	@ %def mci_get_efficiency
	@ %def mci_get_time
	@ Return the MD5 sum of the configuration. This may be overridden in
	an extension, to return a different MD5 sum.
	<<MCI base: mci: TBP>>=
	procedure :: get_md5sum => mci_get_md5sum
	<<MCI base: procedures>>=
	function mci_get_md5sum (mci) result (md5sum)
	class(mci_t), intent(in) :: mci
	character(32) :: md5sum
	md5sum = mci%md5sum
	end function mci_get_md5sum

	@ %def mci_get_md5sum
	@
	\subsection{MCI instance}
	The base type contains an array of channel weights. The value [[mci_weight]]
	is the combined MCI weight that corresponds to a particular sampling point.

	For convenience, we also store the [[x]] and Jacobian values for this sampling
	point.
	<<MCI base: public>>=
	public :: mci_instance_t
	<<MCI base: types>>=
	type, abstract :: mci_instance_t
	logical :: valid = .false.
	real(default), dimension(:), allocatable :: w
	real(default), dimension(:), allocatable :: f
	real(default), dimension(:,:), allocatable :: x
	integer :: selected_channel = 0
	real(default) :: mci_weight = 0
	real(default) :: integrand = 0
	contains
	<<MCI base: mci instance: TBP>>
	end type mci_instance_t

	@ %def mci_instance_t
	@ Output: deferred
	<<MCI base: mci instance: TBP>>=
	procedure (mci_instance_write), deferred :: write
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_instance_write (object, unit, pacify)
	import
	class(mci_instance_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacify
	end subroutine mci_instance_write
	end interface

	@ %def mci_instance_write
	@ A finalizer, just in case.
	<<MCI base: mci instance: TBP>>=
	procedure (mci_instance_final), deferred :: final
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_instance_final (object)
	import
	class(mci_instance_t), intent(inout) :: object
	end subroutine mci_instance_final
	end interface

	@ %def mci_instance_final
	@ Init: basic initializer for the arrays, otherwise deferred. Assigning
	the [[mci]] object is also deferred, because it depends on the concrete type.

	The weights are initialized with an uniform normalized value.
	<<MCI base: mci instance: TBP>>=
	procedure (mci_instance_base_init), deferred :: init
	procedure :: base_init => mci_instance_base_init
	<<MCI base: procedures>>=
	subroutine mci_instance_base_init (mci_instance, mci)
	class(mci_instance_t), intent(out) :: mci_instance
	class(mci_t), intent(in), target :: mci
	allocate (mci_instance%w (mci%n_channel))
	allocate (mci_instance%f (mci%n_channel))
	allocate (mci_instance%x (mci%n_dim, mci%n_channel))
	if (size (mci_instance%w) /= 0) then
	mci_instance%w = 1._default / size (mci_instance%w)
	end if
	mci_instance%f = 0
	mci_instance%x = 0
	end subroutine mci_instance_base_init

	@ %def mci_instance_base_init
	@ Compute the overall weight factor for a configuration of $x$ values and
	Jacobians $f$. The $x$ values come in [[n_channel]] rows with [[n_dim]]
	entries each. The $f$ factors constitute an array with [[n_channel]] entries.

	We assume that the $x$ and $f$ arrays are already stored inside the MC
	instance. The result is also stored there.
	<<MCI base: mci instance: TBP>>=
	procedure (mci_instance_compute_weight), deferred :: compute_weight
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_instance_compute_weight (mci, c)
	import
	class(mci_instance_t), intent(inout) :: mci
	integer, intent(in) :: c
	end subroutine mci_instance_compute_weight
	end interface

	@ %def mci_instance_compute_weight
	@ Record the integrand as returned by the sampler. Depending on the
	implementation, this may merely copy the value, or do more complicated things.

	We may need the MCI weight for the actual computations, so this should
	be called after the previous routine.
	<<MCI base: mci instance: TBP>>=
	procedure (mci_instance_record_integrand), deferred :: record_integrand
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_instance_record_integrand (mci, integrand)
	import
	class(mci_instance_t), intent(inout) :: mci
	real(default), intent(in) :: integrand
	end subroutine mci_instance_record_integrand
	end interface

	@ %def mci_instance_record_integrand
	@ Sample a point directly: evaluate the sampler, then compute the weight and
	the weighted integrand. Finally, record the integrand within the MCI instance.

	If a signal (interrupt) was raised recently, we abort the calculation before
	entering the sampler. Thus, a previous calculation will have
	completed and any data are already recorded, but any new point can be
	discarded. If the [[abort]] flag is present, we may delay the interrupt, so
	we can do some cleanup.
	<<MCI base: mci instance: TBP>>=
	procedure :: evaluate => mci_instance_evaluate
	<<MCI base: procedures>>=
	subroutine mci_instance_evaluate (mci, sampler, c, x)
	class(mci_instance_t), intent(inout) :: mci
	class(mci_sampler_t), intent(inout) :: sampler
	integer, intent(in) :: c
	real(default), dimension(:), intent(in) :: x
	real(default) :: val
	call sampler%evaluate (c, x, val, mci%x, mci%f)
	mci%valid = sampler%is_valid ()
	if (mci%valid) then
	call mci%compute_weight (c)
	call mci%record_integrand (val)
	end if
	end subroutine mci_instance_evaluate

	@ %def mci_instance_evaluate
	@ Initiate and terminate simulation. In contrast to integration, we implement
	these as methods of the process instance, since the [[mci]] configuration
	object is unchanged.

	The safety factor reduces the acceptance probability for unweighted
	events. The implementation of this feature depends on the concrete type.
	<<MCI base: mci instance: TBP>>=
	procedure (mci_instance_init_simulation), deferred :: init_simulation
	procedure (mci_instance_final_simulation), deferred :: final_simulation
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_instance_init_simulation (instance, safety_factor)
	import
	class(mci_instance_t), intent(inout) :: instance
	real(default), intent(in), optional :: safety_factor
	end subroutine mci_instance_init_simulation
	end interface

	abstract interface
	subroutine mci_instance_final_simulation (instance)
	import
	class(mci_instance_t), intent(inout) :: instance
	end subroutine mci_instance_final_simulation
	end interface

	@ %def mci_instance_init_simulation mci_instance_final_simulation
	@ Assuming that the sampler is in a completely defined state, just
	extract the data that [[evaluate]] would compute. Also record the integrand.
	<<MCI base: mci instance: TBP>>=
	procedure :: fetch => mci_instance_fetch
	<<MCI base: procedures>>=
	subroutine mci_instance_fetch (mci, sampler, c)
	class(mci_instance_t), intent(inout) :: mci
	class(mci_sampler_t), intent(in) :: sampler
	integer, intent(in) :: c
	real(default) :: val
	mci%valid = sampler%is_valid ()
	if (mci%valid) then
	call sampler%fetch (val, mci%x, mci%f)
	call mci%compute_weight (c)
	call mci%record_integrand (val)
	end if
	end subroutine mci_instance_fetch

	@ %def mci_instance_fetch
	@ The value, i.e., the weighted integrand, is the integrand (which
	should be taken as-is from the sampler) multiplied by the MCI weight.
	<<MCI base: mci instance: TBP>>=
	procedure :: get_value => mci_instance_get_value
	<<MCI base: procedures>>=
	function mci_instance_get_value (mci) result (value)
	class(mci_instance_t), intent(in) :: mci
	real(default) :: value
	if (mci%valid) then
	value = mci%integrand * mci%mci_weight
	else
	value = 0
	end if
	end function mci_instance_get_value

	@ %def mci_instance_get_value
	@ This is an extra routine. By default, the event weight is equal to
	the value returned by the previous routine. However, if we select a
	channel for event generation not just based on the channel weights,
	the event weight has to account for this bias, so the event weight
	that applies to event generation is different. In that case, we
	should override the default routine.
	<<MCI base: mci instance: TBP>>=
	procedure :: get_event_weight => mci_instance_get_value
	@ %def mci_instance_get_event_weight
	@ Excess weight can occur during unweighted event generation, if the
	assumed maximum value of the integrand is too small. This excess
	should be normalized in the same way as the event weight above (which
	for unweighted events becomes unity).
	<<MCI base: mci instance: TBP>>=
	procedure (mci_instance_get_event_excess), deferred :: get_event_excess
	<<MCI base: interfaces>>=
	abstract interface
	function mci_instance_get_event_excess (mci) result (excess)
	import
	class(mci_instance_t), intent(in) :: mci
	real(default) :: excess
	end function mci_instance_get_event_excess
	end interface

	@ %def mci_instance_get_event_excess
	@
	\subsection{MCI state}
	This object can hold the relevant information that allows us to
	reconstruct the MCI instance without re-evaluating the sampler completely.

	We store the [[x_in]] MC input parameter set, which coincides with the
	section of the complete [[x]] array that belongs to a particular
	channel. We also store the MC function value. When we want to
	reconstruct the state, we can use the input array to recover the
	complete [[x]] and [[f]] arrays (i.e., the kinematics), but do not
	need to recompute the MC function value (the dynamics).

	The [[mci_state_t]] may be extended, to allow storing/recalling more
	information. In that case, we would override the type-bound
	procedures. However, the base type is also a concrete type and
	self-contained.
	<<MCI base: public>>=
	public :: mci_state_t
	<<MCI base: types>>=
	type :: mci_state_t
	integer :: selected_channel = 0
	real(default), dimension(:), allocatable :: x_in
	real(default) :: val
	contains
	<<MCI base: mci state: TBP>>
	end type mci_state_t

	@ %def mci_state_t
	@ Output:
	<<MCI base: mci state: TBP>>=
	procedure :: write => mci_state_write
	<<MCI base: procedures>>=
	subroutine mci_state_write (object, unit)
	class(mci_state_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "MCI state:"
	write (u, "(3x,A,I0)") "Channel = ", object%selected_channel
	write (u, "(3x,A,999(1x,F12.10))") "x (in) =", object%x_in
	write (u, "(3x,A,ES19.12)") "Integrand = ", object%val
	end subroutine mci_state_write

	@ %def mci_state_write
	@ To store the object, we take the relevant section of the [[x]]
	array. The channel used for storing data is taken from the
	[[instance]] object, but it could be arbitrary in principle.
	<<MCI base: mci instance: TBP>>=
	procedure :: store => mci_instance_store
	<<MCI base: procedures>>=
	subroutine mci_instance_store (mci, state)
	class(mci_instance_t), intent(in) :: mci
	class(mci_state_t), intent(out) :: state
	state%selected_channel = mci%selected_channel
	allocate (state%x_in (size (mci%x, 1)))
	state%x_in = mci%x(:,mci%selected_channel)
	state%val = mci%integrand
	end subroutine mci_instance_store

	@ %def mci_instance_store
	@ Recalling the state, we must consult the sampler in order to fully
	reconstruct the [[x]] and [[f]] arrays. The integrand value is known,
	and we also give it to the sampler, bypassing evaluation.

	The final steps are equivalent to the [[evaluate]] method above.
	<<MCI base: mci instance: TBP>>=
	procedure :: recall => mci_instance_recall
	<<MCI base: procedures>>=
	subroutine mci_instance_recall (mci, sampler, state)
	class(mci_instance_t), intent(inout) :: mci
	class(mci_sampler_t), intent(inout) :: sampler
	class(mci_state_t), intent(in) :: state
	if (size (state%x_in) == size (mci%x, 1) &
	.and. state%selected_channel <= size (mci%x, 2)) then
	call sampler%rebuild (state%selected_channel, &
	state%x_in, state%val, mci%x, mci%f)
	call mci%compute_weight (state%selected_channel)
	call mci%record_integrand (state%val)
	else
	call msg_fatal ("Recalling event: mismatch in channel or dimension")
	end if
	end subroutine mci_instance_recall

	@ %def mci_instance_recall
	@
	\subsection{MCI sampler}
	A sampler is an object that implements a multi-channel parameterization of the
	unit hypercube. Specifically, it is able to compute, given a channel and a
	set of $x$ MC parameter values, a the complete set of $x$ values and
	associated Jacobian factors $f$ for all channels.

	Furthermore, the sampler should return a single real value, the integrand, for
	the given point in the hypercube.

	It must implement a method [[evaluate]] for performing the above
	computations.
	<<MCI base: public>>=
	public :: mci_sampler_t
	<<MCI base: types>>=
	type, abstract :: mci_sampler_t
	contains
	<<MCI base: mci sampler: TBP>>
	end type mci_sampler_t

	@ %def mci_sampler_t
	@ Output, deferred to the implementation.
	<<MCI base: mci sampler: TBP>>=
	procedure (mci_sampler_write), deferred :: write
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_sampler_write (object, unit, testflag)
	import
	class(mci_sampler_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine mci_sampler_write
	end interface

	@ %def mci_sampler_write
	@ The evaluation routine. Input is the channel index [[c]] and the
	one-dimensional parameter array [[x_in]]. Output are the integrand value
	[[val]], the two-dimensional parameter array [[x]] and the Jacobian array
	[[f]].
	<<MCI base: mci sampler: TBP>>=
	procedure (mci_sampler_evaluate), deferred :: evaluate
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_sampler_evaluate (sampler, c, x_in, val, x, f)
	import
	class(mci_sampler_t), intent(inout) :: sampler
	integer, intent(in) :: c
	real(default), dimension(:), intent(in) :: x_in
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	end subroutine mci_sampler_evaluate
	end interface

	@ %def mci_sampler_evaluate
	@ Query the validity of the sampling point. Can be called after
	[[evaluate]].
	<<MCI base: mci sampler: TBP>>=
	procedure (mci_sampler_is_valid), deferred :: is_valid
	<<MCI base: interfaces>>=
	abstract interface
	function mci_sampler_is_valid (sampler) result (valid)
	import
	class(mci_sampler_t), intent(in) :: sampler
	logical :: valid
	end function mci_sampler_is_valid
	end interface

	@ %def mci_sampler_is_valid
	@ The shortcut. Again, the channel index [[c]] and the parameter
	array [[x_in]] are input. However, we also provide the integrand
	value [[val]], and we just require that the complete parameter array
	[[x]] and Jacobian array [[f]] are recovered.
	<<MCI base: mci sampler: TBP>>=
	procedure (mci_sampler_rebuild), deferred :: rebuild
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_sampler_rebuild (sampler, c, x_in, val, x, f)
	import
	class(mci_sampler_t), intent(inout) :: sampler
	integer, intent(in) :: c
	real(default), dimension(:), intent(in) :: x_in
	real(default), intent(in) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	end subroutine mci_sampler_rebuild
	end interface

	@ %def mci_sampler_rebuild
	@ This routine should extract the important data from a sampler that
	has been filled by other means. We fetch the integrand value [[val]],
	the two-dimensional parameter array [[x]] and the Jacobian array [[f]].
	<<MCI base: mci sampler: TBP>>=
	procedure (mci_sampler_fetch), deferred :: fetch
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_sampler_fetch (sampler, val, x, f)
	import
	class(mci_sampler_t), intent(in) :: sampler
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	end subroutine mci_sampler_fetch
	end interface

	@ %def mci_sampler_fetch
	@
	\subsection{Results record}
	This is an abstract type which allows us to implement callback: each
	integration results can optionally be recorded to an instance of this
	object. The actual object may store a new result, average results,
	etc. It may also display a result on-line or otherwise, whenever
	the [[record]] method is called.
	<<MCI base: public>>=
	public :: mci_results_t
	<<MCI base: types>>=
	type, abstract :: mci_results_t
	contains
	<<MCI base: mci results: TBP>>
	end type mci_results_t

	@ %def mci_results_t
	@ The output routine is deferred. We provide an extra [[verbose]]
	flag, which could serve any purpose.
	<<MCI base: mci results: TBP>>=
	procedure (mci_results_write), deferred :: write
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_results_write (object, unit, verbose, suppress)
	import
	class(mci_results_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, suppress
	end subroutine mci_results_write
	end interface

	@ %def mci_results_write
	@ This is the [[record]] method, which can be called directly from the
	integrator.
	<<MCI base: mci results: TBP>>=
	procedure (mci_results_record), deferred :: record
	<<MCI base: interfaces>>=
	abstract interface
	subroutine mci_results_record (object, n_it, &
	n_calls, integral, error, efficiency, chain_weights, suppress)
	import
	class(mci_results_t), intent(inout) :: object
	integer, intent(in) :: n_it
	integer, intent(in) :: n_calls
	real(default), intent(in) :: integral
	real(default), intent(in) :: error
	real(default), intent(in) :: efficiency
	real(default), dimension(:), intent(in), optional :: chain_weights
	logical, intent(in), optional :: suppress
	end subroutine mci_results_record
	end interface

	@ %def mci_results_record
	@
	\subsection{Unit tests}
	<<MCI base: public>>=
	public :: mci_base_test
	<<MCI base: tests>>=
	subroutine mci_base_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<MCI base: execute tests>>
	end subroutine mci_base_test

	@ %def mci_base_test
	@
	\subsubsection{Test implementation of the configuration type}
	The concrete type contains the number of requested calls and the integral
	result, to be determined.

	The [[max_factor]] entry is set for the actual test integration, where the
	integrand is not unity but some other constant value. This value should be
	set here, such that the actual maximum of the integrand is known when
	vetoing unweighted events.
	<<MCI base: public>>=
	public :: mci_test_t
	<<MCI base: test types>>=
	type, extends (mci_t) :: mci_test_t
	integer :: divisions = 0
	integer :: tries = 0
	real(default) :: max_factor = 1
	contains
	procedure :: final => mci_test_final
	procedure :: write => mci_test_write
	procedure :: startup_message => mci_test_startup_message
	procedure :: declare_flat_dimensions => mci_test_ignore_flat_dimensions
	procedure :: declare_equivalences => mci_test_ignore_equivalences
	procedure :: set_divisions => mci_test_set_divisions
	procedure :: set_max_factor => mci_test_set_max_factor
	procedure :: allocate_instance => mci_test_allocate_instance
	procedure :: integrate => mci_test_integrate
	procedure :: prepare_simulation => mci_test_ignore_prepare_simulation
	procedure :: generate_weighted_event => mci_test_generate_weighted_event
	procedure :: generate_unweighted_event => &
	mci_test_generate_unweighted_event
	procedure :: rebuild_event => mci_test_rebuild_event
	end type mci_test_t

	@ %def mci_test_t
	@ Finalizer: base version is sufficient
	<<MCI base: tests>>=
	subroutine mci_test_final (object)
	class(mci_test_t), intent(inout) :: object
	call object%base_final ()
	end subroutine mci_test_final

	@ %def mci_test_final
	@ Output: trivial
	<<MCI base: tests>>=
	subroutine mci_test_write (object, unit, pacify, md5sum_version)
	class(mci_test_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacify
	logical, intent(in), optional :: md5sum_version
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Test integrator:"
	call object%base_write (u, pacify, md5sum_version)
	if (object%divisions /= 0) then
	write (u, "(3x,A,I0)") "Number of divisions = ", object%divisions
	end if
	if (allocated (object%rng)) call object%rng%write (u)
	end subroutine mci_test_write

	@ %def mci_test_write
	@ Short version.
	<<MCI base: tests>>=
	subroutine mci_test_startup_message (mci, unit, n_calls)
	class(mci_test_t), intent(in) :: mci
	integer, intent(in), optional :: unit, n_calls
	call mci%base_startup_message (unit = unit, n_calls = n_calls)
	write (msg_buffer, "(A,1x,I0,1x,A)") &
	"Integrator: Test:", mci%divisions, "divisions"
	call msg_message (unit = unit)
	end subroutine mci_test_startup_message

	@ %def mci_test_startup_message
	@ This is a no-op for the test integrator.
	<<MCI base: tests>>=
	subroutine mci_test_ignore_flat_dimensions (mci, dim_flat)
	class(mci_test_t), intent(inout) :: mci
	integer, dimension(:), intent(in) :: dim_flat
	end subroutine mci_test_ignore_flat_dimensions

	@ %def mci_test_ignore_flat_dimensions
	@ Ditto.
	<<MCI base: tests>>=
	subroutine mci_test_ignore_equivalences (mci, channel, dim_offset)
	class(mci_test_t), intent(inout) :: mci
	type(phs_channel_t), dimension(:), intent(in) :: channel
	integer, intent(in) :: dim_offset
	end subroutine mci_test_ignore_equivalences

	@ %def mci_test_ignore_equivalences
	@ Set the number of divisions to a nonzero value.
	<<MCI base: tests>>=
	subroutine mci_test_set_divisions (object, divisions)
	class(mci_test_t), intent(inout) :: object
	integer, intent(in) :: divisions
	object%divisions = divisions
	end subroutine mci_test_set_divisions

	@ %def mci_test_set_divisions
	@ Set the maximum factor (default is 1).
	<<MCI base: tests>>=
	subroutine mci_test_set_max_factor (object, max_factor)
	class(mci_test_t), intent(inout) :: object
	real(default), intent(in) :: max_factor
	object%max_factor = max_factor
	end subroutine mci_test_set_max_factor

	@ %def mci_test_set_max_factor
	@ Allocate instance with matching type.
	<<MCI base: tests>>=
	subroutine mci_test_allocate_instance (mci, mci_instance)
	class(mci_test_t), intent(in) :: mci
	class(mci_instance_t), intent(out), pointer :: mci_instance
	allocate (mci_test_instance_t :: mci_instance)
	end subroutine mci_test_allocate_instance

	@ %def mci_test_allocate_instance
	@ Integrate: sample at the midpoints of uniform bits and add the results.
	We implement this for one and for two dimensions. In the latter case,
	we scan over two channels and multiply with the channel weights.

	The arguments [[n_it]] and [[n_calls]] are ignored in this implementations.

	The test integrator does not set error or efficiency, so those will
	remain undefined.
	<<MCI base: tests>>=
	subroutine mci_test_integrate (mci, instance, sampler, &
	n_it, n_calls, results, pacify)
	class(mci_test_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout) :: instance
	class(mci_sampler_t), intent(inout) :: sampler
	integer, intent(in) :: n_it
	integer, intent(in) :: n_calls
	logical, intent(in), optional :: pacify
	class(mci_results_t), intent(inout), optional :: results
	real(default), dimension(:), allocatable :: integral
	real(default), dimension(:), allocatable :: x
	integer :: i, j, c
	select type (instance)
	type is (mci_test_instance_t)
	allocate (integral (mci%n_channel))
	integral = 0
	allocate (x (mci%n_dim))
	select case (mci%n_dim)
	case (1)
	do c = 1, mci%n_channel
	do i = 1, mci%divisions
	x(1) = (i - 0.5_default) / mci%divisions
	call instance%evaluate (sampler, c, x)
	integral(c) = integral(c) + instance%get_value ()
	end do
	end do
	mci%integral = dot_product (instance%w, integral) &
	/ mci%divisions
	mci%integral_known = .true.
	case (2)
	do c = 1, mci%n_channel
	do i = 1, mci%divisions
	x(1) = (i - 0.5_default) / mci%divisions
	do j = 1, mci%divisions
	x(2) = (j - 0.5_default) / mci%divisions
	call instance%evaluate (sampler, c, x)
	integral(c) = integral(c) + instance%get_value ()
	end do
	end do
	end do
	mci%integral = dot_product (instance%w, integral) &
	/ mci%divisions / mci%divisions
	mci%integral_known = .true.
	end select
	if (present (results)) then
	call results%record (n_it, n_calls, &
	mci%integral, mci%error, &
	efficiency = 0._default)
	end if
	end select
	end subroutine mci_test_integrate

	@ %def mci_test_integrate
	@ Simulation initializer and finalizer: nothing to do here.
	<<MCI base: tests>>=
	subroutine mci_test_ignore_prepare_simulation (mci)
	class(mci_test_t), intent(inout) :: mci
	end subroutine mci_test_ignore_prepare_simulation

	@ %def mci_test_ignore_prepare_simulation
	@ Event generator. We use mock random numbers for first selecting the
	channel and then setting the $x$ values. The results reside in the
	state of [[instance]] and [[sampler]].
	<<MCI base: tests>>=
	subroutine mci_test_generate_weighted_event (mci, instance, sampler)
	class(mci_test_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout), target :: instance
	class(mci_sampler_t), intent(inout), target :: sampler
	real(default) :: r
	real(default), dimension(:), allocatable :: x
	integer :: c
	select type (instance)
	type is (mci_test_instance_t)
	allocate (x (mci%n_dim))
	select case (mci%n_channel)
	case (1)
	c = 1
	call mci%rng%generate (x(1))
	case (2)
	call mci%rng%generate (r)
	if (r < instance%w(1)) then
	c = 1
	else
	c = 2
	end if
	call mci%rng%generate (x)
	end select
	call instance%evaluate (sampler, c, x)
	end select
	end subroutine mci_test_generate_weighted_event

	@ %def mci_test_generate_weighted_event
	@ For unweighted events, we generate weighted events and apply a
	simple rejection step to the relative event weight, until an event passes.

	(This might result in an endless loop if we happen to be in sync with
	the mock random generator cycle. Therefore, limit the number of tries.)
	<<MCI base: tests>>=
	subroutine mci_test_generate_unweighted_event (mci, instance, sampler)
	class(mci_test_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout), target :: instance
	class(mci_sampler_t), intent(inout), target :: sampler
	real(default) :: r
	integer :: i
	select type (instance)
	type is (mci_test_instance_t)
	mci%tries = 0
	do i = 1, 10
	call mci%generate_weighted_event (instance, sampler)
	mci%tries = mci%tries + 1
	call mci%rng%generate (r)
	if (r < instance%rel_value) exit
	end do
	end select
	end subroutine mci_test_generate_unweighted_event

	@ %def mci_test_generate_unweighted_event
	@ Here, we rebuild the event from the state without consulting the rng.
	<<MCI base: tests>>=
	subroutine mci_test_rebuild_event (mci, instance, sampler, state)
	class(mci_test_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout) :: instance
	class(mci_sampler_t), intent(inout) :: sampler
	class(mci_state_t), intent(in) :: state
	select type (instance)
	type is (mci_test_instance_t)
	call instance%recall (sampler, state)
	end select
	end subroutine mci_test_rebuild_event

	@ %def mci_test_rebuild_event
	@
	\subsubsection{Instance of the test MCI type}
	This instance type simulates the VAMP approach. We implement the VAMP
	multi-channel formula, but keep the channel-specific probability
	functions $g_i$ smooth and fixed. We also keep the weights fixed.

	The setup is as follows: we have $n$ mappings of the unit hypercube
	\begin{equation}
	x = x (x^{(k)}) \qquad \text{where $x=(x_1,\ldots)$}.
	\end{equation}
	The Jacobian factors are the determinants
	\begin{equation}
	f^{(k)}(x^{(k)}) = \left\|\frac{\partial x}{\partial x^{(k)}}\right\|
	\end{equation}
	We introduce arbitrary probability functions
	\begin{equation}
	g^{(k)}(x^{(k)}) \qquad
	\text{with}\quad \int dx^{(k)} g^{(k)}(x^{(k)}) = 1
	\end{equation}
	and weights
	\begin{equation}
	w_k \qquad \text{with}\quad \sum_k w_k = 1
	\end{equation}
	and construct the joint probability function
	\begin{equation}
	g(x) = \sum_k w_k\frac{g^{(k)}(x^{(k)}(x))}{f^{(k)}(x^{(k)}(x))}
	\end{equation}
	which also satisfies
	\begin{equation}
	\int g(x)\,dx = 1.
	\end{equation}
	The algorithm implements a resolution of unity as follows
	\begin{align}
	1 &= \int dx = \int\frac{g(x)}{g(x)} dx
	\nonumber\\
	&= \sum w_k \int \frac{g^{(k)}(x^{(k)}(x))}{f^{(k)}(x^{(k)}(x))}
	\,\frac{dx}{g(x)}
	\nonumber\\
	&= \sum w_k \int g^{(k)}(x^{(k)}) \frac{dx^{(k)}}{g(x(x^{(k)}))}
	\end{align}
	where each of the integrals in the sum is evaluated using the
	channel-specific variables $x^{(k)}$.

	We provide two examples: (1) trivial with one channel, one dimension,
	and all functions unity and (2) two channels and two dimensions with
	\begin{align}
	x (x^{(1)}) &= (x^{(1)}_1, x^{(1)}_2)
	\nonumber\\
	x (x^{(2)}) &= (x^{(2)}_1{}^2, x^{(2)}_2)
	\end{align}
	hence
	\begin{align}
	f^{(1)}&\equiv 1,
	&f^{(2)}(x^{(2)}) &= 2x^{(2)}_1
	\end{align}
	The probability functions are
	\begin{align}
	g^{(1)}&\equiv 1,
	&g^{(2)}(x^{(2)}) = 2 x^{(2)}_2
	\end{align}

	In the concrete implementation of the integrator instance we store
	values for the channel probabilities $g_i$ and the accumulated
	probability $g$.

	We also store the result (product of integrand and MCI weight), the
	expected maximum for the result in each channel.
	<<MCI base: public>>=
	public :: mci_test_instance_t
	<<MCI base: test types>>=
	type, extends (mci_instance_t) :: mci_test_instance_t
	type(mci_test_t), pointer :: mci => null ()
	real(default) :: g = 0
	real(default), dimension(:), allocatable :: gi
	real(default) :: value = 0
	real(default) :: rel_value = 0
	real(default), dimension(:), allocatable :: max
	contains
	procedure :: write => mci_test_instance_write
	procedure :: final => mci_test_instance_final
	procedure :: init => mci_test_instance_init
	procedure :: compute_weight => mci_test_instance_compute_weight
	procedure :: record_integrand => mci_test_instance_record_integrand
	procedure :: init_simulation => mci_test_instance_init_simulation
	procedure :: final_simulation => mci_test_instance_final_simulation
	procedure :: get_event_excess => mci_test_instance_get_event_excess
	end type mci_test_instance_t

	@ %def mci_test_instance_t
	@ Output: trivial
	<<MCI base: tests>>=
	subroutine mci_test_instance_write (object, unit, pacify)
	class(mci_test_instance_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacify
	integer :: u, c
	u = given_output_unit (unit)
	write (u, "(1x,A,ES13.7)") "Result value = ", object%value
	write (u, "(1x,A,ES13.7)") "Rel. weight = ", object%rel_value
	write (u, "(1x,A,ES13.7)") "Integrand = ", object%integrand
	write (u, "(1x,A,ES13.7)") "MCI weight = ", object%mci_weight
	write (u, "(3x,A,I0)") "c = ", object%selected_channel
	write (u, "(3x,A,ES13.7)") "g = ", object%g
	write (u, "(1x,A)") "Channel parameters:"
	do c = 1, object%mci%n_channel
	write (u, "(1x,I0,A,4(1x,ES13.7))") c, ": w/f/g/m =", &
	object%w(c), object%f(c), object%gi(c), object%max(c)
	write (u, "(4x,A,9(1x,F9.7))") "x =", object%x(:,c)
	end do
	end subroutine mci_test_instance_write

	@ %def mci_test_instance_write
	@ The finalizer is empty.
	<<MCI base: tests>>=
	subroutine mci_test_instance_final (object)
	class(mci_test_instance_t), intent(inout) :: object
	end subroutine mci_test_instance_final

	@ %def mci_test_instance_final
	@ Initializer. We make use of the analytical result that the maximum of
	the weighted integrand, in each channel, is equal to $1$
	(one-dimensional case) and $2$ (two-dimensional case), respectively.
	<<MCI base: tests>>=
	subroutine mci_test_instance_init (mci_instance, mci)
	class(mci_test_instance_t), intent(out) :: mci_instance
	class(mci_t), intent(in), target :: mci
	call mci_instance%base_init (mci)
	select type (mci)
	type is (mci_test_t)
	mci_instance%mci => mci
	end select
	allocate (mci_instance%gi (mci%n_channel))
	mci_instance%gi = 0
	allocate (mci_instance%max (mci%n_channel))
	select case (mci%n_channel)
	case (1)
	mci_instance%max = 1._default
	case (2)
	mci_instance%max = 2._default
	end select
	end subroutine mci_test_instance_init

	@ %def mci_test_instance_init
	@ Compute weight: we implement the VAMP multi-channel formula. The channel
	probabilities [[gi]] are predefined functions.
	<<MCI base: tests>>=
	subroutine mci_test_instance_compute_weight (mci, c)
	class(mci_test_instance_t), intent(inout) :: mci
	integer, intent(in) :: c
	integer :: i
	mci%selected_channel = c
	select case (mci%mci%n_dim)
	case (1)
	mci%gi(1) = 1
	case (2)
	mci%gi(1) = 1
	mci%gi(2) = 2 * mci%x(2,2)
	end select
	mci%g = 0
	do i = 1, mci%mci%n_channel
	mci%g = mci%g + mci%w(i) * mci%gi(i) / mci%f(i)
	end do
	mci%mci_weight = mci%gi(c) / mci%g
	end subroutine mci_test_instance_compute_weight

	@ %def mci_test_instance_compute_weight
	@ Record the integrand. Apply the Jacobian weight to get the absolute value.
	Divide by the channel maximum and by any overall factor to get the value
	relative to the maximum.
	<<MCI base: tests>>=
	subroutine mci_test_instance_record_integrand (mci, integrand)
	class(mci_test_instance_t), intent(inout) :: mci
	real(default), intent(in) :: integrand
	mci%integrand = integrand
	mci%value = mci%integrand * mci%mci_weight
	mci%rel_value = mci%value / mci%max(mci%selected_channel) &
	/ mci%mci%max_factor
	end subroutine mci_test_instance_record_integrand

	@ %def mci_test_instance_record_integrand
	@ Nothing to do here.
	<<MCI base: tests>>=
	subroutine mci_test_instance_init_simulation (instance, safety_factor)
	class(mci_test_instance_t), intent(inout) :: instance
	real(default), intent(in), optional :: safety_factor
	end subroutine mci_test_instance_init_simulation

	subroutine mci_test_instance_final_simulation (instance)
	class(mci_test_instance_t), intent(inout) :: instance
	end subroutine mci_test_instance_final_simulation

	@ %def mci_test_instance_init_simulation
	@ %def mci_test_instance_final_simulation
	@ Return always zero.
	<<MCI base: tests>>=
	function mci_test_instance_get_event_excess (mci) result (excess)
	class(mci_test_instance_t), intent(in) :: mci
	real(default) :: excess
	excess = 0
	end function mci_test_instance_get_event_excess

	@ %def mci_test_instance_get_event_excess
	@
	\subsubsection{Test sampler}
	The test sampler implements a fixed configuration, either trivial
	(one-channel, one-dimension), or slightly nontrivial (two-channel,
	two-dimension). In the second channel, the first parameter is mapped
	according to $x_1 = x^{(2)}_1{}^2$, so we have $f^{(2)}(x^{(2)}) =
	2x^{(2)}_1$.

	For display purposes, we store the return values inside the object. This is
	not strictly necessary.
	<<MCI base: test types>>=
	type, extends (mci_sampler_t) :: test_sampler_t
	real(default) :: integrand = 0
	integer :: selected_channel = 0
	real(default), dimension(:,:), allocatable :: x
	real(default), dimension(:), allocatable :: f
	contains
	procedure :: init => test_sampler_init
	procedure :: write => test_sampler_write
	procedure :: compute => test_sampler_compute
	procedure :: is_valid => test_sampler_is_valid
	procedure :: evaluate => test_sampler_evaluate
	procedure :: rebuild => test_sampler_rebuild
	procedure :: fetch => test_sampler_fetch
	end type test_sampler_t

	@ %def test_sampler_t
	<<MCI base: tests>>=
	subroutine test_sampler_init (sampler, n)
	class(test_sampler_t), intent(out) :: sampler
	integer, intent(in) :: n
	allocate (sampler%x (n, n))
	allocate (sampler%f (n))
	end subroutine test_sampler_init

	@ %def test_sampler_init
	@ Output
	<<MCI base: tests>>=
	subroutine test_sampler_write (object, unit, testflag)
	class(test_sampler_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u, c
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Test sampler:"
	write (u, "(3x,A,ES13.7)") "Integrand = ", object%integrand
	write (u, "(3x,A,I0)") "Channel = ", object%selected_channel
	do c = 1, size (object%f)
	write (u, "(1x,I0,':',1x,A,ES13.7)") c, "f = ", object%f(c)
	write (u, "(4x,A,9(1x,F9.7))") "x =", object%x(:,c)
	end do
	end subroutine test_sampler_write

	@ %def test_sampler_write
	@ Compute $x$ and Jacobians, given the input parameter array. This is called
	both by [[evaluate]] and [[rebuild]].
	<<MCI base: tests>>=
	subroutine test_sampler_compute (sampler, c, x_in)
	class(test_sampler_t), intent(inout) :: sampler
	integer, intent(in) :: c
	real(default), dimension(:), intent(in) :: x_in
	sampler%selected_channel = c
	select case (size (sampler%f))
	case (1)
	sampler%x(:,1) = x_in
	sampler%f = 1
	case (2)
	select case (c)
	case (1)
	sampler%x(:,1) = x_in
	sampler%x(1,2) = sqrt (x_in(1))
	sampler%x(2,2) = x_in(2)
	case (2)
	sampler%x(1,1) = x_in(1) ** 2
	sampler%x(2,1) = x_in(2)
	sampler%x(:,2) = x_in
	end select
	sampler%f(1) = 1
	sampler%f(2) = 2 * sampler%x(1,2)
	end select
	end subroutine test_sampler_compute

	@ %def test_sampler_kineamtics
	@ The point is always valid.
	<<MCI base: tests>>=
	function test_sampler_is_valid (sampler) result (valid)
	class(test_sampler_t), intent(in) :: sampler
	logical :: valid
	valid = .true.
	end function test_sampler_is_valid

	@ %def test_sampler_is_valid
	@ The integrand is always equal to 1.
	<<MCI base: tests>>=
	subroutine test_sampler_evaluate (sampler, c, x_in, val, x, f)
	class(test_sampler_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%compute (c, x_in)
	sampler%integrand = 1
	val = sampler%integrand
	x = sampler%x
	f = sampler%f
	end subroutine test_sampler_evaluate

	@ %def test_sampler_evaluate
	@ Construct kinematics from the input $x$ array. Set the integrand
	instead of evaluating it.
	<<MCI base: tests>>=
	subroutine test_sampler_rebuild (sampler, c, x_in, val, x, f)
	class(test_sampler_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 sampler%compute (c, x_in)
	sampler%integrand = val
	x = sampler%x
	f = sampler%f
	end subroutine test_sampler_rebuild

	@ %def test_sampler_rebuild
	@ Recall contents.
	<<MCI base: tests>>=
	subroutine test_sampler_fetch (sampler, val, x, f)
	class(test_sampler_t), intent(in) :: sampler
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	val = sampler%integrand
	x = sampler%x
	f = sampler%f
	end subroutine test_sampler_fetch

	@ %def test_sampler_fetch
	@
	\subsubsection{Test results object}
	This mock object just stores and displays the current result.
	<<MCI base: test types>>=
	type, extends (mci_results_t) :: mci_test_results_t
	integer :: n_it = 0
	integer :: n_calls = 0
	real(default) :: integral = 0
	real(default) :: error = 0
	real(default) :: efficiency = 0
	contains
	<<MCI base: mci test results: TBP>>
	end type mci_test_results_t

	@ %def mci_test_results_t
	@ Output.
	<<MCI base: mci test results: TBP>>=
	procedure :: write => mci_test_results_write
	<<MCI base: tests>>=
	subroutine mci_test_results_write (object, unit, verbose, suppress)
	class(mci_test_results_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, suppress
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A,1x,I0)") "Iterations = ", object%n_it
	write (u, "(3x,A,1x,I0)") "Calls = ", object%n_calls
	write (u, "(3x,A,1x,F12.10)") "Integral = ", object%integral
	write (u, "(3x,A,1x,F12.10)") "Error = ", object%error
	write (u, "(3x,A,1x,F12.10)") "Efficiency = ", object%efficiency
	end subroutine mci_test_results_write

	@ %def mci_test_results_write
	@ Record result.
	<<MCI base: mci test results: TBP>>=
	procedure :: record => mci_test_results_record
	<<MCI base: tests>>=
	subroutine mci_test_results_record (object, n_it, n_calls, &
	integral, error, efficiency, chain_weights, suppress)
	class(mci_test_results_t), intent(inout) :: object
	integer, intent(in) :: n_it
	integer, intent(in) :: n_calls
	real(default), intent(in) :: integral
	real(default), intent(in) :: error
	real(default), intent(in) :: efficiency
	real(default), dimension(:), intent(in), optional :: chain_weights
	logical, intent(in), optional :: suppress
	object%n_it = n_it
	object%n_calls = n_calls
	object%integral = integral
	object%error = error
	object%efficiency = efficiency
	end subroutine mci_test_results_record

	@ %def mci_test_results_record
	@
	\subsubsection{Integrator configuration data}
	Construct and display a test integrator configuration object.
	<<MCI base: execute tests>>=
	call test (mci_base_1, "mci_base_1", &
	"integrator configuration", &
	u, results)
	<<MCI base: tests>>=
	subroutine mci_base_1 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler

	real(default) :: integrand

	write (u, "(A)") "* Test output: mci_base_1"
	write (u, "(A)") "* Purpose: initialize and display &
	&test integrator"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_test_t :: mci)
	call mci%set_dimensions (2, 2)

	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize instance"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Initialize test sampler"
	write (u, "(A)")

	allocate (test_sampler_t :: sampler)
	select type (sampler)
	type is (test_sampler_t)
	call sampler%init (2)
	end select

	write (u, "(A)") "* Evaluate sampler for given point and channel"
	write (u, "(A)")

	call sampler%evaluate (1, [0.25_default, 0.8_default], &
	integrand, mci_instance%x, mci_instance%f)

	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Compute MCI weight"
	write (u, "(A)")

	call mci_instance%compute_weight (1)
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Get integrand and compute weight for another point"
	write (u, "(A)")

	call mci_instance%evaluate (sampler, 2, [0.5_default, 0.6_default])
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recall results, again"
	write (u, "(A)")

	call mci_instance%final ()
	deallocate (mci_instance)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	call mci_instance%fetch (sampler, 2)
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Retrieve value"
	write (u, "(A)")

	write (u, "(1x,A,ES13.7)") "Weighted integrand = ", &
	mci_instance%get_value ()

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_base_1

	@ %def mci_base_1
	@
	\subsubsection{Trivial integral}
	Use the MCI approach to compute a trivial one-dimensional integral.
	<<MCI base: execute tests>>=
	call test (mci_base_2, "mci_base_2", &
	"integration", &
	u, results)
	<<MCI base: tests>>=
	subroutine mci_base_2 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler

	write (u, "(A)") "* Test output: mci_base_2"
	write (u, "(A)") "* Purpose: perform a test integral"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_test_t :: mci)
	call mci%set_dimensions (1, 1)
	select type (mci)
	type is (mci_test_t)
	call mci%set_divisions (10)
	end select

	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize instance"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Initialize test sampler"
	write (u, "(A)")

	allocate (test_sampler_t :: sampler)
	select type (sampler)
	type is (test_sampler_t)
	call sampler%init (1)
	end select

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

	call mci%integrate (mci_instance, sampler, 0, 0)

	call mci%write (u)

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_base_2

	@ %def mci_base_2
	@
	\subsubsection{Nontrivial integral}
	Use the MCI approach to compute a simple two-dimensional integral with
	two channels.
	<<MCI base: execute tests>>=
	call test (mci_base_3, "mci_base_3", &
	"integration (two channels)", &
	u, results)
	<<MCI base: tests>>=
	subroutine mci_base_3 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler

	write (u, "(A)") "* Test output: mci_base_3"
	write (u, "(A)") "* Purpose: perform a nontrivial test integral"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_test_t :: mci)
	call mci%set_dimensions (2, 2)
	select type (mci)
	type is (mci_test_t)
	call mci%set_divisions (10)
	end select

	write (u, "(A)") "* Initialize instance"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Initialize test sampler"
	write (u, "(A)")

	allocate (test_sampler_t :: sampler)
	select type (sampler)
	type is (test_sampler_t)
	call sampler%init (2)
	end select

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

	call mci%integrate (mci_instance, sampler, 0, 0)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with higher resolution"
	write (u, "(A)")

	select type (mci)
	type is (mci_test_t)
	call mci%set_divisions (100)
	end select

	call mci%integrate (mci_instance, sampler, 0, 0)
	call mci%write (u)

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_base_3

	@ %def mci_base_3
	@
	\subsubsection{Event generation}
	We generate ``random'' events, one weighted and one unweighted. The
	test implementation does not require an integration pass, we can
	generate events immediately.
	<<MCI base: execute tests>>=
	call test (mci_base_4, "mci_base_4", &
	"event generation (two channels)", &
	u, results)
	<<MCI base: tests>>=
	subroutine mci_base_4 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_base_4"
	write (u, "(A)") "* Purpose: generate events"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator, instance, sampler"
	write (u, "(A)")

	allocate (mci_test_t :: mci)
	call mci%set_dimensions (2, 2)
	select type (mci)
	type is (mci_test_t)
	call mci%set_divisions (10)
	end select

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_t :: sampler)
	select type (sampler)
	type is (test_sampler_t)
	call sampler%init (2)
	end select

	allocate (rng_test_t :: rng)
	call mci%import_rng (rng)

	write (u, "(A)") "* Generate weighted event"
	write (u, "(A)")

	call mci%generate_weighted_event (mci_instance, sampler)

	call sampler%write (u)
	write (u, *)
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate unweighted event"
	write (u, "(A)")

	call mci%generate_unweighted_event (mci_instance, sampler)

	select type (mci)
	type is (mci_test_t)
	write (u, "(A,I0)") " Success in try ", mci%tries
	write (u, "(A)")
	end select

	call sampler%write (u)
	write (u, *)
	call mci_instance%write (u)

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_base_4

	@ %def mci_base_4
	@
	\subsubsection{Store and recall data}
	We generate an event and store the relevant data, i.e., the input
	parameters and the result value for a particular channel. Then we use
	those data to recover the event, as far as the MCI record is concerned.
	<<MCI base: execute tests>>=
	call test (mci_base_5, "mci_base_5", &
	"store and recall", &
	u, results)
	<<MCI base: tests>>=
	subroutine mci_base_5 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng
	class(mci_state_t), allocatable :: state

	write (u, "(A)") "* Test output: mci_base_5"
	write (u, "(A)") "* Purpose: store and recall an event"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator, instance, sampler"
	write (u, "(A)")

	allocate (mci_test_t :: mci)
	call mci%set_dimensions (2, 2)
	select type (mci)
	type is (mci_test_t)
	call mci%set_divisions (10)
	end select

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_t :: sampler)
	select type (sampler)
	type is (test_sampler_t)
	call sampler%init (2)
	end select

	allocate (rng_test_t :: rng)
	call mci%import_rng (rng)

	write (u, "(A)") "* Generate weighted event"
	write (u, "(A)")

	call mci%generate_weighted_event (mci_instance, sampler)

	call sampler%write (u)
	write (u, *)
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Store data"
	write (u, "(A)")

	allocate (state)
	call mci_instance%store (state)
	call mci_instance%final ()
	deallocate (mci_instance)

	call state%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recall data and rebuild event"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)
	call mci%rebuild_event (mci_instance, sampler, state)

	call sampler%write (u)
	write (u, *)
	call mci_instance%write (u)

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_base_5

	@ %def mci_base_5
	@
	\subsubsection{Chained channels}
	Chain channels together. In the base configuration, this just fills entries
	in an extra array (each channel may belong to a chain). In type
	implementations, this will be used for grouping equivalent channels by keeping
	their weights equal.
	<<MCI base: execute tests>>=
	call test (mci_base_6, "mci_base_6", &
	"chained channels", &
	u, results)
	<<MCI base: tests>>=
	subroutine mci_base_6 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci

	write (u, "(A)") "* Test output: mci_base_6"
	write (u, "(A)") "* Purpose: initialize and display &
	&test integrator with chains"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_test_t :: mci)
	call mci%set_dimensions (1, 5)

	write (u, "(A)") "* Introduce chains"
	write (u, "(A)")

	call mci%declare_chains ([1, 2, 2, 1, 2])

	call mci%write (u)

	call mci%final ()

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

	end subroutine mci_base_6

	@ %def mci_base_6
	@
	\subsubsection{Recording results}
	Compute a simple two-dimensional integral and record the result.
	<<MCI base: execute tests>>=
	call test (mci_base_7, "mci_base_7", &
	"recording results", &
	u, results)
	<<MCI base: tests>>=
	subroutine mci_base_7 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(mci_results_t), allocatable :: results

	write (u, "(A)") "* Test output: mci_base_7"
	write (u, "(A)") "* Purpose: perform a nontrivial test integral &
	&and record results"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_test_t :: mci)
	call mci%set_dimensions (2, 2)
	select type (mci)
	type is (mci_test_t)
	call mci%set_divisions (10)
	end select

	write (u, "(A)") "* Initialize instance"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Initialize test sampler"
	write (u, "(A)")

	allocate (test_sampler_t :: sampler)
	select type (sampler)
	type is (test_sampler_t)
	call sampler%init (2)
	end select

	allocate (mci_test_results_t :: results)

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

	call mci%integrate (mci_instance, sampler, 1, 1000, results)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Display results"
	write (u, "(A)")

	call results%write (u)

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_base_7

	@ %def mci_base_7
	@
	\subsubsection{Timer}
	Simple checks for the embedded timer.
	<<MCI base: execute tests>>=
	call test (mci_base_8, "mci_base_8", &
	"timer", &
	u, results)
	<<MCI base: tests>>=
	subroutine mci_base_8 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci

	write (u, "(A)") "* Test output: mci_base_8"
	write (u, "(A)") "* Purpose: check timer availability"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator with timer"
	write (u, "(A)")

	allocate (mci_test_t :: mci)
	call mci%set_dimensions (2, 2)
	select type (mci)
	type is (mci_test_t)
	call mci%set_divisions (10)
	end select

	call mci%set_timer (active = .true.)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Start timer"
	write (u, "(A)")

	call mci%start_timer ()
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Stop timer"
	write (u, "(A)")

	call mci%stop_timer ()
	call mci%write (u)

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

	write (u, "(1x,A,F6.3)") "Time = ", mci%get_time ()

	write (u, "(A)")
	write (u, "(A)") "* Deactivate timer"
	write (u, "(A)")

	call mci%set_timer (active = .false.)
	call mci%write (u)

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

	call mci%final ()

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

	end subroutine mci_base_8

	@ %def mci_base_8
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Iterations}
	This module defines a container for the list of iterations and calls, to be
	submitted to integration.
	<<[[iterations.f90]]>>=
	<<File header>>

	module iterations

	<<Use strings>>
	use io_units
	use unit_tests
	use diagnostics

	<<Standard module head>>

	<<Iterations: public>>

	<<Iterations: types>>

	contains

	<<Iterations: procedures>>

	<<Iterations: tests>>

	end module iterations
	@ %def iterations
	@
	\subsection{The iterations list}
	Each integration pass has a number of iterations and a number of calls
	per iteration. The last pass produces the end result; the previous
	passes are used for adaptation.

	The flags [[adapt_grid]] and [[adapt_weight]] are used only if
	[[custom_adaptation]] is set. Otherwise, default settings are used
	that depend on the integration pass.
	<<Iterations: types>>=
	type :: iterations_spec_t
	private
	integer :: n_it = 0
	integer :: n_calls = 0
	logical :: custom_adaptation = .false.
	logical :: adapt_grids = .false.
	logical :: adapt_weights = .false.
	end type iterations_spec_t

	@ %def iterations_spec_t
	@ We build up a list of iterations.
	<<Iterations: public>>=
	public :: iterations_list_t
	<<Iterations: types>>=
	type :: iterations_list_t
	private
	integer :: n_pass = 0
	type(iterations_spec_t), dimension(:), allocatable :: pass
	contains
	<<Iterations: iterations list: TBP>>
	end type iterations_list_t

	@ %def iterations_list_t
	@ Initialize an iterations list. For each pass, we have to specify
	the number of iterations and calls. We may provide the adaption
	conventions explicitly, either as character codes or as logicals.

	For passes where the adaptation conventions are not specified, we use
	the following default setting: adapt weights and grids for all passes
	except the last one.
	<<Iterations: iterations list: TBP>>=
	procedure :: init => iterations_list_init
	<<Iterations: procedures>>=
	subroutine iterations_list_init &
	(it_list, n_it, n_calls, adapt, adapt_code, adapt_grids, adapt_weights)
	class(iterations_list_t), intent(inout) :: it_list
	integer, dimension(:), intent(in) :: n_it, n_calls
	logical, dimension(:), intent(in), optional :: adapt
	type(string_t), dimension(:), intent(in), optional :: adapt_code
	logical, dimension(:), intent(in), optional :: adapt_grids, adapt_weights
	integer :: i
	it_list%n_pass = size (n_it)
	if (allocated (it_list%pass)) deallocate (it_list%pass)
	allocate (it_list%pass (it_list%n_pass))
	it_list%pass%n_it = n_it
	it_list%pass%n_calls = n_calls
	if (present (adapt)) then
	it_list%pass%custom_adaptation = adapt
	do i = 1, it_list%n_pass
	if (adapt(i)) then
	if (verify (adapt_code(i), "wg") /= 0) then
	call msg_error ("iteration specification: " &
	// "adaptation code letters must be 'w' or 'g'")
	end if
	it_list%pass(i)%adapt_grids = scan (adapt_code(i), "g") /= 0
	it_list%pass(i)%adapt_weights = scan (adapt_code(i), "w") /= 0
	end if
	end do
	else if (present (adapt_grids) .and. present (adapt_weights)) then
	it_list%pass%custom_adaptation = .true.
	it_list%pass%adapt_grids = adapt_grids
	it_list%pass%adapt_weights = adapt_weights
	end if
	do i = 1, it_list%n_pass - 1
	if (.not. it_list%pass(i)%custom_adaptation) then
	it_list%pass(i)%adapt_grids = .true.
	it_list%pass(i)%adapt_weights = .true.
	end if
	end do
	end subroutine iterations_list_init

	@ %def iterations_list_init
	<<Iterations: iterations list: TBP>>=
	procedure :: clear => iterations_list_clear
	<<Iterations: procedures>>=
	subroutine iterations_list_clear (it_list)
	class(iterations_list_t), intent(inout) :: it_list
	it_list%n_pass = 0
	deallocate (it_list%pass)
	end subroutine iterations_list_clear

	@ %def iterations_list_clear
	@ Write the list of iterations.
	<<Iterations: iterations list: TBP>>=
	procedure :: write => iterations_list_write
	<<Iterations: procedures>>=
	subroutine iterations_list_write (it_list, unit)
	class(iterations_list_t), intent(in) :: it_list
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(A)") char (it_list%to_string ())
	end subroutine iterations_list_write

	@ %def iterations_list_write
	@ The output as a single-line string.
	<<Iterations: iterations list: TBP>>=
	procedure :: to_string => iterations_list_to_string
	<<Iterations: procedures>>=
	function iterations_list_to_string (it_list) result (buffer)
	class(iterations_list_t), intent(in) :: it_list
	type(string_t) :: buffer
	character(30) :: ibuf
	integer :: i
	buffer = "iterations = "
	if (it_list%n_pass > 0) then
	do i = 1, it_list%n_pass
	if (i > 1) buffer = buffer // ", "
	write (ibuf, "(I0,':',I0)") &
	it_list%pass(i)%n_it, it_list%pass(i)%n_calls
	buffer = buffer // trim (ibuf)
	if (it_list%pass(i)%custom_adaptation &
	.or. it_list%pass(i)%adapt_grids &
	.or. it_list%pass(i)%adapt_weights) then
	buffer = buffer // ':"'
	if (it_list%pass(i)%adapt_grids) buffer = buffer // "g"
	if (it_list%pass(i)%adapt_weights) buffer = buffer // "w"
	buffer = buffer // '"'
	end if
	end do
	else
	buffer = buffer // "[undefined]"
	end if
	end function iterations_list_to_string

	@ %def iterations_list_to_string
	@
	\subsection{Tools}
	Return the total number of passes.
	<<Iterations: iterations list: TBP>>=
	procedure :: get_n_pass => iterations_list_get_n_pass
	<<Iterations: procedures>>=
	function iterations_list_get_n_pass (it_list) result (n_pass)
	class(iterations_list_t), intent(in) :: it_list
	integer :: n_pass
	n_pass = it_list%n_pass
	end function iterations_list_get_n_pass

	@ %def iterations_list_get_n_pass
	@ Return the number of calls for a specific pass.
	<<Iterations: iterations list: TBP>>=
	procedure :: get_n_calls => iterations_list_get_n_calls
	<<Iterations: procedures>>=
	function iterations_list_get_n_calls (it_list, pass) result (n_calls)
	class(iterations_list_t), intent(in) :: it_list
	integer :: n_calls
	integer, intent(in) :: pass
	if (pass <= it_list%n_pass) then
	n_calls = it_list%pass(pass)%n_calls
	else
	n_calls = 0
	end if
	end function iterations_list_get_n_calls

	@ %def iterations_list_get_n_calls
	@ Get the adaptation mode (automatic/custom) and, for custom adaptation, the
	flags for a specific pass.
	<<Iterations: iterations list: TBP>>=
	procedure :: adapt_grids => iterations_list_adapt_grids
	procedure :: adapt_weights => iterations_list_adapt_weights
	<<Iterations: procedures>>=
	function iterations_list_adapt_grids (it_list, pass) result (flag)
	logical :: flag
	class(iterations_list_t), intent(in) :: it_list
	integer, intent(in) :: pass
	if (pass <= it_list%n_pass) then
	flag = it_list%pass(pass)%adapt_grids
	else
	flag = .false.
	end if
	end function iterations_list_adapt_grids

	function iterations_list_adapt_weights (it_list, pass) result (flag)
	logical :: flag
	class(iterations_list_t), intent(in) :: it_list
	integer, intent(in) :: pass
	if (pass <= it_list%n_pass) then
	flag = it_list%pass(pass)%adapt_weights
	else
	flag = .false.
	end if
	end function iterations_list_adapt_weights

	@ %def iterations_list_has_custom_adaptation
	@ %def iterations_list_adapt_grids
	@ %def iterations_list_adapt_weights
	@ Return the total number of iterations / the iterations for a specific pass.
	<<Iterations: iterations list: TBP>>=
	procedure :: get_n_it => iterations_list_get_n_it
	<<Iterations: procedures>>=
	function iterations_list_get_n_it (it_list, pass) result (n_it)
	class(iterations_list_t), intent(in) :: it_list
	integer :: n_it
	integer, intent(in) :: pass
	if (pass <= it_list%n_pass) then
	n_it = it_list%pass(pass)%n_it
	else
	n_it = 0
	end if
	end function iterations_list_get_n_it

	@ %def iterations_list_get_n_it
	@
	\subsection{Test}
	This is the master for calling self-test procedures.
	<<Iterations: public>>=
	public :: iterations_test
	<<Iterations: tests>>=
	subroutine iterations_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Iterations: execute tests>>
	end subroutine iterations_test

	@ %def iterations_test
	@
	\subsubsection{Empty list}
	<<Iterations: execute tests>>=
	call test (iterations_1, "iterations_1", &
	"empty iterations list", &
	u, results)
	<<Iterations: tests>>=
	subroutine iterations_1 (u)
	integer, intent(in) :: u
	type(iterations_list_t) :: it_list

	write (u, "(A)") "* Test output: iterations_1"
	write (u, "(A)") "* Purpose: display empty iterations list"
	write (u, "(A)")

	call it_list%write (u)

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

	end subroutine iterations_1

	@ %def iterations_1
	@
	\subsubsection{Fill list}
	<<Iterations: execute tests>>=
	call test (iterations_2, "iterations_2", &
	"create iterations list", &
	u, results)
	<<Iterations: tests>>=
	subroutine iterations_2 (u)
	integer, intent(in) :: u
	type(iterations_list_t) :: it_list

	write (u, "(A)") "* Test output: iterations_2"
	write (u, "(A)") "* Purpose: fill and display iterations list"
	write (u, "(A)")

	write (u, "(A)") "* Minimal setup (2 passes)"
	write (u, "(A)")

	call it_list%init ([2, 4], [5000, 20000])

	call it_list%write (u)
	call it_list%clear ()

	write (u, "(A)")
	write (u, "(A)") "* Setup with flags (3 passes)"
	write (u, "(A)")

	call it_list%init ([2, 4, 5], [5000, 20000, 400], &
	[.false., .true., .true.], &
	[var_str (""), var_str ("g"), var_str ("wg")])

	call it_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Extract data"
	write (u, "(A)")

	write (u, "(A,I0)") "n_pass = ", it_list%get_n_pass ()
	write (u, "(A)")
	write (u, "(A,I0)") "n_calls(2) = ", it_list%get_n_calls (2)
	write (u, "(A)")
	write (u, "(A,I0)") "n_it(3) = ", it_list%get_n_it (3)

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

	end subroutine iterations_2

	@ %def iterations_2
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Integration results}

	We record integration results and errors in a dedicated type. This
	allows us to do further statistics such as weighted average,
	chi-squared, grouping by integration passes, etc.

	Note WHIZARD 2.2.0: This code is taken from the previous [[processes]]
	module essentially unchanged and converted into a separate module. It
	lacks an overhaul and, in particular, self-tests.
	<<[[integration_results.f90]]>>=
	module integration_results

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_utils, only: mp_format, pac_fmt
	use format_defs, only: FMT_10, FMT_14
	use diagnostics
	use md5
	use os_interface
	use mci_base

	<<Standard module head>>

	<<Integration results: public>>

	<<Integration results: parameters>>

	<<Integration results: types>>

	contains

	<<Integration results: procedures>>

	end module integration_results
	@ %def integration_results
	@
	\subsection{Integration results entry}
	This object collects the results of an integration pass and makes them
	available to the outside.

	The results object has to distinguish the process type:

	We store the process type, the index of the integration pass and the
	absolute iteration index, the number of iterations contained in this
	result (for averages), and the integral (cross section or partial
	width), error estimate, efficiency.

	For intermediate results, we set a flag if this result is an
	improvement w.r.t. previous ones.

	The process type indicates decay or scattering. Dummy entries
	(skipped iterations) have a process type of [[PRC_UNKNOWN]].
	<<Integration results: types>>=
	type :: integration_entry_t
	private
	integer :: process_type = PRC_UNKNOWN
	integer :: pass = 0
	integer :: it = 0
	integer :: n_it = 0
	integer :: n_calls = 0
	logical :: improved = .false.
	real(default) :: integral = 0
	real(default) :: error = 0
	real(default) :: efficiency = 0
	real(default) :: chi2 = 0
	real(default), dimension(:), allocatable :: chain_weights
	end type integration_entry_t

	@ %def integration_result_t
	@
	The possible values of the type indicator:
	<<Integration results: parameters>>=
	integer, parameter, public :: PRC_UNKNOWN = 0
	integer, parameter, public :: PRC_DECAY = 1
	integer, parameter, public :: PRC_SCATTERING = 2

	@ %def PRC_UNKNOWN PRC_DECAY PRC_SCATTERING
	@ Initialize with all relevant data
	<<Integration results: procedures>>=
	subroutine integration_entry_init (entry, &
	process_type, pass, it, n_it, n_calls, improved, &
	integral, error, efficiency, chi2, chain_weights)
	type(integration_entry_t), intent(out) :: entry
	integer, intent(in) :: process_type, pass, it, n_it, n_calls
	logical, intent(in) :: improved
	real(default), intent(in) :: integral, error, efficiency
	real(default), intent(in), optional :: chi2
	real(default), dimension(:), intent(in), optional :: chain_weights
	entry%process_type = process_type
	entry%pass = pass
	entry%it = it
	entry%n_it = n_it
	entry%n_calls = n_calls
	entry%improved = improved
	entry%integral = integral
	entry%error = error
	entry%efficiency = efficiency
	if (present (chi2)) &
	entry%chi2 = chi2
	if (present (chain_weights)) then
	allocate (entry%chain_weights (size (chain_weights)))
	entry%chain_weights = chain_weights
	end if
	end subroutine integration_entry_init

	@ %def integration_entry_init
	@ Access values, some of them computed on demand:
	<<Integration results: procedures>>=
	elemental function integration_entry_get_pass (entry) result (n)
	integer :: n
	type(integration_entry_t), intent(in) :: entry
	n = entry%pass
	end function integration_entry_get_pass

	elemental function integration_entry_get_n_calls (entry) result (n)
	integer :: n
	type(integration_entry_t), intent(in) :: entry
	n = entry%n_calls
	end function integration_entry_get_n_calls

	elemental function integration_entry_get_integral (entry) result (int)
	real(default) :: int
	type(integration_entry_t), intent(in) :: entry
	int = entry%integral
	end function integration_entry_get_integral

	elemental function integration_entry_get_error (entry) result (err)
	real(default) :: err
	type(integration_entry_t), intent(in) :: entry
	err = entry%error
	end function integration_entry_get_error

	elemental function integration_entry_get_relative_error (entry) result (err)
	real(default) :: err
	type(integration_entry_t), intent(in) :: entry
	if (entry%integral /= 0) then
	err = entry%error / entry%integral
	else
	err = 0
	end if
	end function integration_entry_get_relative_error

	elemental function integration_entry_get_accuracy (entry) result (acc)
	real(default) :: acc
	type(integration_entry_t), intent(in) :: entry
	acc = accuracy (entry%integral, entry%error, entry%n_calls)
	end function integration_entry_get_accuracy

	elemental function accuracy (integral, error, n_calls) result (acc)
	real(default) :: acc
	real(default), intent(in) :: integral, error
	integer, intent(in) :: n_calls
	if (integral /= 0) then
	acc = error / integral * sqrt (real (n_calls, default))
	else
	acc = 0
	end if
	end function accuracy

	elemental function integration_entry_get_efficiency (entry) result (eff)
	real(default) :: eff
	type(integration_entry_t), intent(in) :: entry
	eff = entry%efficiency
	end function integration_entry_get_efficiency

	elemental function integration_entry_get_chi2 (entry) result (chi2)
	real(default) :: chi2
	type(integration_entry_t), intent(in) :: entry
	chi2 = entry%chi2
	end function integration_entry_get_chi2

	elemental function integration_entry_has_improved (entry) result (flag)
	logical :: flag
	type(integration_entry_t), intent(in) :: entry
	flag = entry%improved
	end function integration_entry_has_improved

	elemental function integration_entry_get_n_groves (entry) result (n_groves)
	integer :: n_groves
	type(integration_entry_t), intent(in) :: entry
	if (allocated (entry%chain_weights)) then
	n_groves = size (entry%chain_weights, 1)
	else
	n_groves = 0
	end if
	end function integration_entry_get_n_groves

	@ %def integration_entry_get_pass
	@ %def integration_entry_get_integral
	@ %def integration_entry_get_error
	@ %def integration_entry_get_relative_error
	@ %def integration_entry_get_accuracy
	@ %def accuracy
	@ %def integration_entry_get_efficiency
	@ %def integration_entry_get_chi2
	@ %def integration_entry_has_improved
	@ %def integration_entry_get_n_groves
	@ Output. This writes the header line for the result account below:
	<<Integration results: procedures>>=
	subroutine write_header (process_type, unit, logfile)
	integer, intent(in) :: process_type
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: logfile
	character(5) :: phys_unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	select case (process_type)
	case (PRC_DECAY); phys_unit = "[GeV]"
	case (PRC_SCATTERING); phys_unit = "[fb] "
	case default
	phys_unit = ""
	end select
	write (msg_buffer, "(A)") &
	"It Calls Integral" // phys_unit // &
	" Error" // phys_unit // &
	" Err[%] Acc Eff[%] Chi2 N[It] \|"
	call msg_message (unit=u, logfile=logfile)
	end subroutine write_header

	@ %def write_header
	@ This writes a separator for result display:
	<<Integration results: procedures>>=
	subroutine write_hline (unit)
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A)") "\|" // (repeat ("-", 77)) // "\|"
	flush (u)
	end subroutine write_hline

	subroutine write_dline (unit)
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A)") "\|" // (repeat ("=", 77)) // "\|"
	flush (u)
	end subroutine write_dline

	@ %def write_hline
	@ %def write_dline
	@ This writes the standard result account into one screen line. The
	verbose version uses multiple lines and prints the unabridged values.
	Dummy entries are not written.
	<<Integration results: procedures>>=
	subroutine integration_entry_write (entry, unit, verbose, suppress)
	type(integration_entry_t), intent(in) :: entry
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: suppress
	integer :: u
	character(1) :: star
	character(12) :: fmt
	character(7) :: fmt2
	logical :: verb, supp
	u = given_output_unit (unit); if (u < 0) return
	verb = .false.; if (present (verbose)) verb = verbose
	supp = .false.; if (present (suppress)) supp = suppress
	if (verb) then
	write (u, *) "process_type = ", entry%process_type
	write (u, *) " pass = ", entry%pass
	write (u, *) " it = ", entry%it
	write (u, *) " n_it = ", entry%n_it
	write (u, *) " n_calls = ", entry%n_calls
	write (u, *) " improved = ", entry%improved
	write (u, *) " integral = ", entry%integral
	write (u, *) " error = ", entry%error
	write (u, *) " efficiency = ", entry%efficiency
	write (u, *) " chi2 = ", entry%chi2
	if (allocated (entry%chain_weights)) then
	write (u, *) " n_groves = ", size (entry%chain_weights)
	write (u, *) "chain_weights = ", entry%chain_weights
	else
	write (u, *) " n_groves = 0"
	end if
	else if (entry%process_type /= PRC_UNKNOWN) then
	if (entry%improved .and. .not. supp) then
	star = "*"
	else
	star = " "
	end if
	call pac_fmt (fmt, FMT_14, "3x," // FMT_10 // ",1x", suppress)
	call pac_fmt (fmt2, "1x,F6.2", "2x,F5.1", suppress)
	if (entry%n_it /= 1) then
	write (u, "(1x,I3,1x,I10,1x," // fmt // ",1x,ES9.2,1x,F7.2," // &
	"1x,F7.2,A1," // fmt2 // ",1x,F7.2,1x,I3)") &
	entry%it, &
	entry%n_calls, &
	entry%integral, &
	abs(entry%error), &
	abs(integration_entry_get_relative_error (entry)) * 100, &
	abs(integration_entry_get_accuracy (entry)), &
	star, &
	entry%efficiency * 100, &
	entry%chi2, &
	entry%n_it
	else
	write (u, "(1x,I3,1x,I10,1x," // fmt // ",1x,ES9.2,1x,F7.2," // &
	"1x,F7.2,A1," // fmt2 // ",1x,F7.2,1x,I3)") &
	entry%it, &
	entry%n_calls, &
	entry%integral, &
	abs(entry%error), &
	abs(integration_entry_get_relative_error (entry)) * 100, &
	abs(integration_entry_get_accuracy (entry)), &
	star, &
	entry%efficiency * 100
	end if
	end if
	flush (u)
	end subroutine integration_entry_write

	@ %def integration_entry_write
	@ Read the entry, assuming it has been written in verbose format.
	<<Integration results: procedures>>=
	subroutine integration_entry_read (entry, unit)
	type(integration_entry_t), intent(out) :: entry
	integer, intent(in) :: unit
	character(30) :: dummy
	character :: equals
	integer :: n_groves
	read (unit, *) dummy, equals, entry%process_type
	read (unit, *) dummy, equals, entry%pass
	read (unit, *) dummy, equals, entry%it
	read (unit, *) dummy, equals, entry%n_it
	read (unit, *) dummy, equals, entry%n_calls
	read (unit, *) dummy, equals, entry%improved
	read (unit, *) dummy, equals, entry%integral
	read (unit, *) dummy, equals, entry%error
	read (unit, *) dummy, equals, entry%efficiency
	read (unit, *) dummy, equals, entry%chi2
	read (unit, *) dummy, equals, n_groves
	if (n_groves /= 0) then
	allocate (entry%chain_weights (n_groves))
	read (unit, *) dummy, equals, entry%chain_weights
	end if
	end subroutine integration_entry_read

	@ %def integration_entry_read
	@ Write an account of the channel weights, accumulated by groves.
	<<Integration results: procedures>>=
	subroutine integration_entry_write_chain_weights (entry, unit)
	type(integration_entry_t), intent(in) :: entry
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	if (allocated (entry%chain_weights)) then
	do i = 1, size (entry%chain_weights)
	write (u, "(1x,I3)", advance="no") nint (entry%chain_weights(i) * 100)
	end do
	write (u, *)
	end if
	end subroutine integration_entry_write_chain_weights

	@ %def integration_entry_write_chain_weights
	@ Compute the average for all entries in the specified integration
	pass. The integrals are weighted w.r.t.\ their individual errors.

	The quoted error of the result is the expected error, computed from
	the weighted average of the given individual errors.

	This should be compared to the actual distribution of the results,
	from which we also can compute an error estimate if there is more than
	one iteration. The ratio of the distribution error and the averaged
	error, is the $\chi^2$ value.

	All error distributions are assumed Gaussian, of course. The $\chi^2$
	value is a partial check for this assumption. If it is significantly
	greater than unity, there is something wrong with the individual errors.

	The efficiency returned is the one of the last entry in the
	integration pass.

	If any error vanishes, averaging by this algorithm would fail. In this case,
	we simply average the entries and use the deviations from this average (if
	any) to estimate the error.
	<<Integration results: procedures>>=
	function compute_average (entry, pass) result (result)
	type(integration_entry_t) :: result
	type(integration_entry_t), dimension(:), intent(in) :: entry
	integer, intent(in) :: pass
	integer :: i
	logical, dimension(size(entry)) :: mask
	real(default), dimension(size(entry)) :: ivar
	real(default) :: sum_ivar, variance
	result%process_type = entry(1)%process_type
	result%pass = pass
	mask = entry%pass == pass .and. entry%process_type /= PRC_UNKNOWN
	result%it = maxval (entry%it, mask)
	result%n_it = count (mask)
	result%n_calls = sum (entry%n_calls, mask)
	if (.not. any (mask .and. entry%error == 0)) then
	where (mask)
	ivar = 1 / entry%error ** 2
	elsewhere
	ivar = 0
	end where
	sum_ivar = sum (ivar, mask)
	if (sum_ivar /= 0) then
	variance = 1 / sum_ivar
	else
	variance = 0
	end if
	result%integral = sum (entry%integral * ivar, mask) * variance
	if (result%n_it > 1) then
	result%chi2 = &
	sum ((entry%integral - result%integral)*2 ivar, mask) &
	/ (result%n_it - 1)
	end if
	else if (result%n_it /= 0) then
	result%integral = sum (entry%integral, mask) / result%n_it
	if (result%n_it > 1) then
	variance = &
	sum ((entry%integral - result%integral)**2, mask) &
	/ (result%n_it - 1)
	if (result%integral /= 0) then
	if (abs (variance / result%integral) &
	< 100 * epsilon (1._default)) then
	variance = 0
	end if
	end if
	result%chi2 = variance / result%n_it
	else
	variance = 0
	end if
	end if
	result%error = sqrt (variance)
	do i = size (entry), 1, -1
	if (mask(i)) then
	result%efficiency = entry(i)%efficiency
	exit
	end if
	end do
	end function compute_average

	@ %def compute_average
	@
	\subsection{Combined integration results}
	We collect a list of results which grows during the execution of the
	program. This is implemented as an array which grows if necessary; so
	we can easily compute averages.

	We implement this as an extension of the [[mci_results_t]] which is
	defined in [[mci_base]] as an abstract type. We thus decouple the
	implementation of the integrator from the implementation of the
	results display, but nevertheless can record intermediate results
	during integration. This implies that the present extension
	implements a [[record]] method.
	<<Integration results: public>>=
	public :: integration_results_t
	<<Integration results: types>>=
	type, extends (mci_results_t) :: integration_results_t
	private
	integer :: process_type = PRC_UNKNOWN
	integer :: current_pass = 0
	integer :: n_pass = 0
	integer :: n_it = 0
	logical :: screen = .false.
	integer :: unit = 0
	real(default) :: error_threshold = 0
	type(integration_entry_t), dimension(:), allocatable :: entry
	type(integration_entry_t), dimension(:), allocatable :: average
	contains
	<<Integration results: integration results: TBP>>
	end type integration_results_t

	@ %def integration_results_t
	@ The array is extended in chunks of 10 entries.
	<<Integration results: parameters>>=
	integer, parameter :: RESULTS_CHUNK_SIZE = 10

	@ %def RESULTS_CHUNK_SIZE
	@ The standard does not require to explicitly initialize the integers;
	however, some gfortran version has a bug here and misses the default
	initialization in the type definition.
	<<Integration results: integration results: TBP>>=
	procedure :: init => integration_results_init
	<<Integration results: procedures>>=
	subroutine integration_results_init (results, process_type)
	class(integration_results_t), intent(out) :: results
	integer, intent(in) :: process_type
	results%process_type = process_type
	results%n_pass = 0
	results%n_it = 0
	allocate (results%entry (RESULTS_CHUNK_SIZE))
	allocate (results%average (RESULTS_CHUNK_SIZE))
	end subroutine integration_results_init

	@ %def integration_results_init
	@ Set addititional parameters: the [[error_threshold]] declares that any error
	value (in absolute numbers) smaller than this is to be considered zero.
	<<Integration results: integration results: TBP>>=
	procedure :: set_error_threshold => integration_results_set_error_threshold
	<<Integration results: procedures>>=
	subroutine integration_results_set_error_threshold (results, error_threshold)
	class(integration_results_t), intent(inout) :: results
	real(default), intent(in) :: error_threshold
	results%error_threshold = error_threshold
	end subroutine integration_results_set_error_threshold

	@ %def integration_results_set_error_threshold
	@ Output (ASCII format). The [[verbose]] format is used for writing
	the header in grid files.
	<<Integration results: integration results: TBP>>=
	procedure :: write => integration_results_write
	<<Integration results: procedures>>=
	subroutine integration_results_write (object, unit, verbose, suppress)
	class(integration_results_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: suppress
	logical :: verb
	integer :: u, n
	u = given_output_unit (unit); if (u < 0) return
	verb = .false.; if (present (verbose)) verb = verbose
	if (.not. verb) then
	call write_dline (unit)
	if (object%n_it /= 0) then
	call write_header (object%entry(1)%process_type, unit, &
	logfile=.false.)
	call write_dline (unit)
	do n = 1, object%n_it
	if (n > 1) then
	if (object%entry(n)%pass /= object%entry(n-1)%pass) then
	call write_hline (unit)
	call integration_entry_write &
	(object%average(object%entry(n-1)%pass), &
	unit, suppress = suppress)
	call write_hline (unit)
	end if
	end if
	call integration_entry_write (object%entry(n), unit, &
	suppress = suppress)
	end do
	call write_hline(unit)
	call integration_entry_write (object%average(object%n_pass), &
	unit, suppress = suppress)
	else
	call msg_message ("[WHIZARD integration results: empty]", unit)
	end if
	call write_dline (unit)
	else
	write (u, *) "begin(integration_results)"
	write (u, *) " n_pass = ", object%n_pass
	write (u, *) " n_it = ", object%n_it
	if (object%n_it > 0) then
	write (u, *) "begin(integration_pass)"
	do n = 1, object%n_it
	if (n > 1) then
	if (object%entry(n)%pass /= object%entry(n-1)%pass) then
	write (u, *) "end(integration_pass)"
	write (u, *) "begin(integration_pass)"
	end if
	end if
	write (u, *) "begin(iteration)"
	call integration_entry_write (object%entry(n), unit, &
	verbose = verb, suppress = suppress)
	write (u, *) "end(iteration)"
	end do
	write (u, *) "end(integration_pass)"
	end if
	write (u, *) "end(integration_results)"
	end if
	flush (u)
	end subroutine integration_results_write

	@ %def integration_results_write
	@ During integration, we do not want to print all results at once, but
	each intermediate result as soon as we get it. Thus, the previous procedure
	is chopped in pieces. First piece: store the
	output unit and a flag whether we want to print to standard output as
	well. Then write the header if the results are still empty, i.e.,
	before integration has started. The second piece writes a single
	result to the saved output channels. We call this from the [[record]]
	method, which can be called from the integrator directly. The third
	piece writes the average result, once a pass has been completed. The
	fourth piece writes a footer (if any), assuming that this is the final result.
	<<Integration results: integration results: TBP>>=
	procedure :: display_init => integration_results_display_init
	procedure :: display_current => integration_results_display_current
	procedure :: display_pass => integration_results_display_pass
	procedure :: display_final => integration_results_display_final
	<<Integration results: procedures>>=
	subroutine integration_results_display_init &
	(results, process_type, screen, unit)
	class(integration_results_t), intent(inout) :: results
	integer, intent(in) :: process_type
	logical, intent(in) :: screen
	integer, intent(in), optional :: unit
	integer :: u
	if (present (unit)) results%unit = unit
	u = given_output_unit ()
	results%screen = screen
	if (results%n_it == 0) then
	if (results%screen) then
	call write_dline (u)
	call write_header (process_type, u, &
	logfile=.false.)
	call write_dline (u)
	end if
	if (results%unit /= 0) then
	call write_dline (results%unit)
	call write_header (process_type, results%unit, &
	logfile=.false.)
	call write_dline (results%unit)
	end if
	else
	if (results%screen) then
	call write_hline (u)
	end if
	if (results%unit /= 0) then
	call write_hline (results%unit)
	end if
	end if
	end subroutine integration_results_display_init

	subroutine integration_results_display_current (results, pacify)
	class(integration_results_t), intent(in) :: results
	integer :: u
	logical, intent(in), optional :: pacify
	u = given_output_unit ()
	if (results%screen) then
	call integration_entry_write (results%entry(results%n_it), u, &
	suppress = pacify)
	end if
	if (results%unit /= 0) then
	call integration_entry_write (results%entry(results%n_it), &
	results%unit, suppress = pacify)
	end if
	end subroutine integration_results_display_current

	subroutine integration_results_display_pass (results, pacify)
	class(integration_results_t), intent(in) :: results
	logical, intent(in), optional :: pacify
	integer :: u
	u = given_output_unit ()
	if (results%screen) then
	call write_hline (u)
	call integration_entry_write &
	(results%average(results%entry(results%n_it)%pass), &
	u, suppress = pacify)
	end if
	if (results%unit /= 0) then
	call write_hline (results%unit)
	call integration_entry_write &
	(results%average(results%entry(results%n_it)%pass), &
	results%unit, suppress = pacify)
	end if
	end subroutine integration_results_display_pass

	subroutine integration_results_display_final (results)
	class(integration_results_t), intent(inout) :: results
	integer :: u
	u = given_output_unit ()
	if (results%screen) then
	call write_dline (u)
	end if
	if (results%unit /= 0) then
	call write_dline (results%unit)
	end if
	results%screen = .false.
	results%unit = 0
	end subroutine integration_results_display_final

	@ %def integration_results_display_init
	@ %def integration_results_display_current
	@ %def integration_results_display_pass
	@ Write a concise table of chain weights, i.e., the channel history where
	channels are collected by chains.
	<<Integration results: integration results: TBP>>=
	procedure :: write_chain_weights => &
	integration_results_write_chain_weights
	<<Integration results: procedures>>=
	subroutine integration_results_write_chain_weights (results, unit)
	class(integration_results_t), intent(in) :: results
	integer, intent(in), optional :: unit
	integer :: u, i, n
	u = given_output_unit (unit); if (u < 0) return
	if (allocated (results%entry(1)%chain_weights) .and. results%n_it /= 0) then
	call msg_message ("Phase-space chain (grove) weight history: " &
	// "(numbers in %)", unit)
	write (u, "(A9)", advance="no") "\| chain \|"
	do i = 1, integration_entry_get_n_groves (results%entry(1))
	write (u, "(1x,I3)", advance="no") i
	end do
	write (u, *)
	call write_dline (unit)
	do n = 1, results%n_it
	if (n > 1) then
	if (results%entry(n)%pass /= results%entry(n-1)%pass) then
	call write_hline (unit)
	end if
	end if
	write (u, "(1x,I6,1x,A1)", advance="no") n, "\|"
	call integration_entry_write_chain_weights (results%entry(n), unit)
	end do
	flush (u)
	call write_dline(unit)
	end if
	end subroutine integration_results_write_chain_weights

	@ %def integration_results_write_chain_weights
	@ Read the list from file. The file must be written using the
	[[verbose]] option of the writing routine.
	<<Integration results: procedures>>=
	subroutine integration_results_read (results, unit)
	type(integration_results_t), intent(out) :: results
	integer, intent(in) :: unit
	character(80) :: buffer
	character :: equals
	integer :: pass, it
	read (unit, *) buffer
	if (trim (adjustl (buffer)) /= "begin(integration_results)") then
	call read_err (); return
	end if
	read (unit, *) buffer, equals, results%n_pass
	read (unit, *) buffer, equals, results%n_it
	allocate (results%entry (results%n_it + RESULTS_CHUNK_SIZE))
	allocate (results%average (results%n_it + RESULTS_CHUNK_SIZE))
	it = 0
	do pass = 1, results%n_pass
	read (unit, *) buffer
	if (trim (adjustl (buffer)) /= "begin(integration_pass)") then
	call read_err (); return
	end if
	READ_ENTRIES: do
	read (unit, *) buffer
	if (trim (adjustl (buffer)) /= "begin(iteration)") then
	exit READ_ENTRIES
	end if
	it = it + 1
	call integration_entry_read (results%entry(it), unit)
	read (unit, *) buffer
	if (trim (adjustl (buffer)) /= "end(iteration)") then
	call read_err (); return
	end if
	end do READ_ENTRIES
	if (trim (adjustl (buffer)) /= "end(integration_pass)") then
	call read_err (); return
	end if
	results%average(pass) = compute_average (results%entry, pass)
	end do
	read (unit, *) buffer
	if (trim (adjustl (buffer)) /= "end(integration_results)") then
	call read_err (); return
	end if
	contains
	subroutine read_err ()
	call msg_fatal ("Reading integration results from file: syntax error")
	end subroutine read_err
	end subroutine integration_results_read

	@ %def integration_results_read
	@ Check integration results for consistency. We compare against an
	array of pass indices and call numbers. If there is a difference, up
	to the number of iterations done so far, we return failure. Dummy
	entries (where [[pass]] = 0) are ignored.
	<<Integration results: procedures>>=
	function integration_results_iterations_are_consistent &
	(results, pass, n_calls) result (flag)
	logical :: flag
	type(integration_results_t), intent(in) :: results
	integer, dimension(:), intent(in) :: pass, n_calls
	integer :: n_it
	n_it = results%n_it
	flag = size (pass) >= n_it .and. size (n_calls) >= n_it
	if (flag) then
	flag = all (results%entry(:n_it)%pass == pass(:n_it) &
	.and. &
	(results%entry(:n_it)%n_calls == n_calls(:n_it) &
	.or. &
	results%entry(:n_it)%process_type == PRC_UNKNOWN))
	end if
	end function integration_results_iterations_are_consistent

	@ %def integration_results_iterations_are_consistent
	@ Discard all results starting from the specified iteration.
	<<Integration results: procedures>>=
	subroutine integration_results_discard (results, it)
	type(integration_results_t), intent(inout) :: results
	integer, intent(in) :: it
	if (it <= results%n_it) then
	select case (it)
	case (:1)
	results%n_it = 0
	results%n_pass = 0
	results%current_pass = 0
	case default
	results%n_it = it - 1
	results%n_pass = maxval (results%entry(1:results%n_it)%pass)
	results%current_pass = results%n_pass
	end select
	end if
	end subroutine integration_results_discard

	@ %def integration_results_discard
	@ Expand the list of entries if the limit has been reached:
	<<Integration results: integration results: TBP>>=
	procedure :: expand => integration_results_expand
	<<Integration results: procedures>>=
	subroutine integration_results_expand (results)
	class(integration_results_t), intent(inout) :: results
	type(integration_entry_t), dimension(:), allocatable :: entry_tmp
	if (results%n_it == size (results%entry)) then
	allocate (entry_tmp (results%n_it))
	entry_tmp = results%entry
	deallocate (results%entry)
	allocate (results%entry (results%n_it + RESULTS_CHUNK_SIZE))
	results%entry(:results%n_it) = entry_tmp
	deallocate (entry_tmp)
	end if
	if (results%n_pass == size (results%average)) then
	allocate (entry_tmp (results%n_pass))
	entry_tmp = results%average
	deallocate (results%average)
	allocate (results%average (results%n_it + RESULTS_CHUNK_SIZE))
	results%average(:results%n_pass) = entry_tmp
	deallocate (entry_tmp)
	end if
	end subroutine integration_results_expand

	@ %def integration_results_expand
	@ Increment the [[current_pass]] counter. Can be done before
	integration; after integration, the recording method may use the value
	of this counter to define the entry.
	<<Integration results: integration results: TBP>>=
	procedure :: new_pass => integration_results_new_pass
	<<Integration results: procedures>>=
	subroutine integration_results_new_pass (results)
	class(integration_results_t), intent(inout) :: results
	results%current_pass = results%current_pass + 1
	end subroutine integration_results_new_pass

	@ %def integration_results_new_pass
	@ Append a new entry to the list and, if appropriate, compute the average.
	<<Integration results: integration results: TBP>>=
	procedure :: append_entry => integration_results_append_entry
	<<Integration results: procedures>>=
	subroutine integration_results_append_entry (results, entry)
	class(integration_results_t), intent(inout) :: results
	type(integration_entry_t), intent(in), optional :: entry
	if (results%n_it == 0) then
	results%n_it = 1
	results%n_pass = 1
	else
	call results%expand ()
	if (present (entry)) then
	if (entry%pass /= results%entry(results%n_it)%pass) &
	results%n_pass = results%n_pass + 1
	end if
	results%n_it = results%n_it + 1
	end if
	if (present (entry)) then
	results%entry(results%n_it) = entry
	results%average(results%n_pass) = &
	compute_average (results%entry, entry%pass)
	end if
	end subroutine integration_results_append_entry

	@ %def integration_results_append_entry
	@ Enter results into the results list. For the error value, we may compare
	them with a given threshold. This guards against numerical noise, if the
	exact error would be zero.
	<<Integration results: integration results: TBP>>=
	procedure :: append => integration_results_append
	<<Integration results: procedures>>=
	subroutine integration_results_append (results, &
	n_it, n_calls, &
	integral, error, efficiency, &
	chain_weights)
	class(integration_results_t), intent(inout) :: results
	integer, intent(in) :: n_it, n_calls
	real(default), intent(in) :: integral, error, efficiency
	real(default), dimension(:), intent(in), optional :: chain_weights
	logical :: improved
	type(integration_entry_t) :: entry
	real(default) :: err_checked
	if (results%n_it /= 0) then
	improved = abs(accuracy (integral, error, n_calls)) &
	< abs(integration_entry_get_accuracy (results%entry(results%n_it)))
	else
	improved = .true.
	end if
	if (abs (error) >= results%error_threshold) then
	err_checked = error
	else
	err_checked = 0
	end if
	call integration_entry_init (entry, &
	results%process_type, results%current_pass, &
	results%n_it+1, n_it, n_calls, improved, &
	integral, err_checked, efficiency, &
	chain_weights=chain_weights)
	call results%append_entry (entry)
	end subroutine integration_results_append

	@ %def integration_results_append
	@ Enter an empty result into the results list.
	<<Integration results: public>>=
	public :: integration_results_append_null
	<<Integration results: procedures>>=
	subroutine integration_results_append_null (results, pass, n_it)
	type(integration_results_t), intent(inout) :: results
	integer, intent(in) :: pass, n_it
	type(integration_entry_t) :: entry
	call integration_entry_init (entry, &
	PRC_UNKNOWN, results%current_pass, n_it, 1, 0, .false., &
	0._default, 0._default, 0._default)
	call results%append_entry (entry)
	end subroutine integration_results_append_null

	@ %def integration_results_append_null
	@ Record an integration pass executed by an [[mci]] integrator
	object.

	There is a tolerance below we treat an error (relative to the
	integral) as zero.
	<<Integration results: parameters>>=
	real(default), parameter, public :: INTEGRATION_ERROR_TOLERANCE = 1e-10
	@ %def INTEGRATION_ERROR_TOLERANCE
	@
	<<Integration results: integration results: TBP>>=
	procedure :: record => integration_results_record
	<<Integration results: procedures>>=
	subroutine integration_results_record &
	(object, n_it, n_calls, integral, error, efficiency, &
	chain_weights, suppress)
	class(integration_results_t), intent(inout) :: object
	integer, intent(in) :: n_it, n_calls
	real(default), intent(in) :: integral, error, efficiency
	real(default), dimension(:), intent(in), optional :: chain_weights
	real(default) :: err
	logical, intent(in), optional :: suppress

	if (abs (error) >= abs (integral) * INTEGRATION_ERROR_TOLERANCE) then
	err = error
	else
	err = 0
	end if
	call object%append (n_it, n_calls, integral, err, efficiency, chain_weights)
	call object%display_current (suppress)
	end subroutine integration_results_record

	@ %def integration_results_record
	@
	\subsection{Access results}
	Return true if the results object has entries.
	<<Integration results: integration results: TBP>>=
	procedure :: exist => integration_results_exist
	<<Integration results: procedures>>=
	function integration_results_exist (results) result (flag)
	logical :: flag
	class(integration_results_t), intent(in) :: results
	flag = results%n_pass > 0
	end function integration_results_exist

	@ %def integration_results_exist
	@ Retrieve information from the results record. If [[last]] is set and
	true, take the last iteration. If [[it]] is set instead, take this
	iteration. If [[pass]] is set, take this average. If none is set,
	take the final average.

	If the result would be invalid, the entry is not assigned. Due to
	default initialization, this returns a null entry.
	<<Integration results: integration results: TBP>>=
	procedure :: get_entry => results_get_entry
	<<Integration results: procedures>>=
	function results_get_entry (results, last, it, pass) result (entry)
	class(integration_results_t), intent(in) :: results
	type(integration_entry_t) :: entry
	logical, intent(in), optional :: last
	integer, intent(in), optional :: it, pass
	if (present (last)) then
	if (allocated (results%entry) .and. results%n_it > 0) then
	entry = results%entry(results%n_it)
	else
	call error ()
	end if
	else if (present (it)) then
	if (allocated (results%entry) .and. it > 0 .and. it <= results%n_it) then
	entry = results%entry(it)
	else
	call error ()
	end if
	else if (present (pass)) then
	if (allocated (results%average) &
	.and. pass > 0 .and. pass <= results%n_pass) then
	entry = results%average (pass)
	else
	call error ()
	end if
	else
	if (allocated (results%average) .and. results%n_pass > 0) then
	entry = results%average (results%n_pass)
	else
	call error ()
	end if
	end if
	contains
	subroutine error ()
	call msg_fatal ("Requested integration result is not available")
	end subroutine error
	end function results_get_entry

	@ %def results_get_entry
	@ The individual procedures. The [[results]] record should have the
	[[target]] attribute, but only locally within the function.
	<<Integration results: integration results: TBP>>=
	procedure :: get_n_calls => integration_results_get_n_calls
	procedure :: get_integral => integration_results_get_integral
	procedure :: get_error => integration_results_get_error
	procedure :: get_accuracy => integration_results_get_accuracy
	procedure :: get_chi2 => integration_results_get_chi2
	procedure :: get_efficiency => integration_results_get_efficiency
	<<Integration results: procedures>>=
	function integration_results_get_n_calls (results, last, it, pass) &
	result (n_calls)
	class(integration_results_t), intent(in), target :: results
	integer :: n_calls
	logical, intent(in), optional :: last
	integer, intent(in), optional :: it, pass
	n_calls = integration_entry_get_n_calls &
	(results%get_entry (last, it, pass))
	end function integration_results_get_n_calls

	function integration_results_get_integral (results, last, it, pass) &
	result (integral)
	class(integration_results_t), intent(in), target :: results
	real(default) :: integral
	logical, intent(in), optional :: last
	integer, intent(in), optional :: it, pass
	integral = integration_entry_get_integral &
	(results%get_entry (last, it, pass))
	end function integration_results_get_integral

	function integration_results_get_error (results, last, it, pass) &
	result (error)
	class(integration_results_t), intent(in), target :: results
	real(default) :: error
	logical, intent(in), optional :: last
	integer, intent(in), optional :: it, pass
	error = integration_entry_get_error &
	(results%get_entry (last, it, pass))
	end function integration_results_get_error

	function integration_results_get_accuracy (results, last, it, pass) &
	result (accuracy)
	class(integration_results_t), intent(in), target :: results
	real(default) :: accuracy
	logical, intent(in), optional :: last
	integer, intent(in), optional :: it, pass
	accuracy = integration_entry_get_accuracy &
	(results%get_entry (last, it, pass))
	end function integration_results_get_accuracy

	function integration_results_get_chi2 (results, last, it, pass) &
	result (chi2)
	class(integration_results_t), intent(in), target :: results
	real(default) :: chi2
	logical, intent(in), optional :: last
	integer, intent(in), optional :: it, pass
	chi2 = integration_entry_get_chi2 &
	(results%get_entry (last, it, pass))
	end function integration_results_get_chi2

	function integration_results_get_efficiency (results, last, it, pass) &
	result (efficiency)
	class(integration_results_t), intent(in), target :: results
	real(default) :: efficiency
	logical, intent(in), optional :: last
	integer, intent(in), optional :: it, pass
	efficiency = integration_entry_get_efficiency &
	(results%get_entry (last, it, pass))
	end function integration_results_get_efficiency

	@ %def integration_results_get_n_calls
	@ %def integration_results_get_integral
	@ %def integration_results_get_error
	@ %def integration_results_get_accuracy
	@ %def integration_results_get_chi2
	@ %def integration_results_get_efficiency
	@ Return the last pass index and the index of the last iteration
	\emph{within} the last pass. The third routine returns the absolute
	index of the last iteration.
	<<Integration results: procedures>>=
	function integration_results_get_current_pass (results) result (pass)
	integer :: pass
	type(integration_results_t), intent(in) :: results
	pass = results%n_pass
	end function integration_results_get_current_pass

	function integration_results_get_current_it (results) result (it)
	integer :: it
	type(integration_results_t), intent(in) :: results
	if (allocated (results%entry)) then
	it = count (results%entry(1:results%n_it)%pass == results%n_pass)
	else
	it = 0
	end if
	end function integration_results_get_current_it

	function integration_results_get_last_it (results) result (it)
	integer :: it
	type(integration_results_t), intent(in) :: results
	it = results%n_it
	end function integration_results_get_last_it

	@ %def integration_results_get_current_pass
	@ %def integration_results_get_current_it
	@ %def integration_results_get_last_it
	@ Return the index of the best iteration (lowest accuracy value)
	within the current pass. If none qualifies, return zero.
	<<Integration results: procedures>>=
	function integration_results_get_best_it (results) result (it)
	integer :: it
	type(integration_results_t), intent(in) :: results
	integer :: i
	real(default) :: acc, acc_best
	acc_best = -1
	it = 0
	do i = 1, results%n_it
	if (results%entry(i)%pass == results%n_pass) then
	acc = integration_entry_get_accuracy (results%entry(i))
	if (acc_best < 0 .or. acc <= acc_best) then
	acc_best = acc
	it = i
	end if
	end if
	end do
	end function integration_results_get_best_it

	@ %def integration_results_get_best_it
	@ Compute the MD5 sum by printing everything and checksumming the
	resulting file.
	<<Integration results: procedures>>=
	function integration_results_get_md5sum (results) result (md5sum_results)
	character(32) :: md5sum_results
	type(integration_results_t), intent(in) :: results
	integer :: u
	u = free_unit ()
	open (unit = u, status = "scratch", action = "readwrite")
	call integration_results_write (results, u, verbose=.true.)
	rewind (u)
	md5sum_results = md5sum (u)
	close (u)
	end function integration_results_get_md5sum

	@ %def integration_results_get_md5sum
	@
	This is (ab)used to suppress numerical noise when integrating constant
	matrix elements.
	<<Integration results: integration results: TBP>>=
	procedure :: pacify => integration_results_pacify
	<<Integration results: procedures>>=
	subroutine integration_results_pacify (results, efficiency_reset)
	class(integration_results_t), intent(inout) :: results
	logical, intent(in), optional :: efficiency_reset
	integer :: i
	logical :: reset
	reset = .false.
	if (present (efficiency_reset)) reset = efficiency_reset
	if (allocated (results%entry)) then
	do i = 1, size (results%entry)
	call pacify (results%entry(i)%error, &
	results%entry(i)%integral * 1.E-9_default)
	if (reset) results%entry(i)%efficiency = 1
	end do
	end if
	if (allocated (results%average)) then
	do i = 1, size (results%average)
	call pacify (results%average(i)%error, &
	results%average(i)%integral * 1.E-9_default)
	if (reset) results%average(i)%efficiency = 1
	end do
	end if
	end subroutine integration_results_pacify

	@ %def integration_results_pacify
	@
	<<Integration results: integration results: TBP>>=
	procedure :: record_correction => integration_results_record_correction
	<<Integration results: procedures>>=
	subroutine integration_results_record_correction (object, corr, err)
	class(integration_results_t), intent(inout) :: object
	real(default), intent(in) :: corr, err
	integer :: u
	u = given_output_unit ()
	if (object%screen) then
	call write_hline (u)
	call msg_message ("NLO Results: O(alpha_s+1)/O(alpha_s)")
	write(u,'(1X,F6.4,A4,F7.5)') corr, ' +- ', err
	end if
	end subroutine integration_results_record_correction

	@ %def integration_results_record_correction
	@
	\subsection{Results display}
	Write a driver file for history visualization.

	The ratio of $y$ range over $y$ value must not become too small, otherwise
	we run into an arithmetic overflow in GAMELAN. 2\% appears to be safe.
	<<Integration results: parameters>>=
	real, parameter, public :: GML_MIN_RANGE_RATIO = 0.02
	<<Integration results: public>>=
	public :: integration_results_write_driver
	<<Integration results: procedures>>=
	subroutine integration_results_write_driver (results, filename, eff_reset)
	type(integration_results_t), intent(inout) :: results
	type(string_t), intent(in) :: filename
	logical, intent(in), optional :: eff_reset
	type(string_t) :: file_tex
	integer :: unit
	integer :: n, i, n_pass, pass
	integer, dimension(:), allocatable :: ipass
	real(default) :: ymin, ymax, yavg, ydif, y0, y1
	logical :: reset
	file_tex = filename // ".tex"
	unit = free_unit ()
	open (unit=unit, file=char(file_tex), action="write", status="replace")
	reset = .false.; if (present (eff_reset)) reset = eff_reset
	n = results%n_it
	n_pass = results%n_pass
	allocate (ipass (results%n_pass))
	ipass(1) = 0
	pass = 2
	do i = 1, n-1
	if (integration_entry_get_pass (results%entry(i)) &
	/= integration_entry_get_pass (results%entry(i+1))) then
	ipass(pass) = i
	pass = pass + 1
	end if
	end do
	ymin = minval (integration_entry_get_integral (results%entry(:n)) &
	- integration_entry_get_error (results%entry(:n)))
	ymax = maxval (integration_entry_get_integral (results%entry(:n)) &
	+ integration_entry_get_error (results%entry(:n)))
	yavg = (ymax + ymin) / 2
	ydif = (ymax - ymin)
	if (ydif * 1.5 > GML_MIN_RANGE_RATIO * yavg) then
	y0 = yavg - ydif * 0.75
	y1 = yavg + ydif * 0.75
	else
	y0 = yavg * (1 - GML_MIN_RANGE_RATIO / 2)
	y1 = yavg * (1 + GML_MIN_RANGE_RATIO / 2)
	end if
	write (unit, "(A)") "\documentclass{article}"
	write (unit, "(A)") "\usepackage{a4wide}"
	write (unit, "(A)") "\usepackage{gamelan}"
	write (unit, "(A)") "\usepackage{amsmath}"
	write (unit, "(A)") ""
	write (unit, "(A)") "\begin{document}"
	write (unit, "(A)") "\begin{gmlfile}"
	write (unit, "(A)") "\section*{Integration Results Display}"
	write (unit, "(A)") ""
	write (unit, "(A)") "Process: \verb\|" // char (filename) // "\|"
	write (unit, "(A)") ""
	write (unit, "(A)") "\vspace*{2\baselineskip}"
	write (unit, "(A)") "\unitlength 1mm"
	write (unit, "(A)") "\begin{gmlcode}"
	write (unit, "(A)") " picture sym; sym = fshape (circle scaled 1mm)();"
	write (unit, "(A)") " color col.band; col.band = 0.9white;"
	write (unit, "(A)") " color col.eband; col.eband = 0.98white;"
	write (unit, "(A)") "\end{gmlcode}"
	write (unit, "(A)") "\begin{gmlgraph*}(130,180)[history]"
	write (unit, "(A)") " setup (linear, linear);"
	write (unit, "(A,I0,A)") " history.n_pass = ", n_pass, ";"
	write (unit, "(A,I0,A)") " history.n_it = ", n, ";"
	write (unit, "(A,A,A)") " history.y0 = #""", char (mp_format (y0)), """;"
	write (unit, "(A,A,A)") " history.y1 = #""", char (mp_format (y1)), """;"
	write (unit, "(A)") &
	" graphrange (#0.5, history.y0), (#(n+0.5), history.y1);"
	do pass = 1, n_pass
	write (unit, "(A,I0,A,I0,A)") &
	" history.pass[", pass, "] = ", ipass(pass), ";"
	write (unit, "(A,I0,A,A,A)") &
	" history.avg[", pass, "] = #""", &
	char (mp_format &
	(integration_entry_get_integral (results%average(pass)))), &
	""";"
	write (unit, "(A,I0,A,A,A)") &
	" history.err[", pass, "] = #""", &
	char (mp_format &
	(integration_entry_get_error (results%average(pass)))), &
	""";"
	write (unit, "(A,I0,A,A,A)") &
	" history.chi[", pass, "] = #""", &
	char (mp_format &
	(integration_entry_get_chi2 (results%average(pass)))), &
	""";"
	end do
	write (unit, "(A,I0,A,I0,A)") &
	" history.pass[", n_pass + 1, "] = ", n, ";"
	write (unit, "(A)") " for i = 1 upto history.n_pass:"
	write (unit, "(A)") " if history.chi[i] greater one:"
	write (unit, "(A)") " fill plot ("
	write (unit, "(A)") &
	" (#(history.pass[i] +.5), " &
	// "history.avg[i] minus history.err[i] times history.chi[i]),"
	write (unit, "(A)") &
	" (#(history.pass[i+1]+.5), " &
	// "history.avg[i] minus history.err[i] times history.chi[i]),"
	write (unit, "(A)") &
	" (#(history.pass[i+1]+.5), " &
	// "history.avg[i] plus history.err[i] times history.chi[i]),"
	write (unit, "(A)") &
	" (#(history.pass[i] +.5), " &
	// "history.avg[i] plus history.err[i] times history.chi[i])"
	write (unit, "(A)") " ) withcolor col.eband fi;"
	write (unit, "(A)") " fill plot ("
	write (unit, "(A)") &
	" (#(history.pass[i] +.5), history.avg[i] minus history.err[i]),"
	write (unit, "(A)") &
	" (#(history.pass[i+1]+.5), history.avg[i] minus history.err[i]),"
	write (unit, "(A)") &
	" (#(history.pass[i+1]+.5), history.avg[i] plus history.err[i]),"
	write (unit, "(A)") &
	" (#(history.pass[i] +.5), history.avg[i] plus history.err[i])"
	write (unit, "(A)") " ) withcolor col.band;"
	write (unit, "(A)") " draw plot ("
	write (unit, "(A)") &
	" (#(history.pass[i] +.5), history.avg[i]),"
	write (unit, "(A)") &
	" (#(history.pass[i+1]+.5), history.avg[i])"
	write (unit, "(A)") " ) dashed evenly;"
	write (unit, "(A)") " endfor"
	write (unit, "(A)") " for i = 1 upto history.n_pass + 1:"
	write (unit, "(A)") " draw plot ("
	write (unit, "(A)") &
	" (#(history.pass[i]+.5), history.y0),"
	write (unit, "(A)") &
	" (#(history.pass[i]+.5), history.y1)"
	write (unit, "(A)") " ) dashed withdots;"
	write (unit, "(A)") " endfor"
	do i = 1, n
	write (unit, "(A,I0,A,A,A,A,A)") " plot (history) (#", &
	i, ", #""", &
	char (mp_format (integration_entry_get_integral (results%entry(i)))),&
	""") vbar #""", &
	char (mp_format (integration_entry_get_error (results%entry(i)))), &
	""";"
	end do
	write (unit, "(A)") " draw piecewise from (history) " &
	// "withsymbol sym;"
	write (unit, "(A)") " fullgrid.lr (5,20);"
	write (unit, "(A)") " standardgrid.bt (n);"
	write (unit, "(A)") " begingmleps ""Whizard-Logo.eps"";"
	write (unit, "(A)") " base := (120unitlength,170unitlength);"
	write (unit, "(A)") " height := 9.6*unitlength;"
	write (unit, "(A)") " width := 11.2*unitlength;"
	write (unit, "(A)") " endgmleps;"
	write (unit, "(A)") "\end{gmlgraph*}"
	write (unit, "(A)") "\end{gmlfile}"
	write (unit, "(A)") "\clearpage"
	write (unit, "(A)") "\begin{verbatim}"
	if (reset) then
	call results%pacify (reset)
	end if
	call integration_results_write (results, unit)
	write (unit, "(A)") "\end{verbatim}"
	write (unit, "(A)") "\end{document}"
	close (unit)
	end subroutine integration_results_write_driver

	@ %def integration_results_write_driver
	@ Call \LaTeX\ and Metapost for the history driver file, and convert to PS and
	PDF.
	<<Integration results: public>>=
	public :: integration_results_compile_driver
	<<Integration results: procedures>>=
	subroutine integration_results_compile_driver (results, filename, os_data)
	type(integration_results_t), intent(in) :: results
	type(string_t), intent(in) :: filename
	type(os_data_t), intent(in) :: os_data
	integer :: unit_dev, status
	type(string_t) :: file_tex, file_dvi, file_ps, file_pdf, file_mp
	type(string_t) :: setenv_tex, setenv_mp, pipe, pipe_dvi
	if (.not. os_data%event_analysis) then
	call msg_warning ("Skipping integration history display " &
	// "because latex or mpost is not available")
	return
	end if
	file_tex = filename // ".tex"
	file_dvi = filename // ".dvi"
	file_ps = filename // ".ps"
	file_pdf = filename // ".pdf"
	file_mp = filename // ".mp"
	call msg_message ("Creating integration history display "&
	// char (file_ps) // " and " // char (file_pdf))
	BLOCK: do
	unit_dev = free_unit ()
	open (file = "/dev/null", unit = unit_dev, &
	action = "write", iostat = status)
	if (status /= 0) then
	pipe = ""
	pipe_dvi = ""
	else
	pipe = " > /dev/null"
	pipe_dvi = " 2>/dev/null 1>/dev/null"
	end if
	close (unit_dev)
	if (os_data%whizard_texpath /= "") then
	setenv_tex = &
	"TEXINPUTS=" // os_data%whizard_texpath // ":$TEXINPUTS "
	setenv_mp = &
	"MPINPUTS=" // os_data%whizard_texpath // ":$MPINPUTS "
	else
	setenv_tex = ""
	setenv_mp = ""
	end if
	call os_system_call (setenv_tex // os_data%latex // " " // &
	file_tex // pipe, status)
	if (status /= 0) exit BLOCK
	if (os_data%gml /= "") then
	call os_system_call (setenv_mp // os_data%gml // " " // &
	file_mp // pipe, status)
	else
	call msg_error ("Could not use GAMELAN/MetaPOST.")
	exit BLOCK
	end if
	if (status /= 0) exit BLOCK
	call os_system_call (setenv_tex // os_data%latex // " " // &
	file_tex // pipe, status)
	if (status /= 0) exit BLOCK
	if (os_data%event_analysis_ps) then
	call os_system_call (os_data%dvips // " " // &
	file_dvi // pipe_dvi, status)
	if (status /= 0) exit BLOCK
	else
	call msg_warning ("Skipping PostScript generation because dvips " &
	// "is not available")
	exit BLOCK
	end if
	if (os_data%event_analysis_pdf) then
	call os_system_call (os_data%ps2pdf // " " // &
	file_ps, status)
	if (status /= 0) exit BLOCK
	else
	call msg_warning ("Skipping PDF generation because ps2pdf " &
	// "is not available")
	exit BLOCK
	end if
	exit BLOCK
	end do BLOCK
	if (status /= 0) then
	call msg_error ("Unable to compile integration history display")
	end if
	end subroutine integration_results_compile_driver

	@ %def integration_results_compile_driver
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Simple midpoint integration}
	This is a most simple implementation of an integrator. The algorithm
	is the straightforward multi-dimensional midpoint rule, i.e., the
	integration hypercube is binned uniformly, the integrand is evaluated
	at the midpoints of each bin, and the result is the average. The
	binning is equivalent for all integration dimensions.

	This rule is accurate to the order $h^2$, where $h$ is the bin width.
	Given that $h=N^{-1/d}$, where $d$ is the integration dimension and
	$N$ is the total number of sampling points, we get a relative error
	of order $N^{-2/d}$. This is superior to MC integration if $d<4$, and
	equivalent if $d=4$. It is not worse than higher-order formulas
	(such as Gauss integration) if the integrand is not smooth, e.g., if
	it contains cuts.

	The integrator is specifically single-channel. However, we do not
	limit the dimension.
	<<[[mci_midpoint.f90]]>>=
	<<File header>>

	module mci_midpoint

	use kinds
	<<Use strings>>
	use io_units
	use unit_tests
	use diagnostics

	use phs_base
	use rng_base
	use mci_base

	<<Standard module head>>

	<<MCI midpoint: public>>

	<<MCI midpoint: types>>

	<<MCI midpoint: test types>>

	contains

	<<MCI midpoint: procedures>>

	<<MCI midpoint: tests>>

	end module mci_midpoint
	@ %def mci_midpoint
	@
	\subsection{Integrator}
	The object contains the methods for integration and event generation.
	For the actual work and data storage, it spawns an instance object.

	After an integration pass, we update the [[max]] parameter to indicate
	the maximum absolute value of the integrand that the integrator
	encountered. This is required for event generation.
	<<MCI midpoint: public>>=
	public :: mci_midpoint_t
	<<MCI midpoint: types>>=
	type, extends (mci_t) :: mci_midpoint_t
	integer :: n_dim_binned = 0
	logical, dimension(:), allocatable :: dim_is_binned
	logical :: calls_known = .false.
	integer :: n_calls = 0
	integer :: n_calls_pos = 0
	integer :: n_calls_nul = 0
	integer :: n_calls_neg = 0
	real(default) :: integral_pos = 0
	real(default) :: integral_neg = 0
	integer, dimension(:), allocatable :: n_bin
	logical :: max_known = .false.
	real(default) :: max = 0
	real(default) :: min = 0
	real(default) :: max_abs = 0
	real(default) :: min_abs = 0
	contains
	<<MCI midpoint: mci midpoint: TBP>>
	end type mci_midpoint_t

	@ %def mci_t
	@ Finalizer: base version is sufficient
	<<MCI midpoint: mci midpoint: TBP>>=
	procedure :: final => mci_midpoint_final
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_final (object)
	class(mci_midpoint_t), intent(inout) :: object
	call object%base_final ()
	end subroutine mci_midpoint_final

	@ %def mci_midpoint_final
	@ Output.
	<<MCI midpoint: mci midpoint: TBP>>=
	procedure :: write => mci_midpoint_write
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_write (object, unit, pacify, md5sum_version)
	class(mci_midpoint_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacify
	logical, intent(in), optional :: md5sum_version
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Single-channel midpoint rule integrator:"
	call object%base_write (u, pacify, md5sum_version)
	if (object%n_dim_binned < object%n_dim) then
	write (u, "(3x,A,99(1x,I0))") "Flat dimensions =", &
	pack ([(i, i = 1, object%n_dim)], mask = .not. object%dim_is_binned)
	write (u, "(3x,A,I0)") "Number of binned dim = ", object%n_dim_binned
	end if
	if (object%calls_known) then
	write (u, "(3x,A,99(1x,I0))") "Number of bins =", object%n_bin
	write (u, "(3x,A,I0)") "Number of calls = ", object%n_calls
	if (object%n_calls_pos /= object%n_calls) then
	write (u, "(3x,A,I0)") " positive value = ", object%n_calls_pos
	write (u, "(3x,A,I0)") " zero value = ", object%n_calls_nul
	write (u, "(3x,A,I0)") " negative value = ", object%n_calls_neg
	write (u, "(3x,A,ES17.10)") &
	"Integral (pos. part) = ", object%integral_pos
	write (u, "(3x,A,ES17.10)") &
	"Integral (neg. part) = ", object%integral_neg
	end if
	end if
	if (object%max_known) then
	write (u, "(3x,A,ES17.10)") "Maximum of integrand = ", object%max
	write (u, "(3x,A,ES17.10)") "Minimum of integrand = ", object%min
	if (object%min /= object%min_abs) then
	write (u, "(3x,A,ES17.10)") "Maximum (abs. value) = ", object%max_abs
	write (u, "(3x,A,ES17.10)") "Minimum (abs. value) = ", object%min_abs
	end if
	end if
	if (allocated (object%rng)) call object%rng%write (u)
	end subroutine mci_midpoint_write

	@ %def mci_midpoint_write
	@ Startup message: short version.
	<<MCI midpoint: mci midpoint: TBP>>=
	procedure :: startup_message => mci_midpoint_startup_message
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_startup_message (mci, unit, n_calls)
	class(mci_midpoint_t), intent(in) :: mci
	integer, intent(in), optional :: unit, n_calls
	call mci%base_startup_message (unit = unit, n_calls = n_calls)
	if (mci%n_dim_binned < mci%n_dim) then
	write (msg_buffer, "(A,2(1x,I0,1x,A))") &
	"Integrator: Midpoint rule:", &
	mci%n_dim_binned, "binned dimensions"
	else
	write (msg_buffer, "(A,2(1x,I0,1x,A))") &
	"Integrator: Midpoint rule"
	end if
	call msg_message (unit = unit)
	end subroutine mci_midpoint_startup_message

	@ %def mci_midpoint_startup_message
	@ The number of channels must be one.
	<<MCI midpoint: mci midpoint: TBP>>=
	procedure :: set_dimensions => mci_midpoint_set_dimensions
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_set_dimensions (mci, n_dim, n_channel)
	class(mci_midpoint_t), intent(inout) :: mci
	integer, intent(in) :: n_dim
	integer, intent(in) :: n_channel
	if (n_channel == 1) then
	mci%n_channel = n_channel
	mci%n_dim = n_dim
	allocate (mci%dim_is_binned (mci%n_dim))
	mci%dim_is_binned = .true.
	mci%n_dim_binned = count (mci%dim_is_binned)
	allocate (mci%n_bin (mci%n_dim))
	mci%n_bin = 0
	else
	call msg_fatal ("Attempt to initialize single-channel integrator &
	&for multiple channels")
	end if
	end subroutine mci_midpoint_set_dimensions

	@ %def mci_midpoint_set_dimensions
	@ Declare particular dimensions as flat. These dimensions will not be binned.
	<<MCI midpoint: mci midpoint: TBP>>=
	procedure :: declare_flat_dimensions => mci_midpoint_declare_flat_dimensions
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_declare_flat_dimensions (mci, dim_flat)
	class(mci_midpoint_t), intent(inout) :: mci
	integer, dimension(:), intent(in) :: dim_flat
	integer :: d
	mci%n_dim_binned = mci%n_dim - size (dim_flat)
	do d = 1, size (dim_flat)
	mci%dim_is_binned(dim_flat(d)) = .false.
	end do
	mci%n_dim_binned = count (mci%dim_is_binned)
	end subroutine mci_midpoint_declare_flat_dimensions

	@ %def mci_midpoint_declare_flat_dimensions
	@ Declare particular channels as equivalent. This has no effect.
	<<MCI midpoint: mci midpoint: TBP>>=
	procedure :: declare_equivalences => mci_midpoint_ignore_equivalences
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_ignore_equivalences (mci, channel, dim_offset)
	class(mci_midpoint_t), intent(inout) :: mci
	type(phs_channel_t), dimension(:), intent(in) :: channel
	integer, intent(in) :: dim_offset
	end subroutine mci_midpoint_ignore_equivalences

	@ %def mci_midpoint_ignore_equivalences
	@ Allocate instance with matching type.
	<<MCI midpoint: mci midpoint: TBP>>=
	procedure :: allocate_instance => mci_midpoint_allocate_instance
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_allocate_instance (mci, mci_instance)
	class(mci_midpoint_t), intent(in) :: mci
	class(mci_instance_t), intent(out), pointer :: mci_instance
	allocate (mci_midpoint_instance_t :: mci_instance)
	end subroutine mci_midpoint_allocate_instance

	@ %def mci_midpoint_allocate_instance
	@ Integrate. The number of dimensions is arbitrary. We make sure
	that the number of calls is evenly distributed among the dimensions.
	The actual number of calls will typically be smaller than the
	requested number, but never smaller than 1.

	The sampling over a variable number of dimensions implies a variable
	number of nested loops. We implement this by a recursive subroutine,
	one loop in each recursion level.

	The number of iterations [[n_it]] is ignored. Also, the error is set
	to zero in the current implementation.

	With this integrator, we allow the calculation to abort immediately when
	forced by a signal. There is no state that we can save, hence we do not catch
	an interrupt.
	<<MCI midpoint: mci midpoint: TBP>>=
	procedure :: integrate => mci_midpoint_integrate
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_integrate (mci, instance, sampler, n_it, n_calls, &
	results, pacify)
	class(mci_midpoint_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout) :: instance
	class(mci_sampler_t), intent(inout) :: sampler
	integer, intent(in) :: n_it
	integer, intent(in) :: n_calls
	logical, intent(in), optional :: pacify
	class(mci_results_t), intent(inout), optional :: results
	real(default), dimension(:), allocatable :: x
	real(default) :: integral, integral_pos, integral_neg
	integer :: n_bin
	select type (instance)
	type is (mci_midpoint_instance_t)
	allocate (x (mci%n_dim))
	integral = 0
	integral_pos = 0
	integral_neg = 0
	select case (mci%n_dim_binned)
	case (1)
	n_bin = n_calls
	case (2:)
	n_bin = max (int (n_calls ** (1. / mci%n_dim_binned)), 1)
	end select
	where (mci%dim_is_binned)
	mci%n_bin = n_bin
	elsewhere
	mci%n_bin = 1
	end where
	mci%n_calls = product (mci%n_bin)
	mci%n_calls_pos = 0
	mci%n_calls_nul = 0
	mci%n_calls_neg = 0
	mci%calls_known = .true.
	call sample_dim (mci%n_dim)
	mci%integral = integral / mci%n_calls
	mci%integral_pos = integral_pos / mci%n_calls
	mci%integral_neg = integral_neg / mci%n_calls
	mci%integral_known = .true.
	call instance%set_max ()
	if (present (results)) then
	call results%record (1, mci%n_calls, &
	mci%integral, mci%error, mci%efficiency)
	end if
	end select
	contains
	recursive subroutine sample_dim (d)
	integer, intent(in) :: d
	integer :: i
	real(default) :: value
	do i = 1, mci%n_bin(d)
	x(d) = (i - 0.5_default) / mci%n_bin(d)
	if (d > 1) then
	call sample_dim (d - 1)
	else
	if (signal_is_pending ()) return
	call instance%evaluate (sampler, 1, x)
	value = instance%get_value ()
	if (value > 0) then
	mci%n_calls_pos = mci%n_calls_pos + 1
	integral = integral + value
	integral_pos = integral_pos + value
	else if (value == 0) then
	mci%n_calls_nul = mci%n_calls_nul + 1
	else
	mci%n_calls_neg = mci%n_calls_neg + 1
	integral = integral + value
	integral_neg = integral_neg + value
	end if
	end if
	end do
	end subroutine sample_dim
	end subroutine mci_midpoint_integrate

	@ %def mci_midpoint_integrate
	@ Simulation initializer and finalizer: nothing to do here.
	<<MCI midpoint: mci midpoint: TBP>>=
	procedure :: prepare_simulation => mci_midpoint_ignore_prepare_simulation
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_ignore_prepare_simulation (mci)
	class(mci_midpoint_t), intent(inout) :: mci
	end subroutine mci_midpoint_ignore_prepare_simulation

	@ %def mci_midpoint_ignore_prepare_simulation
	@ Generate weighted event.
	<<MCI midpoint: mci midpoint: TBP>>=
	procedure :: generate_weighted_event => mci_midpoint_generate_weighted_event
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_generate_weighted_event (mci, instance, sampler)
	class(mci_midpoint_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout), target :: instance
	class(mci_sampler_t), intent(inout), target :: sampler
	real(default), dimension(mci%n_dim) :: x
	select type (instance)
	type is (mci_midpoint_instance_t)
	call mci%rng%generate (x)
	call instance%evaluate (sampler, 1, x)
	instance%excess_weight = 0
	end select
	end subroutine mci_midpoint_generate_weighted_event

	@ %def mci_midpoint_generate_weighted_event
	@ For unweighted events, we generate weighted events and apply a
	simple rejection step to the relative event weight, until an event
	passes.

	Note that we use the [[max_abs]] value stored in the configuration
	record, not the one stored in the instance. The latter may change
	during event generation. After an event generation pass is over, we
	may update the value for a subsequent pass.
	<<MCI midpoint: mci midpoint: TBP>>=
	procedure :: generate_unweighted_event => &
	mci_midpoint_generate_unweighted_event
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_generate_unweighted_event (mci, instance, sampler)
	class(mci_midpoint_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout), target :: instance
	class(mci_sampler_t), intent(inout), target :: sampler
	real(default) :: x, norm, int
	select type (instance)
	type is (mci_midpoint_instance_t)
	if (mci%max_known .and. mci%max_abs > 0) then
	norm = abs (mci%max_abs * instance%safety_factor)
	REJECTION: do
	call mci%generate_weighted_event (instance, sampler)
	if (sampler%is_valid ()) then
	call mci%rng%generate (x)
	int = abs (instance%integrand)
	if (x * norm <= int) then
	if (norm > 0 .and. norm < int) then
	instance%excess_weight = int / norm - 1
	end if
	exit REJECTION
	end if
	end if
	if (signal_is_pending ()) return
	end do REJECTION
	else
	call msg_fatal ("Unweighted event generation: &
	&maximum of integrand is zero or unknown")
	end if
	end select
	end subroutine mci_midpoint_generate_unweighted_event

	@ %def mci_midpoint_generate_unweighted_event
	@ Rebuild an event, using the [[state]] input.
	<<MCI midpoint: mci midpoint: TBP>>=
	procedure :: rebuild_event => mci_midpoint_rebuild_event
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_rebuild_event (mci, instance, sampler, state)
	class(mci_midpoint_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout) :: instance
	class(mci_sampler_t), intent(inout) :: sampler
	class(mci_state_t), intent(in) :: state
	select type (instance)
	type is (mci_midpoint_instance_t)
	call instance%recall (sampler, state)
	end select
	end subroutine mci_midpoint_rebuild_event

	@ %def mci_midpoint_rebuild_event
	@
	\subsection{Integrator instance}
	Covering the case of flat dimensions, we store a complete [[x]] array. This
	is filled when generating events.
	<<MCI midpoint: public>>=
	public :: mci_midpoint_instance_t
	<<MCI midpoint: types>>=
	type, extends (mci_instance_t) :: mci_midpoint_instance_t
	type(mci_midpoint_t), pointer :: mci => null ()
	logical :: max_known = .false.
	real(default) :: max = 0
	real(default) :: min = 0
	real(default) :: max_abs = 0
	real(default) :: min_abs = 0
	real(default) :: safety_factor = 1
	real(default) :: excess_weight = 0
	contains
	<<MCI midpoint: mci midpoint instance: TBP>>
	end type mci_midpoint_instance_t

	@ %def mci_midpoint_instance_t
	@ Output.
	<<MCI midpoint: mci midpoint instance: TBP>>=
	procedure :: write => mci_midpoint_instance_write
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_instance_write (object, unit, pacify)
	class(mci_midpoint_instance_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacify
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A,9(1x,F12.10))") "x =", object%x(:,1)
	write (u, "(1x,A,ES19.12)") "Integrand = ", object%integrand
	write (u, "(1x,A,ES19.12)") "Weight = ", object%mci_weight
	if (object%safety_factor /= 1) then
	write (u, "(1x,A,ES19.12)") "Safety f = ", object%safety_factor
	end if
	if (object%excess_weight /= 0) then
	write (u, "(1x,A,ES19.12)") "Excess = ", object%excess_weight
	end if
	if (object%max_known) then
	write (u, "(1x,A,ES19.12)") "Maximum = ", object%max
	write (u, "(1x,A,ES19.12)") "Minimum = ", object%min
	if (object%min /= object%min_abs) then
	write (u, "(1x,A,ES19.12)") "Max.(abs) = ", object%max_abs
	write (u, "(1x,A,ES19.12)") "Min.(abs) = ", object%min_abs
	end if
	end if
	end subroutine mci_midpoint_instance_write

	@ %def mci_midpoint_instance_write
	@ The finalizer is empty.
	<<MCI midpoint: mci midpoint instance: TBP>>=
	procedure :: final => mci_midpoint_instance_final
	<<MCI midpoint: tests>>=
	subroutine mci_midpoint_instance_final (object)
	class(mci_midpoint_instance_t), intent(inout) :: object
	end subroutine mci_midpoint_instance_final

	@ %def mci_midpoint_instance_final
	@ Initializer.
	<<MCI midpoint: mci midpoint instance: TBP>>=
	procedure :: init => mci_midpoint_instance_init
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_instance_init (mci_instance, mci)
	class(mci_midpoint_instance_t), intent(out) :: mci_instance
	class(mci_t), intent(in), target :: mci
	call mci_instance%base_init (mci)
	select type (mci)
	type is (mci_midpoint_t)
	mci_instance%mci => mci
	call mci_instance%get_max ()
	mci_instance%selected_channel = 1
	end select
	end subroutine mci_midpoint_instance_init

	@ %def mci_midpoint_instance_init
	@ Copy the stored extrema of the integrand in the instance record.
	<<MCI midpoint: mci midpoint instance: TBP>>=
	procedure :: get_max => mci_midpoint_instance_get_max
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_instance_get_max (instance)
	class(mci_midpoint_instance_t), intent(inout) :: instance
	associate (mci => instance%mci)
	if (mci%max_known) then
	instance%max_known = .true.
	instance%max = mci%max
	instance%min = mci%min
	instance%max_abs = mci%max_abs
	instance%min_abs = mci%min_abs
	end if
	end associate
	end subroutine mci_midpoint_instance_get_max

	@ %def mci_midpoint_instance_get_max
	@ Reverse operations: recall the extrema, but only if they are wider
	than the extrema already stored in the configuration. Also recalculate the
	efficiency value.
	<<MCI midpoint: mci midpoint instance: TBP>>=
	procedure :: set_max => mci_midpoint_instance_set_max
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_instance_set_max (instance)
	class(mci_midpoint_instance_t), intent(inout) :: instance
	associate (mci => instance%mci)
	if (instance%max_known) then
	if (mci%max_known) then
	mci%max = max (mci%max, instance%max)
	mci%min = min (mci%min, instance%min)
	mci%max_abs = max (mci%max_abs, instance%max_abs)
	mci%min_abs = min (mci%min_abs, instance%min_abs)
	else
	mci%max = instance%max
	mci%min = instance%min
	mci%max_abs = instance%max_abs
	mci%min_abs = instance%min_abs
	mci%max_known = .true.
	end if
	if (mci%max_abs /= 0) then
	if (mci%integral == mci%integral_pos) then
	mci%efficiency = mci%integral / mci%max_abs
	mci%efficiency_known = .true.
	else if (mci%n_calls /= 0) then
	mci%efficiency = &
	(mci%n_calls_pos * mci%integral_pos &
	- mci%n_calls_neg * mci%integral_neg) &
	/ mci%n_calls / mci%max_abs
	mci%efficiency_known = .true.
	end if
	end if
	end if
	end associate
	end subroutine mci_midpoint_instance_set_max

	@ %def mci_midpoint_instance_set_max
	@ The weight is the Jacobian of the mapping for the only channel.
	<<MCI midpoint: mci midpoint instance: TBP>>=
	procedure :: compute_weight => mci_midpoint_instance_compute_weight
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_instance_compute_weight (mci, c)
	class(mci_midpoint_instance_t), intent(inout) :: mci
	integer, intent(in) :: c
	select case (c)
	case (1)
	mci%mci_weight = mci%f(1)
	case default
	call msg_fatal ("MCI midpoint integrator: only single channel supported")
	end select
	end subroutine mci_midpoint_instance_compute_weight

	@ %def mci_midpoint_instance_compute_weight
	@ Record the integrand. Update stored values for maximum and minimum.
	<<MCI midpoint: mci midpoint instance: TBP>>=
	procedure :: record_integrand => mci_midpoint_instance_record_integrand
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_instance_record_integrand (mci, integrand)
	class(mci_midpoint_instance_t), intent(inout) :: mci
	real(default), intent(in) :: integrand
	mci%integrand = integrand
	if (mci%max_known) then
	mci%max = max (mci%max, integrand)
	mci%min = min (mci%min, integrand)
	mci%max_abs = max (mci%max_abs, abs (integrand))
	mci%min_abs = min (mci%min_abs, abs (integrand))
	else
	mci%max = integrand
	mci%min = integrand
	mci%max_abs = abs (integrand)
	mci%min_abs = abs (integrand)
	mci%max_known = .true.
	end if
	end subroutine mci_midpoint_instance_record_integrand

	@ %def mci_midpoint_instance_record_integrand
	@ We store the safety factor, otherwise nothing to do here.
	<<MCI midpoint: mci midpoint instance: TBP>>=
	procedure :: init_simulation => mci_midpoint_instance_init_simulation
	procedure :: final_simulation => mci_midpoint_instance_final_simulation
	<<MCI midpoint: procedures>>=
	subroutine mci_midpoint_instance_init_simulation (instance, safety_factor)
	class(mci_midpoint_instance_t), intent(inout) :: instance
	real(default), intent(in), optional :: safety_factor
	if (present (safety_factor)) instance%safety_factor = safety_factor
	end subroutine mci_midpoint_instance_init_simulation

	subroutine mci_midpoint_instance_final_simulation (instance)
	class(mci_midpoint_instance_t), intent(inout) :: instance
	end subroutine mci_midpoint_instance_final_simulation

	@ %def mci_midpoint_instance_init_simulation
	@ %def mci_midpoint_instance_final_simulation
	@ Return excess weight for the current event.
	<<MCI midpoint: mci midpoint instance: TBP>>=
	procedure :: get_event_excess => mci_midpoint_instance_get_event_excess
	<<MCI midpoint: procedures>>=
	function mci_midpoint_instance_get_event_excess (mci) result (excess)
	class(mci_midpoint_instance_t), intent(in) :: mci
	real(default) :: excess
	excess = mci%excess_weight
	end function mci_midpoint_instance_get_event_excess

	@ %def mci_midpoint_instance_get_event_excess
	@
	\subsection{Unit tests}
	<<MCI midpoint: public>>=
	public :: mci_midpoint_test
	<<MCI midpoint: tests>>=
	subroutine mci_midpoint_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<MCI midpoint: execute tests>>
	end subroutine mci_midpoint_test

	@ %def mci_midpoint_test
	@
	\subsubsection{Test sampler}
	A test sampler object should implement a function with known integral that
	we can use to check the integrator.

	This is the function $f(x) = 3 x^2$ with integral $\int_0^1
	f(x)\,dx=1$ and maximum $f(1)=3$. If the integration dimension is
	greater than one, the function is extended as a constant in the other
	dimension(s).

	Mimicking the behavior of a process object, we store the argument
	and result inside the sampler, so we can [[fetch]] results.
	<<MCI midpoint: test types>>=
	type, extends (mci_sampler_t) :: test_sampler_1_t
	real(default), dimension(:), allocatable :: x
	real(default) :: val
	contains
	<<MCI midpoint: test sampler 1: TBP>>
	end type test_sampler_1_t

	@ %def test_sampler_1_t
	@ Output: There is nothing stored inside, so just print an informative line.
	<<MCI midpoint: test sampler 1: TBP>>=
	procedure :: write => test_sampler_1_write
	<<MCI midpoint: procedures>>=
	subroutine test_sampler_1_write (object, unit, testflag)
	class(test_sampler_1_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Test sampler: f(x) = 3 x^2"
	end subroutine test_sampler_1_write

	@ %def test_sampler_1_write
	@ Evaluation: compute the function value. The output $x$ parameter
	(only one channel) is identical to the input $x$, and the Jacobian is 1.
	<<MCI midpoint: test sampler 1: TBP>>=
	procedure :: evaluate => test_sampler_1_evaluate
	<<MCI midpoint: procedures>>=
	subroutine test_sampler_1_evaluate (sampler, c, x_in, val, x, f)
	class(test_sampler_1_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
	if (allocated (sampler%x)) deallocate (sampler%x)
	allocate (sampler%x (size (x_in)))
	sampler%x = x_in
	sampler%val = 3 * x_in(1) ** 2
	call sampler%fetch (val, x, f)
	end subroutine test_sampler_1_evaluate

	@ %def test_sampler_1_evaluate
	@ The point is always valid.
	<<MCI midpoint: test sampler 1: TBP>>=
	procedure :: is_valid => test_sampler_1_is_valid
	<<MCI midpoint: tests>>=
	function test_sampler_1_is_valid (sampler) result (valid)
	class(test_sampler_1_t), intent(in) :: sampler
	logical :: valid
	valid = .true.
	end function test_sampler_1_is_valid

	@ %def test_sampler_1_is_valid
	@ Rebuild: compute all but the function value.
	<<MCI midpoint: test sampler 1: TBP>>=
	procedure :: rebuild => test_sampler_1_rebuild
	<<MCI midpoint: procedures>>=
	subroutine test_sampler_1_rebuild (sampler, c, x_in, val, x, f)
	class(test_sampler_1_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
	if (allocated (sampler%x)) deallocate (sampler%x)
	allocate (sampler%x (size (x_in)))
	sampler%x = x_in
	sampler%val = val
	x(:,1) = sampler%x
	f = 1
	end subroutine test_sampler_1_rebuild

	@ %def test_sampler_1_rebuild
	@ Extract the results.
	<<MCI midpoint: test sampler 1: TBP>>=
	procedure :: fetch => test_sampler_1_fetch
	<<MCI midpoint: procedures>>=
	subroutine test_sampler_1_fetch (sampler, val, x, f)
	class(test_sampler_1_t), intent(in) :: sampler
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	val = sampler%val
	x(:,1) = sampler%x
	f = 1
	end subroutine test_sampler_1_fetch

	@ %def test_sampler_1_fetch
	@
	This is the function $f(x) = 3 x^2 + 2 y$ with integral $\int_0^1
	f(x,y)\,dx\,dy=2$ and maximum $f(1)=5$.
	<<MCI midpoint: test types>>=
	type, extends (mci_sampler_t) :: test_sampler_2_t
	real(default) :: val
	real(default), dimension(2) :: x
	contains
	<<MCI midpoint: test sampler 2: TBP>>
	end type test_sampler_2_t

	@ %def test_sampler_2_t
	@ Output: There is nothing stored inside, so just print an informative line.
	<<MCI midpoint: test sampler 2: TBP>>=
	procedure :: write => test_sampler_2_write
	<<MCI midpoint: procedures>>=
	subroutine test_sampler_2_write (object, unit, testflag)
	class(test_sampler_2_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Test sampler: f(x) = 3 x^2 + 2 y"
	end subroutine test_sampler_2_write

	@ %def test_sampler_2_write
	@ Evaluate: compute the function value. The output $x$ parameter
	(only one channel) is identical to the input $x$, and the Jacobian is 1.
	<<MCI midpoint: test sampler 2: TBP>>=
	procedure :: evaluate => test_sampler_2_evaluate
	<<MCI midpoint: procedures>>=
	subroutine test_sampler_2_evaluate (sampler, c, x_in, val, x, f)
	class(test_sampler_2_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
	sampler%x = x_in
	sampler%val = 3 * x_in(1) ** 2 + 2 * x_in(2)
	call sampler%fetch (val, x, f)
	end subroutine test_sampler_2_evaluate

	@ %def test_sampler_2_evaluate
	@ The point is always valid.
	<<MCI midpoint: test sampler 2: TBP>>=
	procedure :: is_valid => test_sampler_2_is_valid
	<<MCI midpoint: tests>>=
	function test_sampler_2_is_valid (sampler) result (valid)
	class(test_sampler_2_t), intent(in) :: sampler
	logical :: valid
	valid = .true.
	end function test_sampler_2_is_valid

	@ %def test_sampler_2_is_valid
	@ Rebuild: compute all but the function value.
	<<MCI midpoint: test sampler 2: TBP>>=
	procedure :: rebuild => test_sampler_2_rebuild
	<<MCI midpoint: procedures>>=
	subroutine test_sampler_2_rebuild (sampler, c, x_in, val, x, f)
	class(test_sampler_2_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
	sampler%x = x_in
	sampler%val = val
	x(:,1) = sampler%x
	f = 1
	end subroutine test_sampler_2_rebuild

	@ %def test_sampler_2_rebuild
	<<MCI midpoint: test sampler 2: TBP>>=
	procedure :: fetch => test_sampler_2_fetch
	<<MCI midpoint: procedures>>=
	subroutine test_sampler_2_fetch (sampler, val, x, f)
	class(test_sampler_2_t), intent(in) :: sampler
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	val = sampler%val
	x(:,1) = sampler%x
	f = 1
	end subroutine test_sampler_2_fetch

	@ %def test_sampler_2_fetch
	@
	This is the function $f(x) = (1 - 3 x^2)\,\theta(x-1/2)$ with integral
	$\int_0^1 f(x)\,dx=-3/8$, minimum $f(1)=-2$ and maximum $f(1/2)=1/4$.
	If the integration dimension is greater than one, the function is
	extended as a constant in the other dimension(s).
	<<MCI midpoint: test types>>=
	type, extends (mci_sampler_t) :: test_sampler_4_t
	real(default) :: val
	real(default), dimension(:), allocatable :: x
	contains
	<<MCI midpoint: test sampler 4: TBP>>
	end type test_sampler_4_t

	@ %def test_sampler_4_t
	@ Output: There is nothing stored inside, so just print an informative line.
	<<MCI midpoint: test sampler 4: TBP>>=
	procedure :: write => test_sampler_4_write
	<<MCI midpoint: procedures>>=
	subroutine test_sampler_4_write (object, unit, testflag)
	class(test_sampler_4_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Test sampler: f(x) = 1 - 3 x^2"
	end subroutine test_sampler_4_write

	@ %def test_sampler_4_write
	@ Evaluation: compute the function value. The output $x$ parameter
	(only one channel) is identical to the input $x$, and the Jacobian is 1.
	<<MCI midpoint: test sampler 4: TBP>>=
	procedure :: evaluate => test_sampler_4_evaluate
	<<MCI midpoint: procedures>>=
	subroutine test_sampler_4_evaluate (sampler, c, x_in, val, x, f)
	class(test_sampler_4_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
	if (x_in(1) >= .5_default) then
	sampler%val = 1 - 3 * x_in(1) ** 2
	else
	sampler%val = 0
	end if
	if (.not. allocated (sampler%x)) allocate (sampler%x (size (x_in)))
	sampler%x = x_in
	call sampler%fetch (val, x, f)
	end subroutine test_sampler_4_evaluate

	@ %def test_sampler_4_evaluate
	@ The point is always valid.
	<<MCI midpoint: test sampler 4: TBP>>=
	procedure :: is_valid => test_sampler_4_is_valid
	<<MCI midpoint: tests>>=
	function test_sampler_4_is_valid (sampler) result (valid)
	class(test_sampler_4_t), intent(in) :: sampler
	logical :: valid
	valid = .true.
	end function test_sampler_4_is_valid

	@ %def test_sampler_4_is_valid
	@ Rebuild: compute all but the function value.
	<<MCI midpoint: test sampler 4: TBP>>=
	procedure :: rebuild => test_sampler_4_rebuild
	<<MCI midpoint: procedures>>=
	subroutine test_sampler_4_rebuild (sampler, c, x_in, val, x, f)
	class(test_sampler_4_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
	sampler%x = x_in
	sampler%val = val
	x(:,1) = sampler%x
	f = 1
	end subroutine test_sampler_4_rebuild

	@ %def test_sampler_4_rebuild
	<<MCI midpoint: test sampler 4: TBP>>=
	procedure :: fetch => test_sampler_4_fetch
	<<MCI midpoint: procedures>>=
	subroutine test_sampler_4_fetch (sampler, val, x, f)
	class(test_sampler_4_t), intent(in) :: sampler
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	val = sampler%val
	x(:,1) = sampler%x
	f = 1
	end subroutine test_sampler_4_fetch

	@ %def test_sampler_4_fetch
	@
	\subsubsection{One-dimensional integration}
	Construct an integrator and use it for a one-dimensional sampler.
	<<MCI midpoint: execute tests>>=
	call test (mci_midpoint_1, "mci_midpoint_1", &
	"one-dimensional integral", &
	u, results)
	<<MCI midpoint: tests>>=
	subroutine mci_midpoint_1 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler

	write (u, "(A)") "* Test output: mci_midpoint_1"
	write (u, "(A)") "* Purpose: integrate function in one dimension"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_midpoint_t :: mci)
	call mci%set_dimensions (1, 1)

	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize instance"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Initialize test sampler"
	write (u, "(A)")

	allocate (test_sampler_1_t :: sampler)
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for x = 0.8"
	write (u, "(A)")

	call mci_instance%evaluate (sampler, 1, [0.8_default])
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for x = 0.7"
	write (u, "(A)")

	call mci_instance%evaluate (sampler, 1, [0.7_default])
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for x = 0.9"
	write (u, "(A)")

	call mci_instance%evaluate (sampler, 1, [0.9_default])
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_calls = 1000"
	write (u, "(A)")

	call mci%integrate (mci_instance, sampler, 1, 1000)
	call mci%write (u)

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_midpoint_1

	@ %def mci_midpoint_1
	@
	\subsubsection{Two-dimensional integration}
	Construct an integrator and use it for a two-dimensional sampler.
	<<MCI midpoint: execute tests>>=
	call test (mci_midpoint_2, "mci_midpoint_2", &
	"two-dimensional integral", &
	u, results)
	<<MCI midpoint: tests>>=
	subroutine mci_midpoint_2 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler

	write (u, "(A)") "* Test output: mci_midpoint_2"
	write (u, "(A)") "* Purpose: integrate function in two dimensions"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_midpoint_t :: mci)
	call mci%set_dimensions (2, 1)

	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize instance"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Initialize test sampler"
	write (u, "(A)")

	allocate (test_sampler_2_t :: sampler)
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for x = 0.8, y = 0.2"
	write (u, "(A)")

	call mci_instance%evaluate (sampler, 1, [0.8_default, 0.2_default])
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_calls = 1000"
	write (u, "(A)")

	call mci%integrate (mci_instance, sampler, 1, 1000)
	call mci%write (u)

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_midpoint_2

	@ %def mci_midpoint_2
	@
	\subsubsection{Two-dimensional integration with flat dimension}
	Construct an integrator and use it for a two-dimensional sampler,
	where the function is constant in the second dimension.
	<<MCI midpoint: execute tests>>=
	call test (mci_midpoint_3, "mci_midpoint_3", &
	"two-dimensional integral with flat dimension", &
	u, results)
	<<MCI midpoint: tests>>=
	subroutine mci_midpoint_3 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler

	write (u, "(A)") "* Test output: mci_midpoint_3"
	write (u, "(A)") "* Purpose: integrate function with one flat dimension"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_midpoint_t :: mci)
	select type (mci)
	type is (mci_midpoint_t)
	call mci%set_dimensions (2, 1)
	call mci%declare_flat_dimensions ([2])
	end select

	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize instance"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Initialize test sampler"
	write (u, "(A)")

	allocate (test_sampler_1_t :: sampler)
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for x = 0.8, y = 0.2"
	write (u, "(A)")

	call mci_instance%evaluate (sampler, 1, [0.8_default, 0.2_default])
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_calls = 1000"
	write (u, "(A)")

	call mci%integrate (mci_instance, sampler, 1, 1000)
	call mci%write (u)

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_midpoint_3

	@ %def mci_midpoint_3
	@
	\subsubsection{Integrand with sign flip}
	Construct an integrator and use it for a one-dimensional sampler.
	<<MCI midpoint: execute tests>>=
	call test (mci_midpoint_4, "mci_midpoint_4", &
	"integrand with sign flip", &
	u, results)
	<<MCI midpoint: tests>>=
	subroutine mci_midpoint_4 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler

	write (u, "(A)") "* Test output: mci_midpoint_4"
	write (u, "(A)") "* Purpose: integrate function with sign flip &
	&in one dimension"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_midpoint_t :: mci)
	call mci%set_dimensions (1, 1)

	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize instance"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Initialize test sampler"
	write (u, "(A)")

	allocate (test_sampler_4_t :: sampler)
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for x = 0.8"
	write (u, "(A)")

	call mci_instance%evaluate (sampler, 1, [0.8_default])
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_calls = 1000"
	write (u, "(A)")

	call mci%integrate (mci_instance, sampler, 1, 1000)
	call mci%write (u)

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_midpoint_4

	@ %def mci_midpoint_4
	@
	\subsubsection{Weighted events}
	Generate weighted events. Without rejection, we do not need to know maxima
	and minima, so we can start generating events immediately. We have two
	dimensions.
	<<MCI midpoint: execute tests>>=
	call test (mci_midpoint_5, "mci_midpoint_5", &
	"weighted events", &
	u, results)
	<<MCI midpoint: tests>>=
	subroutine mci_midpoint_5 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng
	class(mci_state_t), allocatable :: state

	write (u, "(A)") "* Test output: mci_midpoint_5"
	write (u, "(A)") "* Purpose: generate weighted events"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_midpoint_t :: mci)
	call mci%set_dimensions (2, 1)

	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize instance"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Initialize test sampler"
	write (u, "(A)")

	allocate (test_sampler_2_t :: sampler)

	write (u, "(A)") "* Initialize random-number generator"
	write (u, "(A)")

	allocate (rng_test_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	write (u, "(A)") "* Generate weighted event"
	write (u, "(A)")

	call mci%generate_weighted_event (mci_instance, sampler)
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate weighted event"
	write (u, "(A)")

	call mci%generate_weighted_event (mci_instance, sampler)
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Store data"
	write (u, "(A)")

	allocate (state)
	call mci_instance%store (state)
	call mci_instance%final ()
	deallocate (mci_instance)

	call state%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recall data and rebuild event"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)
	call mci%rebuild_event (mci_instance, sampler, state)

	call mci_instance%write (u)

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

	call mci_instance%final ()
	deallocate (mci_instance)
	call mci%final ()

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

	end subroutine mci_midpoint_5

	@ %def mci_midpoint_5
	@
	\subsubsection{Unweighted events}
	Generate unweighted events. The integrand has a sign flip in it.
	<<MCI midpoint: execute tests>>=
	call test (mci_midpoint_6, "mci_midpoint_6", &
	"unweighted events", &
	u, results)
	<<MCI midpoint: tests>>=
	subroutine mci_midpoint_6 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_midpoint_6"
	write (u, "(A)") "* Purpose: generate unweighted events"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_midpoint_t :: mci)
	call mci%set_dimensions (1, 1)

	write (u, "(A)") "* Initialize instance"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Initialize test sampler"
	write (u, "(A)")

	allocate (test_sampler_4_t :: sampler)

	write (u, "(A)") "* Initialize random-number generator"
	write (u, "(A)")

	allocate (rng_test_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	write (u, "(A)") "* Integrate (determine maximum of integrand"
	write (u, "(A)")
	call mci%integrate (mci_instance, sampler, 1, 1000)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate unweighted event"
	write (u, "(A)")

	call mci%generate_unweighted_event (mci_instance, sampler)
	call mci_instance%write (u)

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

	call mci_instance%final ()
	deallocate (mci_instance)
	call mci%final ()

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

	end subroutine mci_midpoint_6

	@ %def mci_midpoint_6
	@
	\subsubsection{Excess weight}
	Generate unweighted events. With only 2 points for integration, the
	maximum of the integrand is too low, and we produce excess weight.
	<<MCI midpoint: execute tests>>=
	call test (mci_midpoint_7, "mci_midpoint_7", &
	"excess weight", &
	u, results)
	<<MCI midpoint: tests>>=
	subroutine mci_midpoint_7 (u)
	integer, intent(in) :: u
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_midpoint_7"
	write (u, "(A)") "* Purpose: generate unweighted event &
	&with excess weight"
	write (u, "(A)")

	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_midpoint_t :: mci)
	call mci%set_dimensions (1, 1)

	write (u, "(A)") "* Initialize instance"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Initialize test sampler"
	write (u, "(A)")

	allocate (test_sampler_4_t :: sampler)

	write (u, "(A)") "* Initialize random-number generator"
	write (u, "(A)")

	allocate (rng_test_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	write (u, "(A)") "* Integrate (determine maximum of integrand"
	write (u, "(A)")
	call mci%integrate (mci_instance, sampler, 1, 2)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate unweighted event"
	write (u, "(A)")

	call mci_instance%init_simulation ()
	call mci%generate_unweighted_event (mci_instance, sampler)
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Use getter methods"
	write (u, "(A)")

	write (u, "(1x,A,1x,ES19.12)") "weight =", mci_instance%get_event_weight ()
	write (u, "(1x,A,1x,ES19.12)") "excess =", mci_instance%get_event_excess ()

	write (u, "(A)")
	write (u, "(A)") "* Apply safety factor"
	write (u, "(A)")

	call mci_instance%init_simulation (safety_factor = 2.1_default)

	write (u, "(A)") "* Generate unweighted event"
	write (u, "(A)")

	call mci%generate_unweighted_event (mci_instance, sampler)
	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Use getter methods"
	write (u, "(A)")

	write (u, "(1x,A,1x,ES19.12)") "weight =", mci_instance%get_event_weight ()
	write (u, "(1x,A,1x,ES19.12)") "excess =", mci_instance%get_event_excess ()

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

	call mci_instance%final ()
	deallocate (mci_instance)
	call mci%final ()

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

	end subroutine mci_midpoint_7

	@ %def mci_midpoint_7
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{\vamp\ interface}
	The standard method for integration is \vamp: the multi-channel
	version of the VEGAS algorithm. Each parameterization (channel) of
	the hypercube is binned in each dimension. The binning is equally
	equidistant, but an iteration of the integration procedure,
	the binning is updated for each dimension, according to the variance
	distribution of the integrand, summed over all other dimension. In
	the next iteration, the binning approximates (hopefully) follows the
	integrand more closely, and the accuracy of the result is increased.
	Furthermore, the relative weight of the individual channels is also updated
	after an iteration.

	The bin distribution is denoted as the grid for a channel, which we
	can write to file and reuse later.

	In our implementation we specify the generic \vamp\ algorithm more
	tightly: the number of bins is equal for all dimensions, the initial
	weights are all equal. The user controls whether to update bins
	and/or weights after each iteration. The integration is organized in
	passes, each one consisting of several iterations with a common number
	of calls to the integrand. The first passes are intended as warmup,
	so the results are displayed but otherwise discarded. In the final
	pass, the integration estimates for the individual iterations are
	averaged for the final result.
	<<[[mci_vamp.f90]]>>=
	<<File header>>

	module mci_vamp

	use kinds
	<<Use strings>>
	use io_units
	use constants
	use format_utils, only: pac_fmt
	use format_defs, only: FMT_12, FMT_14, FMT_17, FMT_19
	use unit_tests
	use diagnostics
	use md5

	use phs_base
	use rng_base
	use rng_tao
	use mci_base

	use vamp !NODEP!
	use exceptions !NODEP!

	<<Standard module head>>

	<<MCI vamp: public>>

	<<MCI vamp: types>>

	<<MCI vamp: interfaces>>

	<<MCI vamp: test types>>

	contains

	<<MCI vamp: procedures>>

	<<MCI vamp: tests>>

	end module mci_vamp
	@ %def mci_vamp
	@
	\subsection{Grid parameters}
	This is a transparent container. It holds the parameters that are
	stored in grid files, and are checked when grid files are read.
	<<MCI vamp: public>>=
	public :: grid_parameters_t
	<<MCI vamp: types>>=
	type :: grid_parameters_t
	integer :: threshold_calls = 0
	integer :: min_calls_per_channel = 10
	integer :: min_calls_per_bin = 10
	integer :: min_bins = 3
	integer :: max_bins = 20
	logical :: stratified = .true.
	logical :: use_vamp_equivalences = .true.
	real(default) :: channel_weights_power = 0.25_default
	real(default) :: accuracy_goal = 0
	real(default) :: error_goal = 0
	real(default) :: rel_error_goal = 0
	contains
	<<MCI vamp: grid parameters: TBP>>
	end type grid_parameters_t

	@ %def grid_parameters_t
	@ I/O:
	<<MCI vamp: grid parameters: TBP>>=
	procedure :: write => grid_parameters_write
	<<MCI vamp: procedures>>=
	subroutine grid_parameters_write (object, unit)
	class(grid_parameters_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A,I0)") "threshold_calls = ", &
	object%threshold_calls
	write (u, "(3x,A,I0)") "min_calls_per_channel = ", &
	object%min_calls_per_channel
	write (u, "(3x,A,I0)") "min_calls_per_bin = ", &
	object%min_calls_per_bin
	write (u, "(3x,A,I0)") "min_bins = ", &
	object%min_bins
	write (u, "(3x,A,I0)") "max_bins = ", &
	object%max_bins
	write (u, "(3x,A,L1)") "stratified = ", &
	object%stratified
	write (u, "(3x,A,L1)") "use_vamp_equivalences = ", &
	object%use_vamp_equivalences
	write (u, "(3x,A,F10.7)") "channel_weights_power = ", &
	object%channel_weights_power
	if (object%accuracy_goal > 0) then
	write (u, "(3x,A,F10.7)") "accuracy_goal = ", &
	object%accuracy_goal
	end if
	if (object%error_goal > 0) then
	write (u, "(3x,A,F10.7)") "error_goal = ", &
	object%error_goal
	end if
	if (object%rel_error_goal > 0) then
	write (u, "(3x,A,F10.7)") "rel_error_goal = ", &
	object%rel_error_goal
	end if
	end subroutine grid_parameters_write

	@ %def grid_parameters_write
	@
	\subsection{History parameters}
	The history parameters are also stored in a transparent container.
	This is not a part of the grid definition, and should not be included
	in the MD5 sum.
	<<MCI vamp: public>>=
	public :: history_parameters_t
	<<MCI vamp: types>>=
	type :: history_parameters_t
	logical :: global = .true.
	logical :: global_verbose = .false.
	logical :: channel = .false.
	logical :: channel_verbose = .false.
	contains
	<<MCI vamp: history parameters: TBP>>
	end type history_parameters_t

	@ %def history_parameters_t
	@ I/O:
	<<MCI vamp: history parameters: TBP>>=
	procedure :: write => history_parameters_write
	<<MCI vamp: procedures>>=
	subroutine history_parameters_write (object, unit)
	class(history_parameters_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A,L1)") "history(global) = ", object%global
	write (u, "(3x,A,L1)") "history(global) verb. = ", object%global_verbose
	write (u, "(3x,A,L1)") "history(channels) = ", object%channel
	write (u, "(3x,A,L1)") "history(chann.) verb. = ", object%channel_verbose
	end subroutine history_parameters_write

	@ %def history_parameters_write
	@
	\subsection{Integration pass}
	We store the parameters for each integration pass in a linked list.
	<<MCI vamp: types>>=
	type :: pass_t
	integer :: i_pass = 0
	integer :: i_first_it = 0
	integer :: n_it = 0
	integer :: n_calls = 0
	integer :: n_bins = 0
	logical :: adapt_grids = .false.
	logical :: adapt_weights = .false.
	logical :: is_final_pass = .false.
	logical :: integral_defined = .false.
	integer, dimension(:), allocatable :: calls
	real(default), dimension(:), allocatable :: integral
	real(default), dimension(:), allocatable :: error
	real(default), dimension(:), allocatable :: efficiency
	type(vamp_history), dimension(:), allocatable :: v_history
	type(vamp_history), dimension(:,:), allocatable :: v_histories
	type(pass_t), pointer :: next => null ()
	contains
	<<MCI vamp: pass: TBP>>
	end type pass_t

	@ %def pass_t
	@ Finalizer. The VAMP histories contain a pointer array.
	<<MCI vamp: pass: TBP>>=
	procedure :: final => pass_final
	<<MCI vamp: procedures>>=
	subroutine pass_final (object)
	class(pass_t), intent(inout) :: object
	if (allocated (object%v_history)) then
	call vamp_delete_history (object%v_history)
	end if
	if (allocated (object%v_histories)) then
	call vamp_delete_history (object%v_histories)
	end if
	end subroutine pass_final

	@ %def pass_final
	@ Output. Note that the precision of the numerical values should match the
	precision for comparing output from file with data.
	<<MCI vamp: pass: TBP>>=
	procedure :: write => pass_write
	<<MCI vamp: procedures>>=
	subroutine pass_write (object, unit, pacify)
	class(pass_t), intent(in) :: object
	integer, intent(in) :: unit
	logical, intent(in), optional :: pacify
	integer :: u, i
	character(len=7) :: fmt
	call pac_fmt (fmt, FMT_17, FMT_14, pacify)
	u = given_output_unit (unit)
	write (u, "(3x,A,I0)") "n_it = ", object%n_it
	write (u, "(3x,A,I0)") "n_calls = ", object%n_calls
	write (u, "(3x,A,I0)") "n_bins = ", object%n_bins
	write (u, "(3x,A,L1)") "adapt grids = ", object%adapt_grids
	write (u, "(3x,A,L1)") "adapt weights = ", object%adapt_weights
	if (object%integral_defined) then
	write (u, "(3x,A)") "Results: [it, calls, integral, error, efficiency]"
	do i = 1, object%n_it
	write (u, "(5x,I0,1x,I0,3(1x," // fmt // "))") &
	i, object%calls(i), object%integral(i), object%error(i), &
	object%efficiency(i)
	end do
	else
	write (u, "(3x,A)") "Results: [undefined]"
	end if
	end subroutine pass_write

	@ %def pass_write
	@ Read and reconstruct the pass.
	<<MCI vamp: pass: TBP>>=
	procedure :: read => pass_read
	<<MCI vamp: procedures>>=
	subroutine pass_read (object, u, n_pass, n_it)
	class(pass_t), intent(out) :: object
	integer, intent(in) :: u, n_pass, n_it
	integer :: i, j
	character(80) :: buffer
	object%i_pass = n_pass + 1
	object%i_first_it = n_it + 1
	call read_ival (u, object%n_it)
	call read_ival (u, object%n_calls)
	call read_ival (u, object%n_bins)
	call read_lval (u, object%adapt_grids)
	call read_lval (u, object%adapt_weights)
	allocate (object%calls (object%n_it), source = 0)
	allocate (object%integral (object%n_it), source = 0._default)
	allocate (object%error (object%n_it), source = 0._default)
	allocate (object%efficiency (object%n_it), source = 0._default)
	read (u, "(A)") buffer
	select case (trim (adjustl (buffer)))
	case ("Results: [it, calls, integral, error, efficiency]")
	do i = 1, object%n_it
	read (u, *) &
	j, object%calls(i), object%integral(i), object%error(i), &
	object%efficiency(i)
	end do
	object%integral_defined = .true.
	case ("Results: [undefined]")
	object%integral_defined = .false.
	case default
	call msg_fatal ("Reading integration pass: corrupted file")
	end select
	end subroutine pass_read

	@ %def pass_read
	@ Write the VAMP history for this pass. (The subroutine writes the
	whole array at once.)
	<<MCI vamp: pass: TBP>>=
	procedure :: write_history => pass_write_history
	<<MCI vamp: procedures>>=
	subroutine pass_write_history (pass, unit)
	class(pass_t), intent(in) :: pass
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	if (allocated (pass%v_history)) then
	call vamp_write_history (u, pass%v_history)
	else
	write (u, "(1x,A)") "Global history: [undefined]"
	end if
	if (allocated (pass%v_histories)) then
	write (u, "(1x,A)") "Channel histories:"
	call vamp_write_history (u, pass%v_histories)
	else
	write (u, "(1x,A)") "Channel histories: [undefined]"
	end if
	end subroutine pass_write_history

	@ %def pass_write_history
	@ Given a number of calls and iterations, compute remaining data.
	<<MCI vamp: pass: TBP>>=
	procedure :: configure => pass_configure
	<<MCI vamp: procedures>>=
	subroutine pass_configure (pass, n_it, n_calls, min_calls, &
	min_bins, max_bins, min_channel_calls)
	class(pass_t), intent(inout) :: pass
	integer, intent(in) :: n_it, n_calls, min_channel_calls
	integer, intent(in) :: min_calls, min_bins, max_bins
	pass%n_it = n_it
	if (min_calls /= 0) then
	pass%n_bins = max (min_bins, &
	min (n_calls / min_calls, max_bins))
	else
	pass%n_bins = max_bins
	end if
	pass%n_calls = max (n_calls, max (min_calls, min_channel_calls))
	if (pass%n_calls /= n_calls) then
	write (msg_buffer, "(A,I0)") "VAMP: too few calls, resetting " &
	// "n_calls to ", pass%n_calls
	call msg_warning ()
	end if
	allocate (pass%calls (n_it), source = 0)
	allocate (pass%integral (n_it), source = 0._default)
	allocate (pass%error (n_it), source = 0._default)
	allocate (pass%efficiency (n_it), source = 0._default)
	end subroutine pass_configure

	@ %def pass_configure
	@ Allocate the VAMP history and give options. We assume that the
	[[configure]] routine above has been executed, so the number of
	iterations is known.
	<<MCI vamp: pass: TBP>>=
	procedure :: configure_history => pass_configure_history
	<<MCI vamp: procedures>>=
	subroutine pass_configure_history (pass, n_channels, par)
	class(pass_t), intent(inout) :: pass
	integer, intent(in) :: n_channels
	type(history_parameters_t), intent(in) :: par
	if (par%global) then
	allocate (pass%v_history (pass%n_it))
	call vamp_create_history (pass%v_history, &
	verbose = par%global_verbose)
	end if
	if (par%channel) then
	allocate (pass%v_histories (pass%n_it, n_channels))
	call vamp_create_history (pass%v_histories, &
	verbose = par%channel_verbose)
	end if
	end subroutine pass_configure_history

	@ %def pass_configure_history
	@ Given two pass objects, compare them. All parameters must match. Where
	integrations are done in both (number of calls nonzero), the results must be
	equal (up to numerical noise).

	The allocated array sizes might be different, but should match up to the
	common [[n_it]] value.
	<<MCI vamp: interfaces>>=
	interface operator (.matches.)
	module procedure pass_matches
	end interface operator (.matches.)
	<<MCI vamp: procedures>>=
	function pass_matches (pass, ref) result (ok)
	type(pass_t), intent(in) :: pass, ref
	integer :: n
	logical :: ok
	ok = .true.
	if (ok) ok = pass%i_pass == ref%i_pass
	if (ok) ok = pass%i_first_it == ref%i_first_it
	if (ok) ok = pass%n_it == ref%n_it
	if (ok) ok = pass%n_calls == ref%n_calls
	if (ok) ok = pass%n_bins == ref%n_bins
	if (ok) ok = pass%adapt_grids .eqv. ref%adapt_grids
	if (ok) ok = pass%adapt_weights .eqv. ref%adapt_weights
	if (ok) ok = pass%integral_defined .eqv. ref%integral_defined
	if (pass%integral_defined) then
	n = pass%n_it
	if (ok) ok = all (pass%calls(:n) == ref%calls(:n))
	if (ok) ok = all (pass%integral(:n) .matches. ref%integral(:n))
	if (ok) ok = all (pass%error(:n) .matches. ref%error(:n))
	if (ok) ok = all (pass%efficiency(:n) .matches. ref%efficiency(:n))
	end if
	end function pass_matches

	@ %def pass_matches
	@ Update a pass object, given a reference. The parameters must match, except
	for the [[n_it]] entry. The number of complete iterations must be less or
	equal to the reference, and the number of complete iterations in the reference
	must be no larger than [[n_it]]. Where results are present in both passes,
	they must match. Where results are present in the reference only, the pass is
	updated accordingly.
	<<MCI vamp: pass: TBP>>=
	procedure :: update => pass_update
	<<MCI vamp: procedures>>=
	subroutine pass_update (pass, ref, ok)
	class(pass_t), intent(inout) :: pass
	type(pass_t), intent(in) :: ref
	logical, intent(out) :: ok
	integer :: n, n_ref
	ok = .true.
	if (ok) ok = pass%i_pass == ref%i_pass
	if (ok) ok = pass%i_first_it == ref%i_first_it
	if (ok) ok = pass%n_calls == ref%n_calls
	if (ok) ok = pass%n_bins == ref%n_bins
	if (ok) ok = pass%adapt_grids .eqv. ref%adapt_grids
	if (ok) ok = pass%adapt_weights .eqv. ref%adapt_weights
	if (ok) then
	if (ref%integral_defined) then
	if (.not. allocated (pass%calls)) then
	allocate (pass%calls (pass%n_it), source = 0)
	allocate (pass%integral (pass%n_it), source = 0._default)
	allocate (pass%error (pass%n_it), source = 0._default)
	allocate (pass%efficiency (pass%n_it), source = 0._default)
	end if
	n = count (pass%calls /= 0)
	n_ref = count (ref%calls /= 0)
	ok = n <= n_ref .and. n_ref <= pass%n_it
	if (ok) ok = all (pass%calls(:n) == ref%calls(:n))
	if (ok) ok = all (pass%integral(:n) .matches. ref%integral(:n))
	if (ok) ok = all (pass%error(:n) .matches. ref%error(:n))
	if (ok) ok = all (pass%efficiency(:n) .matches. ref%efficiency(:n))
	if (ok) then
	pass%calls(n+1:n_ref) = ref%calls(n+1:n_ref)
	pass%integral(n+1:n_ref) = ref%integral(n+1:n_ref)
	pass%error(n+1:n_ref) = ref%error(n+1:n_ref)
	pass%efficiency(n+1:n_ref) = ref%efficiency(n+1:n_ref)
	pass%integral_defined = any (pass%calls /= 0)
	end if
	end if
	end if
	end subroutine pass_update

	@ %def pass_update
	@ Match two real numbers: they are equal up to a tolerance, which is
	$10^{-8}$, matching the number of digits that are output by [[pass_write]].
	In particular, if one number is exactly zero, the other one must also be zero.
	<<MCI vamp: interfaces>>=
	interface operator (.matches.)
	module procedure real_matches
	end interface operator (.matches.)
	<<MCI vamp: procedures>>=
	elemental function real_matches (x, y) result (ok)
	real(default), intent(in) :: x, y
	logical :: ok
	real(default), parameter :: tolerance = 1.e-8_default
	ok = abs (x - y) <= tolerance * max (abs (x), abs (y))
	end function real_matches

	@ %def real_matches
	@ Return the index of the most recent complete integration. If there is none,
	return zero.
	<<MCI vamp: pass: TBP>>=
	procedure :: get_integration_index => pass_get_integration_index
	<<MCI vamp: procedures>>=
	function pass_get_integration_index (pass) result (n)
	class (pass_t), intent(in) :: pass
	integer :: n
	integer :: i
	n = 0
	if (allocated (pass%calls)) then
	do i = 1, pass%n_it
	if (pass%calls(i) == 0) exit
	n = i
	end do
	end if
	end function pass_get_integration_index

	@ %def pass_get_integration_index
	@ Return the most recent integral and error, if available.
	<<MCI vamp: pass: TBP>>=
	procedure :: get_calls => pass_get_calls
	procedure :: get_integral => pass_get_integral
	procedure :: get_error => pass_get_error
	procedure :: get_efficiency => pass_get_efficiency
	<<MCI vamp: procedures>>=
	function pass_get_calls (pass) result (calls)
	class(pass_t), intent(in) :: pass
	integer :: calls
	integer :: n
	n = pass%get_integration_index ()
	if (n /= 0) then
	calls = pass%calls(n)
	else
	calls = 0
	end if
	end function pass_get_calls

	function pass_get_integral (pass) result (integral)
	class(pass_t), intent(in) :: pass
	real(default) :: integral
	integer :: n
	n = pass%get_integration_index ()
	if (n /= 0) then
	integral = pass%integral(n)
	else
	integral = 0
	end if
	end function pass_get_integral

	function pass_get_error (pass) result (error)
	class(pass_t), intent(in) :: pass
	real(default) :: error
	integer :: n
	n = pass%get_integration_index ()
	if (n /= 0) then
	error = pass%error(n)
	else
	error = 0
	end if
	end function pass_get_error

	function pass_get_efficiency (pass) result (efficiency)
	class(pass_t), intent(in) :: pass
	real(default) :: efficiency
	integer :: n
	n = pass%get_integration_index ()
	if (n /= 0) then
	efficiency = pass%efficiency(n)
	else
	efficiency = 0
	end if
	end function pass_get_efficiency

	@ %def pass_get_integral
	@ %def pass_get_error
	@ %def pass_get_efficiency
	@
	\subsection{Integrator}
	<<MCI vamp: public>>=
	public :: mci_vamp_t
	<<MCI vamp: types>>=
	type, extends (mci_t) :: mci_vamp_t
	logical, dimension(:), allocatable :: dim_is_flat
	type(grid_parameters_t) :: grid_par
	type(history_parameters_t) :: history_par
	integer :: min_calls = 0
	type(pass_t), pointer :: first_pass => null ()
	type(pass_t), pointer :: current_pass => null ()
	type(vamp_equivalences_t) :: equivalences
	logical :: rebuild = .true.
	logical :: check_grid_file = .true.
	logical :: grid_filename_set = .false.
	logical :: negative_weights = .false.
	logical :: verbose = .false.
	type(string_t) :: grid_filename
	character(32) :: md5sum_adapted = ""
	contains
	<<MCI vamp: mci vamp: TBP>>
	end type mci_vamp_t

	@ %def mci_vamp_t
	@ Reset: delete integration-pass entries.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: reset => mci_vamp_reset
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_reset (object)
	class(mci_vamp_t), intent(inout) :: object
	type(pass_t), pointer :: current_pass
	do while (associated (object%first_pass))
	current_pass => object%first_pass
	object%first_pass => current_pass%next
	call current_pass%final ()
	deallocate (current_pass)
	end do
	object%current_pass => null ()
	end subroutine mci_vamp_reset

	@ %def mci_vamp_reset
	@ Finalizer: reset and finalize the equivalences list.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: final => mci_vamp_final
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_final (object)
	class(mci_vamp_t), intent(inout) :: object
	call object%reset ()
	call vamp_equivalences_final (object%equivalences)
	call object%base_final ()
	end subroutine mci_vamp_final

	@ %def mci_vamp_final
	@ Output. Do not output the grids themselves, this may result in tons
	of data.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: write => mci_vamp_write
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_write (object, unit, pacify, md5sum_version)
	class(mci_vamp_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacify
	logical, intent(in), optional :: md5sum_version
	type(pass_t), pointer :: current_pass
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1x,A)") "VAMP integrator:"
	call object%base_write (u, pacify, md5sum_version)
	if (allocated (object%dim_is_flat)) then
	write (u, "(3x,A,999(1x,I0))") "Flat dimensions =", &
	pack ([(i, i = 1, object%n_dim)], object%dim_is_flat)
	end if
	write (u, "(1x,A)") "Grid parameters:"
	call object%grid_par%write (u)
	write (u, "(3x,A,I0)") "min_calls = ", object%min_calls
	write (u, "(3x,A,L1)") "negative weights = ", &
	object%negative_weights
	write (u, "(3x,A,L1)") "verbose = ", &
	object%verbose
	if (object%grid_par%use_vamp_equivalences) then
	call vamp_equivalences_write (object%equivalences, u)
	end if
	current_pass => object%first_pass
	do while (associated (current_pass))
	write (u, "(1x,A,I0,A)") "Integration pass:"
	call current_pass%write (u, pacify)
	current_pass => current_pass%next
	end do
	if (object%md5sum_adapted /= "") then
	write (u, "(1x,A,A,A)") "MD5 sum (including results) = '", &
	object%md5sum_adapted, "'"
	end if
	end subroutine mci_vamp_write

	@ %def mci_vamp_write
	@ Write the history parameters.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: write_history_parameters => mci_vamp_write_history_parameters
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_write_history_parameters (mci, unit)
	class(mci_vamp_t), intent(in) :: mci
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "VAMP history parameters:"
	call mci%history_par%write (unit)
	end subroutine mci_vamp_write_history_parameters

	@ %def mci_vamp_write_history_parameters
	@ Write the history, iterating over passes. We keep this separate
	from the generic [[write]] routine.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: write_history => mci_vamp_write_history
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_write_history (mci, unit)
	class(mci_vamp_t), intent(in) :: mci
	integer, intent(in), optional :: unit
	type(pass_t), pointer :: current_pass
	integer :: i_pass
	integer :: u
	u = given_output_unit (unit)
	if (associated (mci%first_pass)) then
	write (u, "(1x,A)") "VAMP history (global):"
	i_pass = 0
	current_pass => mci%first_pass
	do while (associated (current_pass))
	i_pass = i_pass + 1
	write (u, "(1x,A,I0,':')") "Pass #", i_pass
	call current_pass%write_history (u)
	current_pass => current_pass%next
	end do
	end if
	end subroutine mci_vamp_write_history

	@ %def mci_vamp_write_history
	@ Compute the MD5 sum, including the configuration MD5 sum and the
	printout, which incorporates the current results.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: compute_md5sum => mci_vamp_compute_md5sum
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_compute_md5sum (mci, pacify)
	class(mci_vamp_t), intent(inout) :: mci
	logical, intent(in), optional :: pacify
	integer :: u
	mci%md5sum_adapted = ""
	u = free_unit ()
	open (u, status = "scratch", action = "readwrite")
	write (u, "(A)") mci%md5sum
	call mci%write (u, pacify, md5sum_version = .true.)
	rewind (u)
	mci%md5sum_adapted = md5sum (u)
	close (u)
	end subroutine mci_vamp_compute_md5sum

	@ %def mci_vamp_compute_md5sum
	@ Return the MD5 sum: If available, return the adapted one.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: get_md5sum => mci_vamp_get_md5sum
	<<MCI vamp: procedures>>=
	function mci_vamp_get_md5sum (mci) result (md5sum)
	class(mci_vamp_t), intent(in) :: mci
	character(32) :: md5sum
	if (mci%md5sum_adapted /= "") then
	md5sum = mci%md5sum_adapted
	else
	md5sum = mci%md5sum
	end if
	end function mci_vamp_get_md5sum

	@ %def mci_vamp_get_md5sum
	@ Startup message: short version.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: startup_message => mci_vamp_startup_message
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_startup_message (mci, unit, n_calls)
	class(mci_vamp_t), intent(in) :: mci
	integer, intent(in), optional :: unit, n_calls
	integer :: num_calls, n_bins
	if (present (n_calls)) then
	num_calls = n_calls
	else
	num_calls = 0
	end if
	if (mci%min_calls /= 0) then
	n_bins = max (mci%grid_par%min_bins, &
	min (num_calls / mci%min_calls, &
	mci%grid_par%max_bins))
	else
	n_bins = mci%grid_par%max_bins
	end if
	call mci%base_startup_message (unit = unit, n_calls = n_calls)
	if (mci%grid_par%use_vamp_equivalences) then
	write (msg_buffer, "(A,2(1x,I0,1x,A))") &
	"Integrator: Using VAMP channel equivalences"
	call msg_message (unit = unit)
	end if
	write (msg_buffer, "(A,2(1x,I0,1x,A),L1)") &
	"Integrator:", num_calls, &
	"initial calls,", n_bins, &
	"bins, stratified = ", &
	mci%grid_par%stratified
	call msg_message (unit = unit)
	write (msg_buffer, "(A,2(1x,I0,1x,A))") &
	"Integrator: VAMP"
	call msg_message (unit = unit)
	end subroutine mci_vamp_startup_message

	@ %def mci_vamp_startup_message
	@ Set the MCI index (necessary for processes with multiple components).
	We append the index to the grid filename, just before the final dotted
	suffix.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: record_index => mci_vamp_record_index
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_record_index (mci, i_mci)
	class(mci_vamp_t), intent(inout) :: mci
	integer, intent(in) :: i_mci
	type(string_t) :: basename, suffix
	character(32) :: buffer
	if (mci%grid_filename_set) then
	basename = mci%grid_filename
	call split (basename, suffix, ".", back=.true.)
	write (buffer, "(I0)") i_mci
	if (basename /= "") then
	mci%grid_filename = basename // "_m" // trim (buffer) // "." // suffix
	else
	mci%grid_filename = suffix // "_m" // trim (buffer) // ".vg"
	end if
	end if
	end subroutine mci_vamp_record_index

	@ %def mci_vamp_record_index
	@ Set the grid parameters.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: set_grid_parameters => mci_vamp_set_grid_parameters
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_set_grid_parameters (mci, grid_par)
	class(mci_vamp_t), intent(inout) :: mci
	type(grid_parameters_t), intent(in) :: grid_par
	mci%grid_par = grid_par
	mci%min_calls = grid_par%min_calls_per_bin * mci%n_channel
	end subroutine mci_vamp_set_grid_parameters

	@ %def mci_vamp_set_grid_parameters
	@ Set the history parameters.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: set_history_parameters => mci_vamp_set_history_parameters
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_set_history_parameters (mci, history_par)
	class(mci_vamp_t), intent(inout) :: mci
	type(history_parameters_t), intent(in) :: history_par
	mci%history_par = history_par
	end subroutine mci_vamp_set_history_parameters

	@ %def mci_vamp_set_history_parameters
	@ Set the rebuild flag, also the flag for checking the grid file.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: set_rebuild_flag => mci_vamp_set_rebuild_flag
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_set_rebuild_flag (mci, rebuild, check_grid_file)
	class(mci_vamp_t), intent(inout) :: mci
	logical, intent(in) :: rebuild
	logical, intent(in) :: check_grid_file
	mci%rebuild = rebuild
	mci%check_grid_file = check_grid_file
	end subroutine mci_vamp_set_rebuild_flag

	@ %def mci_vamp_set_rebuild_flag
	@ Set the filename.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: set_grid_filename => mci_vamp_set_grid_filename
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_set_grid_filename (mci, name, run_id)
	class(mci_vamp_t), intent(inout) :: mci
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: run_id
	if (present (run_id)) then
	mci%grid_filename = name // "." // run_id // ".vg"
	else
	mci%grid_filename = name // ".vg"
	end if
	mci%grid_filename_set = .true.
	end subroutine mci_vamp_set_grid_filename

	@ %def mci_vamp_set_grid_filename
	@ Declare particular dimensions as flat.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: declare_flat_dimensions => mci_vamp_declare_flat_dimensions
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_declare_flat_dimensions (mci, dim_flat)
	class(mci_vamp_t), intent(inout) :: mci
	integer, dimension(:), intent(in) :: dim_flat
	integer :: d
	allocate (mci%dim_is_flat (mci%n_dim), source = .false.)
	do d = 1, size (dim_flat)
	mci%dim_is_flat(dim_flat(d)) = .true.
	end do
	end subroutine mci_vamp_declare_flat_dimensions

	@ %def mci_vamp_declare_flat_dimensions
	@ Declare equivalences. We have an array of channel equivalences,
	provided by the phase-space module. Here, we translate this into the
	[[vamp_equivalences]] array.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: declare_equivalences => mci_vamp_declare_equivalences
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_declare_equivalences (mci, channel, dim_offset)
	class(mci_vamp_t), intent(inout) :: mci
	type(phs_channel_t), dimension(:), intent(in) :: channel
	integer, intent(in) :: dim_offset
	integer, dimension(:), allocatable :: perm, mode
	integer :: n_channels, n_dim, n_equivalences
	integer :: c, i, j, left, right
	n_channels = mci%n_channel
	n_dim = mci%n_dim
	n_equivalences = 0
	do c = 1, n_channels
	n_equivalences = n_equivalences + size (channel(c)%eq)
	end do
	call vamp_equivalences_init (mci%equivalences, &
	n_equivalences, n_channels, n_dim)
	allocate (perm (n_dim))
	allocate (mode (n_dim))
	perm(1:dim_offset) = [(i, i = 1, dim_offset)]
	mode(1:dim_offset) = VEQ_IDENTITY
	c = 1
	j = 0
	do i = 1, n_equivalences
	if (j < size (channel(c)%eq)) then
	j = j + 1
	else
	c = c + 1
	j = 1
	end if
	associate (eq => channel(c)%eq(j))
	left = c
	right = eq%c
	perm(dim_offset+1:) = eq%perm + dim_offset
	mode(dim_offset+1:) = eq%mode
	call vamp_equivalence_set (mci%equivalences, &
	i, left, right, perm, mode)
	end associate
	end do
	call vamp_equivalences_complete (mci%equivalences)
	end subroutine mci_vamp_declare_equivalences

	@ %def mci_vamp_declare_equivalences
	@ Allocate instance with matching type.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: allocate_instance => mci_vamp_allocate_instance
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_allocate_instance (mci, mci_instance)
	class(mci_vamp_t), intent(in) :: mci
	class(mci_instance_t), intent(out), pointer :: mci_instance
	allocate (mci_vamp_instance_t :: mci_instance)
	end subroutine mci_vamp_allocate_instance

	@ %def mci_vamp_allocate_instance
	@ Allocate a new integration pass. We can preset everything that does not
	depend on the number of iterations and calls. This is postponed to
	the [[integrate]] method.

	In the final pass, we do not check accuracy goal etc., since we can assume
	that the user wants to perform and average all iterations in this pass.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: add_pass => mci_vamp_add_pass
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_add_pass (mci, adapt_grids, adapt_weights, final)
	class(mci_vamp_t), intent(inout) :: mci
	logical, intent(in), optional :: adapt_grids, adapt_weights, final
	integer :: i_pass, i_it
	type(pass_t), pointer :: new
	allocate (new)
	if (associated (mci%current_pass)) then
	i_pass = mci%current_pass%i_pass + 1
	i_it = mci%current_pass%i_first_it + mci%current_pass%n_it
	mci%current_pass%next => new
	else
	i_pass = 1
	i_it = 1
	mci%first_pass => new
	end if
	mci%current_pass => new
	new%i_pass = i_pass
	new%i_first_it = i_it
	if (present (adapt_grids)) then
	new%adapt_grids = adapt_grids
	else
	new%adapt_grids = .false.
	end if
	if (present (adapt_weights)) then
	new%adapt_weights = adapt_weights
	else
	new%adapt_weights = .false.
	end if
	if (present (final)) then
	new%is_final_pass = final
	else
	new%is_final_pass = .false.
	end if
	end subroutine mci_vamp_add_pass

	@ %def mci_vamp_add_pass
	@ Update the list of integration passes. All passes except for the last one
	must match exactly. For the last one, integration results are updated. The
	reference output may contain extra passes, these are ignored.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: update_from_ref => mci_vamp_update_from_ref
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_update_from_ref (mci, mci_ref, success)
	class(mci_vamp_t), intent(inout) :: mci
	class(mci_t), intent(in) :: mci_ref
	logical, intent(out) :: success
	type(pass_t), pointer :: current_pass, ref_pass
	select type (mci_ref)
	type is (mci_vamp_t)
	current_pass => mci%first_pass
	ref_pass => mci_ref%first_pass
	success = .true.
	do while (success .and. associated (current_pass))
	if (associated (ref_pass)) then
	if (associated (current_pass%next)) then
	success = current_pass .matches. ref_pass
	else
	call current_pass%update (ref_pass, success)
	if (current_pass%integral_defined) then
	mci%integral = current_pass%get_integral ()
	mci%error = current_pass%get_error ()
	mci%efficiency = current_pass%get_efficiency ()
	mci%integral_known = .true.
	mci%error_known = .true.
	mci%efficiency_known = .true.
	end if
	end if
	current_pass => current_pass%next
	ref_pass => ref_pass%next
	else
	success = .false.
	end if
	end do
	end select
	end subroutine mci_vamp_update_from_ref

	@ %def mci_vamp_update
	@ Update the MCI record (i.e., the integration passes) by reading from input
	stream. The stream should contain a [[write]] output from a previous run. We
	first check the MD5 sum of the configuration parameters. If that matches, we
	proceed directly to the stored integration passes. If successful, we may
	continue to read the file; the position will be after a blank line that
	must follow the MCI record.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: update => mci_vamp_update
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_update (mci, u, success)
	class(mci_vamp_t), intent(inout) :: mci
	integer, intent(in) :: u
	logical, intent(out) :: success
	character(80) :: buffer
	character(32) :: md5sum_file
	type(mci_vamp_t) :: mci_file
	integer :: n_pass, n_it
	call read_sval (u, md5sum_file)
	if (mci%check_grid_file) then
	success = md5sum_file == mci%md5sum
	else
	success = .true.
	end if
	if (success) then
	read (u, *)
	read (u, "(A)") buffer
	if (trim (adjustl (buffer)) == "VAMP integrator:") then
	n_pass = 0
	n_it = 0
	do
	read (u, "(A)") buffer
	select case (trim (adjustl (buffer)))
	case ("")
	exit
	case ("Integration pass:")
	call mci_file%add_pass ()
	call mci_file%current_pass%read (u, n_pass, n_it)
	n_pass = n_pass + 1
	n_it = n_it + mci_file%current_pass%n_it
	end select
	end do
	call mci%update_from_ref (mci_file, success)
	call mci_file%final ()
	else
	call msg_fatal ("VAMP: reading grid file: corrupted data")
	end if
	end if
	end subroutine mci_vamp_update

	@ %def mci_vamp_update
	@ Read / write grids from / to file.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: write_grids => mci_vamp_write_grids
	procedure :: read_grids_header => mci_vamp_read_grids_header
	procedure :: read_grids_data => mci_vamp_read_grids_data
	procedure :: read_grids => mci_vamp_read_grids
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_write_grids (mci, instance)
	class(mci_vamp_t), intent(in) :: mci
	class(mci_instance_t), intent(inout) :: instance
	integer :: u
	select type (instance)
	type is (mci_vamp_instance_t)
	if (mci%grid_filename_set) then
	if (instance%grids_defined) then
	u = free_unit ()
	open (u, file = char (mci%grid_filename), &
	action = "write", status = "replace")
	write (u, "(1x,A,A,A)") "MD5sum = '", mci%md5sum, "'"
	write (u, *)
	call mci%write (u)
	write (u, *)
	write (u, "(1x,A)") "VAMP grids:"
	call vamp_write_grids (instance%grids, u, &
	write_integrals = .true.)
	close (u)
	else
	call msg_bug ("VAMP: write grids: grids undefined")
	end if
	else
	call msg_bug ("VAMP: write grids: filename undefined")
	end if
	end select
	end subroutine mci_vamp_write_grids

	subroutine mci_vamp_read_grids_header (mci, success)
	class(mci_vamp_t), intent(inout) :: mci
	logical, intent(out) :: success
	logical :: exist
	integer :: u
	success = .false.
	if (mci%grid_filename_set) then
	inquire (file = char (mci%grid_filename), exist = exist)
	if (exist) then
	u = free_unit ()
	open (u, file = char (mci%grid_filename), &
	action = "read", status = "old")
	call mci%update (u, success)
	close (u)
	if (.not. success) then
	write (msg_buffer, "(A,A,A)") &
	"VAMP: parameter mismatch, discarding grid file '", &
	char (mci%grid_filename), "'"
	call msg_message ()
	end if
	end if
	else
	call msg_bug ("VAMP: read grids: filename undefined")
	end if
	end subroutine mci_vamp_read_grids_header

	subroutine mci_vamp_read_grids_data (mci, instance, read_integrals)
	class(mci_vamp_t), intent(in) :: mci
	class(mci_instance_t), intent(inout) :: instance
	logical, intent(in), optional :: read_integrals
	integer :: u
	character(80) :: buffer
	select type (instance)
	type is (mci_vamp_instance_t)
	if (.not. instance%grids_defined) then
	u = free_unit ()
	open (u, file = char (mci%grid_filename), &
	action = "read", status = "old")
	do
	read (u, "(A)") buffer
	if (trim (adjustl (buffer)) == "VAMP grids:") exit
	end do
	call vamp_read_grids (instance%grids, u, read_integrals)
	close (u)
	instance%grids_defined = .true.
	else
	call msg_bug ("VAMP: read grids: grids already defined")
	end if
	end select
	end subroutine mci_vamp_read_grids_data

	subroutine mci_vamp_read_grids (mci, instance, success)
	class(mci_vamp_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout) :: instance
	logical, intent(out) :: success
	logical :: exist
	integer :: u
	character(80) :: buffer
	select type (instance)
	type is (mci_vamp_instance_t)
	success = .false.
	if (mci%grid_filename_set) then
	if (.not. instance%grids_defined) then
	inquire (file = char (mci%grid_filename), exist = exist)
	if (exist) then
	u = free_unit ()
	open (u, file = char (mci%grid_filename), &
	action = "read", status = "old")
	call mci%update (u, success)
	if (success) then
	read (u, "(A)") buffer
	if (trim (adjustl (buffer)) == "VAMP grids:") then
	call vamp_read_grids (instance%grids, u)
	else
	call msg_fatal ("VAMP: reading grid file: &
	&corrupted grid data")
	end if
	else
	write (msg_buffer, "(A,A,A)") &
	"VAMP: parameter mismatch, discarding grid file '", &
	char (mci%grid_filename), "'"
	call msg_message ()
	end if
	close (u)
	instance%grids_defined = success
	end if
	else
	call msg_bug ("VAMP: read grids: grids already defined")
	end if
	else
	call msg_bug ("VAMP: read grids: filename undefined")
	end if
	end select
	end subroutine mci_vamp_read_grids

	@ %def mci_vamp_write_grids
	@ %def mci_vamp_read_grids_header
	@ %def mci_vamp_read_grids_data
	@ %def mci_vamp_read_grids
	@ Auxiliary: Read real, integer, string value. We search for an equals sign,
	the value must follow.
	<<MCI vamp: procedures>>=
	subroutine read_rval (u, rval)
	integer, intent(in) :: u
	real(default), intent(out) :: rval
	character(80) :: buffer
	read (u, "(A)") buffer
	buffer = adjustl (buffer(scan (buffer, "=") + 1:))
	read (buffer, *) rval
	end subroutine read_rval

	subroutine read_ival (u, ival)
	integer, intent(in) :: u
	integer, intent(out) :: ival
	character(80) :: buffer
	read (u, "(A)") buffer
	buffer = adjustl (buffer(scan (buffer, "=") + 1:))
	read (buffer, *) ival
	end subroutine read_ival

	subroutine read_sval (u, sval)
	integer, intent(in) :: u
	character(*), intent(out) :: sval
	character(80) :: buffer
	read (u, "(A)") buffer
	buffer = adjustl (buffer(scan (buffer, "=") + 1:))
	read (buffer, *) sval
	end subroutine read_sval

	subroutine read_lval (u, lval)
	integer, intent(in) :: u
	logical, intent(out) :: lval
	character(80) :: buffer
	read (u, "(A)") buffer
	buffer = adjustl (buffer(scan (buffer, "=") + 1:))
	read (buffer, *) lval
	end subroutine read_lval

	@ %def read_rval read_ival read_sval read_lval
	@ Integrate. Perform a new integration pass (possibly reusing
	previous results), which may consist of several iterations.

	Note: we record the integral once per iteration. The integral stored
	in the [[mci]] record itself is the last integral of the current
	iteration, no averaging done. The [[results]] record may average results.

	Note: recording the efficiency is not supported yet.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: integrate => mci_vamp_integrate
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_integrate (mci, instance, sampler, &
	n_it, n_calls, results, pacify)
	class(mci_vamp_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout) :: instance
	class(mci_sampler_t), intent(inout) :: sampler
	integer, intent(in) :: n_it
	integer, intent(in) :: n_calls
	class(mci_results_t), intent(inout), optional :: results
	logical, intent(in), optional :: pacify
	integer :: it
	logical :: reshape, from_file, success
	select type (instance)
	type is (mci_vamp_instance_t)
	if (associated (mci%current_pass)) then
	mci%current_pass%integral_defined = .false.
	call mci%current_pass%configure (n_it, n_calls, &
	mci%min_calls, mci%grid_par%min_bins, &
	mci%grid_par%max_bins, &
	mci%grid_par%min_calls_per_channel * mci%n_channel)
	call mci%current_pass%configure_history &
	(mci%n_channel, mci%history_par)
	instance%pass_complete = .false.
	instance%it_complete = .false.
	call instance%new_pass (reshape)
	if (.not. instance%grids_defined .or. instance%grids_from_file) then
	if (mci%grid_filename_set .and. .not. mci%rebuild) then
	call mci%read_grids_header (success)
	from_file = success
	if (.not. instance%grids_defined .and. success) then
	call mci%read_grids_data (instance)
	end if
	else
	from_file = .false.
	end if
	else
	from_file = .false.
	end if
	if (from_file) then
	if (.not. mci%check_grid_file) &
	call msg_warning ("Reading grid file: MD5 sum check disabled")
	call msg_message ("VAMP: " &
	// "using grids and results from file '" &
	// char (mci%grid_filename) // "'")
	else if (.not. instance%grids_defined) then
	call instance%create_grids ()
	end if
	do it = 1, instance%n_it
	if (signal_is_pending ()) return
	instance%grids_from_file = from_file .and. &
	it <= mci%current_pass%get_integration_index ()
	if (.not. instance%grids_from_file) then
	instance%it_complete = .false.
	call instance%adapt_grids ()
	if (signal_is_pending ()) return
	call instance%adapt_weights ()
	if (signal_is_pending ()) return
	call instance%discard_integrals (reshape)
	if (mci%grid_par%use_vamp_equivalences) then
	call instance%sample_grids (mci%rng, sampler, &
	mci%equivalences)
	else
	call instance%sample_grids (mci%rng, sampler)
	end if
	if (signal_is_pending ()) return
	instance%it_complete = .true.
	if (instance%integral /= 0) then
	mci%current_pass%calls(it) = instance%calls
	mci%current_pass%integral(it) = instance%integral
	if (abs (instance%error / instance%integral) &
	> epsilon (1._default)) then
	mci%current_pass%error(it) = instance%error
	end if
	mci%current_pass%efficiency(it) = instance%efficiency
	end if
	mci%current_pass%integral_defined = .true.
	end if
	if (present (results)) then
	if (mci%has_chains ()) then
	call mci%collect_chain_weights (instance%w)
	call results%record (1, &
	n_calls = mci%current_pass%calls(it), &
	integral = mci%current_pass%integral(it), &
	error = mci%current_pass%error(it), &
	efficiency = mci%current_pass%efficiency(it), &
	chain_weights = mci%chain_weights, &
	suppress = pacify)
	else
	call results%record (1, &
	n_calls = mci%current_pass%calls(it), &
	integral = mci%current_pass%integral(it), &
	error = mci%current_pass%error(it), &
	efficiency = mci%current_pass%efficiency(it), &
	suppress = pacify)
	end if
	end if
	if (.not. instance%grids_from_file &
	.and. mci%grid_filename_set) then
	call mci%write_grids (instance)
	end if
	call instance%allow_adaptation ()
	reshape = .false.
	if (.not. mci%current_pass%is_final_pass) then
	call mci%check_goals (it, success)
	if (success) exit
	end if
	end do
	if (signal_is_pending ()) return
	instance%pass_complete = .true.
	mci%integral = mci%current_pass%get_integral()
	mci%error = mci%current_pass%get_error()
	mci%efficiency = mci%current_pass%get_efficiency()
	mci%integral_known = .true.
	mci%error_known = .true.
	mci%efficiency_known = .true.
	call mci%compute_md5sum (pacify)
	else
	call msg_bug ("MCI integrate: current_pass object not allocated")
	end if
	end select
	end subroutine mci_vamp_integrate

	@ %def mci_vamp_integrate
	@ Check whether we are already finished with this pass.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: check_goals => mci_vamp_check_goals
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_check_goals (mci, it, success)
	class(mci_vamp_t), intent(inout) :: mci
	integer, intent(in) :: it
	logical, intent(out) :: success
	success = .false.
	if (mci%error_reached (it)) then
	mci%current_pass%n_it = it
	call msg_message ("VAMP: error goal reached; &
	&skipping iterations")
	success = .true.
	return
	end if
	if (mci%rel_error_reached (it)) then
	mci%current_pass%n_it = it
	call msg_message ("VAMP: relative error goal reached; &
	&skipping iterations")
	success = .true.
	return
	end if
	if (mci%accuracy_reached (it)) then
	mci%current_pass%n_it = it
	call msg_message ("VAMP: accuracy goal reached; &
	&skipping iterations")
	success = .true.
	return
	end if
	end subroutine mci_vamp_check_goals

	@ %def mci_vamp_check_goals
	@ Return true if the error, relative error, or accuracy goal has been reached,
	if any.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: error_reached => mci_vamp_error_reached
	procedure :: rel_error_reached => mci_vamp_rel_error_reached
	procedure :: accuracy_reached => mci_vamp_accuracy_reached
	<<MCI vamp: procedures>>=
	function mci_vamp_error_reached (mci, it) result (flag)
	class(mci_vamp_t), intent(in) :: mci
	integer, intent(in) :: it
	logical :: flag
	real(default) :: error_goal, error
	error_goal = mci%grid_par%error_goal
	if (error_goal > 0) then
	associate (pass => mci%current_pass)
	if (pass%integral_defined) then
	error = abs (pass%error(it))
	flag = error < error_goal
	else
	flag = .false.
	end if
	end associate
	else
	flag = .false.
	end if
	end function mci_vamp_error_reached

	function mci_vamp_rel_error_reached (mci, it) result (flag)
	class(mci_vamp_t), intent(in) :: mci
	integer, intent(in) :: it
	logical :: flag
	real(default) :: rel_error_goal, rel_error
	rel_error_goal = mci%grid_par%rel_error_goal
	if (rel_error_goal > 0) then
	associate (pass => mci%current_pass)
	if (pass%integral_defined) then
	if (pass%integral(it) /= 0) then
	rel_error = abs (pass%error(it) / pass%integral(it))
	flag = rel_error < rel_error_goal
	else
	flag = .true.
	end if
	else
	flag = .false.
	end if
	end associate
	else
	flag = .false.
	end if
	end function mci_vamp_rel_error_reached

	function mci_vamp_accuracy_reached (mci, it) result (flag)
	class(mci_vamp_t), intent(in) :: mci
	integer, intent(in) :: it
	logical :: flag
	real(default) :: accuracy_goal, accuracy
	accuracy_goal = mci%grid_par%accuracy_goal
	if (accuracy_goal > 0) then
	associate (pass => mci%current_pass)
	if (pass%integral_defined) then
	if (pass%integral(it) /= 0) then
	accuracy = abs (pass%error(it) / pass%integral(it)) &
	* sqrt (real (pass%calls(it), default))
	flag = accuracy < accuracy_goal
	else
	flag = .true.
	end if
	else
	flag = .false.
	end if
	end associate
	else
	flag = .false.
	end if
	end function mci_vamp_accuracy_reached

	@ %def mci_vamp_error_reached
	@ %def mci_vamp_rel_error_reached
	@ %def mci_vamp_accuracy_reached
	@ Prepare an event generation pass. Should be called before a sequence of
	events is generated, then we should call the corresponding finalizer.

	The pass-specific data of the previous integration pass are retained,
	but we reset the number of iterations and calls to zero. The latter
	now counts the number of events (calls to the sampling function, actually).
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: prepare_simulation => mci_vamp_prepare_simulation
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_prepare_simulation (mci)
	class(mci_vamp_t), intent(inout) :: mci
	logical :: success
	if (mci%grid_filename_set) then
	call mci%read_grids_header (success)
	call mci%compute_md5sum ()
	if (.not. success) then
	call msg_fatal ("Simulate: " &
	// "reading integration grids from file '" &
	// char (mci%grid_filename) // "' failed")
	end if
	else
	call msg_bug ("VAMP: simulation: no grids, no grid filename")
	end if
	end subroutine mci_vamp_prepare_simulation

	@ %def mci_vamp_prepare_simulation
	@ Generate weighted event. Note that the event weight
	([[vamp_weight]]) is not just the MCI weight. [[vamp_next_event]]
	selects a channel based on the channel weights multiplied by the
	(previously recorded) maximum integrand value of the channel. The
	MCI weight is renormalized accordingly, to cancel this effect on the
	result.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: generate_weighted_event => mci_vamp_generate_weighted_event
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_generate_weighted_event (mci, instance, sampler)
	class(mci_vamp_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout), target :: instance
	class(mci_sampler_t), intent(inout), target :: sampler
	class(vamp_data_t), allocatable :: data
	type(exception) :: vamp_exception
	select type (instance)
	type is (mci_vamp_instance_t)
	instance%vamp_weight_set = .false.
	allocate (mci_workspace_t :: data)
	select type (data)
	type is (mci_workspace_t)
	data%sampler => sampler
	data%instance => instance
	end select
	select type (rng => mci%rng)
	type is (rng_tao_t)
	if (instance%grids_defined) then
	call vamp_next_event ( &
	instance%vamp_x, &
	rng%state, &
	instance%grids, &
	vamp_sampling_function, &
	data, &
	phi = phi_trivial, &
	weight = instance%vamp_weight, &
	exc = vamp_exception)
	call handle_vamp_exception (vamp_exception, mci%verbose)
	instance%vamp_excess = 0
	instance%vamp_weight_set = .true.
	else
	call msg_bug ("VAMP: generate event: grids undefined")
	end if
	class default
	call msg_fatal ("VAMP event generation: &
	&random-number generator must be TAO")
	end select
	end select
	end subroutine mci_vamp_generate_weighted_event

	@ %def mci_vamp_generate_weighted_event
	@ Generate unweighted event.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: generate_unweighted_event => &
	mci_vamp_generate_unweighted_event
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_generate_unweighted_event (mci, instance, sampler)
	class(mci_vamp_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout), target :: instance
	class(mci_sampler_t), intent(inout), target :: sampler
	class(vamp_data_t), allocatable :: data
	type(exception) :: vamp_exception
	select type (instance)
	type is (mci_vamp_instance_t)
	instance%vamp_weight_set = .false.
	allocate (mci_workspace_t :: data)
	select type (data)
	type is (mci_workspace_t)
	data%sampler => sampler
	data%instance => instance
	end select
	select type (rng => mci%rng)
	type is (rng_tao_t)
	if (instance%grids_defined) then
	REJECTION: do
	call vamp_next_event ( &
	instance%vamp_x, &
	rng%state, &
	instance%grids, &
	vamp_sampling_function, &
	data, &
	phi = phi_trivial, &
	excess = instance%vamp_excess, &
	exc = vamp_exception)
	if (signal_is_pending ()) return
	if (sampler%is_valid ()) exit REJECTION
	end do REJECTION
	call handle_vamp_exception (vamp_exception, mci%verbose)
	instance%vamp_weight = 1
	instance%vamp_weight_set = .true.
	else
	call msg_bug ("VAMP: generate event: grids undefined")
	end if
	class default
	call msg_fatal ("VAMP event generation: &
	&random-number generator must be TAO")
	end select
	end select
	end subroutine mci_vamp_generate_unweighted_event

	@ %def mci_vamp_generate_unweighted_event
	@ Rebuild an event, using the [[state]] input.

	Note: This feature is currently unused.
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: rebuild_event => mci_vamp_rebuild_event
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_rebuild_event (mci, instance, sampler, state)
	class(mci_vamp_t), intent(inout) :: mci
	class(mci_instance_t), intent(inout) :: instance
	class(mci_sampler_t), intent(inout) :: sampler
	class(mci_state_t), intent(in) :: state
	call msg_bug ("MCI vamp rebuild event not implemented yet")
	end subroutine mci_vamp_rebuild_event

	@ %def mci_vamp_rebuild_event
	@
	<<MCI vamp: mci vamp: TBP>>=
	procedure :: pacify => mci_vamp_pacify
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_pacify (object, efficiency_reset, error_reset)
	class(mci_vamp_t), intent(inout) :: object
	logical, intent(in), optional :: efficiency_reset, error_reset
	logical :: err_reset
	type(pass_t), pointer :: current_pass
	err_reset = .false.
	if (present (error_reset)) err_reset = error_reset
	current_pass => object%first_pass
	do while (associated (current_pass))
	if (allocated (current_pass%error) .and. err_reset) then
	current_pass%error = 0
	end if
	if (allocated (current_pass%efficiency) .and. err_reset) then
	current_pass%efficiency = 1
	end if
	current_pass => current_pass%next
	end do
	end subroutine mci_vamp_pacify

	@ %def mci_vamp_pacify
	@
	\subsection{Sampler as Workspace}
	In the full setup, the sampling function requires the process instance
	object as workspace. We implement this by (i) implementing the
	process instance as a type extension of the abstract [[sampler_t]]
	object used by the MCI implementation and (ii) providing such an
	object as an extra argument to the sampling function that VAMP can
	call. To minimize cross-package dependencies, we use an abstract type
	[[vamp_workspace]] that VAMP declares and extend this by including a
	pointer to the [[sampler]] and [[instance]] objects. In the body of
	the sampling function, we dereference this pointer and can then work
	with the contents.
	<<MCI vamp: types>>=
	type, extends (vamp_data_t) :: mci_workspace_t
	class(mci_sampler_t), pointer :: sampler => null ()
	class(mci_vamp_instance_t), pointer :: instance => null ()
	end type mci_workspace_t

	@ %def mci_workspace_t
	@
	\subsection{Integrator instance}
	The history entries should point to the corresponding history entry in
	the [[pass_t]] object. If there is none, we may allocate a local
	history, which is then just transient.
	<<MCI vamp: public>>=
	public :: mci_vamp_instance_t
	<<MCI vamp: types>>=
	type, extends (mci_instance_t) :: mci_vamp_instance_t
	type(mci_vamp_t), pointer :: mci => null ()
	logical :: grids_defined = .false.
	logical :: grids_from_file = .false.
	integer :: n_it = 0
	integer :: it = 0
	logical :: pass_complete = .false.
	integer :: n_calls = 0
	integer :: calls = 0
	logical :: it_complete = .false.
	logical :: enable_adapt_grids = .false.
	logical :: enable_adapt_weights = .false.
	logical :: allow_adapt_grids = .false.
	logical :: allow_adapt_weights = .false.
	logical :: negative_weights = .false.
	integer :: n_adapt_grids = 0
	integer :: n_adapt_weights = 0
	logical :: generating_events = .false.
	real(default) :: safety_factor = 1
	type(vamp_grids) :: grids
	real(default) :: g = 0
	real(default), dimension(:), allocatable :: gi
	real(default) :: integral = 0
	real(default) :: error = 0
	real(default) :: efficiency = 0
	real(default), dimension(:), allocatable :: vamp_x
	logical :: vamp_weight_set = .false.
	real(default) :: vamp_weight = 0
	real(default) :: vamp_excess = 0
	logical :: allocate_global_history = .false.
	type(vamp_history), dimension(:), pointer :: v_history => null ()
	logical :: allocate_channel_history = .false.
	type(vamp_history), dimension(:,:), pointer :: v_histories => null ()
	contains
	<<MCI vamp: mci vamp instance: TBP>>
	end type mci_vamp_instance_t

	@ %def mci_vamp_instance_t
	@ Output.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: write => mci_vamp_instance_write
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_write (object, unit, pacify)
	class(mci_vamp_instance_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacify
	integer :: u, i
	character(len=7) :: fmt
	call pac_fmt (fmt, FMT_17, FMT_14, pacify)
	u = given_output_unit (unit)
	write (u, "(3x,A," // FMT_19 // ")") "Integrand = ", object%integrand
	write (u, "(3x,A," // FMT_19 // ")") "Weight = ", object%mci_weight
	if (object%vamp_weight_set) then
	write (u, "(3x,A," // FMT_19 // ")") "VAMP wgt = ", object%vamp_weight
	if (object%vamp_excess /= 0) then
	write (u, "(3x,A," // FMT_19 // ")") "VAMP exc = ", &
	object%vamp_excess
	end if
	end if
	write (u, "(3x,A,L1)") "adapt grids = ", object%enable_adapt_grids
	write (u, "(3x,A,L1)") "adapt weights = ", object%enable_adapt_weights
	if (object%grids_defined) then
	if (object%grids_from_file) then
	write (u, "(3x,A)") "VAMP grids: read from file"
	else
	write (u, "(3x,A)") "VAMP grids: defined"
	end if
	else
	write (u, "(3x,A)") "VAMP grids: [undefined]"
	end if
	write (u, "(3x,A,I0)") "n_it = ", object%n_it
	write (u, "(3x,A,I0)") "it = ", object%it
	write (u, "(3x,A,L1)") "pass complete = ", object%it_complete
	write (u, "(3x,A,I0)") "n_calls = ", object%n_calls
	write (u, "(3x,A,I0)") "calls = ", object%calls
	write (u, "(3x,A,L1)") "it complete = ", object%it_complete
	write (u, "(3x,A,I0)") "n adapt.(g) = ", object%n_adapt_grids
	write (u, "(3x,A,I0)") "n adapt.(w) = ", object%n_adapt_weights
	write (u, "(3x,A,L1)") "gen. events = ", object%generating_events
	write (u, "(3x,A,L1)") "neg. weights = ", object%negative_weights
	if (object%safety_factor /= 1) write &
	(u, "(3x,A," // fmt // ")") "safety f = ", object%safety_factor
	write (u, "(3x,A," // fmt // ")") "integral = ", object%integral
	write (u, "(3x,A," // fmt // ")") "error = ", object%error
	write (u, "(3x,A," // fmt // ")") "eff. = ", object%efficiency
	write (u, "(3x,A)") "weights:"
	do i = 1, size (object%w)
	write (u, "(5x,I0,1x," // FMT_12 // ")") i, object%w(i)
	end do
	end subroutine mci_vamp_instance_write

	@ %def mci_vamp_instance_write
	@ Write the grids to the specified unit.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: write_grids => mci_vamp_instance_write_grids
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_write_grids (object, unit)
	class(mci_vamp_instance_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	if (object%grids_defined) then
	call vamp_write_grids (object%grids, u, write_integrals = .true.)
	end if
	end subroutine mci_vamp_instance_write_grids

	@ %def mci_vamp_instance_write_grids
	@ Finalizer: the history arrays are pointer arrays and need finalization.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: final => mci_vamp_instance_final
	<<MCI vamp: tests>>=
	subroutine mci_vamp_instance_final (object)
	class(mci_vamp_instance_t), intent(inout) :: object
	if (object%allocate_global_history) then
	if (associated (object%v_history)) then
	call vamp_delete_history (object%v_history)
	deallocate (object%v_history)
	end if
	end if
	if (object%allocate_channel_history) then
	if (associated (object%v_histories)) then
	call vamp_delete_history (object%v_histories)
	deallocate (object%v_histories)
	end if
	end if
	if (object%grids_defined) then
	call vamp_delete_grids (object%grids)
	object%grids_defined = .false.
	end if
	end subroutine mci_vamp_instance_final

	@ %def mci_vamp_instance_final
	@ Initializer.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: init => mci_vamp_instance_init
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_init (mci_instance, mci)
	class(mci_vamp_instance_t), intent(out) :: mci_instance
	class(mci_t), intent(in), target :: mci
	call mci_instance%base_init (mci)
	select type (mci)
	type is (mci_vamp_t)
	mci_instance%mci => mci
	allocate (mci_instance%gi (mci%n_channel))
	mci_instance%allocate_global_history = .not. mci%history_par%global
	mci_instance%allocate_channel_history = .not. mci%history_par%channel
	mci_instance%negative_weights = mci%negative_weights
	end select
	end subroutine mci_vamp_instance_init

	@ %def mci_vamp_instance_init
	@ Prepare a new integration pass: write the pass-specific settings to
	the [[instance]] object. This should be called initially, together
	with the [[create_grids]] procedure, and whenever we start a new
	integration pass.

	Set [[reshape]] if the number of calls is different than previously (unless it
	was zero, indicating the first pass).

	We link VAMP histories to the allocated histories in the current pass
	object, so the recorded results are persistent. However, if there are
	no histories present there, we allocate them locally. In that case,
	the histories will disappear together with the MCI instance object.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: new_pass => mci_vamp_instance_new_pass
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_new_pass (instance, reshape)
	class(mci_vamp_instance_t), intent(inout) :: instance
	logical, intent(out) :: reshape
	type(pass_t), pointer :: current
	associate (mci => instance%mci)
	current => mci%current_pass
	instance%n_it = current%n_it
	if (instance%n_calls == 0) then
	reshape = .false.
	instance%n_calls = current%n_calls
	else if (instance%n_calls == current%n_calls) then
	reshape = .false.
	else
	reshape = .true.
	instance%n_calls = current%n_calls
	end if
	instance%it = 0
	instance%calls = 0
	instance%enable_adapt_grids = current%adapt_grids
	instance%enable_adapt_weights = current%adapt_weights
	instance%generating_events = .false.
	if (instance%allocate_global_history) then
	if (associated (instance%v_history)) then
	call vamp_delete_history (instance%v_history)
	deallocate (instance%v_history)
	end if
	allocate (instance%v_history (instance%n_it))
	call vamp_create_history (instance%v_history, verbose = .false.)
	else
	instance%v_history => current%v_history
	end if
	if (instance%allocate_channel_history) then
	if (associated (instance%v_histories)) then
	call vamp_delete_history (instance%v_histories)
	deallocate (instance%v_histories)
	end if
	allocate (instance%v_histories (instance%n_it, mci%n_channel))
	call vamp_create_history (instance%v_histories, verbose = .false.)
	else
	instance%v_histories => current%v_histories
	end if
	end associate
	end subroutine mci_vamp_instance_new_pass

	@ %def mci_vamp_instance_new_pass
	@
	Create a grid set within the [[instance]] object, using the data of
	the current integration pass. Also reset counters that track this
	grid set.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: create_grids => mci_vamp_instance_create_grids
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_create_grids (instance)
	class(mci_vamp_instance_t), intent(inout) :: instance
	type (pass_t), pointer :: current
	integer, dimension(:), allocatable :: num_div
	real(default), dimension(:,:), allocatable :: region
	associate (mci => instance%mci)
	current => mci%current_pass
	allocate (num_div (mci%n_dim))
	allocate (region (2, mci%n_dim))
	region(1,:) = 0
	region(2,:) = 1
	num_div = current%n_bins
	instance%n_adapt_grids = 0
	instance%n_adapt_weights = 0
	if (.not. instance%grids_defined) then
	call vamp_create_grids (instance%grids, &
	region, &
	current%n_calls, &
	weights = instance%w, &
	num_div = num_div, &
	stratified = mci%grid_par%stratified)
	instance%grids_defined = .true.
	else
	call msg_bug ("VAMP: create grids: grids already defined")
	end if
	end associate
	end subroutine mci_vamp_instance_create_grids

	@ %def mci_vamp_instance_create_grids
	@ Reset a grid set, so we can start a fresh integration pass. In
	effect, we delete results of previous integrations, but keep the grid
	shapes, weights, and variance arrays, so adaptation is still possible.
	The grids are prepared for a specific number of calls (per iteration)
	and sampling mode (stratified/importance).

	The [[vamp_discard_integrals]] implementation will reshape the grids
	only if the argument [[num_calls]] is present.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: discard_integrals => mci_vamp_instance_discard_integrals
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_discard_integrals (instance, reshape)
	class(mci_vamp_instance_t), intent(inout) :: instance
	logical, intent(in) :: reshape
	instance%calls = 0
	instance%integral = 0
	instance%error = 0
	instance%efficiency = 0
	associate (mci => instance%mci)
	if (instance%grids_defined) then
	if (mci%grid_par%use_vamp_equivalences) then
	if (reshape) then
	call vamp_discard_integrals (instance%grids, &
	num_calls = instance%n_calls, &
	stratified = mci%grid_par%stratified, &
	eq = mci%equivalences)
	else
	call vamp_discard_integrals (instance%grids, &
	stratified = mci%grid_par%stratified, &
	eq = mci%equivalences)
	end if
	else
	if (reshape) then
	call vamp_discard_integrals (instance%grids, &
	num_calls = instance%n_calls, &
	stratified = mci%grid_par%stratified)
	else
	call vamp_discard_integrals (instance%grids, &
	stratified = mci%grid_par%stratified)
	end if
	end if
	else
	call msg_bug ("VAMP: discard integrals: grids undefined")
	end if
	end associate
	end subroutine mci_vamp_instance_discard_integrals

	@ %def mci_vamp_instance_discard_integrals
	@ After grids are created (with equidistant binning and equal weight),
	adaptation is redundant. Therefore, we should allow it only after a
	complete integration step has been performed, calling this.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: allow_adaptation => mci_vamp_instance_allow_adaptation
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_allow_adaptation (instance)
	class(mci_vamp_instance_t), intent(inout) :: instance
	instance%allow_adapt_grids = .true.
	instance%allow_adapt_weights = .true.
	end subroutine mci_vamp_instance_allow_adaptation

	@ %def mci_vamp_instance_allow_adaptation
	@ Adapt grids.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: adapt_grids => mci_vamp_instance_adapt_grids
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_adapt_grids (instance)
	class(mci_vamp_instance_t), intent(inout) :: instance
	if (instance%enable_adapt_grids .and. instance%allow_adapt_grids) then
	if (instance%grids_defined) then
	call vamp_refine_grids (instance%grids)
	instance%n_adapt_grids = instance%n_adapt_grids + 1
	else
	call msg_bug ("VAMP: adapt grids: grids undefined")
	end if
	end if
	end subroutine mci_vamp_instance_adapt_grids

	@ %def mci_vamp_instance_adapt_grids
	@ Adapt weights. Use the variance array returned by \vamp\ for
	recalculating the weight array. The parameter
	[[channel_weights_power]] dampens fluctuations.

	If the number of calls in a given channel falls below a user-defined threshold,
	the weight is not lowered further but kept at this threshold. The other
	channel weights are reduced accordingly.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: adapt_weights => mci_vamp_instance_adapt_weights
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_adapt_weights (instance)
	class(mci_vamp_instance_t), intent(inout) :: instance
	real(default) :: w_sum, w_avg_ch, sum_w_underflow, w_min
	integer :: n_ch, ch, n_underflow
	logical, dimension(:), allocatable :: mask, underflow
	type(exception) :: vamp_exception
	if (instance%enable_adapt_weights .and. instance%allow_adapt_weights) then
	associate (mci => instance%mci)
	if (instance%grids_defined) then
	instance%w = instance%grids%weights &
	* vamp_get_variance (instance%grids%grids) &
	** mci%grid_par%channel_weights_power
	w_sum = sum (instance%w)
	if (w_sum /= 0) then
	instance%w = instance%w / w_sum
	if (mci%n_chain /= 0) then
	allocate (mask (mci%n_channel))
	do ch = 1, mci%n_chain
	mask = mci%chain == ch
	n_ch = count (mask)
	if (n_ch /= 0) then
	w_avg_ch = sum (instance%w, mask) / n_ch
	where (mask) instance%w = w_avg_ch
	end if
	end do
	end if
	if (mci%grid_par%threshold_calls /= 0) then
	w_min = &
	real (mci%grid_par%threshold_calls, default) &
	/ instance%n_calls
	allocate (underflow (mci%n_channel))
	underflow = instance%w /= 0 .and. abs (instance%w) < w_min
	n_underflow = count (underflow)
	sum_w_underflow = sum (instance%w, mask=underflow)
	if (sum_w_underflow /= 1) then
	where (underflow)
	instance%w = w_min
	elsewhere
	instance%w = instance%w &
	* (1 - n_underflow * w_min) / (1 - sum_w_underflow)
	end where
	end if
	end if
	end if
	call vamp_update_weights (instance%grids, instance%w, &
	exc = vamp_exception)
	call handle_vamp_exception (vamp_exception, mci%verbose)
	else
	call msg_bug ("VAMP: adapt weights: grids undefined")
	end if
	end associate
	instance%n_adapt_weights = instance%n_adapt_weights + 1
	end if
	end subroutine mci_vamp_instance_adapt_weights

	@ %def mci_vamp_instance_adapt_weights
	@ Integration: sample the VAMP grids. The number of calls etc. are
	already stored inside the grids. We provide the random-number
	generator, the sampling function, and a link to the workspace object,
	which happens to contain a pointer to the sampler object. The sampler
	object thus becomes the workspace of the sampling function.

	Note: in the current implementation, the random-number generator must
	be the TAO generator. This explicit dependence should be removed from
	the VAMP implementation.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: sample_grids => mci_vamp_instance_sample_grids
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_sample_grids (instance, rng, sampler, eq)
	class(mci_vamp_instance_t), intent(inout), target :: instance
	class(rng_t), intent(inout) :: rng
	class(mci_sampler_t), intent(inout), target :: sampler
	type(vamp_equivalences_t), intent(in), optional :: eq
	class(vamp_data_t), allocatable :: data
	type(exception) :: vamp_exception
	allocate (mci_workspace_t :: data)
	select type (data)
	type is (mci_workspace_t)
	data%sampler => sampler
	data%instance => instance
	end select
	select type (rng)
	type is (rng_tao_t)
	instance%it = instance%it + 1
	instance%calls = 0
	if (instance%grids_defined) then
	call vamp_sample_grids ( &
	rng%state, &
	instance%grids, &
	vamp_sampling_function, &
	data, &
	1, &
	eq = eq, &
	history = instance%v_history(instance%it:), &
	histories = instance%v_histories(instance%it:,:), &
	integral = instance%integral, &
	std_dev = instance%error, &
	exc = vamp_exception, &
	negative_weights = instance%negative_weights)
	call handle_vamp_exception (vamp_exception, instance%mci%verbose)
	instance%efficiency = instance%get_efficiency ()
	else
	call msg_bug ("VAMP: sample grids: grids undefined")
	end if
	class default
	call msg_fatal ("VAMP integration: random-number generator must be TAO")
	end select
	end subroutine mci_vamp_instance_sample_grids

	@ %def mci_vamp_instance_sample_grids
	@
	Compute the reweighting efficiency for the current grids, suitable
	averaged over all active channels.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: get_efficiency_array => mci_vamp_instance_get_efficiency_array
	procedure :: get_efficiency => mci_vamp_instance_get_efficiency
	<<MCI vamp: procedures>>=
	function mci_vamp_instance_get_efficiency_array (mci) result (efficiency)
	class(mci_vamp_instance_t), intent(in) :: mci
	real(default), dimension(:), allocatable :: efficiency
	allocate (efficiency (mci%mci%n_channel))
	where (mci%grids%grids%f_max /= 0)
	efficiency = mci%grids%grids%mu(1) / abs (mci%grids%grids%f_max)
	elsewhere
	efficiency = 0
	end where
	end function mci_vamp_instance_get_efficiency_array

	function mci_vamp_instance_get_efficiency (mci) result (efficiency)
	class(mci_vamp_instance_t), intent(in) :: mci
	real(default) :: efficiency
	real(default), dimension(:), allocatable :: weight
	real(default) :: norm
	allocate (weight (mci%mci%n_channel))
	weight = mci%grids%weights * abs (mci%grids%grids%f_max)
	norm = sum (weight)
	if (norm /= 0) then
	efficiency = dot_product (mci%get_efficiency_array (), weight) / norm
	else
	efficiency = 1
	end if
	end function mci_vamp_instance_get_efficiency

	@ %def mci_vamp_instance_get_efficiency_array
	@ %def mci_vamp_instance_get_efficiency
	@ Prepare an event generation pass. Should be called before a sequence of
	events is generated, then we should call the corresponding finalizer.

	The pass-specific data of the previous integration pass are retained,
	but we reset the number of iterations and calls to zero. The latter
	now counts the number of events (calls to the sampling function, actually).
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: init_simulation => mci_vamp_instance_init_simulation
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_init_simulation (instance, safety_factor)
	class(mci_vamp_instance_t), intent(inout) :: instance
	real(default), intent(in), optional :: safety_factor
	associate (mci => instance%mci)
	allocate (instance%vamp_x (mci%n_dim))
	instance%it = 0
	instance%calls = 0
	instance%generating_events = .true.
	if (present (safety_factor)) instance%safety_factor = safety_factor
	if (.not. instance%grids_defined) then
	if (mci%grid_filename_set) then
	if (.not. mci%check_grid_file) &
	call msg_warning ("Reading grid file: MD5 sum check disabled")
	call msg_message ("Simulate: " &
	// "using integration grids from file '" &
	// char (mci%grid_filename) // "'")
	call mci%read_grids_data (instance)
	if (instance%safety_factor /= 1) then
	write (msg_buffer, "(A,ES10.3,A)") "Simulate: &
	&applying safety factor", instance%safety_factor, &
	" to event rejection"
	call msg_message ()
	instance%grids%grids%f_max = &
	instance%grids%grids%f_max * instance%safety_factor
	end if
	else
	call msg_bug ("VAMP: simulation: no grids, no grid filename")
	end if
	end if
	end associate
	end subroutine mci_vamp_instance_init_simulation

	@ %def mci_vamp_init_simulation
	@ Finalize an event generation pass. Should be called before a sequence of
	events is generated, then we should call the corresponding finalizer.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: final_simulation => mci_vamp_instance_final_simulation
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_final_simulation (instance)
	class(mci_vamp_instance_t), intent(inout) :: instance
	if (allocated (instance%vamp_x)) deallocate (instance%vamp_x)
	end subroutine mci_vamp_instance_final_simulation

	@ %def mci_vamp_instance_final_simulation
	@
	\subsection{Sampling function}
	The VAMP sampling function has a well-defined interface which we have
	to implement. The [[data]] argument allows us to pass pointers to the
	[[sampler]] and [[instance]] objects, so we can access configuration
	data and fill point-dependent contents within these objects.

	The [[weights]] and [[channel]] argument must be present in the call.

	Note: we would normally declare the [[instance]] pointer with the
	concrete type, or just use the [[data]] component directly.
	Unfortunately, gfortran 4.6 forgets the inherited base-type methods in
	that case.

	Note: this is the place where we must look for external signals, i.e.,
	interrupt from the OS. We would like to raise a \vamp\ exception which is then
	caught by [[vamp_sample_grids]] as the caller, so it dumps its current state
	and returns (with the signal still pending). \whizard\ will then terminate
	gracefully. Of course, VAMP should be able to resume from the dump.

	In the current implementation, we handle the exception in place and terminate
	immediately. The incomplete current integration pass is lost.
	<<MCI vamp: procedures>>=
	function vamp_sampling_function &
	(xi, data, weights, channel, grids) result (f)
	real(default) :: f
	real(default), dimension(:), intent(in) :: xi
	class(vamp_data_t), intent(in) :: data
	real(default), dimension(:), intent(in), optional :: weights
	integer, intent(in), optional :: channel
	type(vamp_grid), dimension(:), intent(in), optional :: grids
	type(exception) :: exc
	class(mci_instance_t), pointer :: instance
	logical :: verbose
	character(*), parameter :: FN = "WHIZARD sampling function"
	select type (data)
	type is (mci_workspace_t)
	instance => data%instance
	select type (instance)
	class is (mci_vamp_instance_t)
	instance%calls = instance%calls + 1
	verbose = instance%mci%verbose
	end select
	call instance%evaluate (data%sampler, channel, xi)
	if (signal_is_pending ()) then
	call raise_exception (exc, EXC_FATAL, FN, "signal received")
	call handle_vamp_exception (exc, verbose)
	call terminate_now_if_signal ()
	end if
	f = instance%get_value ()
	end select
	end function vamp_sampling_function

	@ %def vamp_sampling_function
	@ This is supposed to be the mapping between integration channels.
	The VAMP event generating procedures technically require it, but it is
	meaningless in our setup where all transformations happen inside the
	sampler object. So, this implementation is trivial:
	<<MCI vamp: procedures>>=
	pure function phi_trivial (xi, channel_dummy) result (x)
	real(default), dimension(:), intent(in) :: xi
	integer, intent(in) :: channel_dummy
	real(default), dimension(size(xi)) :: x
	x = xi
	end function phi_trivial

	@ %def phi_trivial
	@
	\subsection{Integrator instance: evaluation}
	Here, we compute the multi-channel reweighting factor for the current
	channel, that accounts for the Jacobians of the transformations
	from/to all other channels.

	The computation of the VAMP probabilities may consume considerable
	time, therefore we enable parallel evaluation. (Collecting the
	contributions to [[mci%g]] is a reduction, which we should also
	implement via OpenMP.)
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: compute_weight => mci_vamp_instance_compute_weight
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_compute_weight (mci, c)
	class(mci_vamp_instance_t), intent(inout) :: mci
	integer, intent(in) :: c
	integer :: i
	mci%selected_channel = c
	!$OMP PARALLEL PRIVATE(i) SHARED(mci)
	!$OMP DO
	do i = 1, mci%mci%n_channel
	if (mci%w(i) /= 0) then
	mci%gi(i) = vamp_probability (mci%grids%grids(i), mci%x(:,i))
	else
	mci%gi(i) = 0
	end if
	end do
	!$OMP END DO
	!$OMP END PARALLEL
	mci%g = 0
	if (mci%gi(c) /= 0) then
	do i = 1, mci%mci%n_channel
	if (mci%w(i) /= 0 .and. mci%f(i) /= 0) then
	mci%g = mci%g + mci%w(i) * mci%gi(i) / mci%f(i)
	end if
	end do
	end if
	if (mci%g /= 0) then
	mci%mci_weight = mci%gi(c) / mci%g
	else
	mci%mci_weight = 0
	end if
	end subroutine mci_vamp_instance_compute_weight

	@ %def mci_vamp_instance_compute_weight
	@ Record the integrand.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: record_integrand => mci_vamp_instance_record_integrand
	<<MCI vamp: procedures>>=
	subroutine mci_vamp_instance_record_integrand (mci, integrand)
	class(mci_vamp_instance_t), intent(inout) :: mci
	real(default), intent(in) :: integrand
	mci%integrand = integrand
	end subroutine mci_vamp_instance_record_integrand

	@ %def mci_vamp_instance_record_integrand
	@ Get the event weight. The default routine returns the same value that
	we would use for integration. This is correct if we select the integration
	channel according to the channel weight. [[vamp_next_event]] does
	differently, so we should rather rely on the weight that VAMP
	returns. This is the value stored in [[vamp_weight]]. We override
	the default TBP accordingly.
	<<MCI vamp: mci vamp instance: TBP>>=
	procedure :: get_event_weight => mci_vamp_instance_get_event_weight
	procedure :: get_event_excess => mci_vamp_instance_get_event_excess
	<<MCI vamp: procedures>>=
	function mci_vamp_instance_get_event_weight (mci) result (value)
	class(mci_vamp_instance_t), intent(in) :: mci
	real(default) :: value
	if (mci%vamp_weight_set) then
	value = mci%vamp_weight
	else
	call msg_bug ("VAMP: attempt to read undefined event weight")
	end if
	end function mci_vamp_instance_get_event_weight

	function mci_vamp_instance_get_event_excess (mci) result (value)
	class(mci_vamp_instance_t), intent(in) :: mci
	real(default) :: value
	if (mci%vamp_weight_set) then
	value = mci%vamp_excess
	else
	call msg_bug ("VAMP: attempt to read undefined event excess weight")
	end if
	end function mci_vamp_instance_get_event_excess

	@ %def mci_vamp_instance_get_event_excess
	@
	\subsection{VAMP exceptions}
	A VAMP routine may have raised an exception. Turn this into a WHIZARD
	error message.

	An external signal could raise a fatal exception, but this should be delayed and
	handled by the correct termination routine.
	<<MCI vamp: procedures>>=
	subroutine handle_vamp_exception (exc, verbose)
	type(exception), intent(in) :: exc
	logical, intent(in) :: verbose
	integer :: exc_level
	if (verbose) then
	exc_level = EXC_INFO
	else
	exc_level = EXC_ERROR
	end if
	if (exc%level >= exc_level) then
	write (msg_buffer, "(A,':',1x,A)") trim (exc%origin), trim (exc%message)
	select case (exc%level)
	case (EXC_INFO); call msg_message ()
	case (EXC_WARN); call msg_warning ()
	case (EXC_ERROR); call msg_error ()
	case (EXC_FATAL)
	if (signal_is_pending ()) then
	call msg_message ()
	else
	call msg_fatal ()
	end if
	end select
	end if
	end subroutine handle_vamp_exception

	@ %def handle_vamp_exception
	@
	\subsection{Unit tests}
	<<MCI vamp: public>>=
	public :: mci_vamp_test
	<<MCI vamp: tests>>=
	subroutine mci_vamp_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<MCI vamp: execute tests>>
	end subroutine mci_vamp_test

	@ %def mci_vamp_test
	@
	\subsubsection{Test sampler}
	A test sampler object should implement a function with known integral that
	we can use to check the integrator.

	In mode [[1]], the function is $f(x) = 3 x^2$ with integral $\int_0^1
	f(x)\,dx=1$ and maximum $f(1)=3$. If the integration dimension is
	greater than one, the function is extended as a constant in the other
	dimension(s).

	In mode [[2]], the function is $11 x^{10}$, also with integral $1$.
	<<MCI vamp: test types>>=
	type, extends (mci_sampler_t) :: test_sampler_1_t
	real(default), dimension(:), allocatable :: x
	real(default) :: val
	integer :: mode = 1
	contains
	<<MCI vamp: test sampler 1: TBP>>
	end type test_sampler_1_t

	@ %def test_sampler_1_t
	@ Output: There is nothing stored inside, so just print an informative line.
	<<MCI vamp: test sampler 1: TBP>>=
	procedure :: write => test_sampler_1_write
	<<MCI vamp: tests>>=
	subroutine test_sampler_1_write (object, unit, testflag)
	class(test_sampler_1_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	select case (object%mode)
	case (1)
	write (u, "(1x,A)") "Test sampler: f(x) = 3 x^2"
	case (2)
	write (u, "(1x,A)") "Test sampler: f(x) = 11 x^10"
	case (3)
	write (u, "(1x,A)") "Test sampler: f(x) = 11 x^10 * 2 * cos^2 (2 pi y)"
	end select
	end subroutine test_sampler_1_write

	@ %def test_sampler_1_write
	@ Evaluation: compute the function value. The output $x$ parameter
	(only one channel) is identical to the input $x$, and the Jacobian is 1.
	<<MCI vamp: test sampler 1: TBP>>=
	procedure :: evaluate => test_sampler_1_evaluate
	<<MCI vamp: tests>>=
	subroutine test_sampler_1_evaluate (sampler, c, x_in, val, x, f)
	class(test_sampler_1_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
	if (allocated (sampler%x)) deallocate (sampler%x)
	allocate (sampler%x (size (x_in)))
	sampler%x = x_in
	select case (sampler%mode)
	case (1)
	sampler%val = 3 * x_in(1) ** 2
	case (2)
	sampler%val = 11 * x_in(1) ** 10
	case (3)
	sampler%val = 11 * x_in(1) ** 10 * 2 * cos (twopi * x_in(2)) ** 2
	end select
	call sampler%fetch (val, x, f)
	end subroutine test_sampler_1_evaluate

	@ %def test_sampler_1_evaluate
	@ The point is always valid.
	<<MCI vamp: test sampler 1: TBP>>=
	procedure :: is_valid => test_sampler_1_is_valid
	<<MCI vamp: tests>>=
	function test_sampler_1_is_valid (sampler) result (valid)
	class(test_sampler_1_t), intent(in) :: sampler
	logical :: valid
	valid = .true.
	end function test_sampler_1_is_valid

	@ %def test_sampler_1_is_valid
	@ Rebuild: compute all but the function value.
	<<MCI vamp: test sampler 1: TBP>>=
	procedure :: rebuild => test_sampler_1_rebuild
	<<MCI vamp: tests>>=
	subroutine test_sampler_1_rebuild (sampler, c, x_in, val, x, f)
	class(test_sampler_1_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
	if (allocated (sampler%x)) deallocate (sampler%x)
	allocate (sampler%x (size (x_in)))
	sampler%x = x_in
	sampler%val = val
	x(:,1) = sampler%x
	f = 1
	end subroutine test_sampler_1_rebuild

	@ %def test_sampler_1_rebuild
	@ Extract the results.
	<<MCI vamp: test sampler 1: TBP>>=
	procedure :: fetch => test_sampler_1_fetch
	<<MCI vamp: tests>>=
	subroutine test_sampler_1_fetch (sampler, val, x, f)
	class(test_sampler_1_t), intent(in) :: sampler
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	val = sampler%val
	x(:,1) = sampler%x
	f = 1
	end subroutine test_sampler_1_fetch

	@ %def test_sampler_1_fetch
	@
	\subsubsection{Two-channel, two dimension test sampler}
	This sampler implements the function
	\begin{equation}
	f(x, y) = 4\sin^2(\pi x)\sin^2(\pi y) + 2\sin^2(\pi v)
	\end{equation}
	where
	\begin{align}
	x &= u^v &u &= xy
	\\
	y &= u^{(1-v)} &v &= \frac12\left(1 + \frac{\log(x/y)}{\log xy}\right)
	\end{align}
	Each term contributes $1$ to the integral. The first term in the function is
	peaked along a cross aligned to the coordinates $x$ and $y$, while the second
	term is peaked along the diagonal $x=y$.

	The Jacobian is
	\begin{equation}
	\frac{\partial(x,y)}{\partial(u,v)} = \|\log u\|
	\end{equation}
	<<MCI vamp: test types>>=
	type, extends (mci_sampler_t) :: test_sampler_2_t
	real(default), dimension(:,:), allocatable :: x
	real(default), dimension(:), allocatable :: f
	real(default) :: val
	contains
	<<MCI vamp: test sampler 2: TBP>>
	end type test_sampler_2_t

	@ %def test_sampler_2_t
	@ Output: There is nothing stored inside, so just print an informative line.
	<<MCI vamp: test sampler 2: TBP>>=
	procedure :: write => test_sampler_2_write
	<<MCI vamp: tests>>=
	subroutine test_sampler_2_write (object, unit, testflag)
	class(test_sampler_2_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Two-channel test sampler 2"
	end subroutine test_sampler_2_write

	@ %def test_sampler_2_write
	@ Kinematics: compute $x$ and Jacobians, given the input parameter array.
	<<MCI vamp: test sampler 2: TBP>>=
	procedure :: compute => test_sampler_2_compute
	<<MCI vamp: tests>>=
	subroutine test_sampler_2_compute (sampler, c, x_in)
	class(test_sampler_2_t), intent(inout) :: sampler
	integer, intent(in) :: c
	real(default), dimension(:), intent(in) :: x_in
	real(default) :: xx, yy, uu, vv
	if (.not. allocated (sampler%x)) &
	allocate (sampler%x (size (x_in), 2))
	if (.not. allocated (sampler%f)) &
	allocate (sampler%f (2))
	select case (c)
	case (1)
	xx = x_in(1)
	yy = x_in(2)
	uu = xx * yy
	vv = (1 + log (xx/yy) / log (xx*yy)) / 2
	case (2)
	uu = x_in(1)
	vv = x_in(2)
	xx = uu ** vv
	yy = uu ** (1 - vv)
	end select
	sampler%val = (2 * sin (pi * xx) * sin (pi * yy)) ** 2 &
	+ 2 * sin (pi * vv) ** 2
	sampler%f(1) = 1
	sampler%f(2) = abs (log (uu))
	sampler%x(:,1) = [xx, yy]
	sampler%x(:,2) = [uu, vv]
	end subroutine test_sampler_2_compute

	@ %def test_sampler_kineamtics
	@ Evaluation: compute the function value. The output $x$ parameter
	(only one channel) is identical to the input $x$, and the Jacobian is 1.
	<<MCI vamp: test sampler 2: TBP>>=
	procedure :: evaluate => test_sampler_2_evaluate
	<<MCI vamp: tests>>=
	subroutine test_sampler_2_evaluate (sampler, c, x_in, val, x, f)
	class(test_sampler_2_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%compute (c, x_in)
	call sampler%fetch (val, x, f)
	end subroutine test_sampler_2_evaluate

	@ %def test_sampler_2_evaluate
	@ The point is always valid.
	<<MCI vamp: test sampler 2: TBP>>=
	procedure :: is_valid => test_sampler_2_is_valid
	<<MCI vamp: tests>>=
	function test_sampler_2_is_valid (sampler) result (valid)
	class(test_sampler_2_t), intent(in) :: sampler
	logical :: valid
	valid = .true.
	end function test_sampler_2_is_valid

	@ %def test_sampler_2_is_valid
	@ Rebuild: compute all but the function value.
	<<MCI vamp: test sampler 2: TBP>>=
	procedure :: rebuild => test_sampler_2_rebuild
	<<MCI vamp: tests>>=
	subroutine test_sampler_2_rebuild (sampler, c, x_in, val, x, f)
	class(test_sampler_2_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 sampler%compute (c, x_in)
	x = sampler%x
	f = sampler%f
	end subroutine test_sampler_2_rebuild

	@ %def test_sampler_2_rebuild
	@ Extract the results.
	<<MCI vamp: test sampler 2: TBP>>=
	procedure :: fetch => test_sampler_2_fetch
	<<MCI vamp: tests>>=
	subroutine test_sampler_2_fetch (sampler, val, x, f)
	class(test_sampler_2_t), intent(in) :: sampler
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	val = sampler%val
	x = sampler%x
	f = sampler%f
	end subroutine test_sampler_2_fetch

	@ %def test_sampler_2_fetch
	@
	\subsubsection{Two-channel, one dimension test sampler}
	This sampler implements the function
	\begin{equation}
	f(x, y) = a * 5 x^4 + b * 5 (1-x)^4
	\end{equation}
	Each term contributes $1$ to the integral, multiplied by $a$ or $b$,
	respectively. The first term is peaked at $x=1$, the second one at $x=0$..

	We implement the two mappings
	\begin{equation}
	x = u^{1/5} \quad\text{and}\quad x = 1 - v^{1/5},
	\end{equation}
	with Jacobians
	\begin{equation}
	\frac{\partial(x)}{\partial(u)} = u^{-4/5}/5 \quad\text{and}\quad v^{-4/5}/5,
	\end{equation}
	respectively. The first mapping concentrates points near $x=1$, the
	second one near $x=0$.
	<<MCI vamp: test types>>=
	type, extends (mci_sampler_t) :: test_sampler_3_t
	real(default), dimension(:,:), allocatable :: x
	real(default), dimension(:), allocatable :: f
	real(default) :: val
	real(default) :: a = 1
	real(default) :: b = 1
	contains
	<<MCI vamp: test sampler 3: TBP>>
	end type test_sampler_3_t

	@ %def test_sampler_3_t
	@ Output: display $a$ and $b$
	<<MCI vamp: test sampler 3: TBP>>=
	procedure :: write => test_sampler_3_write
	<<MCI vamp: tests>>=
	subroutine test_sampler_3_write (object, unit, testflag)
	class(test_sampler_3_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Two-channel test sampler 3"
	write (u, "(3x,A,F5.2)") "a = ", object%a
	write (u, "(3x,A,F5.2)") "b = ", object%b
	end subroutine test_sampler_3_write

	@ %def test_sampler_3_write
	@ Kinematics: compute $x$ and Jacobians, given the input parameter array.
	<<MCI vamp: test sampler 3: TBP>>=
	procedure :: compute => test_sampler_3_compute
	<<MCI vamp: tests>>=
	subroutine test_sampler_3_compute (sampler, c, x_in)
	class(test_sampler_3_t), intent(inout) :: sampler
	integer, intent(in) :: c
	real(default), dimension(:), intent(in) :: x_in
	real(default) :: u, v, xx
	if (.not. allocated (sampler%x)) &
	allocate (sampler%x (size (x_in), 2))
	if (.not. allocated (sampler%f)) &
	allocate (sampler%f (2))
	select case (c)
	case (1)
	u = x_in(1)
	xx = u ** 0.2_default
	v = (1 - xx) ** 5._default
	case (2)
	v = x_in(1)
	xx = 1 - v ** 0.2_default
	u = xx ** 5._default
	end select
	sampler%val = sampler%a * 5 * xx ** 4 + sampler%b * 5 * (1 - xx) ** 4
	sampler%f(1) = 0.2_default * u ** (-0.8_default)
	sampler%f(2) = 0.2_default * v ** (-0.8_default)
	sampler%x(:,1) = [u]
	sampler%x(:,2) = [v]
	end subroutine test_sampler_3_compute

	@ %def test_sampler_kineamtics
	@ Evaluation: compute the function value. The output $x$ parameter
	(only one channel) is identical to the input $x$, and the Jacobian is 1.
	<<MCI vamp: test sampler 3: TBP>>=
	procedure :: evaluate => test_sampler_3_evaluate
	<<MCI vamp: tests>>=
	subroutine test_sampler_3_evaluate (sampler, c, x_in, val, x, f)
	class(test_sampler_3_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%compute (c, x_in)
	call sampler%fetch (val, x, f)
	end subroutine test_sampler_3_evaluate

	@ %def test_sampler_3_evaluate
	@ The point is always valid.
	<<MCI vamp: test sampler 3: TBP>>=
	procedure :: is_valid => test_sampler_3_is_valid
	<<MCI vamp: tests>>=
	function test_sampler_3_is_valid (sampler) result (valid)
	class(test_sampler_3_t), intent(in) :: sampler
	logical :: valid
	valid = .true.
	end function test_sampler_3_is_valid

	@ %def test_sampler_3_is_valid
	@ Rebuild: compute all but the function value.
	<<MCI vamp: test sampler 3: TBP>>=
	procedure :: rebuild => test_sampler_3_rebuild
	<<MCI vamp: tests>>=
	subroutine test_sampler_3_rebuild (sampler, c, x_in, val, x, f)
	class(test_sampler_3_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 sampler%compute (c, x_in)
	x = sampler%x
	f = sampler%f
	end subroutine test_sampler_3_rebuild

	@ %def test_sampler_3_rebuild
	@ Extract the results.
	<<MCI vamp: test sampler 3: TBP>>=
	procedure :: fetch => test_sampler_3_fetch
	<<MCI vamp: tests>>=
	subroutine test_sampler_3_fetch (sampler, val, x, f)
	class(test_sampler_3_t), intent(in) :: sampler
	real(default), intent(out) :: val
	real(default), dimension(:,:), intent(out) :: x
	real(default), dimension(:), intent(out) :: f
	val = sampler%val
	x = sampler%x
	f = sampler%f
	end subroutine test_sampler_3_fetch

	@ %def test_sampler_3_fetch
	@
	\subsubsection{One-dimensional integration}
	Construct an integrator and use it for a one-dimensional sampler.

	Note: We would like to check the precise contents of the grid
	allocated during integration, but the output format for reals is very
	long (for good reasons), so the last digits in the grid content
	display are numerical noise. So, we just check the integration
	results.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_1, "mci_vamp_1", &
	"one-dimensional integral", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_1 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_vamp_1"
	write (u, "(A)") "* Purpose: integrate function in one dimension &
	&(single channel)"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (1, 1)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize instance"
	write (u, "(A)")

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Initialize test sampler"
	write (u, "(A)")

	allocate (test_sampler_1_t :: sampler)
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_calls = 1000"
	write (u, "(A)") " (lower precision to avoid"
	write (u, "(A)") " numerical noise)"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass ()
	end select
	call mci%integrate (mci_instance, sampler, 1, 1000, pacify = .true.)
	call mci%write (u, .true.)

	write (u, "(A)")
	write (u, "(A)") "* Contents of mci_instance:"
	write (u, "(A)")

	call mci_instance%write (u, .true.)

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

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_1

	@ %def mci_vamp_1
	@
	\subsubsection{Multiple iterations}
	Construct an integrator and use it for a one-dimensional sampler.
	Integrate with five iterations without grid adaptation.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_2, "mci_vamp_2", &
	"multiple iterations", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_2 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_vamp_2"
	write (u, "(A)") "* Purpose: integrate function in one dimension &
	&(single channel)"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (1, 1)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_1_t :: sampler)
	select type (sampler)
	type is (test_sampler_1_t)
	sampler%mode = 2
	end select
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 100"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_grids = .false.)
	end select
	call mci%integrate (mci_instance, sampler, 3, 100)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Contents of mci_instance:"
	write (u, "(A)")

	call mci_instance%write (u)

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

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_2

	@ %def mci_vamp_2
	@
	\subsubsection{Grid adaptation}
	Construct an integrator and use it for a one-dimensional sampler.
	Integrate with three iterations and in-between grid adaptations.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_3, "mci_vamp_3", &
	"grid adaptation", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_3 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_vamp_3"
	write (u, "(A)") "* Purpose: integrate function in one dimension &
	&(single channel)"
	write (u, "(A)") "* and adapt grid"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (1, 1)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_1_t :: sampler)
	select type (sampler)
	type is (test_sampler_1_t)
	sampler%mode = 2
	end select
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 100"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_grids = .true.)
	end select
	call mci%integrate (mci_instance, sampler, 3, 100)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Contents of mci_instance:"
	write (u, "(A)")

	call mci_instance%write (u)

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

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_3

	@ %def mci_vamp_3
	@
	\subsubsection{Two-dimensional integral}
	Construct an integrator and use it for a two-dimensional sampler.
	Integrate with three iterations and in-between grid adaptations.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_4, "mci_vamp_4", &
	"two-dimensional integration", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_4 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_vamp_4"
	write (u, "(A)") "* Purpose: integrate function in two dimensions &
	&(single channel)"
	write (u, "(A)") "* and adapt grid"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (2, 1)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_1_t :: sampler)
	select type (sampler)
	type is (test_sampler_1_t)
	sampler%mode = 3
	end select
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_grids = .true.)
	end select
	call mci%integrate (mci_instance, sampler, 3, 1000)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Contents of mci_instance:"
	write (u, "(A)")

	call mci_instance%write (u)

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

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_4

	@ %def mci_vamp_4
	@
	\subsubsection{Two-channel integral}
	Construct an integrator and use it for a two-dimensional sampler with two
	channels.

	Integrate with three iterations and in-between grid adaptations.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_5, "mci_vamp_5", &
	"two-dimensional integration", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_5 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_vamp_5"
	write (u, "(A)") "* Purpose: integrate function in two dimensions &
	&(two channels)"
	write (u, "(A)") "* and adapt grid"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (2, 2)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%stratified = .false.
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_2_t :: sampler)
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_grids = .true.)
	end select
	call mci%integrate (mci_instance, sampler, 3, 1000)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Contents of mci_instance:"
	write (u, "(A)")

	call mci_instance%write (u)

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

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_5

	@ %def mci_vamp_5
	@
	\subsubsection{Weight adaptation}
	Construct an integrator and use it for a one-dimensional sampler with two
	channels.

	Integrate with three iterations and in-between weight adaptations.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_6, "mci_vamp_6", &
	"weight adaptation", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_6 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_vamp_6"
	write (u, "(A)") "* Purpose: integrate function in one dimension &
	&(two channels)"
	write (u, "(A)") "* and adapt weights"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (1, 2)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%stratified = .false.
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_3_t :: sampler)
	select type (sampler)
	type is (test_sampler_3_t)
	sampler%a = 0.9_default
	sampler%b = 0.1_default
	end select
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_weights = .true.)
	end select
	call mci%integrate (mci_instance, sampler, 3, 1000)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Contents of mci_instance:"
	write (u, "(A)")

	call mci_instance%write (u)

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

	call mci_instance%final ()
	call mci%final ()
	deallocate (mci_instance)
	deallocate (mci)

	write (u, "(A)")
	write (u, "(A)") "* Re-initialize with chained channels"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (1, 2)
	call mci%declare_chains ([1,1])
	select type (mci)
	type is (mci_vamp_t)
	grid_par%stratified = .false.
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_weights = .true.)
	end select
	call mci%integrate (mci_instance, sampler, 3, 1000)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Contents of mci_instance:"
	write (u, "(A)")

	call mci_instance%write (u)

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

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_6

	@ %def mci_vamp_6
	@
	\subsubsection{Equivalences}
	Construct an integrator and use it for a one-dimensional sampler with two
	channels.

	Integrate with three iterations and in-between grid adaptations.
	Apply an equivalence between the two channels, so the binning of the
	two channels is forced to coincide. Compare this with the behavior
	without equivalences.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_7, "mci_vamp_7", &
	"use channel equivalences", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_7 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	type(phs_channel_t), dimension(:), allocatable :: channel
	class(rng_t), allocatable :: rng
	real(default), dimension(:,:), allocatable :: x
	integer :: u_grid, iostat, i, div, ch
	character(16) :: buffer

	write (u, "(A)") "* Test output: mci_vamp_7"
	write (u, "(A)") "* Purpose: check effect of channel equivalences"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (1, 2)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%stratified = .false.
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_3_t :: sampler)
	select type (sampler)
	type is (test_sampler_3_t)
	sampler%a = 0.7_default
	sampler%b = 0.3_default
	end select
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_it = 2 and n_calls = 1000, &
	&adapt grids"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_grids = .true.)
	end select
	call mci%integrate (mci_instance, sampler, 2, 1000)

	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write grids and extract binning"
	write (u, "(A)")

	u_grid = free_unit ()
	open (u_grid, status = "scratch", action = "readwrite")
	select type (mci_instance)
	type is (mci_vamp_instance_t)
	call vamp_write_grids (mci_instance%grids, u_grid)
	end select
	rewind (u_grid)
	allocate (x (0:20, 2))
	do div = 1, 2
	FIND_BINS1: do
	read (u_grid, "(A)") buffer
	if (trim (adjustl (buffer)) == "begin d%x") then
	do
	read (u_grid, *, iostat = iostat) i, x(i,div)
	if (iostat /= 0) exit FIND_BINS1
	end do
	end if
	end do FIND_BINS1
	end do
	close (u_grid)

	write (u, "(1x,A,L1)") "Equal binning in both channels = ", &
	all (x(:,1) == x(:,2))
	deallocate (x)

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

	call mci_instance%final ()
	call mci%final ()
	deallocate (mci_instance)
	deallocate (mci)

	write (u, "(A)")
	write (u, "(A)") "* Re-initialize integrator, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (1, 2)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%stratified = .false.
	grid_par%use_vamp_equivalences = .true.
	call mci%set_grid_parameters (grid_par)
	end select

	write (u, "(A)") "* Define equivalences"
	write (u, "(A)")

	allocate (channel (2))
	do ch = 1, 2
	allocate (channel(ch)%eq (2))
	do i = 1, 2
	associate (eq => channel(ch)%eq(i))
	call eq%init (1)
	eq%c = i
	eq%perm = [1]
	eq%mode = [0]
	end associate
	end do
	write (u, "(1x,I0,':')", advance = "no") ch
	call channel(ch)%write (u)
	end do
	call mci%declare_equivalences (channel, dim_offset = 0)

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_it = 2 and n_calls = 1000, &
	&adapt grids"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_grids = .true.)
	end select
	call mci%integrate (mci_instance, sampler, 2, 1000)

	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write grids and extract binning"
	write (u, "(A)")

	u_grid = free_unit ()
	open (u_grid, status = "scratch", action = "readwrite")
	select type (mci_instance)
	type is (mci_vamp_instance_t)
	call vamp_write_grids (mci_instance%grids, u_grid)
	end select
	rewind (u_grid)
	allocate (x (0:20, 2))
	do div = 1, 2
	FIND_BINS2: do
	read (u_grid, "(A)") buffer
	if (trim (adjustl (buffer)) == "begin d%x") then
	do
	read (u_grid, *, iostat = iostat) i, x(i,div)
	if (iostat /= 0) exit FIND_BINS2
	end do
	end if
	end do FIND_BINS2
	end do
	close (u_grid)

	write (u, "(1x,A,L1)") "Equal binning in both channels = ", &
	all (x(:,1) == x(:,2))
	deallocate (x)


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

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_7

	@ %def mci_vamp_7
	@
	\subsubsection{Multiple passes}
	Integrate with three passes and different settings for weight and grid
	adaptation.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_8, "mci_vamp_8", &
	"integration passes", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_8 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_vamp_8"
	write (u, "(A)") "* Purpose: integrate function in one dimension &
	&(two channels)"
	write (u, "(A)") "* in three passes"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (1, 2)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%stratified = .false.
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_3_t :: sampler)
	select type (sampler)
	type is (test_sampler_3_t)
	sampler%a = 0.9_default
	sampler%b = 0.1_default
	end select
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with grid and weight adaptation"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_grids = .true., adapt_weights = .true.)
	end select
	call mci%integrate (mci_instance, sampler, 3, 1000)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Contents of mci_instance:"
	write (u, "(A)")

	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with grid adaptation"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_grids = .true.)
	end select
	call mci%integrate (mci_instance, sampler, 3, 1000)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Contents of mci_instance:"
	write (u, "(A)")

	call mci_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate without adaptation"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass ()
	end select
	call mci%integrate (mci_instance, sampler, 3, 1000)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Contents of mci_instance:"
	write (u, "(A)")

	call mci_instance%write (u)

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

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_8

	@ %def mci_vamp_8
	@
	\subsubsection{Weighted events}
	Construct an integrator and use it for a two-dimensional sampler with two
	channels. Integrate and generate a weighted event.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_9, "mci_vamp_9", &
	"weighted event", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_9 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_vamp_9"
	write (u, "(A)") "* Purpose: integrate function in two dimensions &
	&(two channels)"
	write (u, "(A)") "* and generate a weighted event"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (2, 2)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%stratified = .false.
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_2_t :: sampler)
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
	write (u, "(A)")

	call mci%add_pass ()
	call mci%integrate (mci_instance, sampler, 1, 1000)
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate a weighted event"
	write (u, "(A)")

	call mci_instance%init_simulation ()
	call mci%generate_weighted_event (mci_instance, sampler)

	write (u, "(1x,A)") "MCI instance:"
	call mci_instance%write (u)

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

	call mci_instance%final_simulation ()
	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_9

	@ %def mci_vamp_9
	@
	\subsubsection{Grids I/O}
	Construct an integrator and allocate grids. Write grids to file, read
	them in again and compare.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_10, "mci_vamp_10", &
	"grids I/O", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_10 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng
	type(string_t) :: file1, file2
	character(80) :: buffer1, buffer2
	integer :: u1, u2, iostat1, iostat2
	logical :: equal, success

	write (u, "(A)") "* Test output: mci_vamp_10"
	write (u, "(A)") "* Purpose: write and read VAMP grids"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (2, 2)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%stratified = .false.
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	mci%md5sum = "1234567890abcdef1234567890abcdef"

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_2_t :: sampler)
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
	write (u, "(A)")

	call mci%add_pass ()
	call mci%integrate (mci_instance, sampler, 1, 1000)

	write (u, "(A)") "* Write grids to file"
	write (u, "(A)")

	file1 = "mci_vamp_10.1"
	select type (mci)
	type is (mci_vamp_t)
	call mci%set_grid_filename (file1)
	call mci%write_grids (mci_instance)
	end select

	call mci_instance%final ()
	call mci%final ()
	deallocate (mci)

	write (u, "(A)") "* Read grids from file"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (2, 2)
	select type (mci)
	type is (mci_vamp_t)
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	mci%md5sum = "1234567890abcdef1234567890abcdef"

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	select type (mci)
	type is (mci_vamp_t)
	call mci%set_grid_filename (file1)
	call mci%add_pass ()
	call mci%current_pass%configure (1, 1000, &
	mci%min_calls, &
	mci%grid_par%min_bins, mci%grid_par%max_bins, &
	mci%grid_par%min_calls_per_channel * mci%n_channel)
	call mci%read_grids_header (success)
	call mci%compute_md5sum ()
	call mci%read_grids_data (mci_instance, read_integrals = .true.)
	end select
	write (u, "(1x,A,L1)") "success = ", success

	write (u, "(A)")
	write (u, "(A)") "* Write grids again"
	write (u, "(A)")

	file2 = "mci_vamp_10.2"
	select type (mci)
	type is (mci_vamp_t)
	call mci%set_grid_filename (file2)
	call mci%write_grids (mci_instance)
	end select

	u1 = free_unit ()
	open (u1, file = char (file1) // ".vg", action = "read", status = "old")
	u2 = free_unit ()
	open (u2, file = char (file2) // ".vg", action = "read", status = "old")

	equal = .true.
	iostat1 = 0
	iostat2 = 0
	do while (equal .and. iostat1 == 0 .and. iostat2 == 0)
	read (u1, "(A)", iostat = iostat1) buffer1
	read (u2, "(A)", iostat = iostat2) buffer2
	equal = buffer1 == buffer2 .and. iostat1 == iostat2
	end do
	close (u1)
	close (u2)

	if (equal) then
	write (u, "(1x,A)") "Success: grid files are identical"
	else
	write (u, "(1x,A)") "Failure: grid files differ"
	end if

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

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_10

	@ %def mci_vamp_10
	@
	\subsubsection{Weighted events}
	Construct an integrator and use it for a two-dimensional sampler with two
	channels. Integrate, write grids, and generate a weighted event using
	the grids from file.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_11, "mci_vamp_11", &
	"weighted events with grid I/O", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_11 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_vamp_11"
	write (u, "(A)") "* Purpose: integrate function in two dimensions &
	&(two channels)"
	write (u, "(A)") "* and generate a weighted event"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (2, 2)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%stratified = .false.
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	call mci%set_grid_filename (var_str ("mci_vamp_11"))
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_2_t :: sampler)

	write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
	write (u, "(A)")

	call mci%add_pass ()
	call mci%integrate (mci_instance, sampler, 1, 1000)

	write (u, "(A)") "* Reset instance"
	write (u, "(A)")

	call mci_instance%final ()
	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Generate a weighted event"
	write (u, "(A)")

	call mci_instance%init_simulation ()
	call mci%generate_weighted_event (mci_instance, sampler)

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

	call mci_instance%final_simulation ()
	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_11

	@ %def mci_vamp_11
	@
	\subsubsection{Weighted events}
	Construct an integrator and use it for a two-dimensional sampler with two
	channels. Integrate, write grids, and generate a weighted event using
	the grids from file.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_12, "mci_vamp_12", &
	"unweighted events with grid I/O", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_12 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_vamp_12"
	write (u, "(A)") "* Purpose: integrate function in two dimensions &
	&(two channels)"
	write (u, "(A)") "* and generate an unweighted event"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (2, 2)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%stratified = .false.
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	call mci%set_grid_filename (var_str ("mci_vamp_12"))
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_2_t :: sampler)

	write (u, "(A)") "* Integrate with n_it = 3 and n_calls = 1000"
	write (u, "(A)")

	call mci%add_pass ()
	call mci%integrate (mci_instance, sampler, 1, 1000)

	write (u, "(A)") "* Reset instance"
	write (u, "(A)")

	call mci_instance%final ()
	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	write (u, "(A)") "* Generate an unweighted event"
	write (u, "(A)")

	call mci_instance%init_simulation ()
	call mci%generate_unweighted_event (mci_instance, sampler)

	write (u, "(1x,A)") "MCI instance:"
	call mci_instance%write (u)

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

	call mci_instance%final_simulation ()
	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_12

	@ %def mci_vamp_12
	@
	\subsubsection{Update integration results}
	Compare two [[mci]] objects; match the two and update the first if
	successful.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_13, "mci_vamp_13", &
	"updating integration results", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_13 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci, mci_ref
	logical :: success

	write (u, "(A)") "* Test output: mci_vamp_13"
	write (u, "(A)") "* Purpose: match and update integrators"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator with no passes"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (2, 2)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%stratified = .false.
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	end select
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize reference"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci_ref)
	call mci_ref%set_dimensions (2, 2)
	select type (mci_ref)
	type is (mci_vamp_t)
	call mci_ref%set_grid_parameters (grid_par)
	end select

	select type (mci_ref)
	type is (mci_vamp_t)
	call mci_ref%add_pass (adapt_grids = .true.)
	call mci_ref%current_pass%configure (2, 1000, 0, 1, 5, 0)
	mci_ref%current_pass%calls = [77, 77]
	mci_ref%current_pass%integral = [1.23_default, 3.45_default]
	mci_ref%current_pass%error = [0.23_default, 0.45_default]
	mci_ref%current_pass%efficiency = [0.1_default, 0.6_default]
	mci_ref%current_pass%integral_defined = .true.

	call mci_ref%add_pass ()
	call mci_ref%current_pass%configure (2, 2000, 0, 1, 7, 0)
	mci_ref%current_pass%calls = [99, 0]
	mci_ref%current_pass%integral = [7.89_default, 0._default]
	mci_ref%current_pass%error = [0.89_default, 0._default]
	mci_ref%current_pass%efficiency = [0.86_default, 0._default]
	mci_ref%current_pass%integral_defined = .true.
	end select

	call mci_ref%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Update integrator (no-op, should succeed)"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%update_from_ref (mci_ref, success)
	end select

	write (u, "(1x,A,L1)") "success = ", success
	write (u, "(A)")
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Add pass to integrator"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_grids = .true.)
	call mci%current_pass%configure (2, 1000, 0, 1, 5, 0)
	mci%current_pass%calls = [77, 77]
	mci%current_pass%integral = [1.23_default, 3.45_default]
	mci%current_pass%error = [0.23_default, 0.45_default]
	mci%current_pass%efficiency = [0.1_default, 0.6_default]
	mci%current_pass%integral_defined = .true.
	end select

	write (u, "(A)") "* Update integrator (no-op, should succeed)"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%update_from_ref (mci_ref, success)
	end select

	write (u, "(1x,A,L1)") "success = ", success
	write (u, "(A)")
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Add pass to integrator, wrong parameters"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass ()
	call mci%current_pass%configure (2, 1000, 0, 1, 7, 0)
	end select

	write (u, "(A)") "* Update integrator (should fail)"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%update_from_ref (mci_ref, success)
	end select

	write (u, "(1x,A,L1)") "success = ", success
	write (u, "(A)")
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reset and add passes to integrator"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%reset ()
	call mci%add_pass (adapt_grids = .true.)
	call mci%current_pass%configure (2, 1000, 0, 1, 5, 0)
	mci%current_pass%calls = [77, 77]
	mci%current_pass%integral = [1.23_default, 3.45_default]
	mci%current_pass%error = [0.23_default, 0.45_default]
	mci%current_pass%efficiency = [0.1_default, 0.6_default]
	mci%current_pass%integral_defined = .true.

	call mci%add_pass ()
	call mci%current_pass%configure (2, 2000, 0, 1, 7, 0)
	end select

	write (u, "(A)") "* Update integrator (should succeed)"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%update_from_ref (mci_ref, success)
	end select

	write (u, "(1x,A,L1)") "success = ", success
	write (u, "(A)")
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Update again (no-op, should succeed)"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%update_from_ref (mci_ref, success)
	end select

	write (u, "(1x,A,L1)") "success = ", success
	write (u, "(A)")
	call mci%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Add extra result to integrator"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	mci%current_pass%calls(2) = 1234
	end select

	write (u, "(A)") "* Update integrator (should fail)"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%update_from_ref (mci_ref, success)
	end select

	write (u, "(1x,A,L1)") "success = ", success
	write (u, "(A)")
	call mci%write (u)

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

	call mci%final ()
	call mci_ref%final ()

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

	end subroutine mci_vamp_13

	@ %def mci_vamp_13
	@
	\subsubsection{Accuracy Goal}
	Integrate with multiple iterations. Skip iterations once an accuracy goal has
	been reached.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_14, "mci_vamp_14", &
	"accuracy goal", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_14 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_vamp_14"
	write (u, "(A)") "* Purpose: integrate function in one dimension &
	&(single channel)"
	write (u, "(A)") "* and check accuracy goal"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (1, 1)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%use_vamp_equivalences = .false.
	grid_par%accuracy_goal = 5E-2_default
	call mci%set_grid_parameters (grid_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_1_t :: sampler)
	select type (sampler)
	type is (test_sampler_1_t)
	sampler%mode = 2
	end select
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_it = 5 and n_calls = 100"
	write (u, "(A)")

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_grids = .true.)
	end select
	call mci%integrate (mci_instance, sampler, 5, 100)
	call mci%write (u)

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

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_14

	@ %def mci_vamp_14
	@
	\subsubsection{VAMP history}
	Integrate with three passes and different settings for weight and grid
	adaptation. Then show the VAMP history.
	<<MCI vamp: execute tests>>=
	call test (mci_vamp_15, "mci_vamp_15", &
	"VAMP history", &
	u, results)
	<<MCI vamp: tests>>=
	subroutine mci_vamp_15 (u)
	integer, intent(in) :: u
	type(grid_parameters_t) :: grid_par
	type(history_parameters_t) :: history_par
	class(mci_t), allocatable, target :: mci
	class(mci_instance_t), pointer :: mci_instance => null ()
	class(mci_sampler_t), allocatable :: sampler
	class(rng_t), allocatable :: rng

	write (u, "(A)") "* Test output: mci_vamp_15"
	write (u, "(A)") "* Purpose: integrate function in one dimension &
	&(two channels)"
	write (u, "(A)") "* in three passes, show history"

	write (u, "(A)")
	write (u, "(A)") "* Initialize integrator, sampler, instance"
	write (u, "(A)")

	history_par%channel = .true.

	allocate (mci_vamp_t :: mci)
	call mci%set_dimensions (1, 2)
	select type (mci)
	type is (mci_vamp_t)
	grid_par%stratified = .false.
	grid_par%use_vamp_equivalences = .false.
	call mci%set_grid_parameters (grid_par)
	call mci%set_history_parameters (history_par)
	end select

	allocate (rng_tao_t :: rng)
	call rng%init ()
	call mci%import_rng (rng)

	call mci%allocate_instance (mci_instance)
	call mci_instance%init (mci)

	allocate (test_sampler_3_t :: sampler)
	select type (sampler)
	type is (test_sampler_3_t)
	sampler%a = 0.9_default
	sampler%b = 0.1_default
	end select
	call sampler%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Pass 1: grid and weight adaptation"

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_grids = .true., adapt_weights = .true.)
	end select
	call mci%integrate (mci_instance, sampler, 3, 1000)

	write (u, "(A)")
	write (u, "(A)") "* Pass 2: grid adaptation"

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass (adapt_grids = .true.)
	end select
	call mci%integrate (mci_instance, sampler, 3, 1000)

	write (u, "(A)")
	write (u, "(A)") "* Pass 3: without adaptation"

	select type (mci)
	type is (mci_vamp_t)
	call mci%add_pass ()
	end select
	call mci%integrate (mci_instance, sampler, 3, 1000)

	write (u, "(A)")
	write (u, "(A)") "* Contents of MCI record, with history"
	write (u, "(A)")

	call mci%write (u)
	select type (mci)
	type is (mci_vamp_t)
	call mci%write_history (u)
	end select

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

	call mci_instance%final ()
	call mci%final ()

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

	end subroutine mci_vamp_15

	@ %def mci_vamp_15

File Metadata

Mime Type: text/x-tex
Expires: Sat, Dec 21, 3:46 PM (1 d, 6 h)
Storage Engine: blob
Storage Format: Raw Data
Storage Handle: 4023337
Default Alt Text: mci.nw (336 KB)

mci.nwNo OneTemporaryActions

mci.nwView Options

File Metadata

Event Timeline

mci.nw
No OneTemporary
Actions

mci.nw
View Options