whizard.nw
No OneTemporary
Actions

Size

989 KB

Subscribers

None

whizard.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 main code as NOWEB source

	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{User-controlled File I/O}

	The SINDARIN language includes commands that write output to file (input may
	be added later). We identify files by their name, and manage the unit
	internally. We need procedures for opening, closing, and printing files.

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

	module user_files

	<<Use strings>>
	use io_units
	use diagnostics
	use ifiles
	use analysis

	<<Standard module head>>

	<<User files: public>>

	<<User files: types>>

	<<User files: interfaces>>

	contains

	<<User files: procedures>>

	end module user_files
	@ %def user_files
	@
	\subsection{The file type}
	This is a type that describes an open user file and its properties. The entry
	is part of a doubly-linked list.
	<<User files: types>>=
	type :: file_t
	private
	type(string_t) :: name
	integer :: unit = -1
	logical :: reading = .false.
	logical :: writing = .false.
	type(file_t), pointer :: prev => null ()
	type(file_t), pointer :: next => null ()
	end type file_t

	@ %def file_t
	@ The initializer opens the file.
	<<User files: procedures>>=
	subroutine file_init (file, name, action, status, position)
	type(file_t), intent(out) :: file
	type(string_t), intent(in) :: name
	character(len=*), intent(in) :: action, status, position
	file%unit = free_unit ()
	file%name = name
	open (unit = file%unit, file = char (file%name), &
	action = action, status = status, position = position)
	select case (action)
	case ("read")
	file%reading = .true.
	case ("write")
	file%writing = .true.
	case ("readwrite")
	file%reading = .true.
	file%writing = .true.
	end select
	end subroutine file_init

	@ %def file_init
	@ The finalizer closes it.
	<<User files: procedures>>=
	subroutine file_final (file)
	type(file_t), intent(inout) :: file
	close (unit = file%unit)
	file%unit = -1
	end subroutine file_final

	@ %def file_init
	@ Check if a file is open with correct status.
	<<User files: procedures>>=
	function file_is_open (file, action) result (flag)
	logical :: flag
	type(file_t), intent(in) :: file
	character(*), intent(in) :: action
	select case (action)
	case ("read")
	flag = file%reading
	case ("write")
	flag = file%writing
	case ("readwrite")
	flag = file%reading .and. file%writing
	case default
	call msg_bug ("Checking file '" // char (file%name) &
	// "': illegal action specifier")
	end select
	end function file_is_open

	@ %def file_is_open
	@ Write to the file. Error if in wrong mode. If there is no string, just
	write an empty record. If there is a string, respect the [[advancing]]
	option.
	<<User files: procedures>>=
	subroutine file_write_string (file, string, advancing)
	type(file_t), intent(in) :: file
	type(string_t), intent(in), optional :: string
	logical, intent(in), optional :: advancing
	if (file%writing) then
	if (present (string)) then
	if (present (advancing)) then
	if (advancing) then
	write (file%unit, "(A)") char (string)
	else
	write (file%unit, "(A)", advance="no") char (string)
	end if
	else
	write (file%unit, "(A)") char (string)
	end if
	else
	write (file%unit, *)
	end if
	else
	call msg_error ("Writing to file: File '" // char (file%name) &
	// "' is not open for writing.")
	end if
	end subroutine file_write_string

	@ %def file_write
	@ Write a whole ifile, line by line.
	<<User files: procedures>>=
	subroutine file_write_ifile (file, ifile)
	type(file_t), intent(in) :: file
	type(ifile_t), intent(in) :: ifile
	type(line_p) :: line
	call line_init (line, ifile)
	do while (line_is_associated (line))
	call file_write_string (file, line_get_string_advance (line))
	end do
	end subroutine file_write_ifile

	@ %def file_write_ifile
	@ Write an analysis object (or all objects) to an open file.
	<<User files: procedures>>=
	subroutine file_write_analysis (file, tag)
	type(file_t), intent(in) :: file
	type(string_t), intent(in), optional :: tag
	if (file%writing) then
	if (present (tag)) then
	call analysis_write (tag, unit = file%unit)
	else
	call analysis_write (unit = file%unit)
	end if
	else
	call msg_error ("Writing analysis to file: File '" // char (file%name) &
	// "' is not open for writing.")
	end if
	end subroutine file_write_analysis

	@ %def file_write_analysis
	@
	\subsection{The file list}
	We maintain a list of all open files and their attributes. The list must be
	doubly-linked because we may delete entries.
	<<User files: public>>=
	public :: file_list_t
	<<User files: types>>=
	type :: file_list_t
	type(file_t), pointer :: first => null ()
	type(file_t), pointer :: last => null ()
	end type file_list_t

	@ %def file_list_t
	@ There is no initialization routine, but a finalizer which deletes all:
	<<User files: public>>=
	public :: file_list_final
	<<User files: procedures>>=
	subroutine file_list_final (file_list)
	type(file_list_t), intent(inout) :: file_list
	type(file_t), pointer :: current
	do while (associated (file_list%first))
	current => file_list%first
	file_list%first => current%next
	call file_final (current)
	deallocate (current)
	end do
	file_list%last => null ()
	end subroutine file_list_final

	@ %def file_list_final
	@ Find an entry in the list. Return null pointer on failure.
	<<User files: procedures>>=
	function file_list_get_file_ptr (file_list, name) result (current)
	type(file_t), pointer :: current
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	current => file_list%first
	do while (associated (current))
	if (current%name == name) return
	current => current%next
	end do
	end function file_list_get_file_ptr

	@ %def file_list_get_file_ptr
	@ Check if a file is open, public version:
	<<User files: public>>=
	public :: file_list_is_open
	<<User files: procedures>>=
	function file_list_is_open (file_list, name, action) result (flag)
	logical :: flag
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	character(len=*), intent(in) :: action
	type(file_t), pointer :: current
	current => file_list_get_file_ptr (file_list, name)
	if (associated (current)) then
	flag = file_is_open (current, action)
	else
	flag = .false.
	end if
	end function file_list_is_open

	@ %def file_list_is_open
	@ Append a new file entry, i.e., open this file. Error if it is
	already open.
	<<User files: public>>=
	public :: file_list_open
	<<User files: procedures>>=
	subroutine file_list_open (file_list, name, action, status, position)
	type(file_list_t), intent(inout) :: file_list
	type(string_t), intent(in) :: name
	character(len=*), intent(in) :: action, status, position
	type(file_t), pointer :: current
	if (.not. associated (file_list_get_file_ptr (file_list, name))) then
	allocate (current)
	call msg_message ("Opening file '" // char (name) // "' for output")
	call file_init (current, name, action, status, position)
	if (associated (file_list%last)) then
	file_list%last%next => current
	current%prev => file_list%last
	else
	file_list%first => current
	end if
	file_list%last => current
	else
	call msg_error ("Opening file: File '" // char (name) &
	// "' is already open.")
	end if
	end subroutine file_list_open

	@ %def file_list_open
	@ Delete a file entry, i.e., close this file. Error if it is not open.
	<<User files: public>>=
	public :: file_list_close
	<<User files: procedures>>=
	subroutine file_list_close (file_list, name)
	type(file_list_t), intent(inout) :: file_list
	type(string_t), intent(in) :: name
	type(file_t), pointer :: current
	current => file_list_get_file_ptr (file_list, name)
	if (associated (current)) then
	if (associated (current%prev)) then
	current%prev%next => current%next
	else
	file_list%first => current%next
	end if
	if (associated (current%next)) then
	current%next%prev => current%prev
	else
	file_list%last => current%prev
	end if
	call msg_message ("Closing file '" // char (name) // "' for output")
	call file_final (current)
	deallocate (current)
	else
	call msg_error ("Closing file: File '" // char (name) &
	// "' is not open.")
	end if
	end subroutine file_list_close

	@ %def file_list_close
	@ Write a string to file. Error if it is not open.
	<<User files: public>>=
	public :: file_list_write
	<<User files: interfaces>>=
	interface file_list_write
	module procedure file_list_write_string
	module procedure file_list_write_ifile
	end interface
	<<User files: procedures>>=
	subroutine file_list_write_string (file_list, name, string, advancing)
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: string
	logical, intent(in), optional :: advancing
	type(file_t), pointer :: current
	current => file_list_get_file_ptr (file_list, name)
	if (associated (current)) then
	call file_write_string (current, string, advancing)
	else
	call msg_error ("Writing to file: File '" // char (name) &
	// "'is not open.")
	end if
	end subroutine file_list_write_string

	subroutine file_list_write_ifile (file_list, name, ifile)
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	type(ifile_t), intent(in) :: ifile
	type(file_t), pointer :: current
	current => file_list_get_file_ptr (file_list, name)
	if (associated (current)) then
	call file_write_ifile (current, ifile)
	else
	call msg_error ("Writing to file: File '" // char (name) &
	// "'is not open.")
	end if
	end subroutine file_list_write_ifile

	@ %def file_list_write
	@ Write an analysis object or all objects to data file. Error if it is not
	open. If the file name is empty, write to standard output.
	<<User files: public>>=
	public :: file_list_write_analysis
	<<User files: procedures>>=
	subroutine file_list_write_analysis (file_list, name, tag)
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: tag
	type(file_t), pointer :: current
	if (name == "") then
	if (present (tag)) then
	call analysis_write (tag)
	else
	call analysis_write
	end if
	else
	current => file_list_get_file_ptr (file_list, name)
	if (associated (current)) then
	call file_write_analysis (current, tag)
	else
	call msg_error ("Writing analysis to file: File '" // char (name) &
	// "' is not open.")
	end if
	end if
	end subroutine file_list_write_analysis

	@ %def file_list_write_analysis
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Runtime data}

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

	module rt_data

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_utils, only: write_separator
	use format_defs, only: FMT_19, FMT_12
	use system_dependencies
	use diagnostics
	use os_interface
	use lexers
	use parser
	use physics_defs, only: LAMBDA_QCD_REF
	use models
	use jets
	use subevents
	use pdg_arrays
	use variables
	use process_libraries
	use prclib_stacks
	use prc_core, only: helicity_selection_t
	use beam_structures
	use event_base, only: event_callback_t
	use user_files
	use process_stacks
	use iterations

	<<Standard module head>>

	<<RT data: public>>

	<<RT data: types>>

	contains

	<<RT data: procedures>>

	end module rt_data
	@ %def rt_data
	@
	\subsection{Strategy for models and variables}
	The program manages its data via a main [[rt_data_t]] object. During program
	flow, various commands create and use local [[rt_data_t]] objects. Those
	transient blocks contain either pointers to global object or local copies
	which are deleted after use.

	Each [[rt_data_t]] object contains a variable list component. This lists
	holds (local copies of) all kinds of intrinsic or user-defined variables. The
	variable list is linked to the variable list contained in the local process
	library. This, in turn, is linked to the variable list of the [[rt_data_t]]
	context, and so on.

	A variable lookup will thus be recursively delegated to the linked variable
	lists, until a match is found. When modifying a variable which is not yet
	local, the program creates a local copy and uses this afterwards. Thus, when
	the local [[rt_data_t]] object is deleted, the context value is recovered.

	Models are kept in a model list which is separate from the variable list.
	Otherwise, they are treated in a similar manner: the local list is linked to
	the context model list. Model lookup is thus recursively delegated. When a
	model or any part of it is modified, the model is copied to the local
	[[rt_data_t]] object, so the context model is not modified. Commands such as
	[[integrate]] will create their own copy of the current model (and of the
	current variable list) at the point where they are executed.

	When a model is encountered for the first time, it is read from file. The
	reading is automatically delegated to the global context. Thus, this master
	copy survives until the main [[rt_data_t]] object is deleted, at program
	completion.

	If there is a currently active model, its variable list is linked to the main
	variable list. Variable lookups will then start from the model variable
	list. When the current model is switched, the new active model will get this
	link instead. Consequently, a change to the current model is kept as long as
	this model has a local copy; it survives local model switches. On the other
	hand, a parameter change in the current model doesn't affect any other model,
	even if the parameter name is identical.
	@
	\subsection{Container for parse nodes}
	The runtime data set contains a bunch of parse nodes (chunks of code
	that have not been compiled into evaluation trees but saved for later
	use). We collect them here.

	This implementation has the useful effect that an assignment between two
	objects of this type will establish a pointer-target relationship for
	all components.
	<<RT data: types>>=
	type :: rt_parse_nodes_t
	type(parse_node_t), pointer :: cuts_lexpr => null ()
	type(parse_node_t), pointer :: scale_expr => null ()
	type(parse_node_t), pointer :: fac_scale_expr => null ()
	type(parse_node_t), pointer :: ren_scale_expr => null ()
	type(parse_node_t), pointer :: weight_expr => null ()
	type(parse_node_t), pointer :: selection_lexpr => null ()
	type(parse_node_t), pointer :: reweight_expr => null ()
	type(parse_node_t), pointer :: analysis_lexpr => null ()
	type(parse_node_p), dimension(:), allocatable :: alt_setup
	contains
	<<RT data: rt parse nodes: TBP>>
	end type rt_parse_nodes_t

	@ %def rt_parse_nodes_t
	@ Clear individual components. The parse nodes are nullified. No
	finalization needed since the pointer targets are part of the global
	parse tree.
	<<RT data: rt parse nodes: TBP>>=
	procedure :: clear => rt_parse_nodes_clear
	<<RT data: procedures>>=
	subroutine rt_parse_nodes_clear (rt_pn, name)
	class(rt_parse_nodes_t), intent(inout) :: rt_pn
	type(string_t), intent(in) :: name
	select case (char (name))
	case ("cuts")
	rt_pn%cuts_lexpr => null ()
	case ("scale")
	rt_pn%scale_expr => null ()
	case ("factorization_scale")
	rt_pn%fac_scale_expr => null ()
	case ("renormalization_scale")
	rt_pn%ren_scale_expr => null ()
	case ("weight")
	rt_pn%weight_expr => null ()
	case ("selection")
	rt_pn%selection_lexpr => null ()
	case ("reweight")
	rt_pn%reweight_expr => null ()
	case ("analysis")
	rt_pn%analysis_lexpr => null ()
	end select
	end subroutine rt_parse_nodes_clear

	@ %def rt_parse_nodes_clear
	@ Output for the parse nodes.
	<<RT data: rt parse nodes: TBP>>=
	procedure :: write => rt_parse_nodes_write
	<<RT data: procedures>>=
	subroutine rt_parse_nodes_write (object, unit)
	class(rt_parse_nodes_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	call wrt ("Cuts", object%cuts_lexpr)
	call write_separator (u)
	call wrt ("Scale", object%scale_expr)
	call write_separator (u)
	call wrt ("Factorization scale", object%fac_scale_expr)
	call write_separator (u)
	call wrt ("Renormalization scale", object%ren_scale_expr)
	call write_separator (u)
	call wrt ("Weight", object%weight_expr)
	call write_separator (u, 2)
	call wrt ("Event selection", object%selection_lexpr)
	call write_separator (u)
	call wrt ("Event reweighting factor", object%reweight_expr)
	call write_separator (u)
	call wrt ("Event analysis", object%analysis_lexpr)
	if (allocated (object%alt_setup)) then
	call write_separator (u, 2)
	write (u, "(1x,A,':')") "Alternative setups"
	do i = 1, size (object%alt_setup)
	call write_separator (u)
	call wrt ("Commands", object%alt_setup(i)%ptr)
	end do
	end if
	contains
	subroutine wrt (title, pn)
	character(*), intent(in) :: title
	type(parse_node_t), intent(in), pointer :: pn
	if (associated (pn)) then
	write (u, "(1x,A,':')") title
	call write_separator (u)
	call parse_node_write_rec (pn, u)
	else
	write (u, "(1x,A,':',1x,A)") title, "[undefined]"
	end if
	end subroutine wrt
	end subroutine rt_parse_nodes_write

	@ %def rt_parse_nodes_write
	@ Screen output for individual components. (This should eventually be more
	condensed, currently we print the internal representation tree.)
	<<RT data: rt parse nodes: TBP>>=
	procedure :: show => rt_parse_nodes_show
	<<RT data: procedures>>=
	subroutine rt_parse_nodes_show (rt_pn, name, unit)
	class(rt_parse_nodes_t), intent(in) :: rt_pn
	type(string_t), intent(in) :: name
	integer, intent(in), optional :: unit
	type(parse_node_t), pointer :: pn
	integer :: u
	u = given_output_unit (unit)
	select case (char (name))
	case ("cuts")
	pn => rt_pn%cuts_lexpr
	case ("scale")
	pn => rt_pn%scale_expr
	case ("factorization_scale")
	pn => rt_pn%fac_scale_expr
	case ("renormalization_scale")
	pn => rt_pn%ren_scale_expr
	case ("weight")
	pn => rt_pn%weight_expr
	case ("selection")
	pn => rt_pn%selection_lexpr
	case ("reweight")
	pn => rt_pn%reweight_expr
	case ("analysis")
	pn => rt_pn%analysis_lexpr
	end select
	if (associated (pn)) then
	write (u, "(A,1x,A,1x,A)") "Expression:", char (name), "(parse tree):"
	call parse_node_write_rec (pn, u)
	else
	write (u, "(A,1x,A,A)") "Expression:", char (name), ": [undefined]"
	end if
	end subroutine rt_parse_nodes_show

	@ %def rt_parse_nodes_show
	@
	\subsection{The data type}
	This is a big data container which contains everything that is used and
	modified during the command flow. A local copy of this can be used to
	temporarily override defaults. The data set is transparent.
	<<RT data: public>>=
	public :: rt_data_t
	<<RT data: types>>=
	type :: rt_data_t
	type(lexer_t), pointer :: lexer => null ()
	type(rt_data_t), pointer :: context => null ()
	type(var_list_t) :: var_list
	type(iterations_list_t) :: it_list
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(model_t), pointer :: model => null ()
	logical :: model_is_copy = .false.
	type(model_t), pointer :: preload_model => null ()
	type(model_t), pointer :: fallback_model => null ()
	type(model_t), pointer :: radiation_model => null ()
	type(prclib_stack_t) :: prclib_stack
	type(process_library_t), pointer :: prclib => null ()
	type(beam_structure_t) :: beam_structure
	type(rt_parse_nodes_t) :: pn
	type(process_stack_t) :: process_stack
	type(string_t), dimension(:), allocatable :: sample_fmt
	class(event_callback_t), allocatable :: event_callback
	type(file_list_t), pointer :: out_files => null ()
	logical :: quit = .false.
	integer :: quit_code = 0
	type(string_t) :: logfile
	logical :: nlo_fixed_order = .false.
	logical, dimension(0:5) :: selected_nlo_parts = .false.
	contains
	<<RT data: rt data: TBP>>
	end type rt_data_t

	@ %def rt_data_t
	@
	\subsection{Output}
	<<RT data: rt data: TBP>>=
	procedure :: write => rt_data_write
	<<RT data: procedures>>=
	subroutine rt_data_write (object, unit, vars, pacify)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	type(string_t), dimension(:), intent(in), optional :: vars
	logical, intent(in), optional :: pacify
	integer :: u, i
	u = given_output_unit (unit)
	call write_separator (u, 2)
	write (u, "(1x,A)") "Runtime data:"
	if (present (vars)) then
	if (size (vars) /= 0) then
	call write_separator (u, 2)
	write (u, "(1x,A)") "Selected variables:"
	call write_separator (u)
	call object%write_vars (u, vars)
	end if
	else
	call write_separator (u, 2)
	if (associated (object%model)) then
	call object%model%write_var_list (u, follow_link=.true.)
	else
	call var_list_write (object%var_list, u, follow_link=.true.)
	end if
	end if
	if (object%it_list%get_n_pass () > 0) then
	call write_separator (u, 2)
	write (u, "(1x)", advance="no")
	call object%it_list%write (u)
	end if
	if (associated (object%model)) then
	call write_separator (u, 2)
	call object%model%write (u)
	end if
	call object%prclib_stack%write (u)
	call object%beam_structure%write (u)
	call write_separator (u, 2)
	call object%pn%write (u)
	if (allocated (object%sample_fmt)) then
	call write_separator (u)
	write (u, "(1x,A)", advance="no") "Event sample formats = "
	do i = 1, size (object%sample_fmt)
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (object%sample_fmt(i))
	end do
	write (u, "(A)")
	end if
	call write_separator (u)
	write (u, "(1x,A)", advance="no") "Event callback:"
	if (allocated (object%event_callback)) then
	call object%event_callback%write (u)
	else
	write (u, "(1x,A)") "[undefined]"
	end if
	call object%process_stack%write (u, pacify)
	write (u, "(1x,A,1x,L1)") "quit :", object%quit
	write (u, "(1x,A,1x,I0)") "quit_code:", object%quit_code
	call write_separator (u, 2)
	write (u, "(1x,A,1x,A)") "Logfile :", "'" // trim (char (object%logfile)) // "'"
	call write_separator (u, 2)
	end subroutine rt_data_write

	@ %def rt_data_write
	@ Write only selected variables.
	<<RT data: rt data: TBP>>=
	procedure :: write_vars => rt_data_write_vars
	<<RT data: procedures>>=
	subroutine rt_data_write_vars (object, unit, vars)
	class(rt_data_t), intent(in), target :: object
	integer, intent(in), optional :: unit
	type(string_t), dimension(:), intent(in), optional :: vars
	type(var_list_t), pointer :: var_list
	integer :: u, i
	u = given_output_unit (unit)
	if (present (vars)) then
	var_list => object%get_var_list_ptr ()
	do i = 1, size (vars)
	associate (var => vars(i))
	if (var_list%contains (var, follow_link=.true.)) then
	call var_list_write_var (var_list, var, unit = u, &
	follow_link = .true.)
	end if
	end associate
	end do
	end if
	end subroutine rt_data_write_vars

	@ %def rt_data_write_vars
	@ Write only the model list.
	<<RT data: rt data: TBP>>=
	procedure :: write_model_list => rt_data_write_model_list
	<<RT data: procedures>>=
	subroutine rt_data_write_model_list (object, unit)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	call object%model_list%write (u)
	end subroutine rt_data_write_model_list

	@ %def rt_data_write_model_list
	@ Write only the library stack.
	<<RT data: rt data: TBP>>=
	procedure :: write_libraries => rt_data_write_libraries
	<<RT data: procedures>>=
	subroutine rt_data_write_libraries (object, unit, libpath)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: libpath
	integer :: u
	u = given_output_unit (unit)
	call object%prclib_stack%write (u, libpath)
	end subroutine rt_data_write_libraries

	@ %def rt_data_write_libraries
	@ Write only the beam data.
	<<RT data: rt data: TBP>>=
	procedure :: write_beams => rt_data_write_beams
	<<RT data: procedures>>=
	subroutine rt_data_write_beams (object, unit)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call object%beam_structure%write (u)
	call write_separator (u, 2)
	end subroutine rt_data_write_beams

	@ %def rt_data_write_beams
	@ Write only the process and event expressions.
	<<RT data: rt data: TBP>>=
	procedure :: write_expr => rt_data_write_expr
	<<RT data: procedures>>=
	subroutine rt_data_write_expr (object, unit)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call object%pn%write (u)
	call write_separator (u, 2)
	end subroutine rt_data_write_expr

	@ %def rt_data_write_expr
	@ Write only the process stack.
	<<RT data: rt data: TBP>>=
	procedure :: write_process_stack => rt_data_write_process_stack
	<<RT data: procedures>>=
	subroutine rt_data_write_process_stack (object, unit)
	class(rt_data_t), intent(in) :: object
	integer, intent(in), optional :: unit
	call object%process_stack%write (unit)
	end subroutine rt_data_write_process_stack

	@ %def rt_data_write_process_stack
	@
	\subsection{Clear}
	The [[clear]] command can remove the contents of various subobjects.
	The objects themselves should stay.
	<<RT data: rt data: TBP>>=
	procedure :: clear_beams => rt_data_clear_beams
	<<RT data: procedures>>=
	subroutine rt_data_clear_beams (global)
	class(rt_data_t), intent(inout) :: global
	call global%beam_structure%final_sf ()
	call global%beam_structure%final_pol ()
	call global%beam_structure%final_mom ()
	end subroutine rt_data_clear_beams

	@ %def rt_data_clear_beams
	@
	\subsection{Initialization}
	Initialize runtime data. This defines special variables such as
	[[sqrts]], and should be done only for the instance that is actually
	global. Local copies will inherit the special variables.

	We link the global variable list to the process stack variable list,
	so the latter is always available (and kept global).
	<<RT data: rt data: TBP>>=
	procedure :: global_init => rt_data_global_init
	<<RT data: procedures>>=
	subroutine rt_data_global_init (global, paths, logfile)
	class(rt_data_t), intent(out), target :: global
	type(paths_t), intent(in), optional :: paths
	type(string_t), intent(in), optional :: logfile
	logical, target, save :: known = .true.
	integer :: seed
	real(default), parameter :: real_specimen = 1.
	call os_data_init (global%os_data, paths)
	if (present (logfile)) then
	global%logfile = logfile
	else
	global%logfile = ""
	end if
	allocate (global%out_files)
	call system_clock (seed)
	call var_list_append_log_ptr &
	(global%var_list, var_str ("?logging"), logging, known, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("seed"), seed, &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$model_name"), &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("process_num_id"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$method"), var_str ("omega"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?report_progress"), .true., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$restrictions"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$omega_flags"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?read_color_factors"), .true., &
	intrinsic=.true.)
	!!! JRR: WK please check (#529)
	! call var_list_append_string &
	! (global%var_list, var_str ("$user_procs_cut"), var_str (""), &
	! intrinsic=.true.)
	! call var_list_append_string &
	! (global%var_list, var_str ("$user_procs_event_shape"), var_str (""), &
	! intrinsic=.true.)
	! call var_list_append_string &
	! (global%var_list, var_str ("$user_procs_obs1"), var_str (""), &
	! intrinsic=.true.)
	! call var_list_append_string &
	! (global%var_list, var_str ("$user_procs_obs2"), var_str (""), &
	! intrinsic=.true.)
	! call var_list_append_string &
	! (global%var_list, var_str ("$user_procs_sf"), var_str (""), &
	! intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?slha_read_input"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?slha_read_spectrum"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?slha_read_decays"), .false., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$library_name"), &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("sqrts"), &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("luminosity"), 0._default, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?sf_trace"), .false., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$sf_trace_file"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?sf_allow_s_mapping"), .true., &
	intrinsic=.true.)
	if (present (paths)) then
	call var_list_append_string &
	(global%var_list, var_str ("$lhapdf_dir"), paths%lhapdfdir, &
	intrinsic=.true.)
	else
	call var_list_append_string &
	(global%var_list, var_str ("$lhapdf_dir"), var_str(""), &
	intrinsic=.true.)
	end if
	call var_list_append_string &
	(global%var_list, var_str ("$lhapdf_file"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$lhapdf_photon_file"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("lhapdf_member"), 0, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("lhapdf_photon_scheme"), 0, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?hoppet_b_matching"), .false., &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("isr_alpha"), 0._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("isr_q_max"), 0._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("isr_mass"), 0._default, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("isr_order"), 3, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?isr_recoil"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?isr_keep_energy"), .false., &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("epa_alpha"), 0._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("epa_x_min"), 0._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("epa_q_min"), 0._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("epa_e_max"), 0._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("epa_mass"), 0._default, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?epa_recoil"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?epa_keep_energy"), .false., &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("ewa_x_min"), 0._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("ewa_pt_max"), 0._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("ewa_mass"), 0._default, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?ewa_recoil"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?ewa_keep_energy"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?circe1_photon1"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?circe1_photon2"), .false., &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("circe1_sqrts"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?circe1_generate"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?circe1_map"), .true., &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("circe1_mapping_slope"), 2._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("circe1_eps"), 1e-5_default, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("circe1_ver"), 0, intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("circe1_rev"), 0, intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$circe1_acc"), var_str ("SBAND"), &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("circe1_chat"), 0, intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?circe1_with_radiation"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?circe2_polarized"), .true., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$circe2_file"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$circe2_design"), var_str ("*"), &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("gaussian_spread1"), 0._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("gaussian_spread2"), 0._default, &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$beam_events_file"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?beam_events_warn_eof"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?energy_scan_normalize"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?alpha_s_is_fixed"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?alpha_s_from_lhapdf"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?alpha_s_from_pdf_builtin"), .false., &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("alpha_s_order"), 0, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("alpha_s_nf"), 5, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?alpha_s_from_mz"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?alpha_s_from_lambda_qcd"), .false., &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("lambda_qcd"), 200.e-3_default, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?fatal_beam_decay"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?helicity_selection_active"), .true., &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("helicity_selection_threshold"), &
	1E10_default, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("helicity_selection_cutoff"), 1000, &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$rng_method"), var_str ("tao"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$integration_method"), var_str ("vamp"), &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("threshold_calls"), 10, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("min_calls_per_channel"), 10, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("min_calls_per_bin"), 10, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("min_bins"), 3, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("max_bins"), 20, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?stratified"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?use_vamp_equivalences"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?vamp_verbose"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?vamp_history_global"), &
	.true., intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?vamp_history_global_verbose"), &
	.false., intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?vamp_history_channels"), &
	.false., intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?vamp_history_channels_verbose"), &
	.false., intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("channel_weights_power"), 0.25_default, &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$phs_method"), var_str ("default"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?vis_channels"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?check_phs_file"), .true., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$phs_file"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?phs_only"), .false., &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("phs_threshold_s"), 50._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("phs_threshold_t"), 100._default, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("phs_off_shell"), 2, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("phs_t_channel"), 6, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("phs_e_scale"), 10._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("phs_m_scale"), 10._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("phs_q_scale"), 10._default, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?phs_keep_nonresonant"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?phs_step_mapping"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?phs_step_mapping_exp"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?phs_s_mapping"), .true., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$run_id"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("n_calls_test"), 0, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?integration_timer"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?check_grid_file"), .true., &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("accuracy_goal"), 0._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("error_goal"), 0._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("relative_error_goal"), 0._default, &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("error_threshold"), &
	0._default, intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?vis_history"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?vis_diags"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?vis_diags_color"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?check_event_file"), .true., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$event_file_version"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("n_events"), 0, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?unweighted"), .true., &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("safety_factor"), 1._default, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?negative_weights"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?keep_beams"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?keep_remnants"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?recover_beams"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?update_event"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?update_sqme"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?update_weight"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?use_alpha_s_from_file"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?use_scale_from_file"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?allow_decays"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?auto_decays"), .false., &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("auto_decays_multiplicity"), 2, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?auto_decays_radiative"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?decay_rest_frame"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?isotropic_decay"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?diagonal_decay"), .false., &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("decay_helicity"), &
	intrinsic=.true.)
	call set_eio_defaults ()
	call var_list_append_int (global%var_list, &
	var_str ("n_bins"), 20, &
	intrinsic=.true.)
	call var_list_append_log (global%var_list, &
	var_str ("?normalize_bins"), .false., &
	intrinsic=.true.)
	call var_list_append_string (global%var_list, &
	var_str ("$obs_label"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_string (global%var_list, &
	var_str ("$obs_unit"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_string (global%var_list, &
	var_str ("$title"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_string (global%var_list, &
	var_str ("$description"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_string (global%var_list, &
	var_str ("$x_label"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_string (global%var_list, &
	var_str ("$y_label"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("graph_width_mm"), 130, &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("graph_height_mm"), 90, &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?y_log"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?x_log"), .false., &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("x_min"), &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("x_max"), &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("y_min"), &
	intrinsic=.true.)
	call var_list_append_real &
	(global%var_list, var_str ("y_max"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$gmlcode_bg"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$gmlcode_fg"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?draw_histogram"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?draw_base"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?draw_piecewise"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?fill_curve"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?draw_curve"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?draw_errors"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?draw_symbols"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$fill_options"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$draw_options"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$err_options"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$symbol"), &
	intrinsic=.true.)
	call var_list_append_log (global%var_list, &
	var_str ("?analysis_file_only"), .false., &
	intrinsic=.true.)
	call var_list_append_real (global%var_list, &
	var_str ("tolerance"), 0._default, &
	intrinsic=.true.)
	call var_list_append_int (global%var_list, &
	var_str ("checkpoint"), 0, &
	intrinsic = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("event_callback_interval"), 0, &
	intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?pacify"), .false., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$out_file"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?out_advance"), .true., &
	intrinsic=.true.)
	!!! JRR: WK please check (#542)
	! call var_list_append_log &
	! (global%var_list, var_str ("?out_custom"), .false., &
	! intrinsic=.true.)
	! call var_list_append_string &
	! (global%var_list, var_str ("$out_comment"), var_str ("# "), &
	! intrinsic=.true.)
	! call var_list_append_log &
	! (global%var_list, var_str ("?out_header"), .true., &
	! intrinsic=.true.)
	! call var_list_append_log &
	! (global%var_list, var_str ("?out_yerr"), .true., &
	! intrinsic=.true.)
	! call var_list_append_log &
	! (global%var_list, var_str ("?out_xerr"), .true., &
	! intrinsic=.true.)
	call var_list_append_int (global%var_list, var_str ("real_range"), &
	range (real_specimen), intrinsic = .true., locked = .true.)
	call var_list_append_int (global%var_list, var_str ("real_precision"), &
	precision (real_specimen), intrinsic = .true., locked = .true.)
	call var_list_append_real (global%var_list, var_str ("real_epsilon"), &
	epsilon (real_specimen), intrinsic = .true., locked = .true.)
	call var_list_append_real (global%var_list, var_str ("real_tiny"), &
	tiny (real_specimen), intrinsic = .true., locked = .true.)
	!!! FastJet parameters
	call var_list_append_int (global%var_list, &
	var_str ("kt_algorithm"), &
	kt_algorithm, &
	intrinsic = .true., locked = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("cambridge_algorithm"), &
	cambridge_algorithm, intrinsic = .true., locked = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("antikt_algorithm"), &
	antikt_algorithm, &
	intrinsic = .true., locked = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("genkt_algorithm"), &
	genkt_algorithm, &
	intrinsic = .true., locked = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("cambridge_for_passive_algorithm"), &
	cambridge_for_passive_algorithm, &
	intrinsic = .true., locked = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("genkt_for_passive_algorithm"), &
	genkt_for_passive_algorithm, &
	intrinsic = .true., locked = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("ee_kt_algorithm"), &
	ee_kt_algorithm, &
	intrinsic = .true., locked = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("ee_genkt_algorithm"), &
	ee_genkt_algorithm, &
	intrinsic = .true., locked = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("plugin_algorithm"), &
	plugin_algorithm, &
	intrinsic = .true., locked = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("undefined_jet_algorithm"), &
	undefined_jet_algorithm, &
	intrinsic = .true., locked = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("jet_algorithm"), undefined_jet_algorithm, &
	intrinsic = .true.)
	call var_list_append_real (global%var_list, &
	var_str ("jet_r"), 0._default, &
	intrinsic = .true.)
	call var_list_append_real (global%var_list, &
	var_str ("jet_p"), 0._default, &
	intrinsic = .true.)
	call var_list_append_real (global%var_list, &
	var_str ("jet_ycut"), 0._default, &
	intrinsic = .true.)
	call var_list_append_log (global%var_list, &
	var_str ("?keep_flavors_when_clustering"), .false., &
	intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?polarized_events"), .false., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$polarization_mode"), &
	var_str ("helicity"), &
	intrinsic=.true.)
	call set_shower_defaults ()
	call set_tauola_defaults ()
	call set_hadronization_defaults ()
	call set_mlm_matching_defaults ()
	call set_powheg_matching_defaults ()
	call var_list_append_log &
	(global%var_list, var_str ("?ckkw_matching"), .false., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$pdf_builtin_set"), var_str ("CTEQ6L"), &
	intrinsic=.true.)
	call set_openmp_defaults ()
	call set_nlo_defaults ()
	call global%init_pointer_variables ()
	call global%process_stack%init_var_list (global%var_list)

	contains

	<<RT data: global init: procedures>>

	end subroutine rt_data_global_init

	@ %def rt_data_global_init
	@
	<<RT data: global init: procedures>>=
	subroutine set_eio_defaults ()
	call var_list_append_string &
	(global%var_list, var_str ("$sample"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$sample_normalization"), var_str ("auto"),&
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?sample_pacify"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?sample_select"), .true., &
	intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("sample_max_tries"), 10000, &
	intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("sample_split_n_evt"), 0, &
	intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("sample_split_n_kbytes"), 0, &
	intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("sample_split_index"), 0, &
	intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$rescan_input_format"), var_str ("raw"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?read_raw"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?write_raw"), .true., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_raw"), var_str ("evx"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_default"), var_str ("evt"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$debug_extension"), var_str ("debug"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?debug_process"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?debug_transforms"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?debug_decay"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?debug_verbose"), .true., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$dump_extension"), var_str ("pset"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?dump_compressed"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?dump_weights"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?dump_summary"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?dump_screen"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?hepevt_ensure_order"), .false., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_hepevt"), var_str ("hepevt"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_ascii_short"), &
	var_str ("short.evt"), intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_ascii_long"), &
	var_str ("long.evt"), intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_athena"), &
	var_str ("athena.evt"), intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_mokka"), &
	var_str ("mokka.evt"), intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$lhef_version"), var_str ("2.0"), &
	intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$lhef_extension"), var_str ("lhe"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?lhef_write_sqme_prc"), .true., &
	intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?lhef_write_sqme_ref"), .false., &
	intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?lhef_write_sqme_alt"), .true., &
	intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_lha"), var_str ("lha"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_hepmc"), var_str ("hepmc"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?hepmc_output_cross_section"), .false., &
	intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_lcio"), var_str ("slcio"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_stdhep"), var_str ("hep"), &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_stdhep_up"), &
	var_str ("up.hep"), intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_stdhep_ev4"), &
	var_str ("ev4.hep"), intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_hepevt_verb"), &
	var_str ("hepevt.verb"), intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$extension_lha_verb"), &
	var_str ("lha.verb"), intrinsic=.true.)
	end subroutine set_eio_defaults
	@
	<<RT data: global init: procedures>>=
	subroutine set_shower_defaults ()
	call var_list_append_log &
	(global%var_list, var_str ("?allow_shower"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?ps_fsr_active"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?ps_isr_active"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?ps_taudec_active"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?muli_active"), .false., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$shower_method"), var_str ("WHIZARD"), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?shower_verbose"), .false., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$ps_PYTHIA_PYGIVE"), var_str (""), &
	intrinsic=.true.)
	call var_list_append_real (global%var_list, &
	var_str ("ps_mass_cutoff"), 1._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, &
	var_str ("ps_fsr_lambda"), 0.29_default, intrinsic = .true.)
	call var_list_append_real (global%var_list, &
	var_str ("ps_isr_lambda"), 0.29_default, intrinsic = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("ps_max_n_flavors"), 5, intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?ps_isr_alpha_s_running"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?ps_fsr_alpha_s_running"), .true., &
	intrinsic=.true.)
	call var_list_append_real (global%var_list, var_str ("ps_fixed_alpha_s"), &
	0._default, intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?ps_isr_pt_ordered"), .false., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?ps_isr_angular_ordered"), .true., &
	intrinsic=.true.)
	call var_list_append_real (global%var_list, var_str &
	("ps_isr_primordial_kt_width"), 0._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("ps_isr_primordial_kt_cutoff"), 5._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("ps_isr_z_cutoff"), 0.999_default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("ps_isr_minenergy"), 1._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("ps_isr_tscalefactor"), 1._default, intrinsic = .true.)
	call var_list_append_log (global%var_list, var_str &
	("?ps_isr_only_onshell_emitted_partons"), .false., intrinsic=.true.)
	end subroutine set_shower_defaults

	@ %def set_shower_default
	@
	<<RT data: global init: procedures>>=
	subroutine set_tauola_defaults ()
	call var_list_append_log (global%var_list, &
	var_str ("?ps_tauola_photos"), .false., intrinsic=.true.)
	call var_list_append_log (global%var_list, &
	var_str ("?ps_tauola_transverse"), .false., intrinsic=.true.)
	call var_list_append_log (global%var_list, &
	var_str ("?ps_tauola_dec_rad_cor"), .true., intrinsic=.true.)
	call var_list_append_int (global%var_list, &
	var_str ("ps_tauola_dec_mode1"), 0, intrinsic = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("ps_tauola_dec_mode2"), 0, intrinsic = .true.)
	call var_list_append_real (global%var_list, &
	var_str ("ps_tauola_mh"), 125._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, &
	var_str ("ps_tauola_mix_angle"), 90._default, intrinsic = .true.)
	call var_list_append_log (global%var_list, &
	var_str ("?ps_tauola_pol_vector"), .false., intrinsic = .true.)
	end subroutine set_tauola_defaults

	@ %def set_tauola_defaults
	@
	<<RT data: global init: procedures>>=
	subroutine set_mlm_matching_defaults ()
	call var_list_append_log &
	(global%var_list, var_str ("?mlm_matching"), .false., &
	intrinsic=.true.)
	call var_list_append_real (global%var_list, var_str &
	("mlm_Qcut_ME"), 0._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("mlm_Qcut_PS"), 0._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("mlm_ptmin"), 0._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("mlm_etamax"), 0._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("mlm_Rmin"), 0._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("mlm_Emin"), 0._default, intrinsic = .true.)
	call var_list_append_int (global%var_list, var_str &
	("mlm_nmaxMEjets"), 0, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("mlm_ETclusfactor"), 0.2_default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("mlm_ETclusminE"), 5._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("mlm_etaclusfactor"), 1._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("mlm_Rclusfactor"), 1._default, intrinsic = .true.)
	call var_list_append_real (global%var_list, var_str &
	("mlm_Eclusfactor"), 1._default, intrinsic = .true.)

	end subroutine set_mlm_matching_defaults
	@
	<<RT data: global init: procedures>>=
	subroutine set_powheg_matching_defaults ()
	call var_list_append_log &
	(global%var_list, var_str ("?powheg_matching"), &
	.false., intrinsic = .true.)
	call var_list_append_real &
	(global%var_list, var_str ("powheg_damping_scale"), &
	10._default, intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?powheg_use_singular_jacobian"), &
	.false., intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("powheg_grid_size_xi"), &
	5, intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("powheg_grid_size_y"), &
	5, intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("powheg_grid_sampling_points"), &
	500000, intrinsic = .true.)
	call var_list_append_real &
	(global%var_list, var_str ("powheg_pt_min"), &
	1._default, intrinsic = .true.)
	call var_list_append_real &
	(global%var_list, var_str ("powheg_lambda"), &
	LAMBDA_QCD_REF, intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?powheg_rebuild_grids"), &
	.false., intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?powheg_use_damping"), &
	.false., intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?powheg_test_sudakov"), &
	.false., intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?powheg_disable_sudakov"), &
	.false., intrinsic = .true.)
	end subroutine set_powheg_matching_defaults

	@
	<<RT data: global init: procedures>>=
	subroutine set_hadronization_defaults ()
	call var_list_append_log &
	(global%var_list, var_str ("?allow_hadronization"), .true., &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?hadronization_active"), .false., &
	intrinsic=.true.)
	call var_list_append_string &
	(global%var_list, var_str ("$hadronization_method"), &
	var_str ("PYTHIA6"), intrinsic = .true.)
	end subroutine set_hadronization_defaults

	@
	<<RT data: global init: procedures>>=
	subroutine set_openmp_defaults ()
	call var_list_append_log &
	(global%var_list, var_str ("?omega_openmp"), &
	openmp_is_active (), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?openmp_is_active"), &
	openmp_is_active (), &
	locked=.true., intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("openmp_num_threads_default"), &
	openmp_get_default_max_threads (), &
	locked=.true., intrinsic=.true.)
	call var_list_append_int &
	(global%var_list, var_str ("openmp_num_threads"), &
	openmp_get_max_threads (), &
	intrinsic=.true.)
	call var_list_append_log &
	(global%var_list, var_str ("?openmp_logging"), &
	.true., intrinsic=.true.)
	end subroutine set_openmp_defaults

	@
	<<RT data: global init: procedures>>=
	subroutine set_nlo_defaults ()
	call var_list_append_string &
	(global%var_list, var_str ("$born_me_method"), &
	var_str ("omega"), intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$loop_me_method"), &
	var_str ("openloops"), intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$correlation_me_method"), &
	var_str ("omega"), intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$real_tree_me_method"), &
	var_str ("omega"), intrinsic = .true.)
	call var_list_append_log (global%var_list, &
	var_str ("?test_soft_limit"), .false., intrinsic = .true.)
	call var_list_append_log (global%var_list, &
	var_str ("?test_coll_limit"), .false., intrinsic = .true.)
	call var_list_append_log (global%var_list, &
	var_str ("?test_anti_coll_limit"), .false., intrinsic = .true.)
	call var_list_append_int (global%var_list, &
	var_str ("fixed_alpha_region"), 0, intrinsic = .true.)
	call var_list_append_log (global%var_list, &
	var_str ("?switch_off_virtual_subtraction"), .false., intrinsic = .true.)
	call var_list_append_real (global%var_list, &
	var_str ("blha_use_top_yukawa"), -1._default, intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("openloops_verbosity"), 1, &
	intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?openloops_use_cms"), &
	.false., intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("openloops_phs_tolerance"), 7, &
	intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("openloops_stability_log"), 0, &
	intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?openloops_switch_off_muon_yukawa"), &
	.false., intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$openloops_extra_cmd"), &
	var_str (""), intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?openloops_use_collier"), &
	.true., intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?disable_subtraction"), &
	.false., intrinsic = .true.)
	call var_list_append_real &
	(global%var_list, var_str ("fks_dij_exp1"), &
	1._default, intrinsic = .true.)
	call var_list_append_real &
	(global%var_list, var_str ("fks_dij_exp2"), &
	1._default, intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$fks_mapping_type"), &
	var_str ("default"), intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$resonances_exclude_particles"), &
	var_str ("default"), intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("alpha_power"), &
	2, intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("alphas_power"), &
	0, intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?combined_nlo_integration"), &
	.false., intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?fixed_order_nlo_events"), &
	.false., intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?check_event_weights_against_xsection"), &
	.false., intrinsic = .true.)
	call var_list_append_log &
	(global%var_list, var_str ("?keep_failed_events"), &
	.false., intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("gks_multiplicity"), &
	0, intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$gosam_filter_lo"), &
	var_str (""), intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$gosam_filter_nlo"), &
	var_str (""), intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$gosam_symmetries"), &
	var_str ("family,generation"), intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("form_threads"), &
	2, intrinsic = .true.)
	call var_list_append_int &
	(global%var_list, var_str ("form_workspace"), &
	1000, intrinsic = .true.)
	call var_list_append_string &
	(global%var_list, var_str ("$gosam_fc"), &
	var_str (""), intrinsic = .true.)
	call var_list_append_real (global%var_list, &
	var_str ("mult_call_real"), 1._default, &
	intrinsic = .true.)
	call var_list_append_real (global%var_list, &
	var_str ("mult_call_virt"), 1._default, &
	intrinsic = .true.)
	call var_list_append_real (global%var_list, &
	var_str ("mult_call_dglap"), 1._default, &
	intrinsic = .true.)
	end subroutine set_nlo_defaults

	@
	\subsection{Local copies}
	This is done at compile time when a local copy of runtime data is
	needed: Link the variable list and initialize all derived parameters.
	This allows for synchronizing them with local variable changes without
	affecting global data.

	Also re-initialize pointer variables, so they point to local copies of
	their targets.
	<<RT data: rt data: TBP>>=
	procedure :: local_init => rt_data_local_init
	<<RT data: procedures>>=
	subroutine rt_data_local_init (local, global, env)
	class(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(in), target :: global
	integer, intent(in), optional :: env
	local%context => global
	call local%process_stack%link (global%process_stack)
	call local%process_stack%init_var_list (local%var_list)
	call local%process_stack%link_var_list (global%var_list)
	call var_list_append_string &
	(local%var_list, var_str ("$model_name"), var_str (""), &
	intrinsic=.true.)
	call local%init_pointer_variables ()
	local%fallback_model => global%fallback_model
	local%radiation_model => global%radiation_model
	local%os_data = global%os_data
	local%logfile = global%logfile
	call local%model_list%link (global%model_list)
	local%model => global%model
	if (associated (local%model)) then
	call local%model%link_var_list (local%var_list)
	end if
	if (allocated (global%event_callback)) then
	allocate (local%event_callback, source = global%event_callback)
	end if
	end subroutine rt_data_local_init

	@ %def rt_data_local_init
	@ These variables point to objects which get local copies:
	<<RT data: rt data: TBP>>=
	procedure :: init_pointer_variables => rt_data_init_pointer_variables
	<<RT data: procedures>>=
	subroutine rt_data_init_pointer_variables (local)
	class(rt_data_t), intent(inout), target :: local
	logical, target, save :: known = .true.
	call var_list_append_string_ptr &
	(local%var_list, var_str ("$fc"), local%os_data%fc, known, &
	intrinsic=.true.)
	call var_list_append_string_ptr &
	(local%var_list, var_str ("$fcflags"), local%os_data%fcflags, known, &
	intrinsic=.true.)
	end subroutine rt_data_init_pointer_variables

	@ %def rt_data_init_pointer_variables
	@ This is done at execution time: Copy data, transfer pointers.
	[[local]] has intent(inout) because its local variable list has
	already been prepared by the previous routine.

	To be pedantic, the local pointers to model and library should point
	to the entries in the local copies. (However, as long as these are
	just shallow copies with identical content, this is actually
	irrelevant.)

	The process library and process stacks behave as global objects. The
	copies of the process library and process stacks should be shallow
	copies, so the contents stay identical. Since objects may be pushed
	on the stack in the local environment, upon restoring the global
	environment, we should reverse the assignment. Then the added stack
	elements will end up on the global stack. (This should be
	reconsidered in a parallel environment.)
	<<RT data: rt data: TBP>>=
	procedure :: activate => rt_data_activate
	<<RT data: procedures>>=
	subroutine rt_data_activate (local)
	class(rt_data_t), intent(inout), target :: local
	class(rt_data_t), pointer :: global
	global => local%context
	if (associated (global)) then
	local%lexer => global%lexer
	call global%copy_globals (local)
	local%os_data = global%os_data
	local%logfile = global%logfile
	if (associated (global%prclib)) then
	local%prclib => &
	local%prclib_stack%get_library_ptr (global%prclib%get_name ())
	end if
	call local%import_values ()
	call local%process_stack%link (global%process_stack)
	local%it_list = global%it_list
	local%beam_structure = global%beam_structure
	local%pn = global%pn
	if (allocated (local%sample_fmt)) deallocate (local%sample_fmt)
	if (allocated (global%sample_fmt)) then
	allocate (local%sample_fmt (size (global%sample_fmt)), &
	source = global%sample_fmt)
	end if
	local%out_files => global%out_files
	local%model => global%model
	local%model_is_copy = .false.
	else if (.not. associated (local%model)) then
	local%model => local%preload_model
	local%model_is_copy = .false.
	end if
	if (associated (local%model)) then
	call local%model%link_var_list (local%var_list)
	call local%var_list%set_string (var_str ("$model_name"), &
	local%model%get_name (), is_known = .true.)
	else
	call local%var_list%set_string (var_str ("$model_name"), &
	var_str (""), is_known = .false.)
	end if
	end subroutine rt_data_activate

	@ %def rt_data_activate
	@ Restore the previous state of data, without actually finalizing the local
	environment. We also clear the local process stack. Some local modifications
	(model list and process library stack) are communicated to the global context,
	if there is any.

	If the [[keep_local]] flag is set, we want to retain current settings in
	the local environment. In particular, we create an instance of the currently
	selected model (which thus becomes separated from the model library!).
	The local variables are also kept.
	<<RT data: rt data: TBP>>=
	procedure :: deactivate => rt_data_deactivate
	<<RT data: procedures>>=
	subroutine rt_data_deactivate (local, global, keep_local)
	class(rt_data_t), intent(inout), target :: local
	class(rt_data_t), intent(inout), optional, target :: global
	logical, intent(in), optional :: keep_local
	type(string_t) :: local_model, local_scheme
	logical :: same_model, delete
	delete = .true.; if (present (keep_local)) delete = .not. keep_local
	if (present (global)) then
	if (associated (global%model) .and. associated (local%model)) then
	local_model = local%model%get_name ()
	if (global%model%has_schemes ()) then
	local_scheme = local%model%get_scheme ()
	same_model = &
	global%model%matches (local_model, local_scheme)
	else
	same_model = global%model%matches (local_model)
	end if
	else
	same_model = .false.
	end if
	if (delete) then
	call local%process_stack%clear ()
	call local%unselect_model ()
	call local%unset_values ()
	else if (associated (local%model)) then
	call local%ensure_model_copy ()
	end if
	if (.not. same_model .and. associated (global%model)) then
	if (global%model%has_schemes ()) then
	call msg_message ("Restoring model '" // &
	char (global%model%get_name ()) // "', scheme '" // &
	char (global%model%get_scheme ()) // "'")
	else
	call msg_message ("Restoring model '" // &
	char (global%model%get_name ()) // "'")
	end if
	end if
	if (associated (global%model)) then
	call global%model%link_var_list (global%var_list)
	end if
	call global%restore_globals (local)
	else
	call local%unselect_model ()
	end if
	end subroutine rt_data_deactivate

	@ %def rt_data_deactivate
	@ This imports the global objects for which local modifications
	should be kept. Currently, this is only the process library stack.
	<<RT data: rt data: TBP>>=
	procedure :: copy_globals => rt_data_copy_globals
	<<RT data: procedures>>=
	subroutine rt_data_copy_globals (global, local)
	class(rt_data_t), intent(in) :: global
	class(rt_data_t), intent(inout) :: local
	local%prclib_stack = global%prclib_stack
	end subroutine rt_data_copy_globals

	@ %def rt_data_copy_globals
	@ This restores global objects, for which local modifications
	should be kept.
	<<RT data: rt data: TBP>>=
	procedure :: restore_globals => rt_data_restore_globals
	<<RT data: procedures>>=
	subroutine rt_data_restore_globals (global, local)
	class(rt_data_t), intent(inout) :: global
	class(rt_data_t), intent(in) :: local
	global%prclib_stack = local%prclib_stack
	end subroutine rt_data_restore_globals

	@ %def rt_data_restore_globals
	@
	\subsection{Finalization}
	Finalizer for the variable list and the structure-function list.
	This is done only for the global RT dataset; local copies contain
	pointers to this and do not need a finalizer.
	<<RT data: rt data: TBP>>=
	procedure :: final => rt_data_global_final
	<<RT data: procedures>>=
	subroutine rt_data_global_final (global)
	class(rt_data_t), intent(inout) :: global
	call global%process_stack%final ()
	call global%prclib_stack%final ()
	call global%model_list%final ()
	call global%var_list%final (follow_link=.false.)
	if (associated (global%out_files)) then
	call file_list_final (global%out_files)
	deallocate (global%out_files)
	end if
	end subroutine rt_data_global_final

	@ %def rt_data_global_final
	@ The local copy needs a finalizer for the variable list, which consists
	of local copies. This finalizer is called only when the local
	environment is finally discarded. (Note that the process stack should
	already have been cleared after execution, which can occur many times
	for the same local environment.)
	<<RT data: rt data: TBP>>=
	procedure :: local_final => rt_data_local_final
	<<RT data: procedures>>=
	subroutine rt_data_local_final (local)
	class(rt_data_t), intent(inout) :: local
	call local%process_stack%clear ()
	call local%model_list%final ()
	call local%var_list%final (follow_link=.false.)
	end subroutine rt_data_local_final

	@ %def rt_data_local_final
	@
	\subsection{Model Management}
	Read a model, so it becomes available for activation. No variables or model
	copies, this is just initialization.

	If this is a local environment, the model will be automatically read into the
	global context.
	<<RT data: rt data: TBP>>=
	procedure :: read_model => rt_data_read_model
	<<RT data: procedures>>=
	subroutine rt_data_read_model (global, name, model, scheme)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	type(model_t), pointer, intent(out) :: model
	type(string_t) :: filename
	filename = name // ".mdl"
	call global%model_list%read_model &
	(name, filename, global%os_data, model, scheme)
	end subroutine rt_data_read_model

	@ %def rt_data_read_model
	@ Initialize the fallback model. This model is used
	whenever the current model does not describe all physical particles
	(hadrons, mainly). It is not supposed to be modified, and the pointer
	should remain linked to this model.
	<<RT data: rt data: TBP>>=
	procedure :: init_fallback_model => rt_data_init_fallback_model
	<<RT data: procedures>>=
	subroutine rt_data_init_fallback_model (global, name, filename)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name, filename
	call global%model_list%read_model &
	(name, filename, global%os_data, global%fallback_model)
	end subroutine rt_data_init_fallback_model

	@ %def rt_data_init_fallback_model
	@ Initialize the radiation model. This model is used by a
	radiation-generator algorithm which is part of the NLO machinery. It is not
	supposed to be modified, and the pointer
	should remain linked to this model.
	<<RT data: rt data: TBP>>=
	procedure :: init_radiation_model => rt_data_init_radiation_model
	<<RT data: procedures>>=
	subroutine rt_data_init_radiation_model (global, name, filename)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name, filename
	call global%model_list%read_model &
	(name, filename, global%os_data, global%radiation_model)
	end subroutine rt_data_init_radiation_model

	@ %def rt_data_init_radiation_model
	@
	Activate a model: assign the current-model pointer and set the model name in
	the variable list. If necessary, read the model from file. Link the global
	variable list to the model variable list.
	<<RT data: rt data: TBP>>=
	procedure :: select_model => rt_data_select_model
	<<RT data: procedures>>=
	subroutine rt_data_select_model (global, name, scheme)
	class(rt_data_t), intent(inout), target :: global
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	logical :: same_model
	if (associated (global%model)) then
	same_model = global%model%matches (name, scheme)
	else
	same_model = .false.
	end if
	if (.not. same_model) then
	global%model => global%model_list%get_model_ptr (name, scheme)
	if (.not. associated (global%model)) then
	call global%read_model (name, global%model)
	global%model_is_copy = .false.
	else if (associated (global%context)) then
	global%model_is_copy = &
	global%model_list%model_exists (name, scheme, &
	follow_link=.false.)
	else
	global%model_is_copy = .false.
	end if
	end if
	if (associated (global%model)) then
	call global%model%link_var_list (global%var_list)
	call global%var_list%set_string (var_str ("$model_name"), &
	name, is_known = .true.)
	if (global%model%has_schemes ()) then
	call msg_message ("Switching to model '" // char (name) // "', " &
	// "scheme '" // char (global%model%get_scheme ()) // "'")
	else
	call msg_message ("Switching to model '" // char (name) // "'")
	end if
	else
	call global%var_list%set_string (var_str ("$model_name"), &
	var_str (""), is_known = .false.)
	end if
	end subroutine rt_data_select_model

	@ %def rt_data_select_model
	@
	Remove the model link and unset the model name variable.
	<<RT data: rt data: TBP>>=
	procedure :: unselect_model => rt_data_unselect_model
	<<RT data: procedures>>=
	subroutine rt_data_unselect_model (global)
	class(rt_data_t), intent(inout), target :: global
	if (associated (global%model)) then
	global%model => null ()
	global%model_is_copy = .false.
	call global%var_list%set_string (var_str ("$model_name"), &
	var_str (""), is_known = .false.)
	end if
	end subroutine rt_data_unselect_model

	@ %def rt_data_unselect_model
	@
	Create a copy of the currently selected model and append it to the local model
	list. The model pointer is redirected to the copy.
	(Not applicable for the global model list, those models will be
	modified in-place.)
	<<RT data: rt data: TBP>>=
	procedure :: ensure_model_copy => rt_data_ensure_model_copy
	<<RT data: procedures>>=
	subroutine rt_data_ensure_model_copy (global)
	class(rt_data_t), intent(inout), target :: global
	if (associated (global%context)) then
	if (.not. global%model_is_copy) then
	call global%model_list%append_copy (global%model, global%model)
	global%model_is_copy = .true.
	call global%model%link_var_list (global%var_list)
	end if
	end if
	end subroutine rt_data_ensure_model_copy

	@ %def rt_data_ensure_model_copy
	@
	Modify a model variable. The update mechanism will ensure that the model
	parameter set remains consistent. This has to take place in a local copy
	of the current model. If there is none yet, create one.
	<<RT data: rt data: TBP>>=
	procedure :: model_set_real => rt_data_model_set_real
	<<RT data: procedures>>=
	subroutine rt_data_model_set_real (global, name, rval, verbose, pacified)
	class(rt_data_t), intent(inout), target :: global
	type(string_t), intent(in) :: name
	real(default), intent(in) :: rval
	logical, intent(in), optional :: verbose, pacified
	call global%ensure_model_copy ()
	call global%model%set_real (name, rval, verbose, pacified)
	end subroutine rt_data_model_set_real

	@ %def rt_data_model_set_real
	@
	Modify particle properties. This has to take place in a local copy
	of the current model. If there is none yet, create one.
	<<RT data: rt data: TBP>>=
	procedure :: modify_particle => rt_data_modify_particle
	<<RT data: procedures>>=
	subroutine rt_data_modify_particle &
	(global, pdg, polarized, stable, decay, &
	isotropic_decay, diagonal_decay, decay_helicity)
	class(rt_data_t), intent(inout), target :: global
	integer, intent(in) :: pdg
	logical, intent(in), optional :: polarized, stable
	logical, intent(in), optional :: isotropic_decay, diagonal_decay
	integer, intent(in), optional :: decay_helicity
	type(string_t), dimension(:), intent(in), optional :: decay
	call global%ensure_model_copy ()
	if (present (polarized)) then
	if (polarized) then
	call global%model%set_polarized (pdg)
	else
	call global%model%set_unpolarized (pdg)
	end if
	end if
	if (present (stable)) then
	if (stable) then
	call global%model%set_stable (pdg)
	else if (present (decay)) then
	call global%model%set_unstable &
	(pdg, decay, isotropic_decay, diagonal_decay, decay_helicity)
	else
	call msg_bug ("Setting particle unstable: missing decay processes")
	end if
	end if
	end subroutine rt_data_modify_particle

	@ %def rt_data_modify_particle
	@
	\subsection{Managing Variables}
	Return a pointer to the currently active variable list. If there is no model,
	this is the global variable list. If there is one, it is the model variable
	list, which should be linked to the former.
	<<RT data: rt data: TBP>>=
	procedure :: get_var_list_ptr => rt_data_get_var_list_ptr
	<<RT data: procedures>>=
	function rt_data_get_var_list_ptr (global) result (var_list)
	class(rt_data_t), intent(in), target :: global
	type(var_list_t), pointer :: var_list
	if (associated (global%model)) then
	var_list => global%model%get_var_list_ptr ()
	else
	var_list => global%var_list
	end if
	end function rt_data_get_var_list_ptr

	@ %def rt_data_get_var_list_ptr
	@ Initialize a local variable: append it to the current variable list. No
	initial value, yet.
	<<RT data: rt data: TBP>>=
	procedure :: append_log => rt_data_append_log
	procedure :: append_int => rt_data_append_int
	procedure :: append_real => rt_data_append_real
	procedure :: append_cmplx => rt_data_append_cmplx
	procedure :: append_subevt => rt_data_append_subevt
	procedure :: append_pdg_array => rt_data_append_pdg_array
	procedure :: append_string => rt_data_append_string
	<<RT data: procedures>>=
	subroutine rt_data_append_log (local, name, lval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	logical, intent(in), optional :: lval
	logical, intent(in), optional :: intrinsic, user
	call var_list_append_log (local%var_list, name, lval, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_log

	subroutine rt_data_append_int (local, name, ival, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	integer, intent(in), optional :: ival
	logical, intent(in), optional :: intrinsic, user
	call var_list_append_int (local%var_list, name, ival, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_int

	subroutine rt_data_append_real (local, name, rval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	real(default), intent(in), optional :: rval
	logical, intent(in), optional :: intrinsic, user
	call var_list_append_real (local%var_list, name, rval, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_real

	subroutine rt_data_append_cmplx (local, name, cval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	complex(default), intent(in), optional :: cval
	logical, intent(in), optional :: intrinsic, user
	call var_list_append_cmplx (local%var_list, name, cval, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_cmplx

	subroutine rt_data_append_subevt (local, name, pval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in), optional :: pval
	logical, intent(in) :: intrinsic, user
	call var_list_append_subevt (local%var_list, name, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_subevt

	subroutine rt_data_append_pdg_array (local, name, aval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in), optional :: aval
	logical, intent(in), optional :: intrinsic, user
	call var_list_append_pdg_array (local%var_list, name, aval, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_pdg_array

	subroutine rt_data_append_string (local, name, sval, intrinsic, user)
	class(rt_data_t), intent(inout) :: local
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: sval
	logical, intent(in), optional :: intrinsic, user
	call var_list_append_string (local%var_list, name, sval, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_string

	@ %def rt_data_append_log
	@ %def rt_data_append_int
	@ %def rt_data_append_real
	@ %def rt_data_append_cmplx
	@ %def rt_data_append_subevt
	@ %def rt_data_append_pdg_array
	@ %def rt_data_append_string
	@ Import values for all local variables, given a global context environment
	where these variables are defined.
	<<RT data: rt data: TBP>>=
	procedure :: import_values => rt_data_import_values
	<<RT data: procedures>>=
	subroutine rt_data_import_values (local)
	class(rt_data_t), intent(inout) :: local
	type(rt_data_t), pointer :: global
	global => local%context
	if (associated (global)) then
	call var_list_import (local%var_list, global%var_list)
	end if
	end subroutine rt_data_import_values

	@ %def rt_data_import_values
	@ Unset all variable values.
	<<RT data: rt data: TBP>>=
	procedure :: unset_values => rt_data_unset_values
	<<RT data: procedures>>=
	subroutine rt_data_unset_values (global)
	class(rt_data_t), intent(inout) :: global
	call var_list_undefine (global%var_list, follow_link=.false.)
	end subroutine rt_data_unset_values

	@ %def rt_data_unset_values
	@ Set a variable. (Not a model variable, these are handled separately.) We
	can assume that the variable has been initialized.
	<<RT data: rt data: TBP>>=
	procedure :: set_log => rt_data_set_log
	procedure :: set_int => rt_data_set_int
	procedure :: set_real => rt_data_set_real
	procedure :: set_cmplx => rt_data_set_cmplx
	procedure :: set_subevt => rt_data_set_subevt
	procedure :: set_pdg_array => rt_data_set_pdg_array
	procedure :: set_string => rt_data_set_string
	<<RT data: procedures>>=
	subroutine rt_data_set_log (global, name, lval, is_known, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	logical, intent(in) :: lval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose
	call global%var_list%set_log (name, lval, is_known, &
	verbose=verbose)
	end subroutine rt_data_set_log

	subroutine rt_data_set_int (global, name, ival, is_known, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	integer, intent(in) :: ival
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose
	call global%var_list%set_int (name, ival, is_known, &
	verbose=verbose)
	end subroutine rt_data_set_int

	subroutine rt_data_set_real (global, name, rval, is_known, verbose, pacified)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	real(default), intent(in) :: rval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose, pacified
	call global%var_list%set_real (name, rval, is_known, &
	verbose=verbose, pacified=pacified)
	end subroutine rt_data_set_real

	subroutine rt_data_set_cmplx (global, name, cval, is_known, verbose, pacified)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: cval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose, pacified
	call global%var_list%set_cmplx (name, cval, is_known, &
	verbose=verbose, pacified=pacified)
	end subroutine rt_data_set_cmplx

	subroutine rt_data_set_subevt (global, name, pval, is_known, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in) :: pval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose
	call global%var_list%set_subevt (name, pval, is_known, &
	verbose=verbose)
	end subroutine rt_data_set_subevt

	subroutine rt_data_set_pdg_array (global, name, aval, is_known, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in) :: aval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose
	call global%var_list%set_pdg_array (name, aval, is_known, &
	verbose=verbose)
	end subroutine rt_data_set_pdg_array

	subroutine rt_data_set_string (global, name, sval, is_known, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(string_t), intent(in) :: sval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose
	call global%var_list%set_string (name, sval, is_known, &
	verbose=verbose)
	end subroutine rt_data_set_string

	@ %def rt_data_set_log
	@ %def rt_data_set_int
	@ %def rt_data_set_real
	@ %def rt_data_set_cmplx
	@ %def rt_data_set_subevt
	@ %def rt_data_set_pdg_array
	@ %def rt_data_set_string
	@ Return the value of a variable, assuming that the type is correct.
	<<RT data: rt data: TBP>>=
	procedure :: get_lval => rt_data_get_lval
	procedure :: get_ival => rt_data_get_ival
	procedure :: get_rval => rt_data_get_rval
	procedure :: get_cval => rt_data_get_cval
	procedure :: get_pval => rt_data_get_pval
	procedure :: get_aval => rt_data_get_aval
	procedure :: get_sval => rt_data_get_sval
	<<RT data: procedures>>=
	function rt_data_get_lval (global, name) result (lval)
	logical :: lval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	lval = var_list%get_lval (name)
	end function rt_data_get_lval

	function rt_data_get_ival (global, name) result (ival)
	integer :: ival
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	ival = var_list%get_ival (name)
	end function rt_data_get_ival

	function rt_data_get_rval (global, name) result (rval)
	real(default) :: rval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	rval = var_list%get_rval (name)
	end function rt_data_get_rval

	function rt_data_get_cval (global, name) result (cval)
	complex(default) :: cval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	cval = var_list%get_cval (name)
	end function rt_data_get_cval

	function rt_data_get_aval (global, name) result (aval)
	type(pdg_array_t) :: aval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	aval = var_list%get_aval (name)
	end function rt_data_get_aval

	function rt_data_get_pval (global, name) result (pval)
	type(subevt_t) :: pval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	pval = var_list%get_pval (name)
	end function rt_data_get_pval

	function rt_data_get_sval (global, name) result (sval)
	type(string_t) :: sval
	class(rt_data_t), intent(in), target :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	sval = var_list%get_sval (name)
	end function rt_data_get_sval

	@ %def rt_data_get_lval
	@ %def rt_data_get_ival
	@ %def rt_data_get_rval
	@ %def rt_data_get_cval
	@ %def rt_data_get_pval
	@ %def rt_data_get_aval
	@ %def rt_data_get_sval
	@ Return true if the variable exists in the global list.
	<<RT data: rt data: TBP>>=
	procedure :: contains => rt_data_contains
	<<RT data: procedures>>=
	function rt_data_contains (global, name) result (lval)
	logical :: lval
	class(rt_data_t), intent(in) :: global
	type(string_t), intent(in) :: name
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	lval = var_list%contains (name)
	end function rt_data_contains

	@ %def rt_data_contains
	@
	\subsection{Further Content}
	Add a library (available via a pointer of type [[prclib_entry_t]]) to
	the stack and update the pointer and variable list to the current
	library. The pointer association of [[prclib_entry]] will be discarded.
	<<RT data: rt data: TBP>>=
	procedure :: add_prclib => rt_data_add_prclib
	<<RT data: procedures>>=
	subroutine rt_data_add_prclib (global, prclib_entry)
	class(rt_data_t), intent(inout) :: global
	type(prclib_entry_t), intent(inout), pointer :: prclib_entry
	call global%prclib_stack%push (prclib_entry)
	call global%update_prclib (global%prclib_stack%get_first_ptr ())
	end subroutine rt_data_add_prclib

	@ %def rt_data_add_prclib
	@ Given a pointer to a process library, make this the currently active
	library.
	<<RT data: rt data: TBP>>=
	procedure :: update_prclib => rt_data_update_prclib
	<<RT data: procedures>>=
	subroutine rt_data_update_prclib (global, lib)
	class(rt_data_t), intent(inout) :: global
	type(process_library_t), intent(in), target :: lib
	global%prclib => lib
	if (global%var_list%contains (&
	var_str ("$library_name"), follow_link = .false.)) then
	call global%var_list%set_string (var_str ("$library_name"), &
	global%prclib%get_name (), is_known=.true.)
	else
	call var_list_append_string (global%var_list, &
	var_str ("$library_name"), global%prclib%get_name (), &
	intrinsic = .true.)
	end if
	end subroutine rt_data_update_prclib

	@ %def rt_data_update_prclib
	@
	\subsection{Miscellaneous}
	The helicity selection data are distributed among several parameters. Here,
	we collect them in a single record.
	<<RT data: rt data: TBP>>=
	procedure :: get_helicity_selection => rt_data_get_helicity_selection
	<<RT data: procedures>>=
	function rt_data_get_helicity_selection (rt_data) result (helicity_selection)
	class(rt_data_t), intent(in) :: rt_data
	type(helicity_selection_t) :: helicity_selection
	associate (var_list => rt_data%var_list)
	helicity_selection%active = var_list%get_lval (&
	var_str ("?helicity_selection_active"))
	if (helicity_selection%active) then
	helicity_selection%threshold = var_list%get_rval (&
	var_str ("helicity_selection_threshold"))
	helicity_selection%cutoff = var_list%get_ival (&
	var_str ("helicity_selection_cutoff"))
	end if
	end associate
	end function rt_data_get_helicity_selection

	@ %def rt_data_get_helicity_selection
	@ Show the beam setup: beam structure and relevant global variables.
	<<RT data: rt data: TBP>>=
	procedure :: show_beams => rt_data_show_beams
	<<RT data: procedures>>=
	subroutine rt_data_show_beams (rt_data, unit)
	class(rt_data_t), intent(in) :: rt_data
	integer, intent(in), optional :: unit
	type(string_t) :: s
	integer :: u
	u = given_output_unit (unit)
	associate (beams => rt_data%beam_structure, var_list => rt_data%var_list)
	call beams%write (u)
	if (.not. beams%asymmetric () .and. beams%get_n_beam () == 2) then
	write (u, "(2x,A," // FMT_19 // ",1x,'GeV')") "sqrts =", &
	var_list%get_rval (var_str ("sqrts"))
	end if
	if (beams%contains ("pdf_builtin")) then
	s = var_list%get_sval (var_str ("$pdf_builtin_set"))
	if (s /= "") then
	write (u, "(2x,A,1x,3A)") "PDF set =", '"', char (s), '"'
	else
	write (u, "(2x,A,1x,A)") "PDF set =", "[undefined]"
	end if
	end if
	if (beams%contains ("lhapdf")) then
	s = var_list%get_sval (var_str ("$lhapdf_dir"))
	if (s /= "") then
	write (u, "(2x,A,1x,3A)") "LHAPDF dir =", '"', char (s), '"'
	end if
	s = var_list%get_sval (var_str ("$lhapdf_file"))
	if (s /= "") then
	write (u, "(2x,A,1x,3A)") "LHAPDF file =", '"', char (s), '"'
	write (u, "(2x,A,1x,I0)") "LHAPDF member =", &
	var_list%get_ival (var_str ("lhapdf_member"))
	else
	write (u, "(2x,A,1x,A)") "LHAPDF file =", "[undefined]"
	end if
	end if
	if (beams%contains ("lhapdf_photon")) then
	s = var_list%get_sval (var_str ("$lhapdf_dir"))
	if (s /= "") then
	write (u, "(2x,A,1x,3A)") "LHAPDF dir =", '"', char (s), '"'
	end if
	s = var_list%get_sval (var_str ("$lhapdf_photon_file"))
	if (s /= "") then
	write (u, "(2x,A,1x,3A)") "LHAPDF file =", '"', char (s), '"'
	write (u, "(2x,A,1x,I0)") "LHAPDF member =", &
	var_list%get_ival (var_str ("lhapdf_member"))
	write (u, "(2x,A,1x,I0)") "LHAPDF scheme =", &
	var_list%get_ival (&
	var_str ("lhapdf_photon_scheme"))
	else
	write (u, "(2x,A,1x,A)") "LHAPDF file =", "[undefined]"
	end if
	end if
	if (beams%contains ("isr")) then
	write (u, "(2x,A," // FMT_19 // ")") "ISR alpha =", &
	var_list%get_rval (var_str ("isr_alpha"))
	write (u, "(2x,A," // FMT_19 // ")") "ISR Q max =", &
	var_list%get_rval (var_str ("isr_q_max"))
	write (u, "(2x,A," // FMT_19 // ")") "ISR mass =", &
	var_list%get_rval (var_str ("isr_mass"))
	write (u, "(2x,A,1x,I0)") "ISR order =", &
	var_list%get_ival (var_str ("isr_order"))
	write (u, "(2x,A,1x,L1)") "ISR recoil =", &
	var_list%get_lval (var_str ("?isr_recoil"))
	write (u, "(2x,A,1x,L1)") "ISR energy cons. =", &
	var_list%get_lval (var_str ("?isr_keep_energy"))
	end if
	if (beams%contains ("epa")) then
	write (u, "(2x,A," // FMT_19 // ")") "EPA alpha =", &
	var_list%get_rval (var_str ("epa_alpha"))
	write (u, "(2x,A," // FMT_19 // ")") "EPA x min =", &
	var_list%get_rval (var_str ("epa_x_min"))
	write (u, "(2x,A," // FMT_19 // ")") "EPA Q min =", &
	var_list%get_rval (var_str ("epa_q_min"))
	write (u, "(2x,A," // FMT_19 // ")") "EPA E max =", &
	var_list%get_rval (var_str ("epa_e_max"))
	write (u, "(2x,A," // FMT_19 // ")") "EPA mass =", &
	var_list%get_rval (var_str ("epa_mass"))
	write (u, "(2x,A,1x,L1)") "EPA recoil =", &
	var_list%get_lval (var_str ("?epa_recoil"))
	write (u, "(2x,A,1x,L1)") "EPA energy cons. =", &
	var_list%get_lval (var_str ("?epa_keep_energy"))
	end if
	if (beams%contains ("ewa")) then
	write (u, "(2x,A," // FMT_19 // ")") "EWA x min =", &
	var_list%get_rval (var_str ("ewa_x_min"))
	write (u, "(2x,A," // FMT_19 // ")") "EWA Pt max =", &
	var_list%get_rval (var_str ("ewa_pt_max"))
	write (u, "(2x,A," // FMT_19 // ")") "EWA mass =", &
	var_list%get_rval (var_str ("ewa_mass"))
	write (u, "(2x,A,1x,L1)") "EWA recoil =", &
	var_list%get_lval (var_str ("?ewa_recoil"))
	write (u, "(2x,A,1x,L1)") "EWA energy cons. =", &
	var_list%get_lval (var_str ("ewa_keep_energy"))
	end if
	if (beams%contains ("circe1")) then
	write (u, "(2x,A,1x,I0)") "CIRCE1 version =", &
	var_list%get_ival (var_str ("circe1_ver"))
	write (u, "(2x,A,1x,I0)") "CIRCE1 revision =", &
	var_list%get_ival (var_str ("circe1_rev"))
	s = var_list%get_sval (var_str ("$circe1_acc"))
	write (u, "(2x,A,1x,A)") "CIRCE1 acceler. =", char (s)
	write (u, "(2x,A,1x,I0)") "CIRCE1 chattin. =", &
	var_list%get_ival (var_str ("circe1_chat"))
	write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 sqrts =", &
	var_list%get_rval (var_str ("circe1_sqrts"))
	write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 epsil. =", &
	var_list%get_rval (var_str ("circe1_eps"))
	write (u, "(2x,A,1x,L1)") "CIRCE1 phot. 1 =", &
	var_list%get_lval (var_str ("?circe1_photon1"))
	write (u, "(2x,A,1x,L1)") "CIRCE1 phot. 2 =", &
	var_list%get_lval (var_str ("?circe1_photon2"))
	write (u, "(2x,A,1x,L1)") "CIRCE1 generat. =", &
	var_list%get_lval (var_str ("?circe1_generate"))
	write (u, "(2x,A,1x,L1)") "CIRCE1 mapping =", &
	var_list%get_lval (var_str ("?circe1_map"))
	write (u, "(2x,A," // FMT_19 // ")") "CIRCE1 map. slope =", &
	var_list%get_rval (var_str ("circe1_mapping_slope"))
	write (u, "(2x,A,1x,L1)") "CIRCE recoil photon =", &
	var_list%get_lval (var_str ("?circe1_with_radiation"))
	end if
	if (beams%contains ("circe2")) then
	s = var_list%get_sval (var_str ("$circe2_design"))
	write (u, "(2x,A,1x,A)") "CIRCE2 design =", char (s)
	s = var_list%get_sval (var_str ("$circe2_file"))
	write (u, "(2x,A,1x,A)") "CIRCE2 file =", char (s)
	write (u, "(2x,A,1x,L1)") "CIRCE2 polarized =", &
	var_list%get_lval (var_str ("?circe2_polarized"))
	end if
	if (beams%contains ("gaussian")) then
	write (u, "(2x,A,1x," // FMT_12 // ")") "Gaussian spread 1 =", &
	var_list%get_rval (var_str ("gaussian_spread1"))
	write (u, "(2x,A,1x," // FMT_12 // ")") "Gaussian spread 2 =", &
	var_list%get_rval (var_str ("gaussian_spread2"))
	end if
	if (beams%contains ("beam_events")) then
	s = var_list%get_sval (var_str ("$beam_events_file"))
	write (u, "(2x,A,1x,A)") "Beam events file =", char (s)
	write (u, "(2x,A,1x,L1)") "Beam events EOF warn =", &
	var_list%get_lval (var_str ("?beam_events_warn_eof"))
	end if
	end associate
	end subroutine rt_data_show_beams

	@ %def rt_data_show_beams
	@ Return the collision energy as determined by the current beam
	settings. Without beam setup, this is the [[sqrts]] variable.

	If the value is meaningless for a setup, the function returns zero.
	<<RT data: rt data: TBP>>=
	procedure :: get_sqrts => rt_data_get_sqrts
	<<RT data: procedures>>=
	function rt_data_get_sqrts (rt_data) result (sqrts)
	class(rt_data_t), intent(in) :: rt_data
	real(default) :: sqrts
	sqrts = rt_data%var_list%get_rval (var_str ("sqrts"))
	end function rt_data_get_sqrts

	@ %def rt_data_get_sqrts
	@ For testing purposes, the [[rt_data_t]] contents can be pacified to
	suppress numerical fluctuations in (constant) test matrix elements.
	<<RT data: rt data: TBP>>=
	procedure :: pacify => rt_data_pacify
	<<RT data: procedures>>=
	subroutine rt_data_pacify (rt_data, efficiency_reset, error_reset)
	class(rt_data_t), intent(inout) :: rt_data
	logical, intent(in), optional :: efficiency_reset, error_reset
	type(process_entry_t), pointer :: process
	process => rt_data%process_stack%first
	do while (associated (process))
	call process%pacify (efficiency_reset, error_reset)
	process => process%next
	end do
	end subroutine rt_data_pacify

	@ %def rt_data_pacify
	@
	<<RT data: rt data: TBP>>=
	procedure :: set_event_callback => rt_data_set_event_callback
	<<RT data: procedures>>=
	subroutine rt_data_set_event_callback (global, callback)
	class(rt_data_t), intent(inout) :: global
	class(event_callback_t), intent(in) :: callback
	if (allocated (global%event_callback)) deallocate (global%event_callback)
	allocate (global%event_callback, source = callback)
	end subroutine rt_data_set_event_callback

	@ %def rt_data_set_event_callback
	@
	<<RT data: rt data: TBP>>=
	procedure :: has_event_callback => rt_data_has_event_callback
	procedure :: get_event_callback => rt_data_get_event_callback
	<<RT data: procedures>>=
	function rt_data_has_event_callback (global) result (flag)
	class(rt_data_t), intent(in) :: global
	logical :: flag
	flag = allocated (global%event_callback)
	end function rt_data_has_event_callback

	function rt_data_get_event_callback (global) result (callback)
	class(rt_data_t), intent(in) :: global
	class(event_callback_t), allocatable :: callback
	if (allocated (global%event_callback)) then
	allocate (callback, source = global%event_callback)
	end if
	end function rt_data_get_event_callback

	@ %def rt_data_has_event_callback
	@ %def rt_data_get_event_callback
	@
	\subsection{Unit Tests}
	Test module, followed by the corresponding implementation module.
	<<[[rt_data_ut.f90]]>>=
	<<File header>>

	module rt_data_ut
	use unit_tests
	use rt_data_uti

	<<Standard module head>>

	<<RT data: public test>>

	contains

	<<RT data: test driver>>

	end module rt_data_ut
	@ %def rt_data_ut
	@
	<<[[rt_data_uti.f90]]>>=
	<<File header>>

	module rt_data_uti

	<<Use kinds>>
	<<Use strings>>
	use format_defs, only: FMT_19
	use ifiles
	use lexers
	use parser
	use flavors
	use variables
	use eval_trees
	use models
	use prclib_stacks

	use rt_data

	<<Standard module head>>

	<<RT data: test declarations>>

	contains

	<<RT data: test auxiliary>>

	<<RT data: tests>>

	end module rt_data_uti
	@ %def rt_data_ut
	@ API: driver for the unit tests below.
	<<RT data: public test>>=
	public :: rt_data_test
	<<RT data: test driver>>=
	subroutine rt_data_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<RT data: execute tests>>
	end subroutine rt_data_test

	@ %def rt_data_test
	@
	\subsubsection{Initial content}
	Force system-dependent objects to well-defined values. Some of the
	variables are locked and therefore must be addressed directly.

	This is, of course, only required for testing purposes. In principle,
	the [[real_specimen]] variables could be set to their values in
	[[rt_data_t]], but this depends on the precision again, so we set
	them to some dummy values.
	<<RT data: test auxiliary>>=
	subroutine fix_system_dependencies (global)
	class(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list

	var_list => global%get_var_list_ptr ()
	call var_list%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true., force=.true.)
	call var_list%set_log (var_str ("?openmp_is_active"), &
	.false., is_known = .true., force=.true.)
	call var_list%set_int (var_str ("openmp_num_threads_default"), &
	1, is_known = .true., force=.true.)
	call var_list%set_int (var_str ("openmp_num_threads"), &
	1, is_known = .true., force=.true.)
	call var_list%set_int (var_str ("real_range"), &
	307, is_known = .true., force=.true.)
	call var_list%set_int (var_str ("real_precision"), &
	15, is_known = .true., force=.true.)
	call var_list%set_real (var_str ("real_epsilon"), &
	1.e-16_default, is_known = .true., force=.true.)
	call var_list%set_real (var_str ("real_tiny"), &
	1.e-300_default, is_known = .true., force=.true.)

	global%os_data%fc = "Fortran-compiler"
	global%os_data%fcflags = "Fortran-flags"

	end subroutine fix_system_dependencies

	@ %def fix_system_dependencies
	@
	Display the RT data in the state just after (global) initialization.
	<<RT data: execute tests>>=
	call test (rt_data_1, "rt_data_1", &
	"initialize", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_1
	<<RT data: tests>>=
	subroutine rt_data_1 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: rt_data_1"
	write (u, "(A)") "* Purpose: initialize global runtime data"
	write (u, "(A)")

	call global%global_init (logfile = var_str ("rt_data.log"))
	call fix_system_dependencies (global)

	call global%set_int (var_str ("seed"), 0, is_known=.true.)

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

	call global%write (u)

	call global%final ()

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

	end subroutine rt_data_1

	@ %def rt_data_1
	@
	\subsubsection{Fill values}
	Fill in empty slots in the runtime data block.
	<<RT data: execute tests>>=
	call test (rt_data_2, "rt_data_2", &
	"fill", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_2
	<<RT data: tests>>=
	subroutine rt_data_2 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(flavor_t), dimension(2) :: flv
	type(string_t) :: cut_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree

	write (u, "(A)") "* Test output: rt_data_2"
	write (u, "(A)") "* Purpose: initialize global runtime data &
	&and fill contents"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call fix_system_dependencies (global)

	call global%select_model (var_str ("Test"))

	call global%set_real (var_str ("sqrts"), &
	1000._default, is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)
	call flv%init ([25,25], global%model)

	call global%set_string (var_str ("$run_id"), &
	var_str ("run1"), is_known = .true.)
	call global%set_real (var_str ("luminosity"), &
	33._default, is_known = .true.)

	call syntax_pexpr_init ()
	cut_expr_text = "all Pt > 100 [s]"
	call ifile_append (ifile, cut_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (parse_tree, stream, .true.)
	global%pn%cuts_lexpr => parse_tree%get_root_ptr ()

	allocate (global%sample_fmt (2))
	global%sample_fmt(1) = "foo_fmt"
	global%sample_fmt(2) = "bar_fmt"

	call global%write (u)

	call parse_tree_final (parse_tree)
	call stream_final (stream)
	call ifile_final (ifile)
	call syntax_pexpr_final ()

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine rt_data_2

	@ %def rt_data_2
	@
	\subsubsection{Save and restore}
	Set up a local runtime data block, change some contents, restore the
	global block.
	<<RT data: execute tests>>=
	call test (rt_data_3, "rt_data_3", &
	"save/restore", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_3
	<<RT data: tests>>=
	subroutine rt_data_3 (u)
	use event_base, only: event_callback_nop_t
	integer, intent(in) :: u
	type(rt_data_t), target :: global, local
	type(flavor_t), dimension(2) :: flv
	type(string_t) :: cut_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree
	type(prclib_entry_t), pointer :: lib
	type(event_callback_nop_t) :: event_callback_nop

	write (u, "(A)") "* Test output: rt_data_3"
	write (u, "(A)") "* Purpose: initialize global runtime data &
	&and fill contents;"
	write (u, "(A)") "* copy to local block and back"
	write (u, "(A)")

	write (u, "(A)") "* Init global data"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call fix_system_dependencies (global)

	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%select_model (var_str ("Test"))

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call flv%init ([25,25], global%model)

	call global%beam_structure%init_sf (flv%get_name (), [1])
	call global%beam_structure%set_sf (1, 1, var_str ("pdf_builtin"))

	call global%set_string (var_str ("$run_id"), &
	var_str ("run1"), is_known = .true.)
	call global%set_real (var_str ("luminosity"), &
	33._default, is_known = .true.)

	call syntax_pexpr_init ()
	cut_expr_text = "all Pt > 100 [s]"
	call ifile_append (ifile, cut_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (parse_tree, stream, .true.)
	global%pn%cuts_lexpr => parse_tree%get_root_ptr ()

	allocate (global%sample_fmt (2))
	global%sample_fmt(1) = "foo_fmt"
	global%sample_fmt(2) = "bar_fmt"

	allocate (lib)
	call lib%init (var_str ("library_1"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Init and modify local data"
	write (u, "(A)")

	call local%local_init (global)
	call local%append_string (var_str ("$integration_method"), intrinsic=.true.)
	call local%append_string (var_str ("$phs_method"), intrinsic=.true.)

	call local%activate ()

	write (u, "(1x,A,L1)") "model associated = ", associated (local%model)
	write (u, "(1x,A,L1)") "library associated = ", associated (local%prclib)
	write (u, *)

	call local%model_set_real (var_str ("ms"), 150._default)
	call local%set_string (var_str ("$integration_method"), &
	var_str ("midpoint"), is_known = .true.)
	call local%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)

	local%os_data%fc = "Local compiler"

	allocate (lib)
	call lib%init (var_str ("library_2"))
	call local%add_prclib (lib)

	call local%set_event_callback (event_callback_nop)

	call local%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Restore global data"
	write (u, "(A)")

	call local%deactivate (global)

	write (u, "(1x,A,L1)") "model associated = ", associated (global%model)
	write (u, "(1x,A,L1)") "library associated = ", associated (global%prclib)
	write (u, *)

	call global%write (u)

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

	call parse_tree_final (parse_tree)
	call stream_final (stream)
	call ifile_final (ifile)
	call syntax_pexpr_final ()

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine rt_data_3

	@ %def rt_data_3
	@
	\subsubsection{Show variables}
	Display selected variables in the global record.
	<<RT data: execute tests>>=
	call test (rt_data_4, "rt_data_4", &
	"show variables", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_4
	<<RT data: tests>>=
	subroutine rt_data_4 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	type(string_t), dimension(0) :: empty_string_array

	write (u, "(A)") "* Test output: rt_data_4"
	write (u, "(A)") "* Purpose: display selected variables"
	write (u, "(A)")

	call global%global_init ()

	write (u, "(A)") "* No variables:"
	write (u, "(A)")

	call global%write_vars (u, empty_string_array)

	write (u, "(A)") "* Two variables:"
	write (u, "(A)")

	call global%write_vars (u, &
	[var_str ("?unweighted"), var_str ("$phs_method")])

	write (u, "(A)")
	write (u, "(A)") "* Display whole record with selected variables"
	write (u, "(A)")

	call global%write (u, &
	vars = [var_str ("?unweighted"), var_str ("$phs_method")])

	call global%final ()

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

	end subroutine rt_data_4

	@ %def rt_data_4
	@
	\subsubsection{Show parts}
	Display only selected parts in the state just after (global) initialization.
	<<RT data: execute tests>>=
	call test (rt_data_5, "rt_data_5", &
	"show parts", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_5
	<<RT data: tests>>=
	subroutine rt_data_5 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: rt_data_5"
	write (u, "(A)") "* Purpose: display parts of rt data"
	write (u, "(A)")

	call global%global_init ()
	call global%write_libraries (u)

	write (u, "(A)")

	call global%write_beams (u)

	write (u, "(A)")

	call global%write_process_stack (u)

	call global%final ()

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

	end subroutine rt_data_5

	@ %def rt_data_5
	@
	\subsubsection{Local Model}
	Locally modify a model and restore the global one. We need an auxiliary
	function to determine the status of a model particle:
	<<RT data: test auxiliary>>=
	function is_stable (pdg, global) result (flag)
	integer, intent(in) :: pdg
	type(rt_data_t), intent(in) :: global
	logical :: flag
	type(flavor_t) :: flv
	call flv%init (pdg, global%model)
	flag = flv%is_stable ()
	end function is_stable

	function is_polarized (pdg, global) result (flag)
	integer, intent(in) :: pdg
	type(rt_data_t), intent(in) :: global
	logical :: flag
	type(flavor_t) :: flv
	call flv%init (pdg, global%model)
	flag = flv%is_polarized ()
	end function is_polarized

	@ %def is_stable is_polarized
	<<RT data: execute tests>>=
	call test (rt_data_6, "rt_data_6", &
	"local model", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_6
	<<RT data: tests>>=
	subroutine rt_data_6 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global, local
	type(var_list_t), pointer :: model_vars
	type(string_t) :: var_name

	write (u, "(A)") "* Test output: rt_data_6"
	write (u, "(A)") "* Purpose: apply and keep local modifications to model"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%select_model (var_str ("Test"))

	write (u, "(A)") "* Original model"
	write (u, "(A)")

	call global%write_model_list (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, global)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, global)

	write (u, *)

	var_name = "ff"

	write (u, "(A)", advance="no") "Global model variable: "
	model_vars => global%model%get_var_list_ptr ()
	call var_list_write_var (model_vars, var_name, u)

	write (u, "(A)")
	write (u, "(A)") "* Apply local modifications: unstable"
	write (u, "(A)")

	call local%local_init (global)
	call local%activate ()

	call local%model_set_real (var_name, 0.4_default)
	call local%modify_particle (25, stable = .false., decay = [var_str ("d1")])
	call local%modify_particle (6, stable = .false., &
	decay = [var_str ("f1")], isotropic_decay = .true.)
	call local%modify_particle (-6, stable = .false., &
	decay = [var_str ("f2"), var_str ("f3")], diagonal_decay = .true.)

	call local%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Further modifications"
	write (u, "(A)")

	call local%modify_particle (6, stable = .false., &
	decay = [var_str ("f1")], &
	diagonal_decay = .true., isotropic_decay = .false.)
	call local%modify_particle (-6, stable = .false., &
	decay = [var_str ("f2"), var_str ("f3")], &
	diagonal_decay = .false., isotropic_decay = .true.)
	call local%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Further modifications: f stable but polarized"
	write (u, "(A)")

	call local%modify_particle (6, stable = .true., polarized = .true.)
	call local%modify_particle (-6, stable = .true.)
	call local%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Global model"
	write (u, "(A)")

	call global%model%write (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, global)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, global)

	write (u, "(A)")
	write (u, "(A)") "* Local model"
	write (u, "(A)")

	call local%model%write (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, local)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, local)

	write (u, *)

	write (u, "(A)", advance="no") "Global model variable: "
	model_vars => global%model%get_var_list_ptr ()
	call var_list_write_var (model_vars, var_name, u)

	write (u, "(A)", advance="no") "Local model variable: "
	call var_list_write_var (local%model%get_var_list_ptr (), &
	var_name, u)

	write (u, "(A)")
	write (u, "(A)") "* Restore global"

	call local%deactivate (global, keep_local = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Global model"
	write (u, "(A)")

	call global%model%write (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, global)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, global)

	write (u, "(A)")
	write (u, "(A)") "* Local model"
	write (u, "(A)")

	call local%model%write (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, local)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, local)

	write (u, *)

	write (u, "(A)", advance="no") "Global model variable: "
	model_vars => global%model%get_var_list_ptr ()
	call var_list_write_var (model_vars, var_name, u)

	write (u, "(A)", advance="no") "Local model variable: "
	call var_list_write_var (local%model%get_var_list_ptr (), &
	var_name, u)

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

	call local%model%final ()
	deallocate (local%model)

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine rt_data_6

	@ %def rt_data_6
	@
	\subsubsection{Result variables}
	Initialize result variables and check that they are accessible via the
	global variable list.
	<<RT data: execute tests>>=
	call test (rt_data_7, "rt_data_7", &
	"result variables", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_7
	<<RT data: tests>>=
	subroutine rt_data_7 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: rt_data_7"
	write (u, "(A)") "* Purpose: set and access result variables"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process variables"
	write (u, "(A)")

	call global%global_init ()
	call global%process_stack%init_result_vars (var_str ("testproc"))

	call var_list_write_var (global%var_list, &
	var_str ("integral(testproc)"), u)
	call var_list_write_var (global%var_list, &
	var_str ("error(testproc)"), u)

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

	call global%final ()

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

	end subroutine rt_data_7

	@ %def rt_data_7
	@
	\subsubsection{Beam energy}
	If beam parameters are set, the variable [[sqrts]] is not necessarily
	the collision energy. The method [[get_sqrts]] fetches the correct value.
	<<RT data: execute tests>>=
	call test (rt_data_8, "rt_data_8", &
	"beam energy", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_8
	<<RT data: tests>>=
	subroutine rt_data_8 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: rt_data_8"
	write (u, "(A)") "* Purpose: get correct collision energy"
	write (u, "(A)")

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

	call global%global_init ()

	write (u, "(A)") "* Set sqrts"
	write (u, "(A)")

	call global%set_real (var_str ("sqrts"), &
	1000._default, is_known = .true.)
	write (u, "(1x,A," // FMT_19 // ")") "sqrts =", global%get_sqrts ()

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

	call global%final ()

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

	end subroutine rt_data_8

	@ %def rt_data_8
	@
	\subsubsection{Local variable modifications}
	<<RT data: execute tests>>=
	call test (rt_data_9, "rt_data_9", &
	"local variables", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_9
	<<RT data: tests>>=
	subroutine rt_data_9 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global, local
	type(var_list_t), pointer :: var_list

	write (u, "(A)") "* Test output: rt_data_9"
	write (u, "(A)") "* Purpose: handle local variables"
	write (u, "(A)")

	call syntax_model_file_init ()

	write (u, "(A)") "* Initialize global record and set some variables"
	write (u, "(A)")

	call global%global_init ()
	call global%select_model (var_str ("Test"))

	call global%set_real (var_str ("sqrts"), 17._default, is_known = .true.)
	call global%set_real (var_str ("luminosity"), 2._default, is_known = .true.)
	call global%model_set_real (var_str ("ff"), 0.5_default)
	call global%model_set_real (var_str ("gy"), 1.2_default)

	var_list => global%get_var_list_ptr ()

	call var_list_write_var (var_list, var_str ("sqrts"), u)
	call var_list_write_var (var_list, var_str ("luminosity"), u)
	call var_list_write_var (var_list, var_str ("ff"), u)
	call var_list_write_var (var_list, var_str ("gy"), u)
	call var_list_write_var (var_list, var_str ("mf"), u)
	call var_list_write_var (var_list, var_str ("x"), u)

	write (u, "(A)")

	write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
	global%get_rval (var_str ("sqrts"))
	write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
	global%get_rval (var_str ("luminosity"))
	write (u, "(1x,A,1x,F5.2)") "ff = ", &
	global%get_rval (var_str ("ff"))
	write (u, "(1x,A,1x,F5.2)") "gy = ", &
	global%get_rval (var_str ("gy"))
	write (u, "(1x,A,1x,F5.2)") "mf = ", &
	global%get_rval (var_str ("mf"))
	write (u, "(1x,A,1x,F5.2)") "x = ", &
	global%get_rval (var_str ("x"))

	write (u, "(A)")
	write (u, "(A)") "* Create local record with local variables"
	write (u, "(A)")

	call local%local_init (global)

	call local%append_real (var_str ("luminosity"), intrinsic = .true.)
	call local%append_real (var_str ("x"), user = .true.)

	call local%activate ()

	var_list => local%get_var_list_ptr ()

	call var_list_write_var (var_list, var_str ("sqrts"), u)
	call var_list_write_var (var_list, var_str ("luminosity"), u)
	call var_list_write_var (var_list, var_str ("ff"), u)
	call var_list_write_var (var_list, var_str ("gy"), u)
	call var_list_write_var (var_list, var_str ("mf"), u)
	call var_list_write_var (var_list, var_str ("x"), u)

	write (u, "(A)")

	write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
	local%get_rval (var_str ("sqrts"))
	write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
	local%get_rval (var_str ("luminosity"))
	write (u, "(1x,A,1x,F5.2)") "ff = ", &
	local%get_rval (var_str ("ff"))
	write (u, "(1x,A,1x,F5.2)") "gy = ", &
	local%get_rval (var_str ("gy"))
	write (u, "(1x,A,1x,F5.2)") "mf = ", &
	local%get_rval (var_str ("mf"))
	write (u, "(1x,A,1x,F5.2)") "x = ", &
	local%get_rval (var_str ("x"))

	write (u, "(A)")
	write (u, "(A)") "* Modify some local variables"
	write (u, "(A)")

	call local%set_real (var_str ("luminosity"), 42._default, is_known=.true.)
	call local%set_real (var_str ("x"), 6.66_default, is_known=.true.)
	call local%model_set_real (var_str ("ff"), 0.7_default)

	var_list => local%get_var_list_ptr ()

	call var_list_write_var (var_list, var_str ("sqrts"), u)
	call var_list_write_var (var_list, var_str ("luminosity"), u)
	call var_list_write_var (var_list, var_str ("ff"), u)
	call var_list_write_var (var_list, var_str ("gy"), u)
	call var_list_write_var (var_list, var_str ("mf"), u)
	call var_list_write_var (var_list, var_str ("x"), u)

	write (u, "(A)")

	write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
	local%get_rval (var_str ("sqrts"))
	write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
	local%get_rval (var_str ("luminosity"))
	write (u, "(1x,A,1x,F5.2)") "ff = ", &
	local%get_rval (var_str ("ff"))
	write (u, "(1x,A,1x,F5.2)") "gy = ", &
	local%get_rval (var_str ("gy"))
	write (u, "(1x,A,1x,F5.2)") "mf = ", &
	local%get_rval (var_str ("mf"))
	write (u, "(1x,A,1x,F5.2)") "x = ", &
	local%get_rval (var_str ("x"))

	write (u, "(A)")
	write (u, "(A)") "* Restore globals"
	write (u, "(A)")

	call local%deactivate (global)

	var_list => global%get_var_list_ptr ()

	call var_list_write_var (var_list, var_str ("sqrts"), u)
	call var_list_write_var (var_list, var_str ("luminosity"), u)
	call var_list_write_var (var_list, var_str ("ff"), u)
	call var_list_write_var (var_list, var_str ("gy"), u)
	call var_list_write_var (var_list, var_str ("mf"), u)
	call var_list_write_var (var_list, var_str ("x"), u)

	write (u, "(A)")

	write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
	global%get_rval (var_str ("sqrts"))
	write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
	global%get_rval (var_str ("luminosity"))
	write (u, "(1x,A,1x,F5.2)") "ff = ", &
	global%get_rval (var_str ("ff"))
	write (u, "(1x,A,1x,F5.2)") "gy = ", &
	global%get_rval (var_str ("gy"))
	write (u, "(1x,A,1x,F5.2)") "mf = ", &
	global%get_rval (var_str ("mf"))
	write (u, "(1x,A,1x,F5.2)") "x = ", &
	global%get_rval (var_str ("x"))

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

	call local%local_final ()

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine rt_data_9

	@ %def rt_data_9
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Select implementations}
	For abstract types (process core, integrator, phase space, etc.), we need a
	way to dynamically select a concrete type, using either data given by the user
	or a previous selection of a concrete type. This is done by subroutines in
	the current module.

	We would like to put this in the [[me_methods]] folder but it also
	depends on [[gosam]] and [[openloops]], so it is unclear where to put
	it.
	<<[[dispatch_me_methods.f90]]>>=
	<<File header>>

	module dispatch_me_methods

	<<Use strings>>
	use physics_defs, only: BORN
	use diagnostics
	use sm_qcd
	use variables
	use models
	use model_data

	use prc_core_def
	use prc_core
	use prc_test_core
	use prc_template_me
	use prc_test
	use prc_omega
	use prc_user_defined
	use prc_gosam
	use prc_openloops
	use prc_threshold

	<<Standard module head>>

	<<Dispatch me methods: public>>

	contains

	<<Dispatch me methods: procedures>>

	end module dispatch_me_methods
	@ %def dispatch_me_methods
	\subsection{Process Core Definition}
	The [[prc_core_def_t]] abstract type can be instantiated by providing a
	[[$method]] string variable.

	Note: [[core_def]] has intent(inout) because gfortran 4.7.1 crashes for
	intent(out).
	<<Dispatch me methods: public>>=
	public :: dispatch_core_def
	<<Dispatch me methods: procedures>>=
	subroutine dispatch_core_def (core_def, prt_in, prt_out, &
	model, var_list, id, nlo_type)
	class(prc_core_def_t), allocatable, intent(inout) :: core_def
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	type(model_t), pointer, intent(in) :: model
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in), optional :: id
	integer, intent(in), optional :: nlo_type
	type(string_t) :: method
	type(string_t) :: model_name
	logical :: cms_scheme
	type(string_t) :: restrictions
	logical :: openmp_support
	logical :: report_progress
	logical :: diags, diags_color
	type(string_t) :: extra_options
	integer :: nlo
	nlo = BORN; if (present (nlo_type)) nlo = nlo_type
	method = var_list%get_sval (var_str ("$method"))
	if (associated (model)) then
	model_name = model%get_name ()
	cms_scheme = model%get_scheme () == "Complex_Mass_Scheme"
	else
	model_name = ""
	cms_scheme = .false.
	end if
	restrictions = var_list%get_sval (&
	var_str ("$restrictions"))
	diags = var_list%get_lval (&
	var_str ("?vis_diags"))
	diags_color = var_list%get_lval (&
	var_str ("?vis_diags_color"))
	openmp_support = var_list%get_lval (&
	var_str ("?omega_openmp"))
	report_progress = var_list%get_lval (&
	var_str ("?report_progress"))
	extra_options = var_list%get_sval (&
	var_str ("$omega_flags"))
	select case (char (method))
	case ("unit_test")
	allocate (prc_test_def_t :: core_def)
	select type (core_def)
	type is (prc_test_def_t)
	call core_def%init (model_name, prt_in, prt_out)
	end select
	case ("template")
	allocate (template_me_def_t :: core_def)
	select type (core_def)
	type is (template_me_def_t)
	call core_def%init (model, prt_in, prt_out, unity = .false.)
	end select
	case ("template_unity")
	allocate (template_me_def_t :: core_def)
	select type (core_def)
	type is (template_me_def_t)
	call core_def%init (model, prt_in, prt_out, unity = .true.)
	end select
	case ("omega")
	allocate (omega_omega_def_t :: core_def)
	select type (core_def)
	type is (omega_omega_def_t)
	call core_def%init (model_name, prt_in, prt_out, &
	restrictions, cms_scheme, openmp_support, &
	report_progress, extra_options, diags, diags_color)
	end select
	case ("ovm")
	allocate (omega_ovm_def_t :: core_def)
	select type (core_def)
	type is (omega_ovm_def_t)
	call core_def%init (model_name, prt_in, prt_out, &
	restrictions, cms_scheme, openmp_support, &
	report_progress, extra_options, diags, diags_color)
	end select
	case ("gosam")
	allocate (gosam_def_t :: core_def)
	select type (core_def)
	type is (gosam_def_t)
	if (present (id)) then
	call core_def%init (id, model_name, prt_in, &
	prt_out, nlo, var_list)
	else
	call msg_fatal ("Dispatch GoSam def: No id!")
	end if
	end select
	case ("openloops")
	allocate (openloops_def_t :: core_def)
	select type (core_def)
	type is (openloops_def_t)
	if (present (id)) then
	call core_def%init (id, model_name, prt_in, &
	prt_out, nlo, var_list)
	else
	call msg_fatal ("Dispatch OpenLoops def: No id!")
	end if
	end select
	case ("dummy")
	allocate (user_defined_test_def_t :: core_def)
	select type (core_def)
	type is (user_defined_test_def_t)
	if (present (id)) then
	call core_def%init (id, model_name, prt_in, prt_out)
	else
	call msg_fatal ("Dispatch User-Defined Test def: No id!")
	end if
	end select
	case ("threshold")
	allocate (threshold_def_t :: core_def)
	select type (core_def)
	type is (threshold_def_t)
	if (present (id)) then
	call core_def%init (id, model_name, prt_in, prt_out, &
	nlo, restrictions)
	else
	call msg_fatal ("Dispatch Threshold def: No id!")
	end if
	end select
	case default
	call msg_fatal ("Process configuration: method '" &
	// char (method) // "' not implemented")
	end select
	end subroutine dispatch_core_def

	@ %def dispatch_core_def
	@
	\subsection{Process core allocation}
	Here we allocate an object of abstract type [[prc_core_t]] with a concrete
	type that matches a process definition. The [[prc_omega_t]] extension
	will require the current parameter set, so we take the opportunity to
	grab it from the model.
	<<Dispatch me methods: public>>=
	public :: dispatch_core
	<<Dispatch me methods: procedures>>=
	subroutine dispatch_core (core, core_def, model, &
	helicity_selection, qcd, use_color_factors)
	class(prc_core_t), allocatable, intent(inout) :: core
	class(prc_core_def_t), intent(in) :: core_def
	class(model_data_t), intent(in), target, optional :: model
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	type(qcd_t), intent(in), optional :: qcd
	logical, intent(in), optional :: use_color_factors
	select type (core_def)
	type is (prc_test_def_t)
	allocate (test_t :: core)
	type is (template_me_def_t)
	allocate (prc_template_me_t :: core)
	select type (core)
	type is (prc_template_me_t)
	call core%set_parameters (model)
	end select
	class is (omega_def_t)
	if (.not. allocated (core)) allocate (prc_omega_t :: core)
	select type (core)
	type is (prc_omega_t)
	call core%set_parameters (model, &
	helicity_selection, qcd, use_color_factors)
	end select
	type is (gosam_def_t)
	if (.not. allocated (core)) allocate (prc_gosam_t :: core)
	select type (core)
	type is (prc_gosam_t)
	call core%set_parameters (qcd)
	end select
	type is (openloops_def_t)
	if (.not. allocated (core)) allocate (prc_openloops_t :: core)
	select type (core)
	type is (prc_openloops_t)
	call core%set_parameters (qcd)
	end select
	type is (user_defined_test_def_t)
	if (.not. allocated (core)) allocate (prc_user_defined_test_t :: core)
	select type (core)
	type is (prc_user_defined_test_t)
	call core%set_parameters (qcd, model)
	end select
	type is (threshold_def_t)
	if (.not. allocated (core)) allocate (prc_threshold_t :: core)
	select type (core)
	type is (prc_threshold_t)
	!!! Need to wait for Bijan's answer to decide whether prc_threshold
	!!! really does not need color factors
	!!!call core%set_parameters (qcd, use_color_factors, model)
	call core%set_parameters (qcd, model)
	end select
	class default
	call msg_bug ("Process core: unexpected process definition type")
	end select
	end subroutine dispatch_core

	@ %def dispatch_core
	@
	\subsection{Process core update and restoration}
	Here we take an existing object of abstract type [[prc_core_t]] and
	update the parameters as given by the current state of [[model]].
	Optionally, we can save the previous state as [[saved_core]]. The
	second routine restores the original from the save.

	(In the test case, there is no possible update.)
	<<Dispatch me methods: public>>=
	public :: dispatch_core_update
	public :: dispatch_core_restore
	<<Dispatch me methods: procedures>>=
	subroutine dispatch_core_update &
	(core, model, helicity_selection, qcd, saved_core)

	class(prc_core_t), allocatable, intent(inout) :: core
	class(model_data_t), intent(in), optional, target :: model
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	type(qcd_t), intent(in), optional :: qcd
	class(prc_core_t), allocatable, intent(inout), optional :: saved_core

	if (present (saved_core)) then
	allocate (saved_core, source = core)
	end if
	select type (core)
	type is (test_t)
	type is (prc_omega_t)
	call core%set_parameters (model, helicity_selection, qcd)
	call core%activate_parameters ()
	class is (prc_user_defined_base_t)
	call msg_message ("Updating user defined cores is not implemented yet.")
	class default
	call msg_bug ("Process core update: unexpected process definition type")
	end select
	end subroutine dispatch_core_update

	subroutine dispatch_core_restore (core, saved_core)

	class(prc_core_t), allocatable, intent(inout) :: core
	class(prc_core_t), allocatable, intent(inout) :: saved_core

	call move_alloc (from = saved_core, to = core)
	select type (core)
	type is (test_t)
	type is (prc_omega_t)
	call core%activate_parameters ()
	class default
	call msg_bug ("Process core restore: unexpected process definition type")
	end select
	end subroutine dispatch_core_restore

	@ %def dispatch_core_update dispatch_core_restore
	@
	\subsection{Unit Tests}
	Test module, followed by the corresponding implementation module.
	<<[[dispatch_ut.f90]]>>=
	<<File header>>

	module dispatch_ut
	use unit_tests
	use dispatch_uti

	<<Standard module head>>

	<<Dispatch: public test>>

	<<Dispatch: public test auxiliary>>

	contains

	<<Dispatch: test driver>>

	end module dispatch_ut
	@ %def dispatch_ut
	@
	<<[[dispatch_uti.f90]]>>=
	<<File header>>

	module dispatch_uti
	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use io_units
	use diagnostics
	use os_interface
	use physics_defs
	use sm_qcd
	use flavors
	use interactions, only: reset_interaction_counter
	use pdg_arrays
	use process_constants
	use prc_core_def
	use prc_test_core
	use prc_core
	use prc_test
	use prc_omega
	use rng_base
	use sf_mappings
	use sf_base
	use mappings
	use phs_forests
	use phs_base
	use phs_wood
	use mci_base
	use mci_midpoint
	use mci_vamp
	use variables
	use model_data, only: model_data_t
	use models
	use eio_base
	use event_transforms
	use shower_base
	use rt_data

	use slha_interface, only: dispatch_slha
	use dispatch_rng
	use dispatch_beams
	use dispatch_phase_space
	use dispatch_mci
	use dispatch_me_methods
	use dispatch_transforms

	use sf_base_ut, only: sf_test_data_t

	<<Standard module head>>

	<<Dispatch: public test auxiliary>>

	<<Dispatch: test declarations>>

	contains

	<<Dispatch: tests>>

	<<Dispatch: test auxiliary>>

	end module dispatch_uti

	@ %def dispatch_uti
	@ API: driver for the unit tests below.
	<<Dispatch: public test>>=
	public :: dispatch_test
	<<Dispatch: test driver>>=
	subroutine dispatch_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Dispatch: execute tests>>
	end subroutine dispatch_test

	@ %def dispatch_test
	@
	\subsubsection{Select type: process definition}
	<<Dispatch: execute tests>>=
	call test (dispatch_1, "dispatch_1", &
	"process configuration method", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_1
	<<Dispatch: tests>>=
	subroutine dispatch_1 (u)
	integer, intent(in) :: u
	type(string_t), dimension(2) :: prt_in, prt_out
	type(rt_data_t), target :: global
	class(prc_core_def_t), allocatable :: core_def

	write (u, "(A)") "* Test output: dispatch_1"
	write (u, "(A)") "* Purpose: select process configuration method"
	write (u, "(A)")

	call global%global_init ()

	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	prt_in = [var_str ("a"), var_str ("b")]
	prt_out = [var_str ("c"), var_str ("d")]

	write (u, "(A)") "* Allocate core_def as prc_test_def"

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
	select type (core_def)
	type is (prc_test_def_t)
	call core_def%write (u)
	end select

	deallocate (core_def)

	write (u, "(A)")
	write (u, "(A)") "* Allocate core_def as omega_def"
	write (u, "(A)")

	call global%set_string (var_str ("$method"), &
	var_str ("omega"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
	select type (core_def)
	type is (omega_omega_def_t)
	call core_def%write (u)
	end select

	call global%final ()

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

	end subroutine dispatch_1

	@ %def dispatch_1
	@
	\subsubsection{Select type: process core}
	<<Dispatch: execute tests>>=
	call test (dispatch_2, "dispatch_2", &
	"process core", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_2
	<<Dispatch: tests>>=
	subroutine dispatch_2 (u)
	integer, intent(in) :: u
	type(string_t), dimension(2) :: prt_in, prt_out
	type(rt_data_t), target :: global
	class(prc_core_def_t), allocatable :: core_def
	class(prc_core_t), allocatable :: core

	write (u, "(A)") "* Test output: dispatch_2"
	write (u, "(A)") "* Purpose: select process configuration method"
	write (u, "(A)") " and allocate process core"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()

	prt_in = [var_str ("a"), var_str ("b")]
	prt_out = [var_str ("c"), var_str ("d")]

	write (u, "(A)") "* Allocate core as test_t"
	write (u, "(A)")

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
	call dispatch_core (core, core_def)
	select type (core)
	type is (test_t)
	call core%write (u)
	end select

	deallocate (core)
	deallocate (core_def)

	write (u, "(A)")
	write (u, "(A)") "* Allocate core as prc_omega_t"
	write (u, "(A)")

	call global%set_string (var_str ("$method"), &
	var_str ("omega"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)

	call global%select_model (var_str ("Test"))

	call global%set_log (&
	var_str ("?helicity_selection_active"), &
	.true., is_known = .true.)
	call global%set_real (&
	var_str ("helicity_selection_threshold"), &
	1e9_default, is_known = .true.)
	call global%set_int (&
	var_str ("helicity_selection_cutoff"), &
	10, is_known = .true.)

	call dispatch_core (core, core_def, &
	global%model, &
	global%get_helicity_selection ())
	call core_def%allocate_driver (core%driver, var_str (""))

	select type (core)
	type is (prc_omega_t)
	call core%write (u)
	end select

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine dispatch_2

	@ %def dispatch_2
	@
	\subsubsection{Select type: integrator core}
	<<Dispatch: execute tests>>=
	call test (dispatch_3, "dispatch_3", &
	"integration method", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_3
	<<Dispatch: tests>>=
	subroutine dispatch_3 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(mci_t), allocatable :: mci
	type(string_t) :: process_id

	write (u, "(A)") "* Test output: dispatch_3"
	write (u, "(A)") "* Purpose: select integration method"
	write (u, "(A)")

	call global%global_init ()
	process_id = "dispatch_3"

	write (u, "(A)") "* Allocate MCI as midpoint_t"
	write (u, "(A)")

	call global%set_string (&
	var_str ("$integration_method"), &
	var_str ("midpoint"), is_known = .true.)
	call dispatch_mci_s (mci, global%get_var_list_ptr (), process_id)
	select type (mci)
	type is (mci_midpoint_t)
	call mci%write (u)
	end select

	call mci%final ()
	deallocate (mci)

	write (u, "(A)")
	write (u, "(A)") "* Allocate MCI as vamp_t"
	write (u, "(A)")

	call global%set_string (&
	var_str ("$integration_method"), &
	var_str ("vamp"), is_known = .true.)
	call global%set_int (var_str ("threshold_calls"), &
	1, is_known = .true.)
	call global%set_int (var_str ("min_calls_per_channel"), &
	2, is_known = .true.)
	call global%set_int (var_str ("min_calls_per_bin"), &
	3, is_known = .true.)
	call global%set_int (var_str ("min_bins"), &
	4, is_known = .true.)
	call global%set_int (var_str ("max_bins"), &
	5, is_known = .true.)
	call global%set_log (var_str ("?stratified"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.false., is_known = .true.)
	call global%set_real (var_str ("channel_weights_power"),&
	4._default, is_known = .true.)
	call global%set_log (&
	var_str ("?vamp_history_global_verbose"), &
	.true., is_known = .true.)
	call global%set_log (&
	var_str ("?vamp_history_channels"), &
	.true., is_known = .true.)
	call global%set_log (&
	var_str ("?vamp_history_channels_verbose"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?stratified"), &
	.false., is_known = .true.)

	call dispatch_mci_s (mci, global%get_var_list_ptr (), process_id)
	select type (mci)
	type is (mci_vamp_t)
	call mci%write (u)
	call mci%write_history_parameters (u)
	end select

	call mci%final ()
	deallocate (mci)

	write (u, "(A)")
	write (u, "(A)") "* Allocate MCI as vamp_t, allow for negative weights"
	write (u, "(A)")

	call global%set_string (&
	var_str ("$integration_method"), &
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?negative_weights"), &
	.true., is_known = .true.)

	call dispatch_mci_s (mci, global%get_var_list_ptr (), process_id)
	select type (mci)
	type is (mci_vamp_t)
	call mci%write (u)
	call mci%write_history_parameters (u)
	end select

	call mci%final ()
	deallocate (mci)

	call global%final ()

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

	end subroutine dispatch_3

	@ %def dispatch_3
	@
	\subsubsection{Select type: phase-space configuration object}
	<<Dispatch: execute tests>>=
	call test (dispatch_4, "dispatch_4", &
	"phase-space configuration", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_4
	<<Dispatch: tests>>=
	subroutine dispatch_4 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(phs_config_t), allocatable :: phs
	type(phs_parameters_t) :: phs_par
	type(mapping_defaults_t) :: mapping_defs

	write (u, "(A)") "* Test output: dispatch_4"
	write (u, "(A)") "* Purpose: select phase-space configuration method"
	write (u, "(A)")

	call global%global_init ()

	write (u, "(A)") "* Allocate PHS as phs_single_t"
	write (u, "(A)")

	call global%set_string (&
	var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call dispatch_phs (phs, global%var_list, global%os_data, var_str ("dispatch_4"))
	call phs%write (u)

	call phs%final ()
	deallocate (phs)

	write (u, "(A)")
	write (u, "(A)") "* Allocate PHS as phs_wood_t"
	write (u, "(A)")

	call global%set_string (&
	var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call dispatch_phs (phs, global%var_list, global%os_data, var_str ("dispatch_4"))
	call phs%write (u)

	call phs%final ()
	deallocate (phs)

	write (u, "(A)")
	write (u, "(A)") "* Setting parameters for phs_wood_t"
	write (u, "(A)")

	phs_par%m_threshold_s = 123
	phs_par%m_threshold_t = 456
	phs_par%t_channel = 42
	phs_par%off_shell = 17
	phs_par%keep_nonresonant = .false.
	mapping_defs%energy_scale = 987
	mapping_defs%invariant_mass_scale = 654
	mapping_defs%momentum_transfer_scale = 321
	mapping_defs%step_mapping = .false.
	mapping_defs%step_mapping_exp = .false.
	mapping_defs%enable_s_mapping = .true.
	call dispatch_phs (phs, global%var_list, global%os_data, var_str ("dispatch_4"), &
	mapping_defs, phs_par)
	call phs%write (u)

	call phs%final ()

	call global%final ()

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

	end subroutine dispatch_4

	@ %def dispatch_4
	@
	\subsubsection{Select type: random number generator}
	This is an extra dispatcher that enables the test RNG. This procedure
	should be assigned to the [[dispatch_rng_factory_extra]] hook before
	any tests are executed.
	<<Dispatch: public test auxiliary>>=
	public :: dispatch_rng_factory_test
	<<Dispatch: test auxiliary>>=
	subroutine dispatch_rng_factory_test (rng_factory, var_list_global, var_list_local)
	use rng_base
	use rng_base_ut, only: rng_test_factory_t
	class(rng_factory_t), allocatable, intent(inout) :: rng_factory
	type(var_list_t), intent(inout) :: var_list_global
	type(var_list_t), intent(in), optional :: var_list_local
	type(var_list_t) :: local
	type(string_t) :: rng_method
	if (present (var_list_local)) then
	local = var_list_local
	else
	local = var_list_global
	end if
	rng_method = &
	local%get_sval (var_str ("$rng_method"))
	select case (char (rng_method))
	case ("unit_test")
	allocate (rng_test_factory_t :: rng_factory)
	call msg_message ("RNG: Initializing Test random-number generator")
	end select
	end subroutine dispatch_rng_factory_test

	@ %def dispatch_rng_factory_test
	<<Dispatch: execute tests>>=
	call test (dispatch_5, "dispatch_5", &
	"random-number generator", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_5
	<<Dispatch: tests>>=
	subroutine dispatch_5 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(rng_factory_t), allocatable :: rng_factory

	write (u, "(A)") "* Test output: dispatch_5"
	write (u, "(A)") "* Purpose: select random-number generator"
	write (u, "(A)")

	call global%global_init ()

	write (u, "(A)") "* Allocate RNG factory as rng_test_factory_t"
	write (u, "(A)")

	call global%set_string (&
	var_str ("$rng_method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_int (&
	var_str ("seed"), 1, is_known = .true.)
	call dispatch_rng_factory (rng_factory, global%var_list)
	call rng_factory%write (u)
	deallocate (rng_factory)

	write (u, "(A)")
	write (u, "(A)") "* Allocate RNG factory as rng_tao_factory_t"
	write (u, "(A)")

	call global%set_string (&
	var_str ("$rng_method"), &
	var_str ("tao"), is_known = .true.)
	call dispatch_rng_factory (rng_factory, global%var_list)
	call rng_factory%write (u)
	deallocate (rng_factory)

	call global%final ()

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

	end subroutine dispatch_5

	@ %def dispatch_5
	@
	\subsubsection{Phase-space configuration with file}
	<<Dispatch: execute tests>>=
	call test (dispatch_6, "dispatch_6", &
	"configure phase space using file", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_6
	<<Dispatch: tests>>=
	subroutine dispatch_6 (u)
	use phs_base_ut, only: init_test_process_data
	use phs_wood_ut, only: write_test_phs_file
	use phs_forests
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(os_data_t) :: os_data
	type(process_constants_t) :: process_data
	class(phs_config_t), allocatable :: phs
	integer :: u_phs

	write (u, "(A)") "* Test output: dispatch_6"
	write (u, "(A)") "* Purpose: select 'wood' phase-space &
	&for a test process"
	write (u, "(A)") "* and read phs configuration from file"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process"
	write (u, "(A)")

	call global%global_init ()

	call os_data_init (os_data)
	call syntax_model_file_init ()
	call global%select_model (var_str ("Test"))

	call syntax_phs_forest_init ()

	call init_test_process_data (var_str ("dispatch_6"), process_data)

	write (u, "(A)") "* Write phase-space file"

	u_phs = free_unit ()
	open (u_phs, file = "dispatch_6.phs", action = "write", status = "replace")
	call write_test_phs_file (u_phs, var_str ("dispatch_6"))
	close (u_phs)

	write (u, "(A)")
	write (u, "(A)") "* Allocate PHS as phs_wood_t"
	write (u, "(A)")

	call global%set_string (&
	var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (&
	var_str ("$phs_file"), &
	var_str ("dispatch_6.phs"), is_known = .true.)
	call dispatch_phs (phs, global%var_list, global%os_data, var_str ("dispatch_6"))

	call phs%init (process_data, global%model)
	call phs%configure (sqrts = 1000._default)

	call phs%write (u)
	write (u, "(A)")
	select type (phs)
	type is (phs_wood_config_t)
	call phs%write_forest (u)
	end select

	call phs%final ()

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine dispatch_6

	@ %def dispatch_6
	@
	\subsubsection{Select type: structure-function data}
	This is an extra dispatcher that enables the test structure
	functions. This procedure should be assigned to the
	[[dispatch_sf_data_extra]] hook before any tests are executed.
	<<Dispatch: public test auxiliary>>=
	public :: dispatch_sf_data_test
	<<Dispatch: test auxiliary>>=
	subroutine dispatch_sf_data_test (data, sf_method, i_beam, sf_prop, &
	var_list, var_list_global, model, os_data, sqrts, pdg_in, pdg_prc, polarized)
	class(sf_data_t), allocatable, intent(inout) :: data
	type(string_t), intent(in) :: sf_method
	integer, dimension(:), intent(in) :: i_beam
	type(var_list_t), intent(in) :: var_list
	type(var_list_t), intent(inout) :: var_list_global
	class(model_data_t), target, intent(in) :: model
	type(os_data_t), intent(in) :: os_data
	real(default), intent(in) :: sqrts
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_in
	type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
	type(sf_prop_t), intent(inout) :: sf_prop
	logical, intent(in) :: polarized
	select case (char (sf_method))
	case ("sf_test_0", "sf_test_1")
	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	select case (char (sf_method))
	case ("sf_test_0"); call data%init (model, pdg_in(i_beam(1)))
	case ("sf_test_1"); call data%init (model, pdg_in(i_beam(1)),&
	mode = 1)
	end select
	end select
	end select
	end subroutine dispatch_sf_data_test

	@ %def dispatch_sf_data_test
	@ The actual test.
	<<Dispatch: execute tests>>=
	call test (dispatch_7, "dispatch_7", &
	"structure-function data", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_7
	<<Dispatch: tests>>=
	subroutine dispatch_7 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(os_data_t) :: os_data
	type(string_t) :: prt, sf_method
	type(sf_prop_t) :: sf_prop
	class(sf_data_t), allocatable :: data
	type(pdg_array_t), dimension(1) :: pdg_in
	type(pdg_array_t), dimension(1,1) :: pdg_prc
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1

	write (u, "(A)") "* Test output: dispatch_7"
	write (u, "(A)") "* Purpose: select and configure &
	&structure function data"
	write (u, "(A)")

	call global%global_init ()

	call os_data_init (os_data)
	call syntax_model_file_init ()
	call global%select_model (var_str ("QCD"))

	call reset_interaction_counter ()
	call global%set_real (var_str ("sqrts"), &
	14000._default, is_known = .true.)
	prt = "p"
	call global%beam_structure%init_sf ([prt, prt], [1])
	pdg_in = 2212

	write (u, "(A)") "* Allocate data as sf_pdf_builtin_t"
	write (u, "(A)")

	sf_method = "pdf_builtin"
	call dispatch_sf_data (data, sf_method, [1], sf_prop, &
	global%get_var_list_ptr (), global%var_list, &
	global%model, global%os_data, global%get_sqrts (), &
	pdg_in, pdg_prc, .false.)
	call data%write (u)

	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(A)")
	write (u, "(1x,A,99(1x,I0))") "PDG(out) = ", pdg1

	deallocate (data)

	write (u, "(A)")
	write (u, "(A)") "* Allocate data for different PDF set"
	write (u, "(A)")

	pdg_in = 2212

	call global%set_string (var_str ("$pdf_builtin_set"), &
	var_str ("CTEQ6M"), is_known = .true.)
	sf_method = "pdf_builtin"
	call dispatch_sf_data (data, sf_method, [1], sf_prop, &
	global%get_var_list_ptr (), global%var_list, &
	global%model, global%os_data, global%get_sqrts (), &
	pdg_in, pdg_prc, .false.)
	call data%write (u)

	call data%get_pdg_out (pdg_out)
	pdg1 = pdg_out(1)
	write (u, "(A)")
	write (u, "(1x,A,99(1x,I0))") "PDG(out) = ", pdg1

	deallocate (data)

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine dispatch_7

	@ %def dispatch_7
	@
	\subsubsection{Beam structure}
	<<Dispatch: execute tests>>=
	call test (dispatch_8, "dispatch_8", &
	"beam structure", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_8
	<<Dispatch: tests>>=
	subroutine dispatch_8 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(os_data_t) :: os_data
	type(flavor_t), dimension(2) :: flv
	type(sf_config_t), dimension(:), allocatable :: sf_config
	type(sf_prop_t) :: sf_prop
	type(sf_channel_t), dimension(:), allocatable :: sf_channel
	type(phs_channel_collection_t) :: coll
	type(string_t) :: sf_string
	integer :: i
	type(pdg_array_t), dimension (2,1) :: pdg_prc

	write (u, "(A)") "* Test output: dispatch_8"
	write (u, "(A)") "* Purpose: configure a structure-function chain"
	write (u, "(A)")

	call global%global_init ()

	call os_data_init (os_data)
	call syntax_model_file_init ()
	call global%select_model (var_str ("QCD"))

	write (u, "(A)") "* Allocate LHC beams with PDF builtin"
	write (u, "(A)")

	call flv(1)%init (PROTON, global%model)
	call flv(2)%init (PROTON, global%model)

	call reset_interaction_counter ()
	call global%set_real (var_str ("sqrts"), &
	14000._default, is_known = .true.)

	call global%beam_structure%init_sf (flv%get_name (), [1])
	call global%beam_structure%set_sf (1, 1, var_str ("pdf_builtin"))

	call dispatch_sf_config (sf_config, sf_prop, global%beam_structure, &
	global%get_var_list_ptr (), global%var_list, &
	global%model, global%os_data, global%get_sqrts (), pdg_prc)
	do i = 1, size (sf_config)
	call sf_config(i)%write (u)
	end do

	call dispatch_sf_channels (sf_channel, sf_string, sf_prop, coll, &
	global%var_list, global%get_sqrts(), global%beam_structure)
	write (u, "(1x,A)") "Mapping configuration:"
	do i = 1, size (sf_channel)
	write (u, "(2x)", advance = "no")
	call sf_channel(i)%write (u)
	end do

	write (u, "(A)")
	write (u, "(A)") "* Allocate ILC beams with CIRCE1"
	write (u, "(A)")

	call global%select_model (var_str ("QED"))
	call flv(1)%init ( ELECTRON, global%model)
	call flv(2)%init (-ELECTRON, global%model)

	call reset_interaction_counter ()
	call global%set_real (var_str ("sqrts"), &
	500._default, is_known = .true.)
	call global%set_log (var_str ("?circe1_generate"), &
	.false., is_known = .true.)

	call global%beam_structure%init_sf (flv%get_name (), [1])
	call global%beam_structure%set_sf (1, 1, var_str ("circe1"))

	call dispatch_sf_config (sf_config, sf_prop, global%beam_structure, &
	global%get_var_list_ptr (), global%var_list, &
	global%model, global%os_data, global%get_sqrts (), pdg_prc)
	do i = 1, size (sf_config)
	call sf_config(i)%write (u)
	end do

	call dispatch_sf_channels (sf_channel, sf_string, sf_prop, coll, &
	global%var_list, global%get_sqrts(), global%beam_structure)
	write (u, "(1x,A)") "Mapping configuration:"
	do i = 1, size (sf_channel)
	write (u, "(2x)", advance = "no")
	call sf_channel(i)%write (u)
	end do

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

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine dispatch_8

	@ %def dispatch_8
	@
	\subsubsection{Event I/O}
	<<Dispatch: execute tests>>=
	call test (dispatch_9, "dispatch_9", &
	"event I/O", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_9
	<<Dispatch: tests>>=
	subroutine dispatch_9 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(eio_t), allocatable :: eio

	write (u, "(A)") "* Test output: dispatch_9"
	write (u, "(A)") "* Purpose: allocate an event I/O (eio) stream"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	write (u, "(A)") "* Allocate as raw"
	write (u, "(A)")

	call dispatch_eio (eio, var_str ("raw"), global%var_list, &
	global%fallback_model, global%event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as checkpoints:"
	write (u, "(A)")

	call dispatch_eio (eio, var_str ("checkpoint"), global%var_list, &
	global%fallback_model, global%event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as LHEF:"
	write (u, "(A)")

	call global%set_string (var_str ("$lhef_extension"), &
	var_str ("lhe_custom"), is_known = .true.)
	call dispatch_eio (eio, var_str ("lhef"), global%var_list, &
	global%fallback_model, global%event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as HepMC:"
	write (u, "(A)")

	call dispatch_eio (eio, var_str ("hepmc"), global%var_list, &
	global%fallback_model, global%event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as weight_stream"
	write (u, "(A)")

	call dispatch_eio (eio, var_str ("weight_stream"), global%var_list, &
	global%fallback_model, global%event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as debug format"
	write (u, "(A)")

	call global%set_log (var_str ("?debug_verbose"), &
	.false., is_known = .true.)
	call dispatch_eio (eio, var_str ("debug"), global%var_list, &
	global%fallback_model, global%event_callback)

	call eio%write (u)

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

	call eio%final ()
	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine dispatch_9

	@ %def dispatch_9
	@
	\subsubsection{Update process core parameters}
	This test dispatches a process core, temporarily modifies parameters,
	then restores the original.
	<<Dispatch: execute tests>>=
	call test (dispatch_10, "dispatch_10", &
	"process core update", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_10
	<<Dispatch: tests>>=
	subroutine dispatch_10 (u)
	integer, intent(in) :: u
	type(string_t), dimension(2) :: prt_in, prt_out
	type(rt_data_t), target :: global
	class(prc_core_def_t), allocatable :: core_def
	class(prc_core_t), allocatable :: core, saved_core
	type(var_list_t), pointer :: model_vars

	write (u, "(A)") "* Test output: dispatch_10"
	write (u, "(A)") "* Purpose: select process configuration method,"
	write (u, "(A)") " allocate process core,"
	write (u, "(A)") " temporarily reset parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()

	prt_in = [var_str ("a"), var_str ("b")]
	prt_out = [var_str ("c"), var_str ("d")]

	write (u, "(A)") "* Allocate core as prc_omega_t"
	write (u, "(A)")

	call global%set_string (var_str ("$method"), &
	var_str ("omega"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)

	call global%select_model (var_str ("Test"))

	call dispatch_core (core, core_def, global%model)
	call core_def%allocate_driver (core%driver, var_str (""))

	select type (core)
	type is (prc_omega_t)
	call core%write (u)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Update core with modified model and helicity selection"
	write (u, "(A)")

	model_vars => global%model%get_var_list_ptr ()

	call model_vars%set_real (var_str ("gy"), 2._default, &
	is_known = .true.)
	call global%model%update_parameters ()

	call global%set_log (&
	var_str ("?helicity_selection_active"), &
	.true., is_known = .true.)
	call global%set_real (&
	var_str ("helicity_selection_threshold"), &
	2e10_default, is_known = .true.)
	call global%set_int (&
	var_str ("helicity_selection_cutoff"), &
	5, is_known = .true.)

	call dispatch_core_update (core, &
	global%model, &
	global%get_helicity_selection (), &
	saved_core = saved_core)
	select type (core)
	type is (prc_omega_t)
	call core%write (u)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Restore core from save"
	write (u, "(A)")

	call dispatch_core_restore (core, saved_core)
	select type (core)
	type is (prc_omega_t)
	call core%write (u)
	end select

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine dispatch_10

	@ %def dispatch_10
	@
	\subsubsection{QCD Coupling}
	This test dispatches an [[qcd]] object, which is used to compute the
	(running) coupling by one of several possible methods.
	<<Dispatch: execute tests>>=
	call test (dispatch_11, "dispatch_11", &
	"QCD coupling", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_11
	<<Dispatch: tests>>=
	subroutine dispatch_11 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(qcd_t) :: qcd
	type(var_list_t), pointer :: model_vars

	write (u, "(A)") "* Test output: dispatch_11"
	write (u, "(A)") "* Purpose: select QCD coupling formula"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()
	call global%select_model (var_str ("SM"))
	model_vars => global%get_var_list_ptr ()

	write (u, "(A)") "* Allocate alpha_s as fixed"
	write (u, "(A)")

	call global%set_log (var_str ("?alpha_s_is_fixed"), &
	.true., is_known = .true.)
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate alpha_s as running (built-in)"
	write (u, "(A)")

	call global%set_log (var_str ("?alpha_s_is_fixed"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?alpha_s_from_mz"), &
	.true., is_known = .true.)
	call global%set_int &
	(var_str ("alpha_s_order"), 1, is_known = .true.)
	call model_vars%set_real (var_str ("alphas"), 0.1234_default, &
	is_known=.true.)
	call model_vars%set_real (var_str ("mZ"), 91.234_default, &
	is_known=.true.)
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate alpha_s as running (built-in, Lambda defined)"
	write (u, "(A)")

	call global%set_log (var_str ("?alpha_s_from_mz"), &
	.false., is_known = .true.)
	call global%set_log (&
	var_str ("?alpha_s_from_lambda_qcd"), &
	.true., is_known = .true.)
	call global%set_real &
	(var_str ("lambda_qcd"), 250.e-3_default, &
	is_known=.true.)
	call global%set_int &
	(var_str ("alpha_s_order"), 2, is_known = .true.)
	call global%set_int &
	(var_str ("alpha_s_nf"), 4, is_known = .true.)
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate alpha_s as running (using builtin PDF set)"
	write (u, "(A)")

	call global%set_log (&
	var_str ("?alpha_s_from_lambda_qcd"), &
	.false., is_known = .true.)
	call global%set_log &
	(var_str ("?alpha_s_from_pdf_builtin"), &
	.true., is_known = .true.)
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call qcd%write (u)

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine dispatch_11

	@ %def dispatch_11
	@
	\subsubsection{Shower settings}
	This test dispatches an [[shower_settings]] object, which is used
	to steer the initial and final state.
	<<Dispatch: execute tests>>=
	call test (dispatch_12, "dispatch_12", &
	"Shower settings", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_12
	<<Dispatch: tests>>=
	subroutine dispatch_12 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(var_list_t), pointer :: var_list
	type(shower_settings_t) :: shower_settings

	write (u, "(A)") "* Test output: dispatch_12"
	write (u, "(A)") "* Purpose: setting ISR/FSR shower"
	write (u, "(A)")

	write (u, "(A)") "* Default settings"
	write (u, "(A)")

	call global%global_init ()
	call global%set_log (var_str ("?alpha_s_is_fixed"), &
	.true., is_known = .true.)
	var_list => global%get_var_list_ptr ()
	call shower_settings%init (var_list)
	call write_separator (u)
	call shower_settings%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Switch on ISR/FSR showers, hadronization"
	write (u, "(A)") " and MLM matching"
	write (u, "(A)")

	call global%set_string (var_str ("$shower_method"), &
	var_str ("PYTHIA6"), is_known = .true.)
	call global%set_log (var_str ("?ps_fsr_active"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?ps_isr_active"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?hadronization_active"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?mlm_matching"), &
	.true., is_known = .true.)
	call global%set_int &
	(var_str ("ps_max_n_flavors"), 4, is_known = .true.)
	call global%set_real &
	(var_str ("ps_isr_z_cutoff"), 0.1234_default, &
	is_known=.true.)
	call global%set_real (&
	var_str ("mlm_etamax"), 3.456_default, is_known=.true.)
	call global%set_string (&
	var_str ("$ps_PYTHIA_PYGIVE"), var_str ("abcdefgh"), is_known=.true.)
	call shower_settings%init (var_list)
	call write_separator (u)
	call shower_settings%write (u)
	call write_separator (u)

	call global%final ()

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

	end subroutine dispatch_12

	@ %def dispatch_12
	@
	\subsubsection{Event transforms}
	This test dispatches an [[evt]] (event transform) object. Currently,
	the only nontrivial transform is the partonic decay chain..
	<<Dispatch: execute tests>>=
	call test (dispatch_13, "dispatch_13", &
	"event transforms", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_13
	<<Dispatch: tests>>=
	subroutine dispatch_13 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(evt_t), pointer :: evt

	write (u, "(A)") "* Test output: dispatch_13"
	write (u, "(A)") "* Purpose: configure event transform"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	write (u, "(A)") "* Partonic decays"
	write (u, "(A)")

	call dispatch_evt_decay (evt, global%var_list)
	call evt%write (u, verbose = .true., more_verbose = .true.)

	call evt%final ()
	deallocate (evt)

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

	call global%set_log (var_str ("?allow_shower"), .true., &
	is_known = .true.)
	call global%set_string (var_str ("$shower_method"), &
	var_str ("WHIZARD"), is_known = .true.)
	call dispatch_evt_shower (evt, global%var_list, global%model, &
	global%fallback_model, global%os_data, global%beam_structure)
	call evt%write (u)
	call write_separator (u, 2)

	call evt%final ()
	deallocate (evt)

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine dispatch_13

	@ %def dispatch_13
	@
	\subsubsection{SLHA interface}
	This rather trivial sets all input values for the SLHA interface
	to [[false]].
	<<Dispatch: execute tests>>=
	call test (dispatch_14, "dispatch_14", &
	"SLHA interface", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_14
	<<Dispatch: tests>>=
	subroutine dispatch_14 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	logical :: input, spectrum, decays

	write (u, "(A)") "* Test output: dispatch_14"
	write (u, "(A)") "* Purpose: SLHA interface settings"
	write (u, "(A)")

	write (u, "(A)") "* Default settings"
	write (u, "(A)")

	call global%global_init ()
	call dispatch_slha (global%var_list, &
	input = input, spectrum = spectrum, decays = decays)

	write (u, "(A,1x,L1)") " slha_read_input =", input
	write (u, "(A,1x,L1)") " slha_read_spectrum =", spectrum
	write (u, "(A,1x,L1)") " slha_read_decays =", decays

	call global%final ()
	call global%global_init ()

	write (u, "(A)")
	write (u, "(A)") "* Set all entries to [false]"
	write (u, "(A)")

	call global%set_log (var_str ("?slha_read_input"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?slha_read_spectrum"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?slha_read_decays"), &
	.false., is_known = .true.)

	call dispatch_slha (global%var_list, &
	input = input, spectrum = spectrum, decays = decays)

	write (u, "(A,1x,L1)") " slha_read_input =", input
	write (u, "(A,1x,L1)") " slha_read_spectrum =", spectrum
	write (u, "(A,1x,L1)") " slha_read_decays =", decays

	call global%final ()

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

	end subroutine dispatch_14

	@ %def dispatch_14
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process Configuration}
	This module communicates between the toplevel command structure with
	its runtime data set and the process-library handling modules which
	collect the definition of individual processes. Its primary purpose
	is to select from the available matrix-element generating methods and
	configure the entry in the process library accordingly.
	<<[[process_configurations.f90]]>>=
	<<File header>>

	module process_configurations

	<<Use strings>>
	use diagnostics
	use models
	use prc_core_def
	use particle_specifiers
	use process_libraries
	use rt_data
	use variables

	use dispatch_me_methods, only: dispatch_core_def

	<<Standard module head>>

	<<Process configurations: public>>

	<<Process configurations: types>>

	contains

	<<Process configurations: procedures>>

	end module process_configurations
	@ %def process_configurations
	@
	\subsection{Data Type}
	<<Process configurations: public>>=
	public :: process_configuration_t
	<<Process configurations: types>>=
	type :: process_configuration_t
	type(process_def_entry_t), pointer :: entry => null ()
	type(string_t) :: id
	integer :: num_id = 0
	contains
	<<Process configurations: process configuration: TBP>>
	end type process_configuration_t

	@ %def process_configuration_t
	@ Initialize a process. We only need the name, the number of incoming
	particles, and the number of components.
	<<Process configurations: process configuration: TBP>>=
	procedure :: init => process_configuration_init
	<<Process configurations: procedures>>=
	subroutine process_configuration_init &
	(config, prc_name, n_in, n_components, global)
	class(process_configuration_t), intent(out) :: config
	type(string_t), intent(in) :: prc_name
	integer, intent(in) :: n_in
	integer, intent(in) :: n_components
	type(rt_data_t), intent(in) :: global
	type(model_t), pointer :: model
	logical :: nlo_process
	model => global%model
	config%id = prc_name
	nlo_process = global%nlo_fixed_order
	allocate (config%entry)
	if (global%var_list%is_known (var_str ("process_num_id"))) then
	config%num_id = &
	global%var_list%get_ival (var_str ("process_num_id"))
	call config%entry%init (prc_name, &
	model = model, n_in = n_in, n_components = n_components, &
	num_id = config%num_id, nlo_process = nlo_process)
	else
	call config%entry%init (prc_name, &
	model = model, n_in = n_in, n_components = n_components, &
	nlo_process = nlo_process)
	end if
	end subroutine process_configuration_init

	@ %def process_configuration_init
	@ Initialize a process component. The details depend on the process method,
	which determines the type of the process component core. We set the incoming
	and outgoing particles (as strings, to be interpreted by the process driver).
	All other information is taken from the variable list.

	The dispatcher gets only the names of the particles. The process
	component definition gets the complete specifiers which contains a
	polarization flag and names of decay processes, where applicable.
	<<Process configurations: process configuration: TBP>>=
	procedure :: setup_component => process_configuration_setup_component
	<<Process configurations: procedures>>=
	subroutine process_configuration_setup_component &
	(config, i_component, prt_in, prt_out, model, var_list, &
	nlo_type, can_be_integrated)
	class(process_configuration_t), intent(inout) :: config
	integer, intent(in) :: i_component
	type(prt_spec_t), dimension(:), intent(in) :: prt_in
	type(prt_spec_t), dimension(:), intent(in) :: prt_out
	type(model_t), pointer, intent(in) :: model
	type(var_list_t), intent(in) :: var_list
	integer, intent(in), optional :: nlo_type
	logical, intent(in), optional :: can_be_integrated
	type(string_t), dimension(:), allocatable :: prt_str_in
	type(string_t), dimension(:), allocatable :: prt_str_out
	class(prc_core_def_t), allocatable :: core_def
	type(string_t) :: method
	integer :: i

	allocate (prt_str_in (size (prt_in)))
	allocate (prt_str_out (size (prt_out)))
	forall (i = 1:size (prt_in)) prt_str_in(i) = prt_in(i)% get_name ()
	forall (i = 1:size (prt_out)) prt_str_out(i) = prt_out(i)%get_name ()

	call dispatch_core_def (core_def, prt_str_in, prt_str_out, &
	model, var_list, config%id, nlo_type)
	method = var_list%get_sval (var_str ("$method"))
	call config%entry%import_component (i_component, &
	n_out = size (prt_out), &
	prt_in = prt_in, &
	prt_out = prt_out, &
	method = method, &
	variant = core_def, &
	nlo_type = nlo_type, &
	can_be_integrated = can_be_integrated)
	end subroutine process_configuration_setup_component

	@ %def process_configuration_setup_component
	@
	<<Process configurations: process configuration: TBP>>=
	procedure :: set_fixed_emitter => process_configuration_set_fixed_emitter
	<<Process configurations: procedures>>=
	subroutine process_configuration_set_fixed_emitter (config, i, emitter)
	class(process_configuration_t), intent(inout) :: config
	integer, intent(in) :: i, emitter
	call config%entry%set_fixed_emitter (i, emitter)
	end subroutine process_configuration_set_fixed_emitter

	@ %def process_configuration_set_fixed_emitter
	@
	<<Process configurations: process configuration: TBP>>=
	procedure :: set_coupling_powers => process_configuration_set_coupling_powers
	<<Process configurations: procedures>>=
	subroutine process_configuration_set_coupling_powers (config, alpha_power, alphas_power)
	class(process_configuration_t), intent(inout) :: config
	integer, intent(in) :: alpha_power, alphas_power
	call config%entry%set_coupling_powers (alpha_power, alphas_power)
	end subroutine process_configuration_set_coupling_powers

	@ %def process_configuration_set_coupling_powers
	@
	<<Process configurations: process configuration: TBP>>=
	procedure :: set_component_associations => &
	process_configuration_set_component_associations
	<<Process configurations: procedures>>=
	subroutine process_configuration_set_component_associations &
	(config, i_list, pdf, damping, mismatch)
	class(process_configuration_t), intent(inout) :: config
	integer, intent(in), dimension(:) :: i_list
	logical, intent(in) :: pdf, damping, mismatch
	integer :: i_component
	do i_component = 1, config%entry%get_n_components ()
	if (any (i_list == i_component)) then
	if (pdf) then
	call config%entry%set_associated_components (i_component, &
	i_list(1), i_list(2), i_list(3), i_list(4), i_pdf = i_list(5))
	else if (mismatch) then
	call config%entry%set_associated_components (i_component, &
	i_list(1), i_list(2), i_list(3), i_list(4), i_pdf = i_list(5))
	else if (damping) then
	call config%entry%set_associated_components (i_component, &
	i_list(1), i_list(2), i_list(3), i_list(4), i_rfin = i_list(5))
	else
	call config%entry%set_associated_components (i_component, &
	i_list(1), i_list(2), i_list(3), i_list(4))
	end if
	end if
	end do
	end subroutine process_configuration_set_component_associations

	@ %def process_configuration_set_component_associations
	@ Record a process configuration: append it to the currently selected process
	definition library.
	<<Process configurations: process configuration: TBP>>=
	procedure :: record => process_configuration_record
	<<Process configurations: procedures>>=
	subroutine process_configuration_record (config, global)
	class(process_configuration_t), intent(inout) :: config
	type(rt_data_t), intent(inout) :: global
	if (associated (global%prclib)) then
	call global%prclib%open ()
	call global%prclib%append (config%entry)
	if (config%num_id /= 0) then
	write (msg_buffer, "(5A,I0,A)") "Process library '", &
	char (global%prclib%get_name ()), &
	"': recorded process '", char (config%id), "' (", &
	config%num_id, ")"
	else
	write (msg_buffer, "(5A)") "Process library '", &
	char (global%prclib%get_name ()), &
	"': recorded process '", char (config%id), "'"
	end if
	call msg_message ()
	else
	call msg_fatal ("Recording process '" // char (config%id) &
	// "': active process library undefined")
	end if
	end subroutine process_configuration_record

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

	module process_configurations_ut
	use unit_tests
	use process_configurations_uti

	<<Standard module head>>

	<<Process configurations: public test>>

	<<Process configurations: public test auxiliary>>

	contains

	<<Process configurations: test driver>>

	end module process_configurations_ut
	@ %def process_configurations_ut
	@
	<<[[process_configurations_uti.f90]]>>=
	<<File header>>

	module process_configurations_uti

	<<Use strings>>
	use particle_specifiers, only: new_prt_spec
	use prclib_stacks
	use models
	use rt_data

	use process_configurations

	<<Standard module head>>

	<<Process configurations: test declarations>>

	<<Process configurations: public test auxiliary>>

	contains

	<<Process configurations: test auxiliary>>

	<<Process configurations: tests>>

	end module process_configurations_uti

	@ %def process_configurations_uti
	@ API: driver for the unit tests below.
	<<Process configurations: public test>>=
	public :: process_configurations_test
	<<Process configurations: test driver>>=
	subroutine process_configurations_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Process configurations: execute tests>>
	end subroutine process_configurations_test

	@ %def process_configurations_test
	@
	\subsubsection{Minimal setup}
	The workflow for setting up a minimal process configuration with the
	test matrix element method.

	We wrap this in a public procedure, so we can reuse it in later modules.
	The procedure prepares a process definition list for two processes
	(one [[prc_test]] and one [[omega]] type) and appends this to the
	process library stack in the global data set.

	The [[mode]] argument determines which processes to build.

	The [[procname]] argument replaces the predefined procname(s).

	This is re-exported by the UT module.
	<<Process configurations: public test auxiliary>>=
	public :: prepare_test_library
	<<Process configurations: test auxiliary>>=
	subroutine prepare_test_library (global, libname, mode, procname)
	type(rt_data_t), intent(inout), target :: global
	type(string_t), intent(in) :: libname
	integer, intent(in) :: mode
	type(string_t), intent(in), dimension(:), optional :: procname
	type(prclib_entry_t), pointer :: lib
	type(string_t) :: prc_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	integer :: n_components
	type(process_configuration_t) :: prc_config

	if (.not. associated (global%prclib_stack%get_first_ptr ())) then
	allocate (lib)
	call lib%init (libname)
	call global%add_prclib (lib)
	end if

	if (btest (mode, 0)) then

	call global%select_model (var_str ("Test"))

	if (present (procname)) then
	prc_name = procname(1)
	else
	prc_name = "prc_config_a"
	end if
	n_components = 1
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("s"), var_str ("s")]
	prt_out = [var_str ("s"), var_str ("s")]

	call global%set_string (var_str ("$method"),&
	var_str ("unit_test"), is_known = .true.)

	call prc_config%init (prc_name, size (prt_in), n_components, global)
	call prc_config%setup_component (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)
	call prc_config%record (global)

	deallocate (prt_in, prt_out)

	end if

	if (btest (mode, 1)) then

	call global%select_model (var_str ("QED"))

	if (present (procname)) then
	prc_name = procname(2)
	else
	prc_name = "prc_config_b"
	end if
	n_components = 1
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("m+"), var_str ("m-")]

	call global%set_string (var_str ("$method"),&
	var_str ("omega"), is_known = .true.)

	call prc_config%init (prc_name, size (prt_in), n_components, global)
	call prc_config%setup_component (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)
	call prc_config%record (global)

	deallocate (prt_in, prt_out)

	end if

	if (btest (mode, 2)) then

	call global%select_model (var_str ("Test"))

	if (present (procname)) then
	prc_name = procname(1)
	else
	prc_name = "prc_config_a"
	end if
	n_components = 1
	allocate (prt_in (1), prt_out (2))
	prt_in = [var_str ("s")]
	prt_out = [var_str ("f"), var_str ("fbar")]

	call global%set_string (var_str ("$method"),&
	var_str ("unit_test"), is_known = .true.)

	call prc_config%init (prc_name, size (prt_in), n_components, global)
	call prc_config%setup_component (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)
	call prc_config%record (global)

	deallocate (prt_in, prt_out)

	end if

	end subroutine prepare_test_library

	@ %def prepare_test_library
	@ The actual test: the previous procedure with some prelude and postlude.
	In the global variable list, just before printing we reset the
	variables where the value may depend on the system and run environment.
	<<Process configurations: execute tests>>=
	call test (process_configurations_1, "process_configurations_1", &
	"test processes", &
	u, results)
	<<Process configurations: test declarations>>=
	public :: process_configurations_1
	<<Process configurations: tests>>=
	subroutine process_configurations_1 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: process_configurations_1"
	write (u, "(A)") "* Purpose: configure test processes"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	write (u, "(A)") "* Configure processes as prc_test, model Test"
	write (u, "(A)") "* and omega, model QED"
	write (u, *)

	call global%set_int (var_str ("process_num_id"), &
	42, is_known = .true.)
	call prepare_test_library (global, var_str ("prc_config_lib_1"), 3)

	global%os_data%fc = "Fortran-compiler"
	global%os_data%fcflags = "Fortran-flags"

	call global%write_libraries (u)

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine process_configurations_1

	@ %def process_configurations_1
	@
	\subsubsection{\oMega\ options}
	Slightly extended example where we pass \oMega\ options to the
	library. The [[prepare_test_library]] contents are spelled out.
	<<Process configurations: execute tests>>=
	call test (process_configurations_2, "process_configurations_2", &
	"omega options", &
	u, results)
	<<Process configurations: test declarations>>=
	public :: process_configurations_2
	<<Process configurations: tests>>=
	subroutine process_configurations_2 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	type(string_t) :: libname
	type(prclib_entry_t), pointer :: lib
	type(string_t) :: prc_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	integer :: n_components
	type(process_configuration_t) :: prc_config

	write (u, "(A)") "* Test output: process_configurations_2"
	write (u, "(A)") "* Purpose: configure test processes with options"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	write (u, "(A)") "* Configure processes as omega, model QED"
	write (u, *)

	libname = "prc_config_lib_2"

	allocate (lib)
	call lib%init (libname)
	call global%add_prclib (lib)

	call global%select_model (var_str ("QED"))

	prc_name = "prc_config_c"
	n_components = 2
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("m+"), var_str ("m-")]

	call global%set_string (var_str ("$method"),&
	var_str ("omega"), is_known = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	call prc_config%init (prc_name, size (prt_in), n_components, global)

	call global%set_log (var_str ("?report_progress"), &
	.true., is_known = .true.)
	call prc_config%setup_component (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)

	call global%set_log (var_str ("?report_progress"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.true., is_known = .true.)
	call global%set_string (var_str ("$restrictions"),&
	var_str ("3+4~A"), is_known = .true.)
	call global%set_string (var_str ("$omega_flags"), &
	var_str ("-fusion:progress_file omega_prc_config.log"), &
	is_known = .true.)
	call prc_config%setup_component (2, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)

	call prc_config%record (global)

	deallocate (prt_in, prt_out)

	global%os_data%fc = "Fortran-compiler"
	global%os_data%fcflags = "Fortran-flags"

	call global%write_vars (u, [ &
	var_str ("$model_name"), &
	var_str ("$method"), &
	var_str ("?report_progress"), &
	var_str ("$restrictions"), &
	var_str ("$omega_flags")])
	write (u, "(A)")
	call global%write_libraries (u)

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine process_configurations_2

	@ %def process_configurations_2
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Compilation}
	This module manages compilation and loading of of process libraries. It is
	needed as a separate module because integration depends on it.
	<<[[compilations.f90]]>>=
	<<File header>>

	module compilations

	<<Use strings>>
	use io_units
	use system_defs, only: TAB
	use diagnostics
	use os_interface
	use variables
	use model_data
	use process_libraries
	use prclib_stacks
	use rt_data

	<<Standard module head>>

	<<Compilations: public>>

	<<Compilations: types>>

	contains

	<<Compilations: procedures>>

	end module compilations
	@ %def compilations
	@
	\subsection{The data type}
	The compilation item handles the compilation and loading of a single
	process library.
	<<Compilations: public>>=
	public :: compilation_item_t
	<<Compilations: types>>=
	type :: compilation_item_t
	private
	type(string_t) :: libname
	type(string_t) :: static_external_tag
	type(process_library_t), pointer :: lib => null ()
	logical :: recompile_library = .false.
	contains
	<<Compilations: compilation item: TBP>>
	end type compilation_item_t

	@ %def compilation_item_t
	@ Initialize:
	<<Compilations: compilation item: TBP>>=
	procedure :: init => compilation_item_init
	<<Compilations: procedures>>=
	subroutine compilation_item_init (comp, libname, stack, var_list)
	class(compilation_item_t), intent(out) :: comp
	type(string_t), intent(in) :: libname
	type(prclib_stack_t), intent(inout) :: stack
	type(var_list_t), intent(in) :: var_list
	comp%libname = libname
	comp%lib => stack%get_library_ptr (comp%libname)
	if (.not. associated (comp%lib)) then
	call msg_fatal ("Process library '" // char (comp%libname) &
	// "' has not been declared.")
	end if
	comp%recompile_library = &
	var_list%get_lval (var_str ("?recompile_library"))
	end subroutine compilation_item_init

	@ %def compilation_item_init
	@ Compile the current library. The [[force]] flag has the
	effect that we first delete any previous files, as far as accessible
	by the current makefile. It also guarantees that previous files not
	accessible by a makefile will be overwritten.
	<<Compilations: compilation item: TBP>>=
	procedure :: compile => compilation_item_compile
	<<Compilations: procedures>>=
	subroutine compilation_item_compile (comp, model, os_data, force, recompile)
	class(compilation_item_t), intent(inout) :: comp
	class(model_data_t), intent(in), target :: model
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: force, recompile
	if (associated (comp%lib)) then
	call msg_message ("Process library '" &
	// char (comp%libname) // "': compiling ...")
	call comp%lib%configure (os_data)
	if (signal_is_pending ()) return
	call comp%lib%compute_md5sum (model)
	call comp%lib%write_makefile (os_data, force)
	if (signal_is_pending ()) return
	if (force) then
	call comp%lib%clean (os_data, distclean = .false.)
	if (signal_is_pending ()) return
	end if
	call comp%lib%write_driver (force)
	if (signal_is_pending ()) return
	if (recompile) then
	call comp%lib%load (os_data, keep_old_source = .true.)
	if (signal_is_pending ()) return
	end if
	call comp%lib%update_status (os_data)
	end if
	end subroutine compilation_item_compile

	@ %def compilation_item_compile
	@ Load the current library, just after compiling it.
	<<Compilations: compilation item: TBP>>=
	procedure :: load => compilation_item_load
	<<Compilations: procedures>>=
	subroutine compilation_item_load (comp, os_data)
	class(compilation_item_t), intent(inout) :: comp
	type(os_data_t), intent(in) :: os_data
	if (associated (comp%lib)) then
	call comp%lib%load (os_data)
	end if
	end subroutine compilation_item_load

	@ %def compilation_item_load
	@ Message as a separate call:
	<<Compilations: compilation item: TBP>>=
	procedure :: success => compilation_item_success
	<<Compilations: procedures>>=
	subroutine compilation_item_success (comp)
	class(compilation_item_t), intent(in) :: comp
	if (associated (comp%lib)) then
	call msg_message ("Process library '" // char (comp%libname) &
	// "': ... success.")
	else
	call msg_fatal ("Process library '" // char (comp%libname) &
	// "': ... failure.")
	end if
	end subroutine compilation_item_success

	@ %def compilation_item_success
	@ %def compilation_item_failure
	@
	\subsection{API for library compilation and loading}
	This is a shorthand for compiling and loading a single library. The
	[[compilation_item]] object is used only internally.

	The [[global]] data set may actually be local to the caller. The
	compilation affects the library specified by its name if it is on the
	stack, but it does not reset the currently selected library.
	<<Compilations: public>>=
	public :: compile_library
	<<Compilations: procedures>>=
	subroutine compile_library (libname, global)
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: global
	type(compilation_item_t) :: comp
	logical :: force, recompile
	force = &
	global%var_list%get_lval (var_str ("?rebuild_library"))
	recompile = &
	global%var_list%get_lval (var_str ("?recompile_library"))
	if (associated (global%model)) then
	call comp%init (libname, global%prclib_stack, global%var_list)
	call comp%compile (global%model, global%os_data, force, recompile)
	if (signal_is_pending ()) return
	call comp%load (global%os_data)
	if (signal_is_pending ()) return
	else
	call msg_fatal ("Process library compilation: " &
	// " model is undefined.")
	end if
	call comp%success ()
	end subroutine compile_library

	@ %def compile_library
	@
	\subsection{Compiling static executable}
	This object handles the creation of a static executable which should
	contain a set of static process libraries.
	<<Compilations: public>>=
	public :: compilation_t
	<<Compilations: types>>=
	type :: compilation_t
	private
	type(string_t) :: exe_name
	type(string_t), dimension(:), allocatable :: lib_name
	contains
	<<Compilations: compilation: TBP>>
	end type compilation_t

	@ %def compilation_t
	@ Output.
	<<Compilations: compilation: TBP>>=
	procedure :: write => compilation_write
	<<Compilations: procedures>>=
	subroutine compilation_write (object, unit)
	class(compilation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Compilation object:"
	write (u, "(3x,3A)") "executable = '", &
	char (object%exe_name), "'"
	write (u, "(3x,A)", advance="no") "process libraries ="
	do i = 1, size (object%lib_name)
	write (u, "(1x,3A)", advance="no") "'", char (object%lib_name(i)), "'"
	end do
	write (u, *)
	end subroutine compilation_write

	@ %def compilation_write
	@ Initialize: we know the names of the executable and of the libraries.
	<<Compilations: compilation: TBP>>=
	procedure :: init => compilation_init
	<<Compilations: procedures>>=
	subroutine compilation_init (compilation, exe_name, lib_name)
	class(compilation_t), intent(out) :: compilation
	type(string_t), intent(in) :: exe_name
	type(string_t), dimension(:), intent(in) :: lib_name
	compilation%exe_name = exe_name
	allocate (compilation%lib_name (size (lib_name)))
	compilation%lib_name = lib_name
	end subroutine compilation_init

	@ %def compilation_init
	@ Write the dispatcher subroutine for the compiled libraries. Also
	write a subroutine which returns the names of the compiled libraries.
	<<Compilations: compilation: TBP>>=
	procedure :: write_dispatcher => compilation_write_dispatcher
	<<Compilations: procedures>>=
	subroutine compilation_write_dispatcher (compilation)
	class(compilation_t), intent(in) :: compilation
	type(string_t) :: file
	integer :: u, i
	file = compilation%exe_name // "_prclib_dispatcher.f90"
	call msg_message ("Static executable '" // char (compilation%exe_name) &
	// "': writing library dispatcher")
	u = free_unit ()
	open (u, file = char (file), status="replace", action="write")
	write (u, "(3A)") "! Whizard: process libraries for executable '", &
	char (compilation%exe_name), "'"
	write (u, "(A)") "! Automatically generated file, do not edit"
	write (u, "(A)") "subroutine dispatch_prclib_static " // &
	"(driver, basename, modellibs_ldflags)"
	write (u, "(A)") " use iso_varying_string, string_t => varying_string"
	write (u, "(A)") " use prclib_interfaces"
	do i = 1, size (compilation%lib_name)
	associate (lib_name => compilation%lib_name(i))
	write (u, "(A)") " use " // char (lib_name) // "_driver"
	end associate
	end do
	write (u, "(A)") " implicit none"
	write (u, "(A)") " class(prclib_driver_t), intent(inout), allocatable &
	&:: driver"
	write (u, "(A)") " type(string_t), intent(in) :: basename"
	write (u, "(A)") " logical, intent(in), optional :: " // &
	"modellibs_ldflags"
	write (u, "(A)") " select case (char (basename))"
	do i = 1, size (compilation%lib_name)
	associate (lib_name => compilation%lib_name(i))
	write (u, "(3A)") " case ('", char (lib_name), "')"
	write (u, "(3A)") " allocate (", char (lib_name), "_driver_t &
	&:: driver)"
	end associate
	end do
	write (u, "(A)") " end select"
	write (u, "(A)") "end subroutine dispatch_prclib_static"
	write (u, *)
	write (u, "(A)") "subroutine get_prclib_static (libname)"
	write (u, "(A)") " use iso_varying_string, string_t => varying_string"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " type(string_t), dimension(:), intent(inout), &
	&allocatable :: libname"
	write (u, "(A,I0,A)") " allocate (libname (", &
	size (compilation%lib_name), "))"
	do i = 1, size (compilation%lib_name)
	associate (lib_name => compilation%lib_name(i))
	write (u, "(A,I0,A,A,A)") " libname(", i, ") = '", &
	char (lib_name), "'"
	end associate
	end do
	write (u, "(A)") "end subroutine get_prclib_static"
	close (u)
	end subroutine compilation_write_dispatcher

	@ %def compilation_write_dispatcher
	@ Write the Makefile subroutine for the compiled libraries.
	<<Compilations: compilation: TBP>>=
	procedure :: write_makefile => compilation_write_makefile
	<<Compilations: procedures>>=
	subroutine compilation_write_makefile (compilation, os_data, ext_libtag)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: ext_libtag
	type(string_t) :: file, ext_tag
	integer :: u, i
	if (present (ext_libtag)) then
	ext_tag = ext_libtag
	else
	ext_tag = ""
	end if
	file = compilation%exe_name // ".makefile"
	call msg_message ("Static executable '" // char (compilation%exe_name) &
	// "': writing makefile")
	u = free_unit ()
	open (u, file = char (file), status="replace", action="write")
	write (u, "(3A)") "# WHIZARD: Makefile for executable '", &
	char (compilation%exe_name), "'"
	write (u, "(A)") "# Automatically generated file, do not edit"
	write (u, "(A)") ""
	write (u, "(A)") "# Executable name"
	write (u, "(A)") "EXE = " // char (compilation%exe_name)
	write (u, "(A)") ""
	write (u, "(A)") "# Compiler"
	write (u, "(A)") "FC = " // char (os_data%fc)
	write (u, "(A)") ""
	write (u, "(A)") "# Included libraries"
	write (u, "(A)") "FCINCL = " // char (os_data%whizard_includes)
	write (u, "(A)") ""
	write (u, "(A)") "# Compiler flags"
	write (u, "(A)") "FCFLAGS = " // char (os_data%fcflags)
	write (u, "(A)") "LDFLAGS = " // char (os_data%ldflags)
	write (u, "(A)") "LDFLAGS_STATIC = " // char (os_data%ldflags_static)
	write (u, "(A)") "LDFLAGS_HEPMC = " // char (os_data%ldflags_hepmc)
	write (u, "(A)") "LDFLAGS_LCIO = " // char (os_data%ldflags_lcio)
	write (u, "(A)") "LDFLAGS_HOPPET = " // char (os_data%ldflags_hoppet)
	write (u, "(A)") "LDFLAGS_LOOPTOOLS = " // char (os_data%ldflags_looptools)
	write (u, "(A)") "LDWHIZARD = " // char (os_data%whizard_ldflags)
	write (u, "(A)") ""
	write (u, "(A)") "# Libtool"
	write (u, "(A)") "LIBTOOL = " // char (os_data%whizard_libtool)
	write (u, "(A)") "FCOMPILE = $(LIBTOOL) --tag=FC --mode=compile"
	write (u, "(A)") "LINK = $(LIBTOOL) --tag=FC --mode=link"
	write (u, "(A)") ""
	write (u, "(A)") "# Compile commands (default)"
	write (u, "(A)") "LTFCOMPILE = $(FCOMPILE) $(FC) -c $(FCINCL) $(FCFLAGS)"
	write (u, "(A)") ""
	write (u, "(A)") "# Default target"
	write (u, "(A)") "all: link"
	write (u, "(A)") ""
	write (u, "(A)") "# Libraries"
	do i = 1, size (compilation%lib_name)
	associate (lib_name => compilation%lib_name(i))
	write (u, "(A)") "LIBRARIES += " // char (lib_name) // ".la"
	write (u, "(A)") char (lib_name) // ".la:"
	write (u, "(A)") TAB // "$(MAKE) -f " // char (lib_name) // ".makefile"
	end associate
	end do
	write (u, "(A)") ""
	write (u, "(A)") "# Library dispatcher"
	write (u, "(A)") "DISP = $(EXE)_prclib_dispatcher"
	write (u, "(A)") "$(DISP).lo: $(DISP).f90 $(LIBRARIES)"
	write (u, "(A)") TAB // "$(LTFCOMPILE) $<"
	write (u, "(A)") ""
	write (u, "(A)") "# Executable"
	write (u, "(A)") "$(EXE): $(DISP).lo $(LIBRARIES)"
	write (u, "(A)") TAB // "$(LINK) $(FC) -static-libtool-libs $(FCFLAGS) \"
	write (u, "(A)") TAB // " $(LDWHIZARD) $(LDFLAGS) \"
	write (u, "(A)") TAB // " -o $(EXE) $^ \"
	write (u, "(A)") TAB // " $(LDFLAGS_HEPMC) $(LDFLAGS_LCIO) $(LDFLAGS_HOPPET) \"
	write (u, "(A)") TAB // " $(LDFLAGS_LOOPTOOLS) $(LDFLAGS_STATIC)" // char (ext_tag)
	write (u, "(A)") ""
	write (u, "(A)") "# Main targets"
	write (u, "(A)") "link: compile $(EXE)"
	write (u, "(A)") "compile: $(LIBRARIES) $(DISP).lo"
	write (u, "(A)") ".PHONY: link compile"
	write (u, "(A)") ""
	write (u, "(A)") "# Cleanup targets"
	write (u, "(A)") "clean-exe:"
	write (u, "(A)") TAB // "rm -f $(EXE)"
	write (u, "(A)") "clean-objects:"
	write (u, "(A)") TAB // "rm -f $(DISP).lo"
	write (u, "(A)") "clean-source:"
	write (u, "(A)") TAB // "rm -f $(DISP).f90"
	write (u, "(A)") "clean-makefile:"
	write (u, "(A)") TAB // "rm -f $(EXE).makefile"
	write (u, "(A)") ""
	write (u, "(A)") "clean: clean-exe clean-objects clean-source"
	write (u, "(A)") "distclean: clean clean-makefile"
	write (u, "(A)") ".PHONY: clean distclean"
	close (u)
	end subroutine compilation_write_makefile

	@ %def compilation_write_makefile
	@ Compile the dispatcher source code.
	<<Compilations: compilation: TBP>>=
	procedure :: make_compile => compilation_make_compile
	<<Compilations: procedures>>=
	subroutine compilation_make_compile (compilation, os_data)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	call os_system_call ("make compile " // os_data%makeflags &
	// " -f " // compilation%exe_name // ".makefile")
	end subroutine compilation_make_compile

	@ %def compilation_make_compile
	@ Link the dispatcher together with all matrix-element code and the
	\whizard\ and \oMega\ main libraries, to generate a static executable.
	<<Compilations: compilation: TBP>>=
	procedure :: make_link => compilation_make_link
	<<Compilations: procedures>>=
	subroutine compilation_make_link (compilation, os_data)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	call os_system_call ("make link " // os_data%makeflags &
	// " -f " // compilation%exe_name // ".makefile")
	end subroutine compilation_make_link

	@ %def compilation_make_link
	@ Cleanup.
	<<Compilations: compilation: TBP>>=
	procedure :: make_clean_exe => compilation_make_clean_exe
	<<Compilations: procedures>>=
	subroutine compilation_make_clean_exe (compilation, os_data)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	call os_system_call ("make clean-exe " // os_data%makeflags &
	// " -f " // compilation%exe_name // ".makefile")
	end subroutine compilation_make_clean_exe

	@ %def compilation_make_clean_exe
	@
	\subsection{API for executable compilation}
	This is a shorthand for compiling and loading an executable, including
	the enclosed libraries. The [[compilation]] object is used only internally.

	The [[global]] data set may actually be local to the caller. The
	compilation affects the library specified by its name if it is on the
	stack, but it does not reset the currently selected library.
	<<Compilations: public>>=
	public :: compile_executable
	<<Compilations: procedures>>=
	subroutine compile_executable (exename, libname, global)
	type(string_t), intent(in) :: exename
	type(string_t), dimension(:), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: global
	type(compilation_t) :: compilation
	type(compilation_item_t) :: item
	type(string_t) :: ext_libtag
	logical :: force, recompile
	integer :: i
	ext_libtag = ""
	force = &
	global%var_list%get_lval (var_str ("?rebuild_library"))
	recompile = &
	global%var_list%get_lval (var_str ("?recompile_library"))
	call compilation%init (exename, [libname])
	if (signal_is_pending ()) return
	call compilation%write_dispatcher ()
	if (signal_is_pending ()) return
	do i = 1, size (libname)
	call item%init (libname(i), global%prclib_stack, global%var_list)
	call item%compile (global%model, global%os_data, &
	force=force, recompile=recompile)
	ext_libtag = "" // item%lib%get_static_modelname (global%os_data)
	if (signal_is_pending ()) return
	call item%success ()
	end do
	call compilation%write_makefile (global%os_data, ext_libtag)
	if (signal_is_pending ()) return
	call compilation%make_compile (global%os_data)
	if (signal_is_pending ()) return
	call compilation%make_link (global%os_data)
	end subroutine compile_executable

	@ %def compile_executable
	@
	\subsection{Unit Tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[compilations_ut.f90]]>>=
	<<File header>>

	module compilations_ut
	use unit_tests
	use compilations_uti

	<<Standard module head>>

	<<Compilations: public test>>

	contains

	<<Compilations: test driver>>

	end module compilations_ut
	@ %def compilations_ut
	@
	<<[[compilations_uti.f90]]>>=
	<<File header>>

	module compilations_uti

	<<Use strings>>
	use io_units
	use models
	use rt_data
	use process_configurations_ut, only: prepare_test_library

	use compilations

	<<Standard module head>>

	<<Compilations: test declarations>>

	contains

	<<Compilations: tests>>

	end module compilations_uti

	@ %def compilations_uti
	@ API: driver for the unit tests below.
	<<Compilations: public test>>=
	public :: compilations_test
	<<Compilations: test driver>>=
	subroutine compilations_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Compilations: execute tests>>
	end subroutine compilations_test

	@ %def compilations_test
	@
	\subsubsection{Intrinsic Matrix Element}
	Compile an intrinsic test matrix element ([[prc_test]] type).

	Note: In this and the following test, we reset the Fortran compiler and flag
	variables immediately before they are printed, so the test is portable.
	<<Compilations: execute tests>>=
	call test (compilations_1, "compilations_1", &
	"intrinsic test processes", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_1
	<<Compilations: tests>>=
	subroutine compilations_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: compilations_1"
	write (u, "(A)") "* Purpose: configure and compile test process"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	libname = "compilation_1"
	procname = "prc_comp_1"
	call prepare_test_library (global, libname, 1, [procname])

	call compile_library (libname, global)

	call global%write_libraries (u)

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine compilations_1

	@ %def compilations_1
	@
	\subsubsection{External Matrix Element}
	Compile an external test matrix element ([[omega]] type)
	<<Compilations: execute tests>>=
	call test (compilations_2, "compilations_2", &
	"external process (omega)", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_2
	<<Compilations: tests>>=
	subroutine compilations_2 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: compilations_2"
	write (u, "(A)") "* Purpose: configure and compile test process"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	libname = "compilation_2"
	procname = "prc_comp_2"
	call prepare_test_library (global, libname, 2, [procname,procname])

	call compile_library (libname, global)

	call global%write_libraries (u, libpath = .false.)

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine compilations_2

	@ %def compilations_2
	@
	\subsubsection{External Matrix Element}
	Compile an external test matrix element ([[omega]] type) and
	create driver files for a static executable.
	<<Compilations: execute tests>>=
	call test (compilations_3, "compilations_3", &
	"static executable: driver", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_3
	<<Compilations: tests>>=
	subroutine compilations_3 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname, exename
	type(rt_data_t), target :: global
	type(compilation_t) :: compilation
	integer :: u_file
	character(80) :: buffer

	write (u, "(A)") "* Test output: compilations_3"
	write (u, "(A)") "* Purpose: make static executable"
	write (u, "(A)")

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

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	libname = "compilations_3_lib"
	procname = "prc_comp_3"
	exename = "compilations_3"

	call prepare_test_library (global, libname, 2, [procname,procname])

	call compilation%init (exename, [libname])
	call compilation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write dispatcher"
	write (u, "(A)")

	call compilation%write_dispatcher ()

	u_file = free_unit ()
	open (u_file, file = char (exename) // "_prclib_dispatcher.f90", &
	status = "old", action = "read")
	do
	read (u_file, "(A)", end = 1) buffer
	write (u, "(A)") trim (buffer)
	end do
	1 close (u_file)

	write (u, "(A)")
	write (u, "(A)") "* Write Makefile"
	write (u, "(A)")

	associate (os_data => global%os_data)
	os_data%fc = "fortran-compiler"
	os_data%whizard_includes = "my-includes"
	os_data%fcflags = "my-fcflags"
	os_data%ldflags = "my-ldflags"
	os_data%ldflags_static = "my-ldflags-static"
	os_data%ldflags_hepmc = "my-ldflags-hepmc"
	os_data%ldflags_lcio = "my-ldflags-lcio"
	os_data%ldflags_hoppet = "my-ldflags-hoppet"
	os_data%ldflags_looptools = "my-ldflags-looptools"
	os_data%whizard_ldflags = "my-ldwhizard"
	os_data%whizard_libtool = "my-libtool"
	end associate

	call compilation%write_makefile (global%os_data)

	open (u_file, file = char (exename) // ".makefile", &
	status = "old", action = "read")
	do
	read (u_file, "(A)", end = 2) buffer
	write (u, "(A)") trim (buffer)
	end do
	2 close (u_file)

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

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine compilations_3

	@ %def compilations_3
	@
	\subsection{Test static build}
	The tests for building a static executable are separate, since they
	should be skipped if the \whizard\ build itself has static libraries
	disabled.
	<<Compilations: public test>>=
	public :: compilations_static_test
	<<Compilations: test driver>>=
	subroutine compilations_static_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Compilations: static tests>>
	end subroutine compilations_static_test

	@ %def compilations_static_test
	@
	\subsubsection{External Matrix Element}
	Compile an external test matrix element ([[omega]] type) and
	incorporate this in a new static WHIZARD executable.
	<<Compilations: static tests>>=
	call test (compilations_static_1, "compilations_static_1", &
	"static executable: compilation", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_static_1
	<<Compilations: tests>>=
	subroutine compilations_static_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname, exename
	type(rt_data_t), target :: global
	type(compilation_item_t) :: item
	type(compilation_t) :: compilation
	logical :: exist

	write (u, "(A)") "* Test output: compilations_static_1"
	write (u, "(A)") "* Purpose: make static executable"
	write (u, "(A)")

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

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	libname = "compilations_static_1_lib"
	procname = "prc_comp_stat_1"
	exename = "compilations_static_1"

	call prepare_test_library (global, libname, 2, [procname,procname])

	call compilation%init (exename, [libname])

	write (u, "(A)")
	write (u, "(A)") "* Write dispatcher"

	call compilation%write_dispatcher ()

	write (u, "(A)")
	write (u, "(A)") "* Write Makefile"

	call compilation%write_makefile (global%os_data)

	write (u, "(A)")
	write (u, "(A)") "* Build libraries"

	call item%init (libname, global%prclib_stack, global%var_list)
	call item%compile &
	(global%model, global%os_data, force=.true., recompile=.false.)
	call item%success ()

	write (u, "(A)")
	write (u, "(A)") "* Check executable (should be absent)"
	write (u, "(A)")

	call compilation%make_clean_exe (global%os_data)
	inquire (file = char (exename), exist = exist)
	write (u, "(A,A,L1)") char (exename), " exists = ", exist

	write (u, "(A)")
	write (u, "(A)") "* Build executable"
	write (u, "(A)")

	call compilation%make_compile (global%os_data)
	call compilation%make_link (global%os_data)

	write (u, "(A)") "* Check executable (should be present)"
	write (u, "(A)")

	inquire (file = char (exename), exist = exist)
	write (u, "(A,A,L1)") char (exename), " exists = ", exist

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

	call compilation%make_clean_exe (global%os_data)

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine compilations_static_1

	@ %def compilations_static_1
	@
	\subsubsection{External Matrix Element}
	Compile an external test matrix element ([[omega]] type) and
	incorporate this in a new static WHIZARD executable. In this version,
	we use the wrapper [[compile_executable]] procedure.
	<<Compilations: static tests>>=
	call test (compilations_static_2, "compilations_static_2", &
	"static executable: shortcut", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_static_2
	<<Compilations: tests>>=
	subroutine compilations_static_2 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname, exename
	type(rt_data_t), target :: global
	logical :: exist
	integer :: u_file

	write (u, "(A)") "* Test output: compilations_static_2"
	write (u, "(A)") "* Purpose: make static executable"
	write (u, "(A)")

	write (u, "(A)") "* Initialize library and compile"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	libname = "compilations_static_2_lib"
	procname = "prc_comp_stat_2"
	exename = "compilations_static_2"

	call prepare_test_library (global, libname, 2, [procname,procname])

	call compile_executable (exename, [libname], global)

	write (u, "(A)") "* Check executable (should be present)"
	write (u, "(A)")

	inquire (file = char (exename), exist = exist)
	write (u, "(A,A,L1)") char (exename), " exists = ", exist

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

	u_file = free_unit ()
	open (u_file, file = char (exename), status = "old", action = "write")
	close (u_file, status = "delete")

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine compilations_static_2

	@ %def compilations_static_2
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Integration}
	This module manages phase space setup, matrix-element evaluation and
	integration, as far as it is not done by lower-level routines, in particular
	in the [[processes]] module.
	<<[[integrations.f90]]>>=
	<<File header>>

	module integrations

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use diagnostics
	use os_interface
	use cputime
	use sm_qcd
	use physics_defs
	use model_data
	use pdg_arrays
	use variables
	use eval_trees
	use sf_mappings
	use sf_base
	use phs_base
	use mappings
	use phs_forests, only: phs_parameters_t
	use rng_base
	use mci_base
	use process_libraries
	use prc_core
	! TODO: (bcn 2016-09-13) details of process config should not be necessary here
	use process_config
	use process
	use instances
	use process_stacks
	use models
	use iterations
	use rt_data

	use dispatch_rng, only: dispatch_rng_factory
	use dispatch_me_methods, only: dispatch_core
	use dispatch_beams, only: dispatch_qcd, sf_prop_t, dispatch_sf_config
	use dispatch_phase_space, only: dispatch_sf_channels
	use dispatch_phase_space, only: dispatch_phs
	use dispatch_mci, only: dispatch_mci_s

	use compilations, only: compile_library

	use dispatch_fks, only: dispatch_fks_s
	use blha_olp_interfaces
	use nlo_data

	<<Standard module head>>

	<<Integrations: public>>

	<<Integrations: types>>

	contains

	<<Integrations: procedures>>

	end module integrations
	@ %def integrations
	@
	\subsection{The integration type}
	This type holds all relevant data, the integration methods operates on this.
	In contrast to the [[simulation_t]] introduced later, the [[integration_t]]
	applies to a single process.
	<<Integrations: public>>=
	public :: integration_t
	<<Integrations: types>>=
	type :: integration_t
	private
	type(string_t) :: process_id
	type(string_t) :: run_id
	type(process_t), pointer :: process => null ()
	type(var_list_t), pointer :: model_vars => null ()
	type(qcd_t) :: qcd
	logical :: rebuild_phs = .false.
	logical :: ignore_phs_mismatch = .false.
	logical :: phs_only = .false.
	logical :: process_has_me = .true.
	integer :: n_calls_test = 0
	logical :: vis_history = .true.
	type(string_t) :: history_filename
	type(string_t) :: log_filename
	logical :: combined_integration = .false.
	type(iteration_multipliers_t) :: iteration_multipliers
	type(nlo_settings_t) :: nlo_settings
	contains
	<<Integrations: integration: TBP>>
	end type integration_t

	@ %def integration_t
	@
	@
	\subsection{Initialization}
	Initialization, first part: Create a process entry.
	Push it on the stack if the [[global]] environment is supplied.
	<<Integrations: integration: TBP>>=
	procedure :: create_process => integration_create_process
	<<Integrations: procedures>>=
	subroutine integration_create_process (intg, process_id, global)
	class(integration_t), intent(out) :: intg
	type(rt_data_t), intent(inout), optional, target :: global
	type(string_t), intent(in) :: process_id
	type(process_entry_t), pointer :: process_entry
	call msg_debug (D_CORE, "integration_create_process")
	intg%process_id = process_id
	if (present (global)) then
	allocate (process_entry)
	intg%process => process_entry%process_t
	call global%process_stack%push (process_entry)
	else
	allocate (process_t :: intg%process)
	end if
	intg%model_vars => null ()
	end subroutine integration_create_process

	@ %def integration_create_process
	@ Initialization, second part: Initialize the process object, using the local
	environment. We allocate a RNG factory and a QCD object.
	We also fetch a pointer to the model that the process uses. The
	process initializer will create a snapshot of that model.

	This procedure
	does not modify the [[local]] stack directly. The intent(inout) attribute for
	the [[local]] data set is due to the random generator seed which may be
	incremented during initialization.

	NOTE: Changes to model parameters within the current context are respected
	only if the process model coincides with the current model. This is the usual
	case. If not, we read
	the model from the global model library, which has default parameters. To
	become more flexible, we should implement a local model library which records
	local changes to currently inactive models.
	<<Integrations: integration: TBP>>=
	procedure :: init_process => integration_init_process
	<<Integrations: procedures>>=
	subroutine integration_init_process (intg, local)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(inout), target :: local
	type(string_t) :: model_name
	type(model_t), pointer :: model
	class(model_data_t), pointer :: model_instance
	class(rng_factory_t), allocatable :: rng_factory
	call msg_debug (D_CORE, "integration_init_process")
	if (.not. local%prclib%contains (intg%process_id)) then
	call msg_fatal ("Process '" // char (intg%process_id) // "' not found" &
	// " in library '" // char (local%prclib%get_name ()) // "'")
	return
	end if
	intg%run_id = &
	local%var_list%get_sval (var_str ("$run_id"))
	call dispatch_qcd (intg%qcd, local%get_var_list_ptr (), local%os_data)
	call dispatch_rng_factory (rng_factory, local%var_list)
	model_name = local%prclib%get_model_name (intg%process_id)
	if (local%get_sval (var_str ("$model_name")) == model_name) then
	model => local%model
	else
	model => local%model_list%get_model_ptr (model_name)
	end if
	allocate (model_t :: model_instance)
	select type (model_instance)
	type is (model_t)
	call model_instance%init_instance (model)
	intg%model_vars => model_instance%get_var_list_ptr ()
	end select
	call intg%process%init (intg%process_id, intg%run_id, &
	local%prclib, &
	local%os_data, intg%qcd, rng_factory, model_instance)
	end subroutine integration_init_process

	@ %def integration_init_process
	@ Initialization, third part: complete process configuration.
	<<Integrations: integration: TBP>>=
	procedure :: setup_process => integration_setup_process
	<<Integrations: procedures>>=
	subroutine integration_setup_process (intg, local, verbose)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(inout), target :: local
	logical, intent(in), optional :: verbose
	type(var_list_t), pointer :: var_list
	class(prc_core_t), allocatable :: core_template
	class(prc_core_t), pointer :: core => null ()
	class(phs_config_t), allocatable :: phs_config_template
	type(phs_parameters_t) :: phs_par
	type(mapping_defaults_t) :: mapping_defs
	class(mci_t), allocatable :: mci_template
	integer :: n_components, i_component
	type(process_component_def_t), pointer :: config
	type(helicity_selection_t) :: helicity_selection
	logical :: use_color_factors
	type(sf_config_t), dimension(:), allocatable :: sf_config
	type(sf_prop_t) :: sf_prop
	type(sf_channel_t), dimension(:), allocatable :: sf_channel
	type(phs_channel_collection_t) :: phs_channel_collection
	logical :: sf_trace
	logical :: verb
	type(blha_template_t) :: blha_template
	type(fks_template_t) :: fks_template
	type(string_t) :: sf_string
	class(phs_config_t), allocatable :: phs_config_template_other
	integer :: i_real = 0
	integer :: i_core
	integer :: i_core_born, i_core_real
	verb = .true.; if (present (verbose)) verb = verbose
	call intg%process%set_var_list (local%get_var_list_ptr ())
	var_list => intg%process%get_var_list_ptr ()

	call setup_phase_space ()

	intg%n_calls_test = &
	var_list%get_ival (var_str ("n_calls_test"))

	call setup_log_and_history ()

	call dispatch_mci_s (mci_template, local%get_var_list_ptr (), intg%process_id, &
	intg%process%is_nlo_calculation ())

	call display_init_message (verb)

	n_components = intg%process%get_n_components ()

	call blha_template%init (local%beam_structure%has_polarized_beams(), &
	var_list%get_lval (var_str ("?openloops_switch_off_muon_yukawa")), &
	var_list%get_rval (var_str ("blha_use_top_yukawa")))

	intg%combined_integration = var_list%get_lval &
	(var_str ('?combined_nlo_integration')) .and. &
	intg%process%is_nlo_calculation ()

	helicity_selection = local%get_helicity_selection ()
	use_color_factors = var_list%get_lval &
	(var_str ("?read_color_factors"))
	do i_component = 1, n_components
	config => intg%process%get_component_def_ptr (i_component)
	call intg%process%core_manager_register &
	(config%get_nlo_type (), i_component, config%get_def_type_string ())
	end do
	call intg%process%allocate_cm_arrays (n_components)
	do i_core = 1, intg%process%get_n_cores ()
	i_component = intg%process%get_core_manager_index (i_core)
	config => intg%process%get_component_def_ptr (i_component)
	call dispatch_core (core_template, config%get_core_def_ptr (), &
	intg%process%get_model_ptr (), &
	helicity_selection, intg%qcd, &
	use_color_factors)
	call intg%process%allocate_core (i_core, core_template)
	deallocate (core_template)
	end do

	do i_core = 1, intg%process%get_n_cores ()
	call fill_blha_template (intg%process%get_nlo_type (i_core))
	call intg%process%init_core (i_core, blha_template)
	call blha_template%reset ()
	end do

	do i_component = 1, n_components
	config => intg%process%get_component_def_ptr (i_component)
	core => intg%process%get_core_nlo_type ( &
	intg%process%get_md5sum_constants (i_component, &
	config%get_def_type_string (), config%get_nlo_type ()))
	select case (config%get_nlo_type ())
	case (NLO_VIRTUAL)
	call setup_virtual_component ()
	case (NLO_REAL)
	call setup_real_component ()
	if (intg%process%get_component_type (i_component) /= COMP_REAL_FIN) &
	i_real = i_component
	case (NLO_MISMATCH)
	call setup_mismatch_component ()
	case (NLO_DGLAP)
	call setup_dglap_component ()
	case (BORN)
	call setup_born_component ()
	case (NLO_SUBTRACTION)
	call setup_subtraction_component ()
	case (GKS)
	call intg%process%init_component &
	(i_component, core%has_matrix_element (), &
	mci_template, phs_config_template)
	case default
	call msg_fatal ("setup_process: NLO type not implemented!")
	end select
	if (allocated (phs_config_template_other)) &
	deallocate (phs_config_template_other)
	end do

	if (verb) call intg%process%write (screen = .true.)

	intg%process_has_me = intg%process%has_matrix_element ()
	if (.not. intg%process_has_me) then
	call msg_warning ("Process '" &
	// char (intg%process_id) // "': matrix element vanishes")
	end if

	call setup_beams ()
	call setup_structure_functions ()

	call intg%process%configure_phs &
	(intg%rebuild_phs, intg%ignore_phs_mismatch, verbose=verbose, &
	combined_integration = intg%combined_integration)

	if (intg%process%is_nlo_calculation ()) then
	call intg%process%init_nlo_settings (var_list, fks_template)
	i_core_real = intg%process%get_i_core_nlo_type (NLO_REAL)
	i_core_born = intg%process%get_i_core_nlo_type (BORN)
	call intg%process%setup_region_data (i_real, &
	intg%process%get_constants(i_core_born), intg%process%get_constants(i_core_real))
	end if

	call intg%process%setup_terms (with_beams = local%beam_structure%is_set ())
	if (intg%process%is_nlo_calculation ()) &
	call intg%process%check_if_threshold_method (i_real)

	if (intg%process_has_me) then
	if (size (sf_config) > 0) then
	call intg%process%collect_channels (phs_channel_collection)
	else if (intg%process%contains_trivial_component ()) then
	call msg_fatal ("Integrate: 2 -> 1 process can't be handled &
	&with fixed-energy beams")
	end if
	call dispatch_sf_channels &
	(sf_channel, sf_string, sf_prop, phs_channel_collection, &
	local%var_list, local%get_sqrts(), local%beam_structure)
	if (allocated (sf_channel)) then
	if (size (sf_channel) > 0) then
	call intg%process%set_sf_channel (sf_channel)
	end if
	end if
	call phs_channel_collection%final ()
	if (verb) call intg%process%sf_startup_message (sf_string)
	end if

	call intg%setup_process_mci ()

	call setup_expressions ()

	call intg%process%compute_md5sum ()
	contains
	subroutine setup_phase_space ()
	intg%rebuild_phs = &
	var_list%get_lval (var_str ("?rebuild_phase_space"))
	intg%ignore_phs_mismatch = &
	.not. var_list%get_lval (var_str ("?check_phs_file"))
	intg%phs_only = &
	var_list%get_lval (var_str ("?phs_only"))
	phs_par%m_threshold_s = &
	var_list%get_rval (var_str ("phs_threshold_s"))
	phs_par%m_threshold_t = &
	var_list%get_rval (var_str ("phs_threshold_t"))
	phs_par%off_shell = &
	var_list%get_ival (var_str ("phs_off_shell"))
	phs_par%keep_nonresonant = &
	var_list%get_lval (var_str ("?phs_keep_nonresonant"))
	phs_par%t_channel = &
	var_list%get_ival (var_str ("phs_t_channel"))
	mapping_defs%energy_scale = &
	var_list%get_rval (var_str ("phs_e_scale"))
	mapping_defs%invariant_mass_scale = &
	var_list%get_rval (var_str ("phs_m_scale"))
	mapping_defs%momentum_transfer_scale = &
	var_list%get_rval (var_str ("phs_q_scale"))
	mapping_defs%step_mapping = &
	var_list%get_lval (var_str ("?phs_step_mapping"))
	mapping_defs%step_mapping_exp = &
	var_list%get_lval (var_str ("?phs_step_mapping_exp"))
	mapping_defs%enable_s_mapping = &
	var_list%get_lval (var_str ("?phs_s_mapping"))

	call dispatch_phs (phs_config_template, local%var_list, &
	local%os_data, intg%process_id, mapping_defs, phs_par)
	end subroutine setup_phase_space

	subroutine setup_log_and_history ()
	!!! We avoid two dots in the filename due to a bug in certain MetaPost versions.
	if (intg%run_id /= "") then
	intg%history_filename = intg%process_id // "." // intg%run_id &
	// "-history"
	intg%log_filename = intg%process_id // "." // intg%run_id // ".log"
	else
	intg%history_filename = intg%process_id // "-history"
	intg%log_filename = intg%process_id // ".log"
	end if
	intg%vis_history = &
	var_list%get_lval (var_str ("?vis_history"))
	end subroutine setup_log_and_history

	subroutine display_init_message (verb)
	logical, intent(in) :: verb
	if (verb) then
	call msg_message ("Initializing integration for process " &
	// char (intg%process_id) // ":")
	if (intg%run_id /= "") &
	call msg_message ("Run ID = " // '"' // char (intg%run_id) // '"')
	end if
	end subroutine display_init_message

	function get_me_method (nlo_type) result (me_method)
	type(string_t) :: me_method
	integer, intent(in) :: nlo_type
	select case (nlo_type)
	case (BORN)
	me_method = var_list%get_sval (var_str ("$born_me_method"))
	case (NLO_REAL)
	me_method = var_list%get_sval (var_str ("$real_tree_me_method"))
	case (NLO_VIRTUAL)
	me_method = var_list%get_sval (var_str ("$loop_me_method"))
	case (NLO_SUBTRACTION)
	me_method = var_list%get_sval (var_str ("$correlation_me_method"))
	end select
	end function get_me_method

	subroutine setup_born_component ()
	call intg%process%init_component &
	(i_component, core%has_matrix_element (), &
	mci_template, phs_config_template)
	if (intg%combined_integration) &
	call intg%process%set_component_type (i_component, COMP_MASTER)
	end subroutine setup_born_component

	subroutine setup_virtual_component ()
	call intg%process%init_component &
	(i_component, core%has_matrix_element (), &
	mci_template, phs_config_template)
	if (intg%combined_integration) &
	call intg%process%set_component_type (i_component, COMP_VIRT)
	end subroutine setup_virtual_component

	subroutine setup_real_component ()
	logical :: use_powheg_damping
	logical :: setup_real_fin
	integer :: i = 0
	use_powheg_damping = var_list%get_lval (var_str ("?powheg_use_damping"))
	setup_real_fin = i > 0
	if (.not. setup_real_fin) then
	call dispatch_phs (phs_config_template_other, local%var_list, &
	local%os_data, intg%process_id, mapping_defs, phs_par, &
	var_str ('fks'))
	call dispatch_fks_s (fks_template, local%var_list)
	else
	call dispatch_phs (phs_config_template_other, local%var_list, &
	local%os_data, intg%process_id, mapping_defs, phs_par, &
	var_str ('wood'))
	end if
	call intg%process%init_component &
	(i_component, core%has_matrix_element (), mci_template, &
	phs_config_template_other)
	if (intg%combined_integration) then
	if (use_powheg_damping) then
	if (i == 0) then
	call intg%process%set_component_type (i_component, COMP_REAL_SING)
	i = i + 1
	else
	call intg%process%set_component_type (i_component, COMP_REAL_FIN)
	end if
	else
	call intg%process%set_component_type (i_component, COMP_REAL)
	end if
	end if
	end subroutine setup_real_component

	subroutine setup_mismatch_component ()
	call dispatch_phs (phs_config_template_other, local%var_list, &
	local%os_data, intg%process_id, mapping_defs, phs_par, var_str ('fks'))
	call intg%process%init_component &
	(i_component, core%has_matrix_element (), mci_template, &
	phs_config_template_other)
	if (intg%combined_integration) &
	call intg%process%set_component_type (i_component, COMP_MISMATCH)
	end subroutine setup_mismatch_component

	subroutine setup_dglap_component ()
	call dispatch_phs (phs_config_template_other, local%var_list, local%os_data, &
	intg%process_id, mapping_defs, phs_par, &
	var_str ('fks'))
	call intg%process%init_component &
	(i_component, core%has_matrix_element (), &
	mci_template, phs_config_template_other)
	if (intg%combined_integration) &
	call intg%process%set_component_type (i_component, COMP_PDF)
	end subroutine setup_dglap_component

	subroutine setup_subtraction_component ()
	call intg%process%init_component &
	(i_component, .false., &
	mci_template, phs_config_template)
	if (intg%combined_integration) &
	call intg%process%set_component_type (i_component, COMP_SUB)
	end subroutine setup_subtraction_component

	function needs_entry (me_method) result (val)
	logical :: val
	type(string_t), intent(in) :: me_method
	val = char (me_method) == 'gosam' .or. char (me_method) == 'openloops'
	end function needs_entry

	subroutine fill_blha_template (nlo_type)
	integer, intent(in) :: nlo_type
	select case (nlo_type)
	case (BORN)
	if (needs_entry (var_list%get_sval (var_str ("$born_me_method")))) &
	call blha_template%set_born ()
	case (NLO_REAL)
	if (needs_entry (var_list%get_sval (var_str ("$real_tree_me_method")))) &
	call blha_template%set_real_trees ()
	case (NLO_VIRTUAL)
	if (needs_entry (var_list%get_sval (var_str ("$loop_me_method")))) &
	call blha_template%set_loop ()
	case (NLO_SUBTRACTION)
	if (needs_entry (var_list%get_sval (var_str ("$correlation_me_method")))) then
	call blha_template%set_subtraction ()
	call blha_template%set_internal_color_correlations ()
	end if
	end select
	end subroutine fill_blha_template

	subroutine setup_beams ()
	real(default) :: sqrts
	logical :: decay_rest_frame
	sqrts = local%get_sqrts ()
	decay_rest_frame = &
	var_list%get_lval (var_str ("?decay_rest_frame"))
	if (intg%process_has_me) then
	call intg%process%setup_beams_beam_structure &
	(local%beam_structure, sqrts, decay_rest_frame)
	end if
	call intg%process%check_masses ()
	if (verb .and. intg%process_has_me) then
	call intg%process%beams_startup_message &
	(beam_structure = local%beam_structure)
	end if
	end subroutine setup_beams

	subroutine setup_structure_functions ()
	integer :: n_in
	type(pdg_array_t), dimension(:,:), allocatable :: pdg_prc
	type(string_t) :: sf_trace_file
	if (intg%process_has_me) then
	call intg%process%get_pdg_in (pdg_prc)
	else
	n_in = intg%process%get_n_in ()
	allocate (pdg_prc (n_in, n_components))
	pdg_prc = 0
	end if
	call dispatch_sf_config (sf_config, sf_prop, local%beam_structure, &
	local%get_var_list_ptr (), local%var_list, &
	local%model, local%os_data, local%get_sqrts (), pdg_prc)
	sf_trace = &
	var_list%get_lval (var_str ("?sf_trace"))
	sf_trace_file = &
	var_list%get_sval (var_str ("$sf_trace_file"))
	if (sf_trace) then
	call intg%process%init_sf_chain (sf_config, sf_trace_file)
	else
	call intg%process%init_sf_chain (sf_config)
	end if
	end subroutine setup_structure_functions

	subroutine setup_expressions ()
	type(eval_tree_factory_t) :: expr_factory
	if (associated (local%pn%cuts_lexpr)) then
	if (verb) call msg_message ("Applying user-defined cuts.")
	call expr_factory%init (local%pn%cuts_lexpr)
	call intg%process%set_cuts (expr_factory)
	else
	if (verb) call msg_warning ("No cuts have been defined.")
	end if
	if (associated (local%pn%scale_expr)) then
	if (verb) call msg_message ("Using user-defined general scale.")
	call expr_factory%init (local%pn%scale_expr)
	call intg%process%set_scale (expr_factory)
	end if
	if (associated (local%pn%fac_scale_expr)) then
	if (verb) call msg_message ("Using user-defined factorization scale.")
	call expr_factory%init (local%pn%fac_scale_expr)
	call intg%process%set_fac_scale (expr_factory)
	end if
	if (associated (local%pn%ren_scale_expr)) then
	if (verb) call msg_message ("Using user-defined renormalization scale.")
	call expr_factory%init (local%pn%ren_scale_expr)
	call intg%process%set_ren_scale (expr_factory)
	end if
	if (associated (local%pn%weight_expr)) then
	if (verb) call msg_message ("Using user-defined reweighting factor.")
	call expr_factory%init (local%pn%weight_expr)
	call intg%process%set_weight (expr_factory)
	end if
	end subroutine setup_expressions
	end subroutine integration_setup_process

	@ %def integration_setup_process
	@
	\subsection{Integration}
	Integrate: do the final integration. Here, we do a multi-iteration
	integration. Again, we skip iterations that are already on file.
	Record the results in the global variable list.
	<<Integrations: integration: TBP>>=
	procedure :: evaluate => integration_evaluate
	<<Integrations: procedures>>=
	subroutine integration_evaluate &
	(intg, process_instance, i_mci, pass, it_list, pacify)
	class(integration_t), intent(inout) :: intg
	type(process_instance_t), intent(inout), target :: process_instance
	integer, intent(in) :: i_mci
	integer, intent(in) :: pass
	type(iterations_list_t), intent(in) :: it_list
	logical, intent(in), optional :: pacify
	integer :: n_calls, n_it
	logical :: adapt_grids, adapt_weights, final
	n_it = it_list%get_n_it (pass)
	n_calls = it_list%get_n_calls (pass)
	adapt_grids = it_list%adapt_grids (pass)
	adapt_weights = it_list%adapt_weights (pass)
	final = pass == it_list%get_n_pass ()
	call process_instance%integrate ( &
	i_mci, n_it, n_calls, adapt_grids, adapt_weights, &
	final, pacify)
	end subroutine integration_evaluate

	@ %def integration_evaluate
	@ In case the user has not provided a list of iterations, make a
	reasonable default. This can depend on the process. The usual
	approach is to define two distinct passes, one for adaptation and one
	for integration.
	<<Integrations: integration: TBP>>=
	procedure :: make_iterations_list => integration_make_iterations_list
	<<Integrations: procedures>>=
	subroutine integration_make_iterations_list (intg, it_list)
	class(integration_t), intent(in) :: intg
	type(iterations_list_t), intent(out) :: it_list
	integer :: pass, n_pass
	integer, dimension(:), allocatable :: n_it, n_calls
	logical, dimension(:), allocatable :: adapt_grids, adapt_weights
	n_pass = intg%process%get_n_pass_default ()
	allocate (n_it (n_pass), n_calls (n_pass))
	allocate (adapt_grids (n_pass), adapt_weights (n_pass))
	do pass = 1, n_pass
	n_it(pass) = intg%process%get_n_it_default (pass)
	n_calls(pass) = intg%process%get_n_calls_default (pass)
	adapt_grids(pass) = intg%process%adapt_grids_default (pass)
	adapt_weights(pass) = intg%process%adapt_weights_default (pass)
	end do
	call it_list%init (n_it, n_calls, &
	adapt_grids = adapt_grids, adapt_weights = adapt_weights)
	end subroutine integration_make_iterations_list

	@ %def integration_make_iterations_list
	@ In NLO calculations, the individual components might scale very differently
	with the number of calls. This especially applies to the real-subtracted
	component, which usually fluctuates more than the Born and virtual
	component, making it a bottleneck of the calculation. Thus, the calculation
	is throttled twice, first by the number of calls for the real component,
	second by the number of surplus calls of computation-intense virtual
	matrix elements. Therefore, we want to set a different number of calls
	for each component, which is done by the subroutine [[integration_apply_multipliers]].
	<<Integrations: integration: TBP>>=
	procedure :: init_iteration_multipliers => integration_init_iteration_multipliers
	<<Integrations: procedures>>=
	subroutine integration_init_iteration_multipliers (intg, local)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(in) :: local
	integer :: n_pass, pass
	type(iterations_list_t) :: it_list
	n_pass = local%it_list%get_n_pass ()
	if (n_pass == 0) then
	call intg%make_iterations_list (it_list)
	n_pass = it_list%get_n_pass ()
	end if
	associate (it_multipliers => intg%iteration_multipliers)
	allocate (it_multipliers%n_calls0 (n_pass))
	do pass = 1, n_pass
	it_multipliers%n_calls0(pass) = local%it_list%get_n_calls (pass)
	end do
	it_multipliers%mult_real = local%var_list%get_rval &
	(var_str ("mult_call_real"))
	it_multipliers%mult_virt = local%var_list%get_rval &
	(var_str ("mult_call_virt"))
	it_multipliers%mult_dglap = local%var_list%get_rval &
	(var_str ("mult_call_dglap"))
	end associate
	end subroutine integration_init_iteration_multipliers

	@ %def integration_init_iteration_multipliers
	@
	<<Integrations: integration: TBP>>=
	procedure :: apply_call_multipliers => integration_apply_call_multipliers
	<<Integrations: procedures>>=
	subroutine integration_apply_call_multipliers (intg, n_pass, i_component, it_list)
	class(integration_t), intent(in) :: intg
	integer, intent(in) :: n_pass, i_component
	type(iterations_list_t), intent(inout) :: it_list
	integer :: nlo_type
	integer :: n_calls0, n_calls
	integer :: pass
	real(default) :: multiplier
	nlo_type = intg%process%get_component_nlo_type (i_component)
	do pass = 1, n_pass
	associate (multipliers => intg%iteration_multipliers)
	select case (nlo_type)
	case (NLO_REAL)
	multiplier = multipliers%mult_real
	case (NLO_VIRTUAL)
	multiplier = multipliers%mult_virt
	case (NLO_DGLAP)
	multiplier = multipliers%mult_dglap
	case default
	return
	end select
	end associate
	if (n_pass <= size (intg%iteration_multipliers%n_calls0)) then
	n_calls0 = intg%iteration_multipliers%n_calls0 (pass)
	n_calls = floor (multiplier * n_calls0)
	call it_list%set_n_calls (pass, n_calls)
	end if
	end do
	end subroutine integration_apply_call_multipliers

	@ %def integration_apply_call_multipliers
	@
	\subsection{API for integration objects}
	This initializer does everything except assigning cuts/scale/weight
	expressions.
	<<Integrations: integration: TBP>>=
	procedure :: init => integration_init
	<<Integrations: procedures>>=
	subroutine integration_init (intg, process_id, local, global, local_stack)
	class(integration_t), intent(out) :: intg
	type(string_t), intent(in) :: process_id
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	logical, intent(in), optional :: local_stack
	logical :: use_local
	use_local = .false.; if (present (local_stack)) use_local = local_stack
	if (present (global)) then
	call intg%create_process (process_id, global)
	else if (use_local) then
	call intg%create_process (process_id, local)
	else
	call intg%create_process (process_id)
	end if
	call intg%init_process (local)
	call intg%setup_process (local)
	call intg%init_iteration_multipliers (local)
	end subroutine integration_init

	@ %def integration_init
	@ Do the integration for a single process, both warmup and final evaluation.
	The [[eff_reset]] flag is to suppress numerical noise in the graphical output
	of the integration history.
	<<Integrations: integration: TBP>>=
	procedure :: integrate => integration_integrate
	<<Integrations: procedures>>=
	subroutine integration_integrate (intg, local, eff_reset)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(in), target :: local
	logical, intent(in), optional :: eff_reset
	type(string_t) :: log_filename
	type(var_list_t), pointer :: var_list
	type(process_instance_t), allocatable, target :: process_instance
	type(iterations_list_t) :: it_list
	logical :: pacify
	integer :: pass, i_mci, n_mci, n_pass
	integer :: i_component
	integer :: nlo_type
	logical :: display_summed
	logical :: nlo_active
	type(string_t) :: component_output

	allocate (process_instance)
	call process_instance%init (intg%process)

	if (intg%process%needs_extra_code ()) then
	call process_instance%create_and_load_extra_libraries &
	(local%beam_structure, local%os_data)
	end if

	var_list => intg%process%get_var_list_ptr ()
	call openmp_set_num_threads_verbose &
	(var_list%get_ival (var_str ("openmp_num_threads")), &
	var_list%get_lval (var_str ("?openmp_logging")))
	pacify = var_list%get_lval (var_str ("?pacify"))

	display_summed = .true.
	n_mci = intg%process%get_n_mci ()
	if (n_mci == 1) then
	write (msg_buffer, "(A,A,A)") &
	"Starting integration for process '", &
	char (intg%process%get_id ()), "'"
	call msg_message ()
	end if

	nlo_active = any (intg%process%get_component_nlo_type &
	([(i_mci, i_mci = 1, n_mci)]) /= BORN)
	do i_mci = 1, n_mci
	i_component = intg%process%i_mci_to_i_component (i_mci)
	nlo_type = intg%process%get_component_nlo_type (i_component)
	if (intg%process%component_can_be_integrated (i_component)) then
	if (n_mci > 1) then
	if (nlo_active) then
	if (intg%combined_integration .and. nlo_type == BORN) then
	component_output = var_str ("Combined")
	else
	component_output = component_status (nlo_type)
	end if
	write (msg_buffer, "(A,A,A,A,A)") &
	"Starting integration for process '", &
	char (intg%process%get_id ()), "' part '", &
	char (component_output), "'"
	else
	write (msg_buffer, "(A,A,A,I0)") &
	"Starting integration for process '", &
	char (intg%process%get_id ()), "' part ", i_mci
	end if
	call msg_message ()
	end if
	n_pass = local%it_list%get_n_pass ()
	if (n_pass == 0) then
	call msg_message ("Integrate: iterations not specified, &
	&using default")
	call intg%make_iterations_list (it_list)
	n_pass = it_list%get_n_pass ()
	else
	it_list = local%it_list
	end if
	call intg%apply_call_multipliers (n_pass, i_mci, it_list)
	call msg_message ("Integrate: " // char (it_list%to_string ()))
	do pass = 1, n_pass
	call intg%evaluate (process_instance, i_mci, pass, it_list, pacify)
	if (signal_is_pending ()) return
	end do
	call intg%process%final_integration (i_mci)
	if (intg%vis_history) then
	call intg%process%display_integration_history &
	(i_mci, intg%history_filename, local%os_data, eff_reset)
	end if
	if (local%logfile == intg%log_filename) then
	if (intg%run_id /= "") then
	log_filename = intg%process_id // "." // intg%run_id // &
	".var.log"
	else
	log_filename = intg%process_id // ".var.log"
	end if
	call msg_message ("Name clash for global logfile and process log: ", &
	arr =[var_str ("\| Renaming log file from ") // local%logfile, &
	var_str ("\| to ") // log_filename // var_str (" .")])
	else
	log_filename = intg%log_filename
	end if
	call intg%process%write_logfile (i_mci, log_filename)
	else
	if (nlo_type /= NLO_SUBTRACTION) display_summed = .false.
	end if
	end do

	if (n_mci > 1 .and. display_summed) then
	call msg_message ("Integrate: sum of all components")
	call intg%process%display_summed_results ()
	end if

	call process_instance%final ()
	deallocate (process_instance)

	end subroutine integration_integrate

	@ %def integration_integrate
	@
	<<Integrations: integration: TBP>>=
	procedure :: setup_process_mci => integration_setup_process_mci
	<<Integrations: procedures>>=
	subroutine integration_setup_process_mci (intg)
	class(integration_t), intent(inout) :: intg
	call intg%process%setup_mci (intg%combined_integration)
	end subroutine integration_setup_process_mci

	@ %def integration_setup_process_mci@
	@ Do a dummy integration for a process which could not be initialized (e.g.,
	has no matrix element). The result is zero.
	<<Integrations: integration: TBP>>=
	procedure :: integrate_dummy => integration_integrate_dummy
	<<Integrations: procedures>>=
	subroutine integration_integrate_dummy (intg)
	class(integration_t), intent(inout) :: intg
	call intg%process%integrate_dummy ()
	end subroutine integration_integrate_dummy

	@ %def integration_integrate_dummy
	@ Just sample the matrix element under realistic conditions (but no
	cuts); throw away the results.
	<<Integrations: integration: TBP>>=
	procedure :: sampler_test => integration_sampler_test
	<<Integrations: procedures>>=
	subroutine integration_sampler_test (intg)
	class(integration_t), intent(inout) :: intg
	type(process_instance_t), allocatable, target :: process_instance
	integer :: n_mci, i_mci
	type(timer_t) :: timer_mci, timer_tot
	real(default) :: t_mci, t_tot
	allocate (process_instance)
	call process_instance%init (intg%process)
	n_mci = intg%process%get_n_mci ()
	if (n_mci == 1) then
	write (msg_buffer, "(A,A,A)") &
	"Test: probing process '", &
	char (intg%process%get_id ()), "'"
	call msg_message ()
	end if
	call timer_tot%start ()
	do i_mci = 1, n_mci
	if (n_mci > 1) then
	write (msg_buffer, "(A,A,A,I0)") &
	"Test: probing process '", &
	char (intg%process%get_id ()), "' part ", i_mci
	call msg_message ()
	end if
	call timer_mci%start ()
	call process_instance%sampler_test (i_mci, intg%n_calls_test)
	call timer_mci%stop ()
	t_mci = timer_mci
	write (msg_buffer, "(A,ES12.5)") "Test: " &
	// "time in seconds (wallclock): ", t_mci
	call msg_message ()
	end do
	call timer_tot%stop ()
	t_tot = timer_tot
	if (n_mci > 1) then
	write (msg_buffer, "(A,ES12.5)") "Test: " &
	// "total time (wallclock): ", t_tot
	call msg_message ()
	end if
	call process_instance%final ()
	end subroutine integration_sampler_test

	@ %def integration_sampler_test
	@ Return the process pointer (needed by simulate):
	<<Integrations: integration: TBP>>=
	procedure :: get_process_ptr => integration_get_process_ptr
	<<Integrations: procedures>>=
	function integration_get_process_ptr (intg) result (ptr)
	class(integration_t), intent(in) :: intg
	type(process_t), pointer :: ptr
	ptr => intg%process
	end function integration_get_process_ptr

	@ %def integration_get_process_ptr
	@ Simply integrate, do a dummy integration if necessary. The [[integration]]
	object exists only internally.

	If the [[global]] environment is provided, the process object is appended to
	the global stack. Otherwise, if [[local_stack]] is set, we append to the
	local process stack. If this is unset, the [[process]] object is not recorded
	permanently.

	The [[init_only]] flag can be used to skip the actual integration part. We
	will end up with a process object that is completely initialized, including
	phase space configuration.

	The [[eff_reset]] flag is to suppress numerical noise in the visualization
	of the integration history.
	<<Integrations: public>>=
	public :: integrate_process
	<<Integrations: procedures>>=
	subroutine integrate_process (process_id, local, global, local_stack, init_only, eff_reset)
	type(string_t), intent(in) :: process_id
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	logical, intent(in), optional :: local_stack, init_only, eff_reset
	type(string_t) :: prclib_name
	type(integration_t) :: intg
	character(32) :: buffer

	if (.not. associated (local%prclib)) then
	call msg_fatal ("Integrate: current process library is undefined")
	return
	end if

	if (.not. local%prclib%is_active ()) then
	call msg_message ("Integrate: current process library needs compilation")
	prclib_name = local%prclib%get_name ()
	call compile_library (prclib_name, local)
	if (signal_is_pending ()) return
	call msg_message ("Integrate: compilation done")
	end if

	call intg%init (process_id, local, global, local_stack)
	if (signal_is_pending ()) return

	if (present (init_only)) then
	if (init_only) return
	end if

	if (intg%n_calls_test > 0) then
	write (buffer, "(I0)") intg%n_calls_test
	call msg_message ("Integrate: test (" // trim (buffer) // " calls) ...")
	call intg%sampler_test ()
	call msg_message ("Integrate: ... test complete.")
	if (signal_is_pending ()) return
	end if

	if (intg%phs_only) then
	call msg_message ("Integrate: phase space only, skipping integration")
	else
	if (intg%process_has_me) then
	call intg%integrate (local, eff_reset)
	else
	call intg%integrate_dummy ()
	end if
	end if

	end subroutine integrate_process

	@ %def integrate_process
	@
	\subsection{Unit Tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[integrations_ut.f90]]>>=
	<<File header>>

	module integrations_ut
	use unit_tests
	use integrations_uti

	<<Standard module head>>

	<<Integrations: public test>>

	contains

	<<Integrations: test driver>>

	end module integrations_ut
	@ %def integrations_ut
	@
	<<[[integrations_uti.f90]]>>=
	<<File header>>

	module integrations_uti

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use ifiles
	use lexers
	use parser
	use io_units
	use flavors
	use interactions, only: reset_interaction_counter
	use phs_forests
	use eval_trees
	use models
	use rt_data
	use process_configurations_ut, only: prepare_test_library
	use compilations, only: compile_library

	use integrations

	use phs_wood_ut, only: write_test_phs_file

	<<Standard module head>>

	<<Integrations: test declarations>>

	contains

	<<Integrations: tests>>

	end module integrations_uti

	@ %def integrations_uti
	@ API: driver for the unit tests below.
	<<Integrations: public test>>=
	public :: integrations_test
	<<Integrations: test driver>>=
	subroutine integrations_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Integrations: execute tests>>
	end subroutine integrations_test

	@ %def integrations_test
	@
	<<Integrations: public test>>=
	public :: integrations_history_test
	<<Integrations: test driver>>=
	subroutine integrations_history_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Integrations: execute history tests>>
	end subroutine integrations_history_test

	@ %def integrations_history_test
	@
	\subsubsection{Integration of test process}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type). The phase-space implementation is [[phs_single]]
	(single-particle phase space), the integrator is [[mci_midpoint]].

	The cross section for the $2\to 2$ process $ss\to ss$ with its
	constant matrix element is given by
	\begin{equation}
	\sigma = c\times f\times \Phi_2 \times \|M\|^2.
	\end{equation}
	$c$ is the conversion constant
	\begin{equation}
	c = 0.3894\times 10^{12}\;\mathrm{fb}\,\mathrm{GeV}^2.
	\end{equation}
	$f$ is the flux of the incoming particles with mass
	$m=125\,\mathrm{GeV}$ and energy $\sqrt{s}=1000\,\mathrm{GeV}$
	\begin{equation}
	f = \frac{(2\pi)^4}{2\lambda^{1/2}(s,m^2,m^2)}
	= \frac{(2\pi)^4}{2\sqrt{s}\,\sqrt{s - 4m^2}}
	= 8.048\times 10^{-4}\;\mathrm{GeV}^{-2}
	\end{equation}
	$\Phi_2$ is the volume of the two-particle phase space
	\begin{equation}
	\Phi_2 = \frac{1}{4(2\pi)^5} = 2.5529\times 10^{-5}.
	\end{equation}
	The squared matrix element $\|M\|^2$ is unity.
	Combining everything, we obtain
	\begin{equation}
	\sigma = 8000\;\mathrm{fb}
	\end{equation}
	This number should appear as the final result.

	Note: In this and the following test, we reset the Fortran compiler and flag
	variables immediately before they are printed, so the test is portable.
	<<Integrations: execute tests>>=
	call test (integrations_1, "integrations_1", &
	"intrinsic test process", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_1
	<<Integrations: tests>>=
	subroutine integrations_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: integrations_1"
	write (u, "(A)") "* Purpose: integrate test process"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	libname = "integration_1"
	procname = "prc_config_a"

	call prepare_test_library (global, libname, 1)
	call compile_library (libname, global)

	call global%set_string (var_str ("$run_id"), &
	var_str ("integrations1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%write (u, vars = [ &
	var_str ("$method"), &
	var_str ("sqrts"), &
	var_str ("$integration_method"), &
	var_str ("$phs_method"), &
	var_str ("$run_id")])

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine integrations_1

	@ %def integrations_1
	@
	\subsubsection{Integration with cuts}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) with cuts set.
	<<Integrations: execute tests>>=
	call test (integrations_2, "integrations_2", &
	"intrinsic test process with cut", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_2
	<<Integrations: tests>>=
	subroutine integrations_2 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	type(string_t) :: cut_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree

	type(string_t), dimension(0) :: empty_string_array

	write (u, "(A)") "* Test output: integrations_2"
	write (u, "(A)") "* Purpose: integrate test process with cut"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	write (u, "(A)") "* Prepare a cut expression"
	write (u, "(A)")

	call syntax_pexpr_init ()
	cut_expr_text = "all Pt > 100 [s]"
	call ifile_append (ifile, cut_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (parse_tree, stream, .true.)
	global%pn%cuts_lexpr => parse_tree%get_root_ptr ()

	write (u, "(A)") "* Build and initialize a test process"
	write (u, "(A)")

	libname = "integration_3"
	procname = "prc_config_a"

	call prepare_test_library (global, libname, 1)
	call compile_library (libname, global)

	call global%set_string (var_str ("$run_id"), &
	var_str ("integrations1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%write (u, vars = empty_string_array)

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine integrations_2

	@ %def integrations_2
	@
	\subsubsection{Standard phase space}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the default ([[phs_wood]]) phase-space implementation. We
	use an explicit phase-space configuration file with a single channel
	and integrate by [[mci_midpoint]].
	<<Integrations: execute tests>>=
	call test (integrations_3, "integrations_3", &
	"standard phase space", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_3
	<<Integrations: tests>>=
	subroutine integrations_3 (u)
	<<Use kinds>>
	<<Use strings>>
	use interactions, only: reset_interaction_counter
	use models
	use rt_data
	use process_configurations_ut, only: prepare_test_library
	use compilations, only: compile_library
	use integrations

	implicit none

	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global
	integer :: u_phs

	write (u, "(A)") "* Test output: integrations_3"
	write (u, "(A)") "* Purpose: integrate test process"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()

	libname = "integration_3"
	procname = "prc_config_a"

	call prepare_test_library (global, libname, 1)
	call compile_library (libname, global)

	call global%set_string (var_str ("$run_id"), &
	var_str ("integrations1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("default"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?phs_s_mapping"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	write (u, "(A)") "* Create a scratch phase-space file"
	write (u, "(A)")

	u_phs = free_unit ()
	open (u_phs, file = "integrations_3.phs", &
	status = "replace", action = "write")
	call write_test_phs_file (u_phs, var_str ("prc_config_a_i1"))
	close (u_phs)

	call global%set_string (var_str ("$phs_file"),&
	var_str ("integrations_3.phs"), is_known = .true.)

	call global%it_list%init ([1], [1000])

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

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%write (u, vars = [ &
	var_str ("$phs_method"), &
	var_str ("$phs_file")])

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

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

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

	end subroutine integrations_3

	@ %def integrations_3
	@
	\subsubsection{VAMP integration}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the single-channel ([[phs_single]]) phase-space
	implementation. The integration method is [[vamp]].
	<<Integrations: execute tests>>=
	call test (integrations_4, "integrations_4", &
	"VAMP integration (one iteration)", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_4
	<<Integrations: tests>>=
	subroutine integrations_4 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: integrations_4"
	write (u, "(A)") "* Purpose: integrate test process using VAMP"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	libname = "integrations_4_lib"
	procname = "integrations_4"

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

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

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%pacify (efficiency_reset = .true., error_reset = .true.)
	call global%write (u, vars = [var_str ("$integration_method")], &
	pacify = .true.)

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

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine integrations_4

	@ %def integrations_4
	@
	\subsubsection{Multiple iterations integration}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the single-channel ([[phs_single]]) phase-space
	implementation. The integration method is [[vamp]]. We launch three
	iterations.
	<<Integrations: execute tests>>=
	call test (integrations_5, "integrations_5", &
	"VAMP integration (three iterations)", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_5
	<<Integrations: tests>>=
	subroutine integrations_5 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: integrations_5"
	write (u, "(A)") "* Purpose: integrate test process using VAMP"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	libname = "integrations_5_lib"
	procname = "integrations_5"

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([3], [1000])

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

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%pacify (efficiency_reset = .true., error_reset = .true.)
	call global%write (u, vars = [var_str ("$integration_method")], &
	pacify = .true.)

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

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine integrations_5

	@ %def integrations_5
	@
	\subsubsection{Multiple passes integration}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the single-channel ([[phs_single]]) phase-space
	implementation. The integration method is [[vamp]]. We launch three
	passes with three iterations each.
	<<Integrations: execute tests>>=
	call test (integrations_6, "integrations_6", &
	"VAMP integration (three passes)", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_6
	<<Integrations: tests>>=
	subroutine integrations_6 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: no_vars

	write (u, "(A)") "* Test output: integrations_6"
	write (u, "(A)") "* Purpose: integrate test process using VAMP"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	libname = "integrations_6_lib"
	procname = "integrations_6"

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([3, 3, 3], [1000, 1000, 1000], &
	adapt = [.true., .true., .false.], &
	adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])

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

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%pacify (efficiency_reset = .true., error_reset = .true.)
	call global%write (u, vars = no_vars, pacify = .true.)

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

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine integrations_6

	@ %def integrations_6
	@
	\subsubsection{VAMP and default phase space}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the default ([[phs_wood]]) phase-space
	implementation. The integration method is [[vamp]]. We launch three
	passes with three iterations each. We enable channel equivalences and
	groves.
	<<Integrations: execute tests>>=
	call test (integrations_7, "integrations_7", &
	"VAMP integration with wood phase space", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_7
	<<Integrations: tests>>=
	subroutine integrations_7 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: no_vars
	integer :: iostat, u_phs
	character(95) :: buffer
	type(string_t) :: phs_file
	logical :: exist

	write (u, "(A)") "* Test output: integrations_7"
	write (u, "(A)") "* Purpose: integrate test process using VAMP"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()

	libname = "integrations_7_lib"
	procname = "integrations_7"

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?phs_s_mapping"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([3, 3, 3], [1000, 1000, 1000], &
	adapt = [.true., .true., .false.], &
	adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])

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

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%pacify (efficiency_reset = .true., error_reset = .true.)
	call global%write (u, vars = no_vars, pacify = .true.)

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

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Generated phase-space file"
	write (u, "(A)")

	phs_file = procname // "_i1.r1.phs"
	inquire (file = char (phs_file), exist = exist)
	if (exist) then
	u_phs = free_unit ()
	open (u_phs, file = char (phs_file), action = "read", status = "old")
	iostat = 0
	do while (iostat == 0)
	read (u_phs, "(A)", iostat = iostat) buffer
	if (iostat == 0) write (u, "(A)") trim (buffer)
	end do
	close (u_phs)
	else
	write (u, "(A)") "[file is missing]"
	end if

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

	end subroutine integrations_7

	@ %def integrations_7
	@
	\subsubsection{Structure functions}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the default ([[phs_wood]]) phase-space
	implementation. The integration method is [[vamp]]. There is a structure
	function of type [[unit_test]].

	We use a test structure function $f(x)=x$ for both beams. Together with the
	$1/x_1x_2$ factor from the phase-space flux and a unit matrix element, we
	should get the same result as previously for the process without structure
	functions. There is a slight correction due to the $m_s$ mass which we set to
	zero here.
	<<Integrations: execute tests>>=
	call test (integrations_8, "integrations_8", &
	"integration with structure function", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_8
	<<Integrations: tests>>=
	subroutine integrations_8 (u)
	<<Use kinds>>
	<<Use strings>>
	use interactions, only: reset_interaction_counter
	use phs_forests
	use models
	use rt_data
	use process_configurations_ut, only: prepare_test_library
	use compilations, only: compile_library
	use integrations

	implicit none

	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global
	type(flavor_t) :: flv
	type(string_t) :: name

	write (u, "(A)") "* Test output: integrations_8"
	write (u, "(A)") "* Purpose: integrate test process using VAMP &
	&with structure function"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()

	libname = "integrations_8_lib"
	procname = "integrations_8"

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?phs_s_mapping"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), 0._default)

	call reset_interaction_counter ()

	call flv%init (25, global%model)

	name = flv%get_name ()
	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

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

	call global%it_list%init ([1], [1000])
	call integrate_process (procname, global, local_stack=.true.)

	call global%write (u, vars = [var_str ("ms")])

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

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

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

	end subroutine integrations_8

	@ %def integrations_8
	@
	\subsubsection{Integration with sign change}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type). The phase-space implementation is [[phs_single]]
	(single-particle phase space), the integrator is [[mci_midpoint]].
	The weight that is applied changes the sign in half of phase space.
	The weight is $-3$ and $1$, respectively, so the total result is equal
	to the original, but negative sign.

	The efficiency should (approximately) become the average of $1$ and
	$1/3$, that is $2/3$.
	<<Integrations: execute tests>>=
	call test (integrations_9, "integrations_9", &
	"handle sign change", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_9
	<<Integrations: tests>>=
	subroutine integrations_9 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	type(string_t) :: wgt_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree

	write (u, "(A)") "* Test output: integrations_9"
	write (u, "(A)") "* Purpose: integrate test process"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	write (u, "(A)") "* Prepare a weight expression"
	write (u, "(A)")

	call syntax_pexpr_init ()
	wgt_expr_text = "eval 2 * sgn (Pz) - 1 [s]"
	call ifile_append (ifile, wgt_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (parse_tree, stream, .true.)
	global%pn%weight_expr => parse_tree%get_root_ptr ()

	write (u, "(A)") "* Build and evaluate a test process"
	write (u, "(A)")

	libname = "integration_9"
	procname = "prc_config_a"

	call prepare_test_library (global, libname, 1)
	call compile_library (libname, global)

	call global%set_string (var_str ("$run_id"), &
	var_str ("integrations1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%write (u, vars = [ &
	var_str ("$method"), &
	var_str ("sqrts"), &
	var_str ("$integration_method"), &
	var_str ("$phs_method"), &
	var_str ("$run_id")])

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine integrations_9

	@ %def integrations_9
	@
	\subsubsection{Integration history for VAMP integration with default
	phase space}
	This test is only run when event analysis can be done.
	<<Integrations: execute history tests>>=
	call test (integrations_history_1, "integrations_history_1", &
	"Test integration history files", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_history_1
	<<Integrations: tests>>=
	subroutine integrations_history_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: no_vars
	integer :: iostat, u_his
	character(91) :: buffer
	type(string_t) :: his_file, ps_file, pdf_file
	logical :: exist, exist_ps, exist_pdf

	write (u, "(A)") "* Test output: integrations_history_1"
	write (u, "(A)") "* Purpose: test integration history files"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()

	libname = "integrations_history_1_lib"
	procname = "integrations_history_1"

	call global%set_log (var_str ("?vis_history"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?phs_s_mapping"),&
	.false., is_known = .true.)

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_real (var_str ("error_threshold"),&
	5E-6_default, is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([2, 2, 2], [1000, 1000, 1000], &
	adapt = [.true., .true., .false.], &
	adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])

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

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true., &
	eff_reset = .true.)

	call global%pacify (efficiency_reset = .true., error_reset = .true.)
	call global%write (u, vars = no_vars, pacify = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Generated history files"
	write (u, "(A)")

	his_file = procname // ".r1-history.tex"
	ps_file = procname // ".r1-history.ps"
	pdf_file = procname // ".r1-history.pdf"
	inquire (file = char (his_file), exist = exist)
	if (exist) then
	u_his = free_unit ()
	open (u_his, file = char (his_file), action = "read", status = "old")
	iostat = 0
	do while (iostat == 0)
	read (u_his, "(A)", iostat = iostat) buffer
	if (iostat == 0) write (u, "(A)") trim (buffer)
	end do
	close (u_his)
	else
	write (u, "(A)") "[History LaTeX file is missing]"
	end if
	inquire (file = char (ps_file), exist = exist_ps)
	if (exist_ps) then
	write (u, "(A)") "[History Postscript file exists and is nonempty]"
	else
	write (u, "(A)") "[History Postscript file is missing/non-regular]"
	end if
	inquire (file = char (pdf_file), exist = exist_pdf)
	if (exist_pdf) then
	write (u, "(A)") "[History PDF file exists and is nonempty]"
	else
	write (u, "(A)") "[History PDF file is missing/non-regular]"
	end if

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

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

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

	end subroutine integrations_history_1

	@ %def integrations_history_1
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Event Streams}
	This module manages I/O from/to multiple concurrent event streams.
	Usually, there is at most one input stream, but several output
	streams. For the latter, we set up an array which can hold [[eio_t]]
	(event I/O) objects of different dynamic types simultaneously. One of
	them may be marked as an input channel.
	<<[[event_streams.f90]]>>=
	<<File header>>

	module event_streams

	<<Use strings>>
	use io_units
	use diagnostics
	use events
	use eio_data
	use eio_base
	use rt_data

	use dispatch_transforms, only: dispatch_eio

	<<Standard module head>>

	<<Event streams: public>>

	<<Event streams: types>>

	contains

	<<Event streams: procedures>>

	end module event_streams
	@ %def event_streams
	@
	\subsection{Event Stream Array}
	Each entry is an [[eio_t]] object. Since the type is dynamic, we need
	a wrapper:
	<<Event streams: types>>=
	type :: event_stream_entry_t
	class(eio_t), allocatable :: eio
	end type event_stream_entry_t

	@ %def event_stream_entry_t
	@ An array of event-stream entry objects. If one of the entries is an
	input channel, [[i_in]] is the corresponding index.
	<<Event streams: public>>=
	public :: event_stream_array_t
	<<Event streams: types>>=
	type :: event_stream_array_t
	type(event_stream_entry_t), dimension(:), allocatable :: entry
	integer :: i_in = 0
	contains
	<<Event streams: event stream array: TBP>>
	end type event_stream_array_t

	@ %def event_stream_array_t
	@ Output.
	<<Event streams: event stream array: TBP>>=
	procedure :: write => event_stream_array_write
	<<Event streams: procedures>>=
	subroutine event_stream_array_write (object, unit)
	class(event_stream_array_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event stream array:"
	if (allocated (object%entry)) then
	select case (size (object%entry))
	case (0)
	write (u, "(3x,A)") "[empty]"
	case default
	do i = 1, size (object%entry)
	if (i == object%i_in) write (u, "(1x,A)") "Input stream:"
	call object%entry(i)%eio%write (u)
	end do
	end select
	else
	write (u, "(3x,A)") "[undefined]"
	end if
	end subroutine event_stream_array_write

	@ %def event_stream_array_write
	@ Finalize all streams.
	<<Event streams: event stream array: TBP>>=
	procedure :: final => event_stream_array_final
	<<Event streams: procedures>>=
	subroutine event_stream_array_final (es_array)
	class(event_stream_array_t), intent(inout) :: es_array
	integer :: i
	do i = 1, size (es_array%entry)
	call es_array%entry(i)%eio%final ()
	end do
	end subroutine event_stream_array_final

	@ %def event_stream_array_final
	@ Initialization. We use a generic [[sample]] name, open event I/O
	objects for all provided stream types (using the [[dispatch_eio]]
	routine), and initialize for the given list of process pointers. If
	there is an [[input]] argument, this channel is initialized as an input
	channel and appended to the array.

	The [[input_data]] or, if not present, [[data]] may be modified. This
	happens if we open a stream for reading and get new information there.
	<<Event streams: event stream array: TBP>>=
	procedure :: init => event_stream_array_init
	<<Event streams: procedures>>=
	subroutine event_stream_array_init &
	(es_array, sample, stream_fmt, global, &
	data, input, input_sample, input_data, allow_switch, &
	checkpoint, callback, &
	error)
	class(event_stream_array_t), intent(out) :: es_array
	type(string_t), intent(in) :: sample
	type(string_t), dimension(:), intent(in) :: stream_fmt
	type(rt_data_t), intent(in) :: global
	type(event_sample_data_t), intent(inout), optional :: data
	type(string_t), intent(in), optional :: input
	type(string_t), intent(in), optional :: input_sample
	type(event_sample_data_t), intent(inout), optional :: input_data
	logical, intent(in), optional :: allow_switch
	integer, intent(in), optional :: checkpoint
	integer, intent(in), optional :: callback
	logical, intent(out), optional :: error
	type(string_t) :: sample_in
	integer :: n, i, n_output, i_input, i_checkpoint, i_callback
	logical :: success, switch
	if (present (input_sample)) then
	sample_in = input_sample
	else
	sample_in = sample
	end if
	if (present (allow_switch)) then
	switch = allow_switch
	else
	switch = .true.
	end if
	if (present (error)) then
	error = .false.
	end if
	n = size (stream_fmt)
	n_output = n
	if (present (input)) then
	n = n + 1
	i_input = n
	else
	i_input = 0
	end if
	if (present (checkpoint)) then
	n = n + 1
	i_checkpoint = n
	else
	i_checkpoint = 0
	end if
	if (present (callback)) then
	n = n + 1
	i_callback = n
	else
	i_callback = 0
	end if
	allocate (es_array%entry (n))
	if (i_checkpoint > 0) then
	call dispatch_eio &
	(es_array%entry(i_checkpoint)%eio, var_str ("checkpoint"), &
	global%var_list, global%fallback_model, &
	global%event_callback)
	call es_array%entry(i_checkpoint)%eio%init_out (sample, data)
	end if
	if (i_callback > 0) then
	call dispatch_eio &
	(es_array%entry(i_callback)%eio, var_str ("callback"), &
	global%var_list, global%fallback_model, &
	global%event_callback)
	call es_array%entry(i_callback)%eio%init_out (sample, data)
	end if
	if (i_input > 0) then
	call dispatch_eio (es_array%entry(i_input)%eio, input, &
	global%var_list, global%fallback_model, &
	global%event_callback)
	if (present (input_data)) then
	call es_array%entry(i_input)%eio%init_in &
	(sample_in, input_data, success)
	else
	call es_array%entry(i_input)%eio%init_in &
	(sample_in, data, success)
	end if
	if (success) then
	es_array%i_in = i_input
	else if (present (input_sample)) then
	if (present (error)) then
	error = .true.
	else
	call msg_fatal ("Events: &
	&parameter mismatch in input, aborting")
	end if
	else
	call msg_message ("Events: &
	&parameter mismatch, discarding old event set")
	call es_array%entry(i_input)%eio%final ()
	if (switch) then
	call msg_message ("Events: generating new events")
	call es_array%entry(i_input)%eio%init_out (sample, data)
	end if
	end if
	end if
	do i = 1, n_output
	call dispatch_eio (es_array%entry(i)%eio, stream_fmt(i), &
	global%var_list, global%fallback_model, &
	global%event_callback)
	call es_array%entry(i)%eio%init_out (sample, data)
	end do
	end subroutine event_stream_array_init

	@ %def event_stream_array_init
	@ Switch the (only) input channel to an output channel, so further
	events are appended to the respective stream.
	<<Event streams: event stream array: TBP>>=
	procedure :: switch_inout => event_stream_array_switch_inout
	<<Event streams: procedures>>=
	subroutine event_stream_array_switch_inout (es_array)
	class(event_stream_array_t), intent(inout) :: es_array
	integer :: n
	if (es_array%has_input ()) then
	n = es_array%i_in
	call es_array%entry(n)%eio%switch_inout ()
	es_array%i_in = 0
	else
	call msg_bug ("Reading events: switch_inout: no input stream selected")
	end if
	end subroutine event_stream_array_switch_inout

	@ %def event_stream_array_switch_inout
	@ Output an event (with given process number) to all output streams.
	If there is no output stream, do nothing.
	<<Event streams: event stream array: TBP>>=
	procedure :: output => event_stream_array_output
	<<Event streams: procedures>>=
	subroutine event_stream_array_output (es_array, event, i_prc, &
	event_index, passed, pacify)
	class(event_stream_array_t), intent(inout) :: es_array
	type(event_t), intent(in), target :: event
	integer, intent(in) :: i_prc, event_index
	logical, intent(in), optional :: passed, pacify
	logical :: increased
	integer :: i
	do i = 1, size (es_array%entry)
	if (i /= es_array%i_in) then
	associate (eio => es_array%entry(i)%eio)
	if (eio%split) then
	if (eio%split_n_evt > 0 &
	.and. event_index > 1 &
	.and. mod (event_index, eio%split_n_evt) == 1) then
	call eio%split_out ()
	else if (eio%split_n_kbytes > 0) then
	call eio%update_split_count (increased)
	if (increased) call eio%split_out ()
	end if
	end if
	call eio%output (event, i_prc, reading = es_array%i_in /= 0, &
	passed = passed, &
	pacify = pacify)
	end associate
	end if
	end do
	end subroutine event_stream_array_output

	@ %def event_stream_array_output
	@ Input the [[i_prc]] index which selects the process for the current
	event. This is separated from reading the event, because it
	determines which event record to read. [[iostat]] may indicate an
	error or an EOF condition, as usual.
	<<Event streams: event stream array: TBP>>=
	procedure :: input_i_prc => event_stream_array_input_i_prc
	<<Event streams: procedures>>=
	subroutine event_stream_array_input_i_prc (es_array, i_prc, iostat)
	class(event_stream_array_t), intent(inout) :: es_array
	integer, intent(out) :: i_prc
	integer, intent(out) :: iostat
	integer :: n
	if (es_array%has_input ()) then
	n = es_array%i_in
	call es_array%entry(n)%eio%input_i_prc (i_prc, iostat)
	else
	call msg_fatal ("Reading events: no input stream selected")
	end if
	end subroutine event_stream_array_input_i_prc

	@ %def event_stream_array_input_i_prc
	@ Input an event from the selected input stream. [[iostat]] may indicate an
	error or an EOF condition, as usual.
	<<Event streams: event stream array: TBP>>=
	procedure :: input_event => event_stream_array_input_event
	<<Event streams: procedures>>=
	subroutine event_stream_array_input_event (es_array, event, iostat)
	class(event_stream_array_t), intent(inout) :: es_array
	type(event_t), intent(inout), target :: event
	integer, intent(out) :: iostat
	integer :: n
	if (es_array%has_input ()) then
	n = es_array%i_in
	call es_array%entry(n)%eio%input_event (event, iostat)
	else
	call msg_fatal ("Reading events: no input stream selected")
	end if
	end subroutine event_stream_array_input_event

	@ %def event_stream_array_input_event
	@ Skip an entry of eio\_t. Used to synchronize the event read-in for
	NLO events.
	<<Event streams: event stream array: TBP>>=
	procedure :: skip_eio_entry => event_stream_array_skip_eio_entry
	<<Event streams: procedures>>=
	subroutine event_stream_array_skip_eio_entry (es_array, iostat)
	class(event_stream_array_t), intent(inout) :: es_array
	integer, intent(out) :: iostat
	integer :: n
	if (es_array%has_input ()) then
	n = es_array%i_in
	call es_array%entry(n)%eio%skip (iostat)
	else
	call msg_fatal ("Reading events: no input stream selected")
	end if
	end subroutine event_stream_array_skip_eio_entry

	@ %def event_stream_array_skip_eio_entry
	@ Return true if there is an input channel among the event streams.
	<<Event streams: event stream array: TBP>>=
	procedure :: has_input => event_stream_array_has_input
	<<Event streams: procedures>>=
	function event_stream_array_has_input (es_array) result (flag)
	class(event_stream_array_t), intent(in) :: es_array
	logical :: flag
	flag = es_array%i_in /= 0
	end function event_stream_array_has_input

	@ %def event_stream_array_has_input
	@
	\subsection{Unit Tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[event_streams_ut.f90]]>>=
	<<File header>>

	module event_streams_ut
	use unit_tests
	use event_streams_uti

	<<Standard module head>>

	<<Event streams: public test>>

	contains

	<<Event streams: test driver>>

	end module event_streams_ut
	@
	<<[[event_streams_uti.f90]]>>=
	<<File header>>

	module event_streams_uti

	<<Use kinds>>
	<<Use strings>>
	use model_data
	use eio_data
	use process, only: process_t
	use instances, only: process_instance_t
	use models
	use rt_data
	use events

	use event_streams

	<<Standard module head>>

	<<Event streams: test declarations>>

	contains

	<<Event streams: tests>>

	end module event_streams_uti

	@ %def event_streams_uti
	@ API: driver for the unit tests below.
	<<Event streams: public test>>=
	public :: event_streams_test
	<<Event streams: test driver>>=
	subroutine event_streams_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Event streams: execute tests>>
	end subroutine event_streams_test

	@ %def event_streams_test
	@
	\subsubsection{Empty event stream}
	This should set up an empty event output stream array, including
	initialization, output, and finalization (which are all no-ops).
	<<Event streams: execute tests>>=
	call test (event_streams_1, "event_streams_1", &
	"empty event stream array", &
	u, results)
	<<Event streams: test declarations>>=
	public :: event_streams_1
	<<Event streams: tests>>=
	subroutine event_streams_1 (u)
	integer, intent(in) :: u
	type(event_stream_array_t) :: es_array
	type(rt_data_t) :: global
	type(event_t) :: event
	type(string_t) :: sample
	type(string_t), dimension(0) :: empty_string_array

	write (u, "(A)") "* Test output: event_streams_1"
	write (u, "(A)") "* Purpose: handle empty event stream array"
	write (u, "(A)")

	sample = "event_streams_1"

	call es_array%init (sample, empty_string_array, global)
	call es_array%output (event, 42, 1)
	call es_array%write (u)
	call es_array%final ()

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

	end subroutine event_streams_1

	@ %def event_streams_1
	@
	\subsubsection{Nontrivial event stream}
	Here we generate a trivial event and choose [[raw]] output as an entry in
	the stream array.
	<<Event streams: execute tests>>=
	call test (event_streams_2, "event_streams_2", &
	"nontrivial event stream array", &
	u, results)
	<<Event streams: test declarations>>=
	public :: event_streams_2
	<<Event streams: tests>>=
	subroutine event_streams_2 (u)
	use processes_ut, only: prepare_test_process
	integer, intent(in) :: u
	type(event_stream_array_t) :: es_array
	type(rt_data_t) :: global
	type(model_data_t), target :: model
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(string_t) :: sample
	type(string_t), dimension(0) :: empty_string_array
	integer :: i_prc, iostat

	write (u, "(A)") "* Test output: event_streams_2"
	write (u, "(A)") "* Purpose: handle empty event stream array"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call model%init_test ()

	write (u, "(A)") "* Generate test process event"
	write (u, "(A)")

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	call process_instance%setup_event_data ()

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())
	call event%generate (1, [0.4_default, 0.4_default])
	call event%evaluate_expressions ()
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate raw eio stream and write event to file"
	write (u, "(A)")

	sample = "event_streams_2"

	call es_array%init (sample, [var_str ("raw")], global)
	call es_array%output (event, 1, 1)
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Reallocate raw eio stream for reading"
	write (u, "(A)")

	sample = "foo"
	call es_array%init (sample, empty_string_array, global, &
	input = var_str ("raw"), input_sample = var_str ("event_streams_2"))
	call es_array%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reread event"
	write (u, "(A)")

	call es_array%input_i_prc (i_prc, iostat)

	write (u, "(1x,A,I0)") "i_prc = ", i_prc
	write (u, "(A)")
	call es_array%input_event (event, iostat)
	call es_array%final ()

	call event%write (u)

	call global%final ()

	call model%final ()
	call syntax_model_file_final ()

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

	end subroutine event_streams_2

	@ %def event_streams_2
	@
	\subsubsection{Switch in/out}
	Here we generate an event file and test switching from writing to
	reading when the file is exhausted.
	<<Event streams: execute tests>>=
	call test (event_streams_3, "event_streams_3", &
	"switch input/output", &
	u, results)
	<<Event streams: test declarations>>=
	public :: event_streams_3
	<<Event streams: tests>>=
	subroutine event_streams_3 (u)
	use processes_ut, only: prepare_test_process
	integer, intent(in) :: u
	type(event_stream_array_t) :: es_array
	type(rt_data_t) :: global
	type(model_data_t), target :: model
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(string_t) :: sample
	type(string_t), dimension(0) :: empty_string_array
	integer :: i_prc, iostat

	write (u, "(A)") "* Test output: event_streams_3"
	write (u, "(A)") "* Purpose: handle in/out switching"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call model%init_test ()

	write (u, "(A)") "* Generate test process event"
	write (u, "(A)")

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	call process_instance%setup_event_data ()

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())
	call event%generate (1, [0.4_default, 0.4_default])
	call event%evaluate_expressions ()

	write (u, "(A)") "* Allocate raw eio stream and write event to file"
	write (u, "(A)")

	sample = "event_streams_3"

	call es_array%init (sample, [var_str ("raw")], global)
	call es_array%output (event, 1, 1)
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Reallocate raw eio stream for reading"
	write (u, "(A)")

	call es_array%init (sample, empty_string_array, global, &
	input = var_str ("raw"))
	call es_array%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reread event"
	write (u, "(A)")

	call es_array%input_i_prc (i_prc, iostat)
	call es_array%input_event (event, iostat)

	write (u, "(A)") "* Attempt to read another event (fail), then generate"
	write (u, "(A)")

	call es_array%input_i_prc (i_prc, iostat)
	if (iostat < 0) then
	call es_array%switch_inout ()
	call event%generate (1, [0.3_default, 0.3_default])
	call event%evaluate_expressions ()
	call es_array%output (event, 1, 2)
	end if
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reallocate raw eio stream for reading"
	write (u, "(A)")

	call es_array%init (sample, empty_string_array, global, &
	input = var_str ("raw"))
	call es_array%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reread two events and display 2nd event"
	write (u, "(A)")

	call es_array%input_i_prc (i_prc, iostat)
	call es_array%input_event (event, iostat)
	call es_array%input_i_prc (i_prc, iostat)

	call es_array%input_event (event, iostat)
	call es_array%final ()

	call event%write (u)

	call global%final ()

	call model%final ()
	call syntax_model_file_final ()

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

	end subroutine event_streams_3

	@ %def event_streams_3
	@
	\subsubsection{Checksum}
	Here we generate an event file and repeat twice, once with identical
	parameters and once with modified parameters.
	<<Event streams: execute tests>>=
	call test (event_streams_4, "event_streams_4", &
	"check MD5 sum", &
	u, results)
	<<Event streams: test declarations>>=
	public :: event_streams_4
	<<Event streams: tests>>=
	subroutine event_streams_4 (u)
	integer, intent(in) :: u
	type(event_stream_array_t) :: es_array
	type(rt_data_t) :: global
	type(process_t), allocatable, target :: process
	type(string_t) :: sample
	type(string_t), dimension(0) :: empty_string_array
	type(event_sample_data_t) :: data

	write (u, "(A)") "* Test output: event_streams_4"
	write (u, "(A)") "* Purpose: handle in/out switching"
	write (u, "(A)")

	write (u, "(A)") "* Generate test process event"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%set_log (var_str ("?check_event_file"), &
	.true., is_known = .true.)

	allocate (process)

	write (u, "(A)") "* Allocate raw eio stream for writing"
	write (u, "(A)")

	sample = "event_streams_4"
	data%md5sum_cfg = "1234567890abcdef1234567890abcdef"

	call es_array%init (sample, [var_str ("raw")], global, data)
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Reallocate raw eio stream for reading"
	write (u, "(A)")

	call es_array%init (sample, empty_string_array, global, &
	data, input = var_str ("raw"))
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Reallocate modified raw eio stream for reading (fail)"
	write (u, "(A)")

	data%md5sum_cfg = "1234567890______1234567890______"
	call es_array%init (sample, empty_string_array, global, &
	data, input = var_str ("raw"))
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Repeat ignoring checksum"
	write (u, "(A)")

	call global%set_log (var_str ("?check_event_file"), &
	.false., is_known = .true.)
	call es_array%init (sample, empty_string_array, global, &
	data, input = var_str ("raw"))
	call es_array%write (u)
	call es_array%final ()

	call global%final ()
	call syntax_model_file_final ()

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

	end subroutine event_streams_4

	@ %def event_streams_4
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Simulation}
	This module manages simulation: event generation and reading/writing of event
	files. The [[simulation]] object is intended to be used (via a pointer)
	outside of \whizard, if events are generated individually by an external
	driver.
	<<[[simulations.f90]]>>=
	<<File header>>

	module simulations

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_utils, only: write_separator
	use format_defs, only: FMT_19
	use numeric_utils
	use diagnostics
	use sm_qcd
	use md5
	use variables
	use eval_trees
	use model_data
	use flavors
	use particles
	use state_matrices, only: FM_IGNORE_HELICITY
	use beam_structures, only: beam_structure_t
	use beams
	use rng_base
	use selectors
	use process_libraries, only: process_library_t
	use prc_core
	! TODO: (bcn 2016-09-13) should be ideally only pcm_base
	use pcm, only: pcm_nlo_t, pcm_instance_nlo_t
	! TODO: (bcn 2016-09-13) details of process config should not be necessary here
	use process_config, only: COMP_REAL_FIN
	use process
	use instances
	use event_base
	use events
	use event_transforms
	use shower
	use eio_data
	use eio_base
	use rt_data

	use dispatch_beams, only: dispatch_qcd
	use dispatch_rng, only: dispatch_rng_factory
	use dispatch_me_methods, only: dispatch_core_update, dispatch_core_restore
	use dispatch_transforms, only: dispatch_evt_decay
	use dispatch_transforms, only: dispatch_evt_shower
	use dispatch_transforms, only: dispatch_evt_hadrons
	use dispatch_transforms, only: dispatch_evt_nlo

	use integrations
	use event_streams

	use evt_nlo

	<<Standard module head>>

	<<Simulations: public>>

	<<Simulations: types>>

	<<Simulations: interfaces>>

	contains

	<<Simulations: procedures>>

	end module simulations
	@ %def simulations
	@
	\subsection{Event counting}
	In this object we collect statistical information about an event
	sample or sub-sample.
	<<Simulations: types>>=
	type :: counter_t
	integer :: total = 0
	integer :: generated = 0
	integer :: read = 0
	integer :: positive = 0
	integer :: negative = 0
	integer :: zero = 0
	integer :: excess = 0
	real(default) :: max_excess = 0
	real(default) :: sum_excess = 0
	logical :: reproduce_xsection = .false.
	real(default) :: mean = 0
	real(default) :: varsq = 0
	integer :: nlo_weight_counter = 0
	contains
	<<Simulations: counter: TBP>>
	end type counter_t

	@ %def simulation_counter_t
	@ Output.
	<<Simulations: counter: TBP>>=
	procedure :: write => counter_write
	<<Simulations: procedures>>=
	subroutine counter_write (counter, unit)
	class(counter_t), intent(in) :: counter
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	1 format (3x,A,I0)
	2 format (5x,A,I0)
	3 format (5x,A,ES19.12)
	write (u, 1) "Events total = ", counter%total
	write (u, 2) "generated = ", counter%generated
	write (u, 2) "read = ", counter%read
	write (u, 2) "positive weight = ", counter%positive
	write (u, 2) "negative weight = ", counter%negative
	write (u, 2) "zero weight = ", counter%zero
	write (u, 2) "excess weight = ", counter%excess
	if (counter%excess /= 0) then
	write (u, 3) "max excess = ", counter%max_excess
	write (u, 3) "avg excess = ", counter%sum_excess / counter%total
	end if
	end subroutine counter_write

	@ %def counter_write
	@ This is a screen message: if there was an excess, display statistics.
	<<Simulations: counter: TBP>>=
	procedure :: show_excess => counter_show_excess
	<<Simulations: procedures>>=
	subroutine counter_show_excess (counter)
	class(counter_t), intent(in) :: counter
	if (counter%excess > 0) then
	write (msg_buffer, "(A,1x,I0,1x,A,1x,'(',F7.3,' %)')") &
	"Encountered events with excess weight:", counter%excess, &
	"events", 100 * counter%excess / real (counter%total)
	call msg_warning ()
	write (msg_buffer, "(A,ES10.3)") &
	"Maximum excess weight =", counter%max_excess
	call msg_message ()
	write (msg_buffer, "(A,ES10.3)") &
	"Average excess weight =", counter%sum_excess / counter%total
	call msg_message ()
	end if
	end subroutine counter_show_excess

	@ %def counter_show_excess
	@
	<<Simulations: counter: TBP>>=
	procedure :: show_mean_and_variance => counter_show_mean_and_variance
	<<Simulations: procedures>>=
	subroutine counter_show_mean_and_variance (counter)
	class(counter_t), intent(in) :: counter
	if (counter%reproduce_xsection) then
	print *, "Reconstructed cross-section from event weights: "
	print *, counter%mean, '+-', sqrt (counter%varsq / (counter%nlo_weight_counter - 1))
	end if
	end subroutine counter_show_mean_and_variance

	@ %def counter_show_mean_and_variance
	@ Count an event. The weight and event source are optional; by
	default we assume that the event has been generated and has positive
	weight.
	<<Simulations: counter: TBP>>=
	procedure :: record => counter_record
	<<Simulations: procedures>>=
	subroutine counter_record (counter, weight, excess, from_file)
	class(counter_t), intent(inout) :: counter
	real(default), intent(in), optional :: weight, excess
	logical, intent(in), optional :: from_file
	counter%total = counter%total + 1
	if (present (from_file)) then
	if (from_file) then
	counter%read = counter%read + 1
	else
	counter%generated = counter%generated + 1
	end if
	else
	counter%generated = counter%generated + 1
	end if
	if (present (weight)) then
	if (weight > 0) then
	counter%positive = counter%positive + 1
	else if (weight < 0) then
	counter%negative = counter%negative + 1
	else
	counter%zero = counter%zero + 1
	end if
	else
	counter%positive = counter%positive + 1
	end if
	if (present (excess)) then
	if (excess > 0) then
	counter%excess = counter%excess + 1
	counter%max_excess = max (counter%max_excess, excess)
	counter%sum_excess = counter%sum_excess + excess
	end if
	end if
	end subroutine counter_record

	@ %def counter_record
	@
	<<Simulations: counter: TBP>>=
	procedure :: record_mean_and_variance => &
	counter_record_mean_and_variance
	<<Simulations: procedures>>=
	subroutine counter_record_mean_and_variance (counter, weight, i_nlo)
	class(counter_t), intent(inout) :: counter
	real(default), intent(in) :: weight
	integer, intent(in) :: i_nlo
	real(default), save :: weight_buffer = 0._default
	integer, save :: nlo_count = 1
	if (.not. counter%reproduce_xsection) return
	if (i_nlo == 1) then
	call flush_weight_buffer (weight_buffer, nlo_count)
	weight_buffer = weight
	nlo_count = 1
	else
	weight_buffer = weight_buffer + weight
	nlo_count = nlo_count + 1
	end if
	contains
	subroutine flush_weight_buffer (w, n_nlo)
	real(default), intent(in) :: w
	integer, intent(in) :: n_nlo
	integer :: n
	real(default) :: mean_new
	counter%nlo_weight_counter = counter%nlo_weight_counter + 1
	!!! Minus 1 to take into account offset from initialization
	n = counter%nlo_weight_counter - 1
	if (n > 0) then
	mean_new = counter%mean + (w / n_nlo - counter%mean) / n
	if (n > 1) &
	counter%varsq = counter%varsq - counter%varsq / (n - 1) + &
	n * (mean_new - counter%mean)**2
	counter%mean = mean_new
	end if
	end subroutine flush_weight_buffer
	end subroutine counter_record_mean_and_variance

	@ %def counter_record_mean_and_variance
	@
	\subsection{Simulation: component sets}
	For each set of process components that share a MCI entry in the
	process configuration, we keep a separate event record.
	<<Simulations: types>>=
	type :: mci_set_t
	private
	integer :: n_components = 0
	integer, dimension(:), allocatable :: i_component
	type(string_t), dimension(:), allocatable :: component_id
	logical :: has_integral = .false.
	real(default) :: integral = 0
	real(default) :: error = 0
	real(default) :: weight_mci = 0
	type(counter_t) :: counter
	contains
	<<Simulations: mci set: TBP>>
	end type mci_set_t

	@ %def mci_set_t
	@ Output.
	<<Simulations: mci set: TBP>>=
	procedure :: write => mci_set_write
	<<Simulations: procedures>>=
	subroutine mci_set_write (object, unit)
	class(mci_set_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(3x,A)") "Components:"
	do i = 1, object%n_components
	write (u, "(5x,I0,A,A,A)") object%i_component(i), &
	": '", char (object%component_id(i)), "'"
	end do
	if (object%has_integral) then
	write (u, "(3x,A," // FMT_19 // ")") "Integral = ", object%integral
	write (u, "(3x,A," // FMT_19 // ")") "Error = ", object%error
	write (u, "(3x,A,F13.10)") "Weight =", object%weight_mci
	else
	write (u, "(3x,A)") "Integral = [undefined]"
	end if
	call object%counter%write (u)
	end subroutine mci_set_write

	@ %def mci_set_write
	@ Initialize: Get the indices and names for the process components
	that will contribute to this set.
	<<Simulations: mci set: TBP>>=
	procedure :: init => mci_set_init
	<<Simulations: procedures>>=
	subroutine mci_set_init (object, i_mci, process)
	class(mci_set_t), intent(out) :: object
	integer, intent(in) :: i_mci
	type(process_t), intent(in), target :: process
	integer :: i
	call process%get_i_component (i_mci, object%i_component)
	object%n_components = size (object%i_component)
	allocate (object%component_id (object%n_components))
	do i = 1, size (object%component_id)
	object%component_id(i) = &
	process%get_component_id (object%i_component(i))
	end do
	if (process%has_integral (i_mci)) then
	object%integral = process%get_integral (i_mci)
	object%error = process%get_error (i_mci)
	object%has_integral = .true.
	end if
	end subroutine mci_set_init

	@ %def mci_set_init
	@
	\subsection{Process-core Safe}
	This is an object that temporarily holds a process core object. We
	need this while rescanning a process with modified parameters. After
	the rescan, we want to restore the original state.
	<<Simulations: types>>=
	type :: core_safe_t
	class(prc_core_t), allocatable :: core
	end type core_safe_t

	@ %def core_safe_t
	@
	\subsection{Process Object}
	The simulation works on process objects. This subroutine makes a
	process object available for simulation. The process is in the
	process stack. If integration is not yet
	done, do it. Any generated process object should be put on the global stack,
	if it is separate from the local one.
	<<Simulations: procedures>>=
	subroutine prepare_process &
	(process, process_id, use_process, integrate, local, global)
	type(process_t), pointer, intent(out) :: process
	type(string_t), intent(in) :: process_id
	logical, intent(in) :: use_process, integrate
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	if (present (global)) then
	process => global%process_stack%get_process_ptr (process_id)
	else
	process => local%process_stack%get_process_ptr (process_id)
	end if
	if (use_process .and. .not. associated (process)) then
	if (integrate) then
	call msg_message ("Simulate: process '" &
	// char (process_id) // "' needs integration")
	else
	call msg_message ("Simulate: process '" &
	// char (process_id) // "' needs initialization")
	end if
	if (present (global)) then
	call integrate_process (process_id, local, global, &
	init_only = .not. integrate)
	else
	call integrate_process (process_id, local, local_stack=.true., &
	init_only = .not. integrate)
	end if
	if (signal_is_pending ()) return
	process => global%process_stack%get_process_ptr (process_id)
	if (associated (process)) then
	if (integrate) then
	call msg_message ("Simulate: integration done")
	call global%process_stack%fill_result_vars (process_id)
	else
	call msg_message ("Simulate: process initialization done")
	end if
	else
	call msg_fatal ("Simulate: process '" &
	// char (process_id) // "' could not be initialized: aborting")
	end if
	else if (.not. associated (process)) then
	call msg_message &
	("Simulate: process '" &
	// char (process_id) // "': enabled for rescan only")
	end if
	end subroutine prepare_process

	@ %def prepare_process
	@
	\subsection{Simulation entry}
	For each process that we consider for event generation, we need a
	separate entry. The entry separately records the process ID and run ID. The
	[[weight_mci]] array is used for selecting a component set (which
	shares a MCI record inside the process container) when generating an
	event for the current process.

	The simulation entry is an extension of the [[event_t]] event record.
	This core object contains configuration data, pointers to the process
	and process instance, the expressions, flags and values that are
	evaluated at runtime, and the resulting particle set.

	The entry explicitly allocate the [[process_instance]], which becomes
	the process-specific workspace for the event record.

	If entries with differing environments are present simultaneously, we
	may need to switch QCD parameters and/or the model event by event. In
	this case, the [[qcd]] and/or [[model]] components are present.\\
	For the puropose of NLO events, [[entry_t]] contains a pointer list
	to other simulation-entries. This is due to the fact that we have to
	associate an event for each component of the fixed order simulation,
	i.e. one $N$-particle event and $N_\alpha$ $N+1$-particle events.
	However, all entries share the same event transforms.
	<<Simulations: types>>=
	type, extends (event_t) :: entry_t
	private
	type(string_t) :: process_id
	type(string_t) :: library
	type(string_t) :: run_id
	logical :: has_integral = .false.
	real(default) :: integral = 0
	real(default) :: error = 0
	real(default) :: process_weight = 0
	logical :: valid = .false.
	type(counter_t) :: counter
	integer :: n_in = 0
	integer :: n_mci = 0
	type(mci_set_t), dimension(:), allocatable :: mci_sets
	type(selector_t) :: mci_selector
	type(core_safe_t), dimension(:), allocatable :: core_safe
	class(model_data_t), pointer :: model => null ()
	type(qcd_t) :: qcd
	type(entry_t), pointer :: first => null ()
	type(entry_t), pointer :: next => null ()
	class(evt_t), pointer :: evt_powheg => null ()
	logical :: requires_real_switch_off = .true.
	contains
	<<Simulations: entry: TBP>>
	end type entry_t

	@ %def entry_t
	@ Output. Write just the configuration, the event is written by a
	separate routine.

	The [[verbose]] option is unused, it is required by the interface of
	the base-object method.
	<<Simulations: entry: TBP>>=
	procedure :: write_config => entry_write_config
	<<Simulations: procedures>>=
	subroutine entry_write_config (object, unit)
	class(entry_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(3x,A,A,A)") "Process = '", char (object%process_id), "'"
	write (u, "(3x,A,A,A)") "Library = '", char (object%library), "'"
	write (u, "(3x,A,A,A)") "Run = '", char (object%run_id), "'"
	write (u, "(3x,A,L1)") "is valid = ", object%valid
	if (object%has_integral) then
	write (u, "(3x,A," // FMT_19 // ")") "Integral = ", object%integral
	write (u, "(3x,A," // FMT_19 // ")") "Error = ", object%error
	write (u, "(3x,A,F13.10)") "Weight =", object%process_weight
	else
	write (u, "(3x,A)") "Integral = [undefined]"
	end if
	write (u, "(3x,A,I0)") "MCI sets = ", object%n_mci
	call object%counter%write (u)
	do i = 1, size (object%mci_sets)
	write (u, "(A)")
	write (u, "(1x,A,I0,A)") "MCI set #", i, ":"
	call object%mci_sets(i)%write (u)
	end do
	if (allocated (object%core_safe)) then
	do i = 1, size (object%core_safe)
	write (u, "(1x,A,I0,A)") "Saved process-component core #", i, ":"
	call object%core_safe(i)%core%write (u)
	end do
	end if
	end subroutine entry_write_config

	@ %def entry_write_config
	@ Finalizer. The [[instance]] pointer component of the [[event_t]]
	base type points to a target which we did explicitly allocate in the
	[[entry_init]] procedure. Therefore, we finalize and explicitly
	deallocate it here. Then we call the finalizer of the base type.
	<<Simulations: entry: TBP>>=
	procedure :: final => entry_final
	<<Simulations: procedures>>=
	subroutine entry_final (object)
	class(entry_t), intent(inout) :: object
	integer :: i
	if (associated (object%instance)) then
	do i = 1, object%n_mci
	call object%instance%final_simulation (i)
	end do
	call object%instance%final ()
	deallocate (object%instance)
	end if
	call object%event_t%final ()
	end subroutine entry_final

	@ %def entry_final
	@ Copy the content of an entry into another one, except for the next-pointer
	<<Simulations: entry: TBP>>=
	procedure :: copy_entry => entry_copy_entry
	<<Simulations: procedures>>=
	subroutine entry_copy_entry (entry1, entry2)
	class(entry_t), intent(in), target :: entry1
	type(entry_t), intent(inout), target :: entry2
	call entry1%event_t%clone (entry2%event_t)
	entry2%process_id = entry1%process_id
	entry2%library = entry1%library
	entry2%run_id = entry1%run_id
	entry2%has_integral = entry1%has_integral
	entry2%integral = entry1%integral
	entry2%error = entry1%error
	entry2%process_weight = entry1%process_weight
	entry2%valid = entry1%valid
	entry2%counter = entry1%counter
	entry2%n_in = entry1%n_in
	entry2%n_mci = entry1%n_mci
	if (allocated (entry1%mci_sets)) then
	allocate (entry2%mci_sets (size (entry1%mci_sets)))
	entry2%mci_sets = entry1%mci_sets
	end if
	entry2%mci_selector = entry1%mci_selector
	if (allocated (entry1%core_safe)) then
	allocate (entry2%core_safe (size (entry1%core_safe)))
	entry2%core_safe = entry1%core_safe
	end if
	entry2%model => entry1%model
	entry2%qcd = entry1%qcd
	end subroutine entry_copy_entry

	@ %def entry_copy_entry
	@ Initialization. Search for a process entry and allocate a process
	instance as an anonymous object, temporarily accessible via the
	[[process_instance]] pointer. Assign data by looking at the process
	object and at the environment.

	If [[n_alt]] is set, we prepare for additional alternate sqme and weight
	entries.

	The [[compile]] flag is only false if we don't need the Whizard
	process at all, just its definition. In that case, we skip process
	initialization.

	Otherwise, and if the process object is not found initially: if
	[[integrate]] is set, attempt an integration pass and try again.
	Otherwise, just initialize the object.

	If [[generate]] is set, prepare the MCI objects for generating new events.
	For pure rescanning, this is not necessary.

	When done, we assign the [[instance]] and [[process]] pointers of the
	base type by the [[connect]] method, so we can reference them later.
	<<Simulations: entry: TBP>>=
	procedure :: init => entry_init
	<<Simulations: procedures>>=
	subroutine entry_init &
	(entry, process_id, &
	use_process, integrate, generate, update_sqme, &
	local, global, n_alt)
	class(entry_t), intent(inout), target :: entry
	type(string_t), intent(in) :: process_id
	logical, intent(in) :: use_process, integrate, generate, update_sqme
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	integer, intent(in), optional :: n_alt
	type(process_t), pointer :: process, master_process
	type(process_instance_t), pointer :: process_instance
	integer :: i
	logical :: combined_integration
	integer :: fixed_mci = 0
	call msg_debug (D_CORE, "entry_init")
	call msg_debug (D_CORE, "process_id", process_id)
	call prepare_process &
	(master_process, process_id, use_process, integrate, local, global)
	if (signal_is_pending ()) return

	if (associated (master_process)) then
	if (.not. master_process%has_matrix_element ()) then
	entry%has_integral = .true.
	entry%process_id = process_id
	entry%valid = .false.
	return
	end if
	else
	call entry%basic_init (local%var_list)
	entry%has_integral = .false.
	entry%process_id = process_id
	call entry%import_process_def_characteristics (local%prclib, process_id)
	entry%valid = .true.
	return
	end if

	call entry%basic_init (local%var_list, n_alt)

	entry%process_id = process_id
	if (generate .or. integrate) then
	entry%run_id = master_process%get_run_id ()
	process => master_process
	else
	call local%set_log (var_str ("?rebuild_phase_space"), &
	.false., is_known = .true.)
	call local%set_log (var_str ("?check_phs_file"), &
	.false., is_known = .true.)
	call local%set_log (var_str ("?rebuild_grids"), &
	.false., is_known = .true.)
	entry%run_id = &
	local%var_list%get_sval (var_str ("$run_id"))
	if (update_sqme) then
	call prepare_local_process (process, process_id, local)
	else
	process => master_process
	end if
	end if

	call entry%import_process_characteristics (process)

	allocate (entry%mci_sets (entry%n_mci))
	do i = 1, size (entry%mci_sets)
	call entry%mci_sets(i)%init (i, master_process)
	end do

	call entry%import_process_results (master_process)
	call entry%prepare_expressions (local)

	if (process%is_nlo_calculation ()) call process%init_nlo_settings (global%var_list)
	combined_integration = local%get_lval (var_str ("?combined_nlo_integration"))
	if (.not. combined_integration &
	.and. local%get_lval (var_str ("?fixed_order_nlo_events"))) then
	fixed_mci = process%extract_fixed_mci ()
	end if
	call prepare_process_instance (process_instance, process, local%model, &
	local = local)

	if (generate) then
	if (fixed_mci > 0) then
	call process%prepare_simulation (fixed_mci)
	call process_instance%init_simulation &
	(fixed_mci, entry%config%safety_factor, &
	local%get_lval (var_str ("?keep_failed_events")))
	else
	do i = 1, entry%n_mci
	call process%prepare_simulation (i)
	call process_instance%init_simulation (i, entry%config%safety_factor, &
	local%get_lval (var_str ("?keep_failed_events")))
	end do
	end if
	end if
	call entry%setup_event_transforms (process, local)
	call dispatch_qcd (entry%qcd, local%get_var_list_ptr (), local%os_data)

	call entry%connect_qcd ()

	select type (pcm => process_instance%pcm)
	class is (pcm_instance_nlo_t)
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	if (config%settings%fixed_order_nlo) &
	call pcm%set_fixed_order_event_mode ()
	end select
	end select

	if (present (global)) then
	call entry%connect (process_instance, local%model, global%process_stack)
	else
	call entry%connect (process_instance, local%model, local%process_stack)
	end if
	call entry%setup_expressions ()

	entry%model => process%get_model_ptr ()
	entry%valid = .true.

	end subroutine entry_init

	@ %def entry_init
	@
	<<Simulations: entry: TBP>>=
	procedure :: set_active_real_components => entry_set_active_real_components
	<<Simulations: procedures>>=
	subroutine entry_set_active_real_components (entry, i_mci)
	class(entry_t), intent(inout) :: entry
	integer, intent(in) :: i_mci
	integer :: i
	if (.not. entry%requires_real_switch_off) return
	select type (pcm => entry%instance%pcm)
	class is (pcm_instance_nlo_t)
	i = pcm%active_real_component
	if (associated (entry%evt_powheg)) then
	select type (evt => entry%evt_powheg)
	type is (evt_shower_t)
	if (entry%process%get_component_type(i) == COMP_REAL_FIN) then
	call evt%disable_powheg_matching ()
	else
	call evt%enable_powheg_matching ()
	end if
	class default
	call msg_fatal ("powheg-evt should be evt_shower_t!")
	end select
	end if
	end select
	if (entry%is_nlo () .and. .not. entry%process%is_combined_nlo_integration ()) then
	if (entry%process%extract_fixed_mci () > 0) then
	call entry%process%deactivate_components &
	(entry%process%extract_fixed_mci ())
	else
	call entry%process%deactivate_real_component ()
	end if
	end if
	entry%requires_real_switch_off = .false.
	end subroutine entry_set_active_real_components

	@ %def entry_set_active_real_components
	@ Part of simulation-entry initialization: set up a process object for
	local use.
	<<Simulations: procedures>>=
	subroutine prepare_local_process (process, process_id, local)
	type(process_t), pointer, intent(inout) :: process
	type(string_t), intent(in) :: process_id
	type(rt_data_t), intent(inout), target :: local
	type(integration_t) :: intg
	call intg%create_process (process_id)
	call intg%init_process (local)
	call intg%setup_process (local, verbose=.false.)
	process => intg%get_process_ptr ()
	end subroutine prepare_local_process

	@ %def prepare_local_process
	@ Part of simulation-entry initialization: set up a process instance
	matching the selected process object.

	The model that we can provide as an extra argument can modify particle
	settings (polarization) in the density matrices that will be constructed. It
	does not affect parameters.
	<<Simulations: procedures>>=
	subroutine prepare_process_instance &
	(process_instance, process, model, local)
	type(process_instance_t), pointer, intent(inout) :: process_instance
	type(process_t), intent(inout), target :: process
	class(model_data_t), intent(in), optional :: model
	type(rt_data_t), intent(in), optional, target :: local
	allocate (process_instance)
	call process_instance%init (process)
	if (process%is_nlo_calculation ()) then
	select type (pcm => process_instance%pcm)
	type is (pcm_instance_nlo_t)
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	if (.not. config%settings%combined_integration) &
	call pcm%disable_subtraction ()
	end select
	end select
	if (process%needs_extra_code () .and. present (local)) &
	call process_instance%create_and_load_extra_libraries &
	(local%beam_structure, local%os_data)
	end if
	call process_instance%setup_event_data (model)
	end subroutine prepare_process_instance

	@ %def prepare_process_instance
	@ Part of simulation-entry initialization: query the
	process for basic information.
	<<Simulations: entry: TBP>>=
	procedure, private :: import_process_characteristics &
	=> entry_import_process_characteristics
	<<Simulations: procedures>>=
	subroutine entry_import_process_characteristics (entry, process)
	class(entry_t), intent(inout) :: entry
	type(process_t), intent(in), target :: process
	entry%library = process%get_library_name ()
	entry%n_in = process%get_n_in ()
	entry%n_mci = process%get_n_mci ()
	end subroutine entry_import_process_characteristics

	@ %def entry_import_process_characteristics
	@ This is the alternative form which applies if there is no process
	entry, but just a process definition which we take from the provided
	[[prclib]] definition library.
	<<Simulations: entry: TBP>>=
	procedure, private :: import_process_def_characteristics &
	=> entry_import_process_def_characteristics
	<<Simulations: procedures>>=
	subroutine entry_import_process_def_characteristics (entry, prclib, id)
	class(entry_t), intent(inout) :: entry
	type(process_library_t), intent(in), target :: prclib
	type(string_t), intent(in) :: id
	entry%library = prclib%get_name ()
	entry%n_in = prclib%get_n_in (id)
	end subroutine entry_import_process_def_characteristics

	@ %def entry_import_process_def_characteristics
	@ Part of simulation-entry initialization: query the
	process for integration results.
	<<Simulations: entry: TBP>>=
	procedure, private :: import_process_results &
	=> entry_import_process_results
	<<Simulations: procedures>>=
	subroutine entry_import_process_results (entry, process)
	class(entry_t), intent(inout) :: entry
	type(process_t), intent(in), target :: process
	if (process%has_integral ()) then
	entry%integral = process%get_integral ()
	entry%error = process%get_error ()
	call entry%set_sigma (entry%integral)
	entry%has_integral = .true.
	end if
	end subroutine entry_import_process_results

	@ %def entry_import_process_characteristics
	@ Part of simulation-entry initialization: create expression factory
	objects and store them.
	<<Simulations: entry: TBP>>=
	procedure, private :: prepare_expressions &
	=> entry_prepare_expressions
	<<Simulations: procedures>>=
	subroutine entry_prepare_expressions (entry, local)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(in), target :: local
	type(eval_tree_factory_t) :: expr_factory
	call expr_factory%init (local%pn%selection_lexpr)
	call entry%set_selection (expr_factory)
	call expr_factory%init (local%pn%reweight_expr)
	call entry%set_reweight (expr_factory)
	call expr_factory%init (local%pn%analysis_lexpr)
	call entry%set_analysis (expr_factory)
	end subroutine entry_prepare_expressions

	@ %def entry_prepare_expressions
	@ Initializes the list of additional NLO entries. The routine gets the
	information about how many entries to associate from [[region_data]].
	<<Simulations: entry: TBP>>=
	procedure :: setup_additional_entries => entry_setup_additional_entries
	<<Simulations: procedures>>=
	subroutine entry_setup_additional_entries (entry)
	class(entry_t), intent(inout), target :: entry
	type(entry_t), pointer :: current_entry
	integer :: i, n_phs, n_flv
	type(evt_nlo_t), pointer :: evt
	integer :: mode
	evt => null ()
	select type (pcm => entry%instance%pcm)
	class is (pcm_instance_nlo_t)
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	n_phs = config%region_data%n_phs
	n_flv = config%region_data%n_flv_real
	end select
	end select
	select type (entry)
	type is (entry_t)
	current_entry => entry
	current_entry%first => entry
	call get_nlo_evt_ptr (current_entry, evt, mode)
	if (mode > EVT_NLO_SEPARATE_BORNLIKE) then
	allocate (evt%particle_set_radiated (n_phs * n_flv + 1))
	evt%event_deps%n_phs = n_phs
	evt%qcd => entry%qcd
	do i = 1, n_phs * n_flv
	allocate (current_entry%next)
	current_entry%next%first => current_entry%first
	current_entry => current_entry%next
	call entry%copy_entry (current_entry)
	current_entry%i_event = i
	end do
	else
	allocate (evt%particle_set_radiated (1))
	end if
	end select
	contains
	subroutine get_nlo_evt_ptr (entry, evt, mode)
	type(entry_t), intent(in), target :: entry
	type(evt_nlo_t), intent(out), pointer :: evt
	integer, intent(out) :: mode
	class(evt_t), pointer :: current_evt
	evt => null ()
	current_evt => entry%transform_first
	do
	select type (current_evt)
	type is (evt_nlo_t)
	evt => current_evt
	mode = evt%mode
	exit
	end select
	if (associated (current_evt%next)) then
	current_evt => current_evt%next
	else
	call msg_fatal ("evt_nlo not in list of event transforms")
	end if
	end do
	end subroutine get_nlo_evt_ptr
	end subroutine entry_setup_additional_entries

	@ %def entry_setup_additional_entries
	@
	<<Simulations: entry: TBP>>=
	procedure :: get_first => entry_get_first
	<<Simulations: procedures>>=
	function entry_get_first (entry) result (entry_out)
	class(entry_t), intent(in), target :: entry
	type(entry_t), pointer :: entry_out
	entry_out => null ()
	select type (entry)
	type is (entry_t)
	if (entry%is_nlo ()) then
	entry_out => entry%first
	else
	entry_out => entry
	end if
	end select
	end function entry_get_first

	@ %def entry_get_first
	@
	<<Simulations: entry: TBP>>=
	procedure :: get_next => entry_get_next
	<<Simulations: procedures>>=
	function entry_get_next (entry) result (next_entry)
	class(entry_t), intent(in) :: entry
	type(entry_t), pointer :: next_entry
	next_entry => null ()
	if (associated (entry%next)) then
	next_entry => entry%next
	else
	call msg_fatal ("Get next entry: No next entry")
	end if
	end function entry_get_next

	@ %def entry_get_next
	@
	<<Simulations: entry: TBP>>=
	procedure :: count_nlo_entries => entry_count_nlo_entries
	<<Simulations: procedures>>=
	function entry_count_nlo_entries (entry) result (n)
	class(entry_t), intent(in), target :: entry
	integer :: n
	type(entry_t), pointer :: current_entry
	n = 1
	if (.not. associated (entry%next)) then
	return
	else
	current_entry => entry%next
	do
	n = n + 1
	if (.not. associated (current_entry%next)) exit
	current_entry => current_entry%next
	end do
	end if
	end function entry_count_nlo_entries

	@ %def entry_count_nlo_entries
	@
	<<Simulations: entry: TBP>>=
	procedure :: reset_nlo_counter => entry_reset_nlo_counter
	<<Simulations: procedures>>=
	subroutine entry_reset_nlo_counter (entry)
	class(entry_t), intent(inout) :: entry
	class(evt_t), pointer :: evt
	evt => entry%transform_first
	do
	select type (evt)
	type is (evt_nlo_t)
	evt%i_evaluation = 0
	exit
	end select
	if (associated (evt%next)) evt => evt%next
	end do
	end subroutine entry_reset_nlo_counter

	@ %def entry_reset_nlo_counter
	@
	<<Simulations: entry: TBP>>=
	procedure :: determine_if_powheg_matching => entry_determine_if_powheg_matching
	<<Simulations: procedures>>=
	subroutine entry_determine_if_powheg_matching (entry)
	class(entry_t), intent(inout) :: entry
	class(evt_t), pointer :: current_transform
	if (associated (entry%transform_first)) then
	current_transform => entry%transform_first
	do
	select type (current_transform)
	type is (evt_shower_t)
	if (current_transform%contains_powheg_matching ()) &
	entry%evt_powheg => current_transform
	exit
	end select
	if (associated (current_transform%next)) then
	current_transform => current_transform%next
	else
	exit
	end if
	end do
	end if
	end subroutine entry_determine_if_powheg_matching

	@ %def entry_determine_if_powheg_matching
	@ Part of simulation-entry initialization: dispatch event transforms
	(decay, shower) as requested.
	<<Simulations: entry: TBP>>=
	procedure, private :: setup_event_transforms &
	=> entry_setup_event_transforms
	<<Simulations: procedures>>=
	subroutine entry_setup_event_transforms (entry, process, local)
	class(entry_t), intent(inout) :: entry
	type(process_t), intent(inout), target :: process
	type(rt_data_t), intent(in), target :: local
	class(evt_t), pointer :: evt
	type(var_list_t), pointer :: var_list
	logical :: enable_fixed_order, enable_shower
	var_list => local%get_var_list_ptr ()
	if (process%contains_unstable (local%model)) then
	call dispatch_evt_decay (evt, local%var_list)
	if (associated (evt)) call entry%import_transform (evt)
	end if
	enable_fixed_order = local%get_lval (var_str ("?fixed_order_nlo_events"))
	if (enable_fixed_order) then
	if (local%get_lval (var_str ("?unweighted"))) &
	call msg_fatal ("NLO Fixed Order events have to be generated with &
	&?unweighted = false")
	call dispatch_evt_nlo (evt)
	call entry%import_transform (evt)
	end if
	enable_shower = local%get_lval (var_str ("?allow_shower")) .and. &
	(local%get_lval (var_str ("?ps_isr_active")) &
	.or. local%get_lval (var_str ("?ps_fsr_active")) &
	.or. local%get_lval (var_str ("?muli_active")) &
	.or. local%get_lval (var_str ("?mlm_matching")) &
	.or. local%get_lval (var_str ("?ckkw_matching")) &
	.or. local%get_lval (var_str ("?powheg_matching")))
	if (enable_shower) then
	call dispatch_evt_shower (evt, var_list, local%model, &
	local%fallback_model, local%os_data, local%beam_structure, &
	process)
	call entry%import_transform (evt)
	end if
	if (local%get_lval (var_str ("?hadronization_active"))) then
	call dispatch_evt_hadrons (evt, var_list, local%fallback_model)
	call entry%import_transform (evt)
	end if
	end subroutine entry_setup_event_transforms

	@ %def entry_setup_event_transforms
	@ Compute weights. The integral in the argument is the sum of integrals for
	all processes in the sample. After computing the process weights, we repeat
	the normalization procedure for the process components.
	<<Simulations: entry: TBP>>=
	procedure :: init_mci_selector => entry_init_mci_selector
	<<Simulations: procedures>>=
	subroutine entry_init_mci_selector (entry, negative_weights)
	class(entry_t), intent(inout), target :: entry
	logical, intent(in), optional :: negative_weights
	type(entry_t), pointer :: current_entry
	integer :: i, j, k
	call msg_debug (D_CORE, "entry_init_mci_selector")
	if (entry%has_integral) then
	select type (entry)
	type is (entry_t)
	current_entry => entry
	do j = 1, current_entry%count_nlo_entries ()
	if (j > 1) current_entry => current_entry%get_next ()
	do k = 1, size(current_entry%mci_sets%integral)
	call msg_debug (D_CORE, "current_entry%mci_sets(k)%integral", &
	current_entry%mci_sets(k)%integral)
	end do
	call current_entry%mci_selector%init &
	(current_entry%mci_sets%integral, negative_weights)
	do i = 1, current_entry%n_mci
	current_entry%mci_sets(i)%weight_mci = &
	current_entry%mci_selector%get_weight (i)
	end do
	end do
	end select
	end if
	end subroutine entry_init_mci_selector

	@ %def entry_init_mci_selector
	@ Select a MCI entry, using the embedded random-number generator.
	<<Simulations: entry: TBP>>=
	procedure :: select_mci => entry_select_mci
	<<Simulations: procedures>>=
	function entry_select_mci (entry) result (i_mci)
	class(entry_t), intent(inout) :: entry
	integer :: i_mci
	call msg_debug2 (D_CORE, "entry_select_mci")
	if (entry%process%extract_fixed_mci () > 0) then
	i_mci = entry%process%extract_fixed_mci ()
	else
	call entry%mci_selector%generate (entry%rng, i_mci)
	end if
	call msg_debug2 (D_CORE, "i_mci", i_mci)
	end function entry_select_mci

	@ %def entry_select_mci
	@ Record an event for this entry, i.e., increment the appropriate counters.
	<<Simulations: entry: TBP>>=
	procedure :: record => entry_record
	<<Simulations: procedures>>=
	subroutine entry_record (entry, i_mci, from_file)
	class(entry_t), intent(inout) :: entry
	integer, intent(in) :: i_mci
	logical, intent(in), optional :: from_file
	real(default) :: weight, excess
	weight = entry%get_weight_prc ()
	excess = entry%get_excess_prc ()
	call entry%counter%record (weight, excess, from_file)
	if (i_mci > 0) then
	call entry%mci_sets(i_mci)%counter%record (weight, excess)
	end if
	end subroutine entry_record

	@ %def entry_record
	@ Update and restore the process core that this entry accesses, when
	parameters change. If explicit arguments [[model]], [[qcd]], or
	[[helicity_selection]] are provided, use those. Otherwise use the
	parameters stored in the process object.
	<<Simulations: entry: TBP>>=
	procedure :: update_process => entry_update_process
	procedure :: restore_process => entry_restore_process
	<<Simulations: procedures>>=
	subroutine entry_update_process &
	(entry, model, qcd, helicity_selection)
	class(entry_t), intent(inout) :: entry
	class(model_data_t), intent(in), optional, target :: model
	type(qcd_t), intent(in), optional :: qcd
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	type(process_t), pointer :: process
	class(prc_core_t), allocatable :: core
	integer :: i, n_terms
	class(model_data_t), pointer :: model_local
	type(qcd_t) :: qcd_local
	if (present (model)) then
	model_local => model
	else
	model_local => entry%model
	end if
	if (present (qcd)) then
	qcd_local = qcd
	else
	qcd_local = entry%qcd
	end if
	process => entry%get_process_ptr ()

	n_terms = process%get_n_terms ()
	allocate (entry%core_safe (n_terms))
	do i = 1, n_terms
	if (process%has_matrix_element (i, is_term_index = .true.)) then
	call process%extract_core (i, core)
	call dispatch_core_update (core, &
	model_local, helicity_selection, qcd_local, &
	entry%core_safe(i)%core)
	call process%restore_core (i, core)
	end if
	end do
	end subroutine entry_update_process

	subroutine entry_restore_process (entry)
	class(entry_t), intent(inout) :: entry
	type(process_t), pointer :: process
	class(prc_core_t), allocatable :: core
	integer :: i, n_terms
	process => entry%get_process_ptr ()
	n_terms = process%get_n_terms ()
	do i = 1, n_terms
	if (process%has_matrix_element (i, is_term_index = .true.)) then
	call process%extract_core (i, core)
	call dispatch_core_restore (core, entry%core_safe(i)%core)
	call process%restore_core (i, core)
	end if
	end do
	deallocate (entry%core_safe)
	end subroutine entry_restore_process

	@ %def entry_update_process
	@ %def entry_restore_process
	<<Simulations: entry: TBP>>=
	procedure :: connect_qcd => entry_connect_qcd
	<<Simulations: procedures>>=
	subroutine entry_connect_qcd (entry)
	class(entry_t), intent(inout), target :: entry
	class(evt_t), pointer :: evt
	evt => entry%transform_first
	do while (associated (evt))
	select type (evt)
	type is (evt_shower_t)
	evt%qcd => entry%qcd
	if (allocated (evt%matching)) then
	evt%matching%qcd => entry%qcd
	end if
	end select
	evt => evt%next
	end do
	end subroutine entry_connect_qcd

	@ %def entry_connect_qcd
	@
	\subsection{Entries for alternative environment}
	Entries for alternate environments. [No additional components
	anymore, so somewhat redundant.]
	<<Simulations: types>>=
	type, extends (entry_t) :: alt_entry_t
	contains
	<<Simulations: alt entry: TBP>>
	end type alt_entry_t

	@ %def alt_entry_t
	@ The alternative entries are there to re-evaluate the event, given
	momenta, in a different context.

	Therefore, we allocate a local process object and use this as the
	reference for the local process instance, when initializing the entry.
	We temporarily import the [[process]] object into an [[integration_t]]
	wrapper, to take advantage of the associated methods. The local
	process object is built in the context of the current environment,
	here called [[global]]. Then, we initialize the process instance.

	The [[master_process]] object contains the integration results to which we
	refer when recalculating an event. Therefore, we use this object instead of
	the locally built [[process]] when we extract the integration results.

	The locally built [[process]] object should be finalized when done. It
	remains accessible via the [[event_t]] base object of [[entry]], which
	contains pointers to the process and instance.
	<<Simulations: alt entry: TBP>>=
	procedure :: init_alt => alt_entry_init
	<<Simulations: procedures>>=
	subroutine alt_entry_init (entry, process_id, master_process, local)
	class(alt_entry_t), intent(inout), target :: entry
	type(string_t), intent(in) :: process_id
	type(process_t), intent(in), target :: master_process
	type(rt_data_t), intent(inout), target :: local
	type(process_t), pointer :: process
	type(process_instance_t), pointer :: process_instance
	type(string_t) :: run_id
	integer :: i

	call msg_message ("Simulate: initializing alternate process setup ...")

	run_id = &
	local%var_list%get_sval (var_str ("$run_id"))
	call local%set_log (var_str ("?rebuild_phase_space"), &
	.false., is_known = .true.)
	call local%set_log (var_str ("?check_phs_file"), &
	.false., is_known = .true.)
	call local%set_log (var_str ("?rebuild_grids"), &
	.false., is_known = .true.)

	call entry%basic_init (local%var_list)

	call prepare_local_process (process, process_id, local)
	entry%process_id = process_id
	entry%run_id = run_id

	call entry%import_process_characteristics (process)

	allocate (entry%mci_sets (entry%n_mci))
	do i = 1, size (entry%mci_sets)
	call entry%mci_sets(i)%init (i, master_process)
	end do

	call entry%import_process_results (master_process)
	call entry%prepare_expressions (local)

	call prepare_process_instance (process_instance, process, local%model)
	call entry%setup_event_transforms (process, local)

	call entry%connect (process_instance, local%model, local%process_stack)
	call entry%setup_expressions ()

	entry%model => process%get_model_ptr ()

	call msg_message ("... alternate process setup complete.")

	end subroutine alt_entry_init

	@ %def alt_entry_init
	@ Copy the particle set from the master entry to the alternate entry.
	This is the particle set of the hard process.
	<<Simulations: alt entry: TBP>>=
	procedure :: fill_particle_set => entry_fill_particle_set
	<<Simulations: procedures>>=
	subroutine entry_fill_particle_set (alt_entry, entry)
	class(alt_entry_t), intent(inout) :: alt_entry
	class(entry_t), intent(in), target :: entry
	type(particle_set_t) :: pset
	call entry%get_hard_particle_set (pset)
	call alt_entry%set_hard_particle_set (pset)
	call pset%final ()
	end subroutine entry_fill_particle_set

	@ %def particle_set_copy_prt
	@
	\subsection{The simulation type}
	Each simulation object corresponds to an event sample, identified by
	the [[sample_id]].

	The simulation may cover several processes simultaneously. All
	process-specific data, including the event records, are stored in the
	[[entry]] subobjects. The [[current]] index indicates which record
	was selected last. [[version]] is foreseen to contain a tag on the \whizard\
	event file version. It can be
	<<Simulations: public>>=
	public :: simulation_t
	<<Simulations: types>>=
	type :: simulation_t
	private
	type(rt_data_t), pointer :: local => null ()
	type(string_t) :: sample_id
	logical :: unweighted = .true.
	logical :: negative_weights = .false.
	logical :: respect_selection = .true.
	integer :: norm_mode = NORM_UNDEFINED
	logical :: update_sqme = .false.
	logical :: update_weight = .false.
	logical :: update_event = .false.
	logical :: recover_beams = .false.
	logical :: pacify = .false.
	integer :: n_max_tries = 10000
	integer :: n_prc = 0
	integer :: n_alt = 0
	logical :: has_integral = .false.
	logical :: valid = .false.
	real(default) :: integral = 0
	real(default) :: error = 0
	integer :: version = 1
	character(32) :: md5sum_prc = ""
	character(32) :: md5sum_cfg = ""
	character(32), dimension(:), allocatable :: md5sum_alt
	type(entry_t), dimension(:), allocatable :: entry
	type(alt_entry_t), dimension(:,:), allocatable :: alt_entry
	type(selector_t) :: process_selector
	integer :: n_evt_requested = 0
	integer :: split_n_evt = 0
	integer :: split_n_kbytes = 0
	integer :: split_index = 0
	type(counter_t) :: counter
	class(rng_t), allocatable :: rng
	integer :: i_prc = 0
	integer :: i_mci = 0
	real(default) :: weight = 0
	real(default) :: excess = 0
	contains
	<<Simulations: simulation: TBP>>
	end type simulation_t

	@ %def simulation_t
	@ Output. [[write_config]] writes just the configuration. [[write]]
	as a method of the base type [[event_t]]
	writes the current event and process instance, depending on options.
	<<Simulations: simulation: TBP>>=
	procedure :: write => simulation_write
	<<Simulations: procedures>>=
	subroutine simulation_write (object, unit)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	call write_separator (u, 2)
	write (u, "(1x,A,A,A)") "Event sample: '", char (object%sample_id), "'"
	write (u, "(3x,A,I0)") "Processes = ", object%n_prc
	if (object%n_alt > 0) then
	write (u, "(3x,A,I0)") "Alt.wgts = ", object%n_alt
	end if
	write (u, "(3x,A,L1)") "Unweighted = ", object%unweighted
	write (u, "(3x,A,A)") "Event norm = ", &
	char (event_normalization_string (object%norm_mode))
	write (u, "(3x,A,L1)") "Neg. weights = ", object%negative_weights
	write (u, "(3x,A,L1)") "Respect sel. = ", object%respect_selection
	write (u, "(3x,A,L1)") "Update sqme = ", object%update_sqme
	write (u, "(3x,A,L1)") "Update wgt = ", object%update_weight
	write (u, "(3x,A,L1)") "Update event = ", object%update_event
	write (u, "(3x,A,L1)") "Recov. beams = ", object%recover_beams
	write (u, "(3x,A,L1)") "Pacify = ", object%pacify
	write (u, "(3x,A,I0)") "Max. tries = ", object%n_max_tries
	if (object%has_integral) then
	write (u, "(3x,A," // FMT_19 // ")") "Integral = ", object%integral
	write (u, "(3x,A," // FMT_19 // ")") "Error = ", object%error
	else
	write (u, "(3x,A)") "Integral = [undefined]"
	end if
	write (u, "(3x,A,L1)") "Sim. valid = ", object%valid
	write (u, "(3x,A,I0)") "Ev.file ver. = ", object%version
	if (object%md5sum_prc /= "") then
	write (u, "(3x,A,A,A)") "MD5 sum (proc) = '", object%md5sum_prc, "'"
	end if
	if (object%md5sum_cfg /= "") then
	write (u, "(3x,A,A,A)") "MD5 sum (config) = '", object%md5sum_cfg, "'"
	end if
	write (u, "(3x,A,I0)") "Events requested = ", object%n_evt_requested
	if (object%split_n_evt > 0 .or. object%split_n_kbytes > 0) then
	write (u, "(3x,A,I0)") "Events per file = ", object%split_n_evt
	write (u, "(3x,A,I0)") "KBytes per file = ", object%split_n_kbytes
	write (u, "(3x,A,I0)") "First file index = ", object%split_index
	end if
	call object%counter%write (u)
	call write_separator (u)
	if (object%i_prc /= 0) then
	write (u, "(1x,A)") "Current event:"
	write (u, "(3x,A,I0,A,A)") "Process #", &
	object%i_prc, ": ", &
	char (object%entry(object%i_prc)%process_id)
	write (u, "(3x,A,I0)") "MCI set #", object%i_mci
	write (u, "(3x,A," // FMT_19 // ")") "Weight = ", object%weight
	if (.not. vanishes (object%excess)) &
	write (u, "(3x,A," // FMT_19 // ")") "Excess = ", object%excess
	else
	write (u, "(1x,A,I0,A,A)") "Current event: [undefined]"
	end if
	call write_separator (u)
	if (allocated (object%rng)) then
	call object%rng%write (u)
	else
	write (u, "(3x,A)") "Random-number generator: [undefined]"
	end if
	if (allocated (object%entry)) then
	do i = 1, size (object%entry)
	if (i == 1) then
	call write_separator (u, 2)
	else
	call write_separator (u)
	end if
	write (u, "(1x,A,I0,A)") "Process #", i, ":"
	call object%entry(i)%write_config (u)
	end do
	end if
	call write_separator (u, 2)
	end subroutine simulation_write

	@ %def simulation_write
	@ Write the current event record. If an explicit index is given,
	write that event record.

	We implement writing to [[unit]] (event contents / debugging format)
	and writing to an [[eio]] event stream (storage). We include a [[testflag]]
	in order to suppress numerical noise in the testsuite.
	<<Simulations: simulation: TBP>>=
	generic :: write_event => write_event_unit
	procedure :: write_event_unit => simulation_write_event_unit
	<<Simulations: procedures>>=
	subroutine simulation_write_event_unit &
	(object, unit, i_prc, verbose, testflag)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer, intent(in), optional :: i_prc
	logical, intent(in), optional :: testflag
	logical :: pacified
	integer :: current
	pacified = .false.; if (present(testflag)) pacified = testflag
	pacified = pacified .or. object%pacify
	if (present (i_prc)) then
	current = i_prc
	else
	current = object%i_prc
	end if
	if (current > 0) then
	call object%entry(current)%write (unit, verbose = verbose, &
	testflag = pacified)
	else
	call msg_fatal ("Simulation: write event: no process selected")
	end if
	end subroutine simulation_write_event_unit

	@ %def simulation_write_event
	@ This writes one of the alternate events, if allocated.
	<<Simulations: simulation: TBP>>=
	procedure :: write_alt_event => simulation_write_alt_event
	<<Simulations: procedures>>=
	subroutine simulation_write_alt_event (object, unit, j_alt, i_prc, &
	verbose, testflag)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: j_alt
	integer, intent(in), optional :: i_prc
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: testflag
	integer :: i, j
	if (present (j_alt)) then
	j = j_alt
	else
	j = 1
	end if
	if (present (i_prc)) then
	i = i_prc
	else
	i = object%i_prc
	end if
	if (i > 0) then
	if (j> 0 .and. j <= object%n_alt) then
	call object%alt_entry(i,j)%write (unit, verbose = verbose, &
	testflag = testflag)
	else
	call msg_fatal ("Simulation: write alternate event: out of range")
	end if
	else
	call msg_fatal ("Simulation: write alternate event: no process selected")
	end if
	end subroutine simulation_write_alt_event

	@ %def simulation_write_alt_event
	@ Finalizer.
	<<Simulations: simulation: TBP>>=
	procedure :: final => simulation_final
	<<Simulations: procedures>>=
	subroutine simulation_final (object)
	class(simulation_t), intent(inout) :: object
	integer :: i, j
	if (allocated (object%entry)) then
	do i = 1, size (object%entry)
	call object%entry(i)%final ()
	end do
	end if
	if (allocated (object%alt_entry)) then
	do j = 1, size (object%alt_entry, 2)
	do i = 1, size (object%alt_entry, 1)
	call object%alt_entry(i,j)%final ()
	end do
	end do
	end if
	if (allocated (object%rng)) call object%rng%final ()
	end subroutine simulation_final

	@ %def simulation_final
	@ Initialization. We can deduce all data from the given list of
	process IDs and the global data set. The process objects are taken
	from the stack. Once the individual integrals are known, we add them (and the
	errors), to get the sample integral.

	If there are alternative environments, we suspend initialization for
	setting up alternative process objects, then restore the master
	process and its parameters. The generator or rescanner can then
	switch rapidly between processes.

	If [[integrate]] is set, we make sure that all affected processes are
	integrated before simulation. This is necessary if we want to actually
	generate events. If [[integrate]] is unset, we don't need the integral
	because we just rescan existing events. In that case, we just need compiled
	matrix elements.

	If [[generate]] is set, we prepare for actually generating events. Otherwise,
	we may only read and rescan events.
	<<Simulations: simulation: TBP>>=
	procedure :: init => simulation_init
	<<Simulations: procedures>>=
	subroutine simulation_init (simulation, &
	process_id, integrate, generate, local, global, alt_env)
	class(simulation_t), intent(out), target :: simulation
	type(string_t), dimension(:), intent(in) :: process_id
	logical, intent(in) :: integrate, generate
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	type(rt_data_t), dimension(:), intent(inout), optional, target :: alt_env
	class(rng_factory_t), allocatable :: rng_factory
	type(string_t) :: norm_string, version_string
	logical :: use_process
	integer :: i, j
	simulation%local => local
	simulation%sample_id = &
	local%get_sval (var_str ("$sample"))
	simulation%unweighted = &
	local%get_lval (var_str ("?unweighted"))
	simulation%negative_weights = &
	local%get_lval (var_str ("?negative_weights"))
	simulation%respect_selection = &
	local%get_lval (var_str ("?sample_select"))
	version_string = &
	local%get_sval (var_str ("$event_file_version"))
	norm_string = &
	local%get_sval (var_str ("$sample_normalization"))
	simulation%norm_mode = &
	event_normalization_mode (norm_string, simulation%unweighted)
	simulation%pacify = &
	local%get_lval (var_str ("?sample_pacify"))
	simulation%n_max_tries = &
	local%get_ival (var_str ("sample_max_tries"))
	simulation%split_n_evt = &
	local%get_ival (var_str ("sample_split_n_evt"))
	simulation%split_n_kbytes = &
	local%get_ival (var_str ("sample_split_n_kbytes"))
	simulation%split_index = &
	local%get_ival (var_str ("sample_split_index"))
	simulation%update_sqme = &
	local%get_lval (var_str ("?update_sqme"))
	simulation%update_weight = &
	local%get_lval (var_str ("?update_weight"))
	simulation%update_event = &
	local%get_lval (var_str ("?update_event"))
	simulation%recover_beams = &
	local%get_lval (var_str ("?recover_beams"))
	simulation%counter%reproduce_xsection = &
	local%get_lval (var_str ("?check_event_weights_against_xsection"))
	use_process = &
	integrate .or. generate &
	.or. simulation%update_sqme &
	.or. simulation%update_weight &
	.or. simulation%update_event &
	.or. present (alt_env)
	select case (size (process_id))
	case (0)
	call msg_error ("Simulation: no process selected")
	case (1)
	write (msg_buffer, "(A,A,A)") &
	"Starting simulation for process '", &
	char (process_id(1)), "'"
	call msg_message ()
	case default
	write (msg_buffer, "(A,A,A)") &
	"Starting simulation for processes '", &
	char (process_id(1)), "' etc."
	call msg_message ()
	end select
	select case (char (version_string))
	case ("", "2.2.4")
	simulation%version = 2
	case ("2.2")
	simulation%version = 1
	case default
	simulation%version = 0
	end select
	if (simulation%version == 0) then
	call msg_fatal ("Event file format '" &
	// char (version_string) &
	// "' is not compatible with this version.")
	end if
	simulation%n_prc = size (process_id)
	allocate (simulation%entry (simulation%n_prc))
	if (present (alt_env)) then
	simulation%n_alt = size (alt_env)
	do i = 1, simulation%n_prc
	call simulation%entry(i)%init (process_id(i), &
	use_process, integrate, generate, &
	simulation%update_sqme, &
	local, global, simulation%n_alt)
	if (signal_is_pending ()) return
	end do
	simulation%valid = any (simulation%entry%valid)
	if (.not. simulation%valid) then
	call msg_error ("Simulate: no process has a valid matrix element.")
	return
	end if
	call simulation%update_processes ()
	allocate (simulation%alt_entry (simulation%n_prc, simulation%n_alt))
	allocate (simulation%md5sum_alt (simulation%n_alt))
	simulation%md5sum_alt = ""
	do j = 1, simulation%n_alt
	do i = 1, simulation%n_prc
	call simulation%alt_entry(i,j)%init_alt (process_id(i), &
	simulation%entry(i)%get_process_ptr (), alt_env(j))
	if (signal_is_pending ()) return
	end do
	end do
	call simulation%restore_processes ()
	else
	do i = 1, simulation%n_prc
	call simulation%entry(i)%init &
	(process_id(i), &
	use_process, integrate, generate, simulation%update_sqme, &
	local, global)
	call simulation%entry(i)%determine_if_powheg_matching ()
	if (signal_is_pending ()) return
	if (simulation%entry(i)%is_nlo ()) &
	call simulation%entry(i)%setup_additional_entries ()
	end do
	simulation%valid = any (simulation%entry%valid)
	if (.not. simulation%valid) then
	call msg_error ("Simulate: " &
	// "no process has a valid matrix element.")
	return
	end if
	end if
	!!! if this becomes conditional, some ref files will need update (seed change)
	! if (generate) then
	call dispatch_rng_factory (rng_factory, local%var_list)
	call rng_factory%make (simulation%rng)
	! end if
	if (all (simulation%entry%has_integral)) then
	simulation%integral = sum (simulation%entry%integral)
	simulation%error = sqrt (sum (simulation%entry%error ** 2))
	simulation%has_integral = .true.
	if (integrate .and. generate) then
	do i = 1, simulation%n_prc
	if (simulation%entry(i)%integral < 0 .and. .not. &
	simulation%negative_weights) then
	call msg_fatal ("Integral of process '" // &
	char (process_id (i)) // "'is negative.")
	end if
	end do
	end if
	else
	if (integrate .and. generate) &
	call msg_error ("Simulation contains undefined integrals.")
	end if
	if (simulation%integral > 0 .or. &
	(simulation%integral < 0 .and. simulation%negative_weights)) then
	simulation%valid = .true.
	else if (generate) then
	call msg_error ("Simulate: " &
	// "sum of process integrals must be positive; skipping.")
	simulation%valid = .false.
	else
	simulation%valid = .true.
	end if
	if (simulation%valid) call simulation%compute_md5sum ()
	end subroutine simulation_init

	@ %def simulation_init
	@ The number of events that we want to simulate is determined by the
	settings of [[n_events]], [[luminosity]], and [[?unweighted]]. For
	weighted events, we take [[n_events]] at face value as the number of
	matrix element calls. For unweighted events, if the process is a
	decay, [[n_events]] is the number of unweighted events. In these
	cases, the luminosity setting is ignored.

	For unweighted events with a scattering process, we calculate the
	event number that corresponds to the luminosity, given the current
	value of the integral. We then compare this with [[n_events]] and
	choose the larger number.
	<<Simulations: simulation: TBP>>=
	procedure :: compute_n_events => simulation_compute_n_events
	<<Simulations: procedures>>=
	subroutine simulation_compute_n_events (simulation, n_events, var_list)
	class(simulation_t), intent(in) :: simulation
	integer, intent(out) :: n_events
	type(var_list_t) :: var_list
	real(default) :: lumi, x_events_lumi
	integer :: n_events_lumi
	logical :: is_scattering
	n_events = &
	var_list%get_ival (var_str ("n_events"))
	lumi = &
	var_list%get_rval (var_str ("luminosity"))
	if (simulation%unweighted) then
	is_scattering = simulation%entry(1)%n_in == 2
	if (is_scattering) then
	x_events_lumi = abs (simulation%integral * lumi)
	if (x_events_lumi < huge (n_events)) then
	n_events_lumi = nint (x_events_lumi)
	else
	call msg_message ("Simulation: luminosity too large, &
	&limiting number of events")
	n_events_lumi = huge (n_events)
	end if
	if (n_events_lumi > n_events) then
	call msg_message ("Simulation: using n_events as computed from &
	&luminosity value")
	n_events = n_events_lumi
	else
	write (msg_buffer, "(A,1x,I0)") &
	"Simulation: requested number of events =", n_events
	call msg_message ()
	if (.not. vanishes (simulation%integral)) then
	write (msg_buffer, "(A,1x,ES11.4)") &
	" corr. to luminosity [fb-1] = ", &
	n_events / simulation%integral
	call msg_message ()
	end if
	end if
	end if
	end if
	end subroutine simulation_compute_n_events

	@ %def simulation_compute_n_events
	@ Write the actual efficiency of the simulation run. We get the total
	number of events stored in the simulation counter and compare this
	with the total number of calls stored in the event entries.

	In order not to miscount samples that are partly read from file, use
	the [[generated]] counter, not the [[total]] counter.
	<<Simulations: simulation: TBP>>=
	procedure :: show_efficiency => simulation_show_efficiency
	<<Simulations: procedures>>=
	subroutine simulation_show_efficiency (simulation)
	class(simulation_t), intent(inout) :: simulation
	integer :: n_events, n_calls
	real(default) :: eff
	n_events = simulation%counter%generated
	n_calls = sum (simulation%entry%get_actual_calls_total ())
	if (n_calls > 0) then
	eff = real (n_events, kind=default) / n_calls
	write (msg_buffer, "(A,1x,F6.2,1x,A)") &
	"Events: actual unweighting efficiency =", 100 * eff, "%"
	call msg_message ()
	end if
	end subroutine simulation_show_efficiency

	@ %def simulation_show_efficiency
	@
	<<Simulations: simulation: TBP>>=
	procedure :: get_n_nlo_entries => simulation_get_n_nlo_entries
	<<Simulations: procedures>>=
	function simulation_get_n_nlo_entries (simulation, i_prc) result (n_extra)
	class(simulation_t), intent(in) :: simulation
	integer, intent(in) :: i_prc
	integer :: n_extra
	n_extra = simulation%entry(i_prc)%count_nlo_entries ()
	end function simulation_get_n_nlo_entries

	@ %def simulation_get_n_nlo_entries
	@ Compute the checksum of the process set. We retrieve the MD5 sums
	of all processes. This depends only on the process definitions, while
	parameters are not considered. The configuration checksum is
	retrieved from the MCI records in the process objects and furthermore
	includes beams, parameters, integration results, etc., so matching the
	latter should guarantee identical physics.
	<<Simulations: simulation: TBP>>=
	procedure :: compute_md5sum => simulation_compute_md5sum
	<<Simulations: procedures>>=
	subroutine simulation_compute_md5sum (simulation)
	class(simulation_t), intent(inout) :: simulation
	type(process_t), pointer :: process
	type(string_t) :: buffer
	integer :: j, i, n_mci, i_mci, n_component, i_component
	if (simulation%md5sum_prc == "") then
	buffer = ""
	do i = 1, simulation%n_prc
	if (.not. simulation%entry(i)%valid) cycle
	process => simulation%entry(i)%get_process_ptr ()
	if (associated (process)) then
	n_component = process%get_n_components ()
	do i_component = 1, n_component
	if (process%has_matrix_element (i_component)) then
	buffer = buffer // process%get_md5sum_prc (i_component)
	end if
	end do
	end if
	end do
	simulation%md5sum_prc = md5sum (char (buffer))
	end if
	if (simulation%md5sum_cfg == "") then
	buffer = ""
	do i = 1, simulation%n_prc
	if (.not. simulation%entry(i)%valid) cycle
	process => simulation%entry(i)%get_process_ptr ()
	if (associated (process)) then
	n_mci = process%get_n_mci ()
	do i_mci = 1, n_mci
	buffer = buffer // process%get_md5sum_mci (i_mci)
	end do
	end if
	end do
	simulation%md5sum_cfg = md5sum (char (buffer))
	end if
	do j = 1, simulation%n_alt
	if (simulation%md5sum_alt(j) == "") then
	buffer = ""
	do i = 1, simulation%n_prc
	process => simulation%alt_entry(i,j)%get_process_ptr ()
	if (associated (process)) then
	buffer = buffer // process%get_md5sum_cfg ()
	end if
	end do
	simulation%md5sum_alt(j) = md5sum (char (buffer))
	end if
	end do
	end subroutine simulation_compute_md5sum

	@ %def simulation_compute_md5sum
	@ Initialize the process selector, using the entry integrals as process
	weights.
	<<Simulations: simulation: TBP>>=
	procedure :: init_process_selector => simulation_init_process_selector
	<<Simulations: procedures>>=
	subroutine simulation_init_process_selector (simulation)
	class(simulation_t), intent(inout) :: simulation
	integer :: i
	if (simulation%has_integral) then
	call simulation%process_selector%init (simulation%entry%integral, &
	negative_weights = simulation%negative_weights)
	do i = 1, simulation%n_prc
	associate (entry => simulation%entry(i))
	if (.not. entry%valid) then
	call msg_warning ("Process '" // char (entry%process_id) // &
	"': matrix element vanishes, no events can be generated.")
	cycle
	end if
	call entry%init_mci_selector (simulation%negative_weights)
	entry%process_weight = simulation%process_selector%get_weight (i)
	end associate
	end do
	end if
	end subroutine simulation_init_process_selector

	@ %def simulation_init_process_selector
	@ Select a process, using the random-number generator.
	<<Simulations: simulation: TBP>>=
	procedure :: select_prc => simulation_select_prc
	<<Simulations: procedures>>=
	function simulation_select_prc (simulation) result (i_prc)
	class(simulation_t), intent(inout) :: simulation
	integer :: i_prc
	call simulation%process_selector%generate (simulation%rng, i_prc)
	end function simulation_select_prc

	@ %def simulation_select_prc
	@ Select a MCI set for the selected process.
	<<Simulations: simulation: TBP>>=
	procedure :: select_mci => simulation_select_mci
	<<Simulations: procedures>>=
	function simulation_select_mci (simulation) result (i_mci)
	class(simulation_t), intent(inout) :: simulation
	integer :: i_mci
	i_mci = 0
	if (simulation%i_prc /= 0) then
	i_mci = simulation%entry(simulation%i_prc)%select_mci ()
	end if
	end function simulation_select_mci

	@ %def simulation_select_mci
	@ Generate a predefined number of events. First select a process and
	a component set, then generate an event for that process and factorize
	the quantum state. The pair of random numbers can be used for
	factorization.

	When generating events, we drop all configurations where the event is
	marked as incomplete. This happens if the event fails cuts. In fact,
	such events are dropped already by the sampler if unweighting is in
	effect, so this can happen only for weighted events. By setting a
	limit given by [[sample_max_tries]] (user parameter), we can avoid an
	endless loop.

	NB: When reading from file, event transforms can't be applied because the
	process instance will not be complete. This should be fixed.
	<<Simulations: simulation: TBP>>=
	procedure :: generate => simulation_generate
	<<Simulations: procedures>>=
	subroutine simulation_generate (simulation, n, es_array)
	class(simulation_t), intent(inout), target :: simulation
	integer, intent(in) :: n
	type(event_stream_array_t), intent(inout), optional :: es_array
	type(string_t) :: str1, str2, str3
	logical :: generate_new, passed
	integer :: i, j, k
	type(entry_t), pointer :: current_entry
	integer :: n_events
	simulation%n_evt_requested = n
	n_events = n * simulation%get_n_nlo_entries (1)
	call simulation%entry%set_n (n)
	if (simulation%n_alt > 0) call simulation%alt_entry%set_n (n)
	str1 = "Events: generating"
	if (present (es_array)) then
	if (es_array%has_input ()) str1 = "Events: reading"
	end if
	if (simulation%entry(1)%config%unweighted) then
	str2 = "unweighted"
	else
	str2 = "weighted"
	end if
	if (simulation%entry(1)%config%factorization_mode == &
	FM_IGNORE_HELICITY) then
	str3 = ", unpolarized"
	else
	str3 = ", polarized"
	end if
	if (n_events == n) then
	write (msg_buffer, "(A,1x,I0,1x,A,1x,A)") char (str1), n, &
	char (str2) // char(str3), "events ..."
	else
	write (msg_buffer, "(A,1x,I0,1x,A,1x,A)") char (str1), n_events, &
	char (str2) // char(str3), "NLO events ..."
	end if
	call msg_message ()
	write (msg_buffer, "(A,1x,A)") "Events: event normalization mode", &
	char (event_normalization_string (simulation%norm_mode))
	call msg_message ()
	do i = 1, n
	if (present (es_array)) then
	call simulation%read_event (es_array, .true., generate_new)
	else
	generate_new = .true.
	end if
	if (generate_new) then
	simulation%i_prc = simulation%select_prc ()
	simulation%i_mci = simulation%select_mci ()
	associate (entry => simulation%entry(simulation%i_prc))
	call entry%set_active_real_components (simulation%i_mci)
	current_entry => entry%get_first ()
	do k = 1, current_entry%count_nlo_entries ()
	if (k > 1) then
	current_entry => current_entry%get_next ()
	current_entry%particle_set => current_entry%first%particle_set
	current_entry%particle_set_is_valid &
	= current_entry%first%particle_set_is_valid
	end if
	do j = 1, simulation%n_max_tries
	if (.not. current_entry%valid) call msg_warning &
	("Process '" // char (current_entry%process_id) // "': " // &
	"matrix element vanishes, no events can be generated.")
	call current_entry%generate (simulation%i_mci, i_nlo = k)
	if (signal_is_pending ()) return
	if (current_entry%has_valid_particle_set ()) then
	call simulation%counter%record_mean_and_variance (&
	current_entry%weight_prc, k)
	exit
	end if
	end do
	end do
	if (entry%is_nlo ()) call entry%reset_nlo_counter ()
	if (.not. entry%has_valid_particle_set ()) then
	write (msg_buffer, "(A,I0,A)") "Simulation: failed to &
	&generate valid event after ", &
	simulation%n_max_tries, " tries (sample_max_tries)"
	call msg_fatal ()
	end if
	current_entry => entry%get_first ()
	do k = 1, current_entry%count_nlo_entries ()
	if (k > 1) current_entry => current_entry%get_next ()
	call current_entry%evaluate_expressions ()
	end do
	if (signal_is_pending ()) return
	if (entry%passed_selection ()) then
	simulation%weight = entry%get_weight_ref ()
	simulation%excess = entry%get_excess_prc ()
	end if
	call simulation%counter%record &
	(simulation%weight, simulation%excess)
	call entry%record (simulation%i_mci)
	end associate
	else
	associate (entry => simulation%entry(simulation%i_prc))
	call entry%accept_sqme_ref ()
	call entry%accept_weight_ref ()
	!!! JRR: WK please check: why commented out
	! call entry%evaluate_transforms () ! doesn't activate
	call entry%check ()
	call entry%evaluate_expressions ()
	if (signal_is_pending ()) return
	if (entry%passed_selection ()) then
	simulation%weight = entry%get_weight_ref ()
	simulation%excess = entry%get_excess_prc ()
	end if
	call simulation%counter%record &
	(simulation%weight, simulation%excess, from_file=.true.)
	call entry%record (simulation%i_mci, from_file=.true.)
	end associate
	end if
	call simulation%calculate_alt_entries ()
	if (signal_is_pending ()) return
	if (simulation%pacify) call pacify (simulation)
	if (simulation%respect_selection) then
	passed = simulation%entry(simulation%i_prc)%passed_selection ()
	else
	passed = .true.
	end if
	if (present (es_array)) then
	call simulation%write_event (es_array, passed)
	end if
	end do
	call msg_message (" ... event sample complete.")
	if (simulation%unweighted) call simulation%show_efficiency ()
	call simulation%counter%show_excess ()
	call simulation%counter%show_mean_and_variance ()
	end subroutine simulation_generate

	@ %def simulation_generate
	@ Compute the event matrix element and weight for all alternative
	environments, given the current event and selected process. We first
	copy the particle set, then temporarily update the process core with
	local parameters, recalculate everything, and restore the process
	core.

	The event weight is obtained by rescaling the original event weight with the
	ratio of the new and old [[sqme]] values. (In particular, if the old
	value was zero, the weight will stay zero.)

	Note: this may turn out to be inefficient because we always replace
	all parameters and recalculate everything, once for each event and
	environment. However, a more fine-grained control requires more
	code. In any case, while we may keep multiple process cores (which
	stay constant for a simulation run), we still have to update the
	external matrix element parameters event by event. The matrix element
	``object'' is present only once.
	<<Simulations: simulation: TBP>>=
	procedure :: calculate_alt_entries => simulation_calculate_alt_entries
	<<Simulations: procedures>>=
	subroutine simulation_calculate_alt_entries (simulation)
	class(simulation_t), intent(inout) :: simulation
	real(default) :: factor
	real(default), dimension(:), allocatable :: sqme_alt, weight_alt
	integer :: n_alt, i, j
	i = simulation%i_prc
	n_alt = simulation%n_alt
	if (n_alt == 0) return
	allocate (sqme_alt (n_alt), weight_alt (n_alt))
	associate (entry => simulation%entry(i))
	do j = 1, n_alt
	if (signal_is_pending ()) return
	factor = entry%get_kinematical_weight ()
	associate (alt_entry => simulation%alt_entry(i,j))
	call alt_entry%update_process ()
	call alt_entry%select &
	(entry%get_i_mci (), entry%get_i_term (), entry%get_channel ())
	call alt_entry%fill_particle_set (entry)
	call alt_entry%recalculate &
	(update_sqme = .true., weight_factor = factor)
	if (signal_is_pending ()) return
	call alt_entry%accept_sqme_prc ()
	call alt_entry%update_normalization ()
	call alt_entry%accept_weight_prc ()
	call alt_entry%check ()
	call alt_entry%evaluate_expressions ()
	if (signal_is_pending ()) return
	call alt_entry%restore_process ()
	sqme_alt(j) = alt_entry%get_sqme_ref ()
	if (alt_entry%passed_selection ()) then
	weight_alt(j) = alt_entry%get_weight_ref ()
	end if
	end associate
	end do
	call entry%set (sqme_alt = sqme_alt, weight_alt = weight_alt)
	call entry%check ()
	call entry%store_alt_values ()
	end associate
	end subroutine simulation_calculate_alt_entries

	@ %def simulation_calculate_alt_entries
	@ Rescan an undefined number of events.

	If [[update_event]] or [[update_sqme]] is set, we have to recalculate the
	event, starting from the particle set. If the latter is set, this includes
	the squared matrix element (i.e., the amplitude is evaluated). Otherwise,
	only kinematics and observables derived from it are recovered.

	If any of the update flags is set, we will come up with separate
	[[sqme_prc]] and [[weight_prc]] values. (The latter is only distinct
	if [[update_weight]] is set.) Otherwise, we accept the reference values.
	<<Simulations: simulation: TBP>>=
	procedure :: rescan => simulation_rescan
	<<Simulations: procedures>>=
	subroutine simulation_rescan (simulation, n, es_array, global)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: n
	type(event_stream_array_t), intent(inout) :: es_array
	type(rt_data_t), intent(inout) :: global
	type(qcd_t) :: qcd
	type(string_t) :: str1, str2, str3
	logical :: complete
	str1 = "Rescanning"
	if (simulation%entry(1)%config%unweighted) then
	str2 = "unweighted"
	else
	str2 = "weighted"
	end if
	simulation%n_evt_requested = n
	call simulation%entry%set_n (n)
	if (simulation%update_sqme .or. simulation%update_weight) then
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call simulation%update_processes &
	(global%model, qcd, global%get_helicity_selection ())
	str3 = "(process parameters updated) "
	else
	str3 = ""
	end if
	write (msg_buffer, "(A,1x,A,1x,A,A,A)") char (str1), char (str2), &
	"events ", char (str3), "..."
	call msg_message ()
	do
	call simulation%read_event (es_array, .false., complete)
	if (complete) exit
	if (simulation%update_event &
	.or. simulation%update_sqme &
	.or. simulation%update_weight) then
	call simulation%recalculate ()
	if (signal_is_pending ()) return
	associate (entry => simulation%entry(simulation%i_prc))
	call entry%update_normalization ()
	if (simulation%update_event) then
	call entry%evaluate_transforms ()
	end if
	call entry%check ()
	call entry%evaluate_expressions ()
	if (signal_is_pending ()) return
	simulation%weight = entry%get_weight_prc ()
	call simulation%counter%record (simulation%weight, from_file=.true.)
	call entry%record (simulation%i_mci, from_file=.true.)
	end associate
	else
	associate (entry => simulation%entry(simulation%i_prc))
	call entry%accept_sqme_ref ()
	call entry%accept_weight_ref ()
	call entry%check ()
	call entry%evaluate_expressions ()
	if (signal_is_pending ()) return
	simulation%weight = entry%get_weight_ref ()
	call simulation%counter%record (simulation%weight, from_file=.true.)
	call entry%record (simulation%i_mci, from_file=.true.)
	end associate
	end if
	call simulation%calculate_alt_entries ()
	if (signal_is_pending ()) return
	call simulation%write_event (es_array)
	end do
	if (simulation%update_sqme .or. simulation%update_weight) then
	call simulation%restore_processes ()
	end if
	end subroutine simulation_rescan

	@ %def simulation_rescan
	@ These routines take care of temporary parameter redefinitions that
	we want to take effect while recalculating the matrix elements. We
	extract the core(s) of the processes that we are simulating, apply the
	changes, and make sure that the changes are actually used. This is
	the duty of [[dispatch_core_update]]. When done, we restore the
	original versions using [[dispatch_core_restore]].
	<<Simulations: simulation: TBP>>=
	procedure :: update_processes => simulation_update_processes
	procedure :: restore_processes => simulation_restore_processes
	<<Simulations: procedures>>=
	subroutine simulation_update_processes (simulation, &
	model, qcd, helicity_selection)
	class(simulation_t), intent(inout) :: simulation
	class(model_data_t), intent(in), optional, target :: model
	type(qcd_t), intent(in), optional :: qcd
	type(helicity_selection_t), intent(in), optional :: helicity_selection
	integer :: i
	do i = 1, simulation%n_prc
	call simulation%entry(i)%update_process &
	(model, qcd, helicity_selection)
	end do
	end subroutine simulation_update_processes

	subroutine simulation_restore_processes (simulation)
	class(simulation_t), intent(inout) :: simulation
	integer :: i
	do i = 1, simulation%n_prc
	call simulation%entry(i)%restore_process ()
	end do
	end subroutine simulation_restore_processes

	@ %def simulation_update_processes
	@ %def simulation_restore_processes
	@
	\subsection{Event Stream I/O}
	Write an event to a generic [[eio]] event stream. The process index
	must be selected, or the current index must be available.
	<<Simulations: simulation: TBP>>=
	generic :: write_event => write_event_eio
	procedure :: write_event_eio => simulation_write_event_eio
	<<Simulations: procedures>>=
	subroutine simulation_write_event_eio (object, eio, i_prc)
	class(simulation_t), intent(in) :: object
	class(eio_t), intent(inout) :: eio
	integer, intent(in), optional :: i_prc
	logical :: increased
	integer :: current
	if (present (i_prc)) then
	current = i_prc
	else
	current = object%i_prc
	end if
	if (current > 0) then
	if (object%split_n_evt > 0 &
	.and. object%counter%total > 1 &
	.and. mod (object%counter%total, object%split_n_evt) == 1) then
	call eio%split_out ()
	else if (object%split_n_kbytes > 0) then
	call eio%update_split_count (increased)
	if (increased) call eio%split_out ()
	end if
	call eio%output (object%entry(current)%event_t, current, pacify = object%pacify)
	else
	call msg_fatal ("Simulation: write event: no process selected")
	end if
	end subroutine simulation_write_event_eio

	@ %def simulation_write_event
	@
	Read an event from a generic [[eio]] event stream. The event stream element
	must specify the process within the sample ([[i_prc]]), the MC group for this
	process ([[i_mci]]), the selected term ([[i_term]]), the selected MC
	integration [[channel]], and the particle set of the event.

	We may encounter EOF, which we indicate by storing 0 for the process index
	[[i_prc]]. An I/O error will be reported, and we also abort reading.
	<<Simulations: simulation: TBP>>=
	generic :: read_event => read_event_eio
	procedure :: read_event_eio => simulation_read_event_eio
	<<Simulations: procedures>>=
	subroutine simulation_read_event_eio (object, eio)
	class(simulation_t), intent(inout) :: object
	class(eio_t), intent(inout) :: eio
	integer :: iostat, current
	call eio%input_i_prc (current, iostat)
	select case (iostat)
	case (0)
	object%i_prc = current
	call eio%input_event (object%entry(current)%event_t, iostat)
	end select
	select case (iostat)
	case (:-1)
	object%i_prc = 0
	object%i_mci = 0
	case (1:)
	call msg_error ("Reading events: I/O error, aborting read")
	object%i_prc = 0
	object%i_mci = 0
	case default
	object%i_mci = object%entry(current)%get_i_mci ()
	end select
	end subroutine simulation_read_event_eio

	@ %def simulation_read_event
	@
	\subsection{Event Stream Array}
	Write an event using an array of event I/O streams.
	The process index must be selected, or the current index must be
	available.
	<<Simulations: simulation: TBP>>=
	generic :: write_event => write_event_es_array
	procedure :: write_event_es_array => simulation_write_event_es_array
	<<Simulations: procedures>>=
	subroutine simulation_write_event_es_array (object, es_array, passed)
	class(simulation_t), intent(in), target :: object
	class(event_stream_array_t), intent(inout) :: es_array
	logical, intent(in), optional :: passed
	integer :: i_prc, event_index
	integer :: i
	type(entry_t), pointer :: current_entry
	i_prc = object%i_prc
	if (i_prc > 0) then
	event_index = object%counter%total
	current_entry => object%entry(i_prc)%get_first ()
	do i = 1, current_entry%count_nlo_entries ()
	if (i > 1) current_entry => current_entry%get_next ()
	call es_array%output (current_entry%event_t, i_prc, &
	event_index, passed = passed, pacify = object%pacify)
	end do
	else
	call msg_fatal ("Simulation: write event: no process selected")
	end if
	end subroutine simulation_write_event_es_array

	@ %def simulation_write_event
	@ Read an event using an array of event I/O streams. Reading is
	successful if there is an input stream within the array, and if a
	valid event can be read from that stream. If there is a stream, but
	EOF is passed when reading the first item, we switch the channel to
	output and return failure but no error message, such that new events
	can be appended to that stream.
	<<Simulations: simulation: TBP>>=
	generic :: read_event => read_event_es_array
	procedure :: read_event_es_array => simulation_read_event_es_array
	<<Simulations: procedures>>=
	subroutine simulation_read_event_es_array (object, es_array, enable_switch, &
	fail)
	class(simulation_t), intent(inout), target :: object
	class(event_stream_array_t), intent(inout), target :: es_array
	logical, intent(in) :: enable_switch
	logical, intent(out) :: fail
	integer :: iostat, i_prc
	type(entry_t), pointer :: current_entry => null ()
	integer :: i
	if (es_array%has_input ()) then
	fail = .false.
	call es_array%input_i_prc (i_prc, iostat)
	select case (iostat)
	case (0)
	object%i_prc = i_prc
	current_entry => object%entry(i_prc)
	do i = 1, current_entry%count_nlo_entries ()
	if (i > 1) then
	call es_array%skip_eio_entry (iostat)
	current_entry => current_entry%get_next ()
	end if
	call es_array%input_event (current_entry%event_t, iostat)
	end do
	case (:-1)
	write (msg_buffer, "(A,1x,I0,1x,A)") &
	"... event file terminates after", &
	object%counter%read, "events."
	call msg_message ()
	if (enable_switch) then
	call es_array%switch_inout ()
	write (msg_buffer, "(A,1x,I0,1x,A)") &
	"Generating remaining ", &
	object%n_evt_requested - object%counter%read, "events ..."
	call msg_message ()
	end if
	fail = .true.
	return
	end select
	select case (iostat)
	case (0)
	object%i_mci = object%entry(i_prc)%get_i_mci ()
	case default
	write (msg_buffer, "(A,1x,I0,1x,A)") &
	"Reading events: I/O error, aborting read after", &
	object%counter%read, "events."
	call msg_error ()
	object%i_prc = 0
	object%i_mci = 0
	fail = .true.
	end select
	else
	fail = .true.
	end if
	end subroutine simulation_read_event_es_array

	@ %def simulation_read_event
	@
	\subsection{Recover event}
	Recalculate the process instance contents, given an event with known particle
	set. The indices for MC, term, and channel must be already set. The
	[[recalculate]] method of the selected entry will import the result
	into [[sqme_prc]] and [[weight_prc]].
	<<Simulations: simulation: TBP>>=
	procedure :: recalculate => simulation_recalculate
	<<Simulations: procedures>>=
	subroutine simulation_recalculate (simulation)
	class(simulation_t), intent(inout) :: simulation
	integer :: i_prc
	i_prc = simulation%i_prc
	associate (entry => simulation%entry(i_prc))
	if (simulation%update_weight) then
	call simulation%entry(i_prc)%recalculate &
	(update_sqme = simulation%update_sqme, &
	recover_beams = simulation%recover_beams, &
	weight_factor = entry%get_kinematical_weight ())
	else
	call simulation%entry(i_prc)%recalculate &
	(update_sqme = simulation%update_sqme, &
	recover_beams = simulation%recover_beams)
	end if
	end associate
	end subroutine simulation_recalculate

	@ %def simulation_recalculate
	@
	\subsection{Extract contents}
	Return the MD5 sum that summarizes configuration and integration
	(but not the event file). Used for initializing the event streams.
	<<Simulations: simulation: TBP>>=
	procedure :: get_md5sum_prc => simulation_get_md5sum_prc
	procedure :: get_md5sum_cfg => simulation_get_md5sum_cfg
	procedure :: get_md5sum_alt => simulation_get_md5sum_alt
	<<Simulations: procedures>>=
	function simulation_get_md5sum_prc (simulation) result (md5sum)
	class(simulation_t), intent(in) :: simulation
	character(32) :: md5sum
	md5sum = simulation%md5sum_prc
	end function simulation_get_md5sum_prc

	function simulation_get_md5sum_cfg (simulation) result (md5sum)
	class(simulation_t), intent(in) :: simulation
	character(32) :: md5sum
	md5sum = simulation%md5sum_cfg
	end function simulation_get_md5sum_cfg

	function simulation_get_md5sum_alt (simulation, i) result (md5sum)
	class(simulation_t), intent(in) :: simulation
	integer, intent(in) :: i
	character(32) :: md5sum
	md5sum = simulation%md5sum_alt(i)
	end function simulation_get_md5sum_alt

	@ %def simulation_get_md5sum_prc
	@ %def simulation_get_md5sum_cfg
	@ Return data that may be useful for writing event files.

	Usually we can refer to a previously integrated process, for which we
	can fetch a process pointer. Occasionally, we don't have this because
	we're just rescanning an externally generated file without
	calculation. For that situation, we generate our local beam data object
	using the current enviroment, or, in simple cases, just fetch the
	necessary data from the process definition and environment.
	<<Simulations: simulation: TBP>>=
	procedure :: get_data => simulation_get_data
	<<Simulations: procedures>>=
	function simulation_get_data (simulation, alt) result (sdata)
	class(simulation_t), intent(in) :: simulation
	logical, intent(in), optional :: alt
	type(event_sample_data_t) :: sdata
	type(process_t), pointer :: process
	type(beam_data_t), pointer :: beam_data
	type(beam_structure_t), pointer :: beam_structure
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: n, i
	logical :: enable_alt, construct_beam_data
	real(default) :: sqrts
	class(model_data_t), pointer :: model
	logical :: decay_rest_frame
	type(string_t) :: process_id
	enable_alt = .true.; if (present (alt)) enable_alt = alt
	if (enable_alt) then
	call sdata%init (simulation%n_prc, simulation%n_alt)
	do i = 1, simulation%n_alt
	sdata%md5sum_alt(i) = simulation%get_md5sum_alt (i)
	end do
	else
	call sdata%init (simulation%n_prc)
	end if
	sdata%unweighted = simulation%unweighted
	sdata%negative_weights = simulation%negative_weights
	sdata%norm_mode = simulation%norm_mode
	process => simulation%entry(1)%get_process_ptr ()
	if (associated (process)) then
	beam_data => process%get_beam_data_ptr ()
	construct_beam_data = .false.
	else
	n = simulation%entry(1)%n_in
	sqrts = simulation%local%get_sqrts ()
	beam_structure => simulation%local%beam_structure
	call beam_structure%check_against_n_in (n, construct_beam_data)
	if (construct_beam_data) then
	allocate (beam_data)
	model => simulation%local%model
	decay_rest_frame = &
	simulation%local%get_lval (var_str ("?decay_rest_frame"))
	call beam_data%init_structure (beam_structure, &
	sqrts, model, decay_rest_frame)
	else
	beam_data => null ()
	end if
	end if
	if (associated (beam_data)) then
	n = beam_data%get_n_in ()
	sdata%n_beam = n
	allocate (flv (n))
	flv = beam_data%get_flavor ()
	sdata%pdg_beam(:n) = flv%get_pdg ()
	sdata%energy_beam(:n) = beam_data%get_energy ()
	if (construct_beam_data) deallocate (beam_data)
	else
	n = simulation%entry(1)%n_in
	sdata%n_beam = n
	process_id = simulation%entry(1)%process_id
	call simulation%local%prclib%get_pdg_in_1 &
	(process_id, sdata%pdg_beam(:n))
	sdata%energy_beam(:n) = sqrts / n
	end if
	do i = 1, simulation%n_prc
	if (.not. simulation%entry(i)%valid) cycle
	process => simulation%entry(i)%get_process_ptr ()
	if (associated (process)) then
	sdata%proc_num_id(i) = process%get_num_id ()
	else
	process_id = simulation%entry(i)%process_id
	sdata%proc_num_id(i) = simulation%local%prclib%get_num_id (process_id)
	end if
	if (sdata%proc_num_id(i) == 0) sdata%proc_num_id(i) = i
	if (simulation%entry(i)%has_integral) then
	sdata%cross_section(i) = simulation%entry(i)%integral
	sdata%error(i) = simulation%entry(i)%error
	end if
	end do
	sdata%total_cross_section = sum (sdata%cross_section)
	sdata%md5sum_prc = simulation%get_md5sum_prc ()
	sdata%md5sum_cfg = simulation%get_md5sum_cfg ()
	if (simulation%split_n_evt > 0 .or. simulation%split_n_kbytes > 0) then
	sdata%split_n_evt = simulation%split_n_evt
	sdata%split_n_kbytes = simulation%split_n_kbytes
	sdata%split_index = simulation%split_index
	end if
	end function simulation_get_data

	@ %def simulation_get_data
	@ Return a default name for the current event sample. This is the
	process ID of the first process.
	<<Simulations: simulation: TBP>>=
	procedure :: get_default_sample_name => simulation_get_default_sample_name
	<<Simulations: procedures>>=
	function simulation_get_default_sample_name (simulation) result (sample)
	class(simulation_t), intent(in) :: simulation
	type(string_t) :: sample
	type(process_t), pointer :: process
	sample = "whizard"
	if (simulation%n_prc > 0) then
	process => simulation%entry(1)%get_process_ptr ()
	if (associated (process)) then
	sample = process%get_id ()
	end if
	end if
	end function simulation_get_default_sample_name

	@ %def simulation_get_default_sample_name
	@
	<<Simulations: simulation: TBP>>=
	procedure :: is_valid => simulation_is_valid
	<<Simulations: procedures>>=
	function simulation_is_valid (simulation) result (valid)
	class(simulation_t), intent(inout) :: simulation
	logical :: valid
	valid = simulation%valid
	end function simulation_is_valid

	@ %def simulation_is_valid
	@
	\subsection{Auxiliary}
	Call pacify: eliminate numerical noise.
	<<Simulations: public>>=
	public :: pacify
	<<Simulations: interfaces>>=
	interface pacify
	module procedure pacify_simulation
	end interface
	<<Simulations: procedures>>=
	subroutine pacify_simulation (simulation)
	class(simulation_t), intent(inout) :: simulation
	integer :: i, j
	i = simulation%i_prc
	if (i > 0) then
	call pacify (simulation%entry(i))
	do j = 1, simulation%n_alt
	call pacify (simulation%alt_entry(i,j))
	end do
	end if
	end subroutine pacify_simulation

	@ %def pacify_simulation
	@ Evaluate expressions for the currently selected process. (This is used only
	in the unit tests.)
	<<Simulations: simulation: TBP>>=
	procedure :: evaluate_expressions => simulation_evaluate_expressions
	<<Simulations: procedures>>=
	subroutine simulation_evaluate_expressions (simulation)
	class(simulation_t), intent(inout) :: simulation
	call simulation%entry(simulation%i_prc)%evaluate_expressions ()
	end subroutine simulation_evaluate_expressions

	@ %def simulation_evaluate_expressions
	@
	\subsection{Unit tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[simulations_ut.f90]]>>=
	<<File header>>

	module simulations_ut
	use unit_tests
	use simulations_uti

	<<Standard module head>>

	<<Simulations: public test>>

	contains

	<<Simulations: test driver>>

	end module simulations_ut
	@ %def simulations_ut
	@
	<<[[simulations_uti.f90]]>>=
	<<File header>>

	module simulations_uti

	<<Use kinds>>
	use kinds, only: i64
	<<Use strings>>
	use io_units
	use ifiles
	use lexers
	use parser
	use flavors
	use interactions, only: reset_interaction_counter
	use prclib_stacks
	use phs_forests
	use event_base, only: generic_event_t
	use event_base, only: event_callback_t
	use eio_data
	use eio_base
	use eio_raw
	use eio_ascii
	use eio_callback
	use eval_trees
	use models
	use rt_data
	use event_streams
	use decays_ut, only: prepare_testbed
	use process_configurations_ut, only: prepare_test_library
	use compilations, only: compile_library
	use integrations, only: integrate_process

	use simulations

	<<Standard module head>>

	<<Simulations: test declarations>>

	<<Simulations: test auxiliary types>>

	contains

	<<Simulations: tests>>

	<<Simulations: test auxiliary>>

	end module simulations_uti

	@ %def simulations_uti
	@ API: driver for the unit tests below.
	<<Simulations: public test>>=
	public :: simulations_test
	<<Simulations: test driver>>=
	subroutine simulations_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Simulations: execute tests>>
	end subroutine simulations_test

	@ %def simulations_test
	@
	\subsubsection{Initialization}
	Initialize a [[simulation_t]] object, including the embedded event records.
	<<Simulations: execute tests>>=
	call test (simulations_1, "simulations_1", &
	"initialization", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_1
	<<Simulations: tests>>=
	subroutine simulations_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, procname2
	type(rt_data_t), target :: global
	type(simulation_t), target :: simulation

	write (u, "(A)") "* Test output: simulations_1"
	write (u, "(A)") "* Purpose: initialize simulation"
	write (u, "(A)")

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

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_1a"
	procname1 = "simulation_1p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	procname2 = "sim_extra"

	call prepare_test_library (global, libname, 1, [procname2])
	call compile_library (libname, global)
	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations2"), is_known = .true.)


	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_string (var_str ("$sample"), &
	var_str ("sim1"), is_known = .true.)
	call integrate_process (procname2, global, local_stack=.true.)

	call simulation%init ([procname1, procname2], .false., .true., global)
	call simulation%init_process_selector ()
	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the first process"
	write (u, "(A)")

	call simulation%write_event (u, i_prc = 1)

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

	call simulation%final ()
	call global%final ()

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

	end subroutine simulations_1

	@ %def simulations_1
	@
	\subsubsection{Weighted events}
	Generate events for a single process.
	<<Simulations: execute tests>>=
	call test (simulations_2, "simulations_2", &
	"weighted events", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_2
	<<Simulations: tests>>=
	subroutine simulations_2 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1
	type(rt_data_t), target :: global
	type(simulation_t), target :: simulation
	type(event_sample_data_t) :: data

	write (u, "(A)") "* Test output: simulations_2"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)")

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

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_2a"
	procname1 = "simulation_2p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	data = simulation%get_data ()
	call data%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate three events"
	write (u, "(A)")

	call simulation%generate (3)
	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the last event"
	write (u, "(A)")

	call simulation%write_event (u)

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

	call simulation%final ()
	call global%final ()

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

	end subroutine simulations_2

	@ %def simulations_2
	@
	\subsubsection{Unweighted events}
	Generate events for a single process.
	<<Simulations: execute tests>>=
	call test (simulations_3, "simulations_3", &
	"unweighted events", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_3
	<<Simulations: tests>>=
	subroutine simulations_3 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1
	type(rt_data_t), target :: global
	type(simulation_t), target :: simulation
	type(event_sample_data_t) :: data

	write (u, "(A)") "* Test output: simulations_3"
	write (u, "(A)") "* Purpose: generate unweighted events &
	&for a single process"
	write (u, "(A)")

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

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_3a"
	procname1 = "simulation_3p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	data = simulation%get_data ()
	call data%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate three events"
	write (u, "(A)")

	call simulation%generate (3)
	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the last event"
	write (u, "(A)")

	call simulation%write_event (u)

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

	call simulation%final ()
	call global%final ()

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

	end subroutine simulations_3

	@ %def simulations_3
	@
	\subsubsection{Simulating process with structure functions}
	Generate events for a single process.
	<<Simulations: execute tests>>=
	call test (simulations_4, "simulations_4", &
	"process with structure functions", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_4
	<<Simulations: tests>>=
	subroutine simulations_4 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1
	type(rt_data_t), target :: global
	type(flavor_t) :: flv
	type(string_t) :: name
	type(simulation_t), target :: simulation
	type(event_sample_data_t) :: data

	write (u, "(A)") "* Test output: simulations_4"
	write (u, "(A)") "* Purpose: generate events for a single process &
	&with structure functions"
	write (u, "(A)")

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

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_4a"
	procname1 = "simulation_4p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), &
	0._default)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call reset_interaction_counter ()

	call flv%init (25, global%model)
	name = flv%get_name ()

	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

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

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	call global%set_string (var_str ("$sample"), &
	var_str ("simulations4"), is_known = .true.)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	data = simulation%get_data ()
	call data%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate three events"
	write (u, "(A)")

	call simulation%generate (3)
	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the last event"
	write (u, "(A)")

	call simulation%write_event (u)

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

	call simulation%final ()
	call global%final ()

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

	end subroutine simulations_4

	@ %def simulations_4
	@
	\subsubsection{Event I/O}
	Generate event for a test process, write to file and reread.
	<<Simulations: execute tests>>=
	call test (simulations_5, "simulations_5", &
	"raw event I/O", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_5
	<<Simulations: tests>>=
	subroutine simulations_5 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	class(eio_t), allocatable :: eio
	type(simulation_t), allocatable, target :: simulation

	write (u, "(A)") "* Test output: simulations_5"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* write to file and reread"
	write (u, "(A)")

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

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_5a"
	procname1 = "simulation_5p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations5"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations5"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)
	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	write (u, "(A)") "* Initialize raw event file"
	write (u, "(A)")

	allocate (eio_raw_t :: eio)
	call eio%init_out (sample)

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

	call simulation%generate (1)
	call simulation%write_event (u)
	call simulation%write_event (eio)

	call eio%final ()
	deallocate (eio)
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)")
	write (u, "(A)") "* Re-read the event from file"
	write (u, "(A)")

	call global%set_log (var_str ("?update_sqme"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_weight"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()
	allocate (eio_raw_t :: eio)
	call eio%init_in (sample)

	call simulation%read_event (eio)
	call simulation%write_event (u)

	write (u, "(A)")
	write (u, "(A)") "* Recalculate process instance"
	write (u, "(A)")

	call simulation%recalculate ()
	call simulation%evaluate_expressions ()
	call simulation%write_event (u)

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

	call eio%final ()
	call simulation%final ()
	call global%final ()

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

	end subroutine simulations_5

	@ %def simulations_5
	@
	\subsubsection{Event I/O}
	Generate event for a real process with structure functions, write to file and
	reread.
	<<Simulations: execute tests>>=
	call test (simulations_6, "simulations_6", &
	"raw event I/O with structure functions", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_6
	<<Simulations: tests>>=
	subroutine simulations_6 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	class(eio_t), allocatable :: eio
	type(simulation_t), allocatable, target :: simulation
	type(flavor_t) :: flv
	type(string_t) :: name

	write (u, "(A)") "* Test output: simulations_6"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* write to file and reread"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and integrate"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_6"
	procname1 = "simulation_6p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), &
	0._default)

	call flv%init (25, global%model)
	name = flv%get_name ()

	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call reset_interaction_counter ()

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations6"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)
	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	write (u, "(A)") "* Initialize raw event file"
	write (u, "(A)")

	allocate (eio_raw_t :: eio)
	call eio%init_out (sample)

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

	call simulation%generate (1)
	call pacify (simulation)
	call simulation%write_event (u, verbose = .true., testflag = .true.)
	call simulation%write_event (eio)

	call eio%final ()
	deallocate (eio)
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)")
	write (u, "(A)") "* Re-read the event from file"
	write (u, "(A)")

	call reset_interaction_counter ()

	call global%set_log (var_str ("?update_sqme"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_weight"), &
	.true., is_known = .true.)

	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()
	allocate (eio_raw_t :: eio)
	call eio%init_in (sample)

	call simulation%read_event (eio)
	call simulation%write_event (u, verbose = .true., testflag = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Recalculate process instance"
	write (u, "(A)")

	call simulation%recalculate ()
	call simulation%evaluate_expressions ()
	call simulation%write_event (u, verbose = .true., testflag = .true.)

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

	call eio%final ()
	call simulation%final ()
	call global%final ()

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

	end subroutine simulations_6

	@ %def simulations_6
	@
	\subsubsection{Automatic Event I/O}
	Generate events with raw-format event file as cache: generate, reread,
	append.
	<<Simulations: execute tests>>=
	call test (simulations_7, "simulations_7", &
	"automatic raw event I/O", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_7
	<<Simulations: tests>>=
	subroutine simulations_7 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: empty_string_array
	type(event_sample_data_t) :: data
	type(event_stream_array_t) :: es_array
	type(simulation_t), allocatable, target :: simulation
	type(flavor_t) :: flv
	type(string_t) :: name

	write (u, "(A)") "* Test output: simulations_7"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* write to file and reread"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and integrate"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_7"
	procname1 = "simulation_7p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), &
	0._default)

	call flv%init (25, global%model)
	name = flv%get_name ()

	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call reset_interaction_counter ()

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations7"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)
	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	write (u, "(A)") "* Initialize raw event file"
	write (u, "(A)")

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = simulation%get_md5sum_cfg ()
	call es_array%init (sample, [var_str ("raw")], global, data)

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

	call simulation%generate (1, es_array)

	call es_array%final ()
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)") "* Re-read the event from file and generate another one"
	write (u, "(A)")

	call global%set_log (&
	var_str ("?rebuild_events"), .false., is_known = .true.)

	call reset_interaction_counter ()

	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = simulation%get_md5sum_cfg ()
	call es_array%init (sample, empty_string_array, global, data, &
	input = var_str ("raw"))

	call simulation%generate (2, es_array)

	call pacify (simulation)
	call simulation%write_event (u, verbose = .true.)

	call es_array%final ()
	call simulation%final ()
	deallocate (simulation)


	write (u, "(A)")
	write (u, "(A)") "* Re-read both events from file"
	write (u, "(A)")

	call reset_interaction_counter ()

	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = simulation%get_md5sum_cfg ()
	call es_array%init (sample, empty_string_array, global, data, &
	input = var_str ("raw"))

	call simulation%generate (2, es_array)

	call pacify (simulation)
	call simulation%write_event (u, verbose = .true.)

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

	call es_array%final ()
	call simulation%final ()
	call global%final ()

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

	end subroutine simulations_7

	@ %def simulations_7
	@
	\subsubsection{Rescanning Events}
	Generate events and rescan the resulting raw event file.
	<<Simulations: execute tests>>=
	call test (simulations_8, "simulations_8", &
	"rescan raw event file", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_8
	<<Simulations: tests>>=
	subroutine simulations_8 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: empty_string_array
	type(event_sample_data_t) :: data
	type(event_stream_array_t) :: es_array
	type(simulation_t), allocatable, target :: simulation
	type(flavor_t) :: flv
	type(string_t) :: name

	write (u, "(A)") "* Test output: simulations_8"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* write to file and rescan"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and integrate"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_8"
	procname1 = "simulation_8p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), &
	0._default)

	call flv%init (25, global%model)
	name = flv%get_name ()

	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call reset_interaction_counter ()

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations8"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)
	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	write (u, "(A)") "* Initialize raw event file"
	write (u, "(A)")

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = simulation%get_md5sum_cfg ()
	write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
	write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
	call es_array%init (sample, [var_str ("raw")], global, &
	data)

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

	call simulation%generate (1, es_array)

	call pacify (simulation)
	call simulation%write_event (u, verbose = .true., testflag = .true.)

	call es_array%final ()
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)")
	write (u, "(A)") "* Re-read the event from file"
	write (u, "(A)")

	call reset_interaction_counter ()

	allocate (simulation)
	call simulation%init ([procname1], .false., .false., global)
	call simulation%init_process_selector ()

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = ""
	write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
	write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
	call es_array%init (sample, empty_string_array, global, data, &
	input = var_str ("raw"), input_sample = sample, allow_switch = .false.)

	call simulation%rescan (1, es_array, global = global)

	write (u, "(A)")

	call pacify (simulation)
	call simulation%write_event (u, verbose = .true., testflag = .true.)

	call es_array%final ()
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)")
	write (u, "(A)") "* Re-read again and recalculate"
	write (u, "(A)")

	call reset_interaction_counter ()

	call global%set_log (var_str ("?update_sqme"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_event"), &
	.true., is_known = .true.)

	allocate (simulation)
	call simulation%init ([procname1], .false., .false., global)
	call simulation%init_process_selector ()

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = ""
	write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
	write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
	call es_array%init (sample, empty_string_array, global, data, &
	input = var_str ("raw"), input_sample = sample, allow_switch = .false.)

	call simulation%rescan (1, es_array, global = global)

	write (u, "(A)")

	call pacify (simulation)
	call simulation%write_event (u, verbose = .true., testflag = .true.)

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

	call es_array%final ()
	call simulation%final ()
	call global%final ()

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

	end subroutine simulations_8

	@ %def simulations_8
	@
	\subsubsection{Rescanning Check}
	Generate events and rescan with process mismatch.
	<<Simulations: execute tests>>=
	call test (simulations_9, "simulations_9", &
	"rescan mismatch", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_9
	<<Simulations: tests>>=
	subroutine simulations_9 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: empty_string_array
	type(event_sample_data_t) :: data
	type(event_stream_array_t) :: es_array
	type(simulation_t), allocatable, target :: simulation
	type(flavor_t) :: flv
	type(string_t) :: name
	logical :: error

	write (u, "(A)") "* Test output: simulations_9"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* write to file and rescan"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and integrate"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_9"
	procname1 = "simulation_9p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), &
	0._default)

	call flv%init (25, global%model)
	name = flv%get_name ()

	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call reset_interaction_counter ()

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations9"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)
	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize raw event file"
	write (u, "(A)")

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = simulation%get_md5sum_cfg ()
	write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
	write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
	call es_array%init (sample, [var_str ("raw")], global, &
	data)

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

	call simulation%generate (1, es_array)

	call es_array%final ()
	call simulation%final ()
	deallocate (simulation)

	write (u, "(A)") "* Initialize event generation for different parameters"
	write (u, "(A)")

	call reset_interaction_counter ()

	allocate (simulation)
	call simulation%init ([procname1, procname1], .false., .false., global)
	call simulation%init_process_selector ()

	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Attempt to re-read the events (should fail)"
	write (u, "(A)")

	data%md5sum_prc = simulation%get_md5sum_prc ()
	data%md5sum_cfg = ""
	write (u, "(1x,A,A,A)") "MD5 sum (proc) = '", data%md5sum_prc, "'"
	write (u, "(1x,A,A,A)") "MD5 sum (config) = '", data%md5sum_cfg, "'"
	call es_array%init (sample, empty_string_array, global, data, &
	input = var_str ("raw"), input_sample = sample, &
	allow_switch = .false., error = error)

	write (u, "(1x,A,L1)") "error = ", error

	call simulation%rescan (1, es_array, global = global)

	call es_array%final ()
	call simulation%final ()
	call global%final ()

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

	end subroutine simulations_9

	@ %def simulations_9
	@
	\subsubsection{Alternative weights}
	Generate an event for a single process and reweight it in a
	simultaneous calculation.
	<<Simulations: execute tests>>=
	call test (simulations_10, "simulations_10", &
	"alternative weight", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_10
	<<Simulations: tests>>=
	subroutine simulations_10 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, expr_text
	type(rt_data_t), target :: global
	type(rt_data_t), dimension(1), target :: alt_env
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: pt_weight
	type(simulation_t), target :: simulation
	type(event_sample_data_t) :: data

	write (u, "(A)") "* Test output: simulations_10"
	write (u, "(A)") "* Purpose: reweight event"
	write (u, "(A)")

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

	call syntax_model_file_init ()
	call syntax_pexpr_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_10a"
	procname1 = "simulation_10p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize alternative environment with custom weight"
	write (u, "(A)")

	call alt_env(1)%local_init (global)
	call alt_env(1)%activate ()

	expr_text = "2"
	write (u, "(A,A)") "weight = ", char (expr_text)
	write (u, *)

	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_weight, stream, .true.)
	call stream_final (stream)
	alt_env(1)%pn%weight_expr => pt_weight%get_root_ptr ()
	call alt_env(1)%write_expr (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	call simulation%init ([procname1], .true., .true., global, alt_env=alt_env)
	call simulation%init_process_selector ()

	data = simulation%get_data ()
	call data%write (u)

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

	call simulation%generate (1)
	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the last event"
	write (u, "(A)")

	call simulation%write_event (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the alternative setup"
	write (u, "(A)")

	call simulation%write_alt_event (u)

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

	call simulation%final ()
	call global%final ()

	call syntax_model_file_final ()
	call syntax_pexpr_final ()

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

	end subroutine simulations_10

	@ %def simulations_10
	@
	\subsubsection{Decays}
	Generate an event with subsequent partonic decays.
	<<Simulations: execute tests>>=
	call test (simulations_11, "simulations_11", &
	"decay", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_11
	<<Simulations: tests>>=
	subroutine simulations_11 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(prclib_entry_t), pointer :: lib
	type(string_t) :: prefix, procname1, procname2
	type(simulation_t), target :: simulation

	write (u, "(A)") "* Test output: simulations_11"
	write (u, "(A)") "* Purpose: apply decay"
	write (u, "(A)")

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

	call syntax_model_file_init ()

	call global%global_init ()
	allocate (lib)
	call global%add_prclib (lib)

	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	prefix = "simulation_11"
	procname1 = prefix // "_p"
	procname2 = prefix // "_d"
	call prepare_testbed &
	(global%prclib, global%process_stack, &
	prefix, global%os_data, &
	scattering=.true., decay=.true.)

	call global%select_model (var_str ("Test"))
	call global%model%set_par (var_str ("ff"), 0.4_default)
	call global%model%set_par (var_str ("mf"), &
	global%model%get_real (var_str ("ff")) &
	* global%model%get_real (var_str ("ms")))
	call global%model%set_unstable (25, [procname2])

	write (u, "(A)") "* Initialize simulation object"
	write (u, "(A)")

	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

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

	call simulation%generate (1)
	call simulation%write (u)

	write (u, *)

	call simulation%write_event (u)

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

	call simulation%final ()
	call global%final ()

	call syntax_model_file_final ()

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

	end subroutine simulations_11

	@ %def simulations_11
	@
	\subsubsection{Split Event Files}
	Generate event for a real process with structure functions and write to file,
	accepting a limit for the number of events per file.
	<<Simulations: execute tests>>=
	call test (simulations_12, "simulations_12", &
	"split event files", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_12
	<<Simulations: tests>>=
	subroutine simulations_12 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	class(eio_t), allocatable :: eio
	type(simulation_t), allocatable, target :: simulation
	type(flavor_t) :: flv
	integer :: i_evt

	write (u, "(A)") "* Test output: simulations_12"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* and write to split event files"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and integrate"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_12"
	procname1 = "simulation_12p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), &
	0._default)

	call flv%init (25, global%model)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations_12"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)
	call global%set_int (var_str ("sample_split_n_evt"), &
	2, is_known = .true.)
	call global%set_int (var_str ("sample_split_index"), &
	42, is_known = .true.)
	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize ASCII event file"
	write (u, "(A)")

	allocate (eio_ascii_short_t :: eio)
	select type (eio)
	class is (eio_ascii_t); call eio%set_parameters ()
	end select
	call eio%init_out (sample, data = simulation%get_data ())

	write (u, "(A)") "* Generate 5 events, distributed among three files"

	do i_evt = 1, 5
	call simulation%generate (1)
	call simulation%write_event (eio)
	end do

	call eio%final ()
	deallocate (eio)
	call simulation%final ()
	deallocate (simulation)

	write (u, *)
	call display_file ("simulations_12.42.short.evt", u)
	write (u, *)
	call display_file ("simulations_12.43.short.evt", u)
	write (u, *)
	call display_file ("simulations_12.44.short.evt", u)

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

	call global%final ()

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

	end subroutine simulations_12

	@ %def simulations_12
	@ Auxiliary: display file contents.
	<<Simulations: public test auxiliary>>=
	public :: display_file
	<<Simulations: test auxiliary>>=
	subroutine display_file (file, u)
	use io_units, only: free_unit
	character(*), intent(in) :: file
	integer, intent(in) :: u
	character(256) :: buffer
	integer :: u_file
	write (u, "(3A)") "* Contents of file '", file, "':"
	write (u, *)
	u_file = free_unit ()
	open (u_file, file = file, action = "read", status = "old")
	do
	read (u_file, "(A)", end = 1) buffer
	write (u, "(A)") trim (buffer)
	end do
	1 continue
	end subroutine display_file

	@ %def display_file
	@
	\subsubsection{Callback}
	Generate events and execute a callback in place of event I/O.
	<<Simulations: execute tests>>=
	call test (simulations_13, "simulations_13", &
	"callback", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_13
	<<Simulations: tests>>=
	subroutine simulations_13 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, sample
	type(rt_data_t), target :: global
	class(eio_t), allocatable :: eio
	type(simulation_t), allocatable, target :: simulation
	type(flavor_t) :: flv
	integer :: i_evt
	type(simulations_13_callback_t) :: event_callback

	write (u, "(A)") "* Test output: simulations_13"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)") "* and execute callback"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and integrate"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_13"
	procname1 = "simulation_13p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call flv%init (25, global%model)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	sample = "simulations_13"
	call global%set_string (var_str ("$sample"), &
	sample, is_known = .true.)

	allocate (simulation)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	write (u, "(A)") "* Prepare callback object"
	write (u, "(A)")

	event_callback%u = u
	call global%set_event_callback (event_callback)

	write (u, "(A)") "* Initialize callback I/O object"
	write (u, "(A)")

	allocate (eio_callback_t :: eio)
	select type (eio)
	class is (eio_callback_t)
	call eio%set_parameters (callback = event_callback, &
	count_interval = 3)
	end select
	call eio%init_out (sample, data = simulation%get_data ())

	write (u, "(A)") "* Generate 7 events, with callback every 3 events"
	write (u, "(A)")

	do i_evt = 1, 7
	call simulation%generate (1)
	call simulation%write_event (eio)
	end do

	call eio%final ()
	deallocate (eio)
	call simulation%final ()
	deallocate (simulation)

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

	call global%final ()

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

	end subroutine simulations_13

	@ %def simulations_13
	@ The callback object and procedure. In the type extension, we can
	store the output channel [[u]] so we know where to write into.
	<<Simulations: test auxiliary types>>=
	type, extends (event_callback_t) :: simulations_13_callback_t
	integer :: u
	contains
	procedure :: write => simulations_13_callback_write
	procedure :: proc => simulations_13_callback
	end type simulations_13_callback_t

	@ %def simulations_13_callback_t
	<<Simulations: test auxiliary>>=
	subroutine simulations_13_callback_write (event_callback, unit)
	class(simulations_13_callback_t), intent(in) :: event_callback
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Hello"
	end subroutine simulations_13_callback_write

	subroutine simulations_13_callback (event_callback, i, event)
	class(simulations_13_callback_t), intent(in) :: event_callback
	integer(i64), intent(in) :: i
	class(generic_event_t), intent(in) :: event
	write (event_callback%u, "(A,I0)") "hello event #", i
	end subroutine simulations_13_callback

	@ %def simulations_13_callback_write
	@ %def simulations_13_callback
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{More Unit Tests}

	This chapter collects some procedures for testing that can't be
	provided at the point where the corresponding modules are defined,
	because they use other modules of a different level.

	(We should move them back, collecting the high-level functionality in
	init/final hooks that we can set at runtime.)


	\section{Expression Testing}

	Expression objects are part of process and event objects, but the
	process and event object modules should not depend on the
	implementation of expressions. Here, we collect unit tests that
	depend on expression implementation.
	<<[[expr_tests_ut.f90]]>>=
	<<File header>>
	module expr_tests_ut

	use unit_tests
	use expr_tests_uti

	<<Standard module head>>

	<<Expr tests: public test>>

	contains

	<<Expr tests: test driver>>

	end module expr_tests_ut
	@ %def expr_tests_ut
	@
	<<[[expr_tests_uti.f90]]>>=
	<<File header>>

	module expr_tests_uti

	<<Use kinds>>
	<<Use strings>>
	use format_defs, only: FMT_12
	use format_utils, only: write_separator
	use os_interface
	use sm_qcd
	use lorentz
	use ifiles
	use lexers
	use parser
	use model_data
	use interactions, only: reset_interaction_counter
	use process_libraries
	use subevents
	use subevt_expr
	use rng_base
	use mci_base
	use phs_base
	use variables
	use eval_trees
	use models
	use prc_core
	use prc_test
	use process, only: process_t
	use instances, only: process_instance_t
	use events

	use rng_base_ut, only: rng_test_factory_t
	use phs_base_ut, only: phs_test_config_t

	<<Standard module head>>

	<<Expr tests: test declarations>>

	contains

	<<Expr tests: tests>>

	end module expr_tests_uti

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

	@ %def subevt_expr_test
	@
	\subsubsection{Parton-event expressions}
	<<Expr tests: execute tests>>=
	call test (subevt_expr_1, "subevt_expr_1", &
	"parton-event expressions", &
	u, results)
	<<Expr tests: test declarations>>=
	public :: subevt_expr_1
	<<Expr tests: tests>>=
	subroutine subevt_expr_1 (u)
	integer, intent(in) :: u
	type(string_t) :: expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: pt_cuts, pt_scale, pt_fac_scale, pt_ren_scale
	type(parse_tree_t) :: pt_weight
	type(parse_node_t), pointer :: pn_cuts, pn_scale, pn_fac_scale, pn_ren_scale
	type(parse_node_t), pointer :: pn_weight
	type(eval_tree_factory_t) :: expr_factory
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(parton_expr_t), target :: expr
	real(default) :: E, Ex, m
	type(vector4_t), dimension(6) :: p
	integer :: i, pdg
	logical :: passed
	real(default) :: scale, fac_scale, ren_scale, weight

	write (u, "(A)") "* Test output: subevt_expr_1"
	write (u, "(A)") "* Purpose: Set up a subevt and associated &
	&process-specific expressions"
	write (u, "(A)")

	call syntax_pexpr_init ()

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model%read (var_str ("Test.mdl"), os_data)

	write (u, "(A)") "* Expression texts"
	write (u, "(A)")


	expr_text = "all Pt > 100 [s]"
	write (u, "(A,A)") "cuts = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (pt_cuts, stream, .true.)
	call stream_final (stream)
	pn_cuts => pt_cuts%get_root_ptr ()

	expr_text = "sqrts"
	write (u, "(A,A)") "scale = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_scale, stream, .true.)
	call stream_final (stream)
	pn_scale => pt_scale%get_root_ptr ()

	expr_text = "sqrts_hat"
	write (u, "(A,A)") "fac_scale = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_fac_scale, stream, .true.)
	call stream_final (stream)
	pn_fac_scale => pt_fac_scale%get_root_ptr ()

	expr_text = "100"
	write (u, "(A,A)") "ren_scale = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_ren_scale, stream, .true.)
	call stream_final (stream)
	pn_ren_scale => pt_ren_scale%get_root_ptr ()

	expr_text = "n_tot - n_in - n_out"
	write (u, "(A,A)") "weight = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_weight, stream, .true.)
	call stream_final (stream)
	pn_weight => pt_weight%get_root_ptr ()

	call ifile_final (ifile)

	write (u, "(A)")
	write (u, "(A)") "* Initialize process expr"
	write (u, "(A)")

	call expr%setup_vars (1000._default)
	call var_list_append_real (expr%var_list, var_str ("tolerance"), 0._default)
	call expr%link_var_list (model%get_var_list_ptr ())

	call expr_factory%init (pn_cuts)
	call expr%setup_selection (expr_factory)
	call expr_factory%init (pn_scale)
	call expr%setup_scale (expr_factory)
	call expr_factory%init (pn_fac_scale)
	call expr%setup_fac_scale (expr_factory)
	call expr_factory%init (pn_ren_scale)
	call expr%setup_ren_scale (expr_factory)
	call expr_factory%init (pn_weight)
	call expr%setup_weight (expr_factory)

	call write_separator (u)
	call expr%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill subevt and evaluate expressions"
	write (u, "(A)")

	call subevt_init (expr%subevt_t, 6)
	E = 500._default
	Ex = 400._default
	m = 125._default
	pdg = 25
	p(1) = vector4_moving (E, sqrt (E2 - m2), 3)
	p(2) = vector4_moving (E, -sqrt (E2 - m2), 3)
	p(3) = vector4_moving (Ex, sqrt (Ex2 - m2), 3)
	p(4) = vector4_moving (Ex, -sqrt (Ex2 - m2), 3)
	p(5) = vector4_moving (Ex, sqrt (Ex2 - m2), 1)
	p(6) = vector4_moving (Ex, -sqrt (Ex2 - m2), 1)

	call expr%reset ()
	do i = 1, 2
	call subevt_set_beam (expr%subevt_t, i, pdg, p(i), m**2)
	end do
	do i = 3, 4
	call subevt_set_incoming (expr%subevt_t, i, pdg, p(i), m**2)
	end do
	do i = 5, 6
	call subevt_set_outgoing (expr%subevt_t, i, pdg, p(i), m**2)
	end do
	expr%sqrts_hat = subevt_get_sqrts_hat (expr%subevt_t)
	expr%n_in = 2
	expr%n_out = 2
	expr%n_tot = 4
	expr%subevt_filled = .true.

	call expr%evaluate (passed, scale, fac_scale, ren_scale, weight)

	write (u, "(A,L1)") "Event has passed = ", passed
	write (u, "(A," // FMT_12 // ")") "Scale = ", scale
	write (u, "(A," // FMT_12 // ")") "Factorization scale = ", fac_scale
	write (u, "(A," // FMT_12 // ")") "Renormalization scale = ", ren_scale
	write (u, "(A," // FMT_12 // ")") "Weight = ", weight
	write (u, "(A)")

	call write_separator (u)
	call expr%write (u)
	call write_separator (u)

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

	call expr%final ()

	call model%final ()
	call syntax_model_file_final ()

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

	end subroutine subevt_expr_1

	@ %def subevt_expr_1
	@
	\subsubsection{Parton-event expressions}
	<<Expr tests: execute tests>>=
	call test (subevt_expr_2, "subevt_expr_2", &
	"parton-event expressions", &
	u, results)
	<<Expr tests: test declarations>>=
	public :: subevt_expr_2
	<<Expr tests: tests>>=
	subroutine subevt_expr_2 (u)
	integer, intent(in) :: u
	type(string_t) :: expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: pt_selection
	type(parse_tree_t) :: pt_reweight, pt_analysis
	type(parse_node_t), pointer :: pn_selection
	type(parse_node_t), pointer :: pn_reweight, pn_analysis
	type(os_data_t) :: os_data
	type(model_t), target :: model
	type(eval_tree_factory_t) :: expr_factory
	type(event_expr_t), target :: expr
	real(default) :: E, Ex, m
	type(vector4_t), dimension(6) :: p
	integer :: i, pdg
	logical :: passed
	real(default) :: reweight
	logical :: analysis_flag

	write (u, "(A)") "* Test output: subevt_expr_2"
	write (u, "(A)") "* Purpose: Set up a subevt and associated &
	&process-specific expressions"
	write (u, "(A)")

	call syntax_pexpr_init ()

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model%read (var_str ("Test.mdl"), os_data)

	write (u, "(A)") "* Expression texts"
	write (u, "(A)")


	expr_text = "all Pt > 100 [s]"
	write (u, "(A,A)") "selection = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (pt_selection, stream, .true.)
	call stream_final (stream)
	pn_selection => pt_selection%get_root_ptr ()

	expr_text = "n_tot - n_in - n_out"
	write (u, "(A,A)") "reweight = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_reweight, stream, .true.)
	call stream_final (stream)
	pn_reweight => pt_reweight%get_root_ptr ()

	expr_text = "true"
	write (u, "(A,A)") "analysis = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (pt_analysis, stream, .true.)
	call stream_final (stream)
	pn_analysis => pt_analysis%get_root_ptr ()

	call ifile_final (ifile)

	write (u, "(A)")
	write (u, "(A)") "* Initialize process expr"
	write (u, "(A)")

	call expr%setup_vars (1000._default)
	call expr%link_var_list (model%get_var_list_ptr ())
	call var_list_append_real (expr%var_list, var_str ("tolerance"), 0._default)

	call expr_factory%init (pn_selection)
	call expr%setup_selection (expr_factory)
	call expr_factory%init (pn_analysis)
	call expr%setup_analysis (expr_factory)
	call expr_factory%init (pn_reweight)
	call expr%setup_reweight (expr_factory)

	call write_separator (u)
	call expr%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill subevt and evaluate expressions"
	write (u, "(A)")

	call subevt_init (expr%subevt_t, 6)
	E = 500._default
	Ex = 400._default
	m = 125._default
	pdg = 25
	p(1) = vector4_moving (E, sqrt (E2 - m2), 3)
	p(2) = vector4_moving (E, -sqrt (E2 - m2), 3)
	p(3) = vector4_moving (Ex, sqrt (Ex2 - m2), 3)
	p(4) = vector4_moving (Ex, -sqrt (Ex2 - m2), 3)
	p(5) = vector4_moving (Ex, sqrt (Ex2 - m2), 1)
	p(6) = vector4_moving (Ex, -sqrt (Ex2 - m2), 1)

	call expr%reset ()
	do i = 1, 2
	call subevt_set_beam (expr%subevt_t, i, pdg, p(i), m**2)
	end do
	do i = 3, 4
	call subevt_set_incoming (expr%subevt_t, i, pdg, p(i), m**2)
	end do
	do i = 5, 6
	call subevt_set_outgoing (expr%subevt_t, i, pdg, p(i), m**2)
	end do
	expr%sqrts_hat = subevt_get_sqrts_hat (expr%subevt_t)
	expr%n_in = 2
	expr%n_out = 2
	expr%n_tot = 4
	expr%subevt_filled = .true.

	call expr%evaluate (passed, reweight, analysis_flag)

	write (u, "(A,L1)") "Event has passed = ", passed
	write (u, "(A," // FMT_12 // ")") "Reweighting factor = ", reweight
	write (u, "(A,L1)") "Analysis flag = ", analysis_flag
	write (u, "(A)")

	call write_separator (u)
	call expr%write (u)
	call write_separator (u)

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

	call expr%final ()

	call model%final ()
	call syntax_model_file_final ()

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

	end subroutine subevt_expr_2

	@ %def subevt_expr_2
	@
	\subsubsection{Processes: handle partonic cuts}
	Initialize a process and process instance, choose a sampling point and
	fill the process instance, evaluating a given cut configuration.

	We use the same trivial process as for the previous test. All
	momentum and state dependence is trivial, so we just test basic
	functionality.
	<<Expr tests: execute tests>>=
	call test (processes_5, "processes_5", &
	"handle cuts (partonic event)", &
	u, results)
	<<Expr tests: test declarations>>=
	public :: processes_5
	<<Expr tests: tests>>=
	subroutine processes_5 (u)
	integer, intent(in) :: u
	type(string_t) :: cut_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree
	type(eval_tree_factory_t) :: expr_factory
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(string_t) :: run_id
	type(os_data_t) :: os_data
	type(qcd_t) :: qcd
	class(rng_factory_t), allocatable :: rng_factory
	type(model_t), pointer :: model_tmp
	class(model_data_t), pointer :: model
	type(var_list_t), target :: var_list
	type(process_t), allocatable, target :: process
	class(mci_t), allocatable :: mci_template
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(process_instance_t), allocatable, target :: process_instance

	write (u, "(A)") "* Test output: processes_5"
	write (u, "(A)") "* Purpose: create a process &
	&and fill a process instance"
	write (u, "(A)")

	write (u, "(A)") "* Prepare a cut expression"
	write (u, "(A)")

	call syntax_pexpr_init ()
	cut_expr_text = "all Pt > 100 [s]"
	call ifile_append (ifile, cut_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (parse_tree, stream, .true.)

	write (u, "(A)") "* Build and initialize a test process"
	write (u, "(A)")

	libname = "processes5"
	procname = libname
	run_id = "run5"
	call os_data_init (os_data)
	allocate (rng_test_factory_t :: rng_factory)
	call prc_test_create_library (libname, lib)

	call syntax_model_file_init ()
	allocate (model_tmp)
	call model_tmp%read (var_str ("Test.mdl"), os_data)
	call var_list_init_snapshot (var_list, model_tmp%get_var_list_ptr ())
	model => model_tmp

	call reset_interaction_counter ()

	allocate (process)
	call process%init (procname, run_id, &
	lib, os_data, qcd, rng_factory, model)

	call var_list_append_real &
	(var_list, var_str ("tolerance"), 0._default)
	call process%set_var_list (var_list)
	call var_list%final ()

	allocate (phs_test_config_t :: phs_config_template)
	call process%setup_test_cores ()
	call process%init_component &
	(1, .true., mci_template, phs_config_template)

	write (u, "(A)") "* Prepare a trivial beam setup"
	write (u, "(A)")

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()
	call process%setup_mci ()

	write (u, "(A)") "* Complete process initialization and set cuts"
	write (u, "(A)")

	call process%setup_terms ()
	call expr_factory%init (parse_tree%get_root_ptr ())
	call process%set_cuts (expr_factory)
	call process%write (.false., u, show_var_list=.true., show_expressions=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Create a process instance"
	write (u, "(A)")

	allocate (process_instance)
	call process_instance%init (process)

	write (u, "(A)")
	write (u, "(A)") "* Inject a set of random numbers"
	write (u, "(A)")

	call process_instance%choose_mci (1)
	call process_instance%set_mcpar ([0._default, 0._default])

	write (u, "(A)")
	write (u, "(A)") "* Set up kinematics and subevt, check cuts (should fail)"
	write (u, "(A)")

	call process_instance%select_channel (1)
	call process_instance%compute_seed_kinematics ()
	call process_instance%compute_hard_kinematics ()
	call process_instance%compute_eff_kinematics ()
	call process_instance%evaluate_expressions ()
	call process_instance%compute_other_channels ()

	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for another set (should succeed)"
	write (u, "(A)")

	call process_instance%reset ()
	call process_instance%set_mcpar ([0.5_default, 0.125_default])
	call process_instance%select_channel (1)
	call process_instance%compute_seed_kinematics ()
	call process_instance%compute_hard_kinematics ()
	call process_instance%compute_eff_kinematics ()
	call process_instance%evaluate_expressions ()
	call process_instance%compute_other_channels ()
	call process_instance%evaluate_trace ()

	call process_instance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for another set using convenience procedure &
	&(failure)"
	write (u, "(A)")

	call process_instance%evaluate_sqme (1, [0.0_default, 0.2_default])

	call process_instance%write_header (u)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate for another set using convenience procedure &
	&(success)"
	write (u, "(A)")

	call process_instance%evaluate_sqme (1, [0.1_default, 0.2_default])

	call process_instance%write_header (u)

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

	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	deallocate (process)

	call parse_tree_final (parse_tree)
	call stream_final (stream)
	call ifile_final (ifile)
	call syntax_pexpr_final ()

	call syntax_model_file_final ()

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

	end subroutine processes_5

	@ %def processes_5
	@
	\subsubsection{Processes: scales and such}
	Initialize a process and process instance, choose a sampling point and
	fill the process instance, evaluating a given cut configuration.

	We use the same trivial process as for the previous test. All
	momentum and state dependence is trivial, so we just test basic
	functionality.
	<<Expr tests: execute tests>>=
	call test (processes_6, "processes_6", &
	"handle scales and weight (partonic event)", &
	u, results)
	<<Expr tests: test declarations>>=
	public :: processes_6
	<<Expr tests: tests>>=
	subroutine processes_6 (u)
	integer, intent(in) :: u
	type(string_t) :: expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: pt_scale, pt_fac_scale, pt_ren_scale, pt_weight
	type(process_library_t), target :: lib
	type(string_t) :: libname
	type(string_t) :: procname
	type(string_t) :: run_id
	type(os_data_t) :: os_data
	type(qcd_t) :: qcd
	class(rng_factory_t), allocatable :: rng_factory
	type(model_t), pointer :: model_tmp
	class(model_data_t), pointer :: model
	type(var_list_t), target :: var_list
	type(process_t), allocatable, target :: process
	class(mci_t), allocatable :: mci_template
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(process_instance_t), allocatable, target :: process_instance
	type(eval_tree_factory_t) :: expr_factory

	write (u, "(A)") "* Test output: processes_6"
	write (u, "(A)") "* Purpose: create a process &
	&and fill a process instance"
	write (u, "(A)")

	write (u, "(A)") "* Prepare expressions"
	write (u, "(A)")

	call syntax_pexpr_init ()

	expr_text = "sqrts - 100 GeV"
	write (u, "(A,A)") "scale = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_scale, stream, .true.)
	call stream_final (stream)

	expr_text = "sqrts_hat"
	write (u, "(A,A)") "fac_scale = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_fac_scale, stream, .true.)
	call stream_final (stream)

	expr_text = "eval sqrt (M2) [collect [s]]"
	write (u, "(A,A)") "ren_scale = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_ren_scale, stream, .true.)
	call stream_final (stream)

	expr_text = "n_tot * n_in * n_out * (eval Phi / pi [s])"
	write (u, "(A,A)") "weight = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_weight, stream, .true.)
	call stream_final (stream)

	call ifile_final (ifile)

	write (u, "(A)")
	write (u, "(A)") "* Build and initialize a test process"
	write (u, "(A)")

	libname = "processes4"
	procname = libname
	run_id = "run4"
	call os_data_init (os_data)
	allocate (rng_test_factory_t :: rng_factory)
	call prc_test_create_library (libname, lib)

	call syntax_model_file_init ()
	allocate (model_tmp)
	call model_tmp%read (var_str ("Test.mdl"), os_data)
	call var_list_init_snapshot (var_list, model_tmp%get_var_list_ptr ())
	model => model_tmp

	call reset_interaction_counter ()

	allocate (process)
	call process%init (procname, run_id, &
	lib, os_data, qcd, rng_factory, model)

	call process%set_var_list (var_list)
	call var_list%final ()

	call process%setup_test_cores ()
	allocate (phs_test_config_t :: phs_config_template)
	call process%init_component &
	(1, .true., mci_template, phs_config_template)

	write (u, "(A)") "* Prepare a trivial beam setup"
	write (u, "(A)")

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()
	call process%setup_mci ()

	write (u, "(A)") "* Complete process initialization and set cuts"
	write (u, "(A)")

	call process%setup_terms ()
	call expr_factory%init (pt_scale%get_root_ptr ())
	call process%set_scale (expr_factory)
	call expr_factory%init (pt_fac_scale%get_root_ptr ())
	call process%set_fac_scale (expr_factory)
	call expr_factory%init (pt_ren_scale%get_root_ptr ())
	call process%set_ren_scale (expr_factory)
	call expr_factory%init (pt_weight%get_root_ptr ())
	call process%set_weight (expr_factory)
	call process%write (.false., u, show_expressions=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Create a process instance and evaluate"
	write (u, "(A)")

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%choose_mci (1)
	call process_instance%evaluate_sqme (1, [0.5_default, 0.125_default])

	call process_instance%write (u)

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

	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	deallocate (process)

	call parse_tree_final (pt_scale)
	call parse_tree_final (pt_fac_scale)
	call parse_tree_final (pt_ren_scale)
	call parse_tree_final (pt_weight)
	call syntax_pexpr_final ()

	call syntax_model_file_final ()

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

	end subroutine processes_6

	@ %def processes_6
	@
	\subsubsection{Event expressions}
	After generating an event, fill the [[subevt]] and evaluate expressions for
	selection, reweighting, and analysis.
	<<Expr tests: execute tests>>=
	call test (events_3, "events_3", &
	"expression evaluation", &
	u, results)
	<<Expr tests: test declarations>>=
	public :: events_3
	<<Expr tests: tests>>=
	subroutine events_3 (u)
	use processes_ut, only: prepare_test_process, cleanup_test_process
	integer, intent(in) :: u
	type(string_t) :: expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: pt_selection, pt_reweight, pt_analysis
	type(eval_tree_factory_t) :: expr_factory
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(os_data_t) :: os_data
	type(model_t), pointer :: model
	type(var_list_t), target :: var_list

	write (u, "(A)") "* Test output: events_3"
	write (u, "(A)") "* Purpose: generate an event and evaluate expressions"
	write (u, "(A)")

	call syntax_pexpr_init ()

	write (u, "(A)") "* Expression texts"
	write (u, "(A)")

	expr_text = "all Pt > 100 [s]"
	write (u, "(A,A)") "selection = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (pt_selection, stream, .true.)
	call stream_final (stream)

	expr_text = "1 + sqrts_hat / sqrts"
	write (u, "(A,A)") "reweight = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (pt_reweight, stream, .true.)
	call stream_final (stream)

	expr_text = "true"
	write (u, "(A,A)") "analysis = ", char (expr_text)
	call ifile_clear (ifile)
	call ifile_append (ifile, expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (pt_analysis, stream, .true.)
	call stream_final (stream)

	call ifile_final (ifile)

	write (u, "(A)")
	write (u, "(A)") "* Initialize test process event"

	call os_data_init (os_data)

	call syntax_model_file_init ()
	allocate (model)
	call model%read (var_str ("Test.mdl"), os_data)
	call var_list_init_snapshot (var_list, model%get_var_list_ptr ())

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)

	call process%set_var_list (var_list)
	call var_list%final ()

	call process_instance%setup_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Initialize event object and set expressions"

	allocate (event)
	call event%basic_init ()

	call expr_factory%init (pt_selection%get_root_ptr ())
	call event%set_selection (expr_factory)
	call expr_factory%init (pt_reweight%get_root_ptr ())
	call event%set_reweight (expr_factory)
	call expr_factory%init (pt_analysis%get_root_ptr ())
	call event%set_analysis (expr_factory)

	call event%connect (process_instance, process%get_model_ptr ())
	call var_list_append_real &
	(event%expr%var_list, var_str ("tolerance"), 0._default)
	call event%setup_expressions ()

	write (u, "(A)")
	write (u, "(A)") "* Generate test process event"

	call process_instance%generate_weighted_event (1)

	write (u, "(A)")
	write (u, "(A)") "* Fill event object and evaluate expressions"
	write (u, "(A)")

	call event%generate (1, [0.4_default, 0.4_default])
	call event%evaluate_expressions ()
	call event%write (u)

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

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call syntax_model_file_final ()

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

	end subroutine events_3

	@ %def events_3
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Top Level}

	The top level consists of
	\begin{description}
	\item[commands]
	Defines generic command-list and command objects, and all specific
	implementations. Each command type provides a specific
	functionality. Together with the modules that provide expressions
	and variables, this module defines the Sindarin language.
	\item[whizard]
	This module interprets streams of various kind in terms of the
	command language. It also contains the unit-test feature. We also
	define the externally visible procedures here, for the \whizard\ as
	a library.
	\item[main]
	The driver for \whizard\ as a stand-alone program. Contains the
	command-line interpreter.
	\item[whizard\_c\_interface]
	Alternative top-level procedures, for use in the context of a
	C-compatible caller program.
	\end{description}

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Commands}
	This module defines the command language of the main input file.
	<<[[commands.f90]]>>=
	<<File header>>

	module commands

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use string_utils, only: lower_case
	use format_utils, only: write_indent
	use format_defs, only: FMT_14, FMT_19
	use diagnostics

	use physics_defs
	use sorting
	use sf_lhapdf, only: lhapdf_global_reset
	use os_interface
	use ifiles
	use lexers
	use syntax_rules
	use parser
	use analysis
	use pdg_arrays
	use variables
	use observables, only: var_list_check_observable
	use observables, only: var_list_check_result_var
	use eval_trees
	use models
	use auto_components
	use flavors
	use polarizations
	use particle_specifiers
	use process_libraries
	use process
	use instances
	use prclib_stacks
	use slha_interface
	use user_files
	use eio_data
	use rt_data

	use process_configurations
	use compilations, only: compile_library, compile_executable
	use integrations, only: integrate_process
	use event_streams
	use simulations

	use radiation_generator

	<<Standard module head>>

	<<Commands: public>>

	<<Commands: types>>

	<<Commands: variables>>

	<<Commands: parameters>>

	<<Commands: interfaces>>

	contains

	<<Commands: procedures>>

	end module commands
	@ %def commands
	@
	\subsection{The command type}
	The command type is a generic type that holds any command, compiled
	for execution.

	Each command may come with its own local environment. The command list that
	determines this environment is allocated as [[options]], if necessary. (It
	has to be allocated as a pointer because the type definition is recursive.) The
	local environment is available as a pointer which either points to the global
	environment, or is explicitly allocated and initialized.
	<<Commands: types>>=
	type, abstract :: command_t
	type(parse_node_t), pointer :: pn => null ()
	class(command_t), pointer :: next => null ()
	type(parse_node_t), pointer :: pn_opt => null ()
	type(command_list_t), pointer :: options => null ()
	type(rt_data_t), pointer :: local => null ()
	contains
	<<Commands: command: TBP>>
	end type command_t

	@ %def command_t
	@ Finalizer: If there is an option list, finalize the option list and
	deallocate. If not, the local environment is just a pointer.
	<<Commands: command: TBP>>=
	procedure :: final => command_final
	<<Commands: procedures>>=
	recursive subroutine command_final (cmd)
	class(command_t), intent(inout) :: cmd
	if (associated (cmd%options)) then
	call cmd%options%final ()
	deallocate (cmd%options)
	call cmd%local%local_final ()
	deallocate (cmd%local)
	else
	cmd%local => null ()
	end if
	end subroutine command_final

	@ %def command_final
	@ Allocate a command with the appropriate concrete type. Store the
	parse node pointer in the command object, so we can reference to it
	when compiling.
	<<Commands: procedures>>=
	subroutine dispatch_command (command, pn)
	class(command_t), intent(inout), pointer :: command
	type(parse_node_t), intent(in), target :: pn
	select case (char (parse_node_get_rule_key (pn)))
	case ("cmd_model")
	allocate (cmd_model_t :: command)
	case ("cmd_library")
	allocate (cmd_library_t :: command)
	case ("cmd_process")
	allocate (cmd_process_t :: command)
	case ("cmd_nlo")
	allocate (cmd_nlo_t :: command)
	case ("cmd_compile")
	allocate (cmd_compile_t :: command)
	case ("cmd_exec")
	allocate (cmd_exec_t :: command)
	case ("cmd_num", "cmd_complex", "cmd_real", "cmd_int", &
	"cmd_log_decl", "cmd_log", "cmd_string", "cmd_string_decl", &
	"cmd_alias", "cmd_result")
	allocate (cmd_var_t :: command)
	case ("cmd_slha")
	allocate (cmd_slha_t :: command)
	case ("cmd_show")
	allocate (cmd_show_t :: command)
	case ("cmd_clear")
	allocate (cmd_clear_t :: command)
	case ("cmd_expect")
	allocate (cmd_expect_t :: command)
	case ("cmd_beams")
	allocate (cmd_beams_t :: command)
	case ("cmd_beams_pol_density")
	allocate (cmd_beams_pol_density_t :: command)
	case ("cmd_beams_pol_fraction")
	allocate (cmd_beams_pol_fraction_t :: command)
	case ("cmd_beams_momentum")
	allocate (cmd_beams_momentum_t :: command)
	case ("cmd_beams_theta")
	allocate (cmd_beams_theta_t :: command)
	case ("cmd_beams_phi")
	allocate (cmd_beams_phi_t :: command)
	case ("cmd_cuts")
	allocate (cmd_cuts_t :: command)
	case ("cmd_scale")
	allocate (cmd_scale_t :: command)
	case ("cmd_fac_scale")
	allocate (cmd_fac_scale_t :: command)
	case ("cmd_ren_scale")
	allocate (cmd_ren_scale_t :: command)
	case ("cmd_weight")
	allocate (cmd_weight_t :: command)
	case ("cmd_selection")
	allocate (cmd_selection_t :: command)
	case ("cmd_reweight")
	allocate (cmd_reweight_t :: command)
	case ("cmd_iterations")
	allocate (cmd_iterations_t :: command)
	case ("cmd_integrate")
	allocate (cmd_integrate_t :: command)
	case ("cmd_observable")
	allocate (cmd_observable_t :: command)
	case ("cmd_histogram")
	allocate (cmd_histogram_t :: command)
	case ("cmd_plot")
	allocate (cmd_plot_t :: command)
	case ("cmd_graph")
	allocate (cmd_graph_t :: command)
	case ("cmd_record")
	allocate (cmd_record_t :: command)
	case ("cmd_analysis")
	allocate (cmd_analysis_t :: command)
	case ("cmd_alt_setup")
	allocate (cmd_alt_setup_t :: command)
	case ("cmd_unstable")
	allocate (cmd_unstable_t :: command)
	case ("cmd_stable")
	allocate (cmd_stable_t :: command)
	case ("cmd_polarized")
	allocate (cmd_polarized_t :: command)
	case ("cmd_unpolarized")
	allocate (cmd_unpolarized_t :: command)
	case ("cmd_sample_format")
	allocate (cmd_sample_format_t :: command)
	case ("cmd_simulate")
	allocate (cmd_simulate_t :: command)
	case ("cmd_rescan")
	allocate (cmd_rescan_t :: command)
	case ("cmd_write_analysis")
	allocate (cmd_write_analysis_t :: command)
	case ("cmd_compile_analysis")
	allocate (cmd_compile_analysis_t :: command)
	case ("cmd_open_out")
	allocate (cmd_open_out_t :: command)
	case ("cmd_close_out")
	allocate (cmd_close_out_t :: command)
	case ("cmd_printf")
	allocate (cmd_printf_t :: command)
	case ("cmd_scan")
	allocate (cmd_scan_t :: command)
	case ("cmd_if")
	allocate (cmd_if_t :: command)
	case ("cmd_include")
	allocate (cmd_include_t :: command)
	case ("cmd_quit")
	allocate (cmd_quit_t :: command)
	case default
	print *, char (parse_node_get_rule_key (pn))
	call msg_bug ("Command not implemented")
	end select
	command%pn => pn
	end subroutine dispatch_command

	@ %def dispatch_command
	@ Output. We allow for indentation so we can display a command tree.
	<<Commands: command: TBP>>=
	procedure (command_write), deferred :: write
	<<Commands: interfaces>>=
	abstract interface
	subroutine command_write (cmd, unit, indent)
	import
	class(command_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine command_write
	end interface

	@ %def command_write
	@ Compile a command. The command type is already fixed, so this is a
	deferred type-bound procedure.
	<<Commands: command: TBP>>=
	procedure (command_compile), deferred :: compile
	<<Commands: interfaces>>=
	abstract interface
	subroutine command_compile (cmd, global)
	import
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine command_compile
	end interface

	@ %def command_compile
	@ Execute a command. This will use and/or modify the runtime data
	set. If the [[quit]] flag is set, the caller should terminate command
	execution.
	<<Commands: command: TBP>>=
	procedure (command_execute), deferred :: execute
	<<Commands: interfaces>>=
	abstract interface
	subroutine command_execute (cmd, global)
	import
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine command_execute
	end interface

	@ %def command_execute
	@
	\subsection{Options}
	The [[options]] command list is allocated, initialized, and executed, if the
	command is associated with an option text in curly braces. If present, a
	separate local runtime data set [[local]] will be allocated and initialized;
	otherwise, [[local]] becomes a pointer to the global dataset.

	For output, we indent the options list.
	<<Commands: command: TBP>>=
	procedure :: write_options => command_write_options
	<<Commands: procedures>>=
	recursive subroutine command_write_options (cmd, unit, indent)
	class(command_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: ind
	ind = 1; if (present (indent)) ind = indent + 1
	if (associated (cmd%options)) call cmd%options%write (unit, ind)
	end subroutine command_write_options

	@ %def command_write_options
	@ Compile the options list, if any. This implies initialization of the local
	environment. Should be done once the [[pn_opt]] node has been assigned (if
	applicable), but before the actual command compilation.
	<<Commands: command: TBP>>=
	procedure :: compile_options => command_compile_options
	<<Commands: procedures>>=
	recursive subroutine command_compile_options (cmd, global)
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (associated (cmd%pn_opt)) then
	allocate (cmd%local)
	call cmd%local%local_init (global)
	call global%copy_globals (cmd%local)
	allocate (cmd%options)
	call cmd%options%compile (cmd%pn_opt, cmd%local)
	call global%restore_globals (cmd%local)
	call cmd%local%deactivate ()
	else
	cmd%local => global
	end if
	end subroutine command_compile_options

	@ %def command_compile_options
	@ Execute options. First prepare the local environment, then execute the
	command list.
	<<Commands: command: TBP>>=
	procedure :: execute_options => cmd_execute_options
	<<Commands: procedures>>=
	recursive subroutine cmd_execute_options (cmd, global)
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (associated (cmd%options)) then
	call cmd%local%activate ()
	call cmd%options%execute (cmd%local)
	end if
	end subroutine cmd_execute_options

	@ %def cmd_execute_options
	@ This must be called after the parent command has been executed, to undo
	temporary modifications to the environment. Note that some modifications to
	[[global]] can become permanent.
	<<Commands: command: TBP>>=
	procedure :: reset_options => cmd_reset_options
	<<Commands: procedures>>=
	subroutine cmd_reset_options (cmd, global)
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (associated (cmd%options)) then
	call cmd%local%deactivate (global)
	end if
	end subroutine cmd_reset_options

	@ %def cmd_reset_options
	@
	\subsection{Specific command types}
	\subsubsection{Model configuration}
	The command declares a model, looks for the specified file and loads
	it.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_model_t
	private
	type(string_t) :: name
	type(string_t) :: scheme
	contains
	<<Commands: cmd model: TBP>>
	end type cmd_model_t

	@ %def cmd_model_t
	@ Output
	<<Commands: cmd model: TBP>>=
	procedure :: write => cmd_model_write
	<<Commands: procedures>>=
	subroutine cmd_model_write (cmd, unit, indent)
	class(cmd_model_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,1x,'""',A,'""')") "model =", char (cmd%name)
	end subroutine cmd_model_write

	@ %def cmd_model_write
	@ Compile. Get the model name and read the model from file, so it is
	readily available when the command list is executed. If the model has a
	scheme argument, take this into account.

	Assign the model pointer in the [[global]] record, so it can be used for
	(read-only) variable lookup while compiling further commands.
	<<Commands: cmd model: TBP>>=
	procedure :: compile => cmd_model_compile
	<<Commands: procedures>>=
	subroutine cmd_model_compile (cmd, global)
	class(cmd_model_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_name, pn_arg, pn_scheme
	type(model_t), pointer :: model
	pn_name => cmd%pn%get_sub_ptr (3)
	pn_arg => pn_name%get_next_ptr ()
	if (associated (pn_arg)) then
	pn_scheme => pn_arg%get_sub_ptr ()
	else
	pn_scheme => null ()
	end if
	cmd%name = pn_name%get_string ()
	if (associated (pn_scheme)) then
	cmd%scheme = pn_scheme%get_string ()
	call preload_model (model, cmd%name, cmd%scheme)
	else
	cmd%scheme = ""
	call preload_model (model, cmd%name)
	end if
	global%model => model
	if (associated (global%model)) then
	call global%model%link_var_list (global%var_list)
	end if
	contains
	subroutine preload_model (model, name, scheme)
	type(model_t), pointer, intent(out) :: model
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	model => null ()
	if (associated (global%model)) then
	if (global%model%matches (name, scheme)) then
	model => global%model
	end if
	end if
	if (.not. associated (model)) then
	if (global%model_list%model_exists (name, scheme)) then
	model => global%model_list%get_model_ptr (name, scheme)
	else
	call global%read_model (name, model, scheme)
	end if
	end if
	end subroutine preload_model
	end subroutine cmd_model_compile

	@ %def cmd_model_compile
	@ Execute: Insert a pointer into the global data record and reassign
	the variable list.
	<<Commands: cmd model: TBP>>=
	procedure :: execute => cmd_model_execute
	<<Commands: procedures>>=
	subroutine cmd_model_execute (cmd, global)
	class(cmd_model_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (cmd%scheme /= "") then
	call global%select_model (cmd%name, cmd%scheme)
	else
	call global%select_model (cmd%name)
	end if
	if (.not. associated (global%model)) &
	call msg_fatal ("Switching to model '" &
	// char (cmd%name) // "': model not found")
	end subroutine cmd_model_execute

	@ %def cmd_model_execute
	@
	\subsubsection{Library configuration}
	We configure a process library that should hold the subsequently
	defined processes. If the referenced library exists already, just
	make it the currently active one.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_library_t
	private
	type(string_t) :: name
	contains
	<<Commands: cmd library: TBP>>
	end type cmd_library_t

	@ %def cmd_library_t
	@ Output.
	<<Commands: cmd library: TBP>>=
	procedure :: write => cmd_library_write
	<<Commands: procedures>>=
	subroutine cmd_library_write (cmd, unit, indent)
	class(cmd_library_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit)
	call write_indent (u, indent)
	write (u, "(1x,A,1x,'""',A,'""')") "library =", char (cmd%name)
	end subroutine cmd_library_write

	@ %def cmd_library_write
	@ Compile. Get the library name.
	<<Commands: cmd library: TBP>>=
	procedure :: compile => cmd_library_compile
	<<Commands: procedures>>=
	subroutine cmd_library_compile (cmd, global)
	class(cmd_library_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_name
	pn_name => parse_node_get_sub_ptr (cmd%pn, 3)
	cmd%name = parse_node_get_string (pn_name)
	end subroutine cmd_library_compile

	@ %def cmd_library_compile
	@ Execute: Initialize a new library and push it on the library stack
	(if it does not yet exist). Insert a pointer to the library into the
	global data record. Then, try to load the library unless the
	[[rebuild]] flag is set.
	<<Commands: cmd library: TBP>>=
	procedure :: execute => cmd_library_execute
	<<Commands: procedures>>=
	subroutine cmd_library_execute (cmd, global)
	class(cmd_library_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	logical :: rebuild_library
	lib => global%prclib_stack%get_library_ptr (cmd%name)
	rebuild_library = &
	global%var_list%get_lval (var_str ("?rebuild_library"))
	if (.not. (associated (lib))) then
	allocate (lib_entry)
	call lib_entry%init (cmd%name)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)
	else
	call global%update_prclib (lib)
	end if
	if (associated (lib) .and. .not. rebuild_library) then
	call lib%update_status (global%os_data)
	end if
	end subroutine cmd_library_execute

	@ %def cmd_library_execute
	@
	\subsubsection{Process configuration}
	We define a process-configuration command as a specific type. The
	incoming and outgoing particles are given evaluation-trees which we
	transform to PDG-code arrays. For transferring to \oMega, they are
	reconverted to strings.

	For the incoming particles, we store parse nodes individually. We do
	not yet resolve the outgoing state, so we store just a single parse
	node.

	This also includes the choice of method for the corresponding process:
	[[omega]] for \oMega\ matrix elements as Fortran code, [[ovm]] for
	\oMega\ matrix elements as a bytecode virtual machine, [[test]] for
	special processes, [[unit_test]] for internal test matrix elements
	generated by \whizard, [[template]] and [[template_unity]] for test
	matrix elements generated by \whizard\ as Fortran code similar to the
	\oMega\ code. If the one-loop program (OLP) \gosam\ is linked, also
	matrix elements from there (at leading and next-to-leading order) can
	be generated via [[gosam]].
	<<Commands: types>>=
	type, extends (command_t) :: cmd_process_t
	private
	type(string_t) :: id
	integer :: n_in = 0
	type(parse_node_p), dimension(:), allocatable :: pn_pdg_in
	type(parse_node_t), pointer :: pn_out => null ()
	contains
	<<Commands: cmd process: TBP>>
	end type cmd_process_t

	@ %def cmd_process_t
	@ Output. The particle expressions are not resolved, so we just list the
	number of incoming particles.
	<<Commands: cmd process: TBP>>=
	procedure :: write => cmd_process_write
	<<Commands: procedures>>=
	subroutine cmd_process_write (cmd, unit, indent)
	class(cmd_process_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A,A,I0,A)") "process: ", char (cmd%id), " (", &
	size (cmd%pn_pdg_in), " -> X)"
	call cmd%write_options (u, indent)
	end subroutine cmd_process_write

	@ %def cmd_process_write
	@ Compile. Find and assign the parse nodes.
	<<Commands: cmd process: TBP>>=
	procedure :: compile => cmd_process_compile
	<<Commands: procedures>>=
	subroutine cmd_process_compile (cmd, global)
	class(cmd_process_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_id, pn_in, pn_codes
	integer :: i
	pn_id => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_in => parse_node_get_next_ptr (pn_id, 2)
	cmd%pn_out => parse_node_get_next_ptr (pn_in, 2)
	cmd%pn_opt => parse_node_get_next_ptr (cmd%pn_out)
	call cmd%compile_options (global)
	cmd%id = parse_node_get_string (pn_id)
	cmd%n_in = parse_node_get_n_sub (pn_in)
	pn_codes => parse_node_get_sub_ptr (pn_in)
	allocate (cmd%pn_pdg_in (cmd%n_in))
	do i = 1, cmd%n_in
	cmd%pn_pdg_in(i)%ptr => pn_codes
	pn_codes => parse_node_get_next_ptr (pn_codes)
	end do
	end subroutine cmd_process_compile

	@ %def cmd_process_compile
	@ Command execution. Evaluate the subevents, transform PDG codes
	into strings, and add the current process configuration to the
	process library.

	The initial state will be unique (one or two particles). For the final state,
	we allow for expressions. The expressions will be expanded until we have a
	sum of final states. Each distinct final state will get its own process
	component.

	To identify equivalent final states, we transform the final state into an array
	of PDG codes, which we sort and compare. If a particle entry is actually a
	PDG array, only the first entry in the array is used for the comparison.
	The user should make sure that there is no overlap between different particles
	or arrays which would make the expansion ambiguous.
	<<Commands: cmd process: TBP>>=
	procedure :: execute => cmd_process_execute
	<<Commands: procedures>>=
	subroutine cmd_process_execute (cmd, global)
	class(cmd_process_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(pdg_array_t) :: pdg_in, pdg_out
	type(pdg_array_t), dimension(:), allocatable :: pdg_out_tab
	type(string_t), dimension(:), allocatable :: prt_in
	type(string_t) :: prt_out, prt_out1
	type(process_configuration_t) :: prc_config
	type(prt_expr_t) :: prt_expr_out
	type(prt_spec_t), dimension(:), allocatable :: prt_spec_in
	type(prt_spec_t), dimension(:), allocatable :: prt_spec_out
	type(var_list_t), pointer :: var_list
	integer, dimension(:), allocatable :: pdg
	integer, dimension(:), allocatable :: i_term
	integer :: i, j, n_in, n_out, n_terms, n_components
	logical :: nlo_fixed_order
	type(string_t), dimension(:), allocatable :: prt_in_nlo, prt_out_nlo
	type(radiation_generator_t) :: radiation_generator
	type(pdg_list_t) :: pl_in, pl_out
	type(string_t) :: born_me_method
	type(string_t) :: real_tree_me_method
	type(string_t) :: loop_me_method
	type(string_t) :: correlation_me_method
	integer, dimension(:), allocatable :: i_list
	logical :: powheg_use_damping
	logical :: gks_active
	logical :: initial_state_colored
	logical :: has_structure_functions
	logical :: requires_pdf
	integer :: n_components_extra
	integer :: gks_multiplicity
	integer :: n_emitters
	integer, dimension(:), allocatable :: emitters
	integer :: n_components_init
	integer :: alpha_power, alphas_power
	logical :: requires_soft_mismatch
	call msg_debug (D_CORE, "cmd_process_execute")
	var_list => cmd%local%get_var_list_ptr ()

	nlo_fixed_order = cmd%local%nlo_fixed_order
	powheg_use_damping = &
	var_list%get_lval (var_str ('?powheg_use_damping'))
	gks_multiplicity = var_list%get_ival (var_str ('gks_multiplicity'))
	gks_active = gks_multiplicity > 2
	born_me_method = var_list%get_sval (var_str ("$born_me_method"))
	real_tree_me_method = var_list%get_sval (var_str ("$real_tree_me_method"))
	loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
	correlation_me_method = var_list%get_sval (var_str ("$correlation_me_method"))
	call check_nlo_options (nlo_fixed_order, var_list)
	if (any (cmd%local%selected_nlo_parts)) &
	call override_local_me_method (born_me_method)

	n_in = size (cmd%pn_pdg_in)
	allocate (prt_in (n_in), prt_spec_in (n_in))
	do i = 1, n_in
	pdg_in = &
	eval_pdg_array (cmd%pn_pdg_in(i)%ptr, var_list)
	prt_in(i) = make_flavor_string (pdg_in, cmd%local%model)
	prt_spec_in(i) = new_prt_spec (prt_in(i))
	end do
	call compile_prt_expr &
	(prt_expr_out, cmd%pn_out, var_list, cmd%local%model)
	call prt_expr_out%expand ()
	call scan_components ()
	call determine_needed_components ()
	call prc_config%init (cmd%id, n_in, n_components_init, cmd%local)

	alpha_power = var_list%get_ival (var_str ("alpha_power"))
	alphas_power = var_list%get_ival (var_str ("alphas_power"))
	call prc_config%set_coupling_powers (alpha_power, alphas_power)

	call setup_components ()
	call prc_config%record (cmd%local)

	contains

	<<Commands: cmd process execute procedures>>

	end subroutine cmd_process_execute

	@ %def cmd_process_execute
	@
	<<Commands: cmd process execute procedures>>=
	subroutine override_local_me_method (me_method)
	type(string_t), intent(in) :: me_method
	call var_list%set_string (var_str ("$method"), me_method, is_known=.true.)
	end subroutine override_local_me_method

	@ %def override_local_me_method
	@
	<<Commands: cmd process execute procedures>>=
	subroutine determine_needed_components ()
	type(string_t) :: fks_method
	if (nlo_fixed_order .or. gks_active) &
	call setup_radiation_generator ()

	if (powheg_use_damping) then
	call radiation_generator%get_emitter_indices (emitters)
	n_emitters = size (emitters)
	end if

	if (nlo_fixed_order) then
	fks_method = var_list%get_sval (var_str ('$fks_mapping_type'))
	requires_soft_mismatch = fks_method == var_str ('resonances')
	n_components_extra = needed_extra_components (initial_state_colored, &
	has_structure_functions, requires_soft_mismatch, &
	powheg_use_damping, n_emitters)
	allocate (i_list (n_components_extra))
	else if (gks_active) then
	call radiation_generator%generate_multiple (gks_multiplicity)
	n_components_extra = radiation_generator%get_n_gks_states ()
	end if

	if (nlo_fixed_order .and. .not. powheg_use_damping) then
	n_components_init = n_components * n_components_extra
	else if (nlo_fixed_order .and. powheg_use_damping) then
	n_components_init = n_components * n_components_extra
	else if (gks_active) then
	n_components_init = n_components * (n_components_extra + 1)
	else
	n_components_init = n_components
	end if
	end subroutine determine_needed_components

	@ %def determine_needed_components
	@
	<<Commands: cmd process execute procedures>>=
	subroutine setup_radiation_generator ()
	call split_prt (prt_spec_in, n_in, pl_in)
	call split_prt (prt_spec_out, n_out, pl_out)
	call radiation_generator%init (pl_in, pl_out, qcd = .true., qed = .false.)
	call radiation_generator%set_n (n_in, n_out, 0)
	initial_state_colored = pdg_in%has_colored_particles()
	has_structure_functions = global%beam_structure%get_n_record () > 0
	requires_pdf = initial_state_colored .and. has_structure_functions
	if (requires_pdf) call radiation_generator%set_initial_state_emissions ()
	call radiation_generator%set_constraints (.false., .false., .true., .true.)
	call radiation_generator%set_radiation_model (cmd%local%radiation_model)
	call radiation_generator%setup_if_table ()
	end subroutine setup_radiation_generator

	@ %def setup_radiation_generator
	@
	<<Commands: cmd process execute procedures>>=
	subroutine scan_components ()
	n_terms = prt_expr_out%get_n_terms ()
	allocate (pdg_out_tab (n_terms))
	allocate (i_term (n_terms), source = 0)
	n_components = 0
	SCAN: do i = 1, n_terms
	if (allocated (pdg)) deallocate (pdg)
	call prt_expr_out%term_to_array (prt_spec_out, i)
	n_out = size (prt_spec_out)
	allocate (pdg (n_out))
	do j = 1, n_out
	prt_out = prt_spec_out(j)%to_string ()
	call split (prt_out, prt_out1, ":")
	pdg(j) = cmd%local%model%get_pdg (prt_out1)
	end do
	pdg_out = sort (pdg)
	do j = 1, n_components
	if (pdg_out == pdg_out_tab(j)) cycle SCAN
	end do
	n_components = n_components + 1
	i_term(n_components) = i
	pdg_out_tab(n_components) = pdg_out
	end do SCAN
	end subroutine scan_components

	@
	<<Commands: cmd process execute procedures>>=
	subroutine split_prt (prt, n_out, pl)
	type(prt_spec_t), intent(in), dimension(:), allocatable :: prt
	integer, intent(in) :: n_out
	type(pdg_list_t), intent(out) :: pl
	type(pdg_array_t) :: pdg
	type(string_t) :: prt_string, prt_tmp
	integer, parameter :: max_particle_number = 25
	integer, dimension(max_particle_number) :: i_particle
	integer :: i, j, n
	i_particle = 0
	call pl%init (n_out)
	do i = 1, n_out
	n = 1
	prt_string = prt(i)%to_string ()
	do
	call split (prt_string, prt_tmp, ":")
	if (prt_tmp /= "") then
	i_particle(n) = cmd%local%model%get_pdg (prt_tmp)
	n = n + 1
	else
	exit
	end if
	end do
	call pdg_array_init (pdg, n - 1)
	do j = 1, n - 1
	call pdg%set (j, i_particle(j))
	end do
	call pl%set (i, pdg)
	call pdg_array_delete (pdg)
	end do
	end subroutine split_prt

	@
	@
	<<Commands: cmd process execute procedures>>=
	subroutine setup_components()
	integer :: i_comp
	call msg_debug (D_CORE, "setup_components")
	do i = 1, n_components
	call prt_expr_out%term_to_array (prt_spec_out, i_term(i))
	if (nlo_fixed_order) then
	associate (selected_nlo_parts => cmd%local%selected_nlo_parts)
	call set_component_list (i_list, i, n_components, &
	requires_pdf, requires_soft_mismatch, &
	powheg_use_damping, n_emitters)

	call override_local_me_method (born_me_method)
	i_comp = i
	call msg_debug (D_CORE, "Setting up this NLO component:", i_comp)
	call prc_config%setup_component (i_comp, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, BORN, &
	can_be_integrated = selected_nlo_parts (BORN))

	call radiation_generator%generate (prt_in_nlo, prt_out_nlo)
	call override_local_me_method (real_tree_me_method)
	i_comp = n_components + i
	call msg_debug (D_CORE, "Setting up this NLO component:", i_comp)
	call prc_config%setup_component (i_comp, &
	new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
	cmd%local%model, var_list, NLO_REAL, &
	can_be_integrated = selected_nlo_parts (NLO_REAL))

	call override_local_me_method (loop_me_method)
	i_comp = n_components * 2 + i
	call msg_debug (D_CORE, "Setting up this NLO component:", i_comp)
	call prc_config%setup_component (i_comp, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, NLO_VIRTUAL, &
	can_be_integrated = selected_nlo_parts (NLO_VIRTUAL))

	call override_local_me_method (correlation_me_method)
	i_comp = n_components * 3 + i
	call msg_debug (D_CORE, "Setting up this NLO component:", i_comp)
	call prc_config%setup_component (i_comp, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, NLO_SUBTRACTION, &
	can_be_integrated = selected_nlo_parts (NLO_SUBTRACTION))

	if (powheg_use_damping) then
	call override_local_me_method (real_tree_me_method)
	i_comp = n_components * 4 + i
	call msg_debug (D_CORE, "Setting up this NLO component:", i_comp)
	call prc_config%setup_component (i_comp, &
	new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
	cmd%local%model, var_list, NLO_REAL, &
	can_be_integrated = selected_nlo_parts (NLO_REAL))
	end if

	if (requires_pdf) then
	! TODO: (bcn 2016-01-26) why only omega here?
	call override_local_me_method (var_str ("omega"))
	i_comp = n_components * 4 + i
	call msg_debug (D_CORE, "Setting up this NLO component:", i_comp)
	call prc_config%setup_component (i_comp, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, NLO_DGLAP, &
	can_be_integrated = selected_nlo_parts (NLO_DGLAP))
	end if

	if (requires_soft_mismatch) then
	! TODO: (bcn 2016-01-26) why only omega here?
	call override_local_me_method (var_str ("omega"))
	i_comp = n_components * 4 + i
	call msg_debug (D_CORE, "Setting up this NLO component:", i_comp)
	call prc_config%setup_component (i_comp, &
	!new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, NLO_MISMATCH, &
	can_be_integrated = selected_nlo_parts (NLO_MISMATCH))
	end if

	call prc_config%set_component_associations (i_list, &
	requires_pdf, powheg_use_damping, requires_soft_mismatch)
	end associate
	else if (gks_active) then
	call override_local_me_method (var_str ("omega"))
	call prc_config%setup_component (i, prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, BORN, can_be_integrated = .true.)
	call radiation_generator%reset_queue ()
	do j = 1, n_components_extra
	prt_out_nlo = radiation_generator%get_next_state ()
	call prc_config%setup_component (i + j, &
	new_prt_spec (prt_in), new_prt_spec (prt_out_nlo), &
	cmd%local%model, var_list, GKS, can_be_integrated = .false.)
	end do
	else
	call prc_config%setup_component (i, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list)
	end if
	end do
	end subroutine setup_components

	@
	@ These three functions should be bundled with the logicals they depend
	on into an object (the pcm?).
	<<Commands: procedures>>=
	subroutine check_nlo_options (nlo, var_list)
	logical, intent(in) :: nlo
	type(var_list_t), intent(in) :: var_list
	logical :: combined, powheg
	logical :: case_lo_but_any_other
	logical :: case_nlo_powheg_but_not_combined
	logical :: vamp_equivalences_enabled
	combined = var_list%get_lval (var_str ('?combined_nlo_integration'))
	powheg = var_list%get_lval (var_str ('?powheg_matching'))
	case_lo_but_any_other = .not. nlo .and. any ([combined, powheg])
	case_nlo_powheg_but_not_combined = &
	nlo .and. powheg .and. .not. combined
	if (case_lo_but_any_other) then
	call msg_fatal ("Option mismatch: Leading order process is selected &
	&but either powheg_matching or combined_nlo_integration &
	&is set to true.")
	else if (case_nlo_powheg_but_not_combined) then
	call msg_fatal ("POWHEG requires the 'combined_nlo_integration'-option &
	&to be set to true.")
	end if
	vamp_equivalences_enabled = var_list%get_lval &
	(var_str ('?use_vamp_equivalences'))
	if (nlo .and. vamp_equivalences_enabled) &
	call msg_warning ("You have switched on VAMP equivalences. ", &
	[var_str ("Note that they are automatically switched off "), &
	var_str ("for NLO calculations.")])
	end subroutine check_nlo_options

	@
	@ For a given process, there can be multiple Born, Real, Virtual,
	Special components. The layout is a grouped one, i.e. at first there are
	all Borns, then all Reals, etc.
	<<Commands: procedures>>=
	pure subroutine set_component_list (i_list, i, n_components, &
	requires_pdf, requires_soft_mismatch, &
	powheg_use_damping, n_emitters)
	integer, dimension(:), intent(out) :: i_list
	integer, intent(in) :: i, n_components, n_emitters
	logical, intent(in) :: requires_pdf, powheg_use_damping, &
	requires_soft_mismatch
	i_list(1) = i
	i_list(2) = i + n_components
	i_list(3) = i + 2 * n_components
	i_list(4) = i + 3 * n_components
	if (requires_pdf .or. requires_soft_mismatch .or. powheg_use_damping) then
	i_list(5) = i + 4 * n_components
	end if
	end subroutine set_component_list

	@ %def set_component_list
	@
	<<Commands: procedures>>=
	pure function needed_extra_components (initial_state_colored, &
	has_structure_functions, requires_soft_mismatch, &
	powheg_use_damping, n_emitters) result (n)
	integer :: n
	logical, intent(in) :: initial_state_colored, &
	has_structure_functions, powheg_use_damping, &
	requires_soft_mismatch
	integer, intent(in) :: n_emitters
	if (initial_state_colored) then
	if (has_structure_functions) then
	n = 5
	else
	n = 4
	end if
	else if (powheg_use_damping) then
	n = 5
	else if (requires_soft_mismatch) then
	n = 5
	else
	n = 4
	end if
	end function needed_extra_components

	@
	@ This is a method of the eval tree, but cannot be coded inside the
	[[expressions]] module since it uses the [[model]] and [[flv]] types
	which are not available there.
	<<Commands: procedures>>=
	function make_flavor_string (aval, model) result (prt)
	type(string_t) :: prt
	type(pdg_array_t), intent(in) :: aval
	type(model_t), intent(in), target :: model
	integer, dimension(:), allocatable :: pdg
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: i
	pdg = aval
	allocate (flv (size (pdg)))
	call flv%init (pdg, model)
	if (size (pdg) /= 0) then
	prt = flv(1)%get_name ()
	do i = 2, size (flv)
	prt = prt // ":" // flv(i)%get_name ()
	end do
	else
	prt = "?"
	end if
	end function make_flavor_string

	@ %def make_flavor_string
	@ Create a pdg array from a particle-specification array
	<<Commands: procedures>>=
	function make_pdg_array (prt, model) result (pdg_array)
	type(prt_spec_t), intent(in), dimension(:) :: prt
	type(model_t), intent(in) :: model
	integer, dimension(:), allocatable :: aval
	type(pdg_array_t) :: pdg_array
	type(flavor_t) :: flv
	integer :: k
	allocate (aval (size (prt)))
	do k = 1, size (prt)
	call flv%init (prt(k)%to_string (), model)
	aval (k) = flv%get_pdg ()
	end do
	pdg_array = aval
	end function make_pdg_array

	@ %def make_pdg_array
	@ Compile a (possible nested) expression, to obtain a
	particle-specifier expression which we can process further.
	<<Commands: procedures>>=
	recursive subroutine compile_prt_expr (prt_expr, pn, var_list, model)
	type(prt_expr_t), intent(out) :: prt_expr
	type(parse_node_t), intent(in), target :: pn
	type(var_list_t), intent(in), target :: var_list
	type(model_t), intent(in), target :: model
	type(parse_node_t), pointer :: pn_entry, pn_term, pn_addition
	type(pdg_array_t) :: pdg
	type(string_t) :: prt_string
	integer :: n_entry, n_term, i
	select case (char (parse_node_get_rule_key (pn)))
	case ("prt_state_list")
	n_entry = parse_node_get_n_sub (pn)
	pn_entry => parse_node_get_sub_ptr (pn)
	if (n_entry == 1) then
	call compile_prt_expr (prt_expr, pn_entry, var_list, model)
	else
	call prt_expr%init_list (n_entry)
	select type (x => prt_expr%x)
	type is (prt_spec_list_t)
	do i = 1, n_entry
	call compile_prt_expr (x%expr(i), pn_entry, var_list, model)
	pn_entry => parse_node_get_next_ptr (pn_entry)
	end do
	end select
	end if
	case ("prt_state_sum")
	n_term = parse_node_get_n_sub (pn)
	pn_term => parse_node_get_sub_ptr (pn)
	pn_addition => pn_term
	if (n_term == 1) then
	call compile_prt_expr (prt_expr, pn_term, var_list, model)
	else
	call prt_expr%init_sum (n_term)
	select type (x => prt_expr%x)
	type is (prt_spec_sum_t)
	do i = 1, n_term
	call compile_prt_expr (x%expr(i), pn_term, var_list, model)
	pn_addition => parse_node_get_next_ptr (pn_addition)
	if (associated (pn_addition)) &
	pn_term => parse_node_get_sub_ptr (pn_addition, 2)
	end do
	end select
	end if
	case ("cexpr")
	pdg = eval_pdg_array (pn, var_list)
	prt_string = make_flavor_string (pdg, model)
	call prt_expr%init_spec (new_prt_spec (prt_string))
	case default
	call parse_node_write_rec (pn)
	call msg_bug ("compile prt expr: impossible syntax rule")
	end select
	end subroutine compile_prt_expr

	@ %def compile_prt_expr
	@
	\subsubsection{Initiating a NLO calculation}
	<<Commands: types>>=
	type, extends (command_t) :: cmd_nlo_t
	private
	type(parse_node_p), dimension(3) :: pn_components
	contains
	<<Commands: cmd nlo: TBP>>
	end type cmd_nlo_t

	@ %def cmd_nlo_t
	@
	<<Commands: cmd nlo: TBP>>=
	procedure :: write => cmd_nlo_write
	<<Commands: procedures>>=
	subroutine cmd_nlo_write (cmd, unit, indent)
	class(cmd_nlo_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine cmd_nlo_write

	@ %def cmd_nlo_write
	@ As it is, the NLO calculation is switched on by putting {nlo} behind the process definition. This should be made nicer in the future.
	<<Commands: cmd nlo: TBP>>=
	procedure :: compile => cmd_nlo_compile
	<<Commands: procedures>>=
	subroutine cmd_nlo_compile (cmd, global)
	class(cmd_nlo_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_comp
	integer :: i
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
	cmd%pn_components(1)%ptr => parse_node_get_sub_ptr (pn_arg)
	pn_comp => parse_node_get_next_ptr (cmd%pn_components(1)%ptr)
	i = 2
	do
	if (associated (pn_comp)) then
	cmd%pn_components(i)%ptr => pn_comp
	pn_comp => parse_node_get_next_ptr (cmd%pn_components(i)%ptr)
	i = i + 1
	else
	exit
	end if
	end do
	end subroutine cmd_nlo_compile

	@ %def cmd_nlo_compile
	@
	<<Commands: cmd nlo: TBP>>=
	procedure :: execute => cmd_nlo_execute
	<<Commands: procedures>>=
	subroutine cmd_nlo_execute (cmd, global)
	class(cmd_nlo_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: current_component
	type(string_t) :: component_type
	type(string_t) :: string
	integer :: i, comp, j
	logical, dimension(0:5) :: selected_nlo_parts
	selected_nlo_parts = .false.

	current_component => cmd%pn_components(1)%ptr
	i = 2
	do while (associated (current_component))
	component_type = eval_string (current_component, global%var_list)
	comp = component_status (component_type)
	select case (comp)
	case (BORN, NLO_VIRTUAL, NLO_MISMATCH, NLO_DGLAP, NLO_REAL)
	selected_nlo_parts(comp) = .true.
	case (NLO_FULL)
	selected_nlo_parts = .true.
	case default
	string = var_str ("")
	do j = BORN, NLO_DGLAP
	string = string // component_status (j) // ", "
	end do
	string = string // component_status (NLO_FULL)
	call msg_fatal (char("Invalid NLO mode! Valid inputs are: " // string))
	end select
	if (i >= 5) exit
	current_component => cmd%pn_components(i)%ptr
	i = i + 1
	end do
	global%nlo_fixed_order = any (selected_nlo_parts(1:4))
	global%selected_nlo_parts = selected_nlo_parts
	end subroutine cmd_nlo_execute

	@ %def cmd_nlo_execute
	@
	\subsubsection{Process compilation}
	<<Commands: types>>=
	type, extends (command_t) :: cmd_compile_t
	private
	type(string_t), dimension(:), allocatable :: libname
	logical :: make_executable = .false.
	type(string_t) :: exec_name
	contains
	<<Commands: cmd compile: TBP>>
	end type cmd_compile_t

	@ %def cmd_compile_t
	@ Output: list all libraries to be compiled.
	<<Commands: cmd compile: TBP>>=
	procedure :: write => cmd_compile_write
	<<Commands: procedures>>=
	subroutine cmd_compile_write (cmd, unit, indent)
	class(cmd_compile_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "compile ("
	if (allocated (cmd%libname)) then
	do i = 1, size (cmd%libname)
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "('""',A,'""')", advance="no") char (cmd%libname(i))
	end do
	end if
	write (u, "(A)") ")"
	end subroutine cmd_compile_write

	@ %def cmd_compile_write
	@ Compile the libraries specified in the argument. If the argument is
	empty, compile all libraries which can be found in the process library stack.
	<<Commands: cmd compile: TBP>>=
	procedure :: compile => cmd_compile_compile
	<<Commands: procedures>>=
	subroutine cmd_compile_compile (cmd, global)
	class(cmd_compile_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_cmd, pn_clause, pn_arg, pn_lib
	type(parse_node_t), pointer :: pn_exec_name_spec, pn_exec_name
	integer :: n_lib, i
	pn_cmd => parse_node_get_sub_ptr (cmd%pn)
	pn_clause => parse_node_get_sub_ptr (pn_cmd)
	pn_exec_name_spec => parse_node_get_sub_ptr (pn_clause, 2)
	if (associated (pn_exec_name_spec)) then
	pn_exec_name => parse_node_get_sub_ptr (pn_exec_name_spec, 2)
	else
	pn_exec_name => null ()
	end if
	pn_arg => parse_node_get_next_ptr (pn_clause)
	cmd%pn_opt => parse_node_get_next_ptr (pn_cmd)
	call cmd%compile_options (global)
	if (associated (pn_arg)) then
	n_lib = parse_node_get_n_sub (pn_arg)
	else
	n_lib = 0
	end if
	if (n_lib > 0) then
	allocate (cmd%libname (n_lib))
	pn_lib => parse_node_get_sub_ptr (pn_arg)
	do i = 1, n_lib
	cmd%libname(i) = parse_node_get_string (pn_lib)
	pn_lib => parse_node_get_next_ptr (pn_lib)
	end do
	end if
	if (associated (pn_exec_name)) then
	cmd%make_executable = .true.
	cmd%exec_name = parse_node_get_string (pn_exec_name)
	end if
	end subroutine cmd_compile_compile

	@ %def cmd_compile_compile
	@ Command execution. Generate code, write driver, compile and link.
	Do this for all libraries in the list.

	If no library names have been given and stored while compiling this
	command, we collect all libraries from the current stack and compile
	those.

	We can compile static libraries (which actually just loads them). However, we
	can't incorporate in a generated executable.
	<<Commands: cmd compile: TBP>>=
	procedure :: execute => cmd_compile_execute
	<<Commands: procedures>>=
	subroutine cmd_compile_execute (cmd, global)
	class(cmd_compile_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(string_t), dimension(:), allocatable :: libname, libname_static
	integer :: i
	if (allocated (cmd%libname)) then
	allocate (libname (size (cmd%libname)))
	libname = cmd%libname
	else
	call cmd%local%prclib_stack%get_names (libname)
	end if
	if (cmd%make_executable) then
	call get_prclib_static (libname_static)
	do i = 1, size (libname)
	if (any (libname_static == libname(i))) then
	call msg_fatal ("Compile: can't include static library '" &
	// char (libname(i)) // "'")
	end if
	end do
	call compile_executable (cmd%exec_name, libname, cmd%local)
	else
	do i = 1, size (libname)
	call compile_library (libname(i), cmd%local)
	end do
	end if
	end subroutine cmd_compile_execute

	@ %def cmd_compile_execute
	@
	This is the interface to the external procedure which returns the
	names of all static libraries which are part of the executable. (The
	default is none.) The routine must allocate the array.
	<<Commands: public>>=
	public :: get_prclib_static
	<<Commands: interfaces>>=
	interface
	subroutine get_prclib_static (libname)
	import
	type(string_t), dimension(:), intent(inout), allocatable :: libname
	end subroutine get_prclib_static
	end interface

	@ %def get_prclib_static
	@
	\subsubsection{Execute a shell command}
	The argument is a string expression.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_exec_t
	private
	type(parse_node_t), pointer :: pn_command => null ()
	contains
	<<Commands: cmd exec: TBP>>
	end type cmd_exec_t

	@ %def cmd_exec_t
	@ Simply tell the status.
	<<Commands: cmd exec: TBP>>=
	procedure :: write => cmd_exec_write
	<<Commands: procedures>>=
	subroutine cmd_exec_write (cmd, unit, indent)
	class(cmd_exec_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	if (associated (cmd%pn_command)) then
	write (u, "(1x,A)") "exec: [command associated]"
	else
	write (u, "(1x,A)") "exec: [undefined]"
	end if
	end subroutine cmd_exec_write

	@ %def cmd_exec_write
	@ Compile the exec command.
	<<Commands: cmd exec: TBP>>=
	procedure :: compile => cmd_exec_compile
	<<Commands: procedures>>=
	subroutine cmd_exec_compile (cmd, global)
	class(cmd_exec_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_command
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_command => parse_node_get_sub_ptr (pn_arg)
	cmd%pn_command => pn_command
	end subroutine cmd_exec_compile

	@ %def cmd_exec_compile
	@ Execute the specified shell command.
	<<Commands: cmd exec: TBP>>=
	procedure :: execute => cmd_exec_execute
	<<Commands: procedures>>=
	subroutine cmd_exec_execute (cmd, global)
	class(cmd_exec_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(string_t) :: command
	logical :: is_known
	integer :: status
	command = eval_string (cmd%pn_command, global%var_list, is_known=is_known)
	if (is_known) then
	if (command /= "") then
	call os_system_call (command, status, verbose=.true.)
	if (status /= 0) then
	write (msg_buffer, "(A,I0)") "Return code = ", status
	call msg_message ()
	call msg_error ("System command returned with nonzero status code")
	end if
	end if
	end if
	end subroutine cmd_exec_execute

	@ %def cmd_exec_execute
	@
	\subsubsection{Variable declaration}
	A variable can have various types. Hold the definition as an eval
	tree.

	There are intrinsic variables, user variables, and model variables.
	The latter are further divided in independent variables and dependent
	variables.

	Regarding model variables: When dealing with them, we always look at
	two variable lists in parallel. The global (or local) variable list
	contains the user-visible values. It includes variables that
	correspond to variables in the current model's list. These, in turn,
	are pointers to the model's parameter list, so the model is always in
	sync, internally. To keep the global variable list in sync with the
	model, the global variables carry the [[is_copy]] property and contain
	a separate pointer to the model variable. (The pointer is reassigned
	whenever the model changes.) Modifying the global variable changes
	two values simultaneously: the visible value and the model variable,
	via this extra pointer. After each modification, we update dependent
	parameters in the model variable list and re-synchronize the global
	variable list (again, using these pointers) with the model variable
	this. In the last step, modifications in the derived parameters
	become visible.

	When we integrate a process, we capture the current variable list of
	the current model in a separate model instance, which is stored in the
	process object. Thus, the model parameters associated to this process
	at this time are preserved for the lifetime of the process object.

	When we generate or rescan events, we can again capture a local model
	variable list in a model instance. This allows us to reweight event
	by event with different parameter sets simultaneously.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_var_t
	private
	type(string_t) :: name
	integer :: type = V_NONE
	type(parse_node_t), pointer :: pn_value => null ()
	logical :: is_intrinsic = .false.
	logical :: is_model_var = .false.
	contains
	<<Commands: cmd var: TBP>>
	end type cmd_var_t

	@ %def cmd_var_t
	@ Output. We know name, type, and properties, but not the value.
	<<Commands: cmd var: TBP>>=
	procedure :: write => cmd_var_write
	<<Commands: procedures>>=
	subroutine cmd_var_write (cmd, unit, indent)
	class(cmd_var_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A,A)", advance="no") "var: ", char (cmd%name), " ("
	select case (cmd%type)
	case (V_NONE)
	write (u, "(A)", advance="no") "[unknown]"
	case (V_LOG)
	write (u, "(A)", advance="no") "logical"
	case (V_INT)
	write (u, "(A)", advance="no") "int"
	case (V_REAL)
	write (u, "(A)", advance="no") "real"
	case (V_CMPLX)
	write (u, "(A)", advance="no") "complex"
	case (V_STR)
	write (u, "(A)", advance="no") "string"
	case (V_PDG)
	write (u, "(A)", advance="no") "alias"
	end select
	if (cmd%is_intrinsic) then
	write (u, "(A)", advance="no") ", intrinsic"
	end if
	if (cmd%is_model_var) then
	write (u, "(A)", advance="no") ", model"
	end if
	write (u, "(A)") ")"
	end subroutine cmd_var_write

	@ %def cmd_var_write
	@ Compile the lhs and determine the variable name and type. Check whether
	this variable can be created or modified as requested, and append the value to
	the variable list, if appropriate. The value is initially undefined.
	The rhs is assigned to a pointer, to be compiled and evaluated when the
	command is executed.
	<<Commands: cmd var: TBP>>=
	procedure :: compile => cmd_var_compile
	<<Commands: procedures>>=
	subroutine cmd_var_compile (cmd, global)
	class(cmd_var_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_var, pn_name
	type(parse_node_t), pointer :: pn_result, pn_proc
	type(string_t) :: var_name
	type(var_list_t), pointer :: model_vars
	integer :: type
	logical :: new
	pn_result => null ()
	new = .false.
	select case (char (parse_node_get_rule_key (cmd%pn)))
	case ("cmd_log_decl"); type = V_LOG
	pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
	if (.not. associated (pn_var)) then ! handle masked syntax error
	cmd%type = V_NONE; return
	end if
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	new = .true.
	case ("cmd_log"); type = V_LOG
	pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
	case ("cmd_int"); type = V_INT
	pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
	new = .true.
	case ("cmd_real"); type = V_REAL
	pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
	new = .true.
	case ("cmd_complex"); type = V_CMPLX
	pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
	new = .true.
	case ("cmd_num"); type = V_NONE
	pn_name => parse_node_get_sub_ptr (cmd%pn)
	case ("cmd_string_decl"); type = V_STR
	pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
	if (.not. associated (pn_var)) then ! handle masked syntax error
	cmd%type = V_NONE; return
	end if
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	new = .true.
	case ("cmd_string"); type = V_STR
	pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
	case ("cmd_alias"); type = V_PDG
	pn_name => parse_node_get_sub_ptr (cmd%pn, 2)
	new = .true.
	case ("cmd_result"); type = V_REAL
	pn_name => parse_node_get_sub_ptr (cmd%pn)
	pn_result => parse_node_get_sub_ptr (pn_name)
	pn_proc => parse_node_get_next_ptr (pn_result)
	case default
	call parse_node_mismatch &
	("logical\|int\|real\|complex\|?\|$\|alias\|var_name", cmd%pn) ! $
	end select
	if (.not. associated (pn_name)) then ! handle masked syntax error
	cmd%type = V_NONE; return
	end if
	if (.not. associated (pn_result)) then
	var_name = parse_node_get_string (pn_name)
	else
	var_name = parse_node_get_key (pn_result) &
	// "(" // parse_node_get_string (pn_proc) // ")"
	end if
	select case (type)
	case (V_LOG); var_name = "?" // var_name
	case (V_STR); var_name = "$" // var_name ! $
	end select
	if (associated (global%model)) then
	model_vars => global%model%get_var_list_ptr ()
	else
	model_vars => null ()
	end if
	call var_list_check_observable (global%var_list, var_name, type)
	call var_list_check_result_var (global%var_list, var_name, type)
	call var_list_check_user_var (global%var_list, var_name, type, new)
	cmd%name = var_name
	cmd%pn_value => parse_node_get_next_ptr (pn_name, 2)
	if (global%var_list%contains (cmd%name, follow_link = .false.)) then
	! local variable
	cmd%is_intrinsic = &
	global%var_list%is_intrinsic (cmd%name, follow_link = .false.)
	cmd%type = &
	global%var_list%get_type (cmd%name, follow_link = .false.)
	else
	if (new) cmd%type = type
	if (global%var_list%contains (cmd%name, follow_link = .true.)) then
	! global variable
	cmd%is_intrinsic = &
	global%var_list%is_intrinsic (cmd%name, follow_link = .true.)
	if (cmd%type == V_NONE) then
	cmd%type = &
	global%var_list%get_type (cmd%name, follow_link = .true.)
	end if
	else if (associated (model_vars)) then ! check model variable
	cmd%is_model_var = &
	model_vars%contains (cmd%name)
	if (cmd%type == V_NONE) then
	cmd%type = &
	model_vars%get_type (cmd%name)
	end if
	end if
	if (cmd%type == V_NONE) then
	call msg_fatal ("Variable '" // char (cmd%name) // "' " &
	// "set without declaration")
	cmd%type = V_NONE; return
	end if
	if (cmd%is_model_var) then
	if (new) then
	call msg_fatal ("Model variable '" // char (cmd%name) // "' " &
	// "redeclared")
	else if (model_vars%is_locked (cmd%name)) then
	call msg_fatal ("Model variable '" // char (cmd%name) // "' " &
	// "is locked")
	end if
	else
	select case (cmd%type)
	case (V_LOG)
	call var_list_append_log (global%var_list, cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_INT)
	call var_list_append_int (global%var_list, cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_REAL)
	call var_list_append_real (global%var_list, cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_CMPLX)
	call var_list_append_cmplx (global%var_list, cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_PDG)
	call var_list_append_pdg_array (global%var_list, cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_STR)
	call var_list_append_string (global%var_list, cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	end select
	end if
	end if
	end subroutine cmd_var_compile

	@ %def cmd_var_compile
	@ Execute. Evaluate the definition and assign the variable value.
	If the variable is a model variable, take a snapshot of the model if necessary
	and set the variable in the local model.
	<<Commands: cmd var: TBP>>=
	procedure :: execute => cmd_var_execute
	<<Commands: procedures>>=
	subroutine cmd_var_execute (cmd, global)
	class(cmd_var_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	real(default) :: rval
	logical :: is_known, pacified
	var_list => global%get_var_list_ptr ()
	if (cmd%is_model_var) then
	pacified = var_list%get_lval (var_str ("?pacify"))
	rval = eval_real (cmd%pn_value, var_list, is_known=is_known)
	call global%model_set_real &
	(cmd%name, rval, verbose=.true., pacified=pacified)
	else if (cmd%type /= V_NONE) then
	call cmd%set_value (var_list, verbose=.true.)
	end if
	end subroutine cmd_var_execute

	@ %def cmd_var_execute
	@ Copy the value to the variable list, where the variable should already exist.
	<<Commands: cmd var: TBP>>=
	procedure :: set_value => cmd_var_set_value
	<<Commands: procedures>>=
	subroutine cmd_var_set_value (var, var_list, verbose, model_name)
	class(cmd_var_t), intent(inout) :: var
	type(var_list_t), intent(inout), target :: var_list
	logical, intent(in), optional :: verbose
	type(string_t), intent(in), optional :: model_name
	logical :: lval, pacified
	integer :: ival
	real(default) :: rval
	complex(default) :: cval
	type(pdg_array_t) :: aval
	type(string_t) :: sval
	logical :: is_known
	pacified = var_list%get_lval (var_str ("?pacify"))
	select case (var%type)
	case (V_LOG)
	lval = eval_log (var%pn_value, var_list, is_known=is_known)
	call var_list%set_log (var%name, &
	lval, is_known, verbose=verbose, model_name=model_name)
	case (V_INT)
	ival = eval_int (var%pn_value, var_list, is_known=is_known)
	call var_list%set_int (var%name, &
	ival, is_known, verbose=verbose, model_name=model_name)
	case (V_REAL)
	rval = eval_real (var%pn_value, var_list, is_known=is_known)
	call var_list%set_real (var%name, &
	rval, is_known, verbose=verbose, &
	model_name=model_name, pacified = pacified)
	case (V_CMPLX)
	cval = eval_cmplx (var%pn_value, var_list, is_known=is_known)
	call var_list%set_cmplx (var%name, &
	cval, is_known, verbose=verbose, &
	model_name=model_name, pacified = pacified)
	case (V_PDG)
	aval = eval_pdg_array (var%pn_value, var_list, is_known=is_known)
	call var_list%set_pdg_array (var%name, &
	aval, is_known, verbose=verbose, model_name=model_name)
	case (V_STR)
	sval = eval_string (var%pn_value, var_list, is_known=is_known)
	call var_list%set_string (var%name, &
	sval, is_known, verbose=verbose, model_name=model_name)
	end select
	end subroutine cmd_var_set_value

	@ %def cmd_var_set_value
	@
	\subsubsection{SLHA}
	Read a SLHA (SUSY Les Houches Accord) file to fill the appropriate
	model parameters. We do not access the current variable record, but
	directly work on the appropriate SUSY model, which is loaded if
	necessary.

	We may be in read or write mode. In the latter case, we may write
	just input parameters, or the complete spectrum, or the spectrum with
	all decays.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_slha_t
	private
	type(string_t) :: file
	logical :: write_mode = .false.
	contains
	<<Commands: cmd slha: TBP>>
	end type cmd_slha_t

	@ %def cmd_slha_t
	@ Output.
	<<Commands: cmd slha: TBP>>=
	procedure :: write => cmd_slha_write
	<<Commands: procedures>>=
	subroutine cmd_slha_write (cmd, unit, indent)
	class(cmd_slha_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A)") "slha: file name = ", char (cmd%file)
	write (u, "(1x,A,L1)") "slha: write mode = ", cmd%write_mode
	end subroutine cmd_slha_write

	@ %def cmd_slha_write
	@ Compile. Read the filename and store it.
	<<Commands: cmd slha: TBP>>=
	procedure :: compile => cmd_slha_compile
	<<Commands: procedures>>=
	subroutine cmd_slha_compile (cmd, global)
	class(cmd_slha_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_key, pn_arg, pn_file
	pn_key => parse_node_get_sub_ptr (cmd%pn)
	pn_arg => parse_node_get_next_ptr (pn_key)
	pn_file => parse_node_get_sub_ptr (pn_arg)
	call cmd%compile_options (global)
	cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
	select case (char (parse_node_get_key (pn_key)))
	case ("read_slha")
	cmd%write_mode = .false.
	case ("write_slha")
	cmd%write_mode = .true.
	case default
	call parse_node_mismatch ("read_slha\|write_slha", cmd%pn)
	end select
	cmd%file = parse_node_get_string (pn_file)
	end subroutine cmd_slha_compile

	@ %def cmd_slha_compile
	@ Execute. Read or write the specified SLHA file. Behind the scenes,
	this will first read the WHIZARD model file, then read the SLHA file
	and assign the SLHA parameters as far as determined by
	[[dispatch_slha]]. Finally, the global variables are synchronized
	with the model. This is similar to executing [[cmd_model]].
	<<Commands: cmd slha: TBP>>=
	procedure :: execute => cmd_slha_execute
	<<Commands: procedures>>=
	subroutine cmd_slha_execute (cmd, global)
	class(cmd_slha_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	logical :: input, spectrum, decays
	if (cmd%write_mode) then
	input = .true.
	spectrum = .false.
	decays = .false.
	if (.not. associated (cmd%local%model)) then
	call msg_fatal ("SLHA: local model not associated")
	return
	end if
	call slha_write_file &
	(cmd%file, cmd%local%model, &
	input = input, spectrum = spectrum, decays = decays)
	else
	if (.not. associated (global%model)) then
	call msg_fatal ("SLHA: global model not associated")
	return
	end if
	call dispatch_slha (cmd%local%var_list, &
	input = input, spectrum = spectrum, decays = decays)
	call global%ensure_model_copy ()
	call slha_read_file &
	(cmd%file, cmd%local%os_data, global%model, &
	input = input, spectrum = spectrum, decays = decays)
	end if
	end subroutine cmd_slha_execute

	@ %def cmd_slha_execute
	@
	\subsubsection{Show values}
	This command shows the current values of variables or other objects,
	in a suitably condensed form.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_show_t
	private
	type(string_t), dimension(:), allocatable :: name
	contains
	<<Commands: cmd show: TBP>>
	end type cmd_show_t

	@ %def cmd_show_t
	@ Output: list the object names, not values.
	<<Commands: cmd show: TBP>>=
	procedure :: write => cmd_show_write
	<<Commands: procedures>>=
	subroutine cmd_show_write (cmd, unit, indent)
	class(cmd_show_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "show: "
	if (allocated (cmd%name)) then
	do i = 1, size (cmd%name)
	write (u, "(1x,A)", advance="no") char (cmd%name(i))
	end do
	write (u, *)
	else
	write (u, "(5x,A)") "[undefined]"
	end if
	end subroutine cmd_show_write

	@ %def cmd_show_write
	@ Compile. Allocate an array which is filled with the names of the
	variables to show.
	<<Commands: cmd show: TBP>>=
	procedure :: compile => cmd_show_compile
	<<Commands: procedures>>=
	subroutine cmd_show_compile (cmd, global)
	class(cmd_show_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
	type(string_t) :: key
	integer :: i, n_args
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	if (associated (pn_arg)) then
	select case (char (parse_node_get_rule_key (pn_arg)))
	case ("show_arg")
	cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
	case default
	cmd%pn_opt => pn_arg
	pn_arg => null ()
	end select
	end if
	call cmd%compile_options (global)
	if (associated (pn_arg)) then
	n_args = parse_node_get_n_sub (pn_arg)
	allocate (cmd%name (n_args))
	pn_var => parse_node_get_sub_ptr (pn_arg)
	i = 0
	do while (associated (pn_var))
	i = i + 1
	select case (char (parse_node_get_rule_key (pn_var)))
	case ("model", "library", "beams", "iterations", &
	"cuts", "weight", "int", "real", "complex", &
	"scale", "factorization_scale", "renormalization_scale", &
	"selection", "reweight", "analysis", "pdg", &
	"stable", "unstable", "polarized", "unpolarized", &
	"results", "expect", "intrinsic", "string", "logical")
	cmd%name(i) = parse_node_get_key (pn_var)
	case ("result_var")
	pn_prefix => parse_node_get_sub_ptr (pn_var)
	pn_name => parse_node_get_next_ptr (pn_prefix)
	if (associated (pn_name)) then
	cmd%name(i) = parse_node_get_key (pn_prefix) &
	// "(" // parse_node_get_string (pn_name) // ")"
	else
	cmd%name(i) = parse_node_get_key (pn_prefix)
	end if
	case ("log_var", "string_var", "alias_var")
	pn_prefix => parse_node_get_sub_ptr (pn_var)
	pn_name => parse_node_get_next_ptr (pn_prefix)
	key = parse_node_get_key (pn_prefix)
	if (associated (pn_name)) then
	select case (char (parse_node_get_rule_key (pn_name)))
	case ("var_name")
	select case (char (key))
	case ("?", "$") ! $ sign
	cmd%name(i) = key // parse_node_get_string (pn_name)
	case ("alias")
	cmd%name(i) = parse_node_get_string (pn_name)
	end select
	case default
	call parse_node_mismatch &
	("var_name", pn_name)
	end select
	else
	cmd%name(i) = key
	end if
	case default
	cmd%name(i) = parse_node_get_string (pn_var)
	end select
	pn_var => parse_node_get_next_ptr (pn_var)
	end do
	else
	allocate (cmd%name (0))
	end if
	end subroutine cmd_show_compile

	@ %def cmd_show_compile
	@ Execute. Scan the list of objects to show.
	<<Commands: parameters>>=
	integer, parameter, public :: SHOW_BUFFER_SIZE = 4096
	<<Commands: cmd show: TBP>>=
	procedure :: execute => cmd_show_execute
	<<Commands: procedures>>=
	subroutine cmd_show_execute (cmd, global)
	class(cmd_show_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list, model_vars
	type(model_t), pointer :: model
	type(string_t) :: name
	integer :: n, pdg
	type(flavor_t) :: flv
	type(process_library_t), pointer :: prc_lib
	type(process_t), pointer :: process
	logical :: pacified
	character(SHOW_BUFFER_SIZE) :: buffer
	integer :: i, j, u, u_log, u_out
	u = free_unit ()
	var_list => cmd%local%var_list
	if (associated (cmd%local%model)) then
	model_vars => cmd%local%model%get_var_list_ptr ()
	else
	model_vars => null ()
	end if
	pacified = var_list%get_lval (var_str ("?pacify"))
	open (u, status = "scratch", action = "readwrite")
	if (associated (cmd%local%model)) then
	name = cmd%local%model%get_name ()
	end if
	if (size (cmd%name) == 0) then
	if (associated (model_vars)) then
	call var_list_write (model_vars, model_name = name, &
	unit = u, pacified = pacified, follow_link = .false.)
	end if
	call var_list_write (var_list, unit = u, pacified = pacified)
	else
	do i = 1, size (cmd%name)
	select case (char (cmd%name(i)))
	case ("model")
	if (associated (cmd%local%model)) then
	call cmd%local%model%show (u)
	else
	write (u, "(A)") "Model: [undefined]"
	end if
	case ("library")
	if (associated (cmd%local%prclib)) then
	call cmd%local%prclib%show (u)
	else
	write (u, "(A)") "Process library: [undefined]"
	end if
	case ("beams")
	call cmd%local%show_beams (u)
	case ("iterations")
	call cmd%local%it_list%write (u)
	case ("results")
	call cmd%local%process_stack%show (u)
	case ("stable")
	call cmd%local%model%show_stable (u)
	case ("polarized")
	call cmd%local%model%show_polarized (u)
	case ("unpolarized")
	call cmd%local%model%show_unpolarized (u)
	case ("unstable")
	model => cmd%local%model
	call model%show_unstable (u)
	n = model%get_n_field ()
	do j = 1, n
	pdg = model%get_pdg (j)
	call flv%init (pdg, model)
	if (.not. flv%is_stable ()) &
	call show_unstable (cmd%local, pdg, u)
	if (flv%has_antiparticle ()) then
	associate (anti => flv%anti ())
	if (.not. anti%is_stable ()) &
	call show_unstable (cmd%local, -pdg, u)
	end associate
	end if
	end do
	case ("cuts", "weight", "scale", &
	"factorization_scale", "renormalization_scale", &
	"selection", "reweight", "analysis")
	call cmd%local%pn%show (cmd%name(i), u)
	case ("expect")
	call expect_summary (force = .true.)
	case ("intrinsic")
	call var_list_write (var_list, &
	intrinsic=.true., unit=u, pacified = pacified)
	case ("logical")
	if (associated (model_vars)) then
	call var_list_write (model_vars, only_type=V_LOG, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list_write (var_list, &
	only_type=V_LOG, unit=u, pacified = pacified)
	case ("int")
	if (associated (model_vars)) then
	call var_list_write (model_vars, only_type=V_INT, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list_write (var_list, only_type=V_INT, &
	unit=u, pacified = pacified)
	case ("real")
	if (associated (model_vars)) then
	call var_list_write (model_vars, only_type=V_REAL, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list_write (var_list, only_type=V_REAL, &
	unit=u, pacified = pacified)
	case ("complex")
	if (associated (model_vars)) then
	call var_list_write (model_vars, only_type=V_CMPLX, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list_write (var_list, only_type=V_CMPLX, &
	unit=u, pacified = pacified)
	case ("pdg")
	if (associated (model_vars)) then
	call var_list_write (model_vars, only_type=V_PDG, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list_write (var_list, only_type=V_PDG, &
	unit=u, pacified = pacified)
	case ("string")
	if (associated (model_vars)) then
	call var_list_write (model_vars, only_type=V_STR, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list_write (var_list, only_type=V_STR, &
	unit=u, pacified = pacified)
	case default
	if (analysis_exists (cmd%name(i))) then
	call analysis_write (cmd%name(i), u)
	else if (cmd%local%process_stack%exists (cmd%name(i))) then
	process => cmd%local%process_stack%get_process_ptr (cmd%name(i))
	call process%show (u)
	else if (associated (cmd%local%prclib_stack%get_library_ptr &
	(cmd%name(i)))) then
	prc_lib => cmd%local%prclib_stack%get_library_ptr (cmd%name(i))
	call prc_lib%show (u)
	else if (associated (model_vars)) then
	if (model_vars%contains (cmd%name(i), follow_link=.false.)) then
	call var_list_write_var (model_vars, cmd%name(i), &
	unit = u, model_name = name, pacified = pacified)
	else if (var_list%contains (cmd%name(i))) then
	call var_list_write_var (var_list, cmd%name(i), &
	unit = u, pacified = pacified)
	else
	call msg_error ("show: object '" // char (cmd%name(i)) &
	// "' not found")
	end if
	else if (var_list%contains (cmd%name(i))) then
	call var_list_write_var (var_list, cmd%name(i), &
	unit = u, pacified = pacified)
	else
	call msg_error ("show: object '" // char (cmd%name(i)) &
	// "' not found")
	end if
	end select
	end do
	end if
	rewind (u)
	u_log = logfile_unit ()
	u_out = given_output_unit ()
	do
	read (u, "(A)", end = 1) buffer
	if (u_log > 0) write (u_log, "(A)") trim (buffer)
	if (u_out > 0) write (u_out, "(A)") trim (buffer)
	end do
	1 close (u)
	if (u_log > 0) flush (u_log)
	if (u_out > 0) flush (u_out)
	end subroutine cmd_show_execute

	@ %def cmd_show_execute
	@
	\subsubsection{Clear values}
	This command clears the current values of variables or other objects,
	where this makes sense. It parallels the [[show]] command. The
	objects are cleared, but not deleted.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_clear_t
	private
	type(string_t), dimension(:), allocatable :: name
	contains
	<<Commands: cmd clear: TBP>>
	end type cmd_clear_t

	@ %def cmd_clear_t
	@ Output: list the names of the objects to be cleared.
	<<Commands: cmd clear: TBP>>=
	procedure :: write => cmd_clear_write
	<<Commands: procedures>>=
	subroutine cmd_clear_write (cmd, unit, indent)
	class(cmd_clear_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "clear: "
	if (allocated (cmd%name)) then
	do i = 1, size (cmd%name)
	write (u, "(1x,A)", advance="no") char (cmd%name(i))
	end do
	write (u, *)
	else
	write (u, "(5x,A)") "[undefined]"
	end if
	end subroutine cmd_clear_write

	@ %def cmd_clear_write
	@ Compile. Allocate an array which is filled with the names of the
	objects to be cleared.

	Note: there is currently no need to account for options, but we
	prepare for that possibility.
	<<Commands: cmd clear: TBP>>=
	procedure :: compile => cmd_clear_compile
	<<Commands: procedures>>=
	subroutine cmd_clear_compile (cmd, global)
	class(cmd_clear_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
	type(string_t) :: key
	integer :: i, n_args
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	if (associated (pn_arg)) then
	select case (char (parse_node_get_rule_key (pn_arg)))
	case ("clear_arg")
	cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
	case default
	cmd%pn_opt => pn_arg
	pn_arg => null ()
	end select
	end if
	call cmd%compile_options (global)
	if (associated (pn_arg)) then
	n_args = parse_node_get_n_sub (pn_arg)
	allocate (cmd%name (n_args))
	pn_var => parse_node_get_sub_ptr (pn_arg)
	i = 0
	do while (associated (pn_var))
	i = i + 1
	select case (char (parse_node_get_rule_key (pn_var)))
	case ("beams", "iterations", &
	"cuts", "weight", &
	"scale", "factorization_scale", "renormalization_scale", &
	"selection", "reweight", "analysis", &
	"unstable", "polarized", &
	"expect")
	cmd%name(i) = parse_node_get_key (pn_var)
	case ("log_var", "string_var")
	pn_prefix => parse_node_get_sub_ptr (pn_var)
	pn_name => parse_node_get_next_ptr (pn_prefix)
	key = parse_node_get_key (pn_prefix)
	if (associated (pn_name)) then
	select case (char (parse_node_get_rule_key (pn_name)))
	case ("var_name")
	select case (char (key))
	case ("?", "$") ! $ sign
	cmd%name(i) = key // parse_node_get_string (pn_name)
	end select
	case default
	call parse_node_mismatch &
	("var_name", pn_name)
	end select
	else
	cmd%name(i) = key
	end if
	case default
	cmd%name(i) = parse_node_get_string (pn_var)
	end select
	pn_var => parse_node_get_next_ptr (pn_var)
	end do
	else
	allocate (cmd%name (0))
	end if
	end subroutine cmd_clear_compile

	@ %def cmd_clear_compile
	@ Execute. Scan the list of objects to clear.

	Objects that can be shown but not cleared: model, library, results
	<<Commands: cmd clear: TBP>>=
	procedure :: execute => cmd_clear_execute
	<<Commands: procedures>>=
	subroutine cmd_clear_execute (cmd, global)
	class(cmd_clear_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	integer :: i
	logical :: success
	type(var_list_t), pointer :: model_vars
	if (size (cmd%name) == 0) then
	call msg_warning ("clear: no object specified")
	else
	do i = 1, size (cmd%name)
	success = .true.
	select case (char (cmd%name(i)))
	case ("beams")
	call cmd%local%clear_beams ()
	case ("iterations")
	call cmd%local%it_list%clear ()
	case ("polarized")
	call cmd%local%model%clear_polarized ()
	case ("unstable")
	call cmd%local%model%clear_unstable ()
	case ("cuts", "weight", "scale", &
	"factorization_scale", "renormalization_scale", &
	"selection", "reweight", "analysis")
	call cmd%local%pn%clear (cmd%name(i))
	case ("expect")
	call expect_clear ()
	case default
	if (analysis_exists (cmd%name(i))) then
	call analysis_clear (cmd%name(i))
	else if (cmd%local%var_list%contains (cmd%name(i))) then
	if (.not. cmd%local%var_list%is_locked (cmd%name(i))) then
	call cmd%local%var_list%unset (cmd%name(i))
	else
	call msg_error ("clear: variable '" // char (cmd%name(i)) &
	// "' is locked and can't be cleared")
	success = .false.
	end if
	else if (associated (cmd%local%model)) then
	model_vars => cmd%local%model%get_var_list_ptr ()
	if (model_vars%contains (cmd%name(i), follow_link=.false.)) then
	call msg_error ("clear: variable '" // char (cmd%name(i)) &
	// "' is a model variable and can't be cleared")
	else
	call msg_error ("clear: object '" // char (cmd%name(i)) &
	// "' not found")
	end if
	success = .false.
	else
	call msg_error ("clear: object '" // char (cmd%name(i)) &
	// "' not found")
	success = .false.
	end if
	end select
	if (success) call msg_message ("cleared: " // char (cmd%name(i)))
	end do
	end if
	end subroutine cmd_clear_execute

	@ %def cmd_clear_execute
	@
	\subsubsection{Compare values of variables to expectation}
	The implementation is similar to the [[show]] command. There are just
	two arguments: two values that should be compared. For providing
	local values for the numerical tolerance, the command has a local
	argument list.

	If the expectation fails, an error condition is recorded.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_expect_t
	private
	type(parse_node_t), pointer :: pn_lexpr => null ()
	contains
	<<Commands: cmd expect: TBP>>
	end type cmd_expect_t

	@ %def cmd_expect_t
	@ Simply tell the status.
	<<Commands: cmd expect: TBP>>=
	procedure :: write => cmd_expect_write
	<<Commands: procedures>>=
	subroutine cmd_expect_write (cmd, unit, indent)
	class(cmd_expect_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	if (associated (cmd%pn_lexpr)) then
	write (u, "(1x,A)") "expect: [expression associated]"
	else
	write (u, "(1x,A)") "expect: [undefined]"
	end if
	end subroutine cmd_expect_write

	@ %def cmd_expect_write
	@ Compile. This merely assigns the parse node, the actual compilation is done
	at execution. This is necessary because the origin of variables
	(local/global) may change during execution.
	<<Commands: cmd expect: TBP>>=
	procedure :: compile => cmd_expect_compile
	<<Commands: procedures>>=
	subroutine cmd_expect_compile (cmd, global)
	class(cmd_expect_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
	cmd%pn_lexpr => parse_node_get_sub_ptr (pn_arg)
	call cmd%compile_options (global)
	end subroutine cmd_expect_compile

	@ %def cmd_expect_compile
	@ Execute. Evaluate both arguments, print them and their difference
	(if numerical), and whether they agree. Record the result.
	<<Commands: cmd expect: TBP>>=
	procedure :: execute => cmd_expect_execute
	<<Commands: procedures>>=
	subroutine cmd_expect_execute (cmd, global)
	class(cmd_expect_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	logical :: success, is_known
	var_list => cmd%local%get_var_list_ptr ()
	success = eval_log (cmd%pn_lexpr, var_list, is_known=is_known)
	if (is_known) then
	if (success) then
	call msg_message ("expect: success")
	else
	call msg_error ("expect: failure")
	end if
	else
	call msg_error ("expect: undefined result")
	success = .false.
	end if
	call expect_record (success)
	end subroutine cmd_expect_execute

	@ %def cmd_expect_execute
	@
	\subsubsection{Beams}
	The beam command includes both beam and structure-function
	definition.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_beams_t
	private
	integer :: n_in = 0
	type(parse_node_p), dimension(:), allocatable :: pn_pdg
	integer :: n_sf_record = 0
	integer, dimension(:), allocatable :: n_entry
	type(parse_node_p), dimension(:,:), allocatable :: pn_sf_entry
	contains
	<<Commands: cmd beams: TBP>>
	end type cmd_beams_t

	@ %def cmd_beams_t
	@ Output. The particle expressions are not resolved.
	<<Commands: cmd beams: TBP>>=
	procedure :: write => cmd_beams_write
	<<Commands: procedures>>=
	subroutine cmd_beams_write (cmd, unit, indent)
	class(cmd_beams_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_in)
	case (1)
	write (u, "(1x,A)") "beams: 1 [decay]"
	case (2)
	write (u, "(1x,A)") "beams: 2 [scattering]"
	case default
	write (u, "(1x,A)") "beams: [undefined]"
	end select
	if (allocated (cmd%n_entry)) then
	if (cmd%n_sf_record > 0) then
	write (u, "(1x,A,99(1x,I0))") "structure function entries:", &
	cmd%n_entry
	end if
	end if
	end subroutine cmd_beams_write

	@ %def cmd_beams_write
	@ Compile. Find and assign the parse nodes.

	Note: local environments are not yet supported.
	<<Commands: cmd beams: TBP>>=
	procedure :: compile => cmd_beams_compile
	<<Commands: procedures>>=
	subroutine cmd_beams_compile (cmd, global)
	class(cmd_beams_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_beam_def, pn_beam_spec
	type(parse_node_t), pointer :: pn_beam_list
	type(parse_node_t), pointer :: pn_codes
	type(parse_node_t), pointer :: pn_strfun_seq, pn_strfun_pair
	type(parse_node_t), pointer :: pn_strfun_def
	integer :: i
	pn_beam_def => parse_node_get_sub_ptr (cmd%pn, 3)
	pn_beam_spec => parse_node_get_sub_ptr (pn_beam_def)
	pn_strfun_seq => parse_node_get_next_ptr (pn_beam_spec)
	pn_beam_list => parse_node_get_sub_ptr (pn_beam_spec)
	call cmd%compile_options (global)
	cmd%n_in = parse_node_get_n_sub (pn_beam_list)
	allocate (cmd%pn_pdg (cmd%n_in))
	pn_codes => parse_node_get_sub_ptr (pn_beam_list)
	do i = 1, cmd%n_in
	cmd%pn_pdg(i)%ptr => pn_codes
	pn_codes => parse_node_get_next_ptr (pn_codes)
	end do
	if (associated (pn_strfun_seq)) then
	cmd%n_sf_record = parse_node_get_n_sub (pn_beam_def) - 1
	allocate (cmd%n_entry (cmd%n_sf_record), source = 1)
	allocate (cmd%pn_sf_entry (2, cmd%n_sf_record))
	do i = 1, cmd%n_sf_record
	pn_strfun_pair => parse_node_get_sub_ptr (pn_strfun_seq, 2)
	pn_strfun_def => parse_node_get_sub_ptr (pn_strfun_pair)
	cmd%pn_sf_entry(1,i)%ptr => pn_strfun_def
	pn_strfun_def => parse_node_get_next_ptr (pn_strfun_def)
	cmd%pn_sf_entry(2,i)%ptr => pn_strfun_def
	if (associated (pn_strfun_def)) cmd%n_entry(i) = 2
	pn_strfun_seq => parse_node_get_next_ptr (pn_strfun_seq)
	end do
	else
	allocate (cmd%n_entry (0))
	allocate (cmd%pn_sf_entry (0, 0))
	end if
	end subroutine cmd_beams_compile

	@ %def cmd_beams_compile
	@ Command execution: Determine beam particles and structure-function
	names, if any. The results are stored in the [[beam_structure]]
	component of the [[global]] data block.
	<<Commands: cmd beams: TBP>>=
	procedure :: execute => cmd_beams_execute
	<<Commands: procedures>>=
	subroutine cmd_beams_execute (cmd, global)
	class(cmd_beams_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(pdg_array_t) :: pdg_array
	integer, dimension(:), allocatable :: pdg
	type(flavor_t), dimension(:), allocatable :: flv
	type(parse_node_t), pointer :: pn_key
	type(string_t) :: sf_name
	integer :: i, j
	call lhapdf_global_reset ()
	var_list => cmd%local%get_var_list_ptr ()
	allocate (flv (cmd%n_in))
	do i = 1, cmd%n_in
	pdg_array = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
	pdg = pdg_array
	select case (size (pdg))
	case (1)
	call flv(i)%init ( pdg(1), cmd%local%model)
	case default
	call msg_fatal ("Beams: beam particles must be unique")
	end select
	end do
	select case (cmd%n_in)
	case (1)
	if (cmd%n_sf_record > 0) then
	call msg_fatal ("Beam setup: no structure functions allowed &
	&for decay")
	end if
	call global%beam_structure%init_sf (flv%get_name ())
	case (2)
	call global%beam_structure%init_sf (flv%get_name (), cmd%n_entry)
	do i = 1, cmd%n_sf_record
	do j = 1, cmd%n_entry(i)
	pn_key => parse_node_get_sub_ptr (cmd%pn_sf_entry(j,i)%ptr)
	sf_name = parse_node_get_key (pn_key)
	call global%beam_structure%set_sf (i, j, sf_name)
	end do
	end do
	end select
	end subroutine cmd_beams_execute

	@ %def cmd_beams_execute
	@
	\subsubsection{Density matrices for beam polarization}
	For holding beam polarization, we define a notation and a data
	structure for sparse matrices. The entries (and the index
	expressions) are numerical expressions, so we use evaluation trees.

	Each entry in the sparse matrix is an n-tuple of expressions. The first
	tuple elements represent index values, the last one is an arbitrary
	(complex) number. Absent expressions are replaced by default-value rules.

	Note: Here, and in some other commands, we would like to store an evaluation
	tree, not just a parse node pointer. However, the current expression handler
	wants all variables defined, so the evaluation tree can only be built by
	[[evaluate]], i.e., compiled just-in-time and evaluated immediately.
	<<Commands: types>>=
	type :: sentry_expr_t
	type(parse_node_p), dimension(:), allocatable :: expr
	contains
	<<Commands: sentry expr: TBP>>
	end type sentry_expr_t

	@ %def sentry_expr_t
	@ Compile parse nodes into evaluation trees.
	<<Commands: sentry expr: TBP>>=
	procedure :: compile => sentry_expr_compile
	<<Commands: procedures>>=
	subroutine sentry_expr_compile (sentry, pn)
	class(sentry_expr_t), intent(out) :: sentry
	type(parse_node_t), intent(in), target :: pn
	type(parse_node_t), pointer :: pn_expr, pn_extra
	integer :: n_expr, i
	n_expr = parse_node_get_n_sub (pn)
	allocate (sentry%expr (n_expr))
	if (n_expr > 0) then
	i = 0
	pn_expr => parse_node_get_sub_ptr (pn)
	pn_extra => parse_node_get_next_ptr (pn_expr)
	do i = 1, n_expr
	sentry%expr(i)%ptr => pn_expr
	if (associated (pn_extra)) then
	pn_expr => parse_node_get_sub_ptr (pn_extra, 2)
	pn_extra => parse_node_get_next_ptr (pn_extra)
	end if
	end do
	end if
	end subroutine sentry_expr_compile

	@ %def sentry_expr_compile
	@ Evaluate the expressions and return an index array of predefined
	length together with a complex value. If the value (as the last expression)
	is undefined, set it to unity. If index values are undefined, repeat
	the previous index value.
	<<Commands: sentry expr: TBP>>=
	procedure :: evaluate => sentry_expr_evaluate
	<<Commands: procedures>>=
	subroutine sentry_expr_evaluate (sentry, index, value, global)
	class(sentry_expr_t), intent(inout) :: sentry
	integer, dimension(:), intent(out) :: index
	complex(default), intent(out) :: value
	type(rt_data_t), intent(in), target :: global
	type(var_list_t), pointer :: var_list
	integer :: i, n_expr, n_index
	type(eval_tree_t) :: eval_tree
	var_list => global%get_var_list_ptr ()
	n_expr = size (sentry%expr)
	n_index = size (index)
	if (n_expr <= n_index + 1) then
	do i = 1, min (n_expr, n_index)
	associate (expr => sentry%expr(i))
	call eval_tree%init_expr (expr%ptr, var_list)
	call eval_tree%evaluate ()
	if (eval_tree%is_known ()) then
	index(i) = eval_tree%get_int ()
	else
	call msg_fatal ("Evaluating density matrix: undefined index")
	end if
	end associate
	end do
	do i = n_expr + 1, n_index
	index(i) = index(n_expr)
	end do
	if (n_expr == n_index + 1) then
	associate (expr => sentry%expr(n_expr))
	call eval_tree%init_expr (expr%ptr, var_list)
	call eval_tree%evaluate ()
	if (eval_tree%is_known ()) then
	value = eval_tree%get_cmplx ()
	else
	call msg_fatal ("Evaluating density matrix: undefined index")
	end if
	call eval_tree%final ()
	end associate
	else
	value = 1
	end if
	else
	call msg_fatal ("Evaluating density matrix: index expression too long")
	end if
	end subroutine sentry_expr_evaluate

	@ %def sentry_expr_evaluate
	@ The sparse matrix itself consists of an arbitrary number of entries.
	<<Commands: types>>=
	type :: smatrix_expr_t
	type(sentry_expr_t), dimension(:), allocatable :: entry
	contains
	<<Commands: smatrix expr: TBP>>
	end type smatrix_expr_t

	@ %def smatrix_expr_t
	@ Compile: assign sub-nodes to sentry-expressions and compile those.
	<<Commands: smatrix expr: TBP>>=
	procedure :: compile => smatrix_expr_compile
	<<Commands: procedures>>=
	subroutine smatrix_expr_compile (smatrix_expr, pn)
	class(smatrix_expr_t), intent(out) :: smatrix_expr
	type(parse_node_t), intent(in), target :: pn
	type(parse_node_t), pointer :: pn_arg, pn_entry
	integer :: n_entry, i
	pn_arg => parse_node_get_sub_ptr (pn, 2)
	if (associated (pn_arg)) then
	n_entry = parse_node_get_n_sub (pn_arg)
	allocate (smatrix_expr%entry (n_entry))
	pn_entry => parse_node_get_sub_ptr (pn_arg)
	do i = 1, n_entry
	call smatrix_expr%entry(i)%compile (pn_entry)
	pn_entry => parse_node_get_next_ptr (pn_entry)
	end do
	else
	allocate (smatrix_expr%entry (0))
	end if
	end subroutine smatrix_expr_compile

	@ %def smatrix_expr_compile
	@ Evaluate the entries and build a new [[smatrix]] object, which
	contains just the numerical results.
	<<Commands: smatrix expr: TBP>>=
	procedure :: evaluate => smatrix_expr_evaluate
	<<Commands: procedures>>=
	subroutine smatrix_expr_evaluate (smatrix_expr, smatrix, global)
	class(smatrix_expr_t), intent(inout) :: smatrix_expr
	type(smatrix_t), intent(out) :: smatrix
	type(rt_data_t), intent(in), target :: global
	integer, dimension(2) :: idx
	complex(default) :: value
	integer :: i, n_entry
	n_entry = size (smatrix_expr%entry)
	call smatrix%init (2, n_entry)
	do i = 1, n_entry
	call smatrix_expr%entry(i)%evaluate (idx, value, global)
	call smatrix%set_entry (i, idx, value)
	end do
	end subroutine smatrix_expr_evaluate

	@ %def smatrix_expr_evaluate
	@
	\subsubsection{Beam polarization density}

	The beam polarization command defines spin density matrix for one or
	two beams (scattering or decay).
	<<Commands: types>>=
	type, extends (command_t) :: cmd_beams_pol_density_t
	private
	integer :: n_in = 0
	type(smatrix_expr_t), dimension(:), allocatable :: smatrix
	contains
	<<Commands: cmd beams pol density: TBP>>
	end type cmd_beams_pol_density_t

	@ %def cmd_beams_pol_density_t
	@ Output.
	<<Commands: cmd beams pol density: TBP>>=
	procedure :: write => cmd_beams_pol_density_write
	<<Commands: procedures>>=
	subroutine cmd_beams_pol_density_write (cmd, unit, indent)
	class(cmd_beams_pol_density_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_in)
	case (1)
	write (u, "(1x,A)") "beams polarization setup: 1 [decay]"
	case (2)
	write (u, "(1x,A)") "beams polarization setup: 2 [scattering]"
	case default
	write (u, "(1x,A)") "beams polarization setup: [undefined]"
	end select
	end subroutine cmd_beams_pol_density_write

	@ %def cmd_beams_pol_density_write
	@ Compile. Find and assign the parse nodes.

	Note: local environments are not yet supported.
	<<Commands: cmd beams pol density: TBP>>=
	procedure :: compile => cmd_beams_pol_density_compile
	<<Commands: procedures>>=
	subroutine cmd_beams_pol_density_compile (cmd, global)
	class(cmd_beams_pol_density_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_pol_spec, pn_smatrix
	integer :: i
	pn_pol_spec => parse_node_get_sub_ptr (cmd%pn, 3)
	call cmd%compile_options (global)
	cmd%n_in = parse_node_get_n_sub (pn_pol_spec)
	allocate (cmd%smatrix (cmd%n_in))
	pn_smatrix => parse_node_get_sub_ptr (pn_pol_spec)
	do i = 1, cmd%n_in
	call cmd%smatrix(i)%compile (pn_smatrix)
	pn_smatrix => parse_node_get_next_ptr (pn_smatrix)
	end do
	end subroutine cmd_beams_pol_density_compile

	@ %def cmd_beams_pol_density_compile
	@ Command execution: Fill polarization density matrices. No check
	yet, the matrices are checked and normalized when the actual beam
	object is created, just before integration. For intermediate storage,
	we use the [[beam_structure]] object in the [[global]] data set.
	<<Commands: cmd beams pol density: TBP>>=
	procedure :: execute => cmd_beams_pol_density_execute
	<<Commands: procedures>>=
	subroutine cmd_beams_pol_density_execute (cmd, global)
	class(cmd_beams_pol_density_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(smatrix_t) :: smatrix
	integer :: i
	call global%beam_structure%init_pol (cmd%n_in)
	do i = 1, cmd%n_in
	call cmd%smatrix(i)%evaluate (smatrix, global)
	call global%beam_structure%set_smatrix (i, smatrix)
	end do
	end subroutine cmd_beams_pol_density_execute

	@ %def cmd_beams_pol_density_execute
	@
	\subsubsection{Beam polarization fraction}
	In addition to the polarization density matrix, we can independently
	specify the polarization fraction for one or both beams.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_beams_pol_fraction_t
	private
	integer :: n_in = 0
	type(parse_node_p), dimension(:), allocatable :: expr
	contains
	<<Commands: cmd beams pol fraction: TBP>>
	end type cmd_beams_pol_fraction_t

	@ %def cmd_beams_pol_fraction_t
	@ Output.
	<<Commands: cmd beams pol fraction: TBP>>=
	procedure :: write => cmd_beams_pol_fraction_write
	<<Commands: procedures>>=
	subroutine cmd_beams_pol_fraction_write (cmd, unit, indent)
	class(cmd_beams_pol_fraction_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_in)
	case (1)
	write (u, "(1x,A)") "beams polarization fraction: 1 [decay]"
	case (2)
	write (u, "(1x,A)") "beams polarization fraction: 2 [scattering]"
	case default
	write (u, "(1x,A)") "beams polarization fraction: [undefined]"
	end select
	end subroutine cmd_beams_pol_fraction_write

	@ %def cmd_beams_pol_fraction_write
	@ Compile. Find and assign the parse nodes.

	Note: local environments are not yet supported.
	<<Commands: cmd beams pol fraction: TBP>>=
	procedure :: compile => cmd_beams_pol_fraction_compile
	<<Commands: procedures>>=
	subroutine cmd_beams_pol_fraction_compile (cmd, global)
	class(cmd_beams_pol_fraction_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_frac_spec, pn_expr
	integer :: i
	pn_frac_spec => parse_node_get_sub_ptr (cmd%pn, 3)
	call cmd%compile_options (global)
	cmd%n_in = parse_node_get_n_sub (pn_frac_spec)
	allocate (cmd%expr (cmd%n_in))
	pn_expr => parse_node_get_sub_ptr (pn_frac_spec)
	do i = 1, cmd%n_in
	cmd%expr(i)%ptr => pn_expr
	pn_expr => parse_node_get_next_ptr (pn_expr)
	end do
	end subroutine cmd_beams_pol_fraction_compile

	@ %def cmd_beams_pol_fraction_compile
	@ Command execution: Retrieve the numerical values of the beam
	polarization fractions. The results are stored in the
	[[beam_structure]] component of the [[global]] data block.
	<<Commands: cmd beams pol fraction: TBP>>=
	procedure :: execute => cmd_beams_pol_fraction_execute
	<<Commands: procedures>>=
	subroutine cmd_beams_pol_fraction_execute (cmd, global)
	class(cmd_beams_pol_fraction_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	real(default), dimension(:), allocatable :: pol_f
	type(eval_tree_t) :: expr
	integer :: i
	var_list => global%get_var_list_ptr ()
	allocate (pol_f (cmd%n_in))
	do i = 1, cmd%n_in
	call expr%init_expr (cmd%expr(i)%ptr, var_list)
	call expr%evaluate ()
	if (expr%is_known ()) then
	pol_f(i) = expr%get_real ()
	else
	call msg_fatal ("beams polarization fraction: undefined value")
	end if
	call expr%final ()
	end do
	call global%beam_structure%set_pol_f (pol_f)
	end subroutine cmd_beams_pol_fraction_execute

	@ %def cmd_beams_pol_fraction_execute
	@
	\subsubsection{Beam momentum}
	This is completely analogous to the previous command, hence we can use
	inheritance.
	<<Commands: types>>=
	type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_momentum_t
	contains
	<<Commands: cmd beams momentum: TBP>>
	end type cmd_beams_momentum_t

	@ %def cmd_beams_momentum_t
	@ Output.
	<<Commands: cmd beams momentum: TBP>>=
	procedure :: write => cmd_beams_momentum_write
	<<Commands: procedures>>=
	subroutine cmd_beams_momentum_write (cmd, unit, indent)
	class(cmd_beams_momentum_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_in)
	case (1)
	write (u, "(1x,A)") "beams momentum: 1 [decay]"
	case (2)
	write (u, "(1x,A)") "beams momentum: 2 [scattering]"
	case default
	write (u, "(1x,A)") "beams momentum: [undefined]"
	end select
	end subroutine cmd_beams_momentum_write

	@ %def cmd_beams_momentum_write
	@ Compile: inherited.

	Command execution: Not inherited, but just the error string and the final
	command are changed.
	<<Commands: cmd beams momentum: TBP>>=
	procedure :: execute => cmd_beams_momentum_execute
	<<Commands: procedures>>=
	subroutine cmd_beams_momentum_execute (cmd, global)
	class(cmd_beams_momentum_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	real(default), dimension(:), allocatable :: p
	type(eval_tree_t) :: expr
	integer :: i
	var_list => global%get_var_list_ptr ()
	allocate (p (cmd%n_in))
	do i = 1, cmd%n_in
	call expr%init_expr (cmd%expr(i)%ptr, var_list)
	call expr%evaluate ()
	if (expr%is_known ()) then
	p(i) = expr%get_real ()
	else
	call msg_fatal ("beams momentum: undefined value")
	end if
	call expr%final ()
	end do
	call global%beam_structure%set_momentum (p)
	end subroutine cmd_beams_momentum_execute

	@ %def cmd_beams_momentum_execute
	@
	\subsubsection{Beam angles}
	Again, this is analogous. There are two angles, polar angle $\theta$
	and azimuthal angle $\phi$, which can be set independently for both beams.
	<<Commands: types>>=
	type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_theta_t
	contains
	<<Commands: cmd beams theta: TBP>>
	end type cmd_beams_theta_t

	type, extends (cmd_beams_pol_fraction_t) :: cmd_beams_phi_t
	contains
	<<Commands: cmd beams phi: TBP>>
	end type cmd_beams_phi_t

	@ %def cmd_beams_theta_t
	@ %def cmd_beams_phi_t
	@ Output.
	<<Commands: cmd beams theta: TBP>>=
	procedure :: write => cmd_beams_theta_write
	<<Commands: cmd beams phi: TBP>>=
	procedure :: write => cmd_beams_phi_write
	<<Commands: procedures>>=
	subroutine cmd_beams_theta_write (cmd, unit, indent)
	class(cmd_beams_theta_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_in)
	case (1)
	write (u, "(1x,A)") "beams theta: 1 [decay]"
	case (2)
	write (u, "(1x,A)") "beams theta: 2 [scattering]"
	case default
	write (u, "(1x,A)") "beams theta: [undefined]"
	end select
	end subroutine cmd_beams_theta_write

	subroutine cmd_beams_phi_write (cmd, unit, indent)
	class(cmd_beams_phi_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_in)
	case (1)
	write (u, "(1x,A)") "beams phi: 1 [decay]"
	case (2)
	write (u, "(1x,A)") "beams phi: 2 [scattering]"
	case default
	write (u, "(1x,A)") "beams phi: [undefined]"
	end select
	end subroutine cmd_beams_phi_write

	@ %def cmd_beams_theta_write
	@ %def cmd_beams_phi_write
	@ Compile: inherited.

	Command execution: Not inherited, but just the error string and the final
	command are changed.
	<<Commands: cmd beams theta: TBP>>=
	procedure :: execute => cmd_beams_theta_execute
	<<Commands: cmd beams phi: TBP>>=
	procedure :: execute => cmd_beams_phi_execute
	<<Commands: procedures>>=
	subroutine cmd_beams_theta_execute (cmd, global)
	class(cmd_beams_theta_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	real(default), dimension(:), allocatable :: theta
	type(eval_tree_t) :: expr
	integer :: i
	var_list => global%get_var_list_ptr ()
	allocate (theta (cmd%n_in))
	do i = 1, cmd%n_in
	call expr%init_expr (cmd%expr(i)%ptr, var_list)
	call expr%evaluate ()
	if (expr%is_known ()) then
	theta(i) = expr%get_real ()
	else
	call msg_fatal ("beams theta: undefined value")
	end if
	call expr%final ()
	end do
	call global%beam_structure%set_theta (theta)
	end subroutine cmd_beams_theta_execute

	subroutine cmd_beams_phi_execute (cmd, global)
	class(cmd_beams_phi_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	real(default), dimension(:), allocatable :: phi
	type(eval_tree_t) :: expr
	integer :: i
	var_list => global%get_var_list_ptr ()
	allocate (phi (cmd%n_in))
	do i = 1, cmd%n_in
	call expr%init_expr (cmd%expr(i)%ptr, var_list)
	call expr%evaluate ()
	if (expr%is_known ()) then
	phi(i) = expr%get_real ()
	else
	call msg_fatal ("beams phi: undefined value")
	end if
	call expr%final ()
	end do
	call global%beam_structure%set_phi (phi)
	end subroutine cmd_beams_phi_execute

	@ %def cmd_beams_theta_execute
	@ %def cmd_beams_phi_execute
	@
	\subsubsection{Cuts}
	Define a cut expression. We store the parse tree for the right-hand
	side instead of compiling it. Compilation is deferred to the process
	environment where the cut expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_cuts_t
	private
	type(parse_node_t), pointer :: pn_lexpr => null ()
	contains
	<<Commands: cmd cuts: TBP>>
	end type cmd_cuts_t

	@ %def cmd_cuts_t
	@ Output. Do not print the parse tree, since this may get cluttered.
	Just a message that cuts have been defined.
	<<Commands: cmd cuts: TBP>>=
	procedure :: write => cmd_cuts_write
	<<Commands: procedures>>=
	subroutine cmd_cuts_write (cmd, unit, indent)
	class(cmd_cuts_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "cuts: [defined]"
	end subroutine cmd_cuts_write

	@ %def cmd_cuts_write
	@ Compile. Simply store the parse (sub)tree.
	<<Commands: cmd cuts: TBP>>=
	procedure :: compile => cmd_cuts_compile
	<<Commands: procedures>>=
	subroutine cmd_cuts_compile (cmd, global)
	class(cmd_cuts_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_cuts_compile

	@ %def cmd_cuts_compile
	@ Instead of evaluating the cut expression, link the parse tree to the
	global data set, such that it is compiled and executed in the
	appropriate process context.
	<<Commands: cmd cuts: TBP>>=
	procedure :: execute => cmd_cuts_execute
	<<Commands: procedures>>=
	subroutine cmd_cuts_execute (cmd, global)
	class(cmd_cuts_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%cuts_lexpr => cmd%pn_lexpr
	end subroutine cmd_cuts_execute

	@ %def cmd_cuts_execute
	@
	\subsubsection{General, Factorization and Renormalization Scales}
	Define a scale expression for either the renormalization or the
	factorization scale. We store the parse tree for the right-hand
	side instead of compiling it. Compilation is deferred to the process
	environment where the expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_scale_t
	private
	type(parse_node_t), pointer :: pn_expr => null ()
	contains
	<<Commands: cmd scale: TBP>>
	end type cmd_scale_t

	@ %def cmd_scale_t
	<<Commands: types>>=
	type, extends (command_t) :: cmd_fac_scale_t
	private
	type(parse_node_t), pointer :: pn_expr => null ()
	contains
	<<Commands: cmd fac scale: TBP>>
	end type cmd_fac_scale_t

	@ %def cmd_fac_scale_t
	<<Commands: types>>=
	type, extends (command_t) :: cmd_ren_scale_t
	private
	type(parse_node_t), pointer :: pn_expr => null ()
	contains
	<<Commands: cmd ren scale: TBP>>
	end type cmd_ren_scale_t

	@ %def cmd_ren_scale_t
	@ Output. Do not print the parse tree, since this may get cluttered.
	Just a message that scale, renormalization and factorization have been
	defined, respectively.
	<<Commands: cmd scale: TBP>>=
	procedure :: write => cmd_scale_write
	<<Commands: procedures>>=
	subroutine cmd_scale_write (cmd, unit, indent)
	class(cmd_scale_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "scale: [defined]"
	end subroutine cmd_scale_write

	@ %def cmd_scale_write
	@
	<<Commands: cmd fac scale: TBP>>=
	procedure :: write => cmd_fac_scale_write
	<<Commands: procedures>>=
	subroutine cmd_fac_scale_write (cmd, unit, indent)
	class(cmd_fac_scale_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "factorization scale: [defined]"
	end subroutine cmd_fac_scale_write

	@ %def cmd_fac_scale_write
	@
	<<Commands: cmd ren scale: TBP>>=
	procedure :: write => cmd_ren_scale_write
	<<Commands: procedures>>=
	subroutine cmd_ren_scale_write (cmd, unit, indent)
	class(cmd_ren_scale_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "renormalization scale: [defined]"
	end subroutine cmd_ren_scale_write

	@ %def cmd_ren_scale_write
	@ Compile. Simply store the parse (sub)tree.
	<<Commands: cmd scale: TBP>>=
	procedure :: compile => cmd_scale_compile
	<<Commands: procedures>>=
	subroutine cmd_scale_compile (cmd, global)
	class(cmd_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_scale_compile

	@ %def cmd_scale_compile
	@
	<<Commands: cmd fac scale: TBP>>=
	procedure :: compile => cmd_fac_scale_compile
	<<Commands: procedures>>=
	subroutine cmd_fac_scale_compile (cmd, global)
	class(cmd_fac_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_fac_scale_compile

	@ %def cmd_fac_scale_compile
	@
	<<Commands: cmd ren scale: TBP>>=
	procedure :: compile => cmd_ren_scale_compile
	<<Commands: procedures>>=
	subroutine cmd_ren_scale_compile (cmd, global)
	class(cmd_ren_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_ren_scale_compile

	@ %def cmd_ren_scale_compile
	@ Instead of evaluating the scale expression, link the parse tree to the
	global data set, such that it is compiled and executed in the
	appropriate process context.
	<<Commands: cmd scale: TBP>>=
	procedure :: execute => cmd_scale_execute
	<<Commands: procedures>>=
	subroutine cmd_scale_execute (cmd, global)
	class(cmd_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%scale_expr => cmd%pn_expr
	end subroutine cmd_scale_execute

	@ %def cmd_scale_execute
	@
	<<Commands: cmd fac scale: TBP>>=
	procedure :: execute => cmd_fac_scale_execute
	<<Commands: procedures>>=
	subroutine cmd_fac_scale_execute (cmd, global)
	class(cmd_fac_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%fac_scale_expr => cmd%pn_expr
	end subroutine cmd_fac_scale_execute

	@ %def cmd_fac_scale_execute
	@
	<<Commands: cmd ren scale: TBP>>=
	procedure :: execute => cmd_ren_scale_execute
	<<Commands: procedures>>=
	subroutine cmd_ren_scale_execute (cmd, global)
	class(cmd_ren_scale_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%ren_scale_expr => cmd%pn_expr
	end subroutine cmd_ren_scale_execute

	@ %def cmd_ren_scale_execute
	@
	\subsubsection{Weight}
	Define a weight expression. The weight is applied to a process to be
	integrated, event by event. We store the parse tree for the right-hand
	side instead of compiling it. Compilation is deferred to the process
	environment where the expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_weight_t
	private
	type(parse_node_t), pointer :: pn_expr => null ()
	contains
	<<Commands: cmd weight: TBP>>
	end type cmd_weight_t

	@ %def cmd_weight_t
	@ Output. Do not print the parse tree, since this may get cluttered.
	Just a message that scale, renormalization and factorization have been
	defined, respectively.
	<<Commands: cmd weight: TBP>>=
	procedure :: write => cmd_weight_write
	<<Commands: procedures>>=
	subroutine cmd_weight_write (cmd, unit, indent)
	class(cmd_weight_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "weight expression: [defined]"
	end subroutine cmd_weight_write

	@ %def cmd_weight_write
	@ Compile. Simply store the parse (sub)tree.
	<<Commands: cmd weight: TBP>>=
	procedure :: compile => cmd_weight_compile
	<<Commands: procedures>>=
	subroutine cmd_weight_compile (cmd, global)
	class(cmd_weight_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_weight_compile

	@ %def cmd_weight_compile
	@ Instead of evaluating the expression, link the parse tree to the
	global data set, such that it is compiled and executed in the
	appropriate process context.
	<<Commands: cmd weight: TBP>>=
	procedure :: execute => cmd_weight_execute
	<<Commands: procedures>>=
	subroutine cmd_weight_execute (cmd, global)
	class(cmd_weight_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%weight_expr => cmd%pn_expr
	end subroutine cmd_weight_execute

	@ %def cmd_weight_execute
	@
	\subsubsection{Selection}
	Define a selection expression. This is to be applied upon simulation or
	event-file rescanning, event by event. We store the parse tree for the
	right-hand side instead of compiling it. Compilation is deferred to the
	environment where the expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_selection_t
	private
	type(parse_node_t), pointer :: pn_expr => null ()
	contains
	<<Commands: cmd selection: TBP>>
	end type cmd_selection_t

	@ %def cmd_selection_t
	@ Output. Do not print the parse tree, since this may get cluttered.
	Just a message that scale, renormalization and factorization have been
	defined, respectively.
	<<Commands: cmd selection: TBP>>=
	procedure :: write => cmd_selection_write
	<<Commands: procedures>>=
	subroutine cmd_selection_write (cmd, unit, indent)
	class(cmd_selection_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "selection expression: [defined]"
	end subroutine cmd_selection_write

	@ %def cmd_selection_write
	@ Compile. Simply store the parse (sub)tree.
	<<Commands: cmd selection: TBP>>=
	procedure :: compile => cmd_selection_compile
	<<Commands: procedures>>=
	subroutine cmd_selection_compile (cmd, global)
	class(cmd_selection_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_selection_compile

	@ %def cmd_selection_compile
	@ Instead of evaluating the expression, link the parse tree to the
	global data set, such that it is compiled and executed in the
	appropriate process context.
	<<Commands: cmd selection: TBP>>=
	procedure :: execute => cmd_selection_execute
	<<Commands: procedures>>=
	subroutine cmd_selection_execute (cmd, global)
	class(cmd_selection_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%selection_lexpr => cmd%pn_expr
	end subroutine cmd_selection_execute

	@ %def cmd_selection_execute
	@
	\subsubsection{Reweight}
	Define a reweight expression. This is to be applied upon simulation or
	event-file rescanning, event by event. We store the parse tree for the
	right-hand side instead of compiling it. Compilation is deferred to the
	environment where the expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_reweight_t
	private
	type(parse_node_t), pointer :: pn_expr => null ()
	contains
	<<Commands: cmd reweight: TBP>>
	end type cmd_reweight_t

	@ %def cmd_reweight_t
	@ Output. Do not print the parse tree, since this may get cluttered.
	Just a message that scale, renormalization and factorization have been
	defined, respectively.
	<<Commands: cmd reweight: TBP>>=
	procedure :: write => cmd_reweight_write
	<<Commands: procedures>>=
	subroutine cmd_reweight_write (cmd, unit, indent)
	class(cmd_reweight_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "reweight expression: [defined]"
	end subroutine cmd_reweight_write

	@ %def cmd_reweight_write
	@ Compile. Simply store the parse (sub)tree.
	<<Commands: cmd reweight: TBP>>=
	procedure :: compile => cmd_reweight_compile
	<<Commands: procedures>>=
	subroutine cmd_reweight_compile (cmd, global)
	class(cmd_reweight_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_expr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_reweight_compile

	@ %def cmd_reweight_compile
	@ Instead of evaluating the expression, link the parse tree to the
	global data set, such that it is compiled and executed in the
	appropriate process context.
	<<Commands: cmd reweight: TBP>>=
	procedure :: execute => cmd_reweight_execute
	<<Commands: procedures>>=
	subroutine cmd_reweight_execute (cmd, global)
	class(cmd_reweight_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%reweight_expr => cmd%pn_expr
	end subroutine cmd_reweight_execute

	@ %def cmd_reweight_execute
	@
	\subsubsection{Alternative Simulation Setups}
	Together with simulation, we can re-evaluate event weights in the context of
	alternative setups. The [[cmd_alt_setup_t]] object is designed to hold these
	setups, which are brace-enclosed command lists. Compilation is deferred to
	the simulation environment where the setup expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_alt_setup_t
	private
	type(parse_node_p), dimension(:), allocatable :: setup
	contains
	<<Commands: cmd alt setup: TBP>>
	end type cmd_alt_setup_t

	@ %def cmd_alt_setup_t
	@ Output. Print just a message that the alternative setup list has been
	defined.
	<<Commands: cmd alt setup: TBP>>=
	procedure :: write => cmd_alt_setup_write
	<<Commands: procedures>>=
	subroutine cmd_alt_setup_write (cmd, unit, indent)
	class(cmd_alt_setup_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,I0,A)") "alt_setup: ", size (cmd%setup), " entries"
	end subroutine cmd_alt_setup_write

	@ %def cmd_alt_setup_write
	@ Compile. Store the parse sub-trees in an array.
	<<Commands: cmd alt setup: TBP>>=
	procedure :: compile => cmd_alt_setup_compile
	<<Commands: procedures>>=
	subroutine cmd_alt_setup_compile (cmd, global)
	class(cmd_alt_setup_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_list, pn_setup
	integer :: i
	pn_list => parse_node_get_sub_ptr (cmd%pn, 3)
	if (associated (pn_list)) then
	allocate (cmd%setup (parse_node_get_n_sub (pn_list)))
	i = 1
	pn_setup => parse_node_get_sub_ptr (pn_list)
	do while (associated (pn_setup))
	cmd%setup(i)%ptr => pn_setup
	i = i + 1
	pn_setup => parse_node_get_next_ptr (pn_setup)
	end do
	else
	allocate (cmd%setup (0))
	end if
	end subroutine cmd_alt_setup_compile

	@ %def cmd_alt_setup_compile
	@ Execute. Transfer the array of command lists to the global environment.
	<<Commands: cmd alt setup: TBP>>=
	procedure :: execute => cmd_alt_setup_execute
	<<Commands: procedures>>=
	subroutine cmd_alt_setup_execute (cmd, global)
	class(cmd_alt_setup_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (allocated (global%pn%alt_setup)) deallocate (global%pn%alt_setup)
	allocate (global%pn%alt_setup (size (cmd%setup)))
	global%pn%alt_setup = cmd%setup
	end subroutine cmd_alt_setup_execute

	@ %def cmd_alt_setup_execute
	@
	\subsubsection{Integration}
	Integrate several processes, consecutively with identical parameters.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_integrate_t
	private
	integer :: n_proc = 0
	type(string_t), dimension(:), allocatable :: process_id
	contains
	<<Commands: cmd integrate: TBP>>
	end type cmd_integrate_t

	@ %def cmd_integrate_t
	@ Output: we know the process IDs.
	<<Commands: cmd integrate: TBP>>=
	procedure :: write => cmd_integrate_write
	<<Commands: procedures>>=
	subroutine cmd_integrate_write (cmd, unit, indent)
	class(cmd_integrate_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "integrate ("
	do i = 1, cmd%n_proc
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (cmd%process_id(i))
	end do
	write (u, "(A)") ")"
	end subroutine cmd_integrate_write

	@ %def cmd_integrate_write
	@ Compile.
	<<Commands: cmd integrate: TBP>>=
	procedure :: compile => cmd_integrate_compile
	<<Commands: procedures>>=
	subroutine cmd_integrate_compile (cmd, global)
	class(cmd_integrate_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_proclist, pn_proc
	integer :: i
	pn_proclist => parse_node_get_sub_ptr (cmd%pn, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
	call cmd%compile_options (global)
	cmd%n_proc = parse_node_get_n_sub (pn_proclist)
	allocate (cmd%process_id (cmd%n_proc))
	pn_proc => parse_node_get_sub_ptr (pn_proclist)
	do i = 1, cmd%n_proc
	cmd%process_id(i) = parse_node_get_string (pn_proc)
	call global%process_stack%init_result_vars (cmd%process_id(i))
	pn_proc => parse_node_get_next_ptr (pn_proc)
	end do
	end subroutine cmd_integrate_compile

	@ %def cmd_integrate_compile
	@ Command execution. Integrate the process(es) with the predefined number
	of passes, iterations and calls. For structure functions, cuts,
	weight and scale, use local definitions if present; by default, the local
	definitions are initialized with the global ones.

	The [[integrate]] procedure should take its input from the currently
	active local environment, but produce a process record in the stack of
	the global environment.

	Since the process acquires a snapshot of the variable list, so if the global
	list (or the local one) is deleted, this does no harm. This implies that
	later changes of the variable list do not affect the stored process.
	<<Commands: cmd integrate: TBP>>=
	procedure :: execute => cmd_integrate_execute
	<<Commands: procedures>>=
	subroutine cmd_integrate_execute (cmd, global)
	class(cmd_integrate_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	integer :: i
	call msg_debug (D_CORE, "cmd_integrate_execute")
	do i = 1, cmd%n_proc
	call msg_debug (D_CORE, "cmd%process_id(i) ", cmd%process_id(i))
	call integrate_process (cmd%process_id(i), cmd%local, global)
	call global%process_stack%fill_result_vars (cmd%process_id(i))
	if (signal_is_pending ()) return
	end do
	end subroutine cmd_integrate_execute

	@ %def cmd_integrate_execute
	@
	\subsubsection{Observables}
	Declare an observable. After the declaration, it can be used to
	record data, and at the end one can retrieve average and error.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_observable_t
	private
	type(string_t) :: id
	contains
	<<Commands: cmd observable: TBP>>
	end type cmd_observable_t

	@ %def cmd_observable_t
	@ Output. We know the ID.
	<<Commands: cmd observable: TBP>>=
	procedure :: write => cmd_observable_write
	<<Commands: procedures>>=
	subroutine cmd_observable_write (cmd, unit, indent)
	class(cmd_observable_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A)") "observable: ", char (cmd%id)
	end subroutine cmd_observable_write

	@ %def cmd_observable_write
	@ Compile. Just record the observable ID.
	<<Commands: cmd observable: TBP>>=
	procedure :: compile => cmd_observable_compile
	<<Commands: procedures>>=
	subroutine cmd_observable_compile (cmd, global)
	class(cmd_observable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_tag
	pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
	if (associated (pn_tag)) then
	cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
	end if
	call cmd%compile_options (global)
	select case (char (parse_node_get_rule_key (pn_tag)))
	case ("analysis_id")
	cmd%id = parse_node_get_string (pn_tag)
	case default
	call msg_bug ("observable: name expression not implemented (yet)")
	end select
	end subroutine cmd_observable_compile

	@ %def cmd_observable_compile
	@ Command execution. This declares the observable and allocates it in
	the analysis store.
	<<Commands: cmd observable: TBP>>=
	procedure :: execute => cmd_observable_execute
	<<Commands: procedures>>=
	subroutine cmd_observable_execute (cmd, global)
	class(cmd_observable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(graph_options_t) :: graph_options
	type(string_t) :: label, unit
	var_list => cmd%local%get_var_list_ptr ()
	label = var_list%get_sval (var_str ("$obs_label"))
	unit = var_list%get_sval (var_str ("$obs_unit"))
	call graph_options_init (graph_options)
	call set_graph_options (graph_options, var_list)
	call analysis_init_observable (cmd%id, label, unit, graph_options)
	end subroutine cmd_observable_execute

	@ %def cmd_observable_execute
	@
	\subsubsection{Histograms}
	Declare a histogram. At minimum, we have to set lower and upper bound
	and bin width.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_histogram_t
	private
	type(string_t) :: id
	type(parse_node_t), pointer :: pn_lower_bound => null ()
	type(parse_node_t), pointer :: pn_upper_bound => null ()
	type(parse_node_t), pointer :: pn_bin_width => null ()
	contains
	<<Commands: cmd histogram: TBP>>
	end type cmd_histogram_t

	@ %def cmd_histogram_t
	@ Output. Just print the ID.
	<<Commands: cmd histogram: TBP>>=
	procedure :: write => cmd_histogram_write
	<<Commands: procedures>>=
	subroutine cmd_histogram_write (cmd, unit, indent)
	class(cmd_histogram_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A)") "histogram: ", char (cmd%id)
	end subroutine cmd_histogram_write

	@ %def cmd_histogram_write
	@ Compile. Record the histogram ID and initialize lower, upper bound
	and bin width.
	<<Commands: cmd histogram: TBP>>=
	procedure :: compile => cmd_histogram_compile
	<<Commands: procedures>>=
	subroutine cmd_histogram_compile (cmd, global)
	class(cmd_histogram_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_tag, pn_args, pn_arg1, pn_arg2, pn_arg3
	character(*), parameter :: e_illegal_use = &
	"illegal usage of 'histogram': insufficient number of arguments"
	pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_args => parse_node_get_next_ptr (pn_tag)
	if (associated (pn_args)) then
	pn_arg1 => parse_node_get_sub_ptr (pn_args)
	if (.not. associated (pn_arg1)) call msg_fatal (e_illegal_use)
	pn_arg2 => parse_node_get_next_ptr (pn_arg1)
	if (.not. associated (pn_arg2)) call msg_fatal (e_illegal_use)
	pn_arg3 => parse_node_get_next_ptr (pn_arg2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_args)
	end if
	call cmd%compile_options (global)
	select case (char (parse_node_get_rule_key (pn_tag)))
	case ("analysis_id")
	cmd%id = parse_node_get_string (pn_tag)
	case default
	call msg_bug ("histogram: name expression not implemented (yet)")
	end select
	cmd%pn_lower_bound => pn_arg1
	cmd%pn_upper_bound => pn_arg2
	cmd%pn_bin_width => pn_arg3
	end subroutine cmd_histogram_compile

	@ %def cmd_histogram_compile
	@ Command execution. This declares the histogram and allocates it in
	the analysis store.
	<<Commands: cmd histogram: TBP>>=
	procedure :: execute => cmd_histogram_execute
	<<Commands: procedures>>=
	subroutine cmd_histogram_execute (cmd, global)
	class(cmd_histogram_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	real(default) :: lower_bound, upper_bound, bin_width
	integer :: bin_number
	logical :: bin_width_is_used, normalize_bins
	type(string_t) :: obs_label, obs_unit
	type(graph_options_t) :: graph_options
	type(drawing_options_t) :: drawing_options

	var_list => cmd%local%get_var_list_ptr ()
	lower_bound = eval_real (cmd%pn_lower_bound, var_list)
	upper_bound = eval_real (cmd%pn_upper_bound, var_list)
	if (associated (cmd%pn_bin_width)) then
	bin_width = eval_real (cmd%pn_bin_width, var_list)
	bin_width_is_used = .true.
	else if (var_list%is_known (var_str ("n_bins"))) then
	bin_number = &
	var_list%get_ival (var_str ("n_bins"))
	bin_width_is_used = .false.
	else
	call msg_error ("Cmd '" // char (cmd%id) // &
	"': neither bin width nor number is defined")
	end if
	normalize_bins = &
	var_list%get_lval (var_str ("?normalize_bins"))
	obs_label = &
	var_list%get_sval (var_str ("$obs_label"))
	obs_unit = &
	var_list%get_sval (var_str ("$obs_unit"))

	call graph_options_init (graph_options)
	call set_graph_options (graph_options, var_list)
	call drawing_options_init_histogram (drawing_options)
	call set_drawing_options (drawing_options, var_list)

	if (bin_width_is_used) then
	call analysis_init_histogram &
	(cmd%id, lower_bound, upper_bound, bin_width, &
	normalize_bins, &
	obs_label, obs_unit, &
	graph_options, drawing_options)
	else
	call analysis_init_histogram &
	(cmd%id, lower_bound, upper_bound, bin_number, &
	normalize_bins, &
	obs_label, obs_unit, &
	graph_options, drawing_options)
	end if
	end subroutine cmd_histogram_execute

	@ %def cmd_histogram_execute
	@ Set the graph options from a variable list.
	<<Commands: procedures>>=
	subroutine set_graph_options (gro, var_list)
	type(graph_options_t), intent(inout) :: gro
	type(var_list_t), intent(in) :: var_list
	call graph_options_set (gro, title = &
	var_list%get_sval (var_str ("$title")))
	call graph_options_set (gro, description = &
	var_list%get_sval (var_str ("$description")))
	call graph_options_set (gro, x_label = &
	var_list%get_sval (var_str ("$x_label")))
	call graph_options_set (gro, y_label = &
	var_list%get_sval (var_str ("$y_label")))
	call graph_options_set (gro, width_mm = &
	var_list%get_ival (var_str ("graph_width_mm")))
	call graph_options_set (gro, height_mm = &
	var_list%get_ival (var_str ("graph_height_mm")))
	call graph_options_set (gro, x_log = &
	var_list%get_lval (var_str ("?x_log")))
	call graph_options_set (gro, y_log = &
	var_list%get_lval (var_str ("?y_log")))
	if (var_list%is_known (var_str ("x_min"))) &
	call graph_options_set (gro, x_min = &
	var_list%get_rval (var_str ("x_min")))
	if (var_list%is_known (var_str ("x_max"))) &
	call graph_options_set (gro, x_max = &
	var_list%get_rval (var_str ("x_max")))
	if (var_list%is_known (var_str ("y_min"))) &
	call graph_options_set (gro, y_min = &
	var_list%get_rval (var_str ("y_min")))
	if (var_list%is_known (var_str ("y_max"))) &
	call graph_options_set (gro, y_max = &
	var_list%get_rval (var_str ("y_max")))
	call graph_options_set (gro, gmlcode_bg = &
	var_list%get_sval (var_str ("$gmlcode_bg")))
	call graph_options_set (gro, gmlcode_fg = &
	var_list%get_sval (var_str ("$gmlcode_fg")))
	end subroutine set_graph_options

	@ %def set_graph_options
	@ Set the drawing options from a variable list.
	<<Commands: procedures>>=
	subroutine set_drawing_options (dro, var_list)
	type(drawing_options_t), intent(inout) :: dro
	type(var_list_t), intent(in) :: var_list
	if (var_list%is_known (var_str ("?draw_histogram"))) then
	if (var_list%get_lval (var_str ("?draw_histogram"))) then
	call drawing_options_set (dro, with_hbars = .true.)
	else
	call drawing_options_set (dro, with_hbars = .false., &
	with_base = .false., fill = .false., piecewise = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("?draw_base"))) then
	if (var_list%get_lval (var_str ("?draw_base"))) then
	call drawing_options_set (dro, with_base = .true.)
	else
	call drawing_options_set (dro, with_base = .false., fill = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("?draw_piecewise"))) then
	if (var_list%get_lval (var_str ("?draw_piecewise"))) then
	call drawing_options_set (dro, piecewise = .true.)
	else
	call drawing_options_set (dro, piecewise = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("?fill_curve"))) then
	if (var_list%get_lval (var_str ("?fill_curve"))) then
	call drawing_options_set (dro, fill = .true., with_base = .true.)
	else
	call drawing_options_set (dro, fill = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("?draw_curve"))) then
	if (var_list%get_lval (var_str ("?draw_curve"))) then
	call drawing_options_set (dro, draw = .true.)
	else
	call drawing_options_set (dro, draw = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("?draw_errors"))) then
	if (var_list%get_lval (var_str ("?draw_errors"))) then
	call drawing_options_set (dro, err = .true.)
	else
	call drawing_options_set (dro, err = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("?draw_symbols"))) then
	if (var_list%get_lval (var_str ("?draw_symbols"))) then
	call drawing_options_set (dro, symbols = .true.)
	else
	call drawing_options_set (dro, symbols = .false.)
	end if
	end if
	if (var_list%is_known (var_str ("$fill_options"))) then
	call drawing_options_set (dro, fill_options = &
	var_list%get_sval (var_str ("$fill_options")))
	end if
	if (var_list%is_known (var_str ("$draw_options"))) then
	call drawing_options_set (dro, draw_options = &
	var_list%get_sval (var_str ("$draw_options")))
	end if
	if (var_list%is_known (var_str ("$err_options"))) then
	call drawing_options_set (dro, err_options = &
	var_list%get_sval (var_str ("$err_options")))
	end if
	if (var_list%is_known (var_str ("$symbol"))) then
	call drawing_options_set (dro, symbol = &
	var_list%get_sval (var_str ("$symbol")))
	end if
	if (var_list%is_known (var_str ("$gmlcode_bg"))) then
	call drawing_options_set (dro, gmlcode_bg = &
	var_list%get_sval (var_str ("$gmlcode_bg")))
	end if
	if (var_list%is_known (var_str ("$gmlcode_fg"))) then
	call drawing_options_set (dro, gmlcode_fg = &
	var_list%get_sval (var_str ("$gmlcode_fg")))
	end if
	end subroutine set_drawing_options

	@ %def set_drawing_options
	@
	\subsubsection{Plots}
	Declare a plot. No mandatory arguments, just options.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_plot_t
	private
	type(string_t) :: id
	contains
	<<Commands: cmd plot: TBP>>
	end type cmd_plot_t

	@ %def cmd_plot_t
	@ Output. Just print the ID.
	<<Commands: cmd plot: TBP>>=
	procedure :: write => cmd_plot_write
	<<Commands: procedures>>=
	subroutine cmd_plot_write (cmd, unit, indent)
	class(cmd_plot_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A)") "plot: ", char (cmd%id)
	end subroutine cmd_plot_write

	@ %def cmd_plot_write
	@ Compile. Record the plot ID and initialize lower, upper bound
	and bin width.
	<<Commands: cmd plot: TBP>>=
	procedure :: compile => cmd_plot_compile
	<<Commands: procedures>>=
	subroutine cmd_plot_compile (cmd, global)
	class(cmd_plot_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_tag
	pn_tag => parse_node_get_sub_ptr (cmd%pn, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
	call cmd%init (pn_tag, global)
	end subroutine cmd_plot_compile

	@ %def cmd_plot_compile
	@ This init routine is separated because it is reused below for graph
	initialization.
	<<Commands: cmd plot: TBP>>=
	procedure :: init => cmd_plot_init
	<<Commands: procedures>>=
	subroutine cmd_plot_init (plot, pn_tag, global)
	class(cmd_plot_t), intent(inout) :: plot
	type(parse_node_t), intent(in), pointer :: pn_tag
	type(rt_data_t), intent(inout), target :: global
	call plot%compile_options (global)
	select case (char (parse_node_get_rule_key (pn_tag)))
	case ("analysis_id")
	plot%id = parse_node_get_string (pn_tag)
	case default
	call msg_bug ("plot: name expression not implemented (yet)")
	end select
	end subroutine cmd_plot_init

	@ %def cmd_plot_init
	@ Command execution. This declares the plot and allocates it in
	the analysis store.
	<<Commands: cmd plot: TBP>>=
	procedure :: execute => cmd_plot_execute
	<<Commands: procedures>>=
	subroutine cmd_plot_execute (cmd, global)
	class(cmd_plot_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(graph_options_t) :: graph_options
	type(drawing_options_t) :: drawing_options

	var_list => cmd%local%get_var_list_ptr ()
	call graph_options_init (graph_options)
	call set_graph_options (graph_options, var_list)
	call drawing_options_init_plot (drawing_options)
	call set_drawing_options (drawing_options, var_list)

	call analysis_init_plot (cmd%id, graph_options, drawing_options)
	end subroutine cmd_plot_execute

	@ %def cmd_plot_execute
	@
	\subsubsection{Graphs}
	Declare a graph. The graph is defined in terms of its contents. Both the
	graph and its contents may carry options.

	The graph object contains its own ID as well as the IDs of its elements. For
	the elements, we reuse the [[cmd_plot_t]] defined above.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_graph_t
	private
	type(string_t) :: id
	integer :: n_elements = 0
	type(cmd_plot_t), dimension(:), allocatable :: el
	type(string_t), dimension(:), allocatable :: element_id
	contains
	<<Commands: cmd graph: TBP>>
	end type cmd_graph_t

	@ %def cmd_graph_t
	@ Output. Just print the ID.
	<<Commands: cmd graph: TBP>>=
	procedure :: write => cmd_graph_write
	<<Commands: procedures>>=
	subroutine cmd_graph_write (cmd, unit, indent)
	class(cmd_graph_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,A,A,I0,A)") "graph: ", char (cmd%id), &
	" (", cmd%n_elements, " entries)"
	end subroutine cmd_graph_write

	@ %def cmd_graph_write
	@ Compile. Record the graph ID and initialize lower, upper bound
	and bin width. For compiling the graph element syntax, we use part of the
	[[cmd_plot_t]] compiler.

	Note: currently, we do not respect options, therefore just IDs on the RHS.
	<<Commands: cmd graph: TBP>>=
	procedure :: compile => cmd_graph_compile
	<<Commands: procedures>>=
	subroutine cmd_graph_compile (cmd, global)
	class(cmd_graph_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_term, pn_tag, pn_def, pn_app
	integer :: i

	pn_term => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_tag => parse_node_get_sub_ptr (pn_term)
	cmd%pn_opt => parse_node_get_next_ptr (pn_tag)
	call cmd%compile_options (global)
	select case (char (parse_node_get_rule_key (pn_tag)))
	case ("analysis_id")
	cmd%id = parse_node_get_string (pn_tag)
	case default
	call msg_bug ("graph: name expression not implemented (yet)")
	end select
	pn_def => parse_node_get_next_ptr (pn_term, 2)
	cmd%n_elements = parse_node_get_n_sub (pn_def)
	allocate (cmd%element_id (cmd%n_elements))
	allocate (cmd%el (cmd%n_elements))
	pn_term => parse_node_get_sub_ptr (pn_def)
	pn_tag => parse_node_get_sub_ptr (pn_term)
	cmd%el(1)%pn_opt => parse_node_get_next_ptr (pn_tag)
	call cmd%el(1)%init (pn_tag, global)
	cmd%element_id(1) = parse_node_get_string (pn_tag)
	pn_app => parse_node_get_next_ptr (pn_term)
	do i = 2, cmd%n_elements
	pn_term => parse_node_get_sub_ptr (pn_app, 2)
	pn_tag => parse_node_get_sub_ptr (pn_term)
	cmd%el(i)%pn_opt => parse_node_get_next_ptr (pn_tag)
	call cmd%el(i)%init (pn_tag, global)
	cmd%element_id(i) = parse_node_get_string (pn_tag)
	pn_app => parse_node_get_next_ptr (pn_app)
	end do

	end subroutine cmd_graph_compile

	@ %def cmd_graph_compile
	@ Command execution. This declares the graph, allocates it in
	the analysis store, and copies the graph elements.

	For the graph, we set graph and default drawing options. For the elements, we
	reset individual drawing options.

	This accesses internals of the contained elements of type [[cmd_plot_t]], see
	above. We might disentangle such an interdependency when this code is
	rewritten using proper type extension.
	<<Commands: cmd graph: TBP>>=
	procedure :: execute => cmd_graph_execute
	<<Commands: procedures>>=
	subroutine cmd_graph_execute (cmd, global)
	class(cmd_graph_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(graph_options_t) :: graph_options
	type(drawing_options_t) :: drawing_options
	integer :: i, type

	var_list => cmd%local%get_var_list_ptr ()
	call graph_options_init (graph_options)
	call set_graph_options (graph_options, var_list)
	call analysis_init_graph (cmd%id, cmd%n_elements, graph_options)

	do i = 1, cmd%n_elements
	if (associated (cmd%el(i)%options)) then
	call cmd%el(i)%options%execute (cmd%el(i)%local)
	end if
	type = analysis_store_get_object_type (cmd%element_id(i))
	select case (type)
	case (AN_HISTOGRAM)
	call drawing_options_init_histogram (drawing_options)
	case (AN_PLOT)
	call drawing_options_init_plot (drawing_options)
	end select
	call set_drawing_options (drawing_options, var_list)
	if (associated (cmd%el(i)%options)) then
	call set_drawing_options (drawing_options, cmd%el(i)%local%var_list)
	end if
	call analysis_fill_graph (cmd%id, i, cmd%element_id(i), drawing_options)
	end do
	end subroutine cmd_graph_execute

	@ %def cmd_graph_execute
	@
	\subsubsection{Analysis}
	Hold the analysis ID either as a string or as an expression:
	<<Commands: types>>=
	type :: analysis_id_t
	type(string_t) :: tag
	type(parse_node_t), pointer :: pn_sexpr => null ()
	end type analysis_id_t

	@ %def analysis_id_t
	@ Define the analysis expression. We store the parse tree for the
	right-hand side instead of compiling it. Compilation is deferred to
	the process environment where the analysis expression is used.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_analysis_t
	private
	type(parse_node_t), pointer :: pn_lexpr => null ()
	contains
	<<Commands: cmd analysis: TBP>>
	end type cmd_analysis_t

	@ %def cmd_analysis_t
	@ Output. Print just a message that analysis has been defined.
	<<Commands: cmd analysis: TBP>>=
	procedure :: write => cmd_analysis_write
	<<Commands: procedures>>=
	subroutine cmd_analysis_write (cmd, unit, indent)
	class(cmd_analysis_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "analysis: [defined]"
	end subroutine cmd_analysis_write

	@ %def cmd_analysis_write
	@ Compile. Simply store the parse (sub)tree.
	<<Commands: cmd analysis: TBP>>=
	procedure :: compile => cmd_analysis_compile
	<<Commands: procedures>>=
	subroutine cmd_analysis_compile (cmd, global)
	class(cmd_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 3)
	end subroutine cmd_analysis_compile

	@ %def cmd_analysis_compile
	@ Instead of evaluating the cut expression, link the parse tree to the
	global data set, such that it is compiled and executed in the
	appropriate process context.
	<<Commands: cmd analysis: TBP>>=
	procedure :: execute => cmd_analysis_execute
	<<Commands: procedures>>=
	subroutine cmd_analysis_execute (cmd, global)
	class(cmd_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	global%pn%analysis_lexpr => cmd%pn_lexpr
	end subroutine cmd_analysis_execute

	@ %def cmd_analysis_execute
	@
	\subsubsection{Write histograms and plots}
	The data type encapsulating the command:
	<<Commands: types>>=
	type, extends (command_t) :: cmd_write_analysis_t
	private
	type(analysis_id_t), dimension(:), allocatable :: id
	type(string_t), dimension(:), allocatable :: tag
	contains
	<<Commands: cmd write analysis: TBP>>
	end type cmd_write_analysis_t

	@ %def analysis_id_t
	@ %def cmd_write_analysis_t
	@ Output. Just the keyword.
	<<Commands: cmd write analysis: TBP>>=
	procedure :: write => cmd_write_analysis_write
	<<Commands: procedures>>=
	subroutine cmd_write_analysis_write (cmd, unit, indent)
	class(cmd_write_analysis_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "write_analysis"
	end subroutine cmd_write_analysis_write

	@ %def cmd_write_analysis_write
	@ Compile.
	<<Commands: cmd write analysis: TBP>>=
	procedure :: compile => cmd_write_analysis_compile
	<<Commands: procedures>>=
	subroutine cmd_write_analysis_compile (cmd, global)
	class(cmd_write_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_clause, pn_args, pn_id
	integer :: n, i
	pn_clause => parse_node_get_sub_ptr (cmd%pn)
	pn_args => parse_node_get_sub_ptr (pn_clause, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_clause)
	call cmd%compile_options (global)
	if (associated (pn_args)) then
	n = parse_node_get_n_sub (pn_args)
	allocate (cmd%id (n))
	do i = 1, n
	pn_id => parse_node_get_sub_ptr (pn_args, i)
	if (char (parse_node_get_rule_key (pn_id)) == "analysis_id") then
	cmd%id(i)%tag = parse_node_get_string (pn_id)
	else
	cmd%id(i)%pn_sexpr => pn_id
	end if
	end do
	else
	allocate (cmd%id (0))
	end if
	end subroutine cmd_write_analysis_compile

	@ %def cmd_write_analysis_compile
	@ The output format for real data values:
	<<Commands: parameters>>=
	character(*), parameter, public :: &
	DEFAULT_ANALYSIS_FILENAME = "whizard_analysis.dat"
	character(len=1), dimension(2), parameter, public :: &
	FORBIDDEN_ENDINGS1 = [ "o", "a" ]
	character(len=2), dimension(5), parameter, public :: &
	FORBIDDEN_ENDINGS2 = [ "mp", "ps", "vg", "lo", "la" ]
	character(len=3), dimension(16), parameter, public :: &
	FORBIDDEN_ENDINGS3 = [ "aux", "dvi", "evt", "evx", "f03", "f90", &
	"f95", "log", "ltp", "mpx", "olc", "olp", "pdf", "phs", "sin", "tex" ]

	@ %def DEFAULT_ANALYSIS_FILENAME
	@ %def FORBIDDEN_ENDINGS1
	@ %def FORBIDDEN_ENDINGS2
	@ %def FORBIDDEN_ENDINGS3
	@ As this contains a lot of similar code to [[cmd_compile_analysis_execute]]
	we outsource the main code to a subroutine.
	<<Commands: cmd write analysis: TBP>>=
	procedure :: execute => cmd_write_analysis_execute
	<<Commands: procedures>>=
	subroutine cmd_write_analysis_execute (cmd, global)
	class(cmd_write_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	var_list => cmd%local%get_var_list_ptr ()
	call write_analysis_wrap (var_list, global%out_files, &
	cmd%id, tag = cmd%tag)
	end subroutine cmd_write_analysis_execute

	@ %def cmd_write_analysis_execute
	@ If the [[data_file]] optional argument is present, this is
	called from [[cmd_compile_analysis_execute]], which needs the file name for
	further processing, and requires the default format. For the moment,
	parameters and macros for custom data processing are disabled.
	<<Commands: procedures>>=
	subroutine write_analysis_wrap (var_list, out_files, id, tag, data_file)
	type(var_list_t), intent(inout), target :: var_list
	type(file_list_t), intent(inout), target :: out_files
	type(analysis_id_t), dimension(:), intent(in), target :: id
	type(string_t), dimension(:), allocatable, intent(out) :: tag
	type(string_t), intent(out), optional :: data_file
	type(string_t) :: defaultfile, file
	integer :: i
	logical :: keep_open !, custom, header, columns
	type(string_t) :: extension !, comment_prefix, separator
	!!! JRR: WK please check (#542)
	! integer :: type
	! type(ifile_t) :: ifile
	logical :: one_file !, has_writer
	! type(analysis_iterator_t) :: iterator
	! type(rt_data_t), target :: sandbox
	! type(command_list_t) :: writer
	defaultfile = var_list%get_sval (var_str ("$out_file"))
	if (present (data_file)) then
	if (defaultfile == "" .or. defaultfile == ".") then
	defaultfile = DEFAULT_ANALYSIS_FILENAME
	else
	if (scan (".", defaultfile) > 0) then
	call split (defaultfile, extension, ".", back=.true.)
	if (any (lower_case (char(extension)) == FORBIDDEN_ENDINGS1) .or. &
	any (lower_case (char(extension)) == FORBIDDEN_ENDINGS2) .or. &
	any (lower_case (char(extension)) == FORBIDDEN_ENDINGS3)) &
	call msg_fatal ("The ending " // char(extension) // &
	" is internal and not allowed as data file.")
	if (extension /= "") then
	if (defaultfile /= "") then
	defaultfile = defaultfile // "." // extension
	else
	defaultfile = "whizard_analysis." // extension
	end if
	else
	defaultfile = defaultfile // ".dat"
	endif
	else
	defaultfile = defaultfile // ".dat"
	end if
	end if
	data_file = defaultfile
	end if
	one_file = defaultfile /= ""
	if (one_file) then
	file = defaultfile
	keep_open = file_list_is_open (out_files, file, &
	action = "write")
	if (keep_open) then
	if (present (data_file)) then
	call msg_fatal ("Compiling analysis: File '" &
	// char (data_file) &
	// "' can't be used, it is already open.")
	else
	call msg_message ("Appending analysis data to file '" &
	// char (file) // "'")
	end if
	else
	call file_list_open (out_files, file, &
	action = "write", status = "replace", position = "asis")
	call msg_message ("Writing analysis data to file '" &
	// char (file) // "'")
	end if
	end if

	!!! JRR: WK please check. Custom data output. Ticket #542
	! if (present (data_file)) then
	! custom = .false.
	! else
	! custom = var_list%get_lval (&
	! var_str ("?out_custom"))
	! end if
	! comment_prefix = var_list%get_sval (&
	! var_str ("$out_comment"))
	! header = var_list%get_lval (&
	! var_str ("?out_header"))
	! write_yerr = var_list%get_lval (&
	! var_str ("?out_yerr"))
	! write_xerr = var_list%get_lval (&
	! var_str ("?out_xerr"))

	call get_analysis_tags (tag, id, var_list)
	do i = 1, size (tag)
	call file_list_write_analysis &
	(out_files, file, tag(i))
	end do
	if (one_file .and. .not. keep_open) then
	call file_list_close (out_files, file)
	end if

	contains

	subroutine get_analysis_tags (analysis_tag, id, var_list)
	type(string_t), dimension(:), intent(out), allocatable :: analysis_tag
	type(analysis_id_t), dimension(:), intent(in) :: id
	type(var_list_t), intent(in), target :: var_list
	if (size (id) /= 0) then
	allocate (analysis_tag (size (id)))
	do i = 1, size (id)
	if (associated (id(i)%pn_sexpr)) then
	analysis_tag(i) = eval_string (id(i)%pn_sexpr, var_list)
	else
	analysis_tag(i) = id(i)%tag
	end if
	end do
	else
	call analysis_store_get_ids (tag)
	end if
	end subroutine get_analysis_tags

	end subroutine write_analysis_wrap

	@ %def write_analysis_wrap
	\subsubsection{Compile analysis results}
	This command writes files in a form suitable for GAMELAN and executes the
	appropriate commands to compile them. The first part is identical to
	[[cmd_write_analysis]].
	<<Commands: types>>=
	type, extends (command_t) :: cmd_compile_analysis_t
	private
	type(analysis_id_t), dimension(:), allocatable :: id
	type(string_t), dimension(:), allocatable :: tag
	contains
	<<Commands: cmd compile analysis: TBP>>
	end type cmd_compile_analysis_t

	@ %def cmd_compile_analysis_t
	@ Output. Just the keyword.
	<<Commands: cmd compile analysis: TBP>>=
	procedure :: write => cmd_compile_analysis_write
	<<Commands: procedures>>=
	subroutine cmd_compile_analysis_write (cmd, unit, indent)
	class(cmd_compile_analysis_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "compile_analysis"
	end subroutine cmd_compile_analysis_write

	@ %def cmd_compile_analysis_write
	@ Compile.
	<<Commands: cmd compile analysis: TBP>>=
	procedure :: compile => cmd_compile_analysis_compile
	<<Commands: procedures>>=
	subroutine cmd_compile_analysis_compile (cmd, global)
	class(cmd_compile_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_clause, pn_args, pn_id
	integer :: n, i
	pn_clause => parse_node_get_sub_ptr (cmd%pn)
	pn_args => parse_node_get_sub_ptr (pn_clause, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_clause)
	call cmd%compile_options (global)
	if (associated (pn_args)) then
	n = parse_node_get_n_sub (pn_args)
	allocate (cmd%id (n))
	do i = 1, n
	pn_id => parse_node_get_sub_ptr (pn_args, i)
	if (char (parse_node_get_rule_key (pn_id)) == "analysis_id") then
	cmd%id(i)%tag = parse_node_get_string (pn_id)
	else
	cmd%id(i)%pn_sexpr => pn_id
	end if
	end do
	else
	allocate (cmd%id (0))
	end if
	end subroutine cmd_compile_analysis_compile

	@ %def cmd_compile_analysis_compile
	@ First write the analysis data to file, then write a GAMELAN driver and
	produce MetaPost and \TeX\ output.
	<<Commands: cmd compile analysis: TBP>>=
	procedure :: execute => cmd_compile_analysis_execute
	<<Commands: procedures>>=
	subroutine cmd_compile_analysis_execute (cmd, global)
	class(cmd_compile_analysis_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(string_t) :: file, basename, extension, driver_file, &
	makefile
	integer :: u_driver, u_makefile
	logical :: has_gmlcode, only_file
	var_list => cmd%local%get_var_list_ptr ()
	call write_analysis_wrap (var_list, &
	global%out_files, cmd%id, tag = cmd%tag, &
	data_file = file)
	basename = file
	if (scan (".", basename) > 0) then
	call split (basename, extension, ".", back=.true.)
	else
	extension = ""
	end if
	driver_file = basename // ".tex"
	makefile = basename // "_ana.makefile"
	u_driver = free_unit ()
	open (unit=u_driver, file=char(driver_file), &
	action="write", status="replace")
	if (allocated (cmd%tag)) then
	call analysis_write_driver (file, cmd%tag, unit=u_driver)
	has_gmlcode = analysis_has_plots (cmd%tag)
	else
	call analysis_write_driver (file, unit=u_driver)
	has_gmlcode = analysis_has_plots ()
	end if
	close (u_driver)
	u_makefile = free_unit ()
	open (unit=u_makefile, file=char(makefile), &
	action="write", status="replace")
	call analysis_write_makefile (basename, u_makefile, &
	has_gmlcode, global%os_data)
	close (u_makefile)
	call msg_message ("Compiling analysis results display in '" &
	// char (driver_file) // "'")
	call msg_message ("Providing analysis steering makefile '" &
	// char (makefile) // "'")
	only_file = global%var_list%get_lval &
	(var_str ("?analysis_file_only"))
	if (.not. only_file) call analysis_compile_tex &
	(basename, has_gmlcode, global%os_data)
	end subroutine cmd_compile_analysis_execute

	@ %def cmd_compile_analysis_execute
	@
	\subsection{User-controlled output to data files}

	\subsubsection{Open file (output)}
	Open a file for output.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_open_out_t
	private
	type(parse_node_t), pointer :: file_expr => null ()
	contains
	<<Commands: cmd open out: TBP>>
	end type cmd_open_out_t

	@ %def cmd_open_out
	@ Finalizer for the embedded eval tree.
	<<Commands: procedures>>=
	subroutine cmd_open_out_final (object)
	class(cmd_open_out_t), intent(inout) :: object
	end subroutine cmd_open_out_final

	@ %def cmd_open_out_final
	@ Output (trivial here).
	<<Commands: cmd open out: TBP>>=
	procedure :: write => cmd_open_out_write
	<<Commands: procedures>>=
	subroutine cmd_open_out_write (cmd, unit, indent)
	class(cmd_open_out_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "open_out: <filename>"
	end subroutine cmd_open_out_write

	@ %def cmd_open_out_write
	@ Compile: create an eval tree for the filename expression.
	<<Commands: cmd open out: TBP>>=
	procedure :: compile => cmd_open_out_compile
	<<Commands: procedures>>=
	subroutine cmd_open_out_compile (cmd, global)
	class(cmd_open_out_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	cmd%file_expr => parse_node_get_sub_ptr (cmd%pn, 2)
	if (associated (cmd%file_expr)) then
	cmd%pn_opt => parse_node_get_next_ptr (cmd%file_expr)
	end if
	call cmd%compile_options (global)
	end subroutine cmd_open_out_compile

	@ %def cmd_open_out_compile
	@ Execute: append the file to the global list of open files.
	<<Commands: cmd open out: TBP>>=
	procedure :: execute => cmd_open_out_execute
	<<Commands: procedures>>=
	subroutine cmd_open_out_execute (cmd, global)
	class(cmd_open_out_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(eval_tree_t) :: file_expr
	type(string_t) :: file
	var_list => cmd%local%get_var_list_ptr ()
	call file_expr%init_sexpr (cmd%file_expr, var_list)
	call file_expr%evaluate ()
	if (file_expr%is_known ()) then
	file = file_expr%get_string ()
	call file_list_open (global%out_files, file, &
	action = "write", status = "replace", position = "asis")
	else
	call msg_fatal ("open_out: file name argument evaluates to unknown")
	end if
	call file_expr%final ()
	end subroutine cmd_open_out_execute

	@ %def cmd_open_out_execute

	\subsubsection{Open file (output)}
	Close an output file. Except for the [[execute]] method, everything is
	analogous to the open command, so we can just inherit.
	<<Commands: types>>=
	type, extends (cmd_open_out_t) :: cmd_close_out_t
	private
	contains
	<<Commands: cmd close out: TBP>>
	end type cmd_close_out_t

	@ %def cmd_close_out
	@ Execute: remove the file from the global list of output files.
	<<Commands: cmd close out: TBP>>=
	procedure :: execute => cmd_close_out_execute
	<<Commands: procedures>>=
	subroutine cmd_close_out_execute (cmd, global)
	class(cmd_close_out_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(eval_tree_t) :: file_expr
	type(string_t) :: file
	var_list => cmd%local%var_list
	call file_expr%init_sexpr (cmd%file_expr, var_list)
	call file_expr%evaluate ()
	if (file_expr%is_known ()) then
	file = file_expr%get_string ()
	call file_list_close (global%out_files, file)
	else
	call msg_fatal ("close_out: file name argument evaluates to unknown")
	end if
	call file_expr%final ()
	end subroutine cmd_close_out_execute

	@ %def cmd_close_out_execute
	@
	\subsection{Print custom-formatted values}
	<<Commands: types>>=
	type, extends (command_t) :: cmd_printf_t
	private
	type(parse_node_t), pointer :: sexpr => null ()
	type(parse_node_t), pointer :: sprintf_fun => null ()
	type(parse_node_t), pointer :: sprintf_clause => null ()
	type(parse_node_t), pointer :: sprintf => null ()
	contains
	<<Commands: cmd printf: TBP>>
	end type cmd_printf_t

	@ %def cmd_printf_t
	@ Finalize.
	<<Commands: cmd printf: TBP>>=
	procedure :: final => cmd_printf_final
	<<Commands: procedures>>=
	subroutine cmd_printf_final (cmd)
	class(cmd_printf_t), intent(inout) :: cmd
	call parse_node_final (cmd%sexpr, recursive = .false.)
	deallocate (cmd%sexpr)
	call parse_node_final (cmd%sprintf_fun, recursive = .false.)
	deallocate (cmd%sprintf_fun)
	call parse_node_final (cmd%sprintf_clause, recursive = .false.)
	deallocate (cmd%sprintf_clause)
	call parse_node_final (cmd%sprintf, recursive = .false.)
	deallocate (cmd%sprintf)
	end subroutine cmd_printf_final

	@ %def cmd_printf_final
	@ Output. Do not print the parse tree, since this may get cluttered.
	Just a message that cuts have been defined.
	<<Commands: cmd printf: TBP>>=
	procedure :: write => cmd_printf_write
	<<Commands: procedures>>=
	subroutine cmd_printf_write (cmd, unit, indent)
	class(cmd_printf_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "printf:"
	end subroutine cmd_printf_write

	@ %def cmd_printf_write
	@ Compile. We create a fake parse node (subtree) with a [[sprintf]] command
	with identical arguments which can then be handled by the corresponding
	evaluation procedure.
	<<Commands: cmd printf: TBP>>=
	procedure :: compile => cmd_printf_compile
	<<Commands: procedures>>=
	subroutine cmd_printf_compile (cmd, global)
	class(cmd_printf_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_cmd, pn_clause, pn_args, pn_format
	pn_cmd => parse_node_get_sub_ptr (cmd%pn)
	pn_clause => parse_node_get_sub_ptr (pn_cmd)
	pn_format => parse_node_get_sub_ptr (pn_clause, 2)
	pn_args => parse_node_get_next_ptr (pn_clause)
	cmd%pn_opt => parse_node_get_next_ptr (pn_cmd)
	call cmd%compile_options (global)
	allocate (cmd%sexpr)
	call parse_node_create_branch (cmd%sexpr, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("sexpr")))
	allocate (cmd%sprintf_fun)
	call parse_node_create_branch (cmd%sprintf_fun, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf_fun")))
	allocate (cmd%sprintf_clause)
	call parse_node_create_branch (cmd%sprintf_clause, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf_clause")))
	allocate (cmd%sprintf)
	call parse_node_create_key (cmd%sprintf, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("sprintf")))
	call parse_node_append_sub (cmd%sprintf_clause, cmd%sprintf)
	call parse_node_append_sub (cmd%sprintf_clause, pn_format)
	call parse_node_freeze_branch (cmd%sprintf_clause)
	call parse_node_append_sub (cmd%sprintf_fun, cmd%sprintf_clause)
	if (associated (pn_args)) then
	call parse_node_append_sub (cmd%sprintf_fun, pn_args)
	end if
	call parse_node_freeze_branch (cmd%sprintf_fun)
	call parse_node_append_sub (cmd%sexpr, cmd%sprintf_fun)
	call parse_node_freeze_branch (cmd%sexpr)
	end subroutine cmd_printf_compile

	@ %def cmd_printf_compile
	@ Execute. Evaluate the string (pretending this is a [[sprintf]] expression)
	and print it.
	<<Commands: cmd printf: TBP>>=
	procedure :: execute => cmd_printf_execute
	<<Commands: procedures>>=
	subroutine cmd_printf_execute (cmd, global)
	class(cmd_printf_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(string_t) :: string, file
	type(eval_tree_t) :: sprintf_expr
	logical :: advance
	var_list => cmd%local%get_var_list_ptr ()
	advance = var_list%get_lval (&
	var_str ("?out_advance"))
	file = var_list%get_sval (&
	var_str ("$out_file"))
	call sprintf_expr%init_sexpr (cmd%sexpr, var_list)
	call sprintf_expr%evaluate ()
	if (sprintf_expr%is_known ()) then
	string = sprintf_expr%get_string ()
	if (len (file) == 0) then
	call msg_result (char (string))
	else
	call file_list_write (global%out_files, file, string, advance)
	end if
	end if
	end subroutine cmd_printf_execute

	@ %def cmd_printf_execute
	@
	\subsubsection{Record data}
	The expression syntax already contains a [[record]] keyword; this evaluates to
	a logical which is always true, but it has the side-effect of recording data
	into analysis objects. Here we define a command as an interface to this
	construct.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_record_t
	private
	type(parse_node_t), pointer :: pn_lexpr => null ()
	contains
	<<Commands: cmd record: TBP>>
	end type cmd_record_t

	@ %def cmd_record_t
	@ Output. With the compile hack below, there is nothing of interest
	to print here.
	<<Commands: cmd record: TBP>>=
	procedure :: write => cmd_record_write
	<<Commands: procedures>>=
	subroutine cmd_record_write (cmd, unit, indent)
	class(cmd_record_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)") "record"
	end subroutine cmd_record_write

	@ %def cmd_record_write
	@ Compile. This is a hack which transforms the [[record]] command
	into a [[record]] expression, which we handle in the [[expressions]]
	module.
	<<Commands: cmd record: TBP>>=
	procedure :: compile => cmd_record_compile
	<<Commands: procedures>>=
	subroutine cmd_record_compile (cmd, global)
	class(cmd_record_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_lexpr, pn_lsinglet, pn_lterm, pn_record
	call parse_node_create_branch (pn_lexpr, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("lexpr")))
	call parse_node_create_branch (pn_lsinglet, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("lsinglet")))
	call parse_node_append_sub (pn_lexpr, pn_lsinglet)
	call parse_node_create_branch (pn_lterm, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("lterm")))
	call parse_node_append_sub (pn_lsinglet, pn_lterm)
	pn_record => parse_node_get_sub_ptr (cmd%pn)
	call parse_node_append_sub (pn_lterm, pn_record)
	cmd%pn_lexpr => pn_lexpr
	end subroutine cmd_record_compile

	@ %def cmd_record_compile
	@ Command execution. Again, transfer this to the embedded expression
	and just forget the logical result.
	<<Commands: cmd record: TBP>>=
	procedure :: execute => cmd_record_execute
	<<Commands: procedures>>=
	subroutine cmd_record_execute (cmd, global)
	class(cmd_record_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	logical :: lval
	var_list => global%get_var_list_ptr ()
	lval = eval_log (cmd%pn_lexpr, var_list)
	end subroutine cmd_record_execute

	@ %def cmd_record_execute
	@
	\subsubsection{Unstable particles}
	Mark a particle as unstable. For each unstable particle, we store a
	number of decay channels and compute their respective BRs.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_unstable_t
	private
	integer :: n_proc = 0
	type(string_t), dimension(:), allocatable :: process_id
	type(parse_node_t), pointer :: pn_prt_in => null ()
	contains
	<<Commands: cmd unstable: TBP>>
	end type cmd_unstable_t

	@ %def cmd_unstable_t
	@ Output: we know the process IDs.
	<<Commands: cmd unstable: TBP>>=
	procedure :: write => cmd_unstable_write
	<<Commands: procedures>>=
	subroutine cmd_unstable_write (cmd, unit, indent)
	class(cmd_unstable_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,1x,I0,1x,A)", advance="no") &
	"unstable:", 1, "("
	do i = 1, cmd%n_proc
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (cmd%process_id(i))
	end do
	write (u, "(A)") ")"
	end subroutine cmd_unstable_write

	@ %def cmd_unstable_write
	@ Compile. Initiate an eval tree for the decaying particle and
	determine the decay channel process IDs.
	<<Commands: cmd unstable: TBP>>=
	procedure :: compile => cmd_unstable_compile
	<<Commands: procedures>>=
	subroutine cmd_unstable_compile (cmd, global)
	class(cmd_unstable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_list, pn_proc
	integer :: i
	cmd%pn_prt_in => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_list => parse_node_get_next_ptr (cmd%pn_prt_in)
	if (associated (pn_list)) then
	select case (char (parse_node_get_rule_key (pn_list)))
	case ("unstable_arg")
	cmd%n_proc = parse_node_get_n_sub (pn_list)
	cmd%pn_opt => parse_node_get_next_ptr (pn_list)
	case default
	cmd%n_proc = 0
	cmd%pn_opt => pn_list
	pn_list => null ()
	end select
	end if
	call cmd%compile_options (global)
	if (associated (pn_list)) then
	allocate (cmd%process_id (cmd%n_proc))
	pn_proc => parse_node_get_sub_ptr (pn_list)
	do i = 1, cmd%n_proc
	cmd%process_id(i) = parse_node_get_string (pn_proc)
	call cmd%local%process_stack%init_result_vars (cmd%process_id(i))
	pn_proc => parse_node_get_next_ptr (pn_proc)
	end do
	else
	allocate (cmd%process_id (0))
	end if
	end subroutine cmd_unstable_compile

	@ %def cmd_unstable_compile
	@ Command execution. Evaluate the decaying particle and mark the decays in
	the current model object.
	<<Commands: cmd unstable: TBP>>=
	procedure :: execute => cmd_unstable_execute
	<<Commands: procedures>>=
	subroutine cmd_unstable_execute (cmd, global)
	class(cmd_unstable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	logical :: auto_decays, auto_decays_radiative
	integer :: auto_decays_multiplicity
	logical :: isotropic_decay, diagonal_decay, polarized_decay
	integer :: decay_helicity
	type(pdg_array_t) :: pa_in
	integer :: pdg_in
	type(string_t) :: libname_cur, libname_dec
	type(string_t), dimension(:), allocatable :: auto_id, tmp_id
	integer :: n_proc_user
	integer :: i, u_tmp
	character(80) :: buffer
	var_list => cmd%local%get_var_list_ptr ()
	auto_decays = &
	var_list%get_lval (var_str ("?auto_decays"))
	if (auto_decays) then
	auto_decays_multiplicity = &
	var_list%get_ival (var_str ("auto_decays_multiplicity"))
	auto_decays_radiative = &
	var_list%get_lval (var_str ("?auto_decays_radiative"))
	end if
	isotropic_decay = &
	var_list%get_lval (var_str ("?isotropic_decay"))
	if (isotropic_decay) then
	diagonal_decay = .false.
	polarized_decay = .false.
	else
	diagonal_decay = &
	var_list%get_lval (var_str ("?diagonal_decay"))
	if (diagonal_decay) then
	polarized_decay = .false.
	else
	polarized_decay = &
	var_list%is_known (var_str ("decay_helicity"))
	if (polarized_decay) then
	decay_helicity = var_list%get_ival (var_str ("decay_helicity"))
	end if
	end if
	end if
	pa_in = eval_pdg_array (cmd%pn_prt_in, var_list)
	if (pdg_array_get_length (pa_in) /= 1) &
	call msg_fatal ("Unstable: decaying particle must be unique")
	pdg_in = pdg_array_get (pa_in, 1)
	n_proc_user = cmd%n_proc
	if (auto_decays) then
	call create_auto_decays (pdg_in, &
	auto_decays_multiplicity, auto_decays_radiative, &
	libname_dec, auto_id, cmd%local)
	allocate (tmp_id (cmd%n_proc + size (auto_id)))
	tmp_id(:cmd%n_proc) = cmd%process_id
	tmp_id(cmd%n_proc+1:) = auto_id
	call move_alloc (from = tmp_id, to = cmd%process_id)
	cmd%n_proc = size (cmd%process_id)
	end if
	libname_cur = cmd%local%prclib%get_name ()
	do i = 1, cmd%n_proc
	if (i == n_proc_user + 1) then
	call cmd%local%update_prclib &
	(cmd%local%prclib_stack%get_library_ptr (libname_dec))
	end if
	if (.not. global%process_stack%exists (cmd%process_id(i))) then
	call var_list%set_log &
	(var_str ("?decay_rest_frame"), .false., is_known = .true.)
	call integrate_process (cmd%process_id(i), cmd%local, global)
	call global%process_stack%fill_result_vars (cmd%process_id(i))
	end if
	end do
	call cmd%local%update_prclib &
	(cmd%local%prclib_stack%get_library_ptr (libname_cur))
	if (cmd%n_proc > 0) then
	if (polarized_decay) then
	call global%modify_particle (pdg_in, stable = .false., &
	decay = cmd%process_id, &
	isotropic_decay = .false., &
	diagonal_decay = .false., &
	decay_helicity = decay_helicity, &
	polarized = .false.)
	else
	call global%modify_particle (pdg_in, stable = .false., &
	decay = cmd%process_id, &
	isotropic_decay = isotropic_decay, &
	diagonal_decay = diagonal_decay, &
	polarized = .false.)
	end if
	u_tmp = free_unit ()
	open (u_tmp, status = "scratch", action = "readwrite")
	call show_unstable (global, pdg_in, u_tmp)
	rewind (u_tmp)
	do
	read (u_tmp, "(A)", end = 1) buffer
	write (msg_buffer, "(A)") trim (buffer)
	call msg_message ()
	end do
	1 continue
	close (u_tmp)
	else
	call err_unstable (global, pdg_in)
	end if
	end subroutine cmd_unstable_execute

	@ %def cmd_unstable_execute
	@ Show data for the current unstable particle. This is called both by
	the [[unstable]] and by the [[show]] command.
	<<Commands: procedures>>=
	subroutine show_unstable (global, pdg, u)
	type(rt_data_t), intent(in), target :: global
	integer, intent(in) :: pdg, u
	type(flavor_t) :: flv
	type(string_t), dimension(:), allocatable :: decay
	real(default), dimension(:), allocatable :: br
	real(default) :: width
	type(process_t), pointer :: process
	type(process_component_def_t), pointer :: prc_def
	type(string_t), dimension(:), allocatable :: prt_out, prt_out_str
	integer :: i, j
	logical :: opened
	call flv%init (pdg, global%model)
	call flv%get_decays (decay)
	if (.not. allocated (decay)) return
	allocate (prt_out_str (size (decay)))
	allocate (br (size (decay)))
	do i = 1, size (br)
	process => global%process_stack%get_process_ptr (decay(i))
	prc_def => process%get_component_def_ptr (1)
	call prc_def%get_prt_out (prt_out)
	prt_out_str(i) = prt_out(1)
	do j = 2, size (prt_out)
	prt_out_str(i) = prt_out_str(i) // ", " // prt_out(j)
	end do
	br(i) = process%get_integral ()
	end do
	if (all (br >= 0)) then
	if (any (br > 0)) then
	width = sum (br)
	br = br / sum (br)
	write (u, "(A)") "Unstable particle " &
	// char (flv%get_name ()) &
	// ": computed branching ratios:"
	do i = 1, size (br)
	write (u, "(2x,A,':'," // FMT_14 // ",3x,A)") &
	char (decay(i)), br(i), char (prt_out_str(i))
	end do
	write (u, "(2x,'Total width ='," // FMT_14 // ",' GeV (computed)')") width
	write (u, "(2x,' ='," // FMT_14 // ",' GeV (preset)')") &
	flv%get_width ()
	if (flv%decays_isotropically ()) then
	write (u, "(2x,A)") "Decay options: isotropic"
	else if (flv%decays_diagonal ()) then
	write (u, "(2x,A)") "Decay options: &
	&projection on diagonal helicity states"
	else if (flv%has_decay_helicity ()) then
	write (u, "(2x,A,1x,I0)") "Decay options: projection onto helicity =", &
	flv%get_decay_helicity ()
	else
	write (u, "(2x,A)") "Decay options: helicity treated exactly"
	end if
	else
	inquire (unit = u, opened = opened)
	if (opened .and. .not. mask_fatal_errors) close (u)
	call msg_fatal ("Unstable particle " &
	// char (flv%get_name ()) &
	// ": partial width vanishes for all decay channels")
	end if
	else
	inquire (unit = u, opened = opened)
	if (opened .and. .not. mask_fatal_errors) close (u)
	call msg_fatal ("Unstable particle " &
	// char (flv%get_name ()) &
	// ": partial width is negative")
	end if
	end subroutine show_unstable

	@ %def show_unstable
	@ If no decays have been found, issue a non-fatal error.
	<<Commands: procedures>>=
	subroutine err_unstable (global, pdg)
	type(rt_data_t), intent(in), target :: global
	integer, intent(in) :: pdg
	type(flavor_t) :: flv
	call flv%init (pdg, global%model)
	call msg_error ("Unstable: no allowed decays found for particle " &
	// char (flv%get_name ()) // ", keeping as stable")
	end subroutine err_unstable

	@ %def err_unstable
	@ Auto decays: create process IDs and make up process
	configurations, using the PDG codes generated by the [[ds_table]] make
	method.

	We allocate and use a self-contained process library that contains only the
	decay processes of the current particle. When done, we revert the global
	library pointer to the original library but return the name of the new one.
	The new library becomes part of the global library stack and can thus be
	referred to at any time.
	<<Commands: procedures>>=
	subroutine create_auto_decays &
	(pdg_in, mult, rad, libname_dec, process_id, global)
	integer, intent(in) :: pdg_in
	integer, intent(in) :: mult
	logical, intent(in) :: rad
	type(string_t), intent(out) :: libname_dec
	type(string_t), dimension(:), allocatable, intent(out) :: process_id
	type(rt_data_t), intent(inout) :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	type(ds_table_t) :: ds_table
	type(split_constraints_t) :: constraints
	type(pdg_array_t), dimension(:), allocatable :: pa_out
	character(80) :: buffer
	character :: p_or_a
	type(string_t) :: process_string, libname_cur
	type(flavor_t) :: flv_in, flv_out
	type(string_t) :: prt_in
	type(string_t), dimension(:), allocatable :: prt_out
	type(process_configuration_t) :: prc_config
	integer :: i, j, k
	call flv_in%init (pdg_in, global%model)
	if (rad) then
	call constraints%init (2)
	else
	call constraints%init (3)
	call constraints%set (3, constrain_radiation ())
	end if
	call constraints%set (1, constrain_n_tot (mult))
	call constraints%set (2, &
	constrain_mass_sum (flv_in%get_mass (), margin = 0._default))
	call ds_table%make (global%model, pdg_in, constraints)
	prt_in = flv_in%get_name ()
	if (pdg_in > 0) then
	p_or_a = "p"
	else
	p_or_a = "a"
	end if
	if (ds_table%get_length () == 0) then
	call msg_warning ("Auto-decays: Particle " // char (prt_in) // ": " &
	// "no decays found")
	libname_dec = ""
	allocate (process_id (0))
	else
	call msg_message ("Creating decay process library for particle " &
	// char (prt_in))
	libname_cur = global%prclib%get_name ()
	write (buffer, "(A,A,I0)") "_d", p_or_a, abs (pdg_in)
	libname_dec = libname_cur // trim (buffer)
	lib => global%prclib_stack%get_library_ptr (libname_dec)
	if (.not. (associated (lib))) then
	allocate (lib_entry)
	call lib_entry%init (libname_dec)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)
	else
	call global%update_prclib (lib)
	end if
	allocate (process_id (ds_table%get_length ()))
	do i = 1, size (process_id)
	write (buffer, "(A,'_',A,I0,'_',I0)") &
	"decay", p_or_a, abs (pdg_in), i
	process_id(i) = trim (buffer)
	process_string = process_id(i) // ": " // prt_in // " =>"
	call ds_table%get_pdg_out (i, pa_out)
	allocate (prt_out (size (pa_out)))
	do j = 1, size (pa_out)
	do k = 1, pa_out(j)%get_length ()
	call flv_out%init (pa_out(j)%get (k), global%model)
	if (k == 1) then
	prt_out(j) = flv_out%get_name ()
	else
	prt_out(j) = prt_out(j) // ":" // flv_out%get_name ()
	end if
	end do
	process_string = process_string // " " // prt_out(j)
	end do
	call msg_message (char (process_string))
	call prc_config%init (process_id(i), 1, 1, global)
	!!! Causes runtime error with gfortran 4.9.1
	! call prc_config%setup_component (1, &
	! new_prt_spec ([prt_in]), new_prt_spec (prt_out), global%model, global%var_list)
	!!! Workaround:
	call prc_config%setup_component (1, &
	[new_prt_spec (prt_in)], new_prt_spec (prt_out), global%model, global%var_list)
	call prc_config%record (global)
	deallocate (prt_out)
	deallocate (pa_out)
	end do
	lib => global%prclib_stack%get_library_ptr (libname_cur)
	call global%update_prclib (lib)
	end if
	call ds_table%final ()
	end subroutine create_auto_decays

	@ %def create_auto_decays
	@
	\subsubsection{(Stable particles}
	Revert the unstable declaration for a list of particles.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_stable_t
	private
	type(parse_node_p), dimension(:), allocatable :: pn_pdg
	contains
	<<Commands: cmd stable: TBP>>
	end type cmd_stable_t

	@ %def cmd_stable_t
	@ Output: we know only the number of particles.
	<<Commands: cmd stable: TBP>>=
	procedure :: write => cmd_stable_write
	<<Commands: procedures>>=
	subroutine cmd_stable_write (cmd, unit, indent)
	class(cmd_stable_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,1x,I0)") "stable:", size (cmd%pn_pdg)
	end subroutine cmd_stable_write

	@ %def cmd_stable_write
	@ Compile. Assign parse nodes for the particle IDs.
	<<Commands: cmd stable: TBP>>=
	procedure :: compile => cmd_stable_compile
	<<Commands: procedures>>=
	subroutine cmd_stable_compile (cmd, global)
	class(cmd_stable_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_list, pn_prt
	integer :: n, i
	pn_list => parse_node_get_sub_ptr (cmd%pn, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_list)
	call cmd%compile_options (global)
	n = parse_node_get_n_sub (pn_list)
	allocate (cmd%pn_pdg (n))
	pn_prt => parse_node_get_sub_ptr (pn_list)
	i = 1
	do while (associated (pn_prt))
	cmd%pn_pdg(i)%ptr => pn_prt
	pn_prt => parse_node_get_next_ptr (pn_prt)
	i = i + 1
	end do
	end subroutine cmd_stable_compile

	@ %def cmd_stable_compile
	@ Execute: apply the modifications to the current model.
	<<Commands: cmd stable: TBP>>=
	procedure :: execute => cmd_stable_execute
	<<Commands: procedures>>=
	subroutine cmd_stable_execute (cmd, global)
	class(cmd_stable_t), intent(inout) :: cmd
	type(rt_data_t), target, intent(inout) :: global
	type(var_list_t), pointer :: var_list
	type(pdg_array_t) :: pa
	integer :: pdg
	type(flavor_t) :: flv
	integer :: i
	var_list => cmd%local%get_var_list_ptr ()
	do i = 1, size (cmd%pn_pdg)
	pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
	if (pdg_array_get_length (pa) /= 1) &
	call msg_fatal ("Stable: listed particles must be unique")
	pdg = pdg_array_get (pa, 1)
	call global%modify_particle (pdg, stable = .true., &
	isotropic_decay = .false., &
	diagonal_decay = .false., &
	polarized = .false.)
	call flv%init (pdg, cmd%local%model)
	call msg_message ("Particle " &
	// char (flv%get_name ()) &
	// " declared as stable")
	end do
	end subroutine cmd_stable_execute

	@ %def cmd_stable_execute
	@
	\subsubsection{Polarized particles}
	These commands mark particles as (un)polarized, to be applied in
	subsequent simulation passes. Since this is technically the same as
	the [[stable]] command, we take a shortcut and make this an extension,
	just overriding methods.
	<<Commands: types>>=
	type, extends (cmd_stable_t) :: cmd_polarized_t
	contains
	<<Commands: cmd polarized: TBP>>
	end type cmd_polarized_t

	type, extends (cmd_stable_t) :: cmd_unpolarized_t
	contains
	<<Commands: cmd unpolarized: TBP>>
	end type cmd_unpolarized_t

	@ %def cmd_polarized_t cmd_unpolarized_t
	@ Output: we know only the number of particles.
	<<Commands: cmd polarized: TBP>>=
	procedure :: write => cmd_polarized_write
	<<Commands: cmd unpolarized: TBP>>=
	procedure :: write => cmd_unpolarized_write
	<<Commands: procedures>>=
	subroutine cmd_polarized_write (cmd, unit, indent)
	class(cmd_polarized_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,1x,I0)") "polarized:", size (cmd%pn_pdg)
	end subroutine cmd_polarized_write

	subroutine cmd_unpolarized_write (cmd, unit, indent)
	class(cmd_unpolarized_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,1x,I0)") "unpolarized:", size (cmd%pn_pdg)
	end subroutine cmd_unpolarized_write

	@ %def cmd_polarized_write
	@ %def cmd_unpolarized_write
	@ Compile: accounted for by the base command.

	Execute: apply the modifications to the current model.
	<<Commands: cmd polarized: TBP>>=
	procedure :: execute => cmd_polarized_execute
	<<Commands: cmd unpolarized: TBP>>=
	procedure :: execute => cmd_unpolarized_execute
	<<Commands: procedures>>=
	subroutine cmd_polarized_execute (cmd, global)
	class(cmd_polarized_t), intent(inout) :: cmd
	type(rt_data_t), target, intent(inout) :: global
	type(var_list_t), pointer :: var_list
	type(pdg_array_t) :: pa
	integer :: pdg
	type(flavor_t) :: flv
	integer :: i
	var_list => cmd%local%get_var_list_ptr ()
	do i = 1, size (cmd%pn_pdg)
	pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
	if (pdg_array_get_length (pa) /= 1) &
	call msg_fatal ("Polarized: listed particles must be unique")
	pdg = pdg_array_get (pa, 1)
	call global%modify_particle (pdg, polarized = .true., &
	stable = .true., &
	isotropic_decay = .false., &
	diagonal_decay = .false.)
	call flv%init (pdg, cmd%local%model)
	call msg_message ("Particle " &
	// char (flv%get_name ()) &
	// " declared as polarized")
	end do
	end subroutine cmd_polarized_execute

	subroutine cmd_unpolarized_execute (cmd, global)
	class(cmd_unpolarized_t), intent(inout) :: cmd
	type(rt_data_t), target, intent(inout) :: global
	type(var_list_t), pointer :: var_list
	type(pdg_array_t) :: pa
	integer :: pdg
	type(flavor_t) :: flv
	integer :: i
	var_list => cmd%local%get_var_list_ptr ()
	do i = 1, size (cmd%pn_pdg)
	pa = eval_pdg_array (cmd%pn_pdg(i)%ptr, var_list)
	if (pdg_array_get_length (pa) /= 1) &
	call msg_fatal ("Unpolarized: listed particles must be unique")
	pdg = pdg_array_get (pa, 1)
	call global%modify_particle (pdg, polarized = .false., &
	stable = .true., &
	isotropic_decay = .false., &
	diagonal_decay = .false.)
	call flv%init (pdg, cmd%local%model)
	call msg_message ("Particle " &
	// char (flv%get_name ()) &
	// " declared as unpolarized")
	end do
	end subroutine cmd_unpolarized_execute

	@ %def cmd_polarized_execute
	@ %def cmd_unpolarized_execute
	@
	\subsubsection{Parameters: formats for event-sample output}
	Specify all event formats that are to be used for output files in the
	subsequent simulation run. (The raw format is on by default and can be turned
	off here.)
	<<Commands: types>>=
	type, extends (command_t) :: cmd_sample_format_t
	private
	type(string_t), dimension(:), allocatable :: format
	contains
	<<Commands: cmd sample format: TBP>>
	end type cmd_sample_format_t

	@ %def cmd_sample_format_t
	@ Output: here, everything is known.
	<<Commands: cmd sample format: TBP>>=
	procedure :: write => cmd_sample_format_write
	<<Commands: procedures>>=
	subroutine cmd_sample_format_write (cmd, unit, indent)
	class(cmd_sample_format_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "sample_format = "
	do i = 1, size (cmd%format)
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (cmd%format(i))
	end do
	write (u, "(A)")
	end subroutine cmd_sample_format_write

	@ %def cmd_sample_format_write
	@ Compile. Initialize evaluation trees.
	<<Commands: cmd sample format: TBP>>=
	procedure :: compile => cmd_sample_format_compile
	<<Commands: procedures>>=
	subroutine cmd_sample_format_compile (cmd, global)
	class(cmd_sample_format_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg
	type(parse_node_t), pointer :: pn_format
	integer :: i, n_format
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
	if (associated (pn_arg)) then
	n_format = parse_node_get_n_sub (pn_arg)
	allocate (cmd%format (n_format))
	pn_format => parse_node_get_sub_ptr (pn_arg)
	i = 0
	do while (associated (pn_format))
	i = i + 1
	cmd%format(i) = parse_node_get_string (pn_format)
	pn_format => parse_node_get_next_ptr (pn_format)
	end do
	else
	allocate (cmd%format (0))
	end if
	end subroutine cmd_sample_format_compile

	@ %def cmd_sample_format_compile
	@ Execute. Transfer the list of format specifications to the
	corresponding array in the runtime data set.
	<<Commands: cmd sample format: TBP>>=
	procedure :: execute => cmd_sample_format_execute
	<<Commands: procedures>>=
	subroutine cmd_sample_format_execute (cmd, global)
	class(cmd_sample_format_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (allocated (global%sample_fmt)) deallocate (global%sample_fmt)
	allocate (global%sample_fmt (size (cmd%format)), source = cmd%format)
	end subroutine cmd_sample_format_execute

	@ %def cmd_sample_format_execute
	@
	\subsubsection{The simulate command}
	This is the actual SINDARIN command.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_simulate_t
	! not private anymore as required by the whizard-c-interface
	integer :: n_proc = 0
	type(string_t), dimension(:), allocatable :: process_id
	contains
	<<Commands: cmd simulate: TBP>>
	end type cmd_simulate_t

	@ %def cmd_simulate_t
	@ Output: we know the process IDs.
	<<Commands: cmd simulate: TBP>>=
	procedure :: write => cmd_simulate_write
	<<Commands: procedures>>=
	subroutine cmd_simulate_write (cmd, unit, indent)
	class(cmd_simulate_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "simulate ("
	do i = 1, cmd%n_proc
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (cmd%process_id(i))
	end do
	write (u, "(A)") ")"
	end subroutine cmd_simulate_write

	@ %def cmd_simulate_write
	@ Compile. In contrast to WHIZARD 1 the confusing option to give the
	number of unweighted events for weighted events as if unweighting were
	to take place has been abandoned. (We both use [[n_events]] for
	weighted and unweighted events, the variable [[n_calls]] from WHIZARD
	1 has been discarded.
	<<Commands: cmd simulate: TBP>>=
	procedure :: compile => cmd_simulate_compile
	<<Commands: procedures>>=
	subroutine cmd_simulate_compile (cmd, global)
	class(cmd_simulate_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_proclist, pn_proc
	integer :: i
	pn_proclist => parse_node_get_sub_ptr (cmd%pn, 2)
	cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
	call cmd%compile_options (global)
	cmd%n_proc = parse_node_get_n_sub (pn_proclist)
	allocate (cmd%process_id (cmd%n_proc))
	pn_proc => parse_node_get_sub_ptr (pn_proclist)
	do i = 1, cmd%n_proc
	cmd%process_id(i) = parse_node_get_string (pn_proc)
	call global%process_stack%init_result_vars (cmd%process_id(i))
	pn_proc => parse_node_get_next_ptr (pn_proc)
	end do
	end subroutine cmd_simulate_compile

	@ %def cmd_simulate_compile
	@ Execute command: Simulate events. This is done via a [[simulation_t]]
	object and its associated methods.

	Signal handling: the [[generate]] method may exit abnormally if there is a
	pending signal. The current logic ensures that the [[es_array]] output
	channels are closed before the [[execute]] routine returns. The program will
	terminate then in [[command_list_execute]].
	<<Commands: cmd simulate: TBP>>=
	procedure :: execute => cmd_simulate_execute
	<<Commands: procedures>>=
	subroutine cmd_simulate_execute (cmd, global)
	class(cmd_simulate_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(rt_data_t), dimension(:), allocatable, target :: alt_env
	integer :: n_events, n_fmt
	type(string_t) :: sample
	logical :: rebuild_events, read_raw, write_raw
	type(simulation_t), target :: sim
	type(string_t), dimension(:), allocatable :: sample_fmt
	type(event_stream_array_t) :: es_array
	type(event_sample_data_t) :: data
	integer :: i, checkpoint, callback
	var_list => cmd%local%var_list
	if (allocated (cmd%local%pn%alt_setup)) then
	allocate (alt_env (size (cmd%local%pn%alt_setup)))
	do i = 1, size (alt_env)
	call build_alt_setup (alt_env(i), cmd%local, &
	cmd%local%pn%alt_setup(i)%ptr)
	end do
	call sim%init (cmd%process_id, .true., .true., cmd%local, global, &
	alt_env)
	else
	call sim%init (cmd%process_id, .true., .true., cmd%local, global)
	end if
	if (signal_is_pending ()) return
	if (sim%is_valid ()) then
	call sim%init_process_selector ()
	call openmp_set_num_threads_verbose &
	(var_list%get_ival (var_str ("openmp_num_threads")), &
	var_list%get_lval (var_str ("?openmp_logging")))
	call sim%compute_n_events (n_events, var_list)
	sample = var_list%get_sval (var_str ("$sample"))
	if (sample == "") sample = sim%get_default_sample_name ()
	rebuild_events = &
	var_list%get_lval (var_str ("?rebuild_events"))
	read_raw = &
	var_list%get_lval (var_str ("?read_raw")) &
	.and. .not. rebuild_events
	write_raw = &
	var_list%get_lval (var_str ("?write_raw"))
	checkpoint = &
	var_list%get_ival (var_str ("checkpoint"))
	callback = &
	var_list%get_ival (var_str ("event_callback_interval"))
	if (read_raw) then
	inquire (file = char (sample) // ".evx", exist = read_raw)
	end if
	if (allocated (cmd%local%sample_fmt)) then
	n_fmt = size (cmd%local%sample_fmt)
	else
	n_fmt = 0
	end if
	data = sim%get_data ()
	data%n_evt = n_events
	data%nlo_multiplier = sim%get_n_nlo_entries (1)
	if (read_raw) then
	allocate (sample_fmt (n_fmt))
	if (n_fmt > 0) sample_fmt = cmd%local%sample_fmt
	call es_array%init (sample, &
	sample_fmt, cmd%local, &
	data = data, &
	input = var_str ("raw"), &
	allow_switch = write_raw, &
	checkpoint = checkpoint, &
	callback = callback)
	call sim%generate (n_events, es_array)
	call es_array%final ()
	else if (write_raw) then
	allocate (sample_fmt (n_fmt + 1))
	if (n_fmt > 0) sample_fmt(:n_fmt) = cmd%local%sample_fmt
	sample_fmt(n_fmt+1) = var_str ("raw")
	call es_array%init (sample, &
	sample_fmt, cmd%local, &
	data = data, &
	checkpoint = checkpoint, &
	callback = callback)
	call sim%generate (n_events, es_array)
	call es_array%final ()
	else if (allocated (cmd%local%sample_fmt) &
	.or. checkpoint > 0 &
	.or. callback > 0) then
	allocate (sample_fmt (n_fmt))
	if (n_fmt > 0) sample_fmt = cmd%local%sample_fmt
	call es_array%init (sample, &
	sample_fmt, cmd%local, &
	data = data, &
	checkpoint = checkpoint, &
	callback = callback)
	call sim%generate (n_events, es_array)
	call es_array%final ()
	else
	call sim%generate (n_events)
	end if
	if (allocated (alt_env)) then
	do i = 1, size (alt_env)
	call alt_env(i)%local_final ()
	end do
	end if
	end if
	call sim%final ()
	end subroutine cmd_simulate_execute

	@ %def cmd_simulate_execute
	@ Build an alternative setup: the parse tree is stored in the global
	environment. We create a temporary command list to compile and execute this;
	the result is an alternative local environment [[alt_env]] which we can hand
	over to the [[simulate]] command.
	<<Commands: procedures>>=
	recursive subroutine build_alt_setup (alt_env, global, pn)
	type(rt_data_t), intent(inout), target :: alt_env
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), intent(in), target :: pn
	type(command_list_t), allocatable :: alt_options
	allocate (alt_options)
	call alt_env%local_init (global)
	call alt_env%activate ()
	call alt_options%compile (pn, alt_env)
	call alt_options%execute (alt_env)
	call alt_env%deactivate (global, keep_local = .true.)
	call alt_options%final ()
	end subroutine build_alt_setup

	@ %def build_alt_setup
	@
	\subsubsection{The rescan command}
	This is the actual SINDARIN command.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_rescan_t
	! private
	type(parse_node_t), pointer :: pn_filename => null ()
	integer :: n_proc = 0
	type(string_t), dimension(:), allocatable :: process_id
	contains
	<<Commands: cmd rescan: TBP>>
	end type cmd_rescan_t

	@ %def cmd_rescan_t
	@ Output: we know the process IDs.
	<<Commands: cmd rescan: TBP>>=
	procedure :: write => cmd_rescan_write
	<<Commands: procedures>>=
	subroutine cmd_rescan_write (cmd, unit, indent)
	class(cmd_rescan_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "rescan ("
	do i = 1, cmd%n_proc
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (cmd%process_id(i))
	end do
	write (u, "(A)") ")"
	end subroutine cmd_rescan_write

	@ %def cmd_rescan_write
	@ Compile. The command takes a suffix argument, namely the file name
	of requested event file.
	<<Commands: cmd rescan: TBP>>=
	procedure :: compile => cmd_rescan_compile
	<<Commands: procedures>>=
	subroutine cmd_rescan_compile (cmd, global)
	class(cmd_rescan_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_filename, pn_proclist, pn_proc
	integer :: i
	pn_filename => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_proclist => parse_node_get_next_ptr (pn_filename)
	cmd%pn_opt => parse_node_get_next_ptr (pn_proclist)
	call cmd%compile_options (global)
	cmd%pn_filename => pn_filename
	cmd%n_proc = parse_node_get_n_sub (pn_proclist)
	allocate (cmd%process_id (cmd%n_proc))
	pn_proc => parse_node_get_sub_ptr (pn_proclist)
	do i = 1, cmd%n_proc
	cmd%process_id(i) = parse_node_get_string (pn_proc)
	pn_proc => parse_node_get_next_ptr (pn_proc)
	end do
	end subroutine cmd_rescan_compile

	@ %def cmd_rescan_compile
	@ Execute command: Rescan events. This is done via a [[simulation_t]]
	object and its associated methods.
	<<Commands: cmd rescan: TBP>>=
	procedure :: execute => cmd_rescan_execute
	<<Commands: procedures>>=
	subroutine cmd_rescan_execute (cmd, global)
	class(cmd_rescan_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(rt_data_t), dimension(:), allocatable, target :: alt_env
	type(string_t) :: sample
	logical :: exist, write_raw, update_event, update_sqme
	type(simulation_t), target :: sim
	type(event_sample_data_t) :: input_data, data
	type(string_t) :: input_sample
	integer :: n_fmt
	type(string_t), dimension(:), allocatable :: sample_fmt
	type(string_t) :: input_format, input_ext, input_file
	type(string_t) :: lhef_extension, extension_hepmc, extension_lcio
	type(event_stream_array_t) :: es_array
	integer :: i, n_events
	var_list => cmd%local%var_list
	if (allocated (cmd%local%pn%alt_setup)) then
	allocate (alt_env (size (cmd%local%pn%alt_setup)))
	do i = 1, size (alt_env)
	call build_alt_setup (alt_env(i), cmd%local, &
	cmd%local%pn%alt_setup(i)%ptr)
	end do
	call sim%init (cmd%process_id, .false., .false., cmd%local, global, &
	alt_env)
	else
	call sim%init (cmd%process_id, .false., .false., cmd%local, global)
	end if
	call sim%compute_n_events (n_events, var_list)
	input_sample = eval_string (cmd%pn_filename, var_list)
	input_format = var_list%get_sval (&
	var_str ("$rescan_input_format"))
	sample = var_list%get_sval (var_str ("$sample"))
	if (sample == "") sample = sim%get_default_sample_name ()
	write_raw = var_list%get_lval (var_str ("?write_raw"))
	if (allocated (cmd%local%sample_fmt)) then
	n_fmt = size (cmd%local%sample_fmt)
	else
	n_fmt = 0
	end if
	if (write_raw) then
	if (sample == input_sample) then
	call msg_error ("Rescan: ?write_raw = true: " &
	// "suppressing raw event output (filename clashes with input)")
	allocate (sample_fmt (n_fmt))
	if (n_fmt > 0) sample_fmt = cmd%local%sample_fmt
	else
	allocate (sample_fmt (n_fmt + 1))
	if (n_fmt > 0) sample_fmt(:n_fmt) = cmd%local%sample_fmt
	sample_fmt(n_fmt+1) = var_str ("raw")
	end if
	else
	allocate (sample_fmt (n_fmt))
	if (n_fmt > 0) sample_fmt = cmd%local%sample_fmt
	end if
	update_event = &
	var_list%get_lval (var_str ("?update_event"))
	update_sqme = &
	var_list%get_lval (var_str ("?update_sqme"))
	if (update_event .or. update_sqme) then
	call msg_message ("Recalculating observables")
	if (update_sqme) then
	call msg_message ("Recalculating squared matrix elements")
	end if
	end if
	lhef_extension = &
	var_list%get_sval (var_str ("$lhef_extension"))
	extension_hepmc = &
	var_list%get_sval (var_str ("$extension_hepmc"))
	extension_lcio = &
	var_list%get_sval (var_str ("$extension_lcio"))
	select case (char (input_format))
	case ("raw"); input_ext = "evx"
	call cmd%local%set_log &
	(var_str ("?recover_beams"), .false., is_known=.true.)
	case ("lhef"); input_ext = lhef_extension
	case ("hepmc"); input_ext = extension_hepmc
	case default
	call msg_fatal ("rescan: input sample format '" // char (input_format) &
	// "' not supported")
	end select
	input_file = input_sample // "." // input_ext
	inquire (file = char (input_file), exist = exist)
	if (exist) then
	input_data = sim%get_data (alt = .false.)
	input_data%n_evt = n_events
	data = sim%get_data ()
	data%n_evt = n_events
	input_data%md5sum_cfg = ""
	call es_array%init (sample, &
	sample_fmt, cmd%local, data, &
	input = input_format, input_sample = input_sample, &
	input_data = input_data, &
	allow_switch = .false.)
	call sim%rescan (n_events, es_array, global = cmd%local)
	call es_array%final ()
	else
	call msg_fatal ("Rescan: event file '" &
	// char (input_file) // "' not found")
	end if
	if (allocated (alt_env)) then
	do i = 1, size (alt_env)
	call alt_env(i)%local_final ()
	end do
	end if
	call sim%final ()
	end subroutine cmd_rescan_execute

	@ %def cmd_rescan_execute
	@
	\subsubsection{Parameters: number of iterations}
	Specify number of iterations and number of calls for one integration pass.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_iterations_t
	private
	integer :: n_pass = 0
	type(parse_node_p), dimension(:), allocatable :: pn_expr_n_it
	type(parse_node_p), dimension(:), allocatable :: pn_expr_n_calls
	type(parse_node_p), dimension(:), allocatable :: pn_sexpr_adapt
	contains
	<<Commands: cmd iterations: TBP>>
	end type cmd_iterations_t

	@ %def cmd_iterations_t
	@ Output. Display the number of passes, which is known after compilation.
	<<Commands: cmd iterations: TBP>>=
	procedure :: write => cmd_iterations_write
	<<Commands: procedures>>=
	subroutine cmd_iterations_write (cmd, unit, indent)
	class(cmd_iterations_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	select case (cmd%n_pass)
	case (0)
	write (u, "(1x,A)") "iterations: [empty]"
	case (1)
	write (u, "(1x,A,I0,A)") "iterations: ", cmd%n_pass, " pass"
	case default
	write (u, "(1x,A,I0,A)") "iterations: ", cmd%n_pass, " passes"
	end select
	end subroutine cmd_iterations_write

	@ %def cmd_iterations_write
	@ Compile. Initialize evaluation trees.
	<<Commands: cmd iterations: TBP>>=
	procedure :: compile => cmd_iterations_compile
	<<Commands: procedures>>=
	subroutine cmd_iterations_compile (cmd, global)
	class(cmd_iterations_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_n_it, pn_n_calls, pn_adapt
	type(parse_node_t), pointer :: pn_it_spec, pn_calls_spec, pn_adapt_spec
	integer :: i
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
	if (associated (pn_arg)) then
	cmd%n_pass = parse_node_get_n_sub (pn_arg)
	allocate (cmd%pn_expr_n_it (cmd%n_pass))
	allocate (cmd%pn_expr_n_calls (cmd%n_pass))
	allocate (cmd%pn_sexpr_adapt (cmd%n_pass))
	pn_it_spec => parse_node_get_sub_ptr (pn_arg)
	i = 1
	do while (associated (pn_it_spec))
	pn_n_it => parse_node_get_sub_ptr (pn_it_spec)
	pn_calls_spec => parse_node_get_next_ptr (pn_n_it)
	pn_n_calls => parse_node_get_sub_ptr (pn_calls_spec, 2)
	pn_adapt_spec => parse_node_get_next_ptr (pn_calls_spec)
	if (associated (pn_adapt_spec)) then
	pn_adapt => parse_node_get_sub_ptr (pn_adapt_spec, 2)
	else
	pn_adapt => null ()
	end if
	cmd%pn_expr_n_it(i)%ptr => pn_n_it
	cmd%pn_expr_n_calls(i)%ptr => pn_n_calls
	cmd%pn_sexpr_adapt(i)%ptr => pn_adapt
	i = i + 1
	pn_it_spec => parse_node_get_next_ptr (pn_it_spec)
	end do
	else
	allocate (cmd%pn_expr_n_it (0))
	allocate (cmd%pn_expr_n_calls (0))
	end if
	end subroutine cmd_iterations_compile

	@ %def cmd_iterations_compile
	@ Execute. Evaluate the trees and transfer the results to the iteration
	list in the runtime data set.
	<<Commands: cmd iterations: TBP>>=
	procedure :: execute => cmd_iterations_execute
	<<Commands: procedures>>=
	subroutine cmd_iterations_execute (cmd, global)
	class(cmd_iterations_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	integer, dimension(cmd%n_pass) :: n_it, n_calls
	logical, dimension(cmd%n_pass) :: custom_adapt
	type(string_t), dimension(cmd%n_pass) :: adapt_code
	integer :: i
	var_list => global%get_var_list_ptr ()
	do i = 1, cmd%n_pass
	n_it(i) = eval_int (cmd%pn_expr_n_it(i)%ptr, var_list)
	n_calls(i) = &
	eval_int (cmd%pn_expr_n_calls(i)%ptr, var_list)
	if (associated (cmd%pn_sexpr_adapt(i)%ptr)) then
	adapt_code(i) = &
	eval_string (cmd%pn_sexpr_adapt(i)%ptr, &
	var_list, is_known = custom_adapt(i))
	else
	custom_adapt(i) = .false.
	end if
	end do
	call global%it_list%init (n_it, n_calls, custom_adapt, adapt_code)
	end subroutine cmd_iterations_execute

	@ %def cmd_iterations_execute
	@
	\subsubsection{Range expressions}
	We need a special type for storing and evaluating range expressions.
	<<Commands: parameters>>=
	integer, parameter :: STEP_NONE = 0
	integer, parameter :: STEP_ADD = 1
	integer, parameter :: STEP_SUB = 2
	integer, parameter :: STEP_MUL = 3
	integer, parameter :: STEP_DIV = 4
	integer, parameter :: STEP_COMP_ADD = 11
	integer, parameter :: STEP_COMP_MUL = 13
	@
	There is an abstract base type and two implementations: scan over integers and
	scan over reals.
	<<Commands: types>>=
	type, abstract :: range_t
	type(parse_node_t), pointer :: pn_expr => null ()
	type(parse_node_t), pointer :: pn_term => null ()
	type(parse_node_t), pointer :: pn_factor => null ()
	type(parse_node_t), pointer :: pn_value => null ()
	type(parse_node_t), pointer :: pn_literal => null ()
	type(parse_node_t), pointer :: pn_beg => null ()
	type(parse_node_t), pointer :: pn_end => null ()
	type(parse_node_t), pointer :: pn_step => null ()
	type(eval_tree_t) :: expr_beg
	type(eval_tree_t) :: expr_end
	type(eval_tree_t) :: expr_step
	integer :: step_mode = 0
	integer :: n_step = 0
	contains
	<<Commands: range: TBP>>
	end type range_t

	@ %def range_t
	@ These are the implementations:
	<<Commands: types>>=
	type, extends (range_t) :: range_int_t
	integer :: i_beg = 0
	integer :: i_end = 0
	integer :: i_step = 0
	contains
	<<Commands: range int: TBP>>
	end type range_int_t

	type, extends (range_t) :: range_real_t
	real(default) :: r_beg = 0
	real(default) :: r_end = 0
	real(default) :: r_step = 0
	real(default) :: lr_beg = 0
	real(default) :: lr_end = 0
	real(default) :: lr_step = 0
	contains
	<<Commands: range real: TBP>>
	end type range_real_t

	@ %def range_int_t range_real_t
	@ Finalize the allocated dummy node. The other nodes are just pointers.
	<<Commands: range: TBP>>=
	procedure :: final => range_final
	<<Commands: procedures>>=
	subroutine range_final (object)
	class(range_t), intent(inout) :: object
	if (associated (object%pn_expr)) then
	call parse_node_final (object%pn_expr, recursive = .false.)
	call parse_node_final (object%pn_term, recursive = .false.)
	call parse_node_final (object%pn_factor, recursive = .false.)
	call parse_node_final (object%pn_value, recursive = .false.)
	call parse_node_final (object%pn_literal, recursive = .false.)
	deallocate (object%pn_expr)
	deallocate (object%pn_term)
	deallocate (object%pn_factor)
	deallocate (object%pn_value)
	deallocate (object%pn_literal)
	end if
	end subroutine range_final

	@ %def range_final
	@ Output.
	<<Commands: range: TBP>>=
	procedure (range_write), deferred :: write
	procedure :: base_write => range_write
	<<Commands: range int: TBP>>=
	procedure :: write => range_int_write
	<<Commands: range real: TBP>>=
	procedure :: write => range_real_write
	<<Commands: procedures>>=
	subroutine range_write (object, unit)
	class(range_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Range specification:"
	if (associated (object%pn_expr)) then
	write (u, "(1x,A)") "Dummy value:"
	call parse_node_write_rec (object%pn_expr, u)
	end if
	if (associated (object%pn_beg)) then
	write (u, "(1x,A)") "Initial value:"
	call parse_node_write_rec (object%pn_beg, u)
	call object%expr_beg%write (u)
	if (associated (object%pn_end)) then
	write (u, "(1x,A)") "Final value:"
	call parse_node_write_rec (object%pn_end, u)
	call object%expr_end%write (u)
	if (associated (object%pn_step)) then
	write (u, "(1x,A)") "Step value:"
	call parse_node_write_rec (object%pn_step, u)
	select case (object%step_mode)
	case (STEP_ADD); write (u, "(1x,A)") "Step mode: +"
	case (STEP_SUB); write (u, "(1x,A)") "Step mode: -"
	case (STEP_MUL); write (u, "(1x,A)") "Step mode: *"
	case (STEP_DIV); write (u, "(1x,A)") "Step mode: /"
	case (STEP_COMP_ADD); write (u, "(1x,A)") "Division mode: +"
	case (STEP_COMP_MUL); write (u, "(1x,A)") "Division mode: *"
	end select
	end if
	end if
	else
	write (u, "(1x,A)") "Expressions: [undefined]"
	end if
	end subroutine range_write

	subroutine range_int_write (object, unit)
	class(range_int_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	call object%base_write (unit)
	write (u, "(1x,A)") "Range parameters:"
	write (u, "(3x,A,I0)") "i_beg = ", object%i_beg
	write (u, "(3x,A,I0)") "i_end = ", object%i_end
	write (u, "(3x,A,I0)") "i_step = ", object%i_step
	write (u, "(3x,A,I0)") "n_step = ", object%n_step
	end subroutine range_int_write

	subroutine range_real_write (object, unit)
	class(range_real_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	call object%base_write (unit)
	write (u, "(1x,A)") "Range parameters:"
	write (u, "(3x,A," // FMT_19 // ")") "r_beg = ", object%r_beg
	write (u, "(3x,A," // FMT_19 // ")") "r_end = ", object%r_end
	write (u, "(3x,A," // FMT_19 // ")") "r_step = ", object%r_end
	write (u, "(3x,A,I0)") "n_step = ", object%n_step
	end subroutine range_real_write

	@ %def range_write
	@ Initialize, given a range expression parse node. This is common to the
	implementations.
	<<Commands: range: TBP>>=
	procedure :: init => range_init
	<<Commands: procedures>>=
	subroutine range_init (range, pn)
	class(range_t), intent(out) :: range
	type(parse_node_t), intent(in), target :: pn
	type(parse_node_t), pointer :: pn_spec, pn_end, pn_step_spec, pn_op
	select case (char (parse_node_get_rule_key (pn)))
	case ("expr")
	case ("range_expr")
	range%pn_beg => parse_node_get_sub_ptr (pn)
	pn_spec => parse_node_get_next_ptr (range%pn_beg)
	if (associated (pn_spec)) then
	pn_end => parse_node_get_sub_ptr (pn_spec, 2)
	range%pn_end => pn_end
	pn_step_spec => parse_node_get_next_ptr (pn_end)
	if (associated (pn_step_spec)) then
	pn_op => parse_node_get_sub_ptr (pn_step_spec)
	range%pn_step => parse_node_get_next_ptr (pn_op)
	select case (char (parse_node_get_rule_key (pn_op)))
	case ("/+"); range%step_mode = STEP_ADD
	case ("/-"); range%step_mode = STEP_SUB
	case ("/*"); range%step_mode = STEP_MUL
	case ("//"); range%step_mode = STEP_DIV
	case ("/+/"); range%step_mode = STEP_COMP_ADD
	case ("/*/"); range%step_mode = STEP_COMP_MUL
	case default
	call range%write ()
	call msg_bug ("Range: step mode not implemented")
	end select
	else
	range%step_mode = STEP_ADD
	end if
	else
	range%step_mode = STEP_NONE
	end if
	call range%create_value_node ()
	case default
	call msg_bug ("range expression: node type '" &
	// char (parse_node_get_rule_key (pn)) &
	// "' not implemented")
	end select
	end subroutine range_init

	@ %def range_init
	@ This method manually creates a parse node (actually, a cascade of parse
	nodes) that hold a constant value as a literal. The idea is that this node is
	inserted as the right-hand side of a fake variable assignment, which is
	prepended to each scan iteration. Before the variable
	assignment is compiled and executed, we can manually reset the value of the
	literal and thus pretend that the loop variable is assigned this value.
	<<Commands: range: TBP>>=
	procedure :: create_value_node => range_create_value_node
	<<Commands: procedures>>=
	subroutine range_create_value_node (range)
	class(range_t), intent(inout) :: range
	allocate (range%pn_literal)
	allocate (range%pn_value)
	select type (range)
	type is (range_int_t)
	call parse_node_create_value (range%pn_literal, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("integer_literal")),&
	ival = 0)
	call parse_node_create_branch (range%pn_value, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("integer_value")))
	type is (range_real_t)
	call parse_node_create_value (range%pn_literal, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("real_literal")),&
	rval = 0._default)
	call parse_node_create_branch (range%pn_value, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("real_value")))
	class default
	call msg_bug ("range: create value node: type not implemented")
	end select
	call parse_node_append_sub (range%pn_value, range%pn_literal)
	call parse_node_freeze_branch (range%pn_value)
	allocate (range%pn_factor)
	call parse_node_create_branch (range%pn_factor, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("factor")))
	call parse_node_append_sub (range%pn_factor, range%pn_value)
	call parse_node_freeze_branch (range%pn_factor)
	allocate (range%pn_term)
	call parse_node_create_branch (range%pn_term, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("term")))
	call parse_node_append_sub (range%pn_term, range%pn_factor)
	call parse_node_freeze_branch (range%pn_term)
	allocate (range%pn_expr)
	call parse_node_create_branch (range%pn_expr, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("expr")))
	call parse_node_append_sub (range%pn_expr, range%pn_term)
	call parse_node_freeze_branch (range%pn_expr)
	end subroutine range_create_value_node

	@ %def range_create_value_node
	@ Compile, given an environment.
	<<Commands: range: TBP>>=
	procedure :: compile => range_compile
	<<Commands: procedures>>=
	subroutine range_compile (range, global)
	class(range_t), intent(inout) :: range
	type(rt_data_t), intent(in), target :: global
	type(var_list_t), pointer :: var_list
	var_list => global%get_var_list_ptr ()
	if (associated (range%pn_beg)) then
	call range%expr_beg%init_expr (range%pn_beg, var_list)
	if (associated (range%pn_end)) then
	call range%expr_end%init_expr (range%pn_end, var_list)
	if (associated (range%pn_step)) then
	call range%expr_step%init_expr (range%pn_step, var_list)
	end if
	end if
	end if
	end subroutine range_compile

	@ %def range_compile
	@ Evaluate: compute the actual bounds and parameters that determine the values
	that we can iterate.

	This is implementation-specific.
	<<Commands: range: TBP>>=
	procedure (range_evaluate), deferred :: evaluate
	<<Commands: interfaces>>=
	abstract interface
	subroutine range_evaluate (range)
	import
	class(range_t), intent(inout) :: range
	end subroutine range_evaluate
	end interface

	@ %def range_evaluate
	@ The version for an integer variable. If the step is subtractive, we invert
	the sign and treat it as an additive step. For a multiplicative step, the
	step must be greater than one, and the initial and final values must be of
	same sign and strictly ordered. Analogously for a division step.
	<<Commands: range int: TBP>>=
	procedure :: evaluate => range_int_evaluate
	<<Commands: procedures>>=
	subroutine range_int_evaluate (range)
	class(range_int_t), intent(inout) :: range
	integer :: ival
	if (associated (range%pn_beg)) then
	call range%expr_beg%evaluate ()
	if (range%expr_beg%is_known ()) then
	range%i_beg = range%expr_beg%get_int ()
	else
	call range%write ()
	call msg_fatal &
	("Range expression: initial value evaluates to unknown")
	end if
	if (associated (range%pn_end)) then
	call range%expr_end%evaluate ()
	if (range%expr_end%is_known ()) then
	range%i_end = range%expr_end%get_int ()
	if (associated (range%pn_step)) then
	call range%expr_step%evaluate ()
	if (range%expr_step%is_known ()) then
	range%i_step = range%expr_step%get_int ()
	select case (range%step_mode)
	case (STEP_SUB); range%i_step = - range%i_step
	end select
	else
	call range%write ()
	call msg_fatal &
	("Range expression: step value evaluates to unknown")
	end if
	else
	range%i_step = 1
	end if
	else
	call range%write ()
	call msg_fatal &
	("Range expression: final value evaluates to unknown")
	end if
	else
	range%i_end = range%i_beg
	range%i_step = 1
	end if
	select case (range%step_mode)
	case (STEP_NONE)
	range%n_step = 1
	case (STEP_ADD, STEP_SUB)
	if (range%i_step /= 0) then
	if (range%i_beg == range%i_end) then
	range%n_step = 1
	else if (sign (1, range%i_end - range%i_beg) &
	== sign (1, range%i_step)) then
	range%n_step = (range%i_end - range%i_beg) / range%i_step + 1
	else
	range%n_step = 0
	end if
	else
	call msg_fatal ("range evaluation (add): step value is zero")
	end if
	case (STEP_MUL)
	if (range%i_step > 1) then
	if (range%i_beg == range%i_end) then
	range%n_step = 1
	else if (range%i_beg == 0) then
	call msg_fatal ("range evaluation (mul): initial value is zero")
	else if (sign (1, range%i_beg) == sign (1, range%i_end) &
	.and. abs (range%i_beg) < abs (range%i_end)) then
	range%n_step = 0
	ival = range%i_beg
	do while (abs (ival) <= abs (range%i_end))
	range%n_step = range%n_step + 1
	ival = ival * range%i_step
	end do
	else
	range%n_step = 0
	end if
	else
	call msg_fatal &
	("range evaluation (mult): step value is one or less")
	end if
	case (STEP_DIV)
	if (range%i_step > 1) then
	if (range%i_beg == range%i_end) then
	range%n_step = 1
	else if (sign (1, range%i_beg) == sign (1, range%i_end) &
	.and. abs (range%i_beg) > abs (range%i_end)) then
	range%n_step = 0
	ival = range%i_beg
	do while (abs (ival) >= abs (range%i_end))
	range%n_step = range%n_step + 1
	if (ival == 0) exit
	ival = ival / range%i_step
	end do
	else
	range%n_step = 0
	end if
	else
	call msg_fatal &
	("range evaluation (div): step value is one or less")
	end if
	case (STEP_COMP_ADD)
	call msg_fatal ("range evaluation: &
	&step mode /+/ not allowed for integer variable")
	case (STEP_COMP_MUL)
	call msg_fatal ("range evaluation: &
	&step mode /*/ not allowed for integer variable")
	case default
	call range%write ()
	call msg_bug ("range evaluation: step mode not implemented")
	end select
	end if
	end subroutine range_int_evaluate

	@ %def range_int_evaluate
	@ The version for a real variable.
	<<Commands: range real: TBP>>=
	procedure :: evaluate => range_real_evaluate
	<<Commands: procedures>>=
	subroutine range_real_evaluate (range)
	class(range_real_t), intent(inout) :: range
	if (associated (range%pn_beg)) then
	call range%expr_beg%evaluate ()
	if (range%expr_beg%is_known ()) then
	range%r_beg = range%expr_beg%get_real ()
	else
	call range%write ()
	call msg_fatal &
	("Range expression: initial value evaluates to unknown")
	end if
	if (associated (range%pn_end)) then
	call range%expr_end%evaluate ()
	if (range%expr_end%is_known ()) then
	range%r_end = range%expr_end%get_real ()
	if (associated (range%pn_step)) then
	if (range%expr_step%is_known ()) then
	select case (range%step_mode)
	case (STEP_ADD, STEP_SUB, STEP_MUL, STEP_DIV)
	call range%expr_step%evaluate ()
	range%r_step = range%expr_step%get_real ()
	select case (range%step_mode)
	case (STEP_SUB); range%r_step = - range%r_step
	end select
	case (STEP_COMP_ADD, STEP_COMP_MUL)
	range%n_step = &
	max (range%expr_step%get_int (), 0)
	end select
	else
	call range%write ()
	call msg_fatal &
	("Range expression: step value evaluates to unknown")
	end if
	else
	call range%write ()
	call msg_fatal &
	("Range expression (real): step value must be provided")
	end if
	else
	call range%write ()
	call msg_fatal &
	("Range expression: final value evaluates to unknown")
	end if
	else
	range%r_end = range%r_beg
	range%r_step = 1
	end if
	select case (range%step_mode)
	case (STEP_NONE)
	range%n_step = 1
	case (STEP_ADD, STEP_SUB)
	if (range%r_step /= 0) then
	if (sign (1._default, range%r_end - range%r_beg) &
	== sign (1._default, range%r_step)) then
	range%n_step = &
	nint ((range%r_end - range%r_beg) / range%r_step + 1)
	else
	range%n_step = 0
	end if
	else
	call msg_fatal ("range evaluation (add): step value is zero")
	end if
	case (STEP_MUL)
	if (range%r_step > 1) then
	if (range%r_beg == 0 .or. range%r_end == 0) then
	call msg_fatal ("range evaluation (mul): bound is zero")
	else if (sign (1._default, range%r_beg) &
	== sign (1._default, range%r_end) &
	.and. abs (range%r_beg) <= abs (range%r_end)) then
	range%lr_beg = log (abs (range%r_beg))
	range%lr_end = log (abs (range%r_end))
	range%lr_step = log (range%r_step)
	range%n_step = nint &
	(abs ((range%lr_end - range%lr_beg) / range%lr_step) + 1)
	else
	range%n_step = 0
	end if
	else
	call msg_fatal &
	("range evaluation (mult): step value is one or less")
	end if
	case (STEP_DIV)
	if (range%r_step > 1) then
	if (range%r_beg == 0 .or. range%r_end == 0) then
	call msg_fatal ("range evaluation (div): bound is zero")
	else if (sign (1._default, range%r_beg) &
	== sign (1._default, range%r_end) &
	.and. abs (range%r_beg) >= abs (range%r_end)) then
	range%lr_beg = log (abs (range%r_beg))
	range%lr_end = log (abs (range%r_end))
	range%lr_step = -log (range%r_step)
	range%n_step = nint &
	(abs ((range%lr_end - range%lr_beg) / range%lr_step) + 1)
	else
	range%n_step = 0
	end if
	else
	call msg_fatal &
	("range evaluation (mult): step value is one or less")
	end if
	case (STEP_COMP_ADD)
	! Number of steps already known
	case (STEP_COMP_MUL)
	! Number of steps already known
	if (range%r_beg == 0 .or. range%r_end == 0) then
	call msg_fatal ("range evaluation (mul): bound is zero")
	else if (sign (1._default, range%r_beg) &
	== sign (1._default, range%r_end)) then
	range%lr_beg = log (abs (range%r_beg))
	range%lr_end = log (abs (range%r_end))
	else
	range%n_step = 0
	end if
	case default
	call range%write ()
	call msg_bug ("range evaluation: step mode not implemented")
	end select
	end if
	end subroutine range_real_evaluate

	@ %def range_real_evaluate
	@ Return the number of iterations:
	<<Commands: range: TBP>>=
	procedure :: get_n_iterations => range_get_n_iterations
	<<Commands: procedures>>=
	function range_get_n_iterations (range) result (n)
	class(range_t), intent(in) :: range
	integer :: n
	n = range%n_step
	end function range_get_n_iterations

	@ %def range_get_n_iterations
	@ Compute the value for iteration [[i]] and store it in the embedded token.
	<<Commands: range: TBP>>=
	procedure (range_set_value), deferred :: set_value
	<<Commands: interfaces>>=
	abstract interface
	subroutine range_set_value (range, i)
	import
	class(range_t), intent(inout) :: range
	integer, intent(in) :: i
	end subroutine range_set_value
	end interface

	@ %def range_set_value
	@ In the integer case, we compute the value directly for additive step. For
	multiplicative step, we perform a loop in the same way as above, where the
	number of iteration was determined.
	<<Commands: range int: TBP>>=
	procedure :: set_value => range_int_set_value
	<<Commands: procedures>>=
	subroutine range_int_set_value (range, i)
	class(range_int_t), intent(inout) :: range
	integer, intent(in) :: i
	integer :: k, ival
	select case (range%step_mode)
	case (STEP_NONE)
	ival = range%i_beg
	case (STEP_ADD, STEP_SUB)
	ival = range%i_beg + (i - 1) * range%i_step
	case (STEP_MUL)
	ival = range%i_beg
	do k = 1, i - 1
	ival = ival * range%i_step
	end do
	case (STEP_DIV)
	ival = range%i_beg
	do k = 1, i - 1
	ival = ival / range%i_step
	end do
	case default
	call range%write ()
	call msg_bug ("range iteration: step mode not implemented")
	end select
	call parse_node_set_value (range%pn_literal, ival = ival)
	end subroutine range_int_set_value

	@ %def range_int_set_value
	@ In the integer case, we compute the value directly for additive step. For
	multiplicative step, we perform a loop in the same way as above, where the
	number of iteration was determined.
	<<Commands: range real: TBP>>=
	procedure :: set_value => range_real_set_value
	<<Commands: procedures>>=
	subroutine range_real_set_value (range, i)
	class(range_real_t), intent(inout) :: range
	integer, intent(in) :: i
	real(default) :: rval, x
	select case (range%step_mode)
	case (STEP_NONE)
	rval = range%r_beg
	case (STEP_ADD, STEP_SUB, STEP_COMP_ADD)
	if (range%n_step > 1) then
	x = real (i - 1, default) / (range%n_step - 1)
	else
	x = 1._default / 2
	end if
	rval = x * range%r_end + (1 - x) * range%r_beg
	case (STEP_MUL, STEP_DIV, STEP_COMP_MUL)
	if (range%n_step > 1) then
	x = real (i - 1, default) / (range%n_step - 1)
	else
	x = 1._default / 2
	end if
	rval = sign &
	(exp (x * range%lr_end + (1 - x) * range%lr_beg), range%r_beg)
	case default
	call range%write ()
	call msg_bug ("range iteration: step mode not implemented")
	end select
	call parse_node_set_value (range%pn_literal, rval = rval)
	end subroutine range_real_set_value

	@ %def range_real_set_value
	@
	\subsubsection{Scan over parameters and other objects}
	The scan command allocates a new parse node for the variable
	assignment (the lhs). The rhs of this parse node is assigned from the
	available rhs expressions in the scan list, one at a time, so the
	compiled parse node can be prepended to the scan body.

	Note: for the integer/real range array, the obvious implementation as a
	polymorphic array is suspended because in gfortran 4.7, polymorphic arrays are
	apparently broken.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_scan_t
	private
	type(string_t) :: name
	integer :: n_values = 0
	type(parse_node_p), dimension(:), allocatable :: scan_cmd
	!!! !!! gfortran 4.7.x memory corruption
	!!! class(range_t), dimension(:), allocatable :: range
	type(range_int_t), dimension(:), allocatable :: range_int
	type(range_real_t), dimension(:), allocatable :: range_real
	contains
	<<Commands: cmd scan: TBP>>
	end type cmd_scan_t

	@ %def cmd_scan_t
	@ Finalizer.

	The auxiliary parse nodes that we have constructed have to be treated
	carefully: the embedded pointers all point to persistent objects
	somewhere else and should not be finalized, so we should not call the
	finalizer recursively.
	<<Commands: cmd scan: TBP>>=
	procedure :: final => cmd_scan_final
	<<Commands: procedures>>=
	recursive subroutine cmd_scan_final (cmd)
	class(cmd_scan_t), intent(inout) :: cmd
	type(parse_node_t), pointer :: pn_var_single, pn_decl_single
	type(string_t) :: key
	integer :: i
	if (allocated (cmd%scan_cmd)) then
	do i = 1, size (cmd%scan_cmd)
	pn_var_single => parse_node_get_sub_ptr (cmd%scan_cmd(i)%ptr)
	key = parse_node_get_rule_key (pn_var_single)
	select case (char (key))
	case ("scan_string_decl", "scan_log_decl")
	pn_decl_single => parse_node_get_sub_ptr (pn_var_single, 2)
	call parse_node_final (pn_decl_single, recursive=.false.)
	deallocate (pn_decl_single)
	end select
	call parse_node_final (pn_var_single, recursive=.false.)
	deallocate (pn_var_single)
	end do
	deallocate (cmd%scan_cmd)
	end if
	!!! !!! gfortran 4.7.x memory corruption
	!!! if (allocated (cmd%range)) then
	!!! do i = 1, size (cmd%range)
	!!! call cmd%range(i)%final ()
	!!! end do
	!!! end if
	if (allocated (cmd%range_int)) then
	do i = 1, size (cmd%range_int)
	call cmd%range_int(i)%final ()
	end do
	end if
	if (allocated (cmd%range_real)) then
	do i = 1, size (cmd%range_real)
	call cmd%range_real(i)%final ()
	end do
	end if
	end subroutine cmd_scan_final

	@ %def cmd_scan_final
	@ Output.
	<<Commands: cmd scan: TBP>>=
	procedure :: write => cmd_scan_write
	<<Commands: procedures>>=
	subroutine cmd_scan_write (cmd, unit, indent)
	class(cmd_scan_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,1x,A,1x,'(',I0,')')") "scan:", char (cmd%name), &
	cmd%n_values
	end subroutine cmd_scan_write

	@ %def cmd_scan_write
	@ Compile the scan command. We construct a new parse node that
	implements the variable assignment for a single element on the rhs,
	instead of the whole list that we get from the original parse tree.
	By simply copying the node, we copy all pointers and inherit the
	targets from the original. During execution, we should replace the
	rhs by the stored rhs pointers (the list elements), one by one, then
	(re)compile the redefined node.
	<<Commands: cmd scan: TBP>>=
	procedure :: compile => cmd_scan_compile
	<<Commands: procedures>>=
	recursive subroutine cmd_scan_compile (cmd, global)
	class(cmd_scan_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	type(parse_node_t), pointer :: pn_var, pn_body, pn_body_first
	type(parse_node_t), pointer :: pn_decl, pn_name
	type(parse_node_t), pointer :: pn_arg, pn_scan_cmd, pn_rhs
	type(parse_node_t), pointer :: pn_decl_single, pn_var_single
	type(syntax_rule_t), pointer :: var_rule_decl, var_rule
	type(string_t) :: key
	integer :: var_type
	integer :: i
	logical, parameter :: debug = .false.
	if (debug) then
	print *, "compile scan"
	call parse_node_write_rec (cmd%pn)
	end if
	pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_body => parse_node_get_next_ptr (pn_var)
	if (associated (pn_body)) then
	pn_body_first => parse_node_get_sub_ptr (pn_body)
	else
	pn_body_first => null ()
	end if
	key = parse_node_get_rule_key (pn_var)
	select case (char (key))
	case ("scan_num")
	pn_name => parse_node_get_sub_ptr (pn_var)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_num"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_int")
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_int"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_real")
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_real"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_complex")
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str("cmd_complex"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_alias")
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_alias"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_string_decl")
	pn_decl => parse_node_get_sub_ptr (pn_var, 2)
	pn_name => parse_node_get_sub_ptr (pn_decl, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule_decl => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_string"))
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_string_decl"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_log_decl")
	pn_decl => parse_node_get_sub_ptr (pn_var, 2)
	pn_name => parse_node_get_sub_ptr (pn_decl, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule_decl => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_log"))
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_log_decl"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_cuts")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_cuts"))
	cmd%name = "cuts"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_weight")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_weight"))
	cmd%name = "weight"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_scale")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_scale"))
	cmd%name = "scale"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_ren_scale")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_ren_scale"))
	cmd%name = "renormalization_scale"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_fac_scale")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_fac_scale"))
	cmd%name = "factorization_scale"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_selection")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_selection"))
	cmd%name = "selection"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_reweight")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_reweight"))
	cmd%name = "reweight"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_analysis")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_analysis"))
	cmd%name = "analysis"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_model")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_model"))
	cmd%name = "model"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_library")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_library"))
	cmd%name = "library"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case default
	call msg_bug ("scan: case '" // char (key) // "' not implemented")
	end select
	if (associated (pn_arg)) then
	cmd%n_values = parse_node_get_n_sub (pn_arg)
	end if
	var_list => global%get_var_list_ptr ()
	allocate (cmd%scan_cmd (cmd%n_values))
	select case (char (key))
	case ("scan_num")
	var_type = &
	var_list%get_type (cmd%name)
	select case (var_type)
	case (V_INT)
	!!! !!! gfortran 4.7.x memory corruption
	!!! allocate (range_int_t :: cmd%range (cmd%n_values))
	allocate (cmd%range_int (cmd%n_values))
	case (V_REAL)
	!!! !!! gfortran 4.7.x memory corruption
	!!! allocate (range_real_t :: cmd%range (cmd%n_values))
	allocate (cmd%range_real (cmd%n_values))
	case (V_CMPLX)
	call msg_fatal ("scan over complex variable not implemented")
	case (V_NONE)
	call msg_fatal ("scan: variable '" // char (cmd%name) //"' undefined")
	case default
	call msg_bug ("scan: impossible variable type")
	end select
	case ("scan_int")
	!!! !!! gfortran 4.7.x memory corruption
	!!! allocate (range_int_t :: cmd%range (cmd%n_values))
	allocate (cmd%range_int (cmd%n_values))
	case ("scan_real")
	!!! !!! gfortran 4.7.x memory corruption
	!!! allocate (range_real_t :: cmd%range (cmd%n_values))
	allocate (cmd%range_real (cmd%n_values))
	case ("scan_complex")
	call msg_fatal ("scan over complex variable not implemented")
	end select
	i = 1
	if (associated (pn_arg)) then
	pn_rhs => parse_node_get_sub_ptr (pn_arg)
	else
	pn_rhs => null ()
	end if
	do while (associated (pn_rhs))
	allocate (pn_scan_cmd)
	call parse_node_create_branch (pn_scan_cmd, &
	syntax_get_rule_ptr (syntax_cmd_list, var_str ("command_list")))
	allocate (pn_var_single)
	pn_var_single = pn_var
	call parse_node_replace_rule (pn_var_single, var_rule)
	select case (char (key))
	case ("scan_num", "scan_int", "scan_real", &
	"scan_complex", "scan_alias", &
	"scan_cuts", "scan_weight", &
	"scan_scale", "scan_ren_scale", "scan_fac_scale", &
	"scan_selection", "scan_reweight", "scan_analysis", &
	"scan_model", "scan_library")
	if (allocated (cmd%range_int)) then
	call cmd%range_int(i)%init (pn_rhs)
	!!! !!! gfortran 4.7.x memory corruption
	!!! call cmd%range_int(i)%compile (global)
	call parse_node_replace_last_sub &
	(pn_var_single, cmd%range_int(i)%pn_expr)
	else if (allocated (cmd%range_real)) then
	call cmd%range_real(i)%init (pn_rhs)
	!!! !!! gfortran 4.7.x memory corruption
	!!! call cmd%range_real(i)%compile (global)
	call parse_node_replace_last_sub &
	(pn_var_single, cmd%range_real(i)%pn_expr)
	else
	call parse_node_replace_last_sub (pn_var_single, pn_rhs)
	end if
	case ("scan_string_decl", "scan_log_decl")
	allocate (pn_decl_single)
	pn_decl_single = pn_decl
	call parse_node_replace_rule (pn_decl_single, var_rule_decl)
	call parse_node_replace_last_sub (pn_decl_single, pn_rhs)
	call parse_node_freeze_branch (pn_decl_single)
	call parse_node_replace_last_sub (pn_var_single, pn_decl_single)
	case default
	call msg_bug ("scan: case '" // char (key) &
	// "' broken")
	end select
	call parse_node_freeze_branch (pn_var_single)
	call parse_node_append_sub (pn_scan_cmd, pn_var_single)
	call parse_node_append_sub (pn_scan_cmd, pn_body_first)
	call parse_node_freeze_branch (pn_scan_cmd)
	cmd%scan_cmd(i)%ptr => pn_scan_cmd
	i = i + 1
	pn_rhs => parse_node_get_next_ptr (pn_rhs)
	end do
	if (debug) then
	do i = 1, cmd%n_values
	print *, "scan command ", i
	call parse_node_write_rec (cmd%scan_cmd(i)%ptr)
	if (allocated (cmd%range_int)) call cmd%range_int(i)%write ()
	if (allocated (cmd%range_real)) call cmd%range_real(i)%write ()
	end do
	print *, "original"
	call parse_node_write_rec (cmd%pn)
	end if
	end subroutine cmd_scan_compile

	@ %def cmd_scan_compile
	@ Execute the loop for all values in the step list. We use the
	parse trees with single variable assignment that we have stored, to
	iteratively create a local environment, execute the stored commands, and
	destroy it again. When we encounter a range object, we execute the commands
	for each value that this object provides. Computing this value has the side
	effect of modifying the rhs of the variable assignment that heads the local
	command list, directly in the local parse tree.
	<<Commands: cmd scan: TBP>>=
	procedure :: execute => cmd_scan_execute
	<<Commands: procedures>>=
	recursive subroutine cmd_scan_execute (cmd, global)
	class(cmd_scan_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(rt_data_t), allocatable :: local
	integer :: i, j
	do i = 1, cmd%n_values
	if (allocated (cmd%range_int)) then
	call cmd%range_int(i)%compile (global)
	call cmd%range_int(i)%evaluate ()
	do j = 1, cmd%range_int(i)%get_n_iterations ()
	call cmd%range_int(i)%set_value (j)
	allocate (local)
	call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
	call local%local_final ()
	deallocate (local)
	end do
	else if (allocated (cmd%range_real)) then
	call cmd%range_real(i)%compile (global)
	call cmd%range_real(i)%evaluate ()
	do j = 1, cmd%range_real(i)%get_n_iterations ()
	call cmd%range_real(i)%set_value (j)
	allocate (local)
	call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
	call local%local_final ()
	deallocate (local)
	end do
	else
	allocate (local)
	call build_alt_setup (local, global, cmd%scan_cmd(i)%ptr)
	call local%local_final ()
	deallocate (local)
	end if
	end do
	end subroutine cmd_scan_execute

	@ %def cmd_scan_execute
	@
	\subsubsection{Conditionals}
	Conditionals are implemented as a list that is compiled and evaluated
	recursively; this allows for a straightforward representation of
	[[else if]] constructs. A [[cmd_if_t]] object can hold either an
	[[else_if]] clause which is another object of this type, or an
	[[else_body]], but not both.

	If- or else-bodies are no scoping units, so all data remain global and
	no copy-in copy-out is needed.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_if_t
	private
	type(parse_node_t), pointer :: pn_if_lexpr => null ()
	type(command_list_t), pointer :: if_body => null ()
	type(cmd_if_t), dimension(:), pointer :: elsif_cmd => null ()
	type(command_list_t), pointer :: else_body => null ()
	contains
	<<Commands: cmd if: TBP>>
	end type cmd_if_t

	@ %def cmd_if_t
	@ Finalizer. There are no local options, therefore we can simply override
	the default finalizer.
	<<Commands: cmd if: TBP>>=
	procedure :: final => cmd_if_final
	<<Commands: procedures>>=
	recursive subroutine cmd_if_final (cmd)
	class(cmd_if_t), intent(inout) :: cmd
	integer :: i
	if (associated (cmd%if_body)) then
	call command_list_final (cmd%if_body)
	deallocate (cmd%if_body)
	end if
	if (associated (cmd%elsif_cmd)) then
	do i = 1, size (cmd%elsif_cmd)
	call cmd_if_final (cmd%elsif_cmd(i))
	end do
	deallocate (cmd%elsif_cmd)
	end if
	if (associated (cmd%else_body)) then
	call command_list_final (cmd%else_body)
	deallocate (cmd%else_body)
	end if
	end subroutine cmd_if_final

	@ %def cmd_if_final
	@ Output. Recursively write the command lists.
	<<Commands: cmd if: TBP>>=
	procedure :: write => cmd_if_write
	<<Commands: procedures>>=
	subroutine cmd_if_write (cmd, unit, indent)
	class(cmd_if_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, ind, i
	u = given_output_unit (unit); if (u < 0) return
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, indent)
	write (u, "(A)") "if <expr> then"
	if (associated (cmd%if_body)) then
	call cmd%if_body%write (unit, ind + 1)
	end if
	if (associated (cmd%elsif_cmd)) then
	do i = 1, size (cmd%elsif_cmd)
	call write_indent (u, indent)
	write (u, "(A)") "elsif <expr> then"
	if (associated (cmd%elsif_cmd(i)%if_body)) then
	call cmd%elsif_cmd(i)%if_body%write (unit, ind + 1)
	end if
	end do
	end if
	if (associated (cmd%else_body)) then
	call write_indent (u, indent)
	write (u, "(A)") "else"
	call cmd%else_body%write (unit, ind + 1)
	end if
	end subroutine cmd_if_write

	@ %def cmd_if_write
	@ Compile the conditional.
	<<Commands: cmd if: TBP>>=
	procedure :: compile => cmd_if_compile
	<<Commands: procedures>>=
	recursive subroutine cmd_if_compile (cmd, global)
	class(cmd_if_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_lexpr, pn_body
	type(parse_node_t), pointer :: pn_elsif_clauses, pn_cmd_elsif
	type(parse_node_t), pointer :: pn_else_clause, pn_cmd_else
	integer :: i, n_elsif
	pn_lexpr => parse_node_get_sub_ptr (cmd%pn, 2)
	cmd%pn_if_lexpr => pn_lexpr
	pn_body => parse_node_get_next_ptr (pn_lexpr, 2)
	select case (char (parse_node_get_rule_key (pn_body)))
	case ("command_list")
	allocate (cmd%if_body)
	call cmd%if_body%compile (pn_body, global)
	pn_elsif_clauses => parse_node_get_next_ptr (pn_body)
	case default
	pn_elsif_clauses => pn_body
	end select
	select case (char (parse_node_get_rule_key (pn_elsif_clauses)))
	case ("elsif_clauses")
	n_elsif = parse_node_get_n_sub (pn_elsif_clauses)
	allocate (cmd%elsif_cmd (n_elsif))
	pn_cmd_elsif => parse_node_get_sub_ptr (pn_elsif_clauses)
	do i = 1, n_elsif
	pn_lexpr => parse_node_get_sub_ptr (pn_cmd_elsif, 2)
	cmd%elsif_cmd(i)%pn_if_lexpr => pn_lexpr
	pn_body => parse_node_get_next_ptr (pn_lexpr, 2)
	if (associated (pn_body)) then
	allocate (cmd%elsif_cmd(i)%if_body)
	call cmd%elsif_cmd(i)%if_body%compile (pn_body, global)
	end if
	pn_cmd_elsif => parse_node_get_next_ptr (pn_cmd_elsif)
	end do
	pn_else_clause => parse_node_get_next_ptr (pn_elsif_clauses)
	case default
	pn_else_clause => pn_elsif_clauses
	end select
	select case (char (parse_node_get_rule_key (pn_else_clause)))
	case ("else_clause")
	pn_cmd_else => parse_node_get_sub_ptr (pn_else_clause)
	pn_body => parse_node_get_sub_ptr (pn_cmd_else, 2)
	if (associated (pn_body)) then
	allocate (cmd%else_body)
	call cmd%else_body%compile (pn_body, global)
	end if
	end select
	end subroutine cmd_if_compile

	@ %def global
	@ (Recursively) execute the condition. Context remains global in all cases.
	<<Commands: cmd if: TBP>>=
	procedure :: execute => cmd_if_execute
	<<Commands: procedures>>=
	recursive subroutine cmd_if_execute (cmd, global)
	class(cmd_if_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	logical :: lval, is_known
	integer :: i
	var_list => global%get_var_list_ptr ()
	lval = eval_log (cmd%pn_if_lexpr, var_list, is_known=is_known)
	if (is_known) then
	if (lval) then
	if (associated (cmd%if_body)) then
	call cmd%if_body%execute (global)
	end if
	return
	end if
	else
	call error_undecided ()
	return
	end if
	if (associated (cmd%elsif_cmd)) then
	SCAN_ELSIF: do i = 1, size (cmd%elsif_cmd)
	lval = eval_log (cmd%elsif_cmd(i)%pn_if_lexpr, var_list, &
	is_known=is_known)
	if (is_known) then
	if (lval) then
	if (associated (cmd%elsif_cmd(i)%if_body)) then
	call cmd%elsif_cmd(i)%if_body%execute (global)
	end if
	return
	end if
	else
	call error_undecided ()
	return
	end if
	end do SCAN_ELSIF
	end if
	if (associated (cmd%else_body)) then
	call cmd%else_body%execute (global)
	end if
	contains
	subroutine error_undecided ()
	call msg_error ("Undefined result of cmditional expression: " &
	// "neither branch will be executed")
	end subroutine error_undecided
	end subroutine cmd_if_execute

	@ %def cmd_if_execute
	@
	\subsubsection{Include another command-list file}
	The include command allocates a local parse tree. This must not be
	deleted before the command object itself is deleted, since pointers
	may point to subobjects of it.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_include_t
	private
	type(string_t) :: file
	type(command_list_t), pointer :: command_list => null ()
	type(parse_tree_t) :: parse_tree
	contains
	<<Commands: cmd include: TBP>>
	end type cmd_include_t

	@ %def cmd_include_t
	@ Finalizer: delete the command list. No options, so we can simply override
	the default finalizer.
	<<Commands: cmd include: TBP>>=
	procedure :: final => cmd_include_final
	<<Commands: procedures>>=
	subroutine cmd_include_final (cmd)
	class(cmd_include_t), intent(inout) :: cmd
	call parse_tree_final (cmd%parse_tree)
	if (associated (cmd%command_list)) then
	call cmd%command_list%final ()
	deallocate (cmd%command_list)
	end if
	end subroutine cmd_include_final

	@ %def cmd_include_final
	@ Write: display the command list as-is, if allocated.
	<<Commands: cmd include: TBP>>=
	procedure :: write => cmd_include_write
	<<Commands: procedures>>=
	subroutine cmd_include_write (cmd, unit, indent)
	class(cmd_include_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, indent)
	write (u, "(A,A,A,A)") "include ", '"', char (cmd%file), '"'
	if (associated (cmd%command_list)) then
	call cmd%command_list%write (u, ind + 1)
	end if
	end subroutine cmd_include_write

	@ %def cmd_include_write
	@ Compile file contents: First parse the file, then immediately
	compile its contents. Use the global data set.
	<<Commands: cmd include: TBP>>=
	procedure :: compile => cmd_include_compile
	<<Commands: procedures>>=
	subroutine cmd_include_compile (cmd, global)
	class(cmd_include_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_file
	type(string_t) :: file
	logical :: exist
	integer :: u
	type(stream_t), target :: stream
	type(lexer_t) :: lexer
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_file => parse_node_get_sub_ptr (pn_arg)
	file = parse_node_get_string (pn_file)
	inquire (file=char(file), exist=exist)
	if (exist) then
	cmd%file = file
	else
	cmd%file = global%os_data%whizard_cutspath // "/" // file
	inquire (file=char(cmd%file), exist=exist)
	if (.not. exist) then
	call msg_error ("Include file '" // char (file) // "' not found")
	return
	end if
	end if
	u = free_unit ()
	call lexer_init_cmd_list (lexer, global%lexer)
	call stream_init (stream, char (cmd%file))
	call lexer_assign_stream (lexer, stream)
	call parse_tree_init (cmd%parse_tree, syntax_cmd_list, lexer)
	call stream_final (stream)
	call lexer_final (lexer)
	close (u)
	allocate (cmd%command_list)
	call cmd%command_list%compile (cmd%parse_tree%get_root_ptr (), &
	global)
	end subroutine cmd_include_compile

	@ %def cmd_include_compile
	@ Execute file contents in the global context.
	<<Commands: cmd include: TBP>>=
	procedure :: execute => cmd_include_execute
	<<Commands: procedures>>=
	subroutine cmd_include_execute (cmd, global)
	class(cmd_include_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (associated (cmd%command_list)) then
	call msg_message &
	("Including Sindarin from '" // char (cmd%file) // "'")
	call cmd%command_list%execute (global)
	call msg_message &
	("End of included '" // char (cmd%file) // "'")
	end if
	end subroutine cmd_include_execute

	@ %def cmd_include_execute
	@
	\subsubsection{Quit command execution}
	The code is the return code of the whole program if it is terminated
	by this command.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_quit_t
	private
	logical :: has_code = .false.
	type(parse_node_t), pointer :: pn_code_expr => null ()
	contains
	<<Commands: cmd quit: TBP>>
	end type cmd_quit_t

	@ %def cmd_quit_t
	@ Output.
	<<Commands: cmd quit: TBP>>=
	procedure :: write => cmd_quit_write
	<<Commands: procedures>>=
	subroutine cmd_quit_write (cmd, unit, indent)
	class(cmd_quit_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A,L1)") "quit: has_code = ", cmd%has_code
	end subroutine cmd_quit_write

	@ %def cmd_quit_write
	@ Compile: allocate a [[quit]] object which serves as a placeholder.
	<<Commands: cmd quit: TBP>>=
	procedure :: compile => cmd_quit_compile
	<<Commands: procedures>>=
	subroutine cmd_quit_compile (cmd, global)
	class(cmd_quit_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	if (associated (pn_arg)) then
	cmd%pn_code_expr => parse_node_get_sub_ptr (pn_arg)
	cmd%has_code = .true.
	end if
	end subroutine cmd_quit_compile

	@ %def cmd_quit_compile
	@ Execute: The quit command does not execute anything, it just stops
	command execution. This is achieved by setting quit flag and quit
	code in the global variable list. However, the return code, if
	present, is an expression which has to be evaluated.
	<<Commands: cmd quit: TBP>>=
	procedure :: execute => cmd_quit_execute
	<<Commands: procedures>>=
	subroutine cmd_quit_execute (cmd, global)
	class(cmd_quit_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(var_list_t), pointer :: var_list
	logical :: is_known
	var_list => global%get_var_list_ptr ()
	if (cmd%has_code) then
	global%quit_code = eval_int (cmd%pn_code_expr, var_list, &
	is_known=is_known)
	if (.not. is_known) then
	call msg_error ("Undefined return code of quit/exit command")
	end if
	end if
	global%quit = .true.
	end subroutine cmd_quit_execute

	@ %def cmd_quit_execute
	@
	\subsection{The command list}
	The command list holds a list of commands and relevant global data.
	<<Commands: public>>=
	public :: command_list_t
	<<Commands: types>>=
	type :: command_list_t
	! not private anymore as required by the whizard-c-interface
	class(command_t), pointer :: first => null ()
	class(command_t), pointer :: last => null ()
	contains
	<<Commands: command list: TBP>>
	end type command_list_t

	@ %def command_list_t
	@ Output.
	<<Commands: command list: TBP>>=
	procedure :: write => command_list_write
	<<Commands: procedures>>=
	recursive subroutine command_list_write (cmd_list, unit, indent)
	class(command_list_t), intent(in) :: cmd_list
	integer, intent(in), optional :: unit, indent
	class(command_t), pointer :: cmd
	cmd => cmd_list%first
	do while (associated (cmd))
	call cmd%write (unit, indent)
	cmd => cmd%next
	end do
	end subroutine command_list_write

	@ %def command_list_write
	@ Append a new command to the list and free the original pointer.
	<<Commands: command list: TBP>>=
	procedure :: append => command_list_append
	<<Commands: procedures>>=
	subroutine command_list_append (cmd_list, command)
	class(command_list_t), intent(inout) :: cmd_list
	class(command_t), intent(inout), pointer :: command
	if (associated (cmd_list%last)) then
	cmd_list%last%next => command
	else
	cmd_list%first => command
	end if
	cmd_list%last => command
	command => null ()
	end subroutine command_list_append

	@ %def command_list_append
	@ Finalize.
	<<Commands: command list: TBP>>=
	procedure :: final => command_list_final
	<<Commands: procedures>>=
	recursive subroutine command_list_final (cmd_list)
	class(command_list_t), intent(inout) :: cmd_list
	class(command_t), pointer :: command
	do while (associated (cmd_list%first))
	command => cmd_list%first
	cmd_list%first => cmd_list%first%next
	call command%final ()
	deallocate (command)
	end do
	cmd_list%last => null ()
	end subroutine command_list_final

	@ %def command_list_final
	@
	\subsection{Compiling the parse tree}
	Transform a parse tree into a command list. Initialization is assumed
	to be done.

	After each command, we set a breakpoint.
	<<Commands: command list: TBP>>=
	procedure :: compile => command_list_compile
	<<Commands: procedures>>=
	recursive subroutine command_list_compile (cmd_list, pn, global)
	class(command_list_t), intent(inout), target :: cmd_list
	type(parse_node_t), intent(in), target :: pn
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_cmd
	class(command_t), pointer :: command
	integer :: i
	pn_cmd => parse_node_get_sub_ptr (pn)
	do i = 1, parse_node_get_n_sub (pn)
	call dispatch_command (command, pn_cmd)
	call command%compile (global)
	call cmd_list%append (command)
	call terminate_now_if_signal ()
	pn_cmd => parse_node_get_next_ptr (pn_cmd)
	end do
	end subroutine command_list_compile

	@ %def command_list_compile
	@
	\subsection{Executing the command list}
	Before executing a command we should execute its options (if any). After
	that, reset the options, i.e., remove temporary effects from the global
	state.

	Also here, after each command we set a breakpoint.
	<<Commands: command list: TBP>>=
	procedure :: execute => command_list_execute
	<<Commands: procedures>>=
	recursive subroutine command_list_execute (cmd_list, global)
	class(command_list_t), intent(in) :: cmd_list
	type(rt_data_t), intent(inout), target :: global
	class(command_t), pointer :: command
	command => cmd_list%first
	COMMAND_COND: do while (associated (command))
	call command%execute_options (global)
	call command%execute (global)
	call command%reset_options (global)
	call terminate_now_if_signal ()
	if (global%quit) exit COMMAND_COND
	command => command%next
	end do COMMAND_COND
	end subroutine command_list_execute

	@ %def command_list_execute
	@
	\subsection{Command list syntax}
	<<Commands: public>>=
	public :: syntax_cmd_list
	<<Commands: variables>>=
	type(syntax_t), target, save :: syntax_cmd_list

	@ %def syntax_cmd_list
	<<Commands: public>>=
	public :: syntax_cmd_list_init
	<<Commands: procedures>>=
	subroutine syntax_cmd_list_init ()
	type(ifile_t) :: ifile
	call define_cmd_list_syntax (ifile)
	call syntax_init (syntax_cmd_list, ifile)
	call ifile_final (ifile)
	end subroutine syntax_cmd_list_init

	@ %def syntax_cmd_list_init
	<<Commands: public>>=
	public :: syntax_cmd_list_final
	<<Commands: procedures>>=
	subroutine syntax_cmd_list_final ()
	call syntax_final (syntax_cmd_list)
	end subroutine syntax_cmd_list_final

	@ %def syntax_cmd_list_final
	<<Commands: public>>=
	public :: syntax_cmd_list_write
	<<Commands: procedures>>=
	subroutine syntax_cmd_list_write (unit)
	integer, intent(in), optional :: unit
	call syntax_write (syntax_cmd_list, unit)
	end subroutine syntax_cmd_list_write

	@ %def syntax_cmd_list_write
	<<Commands: procedures>>=
	subroutine define_cmd_list_syntax (ifile)
	type(ifile_t), intent(inout) :: ifile
	call ifile_append (ifile, "SEQ command_list = command*")
	call ifile_append (ifile, "ALT command = " &
	// "cmd_model \| cmd_library \| cmd_iterations \| cmd_sample_format \| " &
	// "cmd_var \| cmd_slha \| " &
	// "cmd_show \| cmd_clear \| " &
	// "cmd_expect \| " &
	// "cmd_cuts \| cmd_scale \| cmd_fac_scale \| cmd_ren_scale \| " &
	// "cmd_weight \| cmd_selection \| cmd_reweight \| " &
	// "cmd_beams \| cmd_beams_pol_density \| cmd_beams_pol_fraction \| " &
	// "cmd_beams_momentum \| cmd_beams_theta \| cmd_beams_phi \| " &
	// "cmd_integrate \| " &
	// "cmd_observable \| cmd_histogram \| cmd_plot \| cmd_graph \| " &
	// "cmd_record \| " &
	// "cmd_analysis \| cmd_alt_setup \| " &
	// "cmd_unstable \| cmd_stable \| cmd_simulate \| cmd_rescan \| " &
	// "cmd_process \| cmd_compile \| cmd_exec \| " &
	// "cmd_scan \| cmd_if \| cmd_include \| cmd_quit \| " &
	// "cmd_polarized \| cmd_unpolarized \| " &
	// "cmd_open_out \| cmd_close_out \| cmd_printf \| " &
	// "cmd_write_analysis \| cmd_compile_analysis \| cmd_nlo \| cmd_components")
	call ifile_append (ifile, "GRO options = '{' local_command_list '}'")
	call ifile_append (ifile, "SEQ local_command_list = local_command*")
	call ifile_append (ifile, "ALT local_command = " &
	// "cmd_model \| cmd_library \| cmd_iterations \| cmd_sample_format \| " &
	// "cmd_var \| cmd_slha \| " &
	// "cmd_show \| " &
	// "cmd_expect \| " &
	// "cmd_cuts \| cmd_scale \| cmd_fac_scale \| cmd_ren_scale \| " &
	// "cmd_weight \| cmd_selection \| cmd_reweight \| " &
	// "cmd_beams \| cmd_beams_pol_density \| cmd_beams_pol_fraction \| " &
	// "cmd_beams_momentum \| cmd_beams_theta \| cmd_beams_phi \| " &
	// "cmd_observable \| cmd_histogram \| cmd_plot \| cmd_graph \| " &
	// "cmd_clear \| cmd_record \| " &
	// "cmd_analysis \| cmd_alt_setup \| " &
	// "cmd_open_out \| cmd_close_out \| cmd_printf \| " &
	// "cmd_write_analysis \| cmd_compile_analysis \| cmd_nlo \| cmd_components")
	call ifile_append (ifile, "SEQ cmd_model = model '=' model_name model_arg?")
	call ifile_append (ifile, "KEY model")
	call ifile_append (ifile, "ALT model_name = model_id \| string_literal")
	call ifile_append (ifile, "IDE model_id")
	call ifile_append (ifile, "ARG model_arg = ( model_scheme? )")
	call ifile_append (ifile, "ALT model_scheme = scheme_id \| string_literal")
	call ifile_append (ifile, "IDE scheme_id")
	call ifile_append (ifile, "SEQ cmd_library = library '=' lib_name")
	call ifile_append (ifile, "KEY library")
	call ifile_append (ifile, "ALT lib_name = lib_id \| string_literal")
	call ifile_append (ifile, "IDE lib_id")
	call ifile_append (ifile, "ALT cmd_var = " &
	// "cmd_log_decl \| cmd_log \| " &
	// "cmd_int \| cmd_real \| cmd_complex \| cmd_num \| " &
	// "cmd_string_decl \| cmd_string \| cmd_alias \| " &
	// "cmd_result")
	call ifile_append (ifile, "SEQ cmd_log_decl = logical cmd_log")
	call ifile_append (ifile, "SEQ cmd_log = '?' var_name '=' lexpr")
	call ifile_append (ifile, "SEQ cmd_int = int var_name '=' expr")
	call ifile_append (ifile, "SEQ cmd_real = real var_name '=' expr")
	call ifile_append (ifile, "SEQ cmd_complex = complex var_name '=' expr")
	call ifile_append (ifile, "SEQ cmd_num = var_name '=' expr")
	call ifile_append (ifile, "SEQ cmd_string_decl = string cmd_string")
	call ifile_append (ifile, "SEQ cmd_string = " &
	// "'$' var_name '=' sexpr") ! $
	call ifile_append (ifile, "SEQ cmd_alias = alias var_name '=' cexpr")
	call ifile_append (ifile, "SEQ cmd_result = result '=' expr")
	call ifile_append (ifile, "SEQ cmd_slha = slha_action slha_arg options?")
	call ifile_append (ifile, "ALT slha_action = " &
	// "read_slha \| write_slha")
	call ifile_append (ifile, "KEY read_slha")
	call ifile_append (ifile, "KEY write_slha")
	call ifile_append (ifile, "ARG slha_arg = ( string_literal )")
	call ifile_append (ifile, "SEQ cmd_show = show show_arg options?")
	call ifile_append (ifile, "KEY show")
	call ifile_append (ifile, "ARG show_arg = ( showable* )")
	call ifile_append (ifile, "ALT showable = " &
	// "model \| library \| beams \| iterations \| " &
	// "cuts \| weight \| logical \| string \| pdg \| " &
	// "scale \| factorization_scale \| renormalization_scale \| " &
	// "selection \| reweight \| analysis \| " &
	// "stable \| unstable \| polarized \| unpolarized \| " &
	// "expect \| intrinsic \| int \| real \| complex \| " &
	// "alias_var \| string \| results \| result_var \| " &
	// "log_var \| string_var \| var_name")
	call ifile_append (ifile, "KEY results")
	call ifile_append (ifile, "KEY intrinsic")
	call ifile_append (ifile, "SEQ alias_var = alias var_name")
	call ifile_append (ifile, "SEQ result_var = result_key result_arg?")
	call ifile_append (ifile, "SEQ log_var = '?' var_name")
	call ifile_append (ifile, "SEQ string_var = '$' var_name") ! $
	call ifile_append (ifile, "SEQ cmd_clear = clear clear_arg options?")
	call ifile_append (ifile, "KEY clear")
	call ifile_append (ifile, "ARG clear_arg = ( clearable* )")
	call ifile_append (ifile, "ALT clearable = " &
	// "beams \| iterations \| " &
	// "cuts \| weight \| " &
	// "scale \| factorization_scale \| renormalization_scale \| " &
	// "selection \| reweight \| analysis \| " &
	// "unstable \| polarized \| " &
	// "expect \| " &
	// "log_var \| string_var \| var_name")
	call ifile_append (ifile, "SEQ cmd_expect = expect expect_arg options?")
	call ifile_append (ifile, "KEY expect")
	call ifile_append (ifile, "ARG expect_arg = ( lexpr )")
	call ifile_append (ifile, "SEQ cmd_cuts = cuts '=' lexpr")
	call ifile_append (ifile, "SEQ cmd_scale = scale '=' expr")
	call ifile_append (ifile, "SEQ cmd_fac_scale = " &
	// "factorization_scale '=' expr")
	call ifile_append (ifile, "SEQ cmd_ren_scale = " &
	// "renormalization_scale '=' expr")
	call ifile_append (ifile, "SEQ cmd_weight = weight '=' expr")
	call ifile_append (ifile, "SEQ cmd_selection = selection '=' lexpr")
	call ifile_append (ifile, "SEQ cmd_reweight = reweight '=' expr")
	call ifile_append (ifile, "KEY cuts")
	call ifile_append (ifile, "KEY scale")
	call ifile_append (ifile, "KEY factorization_scale")
	call ifile_append (ifile, "KEY renormalization_scale")
	call ifile_append (ifile, "KEY weight")
	call ifile_append (ifile, "KEY selection")
	call ifile_append (ifile, "KEY reweight")
	call ifile_append (ifile, "SEQ cmd_process = process process_id '=' " &
	// "process_prt '=>' prt_state_list options?")
	call ifile_append (ifile, "KEY process")
	call ifile_append (ifile, "KEY '=>'")
	call ifile_append (ifile, "LIS process_prt = cexpr+")
	call ifile_append (ifile, "LIS prt_state_list = prt_state_sum+")
	call ifile_append (ifile, "SEQ prt_state_sum = " &
	// "prt_state prt_state_addition*")
	call ifile_append (ifile, "SEQ prt_state_addition = '+' prt_state")
	call ifile_append (ifile, "ALT prt_state = grouped_prt_state_list \| cexpr")
	call ifile_append (ifile, "GRO grouped_prt_state_list = " &
	// "( prt_state_list )")
	call ifile_append (ifile, "SEQ cmd_compile = compile_cmd options?")
	call ifile_append (ifile, "SEQ compile_cmd = compile_clause compile_arg?")
	call ifile_append (ifile, "SEQ compile_clause = compile exec_name_spec?")
	call ifile_append (ifile, "KEY compile")
	call ifile_append (ifile, "SEQ exec_name_spec = as exec_name")
	call ifile_append (ifile, "KEY as")
	call ifile_append (ifile, "ALT exec_name = exec_id \| string_literal")
	call ifile_append (ifile, "IDE exec_id")
	call ifile_append (ifile, "ARG compile_arg = ( lib_name* )")
	call ifile_append (ifile, "SEQ cmd_exec = exec exec_arg")
	call ifile_append (ifile, "KEY exec")
	call ifile_append (ifile, "ARG exec_arg = ( sexpr )")
	call ifile_append (ifile, "SEQ cmd_beams = beams '=' beam_def")
	call ifile_append (ifile, "KEY beams")
	call ifile_append (ifile, "SEQ beam_def = beam_spec strfun_seq*")
	call ifile_append (ifile, "SEQ beam_spec = beam_list")
	call ifile_append (ifile, "LIS beam_list = cexpr, cexpr?")
	call ifile_append (ifile, "SEQ cmd_beams_pol_density = " &
	// "beams_pol_density '=' beams_pol_spec")
	call ifile_append (ifile, "KEY beams_pol_density")
	call ifile_append (ifile, "LIS beams_pol_spec = smatrix, smatrix?")
	call ifile_append (ifile, "SEQ smatrix = '@' smatrix_arg")
	! call ifile_append (ifile, "KEY '@'") !!! Key already exists
	call ifile_append (ifile, "ARG smatrix_arg = ( sentry* )")
	call ifile_append (ifile, "SEQ sentry = expr extra_sentry*")
	call ifile_append (ifile, "SEQ extra_sentry = ':' expr")
	call ifile_append (ifile, "SEQ cmd_beams_pol_fraction = " &
	// "beams_pol_fraction '=' beams_par_spec")
	call ifile_append (ifile, "KEY beams_pol_fraction")
	call ifile_append (ifile, "SEQ cmd_beams_momentum = " &
	// "beams_momentum '=' beams_par_spec")
	call ifile_append (ifile, "KEY beams_momentum")
	call ifile_append (ifile, "SEQ cmd_beams_theta = " &
	// "beams_theta '=' beams_par_spec")
	call ifile_append (ifile, "KEY beams_theta")
	call ifile_append (ifile, "SEQ cmd_beams_phi = " &
	// "beams_phi '=' beams_par_spec")
	call ifile_append (ifile, "KEY beams_phi")
	call ifile_append (ifile, "LIS beams_par_spec = expr, expr?")
	call ifile_append (ifile, "SEQ strfun_seq = '=>' strfun_pair")
	call ifile_append (ifile, "LIS strfun_pair = strfun_def, strfun_def?")
	call ifile_append (ifile, "SEQ strfun_def = strfun_id")
	call ifile_append (ifile, "ALT strfun_id = " &
	// "none \| lhapdf \| lhapdf_photon \| pdf_builtin \| pdf_builtin_photon \| " &
	// "isr \| epa \| ewa \| circe1 \| circe2 \| energy_scan \| " &
	// "gaussian \| beam_events \| user_sf_spec")
	call ifile_append (ifile, "KEY none")
	call ifile_append (ifile, "KEY lhapdf")
	call ifile_append (ifile, "KEY lhapdf_photon")
	call ifile_append (ifile, "KEY pdf_builtin")
	call ifile_append (ifile, "KEY pdf_builtin_photon")
	call ifile_append (ifile, "KEY isr")
	call ifile_append (ifile, "KEY epa")
	call ifile_append (ifile, "KEY ewa")
	call ifile_append (ifile, "KEY circe1")
	call ifile_append (ifile, "KEY circe2")
	call ifile_append (ifile, "KEY energy_scan")
	call ifile_append (ifile, "KEY gaussian")
	call ifile_append (ifile, "KEY beam_events")
	call ifile_append (ifile, "SEQ user_sf_spec = user_strfun user_arg")
	call ifile_append (ifile, "KEY user_strfun")
	call ifile_append (ifile, "SEQ cmd_integrate = " &
	// "integrate proc_arg options?")
	call ifile_append (ifile, "KEY integrate")
	call ifile_append (ifile, "ARG proc_arg = ( proc_id* )")
	call ifile_append (ifile, "IDE proc_id")
	call ifile_append (ifile, "SEQ cmd_iterations = " &
	// "iterations '=' iterations_list")
	call ifile_append (ifile, "KEY iterations")
	call ifile_append (ifile, "LIS iterations_list = iterations_spec+")
	call ifile_append (ifile, "ALT iterations_spec = it_spec")
	call ifile_append (ifile, "SEQ it_spec = expr calls_spec adapt_spec?")
	call ifile_append (ifile, "SEQ calls_spec = ':' expr")
	call ifile_append (ifile, "SEQ adapt_spec = ':' sexpr")
	call ifile_append (ifile, "SEQ cmd_components = " &
	// "active '=' component_list")
	call ifile_append (ifile, "KEY active")
	call ifile_append (ifile, "LIS component_list = sexpr+")
	call ifile_append (ifile, "SEQ cmd_sample_format = " &
	// "sample_format '=' event_format_list")
	call ifile_append (ifile, "KEY sample_format")
	call ifile_append (ifile, "LIS event_format_list = event_format+")
	call ifile_append (ifile, "IDE event_format")
	call ifile_append (ifile, "SEQ cmd_observable = " &
	// "observable analysis_tag options?")
	call ifile_append (ifile, "KEY observable")
	call ifile_append (ifile, "SEQ cmd_histogram = " &
	// "histogram analysis_tag histogram_arg " &
	// "options?")
	call ifile_append (ifile, "KEY histogram")
	call ifile_append (ifile, "ARG histogram_arg = (expr, expr, expr?)")
	call ifile_append (ifile, "SEQ cmd_plot = plot analysis_tag options?")
	call ifile_append (ifile, "KEY plot")
	call ifile_append (ifile, "SEQ cmd_graph = graph graph_term '=' graph_def")
	call ifile_append (ifile, "KEY graph")
	call ifile_append (ifile, "SEQ graph_term = analysis_tag options?")
	call ifile_append (ifile, "SEQ graph_def = graph_term graph_append*")
	call ifile_append (ifile, "SEQ graph_append = '&' graph_term")
	call ifile_append (ifile, "SEQ cmd_analysis = analysis '=' lexpr")
	call ifile_append (ifile, "KEY analysis")
	call ifile_append (ifile, "SEQ cmd_alt_setup = " &
	// "alt_setup '=' option_list_expr")
	call ifile_append (ifile, "KEY alt_setup")
	call ifile_append (ifile, "ALT option_list_expr = " &
	// "grouped_option_list \| option_list")
	call ifile_append (ifile, "GRO grouped_option_list = ( option_list_expr )")
	call ifile_append (ifile, "LIS option_list = options+")
	call ifile_append (ifile, "SEQ cmd_open_out = open_out open_arg options?")
	call ifile_append (ifile, "SEQ cmd_close_out = close_out open_arg options?")
	call ifile_append (ifile, "KEY open_out")
	call ifile_append (ifile, "KEY close_out")
	call ifile_append (ifile, "ARG open_arg = (sexpr)")
	call ifile_append (ifile, "SEQ cmd_printf = printf_cmd options?")
	call ifile_append (ifile, "SEQ printf_cmd = printf_clause sprintf_args?")
	call ifile_append (ifile, "SEQ printf_clause = printf sexpr")
	call ifile_append (ifile, "KEY printf")
	call ifile_append (ifile, "SEQ cmd_record = record_cmd")
	call ifile_append (ifile, "SEQ cmd_unstable = " &
	// "unstable cexpr unstable_arg options?")
	call ifile_append (ifile, "KEY unstable")
	call ifile_append (ifile, "ARG unstable_arg = ( proc_id* )")
	call ifile_append (ifile, "SEQ cmd_stable = stable stable_list options?")
	call ifile_append (ifile, "KEY stable")
	call ifile_append (ifile, "LIS stable_list = cexpr+")
	call ifile_append (ifile, "KEY polarized")
	call ifile_append (ifile, "SEQ cmd_polarized = polarized polarized_list options?")
	call ifile_append (ifile, "LIS polarized_list = cexpr+")
	call ifile_append (ifile, "KEY unpolarized")
	call ifile_append (ifile, "SEQ cmd_unpolarized = unpolarized unpolarized_list options?")
	call ifile_append (ifile, "LIS unpolarized_list = cexpr+")
	call ifile_append (ifile, "SEQ cmd_simulate = " &
	// "simulate proc_arg options?")
	call ifile_append (ifile, "KEY simulate")
	call ifile_append (ifile, "SEQ cmd_rescan = " &
	// "rescan sexpr proc_arg options?")
	call ifile_append (ifile, "KEY rescan")
	call ifile_append (ifile, "SEQ cmd_scan = scan scan_var scan_body?")
	call ifile_append (ifile, "KEY scan")
	call ifile_append (ifile, "ALT scan_var = " &
	// "scan_log_decl \| scan_log \| " &
	// "scan_int \| scan_real \| scan_complex \| scan_num \| " &
	// "scan_string_decl \| scan_string \| scan_alias \| " &
	// "scan_cuts \| scan_weight \| " &
	// "scan_scale \| scan_ren_scale \| scan_fac_scale \| " &
	// "scan_selection \| scan_reweight \| scan_analysis \| " &
	// "scan_model \| scan_library")
	call ifile_append (ifile, "SEQ scan_log_decl = logical scan_log")
	call ifile_append (ifile, "SEQ scan_log = '?' var_name '=' scan_log_arg")
	call ifile_append (ifile, "ARG scan_log_arg = ( lexpr* )")
	call ifile_append (ifile, "SEQ scan_int = int var_name '=' scan_num_arg")
	call ifile_append (ifile, "SEQ scan_real = real var_name '=' scan_num_arg")
	call ifile_append (ifile, "SEQ scan_complex = " &
	// "complex var_name '=' scan_num_arg")
	call ifile_append (ifile, "SEQ scan_num = var_name '=' scan_num_arg")
	call ifile_append (ifile, "ARG scan_num_arg = ( range* )")
	call ifile_append (ifile, "ALT range = grouped_range \| range_expr")
	call ifile_append (ifile, "GRO grouped_range = ( range_expr )")
	call ifile_append (ifile, "SEQ range_expr = expr range_spec?")
	call ifile_append (ifile, "SEQ range_spec = '=>' expr step_spec?")
	call ifile_append (ifile, "SEQ step_spec = step_op expr")
	call ifile_append (ifile, "ALT step_op = " &
	// "'/+' \| '/-' \| '/' \| '//' \| '/+/' \| '//'")
	call ifile_append (ifile, "KEY '/+'")
	call ifile_append (ifile, "KEY '/-'")
	call ifile_append (ifile, "KEY '/*'")
	call ifile_append (ifile, "KEY '//'")
	call ifile_append (ifile, "KEY '/+/'")
	call ifile_append (ifile, "KEY '/*/'")
	call ifile_append (ifile, "SEQ scan_string_decl = string scan_string")
	call ifile_append (ifile, "SEQ scan_string = " &
	// "'$' var_name '=' scan_string_arg")
	call ifile_append (ifile, "ARG scan_string_arg = ( sexpr* )")
	call ifile_append (ifile, "SEQ scan_alias = " &
	// "alias var_name '=' scan_alias_arg")
	call ifile_append (ifile, "ARG scan_alias_arg = ( cexpr* )")
	call ifile_append (ifile, "SEQ scan_cuts = cuts '=' scan_lexpr_arg")
	call ifile_append (ifile, "ARG scan_lexpr_arg = ( lexpr* )")
	call ifile_append (ifile, "SEQ scan_scale = scale '=' scan_expr_arg")
	call ifile_append (ifile, "ARG scan_expr_arg = ( expr* )")
	call ifile_append (ifile, "SEQ scan_fac_scale = " &
	// "factorization_scale '=' scan_expr_arg")
	call ifile_append (ifile, "SEQ scan_ren_scale = " &
	// "renormalization_scale '=' scan_expr_arg")
	call ifile_append (ifile, "SEQ scan_weight = weight '=' scan_expr_arg")
	call ifile_append (ifile, "SEQ scan_selection = selection '=' scan_lexpr_arg")
	call ifile_append (ifile, "SEQ scan_reweight = reweight '=' scan_expr_arg")
	call ifile_append (ifile, "SEQ scan_analysis = analysis '=' scan_lexpr_arg")
	call ifile_append (ifile, "SEQ scan_model = model '=' scan_model_arg")
	call ifile_append (ifile, "ARG scan_model_arg = ( model_name* )")
	call ifile_append (ifile, "SEQ scan_library = library '=' scan_library_arg")
	call ifile_append (ifile, "ARG scan_library_arg = ( lib_name* )")
	call ifile_append (ifile, "GRO scan_body = '{' command_list '}'")
	call ifile_append (ifile, "SEQ cmd_if = " &
	// "if lexpr then command_list elsif_clauses else_clause endif")
	call ifile_append (ifile, "SEQ elsif_clauses = cmd_elsif*")
	call ifile_append (ifile, "SEQ cmd_elsif = elsif lexpr then command_list")
	call ifile_append (ifile, "SEQ else_clause = cmd_else?")
	call ifile_append (ifile, "SEQ cmd_else = else command_list")
	call ifile_append (ifile, "SEQ cmd_include = include include_arg")
	call ifile_append (ifile, "KEY include")
	call ifile_append (ifile, "ARG include_arg = ( string_literal )")
	call ifile_append (ifile, "SEQ cmd_quit = quit_cmd quit_arg?")
	call ifile_append (ifile, "ALT quit_cmd = quit \| exit")
	call ifile_append (ifile, "KEY quit")
	call ifile_append (ifile, "KEY exit")
	call ifile_append (ifile, "ARG quit_arg = ( expr )")
	call ifile_append (ifile, "SEQ cmd_write_analysis = " &
	// "write_analysis_clause options?")
	call ifile_append (ifile, "SEQ cmd_compile_analysis = " &
	// "compile_analysis_clause options?")
	call ifile_append (ifile, "SEQ write_analysis_clause = " &
	// "write_analysis write_analysis_arg?")
	call ifile_append (ifile, "SEQ compile_analysis_clause = " &
	// "compile_analysis write_analysis_arg?")
	call ifile_append (ifile, "KEY write_analysis")
	call ifile_append (ifile, "KEY compile_analysis")
	call ifile_append (ifile, "ARG write_analysis_arg = ( analysis_tag* )")
	call ifile_append (ifile, "SEQ cmd_nlo = " &
	// "nlo_calculation '=' nlo_calculation_list")
	call ifile_append (ifile, "KEY nlo_calculation")
	call ifile_append (ifile, "LIS nlo_calculation_list = sexpr ',' sexpr ',' sexpr")
	call define_expr_syntax (ifile, particles=.true., analysis=.true.)
	end subroutine define_cmd_list_syntax

	@ %def define_cmd_list_syntax
	<<Commands: public>>=
	public :: lexer_init_cmd_list
	<<Commands: procedures>>=
	subroutine lexer_init_cmd_list (lexer, parent_lexer)
	type(lexer_t), intent(out) :: lexer
	type(lexer_t), intent(in), optional, target :: parent_lexer
	call lexer_init (lexer, &
	comment_chars = "#!", &
	quote_chars = '"', &
	quote_match = '"', &
	single_chars = "()[]{},;:&%?$@", &
	special_class = [ "+-*/^", "<>=~ " ] , &
	keyword_list = syntax_get_keyword_list_ptr (syntax_cmd_list), &
	parent = parent_lexer)
	end subroutine lexer_init_cmd_list

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

	module commands_ut
	use unit_tests
	use commands_uti

	<<Standard module head>>

	<<Commands: public test>>

	contains

	<<Commands: test driver>>

	end module commands_ut
	@ %def commands_ut
	@
	<<[[commands_uti.f90]]>>=
	<<File header>>

	module commands_uti

	<<Use kinds>>
	use kinds, only: i64
	<<Use strings>>
	use io_units
	use ifiles
	use parser
	use interactions, only: reset_interaction_counter
	use prclib_stacks
	use analysis
	use variables
	use models
	use slha_interface
	use rt_data
	use event_base, only: generic_event_t, event_callback_t

	use commands

	<<Standard module head>>

	<<Commands: test declarations>>

	<<Commands: test auxiliary types>>

	contains

	<<Commands: tests>>

	<<Commands: test auxiliary>>

	end module commands_uti

	@ %def commands_uti
	@ API: driver for the unit tests below.
	<<Commands: public test>>=
	public :: commands_test
	<<Commands: test driver>>=
	subroutine commands_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Commands: execute tests>>
	end subroutine commands_test

	@ %def commands_test
	@
	\subsubsection{Prepare Sindarin code}
	This routine parses an internal file, prints the parse tree, and
	returns a parse node to the root. We use the routine in the tests
	below.
	<<Commands: public test auxiliary>>=
	public :: parse_ifile
	<<Commands: test auxiliary>>=
	subroutine parse_ifile (ifile, pn_root, u)
	use ifiles
	use lexers
	use parser
	use commands
	type(ifile_t), intent(in) :: ifile
	type(parse_node_t), pointer, intent(out) :: pn_root
	integer, intent(in), optional :: u
	type(stream_t), target :: stream
	type(lexer_t), target :: lexer
	type(parse_tree_t) :: parse_tree

	call lexer_init_cmd_list (lexer)
	call stream_init (stream, ifile)
	call lexer_assign_stream (lexer, stream)

	call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
	if (present (u)) call parse_tree_write (parse_tree, u)
	pn_root => parse_tree%get_root_ptr ()

	call stream_final (stream)
	call lexer_final (lexer)
	end subroutine parse_ifile

	@ %def parse_ifile
	@
	\subsubsection{Empty command list}
	Compile and execute an empty command list. Should do nothing but
	test the integrity of the workflow.
	<<Commands: execute tests>>=
	call test (commands_1, "commands_1", &
	"empty command list", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_1
	<<Commands: tests>>=
	subroutine commands_1 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_1"
	write (u, "(A)") "* Purpose: compile and execute empty command list"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Parse empty file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"

	if (associated (pn_root)) then
	call command_list%compile (pn_root, global)
	end if

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"

	call global%activate ()
	call command_list%execute (global)
	call global%deactivate ()

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

	call ifile_final (ifile)

	call command_list%final ()
	call syntax_cmd_list_final ()
	call global%final ()

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

	end subroutine commands_1

	@ %def commands_1
	@
	\subsubsection{Read model}
	Execute a [[model]] assignment.
	<<Commands: execute tests>>=
	call test (commands_2, "commands_2", &
	"model", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_2
	<<Commands: tests>>=
	subroutine commands_2 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_2"
	write (u, "(A)") "* Purpose: set model"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')

	call ifile_write (ifile, u)

	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_2

	@ %def commands_2
	@
	\subsubsection{Declare Process}
	Read a model, then declare a process. The process library is allocated
	explicitly. For the process definition, We take the default ([[omega]])
	method. Since we do not compile, \oMega\ is not actually called.
	<<Commands: execute tests>>=
	call test (commands_3, "commands_3", &
	"process declaration", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_3
	<<Commands: tests>>=
	subroutine commands_3 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_3"
	write (u, "(A)") "* Purpose: define process"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd3"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process t3 = s, s => s, s')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%prclib_stack%write (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_3

	@ %def commands_3
	@
	\subsubsection{Compile Process}
	Read a model, then declare a process and compile the library. The process
	library is allocated explicitly. For the process definition, We take the
	default ([[unit_test]]) method. There is no external code, so compilation of
	the library is merely a formal status change.
	<<Commands: execute tests>>=
	call test (commands_4, "commands_4", &
	"compilation", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_4
	<<Commands: tests>>=
	subroutine commands_4 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_4"
	write (u, "(A)") "* Purpose: define process and compile library"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd4"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process t4 = s, s => s, s')
	call ifile_append (ifile, 'compile ("lib_cmd4")')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%prclib_stack%write (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_4

	@ %def commands_4
	@
	\subsubsection{Integrate Process}
	Read a model, then declare a process, compile the library, and
	integrate over phase space. We take the
	default ([[unit_test]]) method and use the simplest methods of
	phase-space parameterization and integration.
	<<Commands: execute tests>>=
	call test (commands_5, "commands_5", &
	"integration", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_5
	<<Commands: tests>>=
	subroutine commands_5 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_5"
	write (u, "(A)") "* Purpose: define process, iterations, and integrate"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)
	call global%var_list%set_int (var_str ("seed"), 0, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd5"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process t5 = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (t5)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call reset_interaction_counter ()
	call command_list%execute (global)

	call global%it_list%write (u)
	write (u, "(A)")
	call global%process_stack%write (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_5

	@ %def commands_5
	@
	\subsubsection{Variables}
	Set intrinsic and user-defined variables.
	<<Commands: execute tests>>=
	call test (commands_6, "commands_6", &
	"variables", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_6
	<<Commands: tests>>=
	subroutine commands_6 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_6"
	write (u, "(A)") "* Purpose: define and set variables"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()
	call global%write_vars (u, [ &
	var_str ("$run_id"), &
	var_str ("?unweighted"), &
	var_str ("sqrts")])

	write (u, "(A)")
	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$run_id = "run1"')
	call ifile_append (ifile, '?unweighted = false')
	call ifile_append (ifile, 'sqrts = 1000')
	call ifile_append (ifile, 'int j = 10')
	call ifile_append (ifile, 'real x = 1000.')
	call ifile_append (ifile, 'complex z = 5')
	call ifile_append (ifile, 'string $text = "abcd"')
	call ifile_append (ifile, 'logical ?flag = true')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_vars (u, [ &
	var_str ("$run_id"), &
	var_str ("?unweighted"), &
	var_str ("sqrts"), &
	var_str ("j"), &
	var_str ("x"), &
	var_str ("z"), &
	var_str ("$text"), &
	var_str ("?flag")])


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

	call ifile_final (ifile)

	call command_list%final ()
	call syntax_cmd_list_final ()
	call global%final ()

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

	end subroutine commands_6

	@ %def commands_6
	@
	\subsubsection{Process library}
	Open process libraries explicitly.
	<<Commands: execute tests>>=
	call test (commands_7, "commands_7", &
	"process library", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_7
	<<Commands: tests>>=
	subroutine commands_7 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_7"
	write (u, "(A)") "* Purpose: declare process libraries"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()
	call global%var_list%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	global%os_data%fc = "Fortran-compiler"
	global%os_data%fcflags = "Fortran-flags"

	write (u, "(A)")
	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'library = "lib_cmd7_1"')
	call ifile_append (ifile, 'library = "lib_cmd7_2"')
	call ifile_append (ifile, 'library = "lib_cmd7_1"')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_libraries (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call syntax_cmd_list_final ()
	call global%final ()

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

	end subroutine commands_7

	@ %def commands_7
	@
	\subsubsection{Generate events}
	Read a model, then declare a process, compile the library, and
	generate weighted events. We take the
	default ([[unit_test]]) method and use the simplest methods of
	phase-space parameterization and integration.
	<<Commands: execute tests>>=
	call test (commands_8, "commands_8", &
	"event generation", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_8
	<<Commands: tests>>=
	subroutine commands_8 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_8"
	write (u, "(A)") "* Purpose: define process, integrate, generate events"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd8"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_8_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (commands_8_p)')
	call ifile_append (ifile, '?unweighted = false')
	call ifile_append (ifile, 'n_events = 3')
	call ifile_append (ifile, '?read_raw = false')
	call ifile_append (ifile, 'simulate (commands_8_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"

	call command_list%execute (global)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_8

	@ %def commands_8
	@
	\subsubsection{Define cuts}
	Declare a cut expression.
	<<Commands: execute tests>>=
	call test (commands_9, "commands_9", &
	"cuts", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_9
	<<Commands: tests>>=
	subroutine commands_9 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(string_t), dimension(0) :: no_vars

	write (u, "(A)") "* Test output: commands_9"
	write (u, "(A)") "* Purpose: define cuts"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'cuts = all Pt > 0 [particle]')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write (u, vars = no_vars)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_9

	@ %def commands_9
	@
	\subsubsection{Beams}
	Define beam setup.
	<<Commands: execute tests>>=
	call test (commands_10, "commands_10", &
	"beams", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_10
	<<Commands: tests>>=
	subroutine commands_10 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_10"
	write (u, "(A)") "* Purpose: define beams"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = QCD')
	call ifile_append (ifile, 'sqrts = 1000')
	call ifile_append (ifile, 'beams = p, p')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_beams (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_10

	@ %def commands_10
	@
	\subsubsection{Structure functions}
	Define beam setup with structure functions
	<<Commands: execute tests>>=
	call test (commands_11, "commands_11", &
	"structure functions", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_11
	<<Commands: tests>>=
	subroutine commands_11 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_11"
	write (u, "(A)") "* Purpose: define beams with structure functions"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = QCD')
	call ifile_append (ifile, 'sqrts = 1100')
	call ifile_append (ifile, 'beams = p, p => lhapdf => pdf_builtin, isr')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_beams (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_11

	@ %def commands_11
	@
	\subsubsection{Rescan events}
	Read a model, then declare a process, compile the library, and
	generate weighted events. We take the
	default ([[unit_test]]) method and use the simplest methods of
	phase-space parameterization and integration. Then, rescan the
	generated event sample.
	<<Commands: execute tests>>=
	call test (commands_12, "commands_12", &
	"event rescanning", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_12
	<<Commands: tests>>=
	subroutine commands_12 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_12"
	write (u, "(A)") "* Purpose: generate events and rescan"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()

	call global%global_init ()
	call var_list_append_log (global%var_list, &
	var_str ("?rebuild_phase_space"), .false., &
	intrinsic=.true.)
	call var_list_append_log (global%var_list, &
	var_str ("?rebuild_grids"), .false., &
	intrinsic=.true.)
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd12"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_12_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (commands_12_p)')
	call ifile_append (ifile, '?unweighted = false')
	call ifile_append (ifile, 'n_events = 3')
	call ifile_append (ifile, '?read_raw = false')
	call ifile_append (ifile, 'simulate (commands_12_p)')
	call ifile_append (ifile, '?write_raw = false')
	call ifile_append (ifile, 'rescan "commands_12_p" (commands_12_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"

	call command_list%execute (global)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_12

	@ %def commands_12
	@
	\subsubsection{Event Files}
	Set output formats for event files.
	<<Commands: execute tests>>=
	call test (commands_13, "commands_13", &
	"event output formats", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_13
	<<Commands: tests>>=
	subroutine commands_13 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib
	logical :: exist

	write (u, "(A)") "* Test output: commands_13"
	write (u, "(A)") "* Purpose: generate events and rescan"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd13"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_13_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (commands_13_p)')
	call ifile_append (ifile, '?unweighted = false')
	call ifile_append (ifile, 'n_events = 1')
	call ifile_append (ifile, '?read_raw = false')
	call ifile_append (ifile, 'sample_format = weight_stream')
	call ifile_append (ifile, 'simulate (commands_13_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"

	call command_list%execute (global)

	write (u, "(A)")
	write (u, "(A)") "* Verify output files"
	write (u, "(A)")

	inquire (file = "commands_13_p.evx", exist = exist)
	if (exist) write (u, "(1x,A)") "raw"

	inquire (file = "commands_13_p.weights.dat", exist = exist)
	if (exist) write (u, "(1x,A)") "weight_stream"

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_13

	@ %def commands_13
	@
	\subsubsection{Compile Empty Libraries}
	(This is a regression test:) Declare two empty libraries and compile them.
	<<Commands: execute tests>>=
	call test (commands_14, "commands_14", &
	"empty libraries", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_14
	<<Commands: tests>>=
	subroutine commands_14 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_14"
	write (u, "(A)") "* Purpose: define and compile empty libraries"
	write (u, "(A)")

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

	call syntax_model_file_init ()
	call syntax_cmd_list_init ()

	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'library = "lib1"')
	call ifile_append (ifile, 'library = "lib2"')
	call ifile_append (ifile, 'compile ()')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%prclib_stack%write (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()

	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_14

	@ %def commands_14
	@
	\subsubsection{Compile Process}
	Read a model, then declare a process and compile the library. The process
	library is allocated explicitly. For the process definition, We take the
	default ([[unit_test]]) method. There is no external code, so compilation of
	the library is merely a formal status change.
	<<Commands: execute tests>>=
	call test (commands_15, "commands_15", &
	"compilation", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_15
	<<Commands: tests>>=
	subroutine commands_15 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_15"
	write (u, "(A)") "* Purpose: define process and compile library"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd15"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process t15 = s, s => s, s')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (t15)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%prclib_stack%write (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_15

	@ %def commands_15
	@
	\subsubsection{Observable}
	Declare an observable, fill it and display.
	<<Commands: execute tests>>=
	call test (commands_16, "commands_16", &
	"observables", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_16
	<<Commands: tests>>=
	subroutine commands_16 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_16"
	write (u, "(A)") "* Purpose: declare an observable"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$obs_label = "foo"')
	call ifile_append (ifile, '$obs_unit = "cm"')
	call ifile_append (ifile, '$title = "Observable foo"')
	call ifile_append (ifile, '$description = "This is observable foo"')
	call ifile_append (ifile, 'observable foo')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Record two data items"
	write (u, "(A)")

	call analysis_record_data (var_str ("foo"), 1._default)
	call analysis_record_data (var_str ("foo"), 3._default)

	write (u, "(A)") "* Display analysis store"
	write (u, "(A)")

	call analysis_write (u, verbose=.true.)

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

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_16

	@ %def commands_16
	@
	\subsubsection{Histogram}
	Declare a histogram, fill it and display.
	<<Commands: execute tests>>=
	call test (commands_17, "commands_17", &
	"histograms", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_17
	<<Commands: tests>>=
	subroutine commands_17 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(string_t), dimension(3) :: name
	integer :: i

	write (u, "(A)") "* Test output: commands_17"
	write (u, "(A)") "* Purpose: declare histograms"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$obs_label = "foo"')
	call ifile_append (ifile, '$obs_unit = "cm"')
	call ifile_append (ifile, '$title = "Histogram foo"')
	call ifile_append (ifile, '$description = "This is histogram foo"')
	call ifile_append (ifile, 'histogram foo (0,5,1)')
	call ifile_append (ifile, '$title = "Histogram bar"')
	call ifile_append (ifile, '$description = "This is histogram bar"')
	call ifile_append (ifile, 'n_bins = 2')
	call ifile_append (ifile, 'histogram bar (0,5)')
	call ifile_append (ifile, '$title = "Histogram gee"')
	call ifile_append (ifile, '$description = "This is histogram gee"')
	call ifile_append (ifile, '?normalize_bins = true')
	call ifile_append (ifile, 'histogram gee (0,5)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Record two data items"
	write (u, "(A)")

	name(1) = "foo"
	name(2) = "bar"
	name(3) = "gee"

	do i = 1, 3
	call analysis_record_data (name(i), 0.1_default, &
	weight = 0.25_default)
	call analysis_record_data (name(i), 3.1_default)
	call analysis_record_data (name(i), 4.1_default, &
	excess = 0.5_default)
	call analysis_record_data (name(i), 7.1_default)
	end do

	write (u, "(A)") "* Display analysis store"
	write (u, "(A)")

	call analysis_write (u, verbose=.true.)

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

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_17

	@ %def commands_17
	@
	\subsubsection{Plot}
	Declare a plot, fill it and display contents.
	<<Commands: execute tests>>=
	call test (commands_18, "commands_18", &
	"plots", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_18
	<<Commands: tests>>=
	subroutine commands_18 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_18"
	write (u, "(A)") "* Purpose: declare a plot"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$obs_label = "foo"')
	call ifile_append (ifile, '$obs_unit = "cm"')
	call ifile_append (ifile, '$title = "Plot foo"')
	call ifile_append (ifile, '$description = "This is plot foo"')
	call ifile_append (ifile, '$x_label = "x axis"')
	call ifile_append (ifile, '$y_label = "y axis"')
	call ifile_append (ifile, '?x_log = false')
	call ifile_append (ifile, '?y_log = true')
	call ifile_append (ifile, 'x_min = -1')
	call ifile_append (ifile, 'x_max = 1')
	call ifile_append (ifile, 'y_min = 0.1')
	call ifile_append (ifile, 'y_max = 1000')
	call ifile_append (ifile, 'plot foo')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Record two data items"
	write (u, "(A)")

	call analysis_record_data (var_str ("foo"), 0._default, 20._default, &
	xerr = 0.25_default)
	call analysis_record_data (var_str ("foo"), 0.5_default, 0.2_default, &
	yerr = 0.07_default)
	call analysis_record_data (var_str ("foo"), 3._default, 2._default)

	write (u, "(A)") "* Display analysis store"
	write (u, "(A)")

	call analysis_write (u, verbose=.true.)

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

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_18

	@ %def commands_18
	@
	\subsubsection{Graph}
	Combine two (empty) plots to a graph.
	<<Commands: execute tests>>=
	call test (commands_19, "commands_19", &
	"graphs", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_19
	<<Commands: tests>>=
	subroutine commands_19 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_19"
	write (u, "(A)") "* Purpose: combine two plots to a graph"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'plot a')
	call ifile_append (ifile, 'plot b')
	call ifile_append (ifile, '$title = "Graph foo"')
	call ifile_append (ifile, '$description = "This is graph foo"')
	call ifile_append (ifile, 'graph foo = a & b')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis object"
	write (u, "(A)")

	call analysis_write (var_str ("foo"), u)

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

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_19

	@ %def commands_19
	@
	\subsubsection{Record Data}
	Record data in previously allocated analysis objects.
	<<Commands: execute tests>>=
	call test (commands_20, "commands_20", &
	"record data", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_20
	<<Commands: tests>>=
	subroutine commands_20 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_20"
	write (u, "(A)") "* Purpose: record data"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create observable, histogram, plot"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	call analysis_init_observable (var_str ("o"))
	call analysis_init_histogram (var_str ("h"), 0._default, 1._default, 3, &
	normalize_bins = .false.)
	call analysis_init_plot (var_str ("p"))

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'record o (1.234)')
	call ifile_append (ifile, 'record h (0.5)')
	call ifile_append (ifile, 'record p (1, 2)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis object"
	write (u, "(A)")

	call analysis_write (u, verbose = .true.)

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

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_20

	@ %def commands_20
	@
	\subsubsection{Analysis}
	Declare an analysis expression and use it to fill an observable during
	event generation.
	<<Commands: execute tests>>=
	call test (commands_21, "commands_21", &
	"analysis expression", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_21
	<<Commands: tests>>=
	subroutine commands_21 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_21"
	write (u, "(A)") "* Purpose: create and use analysis expression"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create observable"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd8"))
	call global%add_prclib (lib)

	call analysis_init_observable (var_str ("m"))

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_21_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:100')
	call ifile_append (ifile, 'integrate (commands_21_p)')
	call ifile_append (ifile, '?unweighted = true')
	call ifile_append (ifile, 'n_events = 3')
	call ifile_append (ifile, '?read_raw = false')
	call ifile_append (ifile, 'observable m')
	call ifile_append (ifile, 'analysis = record m (eval M [s])')
	call ifile_append (ifile, 'simulate (commands_21_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis object"
	write (u, "(A)")

	call analysis_write (u)

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

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_21

	@ %def commands_21
	@
	\subsubsection{Write Analysis}
	Write accumulated analysis data to file.
	<<Commands: execute tests>>=
	call test (commands_22, "commands_22", &
	"write analysis", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_22
	<<Commands: tests>>=
	subroutine commands_22 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	integer :: u_file, iostat
	logical :: exist
	character(80) :: buffer

	write (u, "(A)") "* Test output: commands_22"
	write (u, "(A)") "* Purpose: write analysis data"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create observable"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	call analysis_init_observable (var_str ("m"))
	call analysis_record_data (var_str ("m"), 125._default)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$out_file = "commands_22.dat"')
	call ifile_append (ifile, 'write_analysis')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis data"
	write (u, "(A)")

	inquire (file = "commands_22.dat", exist = exist)
	if (.not. exist) then
	write (u, "(A)") "ERROR: File commands_22.dat not found"
	return
	end if

	u_file = free_unit ()
	open (u_file, file = "commands_22.dat", &
	action = "read", status = "old")
	do
	read (u_file, "(A)", iostat = iostat) buffer
	if (iostat /= 0) exit
	write (u, "(A)") trim (buffer)
	end do
	close (u_file)

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

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_22

	@ %def commands_22
	@
	\subsubsection{Compile Analysis}
	Write accumulated analysis data to file and compile.
	<<Commands: execute tests>>=
	call test (commands_23, "commands_23", &
	"compile analysis", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_23
	<<Commands: tests>>=
	subroutine commands_23 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	integer :: u_file, iostat
	character(256) :: buffer
	logical :: exist
	type(graph_options_t) :: graph_options

	write (u, "(A)") "* Test output: commands_23"
	write (u, "(A)") "* Purpose: write and compile analysis data"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create and fill histogram"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	call graph_options_init (graph_options)
	call graph_options_set (graph_options, &
	title = var_str ("Histogram for test: commands 23"), &
	description = var_str ("This is a test."), &
	width_mm = 125, height_mm = 85)
	call analysis_init_histogram (var_str ("h"), &
	0._default, 10._default, 2._default, .false., &
	graph_options = graph_options)
	call analysis_record_data (var_str ("h"), 1._default)
	call analysis_record_data (var_str ("h"), 1._default)
	call analysis_record_data (var_str ("h"), 1._default)
	call analysis_record_data (var_str ("h"), 1._default)
	call analysis_record_data (var_str ("h"), 3._default)
	call analysis_record_data (var_str ("h"), 3._default)
	call analysis_record_data (var_str ("h"), 3._default)
	call analysis_record_data (var_str ("h"), 5._default)
	call analysis_record_data (var_str ("h"), 7._default)
	call analysis_record_data (var_str ("h"), 7._default)
	call analysis_record_data (var_str ("h"), 7._default)
	call analysis_record_data (var_str ("h"), 7._default)
	call analysis_record_data (var_str ("h"), 9._default)
	call analysis_record_data (var_str ("h"), 9._default)
	call analysis_record_data (var_str ("h"), 9._default)
	call analysis_record_data (var_str ("h"), 9._default)
	call analysis_record_data (var_str ("h"), 9._default)
	call analysis_record_data (var_str ("h"), 9._default)
	call analysis_record_data (var_str ("h"), 9._default)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$out_file = "commands_23.dat"')
	call ifile_append (ifile, 'compile_analysis')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Delete Postscript output"
	write (u, "(A)")

	inquire (file = "commands_23.ps", exist = exist)
	if (exist) then
	u_file = free_unit ()
	open (u_file, file = "commands_23.ps", action = "write", status = "old")
	close (u_file, status = "delete")
	end if
	inquire (file = "commands_23.ps", exist = exist)
	write (u, "(1x,A,L1)") "Postcript output exists = ", exist

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* TeX file"
	write (u, "(A)")

	inquire (file = "commands_23.tex", exist = exist)
	if (.not. exist) then
	write (u, "(A)") "ERROR: File commands_23.tex not found"
	return
	end if

	u_file = free_unit ()
	open (u_file, file = "commands_23.tex", &
	action = "read", status = "old")
	do
	read (u_file, "(A)", iostat = iostat) buffer
	if (iostat /= 0) exit
	write (u, "(A)") trim (buffer)
	end do
	close (u_file)
	write (u, *)

	inquire (file = "commands_23.ps", exist = exist)
	write (u, "(1x,A,L1)") "Postcript output exists = ", exist

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

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_23

	@ %def commands_23
	@
	\subsubsection{Histogram}
	Declare a histogram, fill it and display.
	<<Commands: execute tests>>=
	call test (commands_24, "commands_24", &
	"drawing options", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_24
	<<Commands: tests>>=
	subroutine commands_24 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_24"
	write (u, "(A)") "* Purpose: check graph and drawing options"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$title = "Title"')
	call ifile_append (ifile, '$description = "Description"')
	call ifile_append (ifile, '$x_label = "X Label"')
	call ifile_append (ifile, '$y_label = "Y Label"')
	call ifile_append (ifile, 'graph_width_mm = 111')
	call ifile_append (ifile, 'graph_height_mm = 222')
	call ifile_append (ifile, 'x_min = -11')
	call ifile_append (ifile, 'x_max = 22')
	call ifile_append (ifile, 'y_min = -33')
	call ifile_append (ifile, 'y_max = 44')
	call ifile_append (ifile, '$gmlcode_bg = "GML Code BG"')
	call ifile_append (ifile, '$gmlcode_fg = "GML Code FG"')
	call ifile_append (ifile, '$fill_options = "Fill Options"')
	call ifile_append (ifile, '$draw_options = "Draw Options"')
	call ifile_append (ifile, '$err_options = "Error Options"')
	call ifile_append (ifile, '$symbol = "Symbol"')
	call ifile_append (ifile, 'histogram foo (0,1)')
	call ifile_append (ifile, 'plot bar')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis store"
	write (u, "(A)")

	call analysis_write (u, verbose=.true.)

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

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_24

	@ %def commands_24
	@
	\subsubsection{Local Environment}
	Declare a local environment.
	<<Commands: execute tests>>=
	call test (commands_25, "commands_25", &
	"local process environment", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_25
	<<Commands: tests>>=
	subroutine commands_25 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_25"
	write (u, "(A)") "* Purpose: declare local environment for process"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_cmd_list_init ()
	call global%global_init ()
	call global%var_list%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'library = "commands_25_lib"')
	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_25_p1 = g, g => g, g &
	&{ model = "QCD" }')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)
	call global%write_libraries (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_25

	@ %def commands_25
	@
	\subsubsection{Alternative Setups}
	Declare a list of alternative setups.
	<<Commands: execute tests>>=
	call test (commands_26, "commands_26", &
	"alternative setups", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_26
	<<Commands: tests>>=
	subroutine commands_26 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_26"
	write (u, "(A)") "* Purpose: declare alternative setups for simulation"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'int i = 0')
	call ifile_append (ifile, 'alt_setup = ({ i = 1 }, { i = 2 })')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_expr (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

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

	end subroutine commands_26

	@ %def commands_26
	@
	\subsubsection{Unstable Particle}
	Define decay processes and declare a particle as unstable. Also check
	the commands stable, polarized, unpolarized.
	<<Commands: execute tests>>=
	call test (commands_27, "commands_27", &
	"unstable and polarized particles", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_27
	<<Commands: tests>>=
	subroutine commands_27 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_27"
	write (u, "(A)") "* Purpose: modify particle properties"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)

	allocate (lib)
	call lib%init (var_str ("commands_27_lib"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'ff = 0.4')
	call ifile_append (ifile, 'process d1 = s => f, fbar')
	call ifile_append (ifile, 'unstable s (d1)')
	call ifile_append (ifile, 'polarized f, fbar')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Show model"
	write (u, "(A)")

	call global%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Extra Input"
	write (u, "(A)")

	call ifile_final (ifile)
	call ifile_append (ifile, '?diagonal_decay = true')
	call ifile_append (ifile, 'unstable s (d1)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%final ()
	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Show model"
	write (u, "(A)")

	call global%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Extra Input"
	write (u, "(A)")

	call ifile_final (ifile)
	call ifile_append (ifile, '?isotropic_decay = true')
	call ifile_append (ifile, 'unstable s (d1)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%final ()
	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Show model"
	write (u, "(A)")

	call global%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Extra Input"
	write (u, "(A)")

	call ifile_final (ifile)
	call ifile_append (ifile, 'stable s')
	call ifile_append (ifile, 'unpolarized f')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%final ()
	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Show model"
	write (u, "(A)")

	call global%model%write (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_model_file_init ()
	call syntax_cmd_list_final ()

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

	end subroutine commands_27

	@ %def commands_27
	@
	\subsubsection{Quit the program}
	Quit the program.
	<<Commands: execute tests>>=
	call test (commands_28, "commands_28", &
	"quit", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_28
	<<Commands: tests>>=
	subroutine commands_28 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root1, pn_root2
	type(string_t), dimension(0) :: no_vars

	write (u, "(A)") "* Test output: commands_28"
	write (u, "(A)") "* Purpose: quit the program"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file: quit without code"
	write (u, "(A)")

	call ifile_append (ifile, 'quit')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root1, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root1, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write (u, vars = no_vars)

	write (u, "(A)")
	write (u, "(A)") "* Input file: quit with code"
	write (u, "(A)")

	call ifile_final (ifile)
	call command_list%final ()
	call ifile_append (ifile, 'quit ( 3 + 4 )')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root2, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root2, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write (u, vars = no_vars)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

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

	end subroutine commands_28

	@ %def commands_28
	@
	\subsubsection{SLHA interface}
	Testing commands steering the SLHA interface.
	<<Commands: execute tests>>=
	call test (commands_29, "commands_29", &
	"SLHA interface", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_29
	<<Commands: tests>>=
	subroutine commands_29 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(var_list_t), pointer :: model_vars
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_29"
	write (u, "(A)") "* Purpose: test SLHA interface"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call syntax_slha_init ()
	call global%global_init ()

	write (u, "(A)") "* Model MSSM, read SLHA file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "MSSM"')
	call ifile_append (ifile, '?slha_read_decays = true')
	call ifile_append (ifile, 'read_slha ("sps1ap_decays.slha")')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Model MSSM, default values:"
	write (u, "(A)")

	call global%model%write (u, verbose = .false., &
	show_vertices = .false., show_particles = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Selected global variables"
	write (u, "(A)")

	model_vars => global%model%get_var_list_ptr ()

	call var_list_write_var (model_vars, var_str ("mch1"), u)
	call var_list_write_var (model_vars, var_str ("wch1"), u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Model MSSM, values from SLHA file"
	write (u, "(A)")

	call global%model%write (u, verbose = .false., &
	show_vertices = .false., show_particles = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Selected global variables"
	write (u, "(A)")

	model_vars => global%model%get_var_list_ptr ()

	call var_list_write_var (model_vars, var_str ("mch1"), u)
	call var_list_write_var (model_vars, var_str ("wch1"), u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_slha_final ()
	call syntax_model_file_final ()
	call syntax_cmd_list_final ()

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

	end subroutine commands_29

	@ %def commands_29
	@
	\subsubsection{Expressions for scales}
	Declare a scale, factorization scale or factorization scale expression.
	<<Commands: execute tests>>=
	call test (commands_30, "commands_30", &
	"scales", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_30
	<<Commands: tests>>=
	subroutine commands_30 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_30"
	write (u, "(A)") "* Purpose: define scales"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'scale = 200 GeV')
	call ifile_append (ifile, &
	'factorization_scale = eval Pt [particle]')
	call ifile_append (ifile, &
	'renormalization_scale = eval E [particle]')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_expr (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

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

	end subroutine commands_30

	@ %def commands_30
	@
	\subsubsection{Weight and reweight expressions}
	Declare an expression for event weights and reweighting.
	<<Commands: execute tests>>=
	call test (commands_31, "commands_31", &
	"event weights/reweighting", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_31
	<<Commands: tests>>=
	subroutine commands_31 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_31"
	write (u, "(A)") "* Purpose: define weight/reweight"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'weight = eval Pz [particle]')
	call ifile_append (ifile, 'reweight = eval M2 [particle]')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_expr (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_31

	@ %def commands_31
	@
	\subsubsection{Selecting events}
	Declare an expression for selecting events in an analysis.
	<<Commands: execute tests>>=
	call test (commands_32, "commands_32", &
	"event selection", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_32
	<<Commands: tests>>=
	subroutine commands_32 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_32"
	write (u, "(A)") "* Purpose: define selection"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'selection = any PDG == 13 [particle]')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_expr (u)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

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

	end subroutine commands_32

	@ %def commands_32
	@
	\subsubsection{Executing shell commands}
	Execute a shell command.
	<<Commands: execute tests>>=
	call test (commands_33, "commands_33", &
	"execute shell command", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_33
	<<Commands: tests>>=
	subroutine commands_33 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	integer :: u_file, iostat
	character(3) :: buffer

	write (u, "(A)") "* Test output: commands_33"
	write (u, "(A)") "* Purpose: execute shell command"
	write (u, "(A)")

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

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'exec ("echo foo >> bar")')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)
	u_file = free_unit ()
	open (u_file, file = "bar", &
	action = "read", status = "old")
	do
	read (u_file, "(A)", iostat = iostat) buffer
	if (iostat /= 0) exit
	end do
	write (u, "(A,A)") "should be 'foo': ", trim (buffer)
	close (u_file)

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

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

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

	end subroutine commands_33

	@ %def commands_33
	@
	\subsubsection{Callback}
	Instead of an explicit write, use the callback feature to write the
	analysis file during event generation. We generate 4 events and
	arrange that the callback is executed while writing the 3rd event.
	<<Commands: execute tests>>=
	call test (commands_34, "commands_34", &
	"analysis via callback", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_34
	<<Commands: tests>>=
	subroutine commands_34 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib
	type(event_callback_34_t) :: event_callback

	write (u, "(A)") "* Test output: commands_34"
	write (u, "(A)") "* Purpose: write analysis data"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create observable"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd34"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Prepare callback for writing analysis to I/O unit"
	write (u, "(A)")

	event_callback%u = u
	call global%set_event_callback (event_callback)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_34_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (commands_34_p)')
	call ifile_append (ifile, 'observable sq')
	call ifile_append (ifile, 'analysis = record sq (sqrts)')
	call ifile_append (ifile, 'n_events = 4')
	call ifile_append (ifile, 'event_callback_interval = 3')
	call ifile_append (ifile, 'simulate (commands_34_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

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

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

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

	end subroutine commands_34

	@ %def commands_34
	@ For this test, we invent a callback object which simply writes the
	analysis file, using the standard call for this. Here we rely on the
	fact that the analysis data are stored as a global entity, otherwise
	we would have to access them via the event object.
	<<Commands: test auxiliary types>>=
	type, extends (event_callback_t) :: event_callback_34_t
	private
	integer :: u = 0
	contains
	procedure :: write => event_callback_34_write
	procedure :: proc => event_callback_34
	end type event_callback_34_t

	@ %def event_callback_t
	@ The output routine is unused. The actual callback should write the
	analysis data to the output unit that we have injected into the
	callback object.
	<<Commands: test auxiliary>>=
	subroutine event_callback_34_write (event_callback, unit)
	class(event_callback_34_t), intent(in) :: event_callback
	integer, intent(in), optional :: unit
	end subroutine event_callback_34_write

	subroutine event_callback_34 (event_callback, i, event)
	class(event_callback_34_t), intent(in) :: event_callback
	integer(i64), intent(in) :: i
	class(generic_event_t), intent(in) :: event
	call analysis_write (event_callback%u)
	end subroutine event_callback_34

	@ %def event_callback_34_write
	@ %def event_callback_34
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Toplevel module WHIZARD}
	<<[[whizard.f90]]>>=
	<<File header>>

	module whizard

	use io_units
	<<Use strings>>
	use system_defs, only: VERSION_STRING
	use system_defs, only: EOF, BACKSLASH
	use diagnostics
	use os_interface
	use ifiles
	use lexers
	use parser
	use variables
	use eval_trees
	use models
	use phs_forests
	use prclib_stacks
	use slha_interface
	use blha_config
	use rt_data
	use commands

	<<Standard module head>>

	<<WHIZARD: public>>

	<<WHIZARD: types>>

	save

	contains

	<<WHIZARD: procedures>>

	end module whizard
	@ %def whizard
	@
	\subsection{Options}
	Here we introduce a wrapper that holds various user options, so they
	can transparently be passed from the main program to the [[whizard]]
	object. Most parameters are used for initializing the [[global]]
	state.
	<<WHIZARD: public>>=
	public :: whizard_options_t
	<<WHIZARD: types>>=
	type :: whizard_options_t
	type(string_t) :: preload_model
	type(string_t) :: default_lib
	type(string_t) :: preload_libraries
	logical :: rebuild_library = .false.
	logical :: recompile_library = .false.
	logical :: rebuild_user
	logical :: rebuild_phs = .false.
	logical :: rebuild_grids = .false.
	logical :: rebuild_events = .false.
	end type whizard_options_t

	@ %def whizard_options_t
	@
	\subsection{Parse tree stack}
	We collect all parse trees that we generate in the [[whizard]] object. To
	this end, we create a stack of parse trees. They must not be finalized before
	the [[global]] object is finalized, because items such as a cut definition may
	contain references to the parse tree from which they were generated.
	<<WHIZARD: types>>=
	type, extends (parse_tree_t) :: pt_entry_t
	type(pt_entry_t), pointer :: previous => null ()
	end type pt_entry_t

	@ %def pt_entry_t
	@ This is the stack. Since we always prepend, we just need the [[last]]
	pointer.
	<<WHIZARD: types>>=
	type :: pt_stack_t
	type(pt_entry_t), pointer :: last => null ()
	contains
	<<WHIZARD: pt stack: TBP>>
	end type pt_stack_t

	@ %def pt_stack_t
	@ The finalizer is called at the very end.
	<<WHIZARD: pt stack: TBP>>=
	procedure :: final => pt_stack_final
	<<WHIZARD: procedures>>=
	subroutine pt_stack_final (pt_stack)
	class(pt_stack_t), intent(inout) :: pt_stack
	type(pt_entry_t), pointer :: current
	do while (associated (pt_stack%last))
	current => pt_stack%last
	pt_stack%last => current%previous
	call parse_tree_final (current%parse_tree_t)
	deallocate (current)
	end do
	end subroutine pt_stack_final

	@ %def pt_stack_final
	@ Create and push a new entry, keeping the previous ones.
	<<WHIZARD: pt stack: TBP>>=
	procedure :: push => pt_stack_push
	<<WHIZARD: procedures>>=
	subroutine pt_stack_push (pt_stack, parse_tree)
	class(pt_stack_t), intent(inout) :: pt_stack
	type(parse_tree_t), intent(out), pointer :: parse_tree
	type(pt_entry_t), pointer :: current
	allocate (current)
	parse_tree => current%parse_tree_t
	current%previous => pt_stack%last
	pt_stack%last => current
	end subroutine pt_stack_push

	@ %def pt_stack_push
	@
	\subsection{The [[whizard]] object}
	An object of type [[whizard_t]] is the top-level wrapper for a
	\whizard\ instance. The object holds various default
	settings and the current state of the generator, the [[global]] object
	of type [[rt_data_t]]. This object contains, for instance, the list
	of variables and the process libraries.

	Since components of the [[global]] subobject are frequently used as
	targets, the [[whizard]] object should also consistently carry the
	[[target]] attribute.

	The various self-tests do no not use this object. They initialize
	only specific subsets of the system, according to their needs.

	Note: we intend to allow several concurrent instances. In the current
	implementation, there are still a few obstacles to this: the model
	library and the syntax tables are global variables, and the error
	handling uses global state. This should be improved.
	<<WHIZARD: public>>=
	public :: whizard_t
	<<WHIZARD: types>>=
	type :: whizard_t
	type(whizard_options_t) :: options
	type(rt_data_t) :: global
	type(pt_stack_t) :: pt_stack
	contains
	<<WHIZARD: whizard: TBP>>
	end type whizard_t

	@ %def whizard_t
	@
	\subsection{Initialization and finalization}
	<<WHIZARD: whizard: TBP>>=
	procedure :: init => whizard_init
	<<WHIZARD: procedures>>=
	subroutine whizard_init (whizard, options, paths, logfile)
	class(whizard_t), intent(out), target :: whizard
	type(whizard_options_t), intent(in) :: options
	type(paths_t), intent(in), optional :: paths
	type(string_t), intent(in), optional :: logfile
	call init_syntax_tables ()
	whizard%options = options
	call whizard%global%global_init (paths, logfile)
	call whizard%init_rebuild_flags ()
	call whizard%preload_model ()
	call whizard%preload_library ()
	call whizard%global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
	call whizard%global%init_radiation_model &
	(var_str ("SM_rad"), var_str ("SM_rad.mdl"))
	end subroutine whizard_init

	@ %def whizard_init
	@ Apart from the global data which have been initialized above, the
	process and model lists need to be finalized.
	<<WHIZARD: whizard: TBP>>=
	procedure :: final => whizard_final
	<<WHIZARD: procedures>>=
	subroutine whizard_final (whizard)
	class(whizard_t), intent(inout), target :: whizard
	call whizard%global%final ()
	call whizard%pt_stack%final ()
	!!! JRR: WK please check (#529)
	! call user_code_final ()
	call final_syntax_tables ()
	end subroutine whizard_final

	@ %def whizard_final
	@
	Set the rebuild flags. They can be specified on the command line and
	set the initial value for the associated logical variables.
	<<WHIZARD: whizard: TBP>>=
	procedure :: init_rebuild_flags => whizard_init_rebuild_flags
	<<WHIZARD: procedures>>=
	subroutine whizard_init_rebuild_flags (whizard)
	class(whizard_t), intent(inout), target :: whizard
	associate (var_list => whizard%global%var_list, options => whizard%options)
	call var_list_append_log &
	(var_list, var_str ("?rebuild_library"), options%rebuild_library, &
	intrinsic=.true.)
	call var_list_append_log &
	(var_list, var_str ("?recompile_library"), &
	options%recompile_library, &
	intrinsic=.true.)
	call var_list_append_log &
	(var_list, var_str ("?rebuild_phase_space"), options%rebuild_phs, &
	intrinsic=.true.)
	call var_list_append_log &
	(var_list, var_str ("?rebuild_grids"), options%rebuild_grids, &
	intrinsic=.true.)
	call var_list_append_log &
	(var_list, var_str ("?powheg_rebuild_grids"), options%rebuild_grids, &
	intrinsic=.true.)
	call var_list_append_log &
	(var_list, var_str ("?rebuild_events"), options%rebuild_events, &
	intrinsic=.true.)
	end associate
	end subroutine whizard_init_rebuild_flags

	@ %def whizard_init_rebuild_flags
	@
	This procedure preloads a model, if a model name is given.
	<<WHIZARD: whizard: TBP>>=
	procedure :: preload_model => whizard_preload_model
	<<WHIZARD: procedures>>=
	subroutine whizard_preload_model (whizard)
	class(whizard_t), intent(inout), target :: whizard
	type(string_t) :: model_name
	model_name = whizard%options%preload_model
	if (model_name /= "") then
	call whizard%global%read_model (model_name, whizard%global%preload_model)
	whizard%global%model => whizard%global%preload_model
	if (associated (whizard%global%model)) then
	call whizard%global%model%link_var_list (whizard%global%var_list)
	call msg_message ("Preloaded model: " &
	// char (model_name))
	else
	call msg_fatal ("Preloading model " // char (model_name) &
	// " failed")
	end if
	else
	call msg_message ("No model preloaded")
	end if
	end subroutine whizard_preload_model

	@ %def whizard_preload_model
	@
	This procedure preloads a library, if a library name is given.

	Note: This version just opens a new library with that name. It does not load
	(yet) an existing library on file, as previous \whizard\ versions would do.
	<<WHIZARD: whizard: TBP>>=
	procedure :: preload_library => whizard_preload_library
	<<WHIZARD: procedures>>=
	subroutine whizard_preload_library (whizard)
	class(whizard_t), intent(inout), target :: whizard
	type(string_t) :: library_name, libs
	type(string_t), dimension(:), allocatable :: libname_static
	type(prclib_entry_t), pointer :: lib_entry
	integer :: i
	call get_prclib_static (libname_static)
	do i = 1, size (libname_static)
	allocate (lib_entry)
	call lib_entry%init_static (libname_static(i))
	call whizard%global%add_prclib (lib_entry)
	end do
	libs = adjustl (whizard%options%preload_libraries)
	if (libs == "" .and. whizard%options%default_lib /= "") then
	allocate (lib_entry)
	call lib_entry%init (whizard%options%default_lib)
	call whizard%global%add_prclib (lib_entry)
	call msg_message ("Preloaded library: " // &
	char (whizard%options%default_lib))
	end if
	SCAN_LIBS: do while (libs /= "")
	call split (libs, library_name, " ")
	if (library_name /= "") then
	allocate (lib_entry)
	call lib_entry%init (library_name)
	call whizard%global%add_prclib (lib_entry)
	call msg_message ("Preloaded library: " // char (library_name))
	end if
	end do SCAN_LIBS
	end subroutine whizard_preload_library

	@ %def whizard_preload_library
	@
	\subsection{Initialization and finalization (old version)}
	These procedures initialize and finalize global variables. Most of
	them are collected in the [[global]] data record located here, the
	others are syntax tables located in various modules, which do not
	change during program execution. Furthermore, there is a global model
	list and a global process store, which get filled during program
	execution but are finalized here.

	During initialization, we can preload a default model and initialize a
	default library for setting up processes. The default library is
	loaded if requested by the setup. Further libraries can be loaded as
	specified by command-line flags.
	@ Initialize/finalize the syntax tables used by WHIZARD:
	<<WHIZARD: public>>=
	public :: init_syntax_tables
	public :: final_syntax_tables
	<<WHIZARD: procedures>>=
	subroutine init_syntax_tables ()
	call syntax_model_file_init ()
	call syntax_phs_forest_init ()
	call syntax_pexpr_init ()
	call syntax_slha_init ()
	call syntax_cmd_list_init ()
	end subroutine init_syntax_tables

	subroutine final_syntax_tables ()
	call syntax_model_file_final ()
	call syntax_phs_forest_final ()
	call syntax_pexpr_final ()
	call syntax_slha_final ()
	call syntax_cmd_list_final ()
	end subroutine final_syntax_tables

	@ %def init_syntax_tables
	@ %def final_syntax_tables
	@ Write the syntax tables to external files.
	<<WHIZARD: public>>=
	public :: write_syntax_tables
	<<WHIZARD: procedures>>=
	subroutine write_syntax_tables ()
	integer :: unit
	character(*), parameter :: file_model = "whizard.model_file.syntax"
	character(*), parameter :: file_phs = "whizard.phase_space_file.syntax"
	character(*), parameter :: file_pexpr = "whizard.prt_expressions.syntax"
	character(*), parameter :: file_slha = "whizard.slha.syntax"
	character(*), parameter :: file_sindarin = "whizard.sindarin.syntax"
	unit = free_unit ()
	print *, "Writing file '" // file_model // "'"
	open (unit=unit, file=file_model, status="replace", action="write")
	write (unit, "(A)") VERSION_STRING
	write (unit, "(A)") "Syntax definition file: " // file_model
	call syntax_model_file_write (unit)
	close (unit)
	print *, "Writing file '" // file_phs // "'"
	open (unit=unit, file=file_phs, status="replace", action="write")
	write (unit, "(A)") VERSION_STRING
	write (unit, "(A)") "Syntax definition file: " // file_phs
	call syntax_phs_forest_write (unit)
	close (unit)
	print *, "Writing file '" // file_pexpr // "'"
	open (unit=unit, file=file_pexpr, status="replace", action="write")
	write (unit, "(A)") VERSION_STRING
	write (unit, "(A)") "Syntax definition file: " // file_pexpr
	call syntax_pexpr_write (unit)
	close (unit)
	print *, "Writing file '" // file_slha // "'"
	open (unit=unit, file=file_slha, status="replace", action="write")
	write (unit, "(A)") VERSION_STRING
	write (unit, "(A)") "Syntax definition file: " // file_slha
	call syntax_slha_write (unit)
	close (unit)
	print *, "Writing file '" // file_sindarin // "'"
	open (unit=unit, file=file_sindarin, status="replace", action="write")
	write (unit, "(A)") VERSION_STRING
	write (unit, "(A)") "Syntax definition file: " // file_sindarin
	call syntax_cmd_list_write (unit)
	close (unit)
	end subroutine write_syntax_tables

	@ %def write_syntax_tables
	@
	\subsection{Execute command lists}
	Process commands given on the command line, stored as an [[ifile]]. The whole
	input is read, compiled and executed as a whole.
	<<WHIZARD: whizard: TBP>>=
	procedure :: process_ifile => whizard_process_ifile
	<<WHIZARD: procedures>>=
	subroutine whizard_process_ifile (whizard, ifile, quit, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	type(ifile_t), intent(in) :: ifile
	logical, intent(out) :: quit
	integer, intent(out) :: quit_code
	type(lexer_t), target :: lexer
	type(stream_t), target :: stream
	call msg_message ("Reading commands given on the command line")
	call lexer_init_cmd_list (lexer)
	call stream_init (stream, ifile)
	call whizard%process_stream (stream, lexer, quit, quit_code)
	call stream_final (stream)
	call lexer_final (lexer)
	end subroutine whizard_process_ifile

	@ %def whizard_process_ifile
	@ Process standard input as a command list. The whole input is read,
	compiled and executed as a whole.
	<<WHIZARD: whizard: TBP>>=
	procedure :: process_stdin => whizard_process_stdin
	<<WHIZARD: procedures>>=
	subroutine whizard_process_stdin (whizard, quit, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	logical, intent(out) :: quit
	integer, intent(out) :: quit_code
	type(lexer_t), target :: lexer
	type(stream_t), target :: stream
	call msg_message ("Reading commands from standard input")
	call lexer_init_cmd_list (lexer)
	call stream_init (stream, 5)
	call whizard%process_stream (stream, lexer, quit, quit_code)
	call stream_final (stream)
	call lexer_final (lexer)
	end subroutine whizard_process_stdin

	@ %def whizard_process_stdin
	@ Process a file as a command list.
	<<WHIZARD: whizard: TBP>>=
	procedure :: process_file => whizard_process_file
	<<WHIZARD: procedures>>=
	subroutine whizard_process_file (whizard, file, quit, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	type(string_t), intent(in) :: file
	logical, intent(out) :: quit
	integer, intent(out) :: quit_code
	type(lexer_t), target :: lexer
	type(stream_t), target :: stream
	logical :: exist
	call msg_message ("Reading commands from file '" // char (file) // "'")
	inquire (file=char(file), exist=exist)
	if (exist) then
	call lexer_init_cmd_list (lexer)
	call stream_init (stream, char (file))
	call whizard%process_stream (stream, lexer, quit, quit_code)
	call stream_final (stream)
	call lexer_final (lexer)
	else
	call msg_error ("File '" // char (file) // "' not found")
	end if
	end subroutine whizard_process_file

	@ %def whizard_process_file
	@
	<<WHIZARD: whizard: TBP>>=
	procedure :: process_stream => whizard_process_stream
	<<WHIZARD: procedures>>=
	subroutine whizard_process_stream (whizard, stream, lexer, quit, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	type(stream_t), intent(inout), target :: stream
	type(lexer_t), intent(inout), target :: lexer
	logical, intent(out) :: quit
	integer, intent(out) :: quit_code
	type(parse_tree_t), pointer :: parse_tree
	type(command_list_t), target :: command_list
	call lexer_assign_stream (lexer, stream)
	call whizard%pt_stack%push (parse_tree)
	call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
	if (associated (parse_tree%get_root_ptr ())) then
	whizard%global%lexer => lexer
	call command_list%compile (parse_tree%get_root_ptr (), &
	whizard%global)
	end if
	call whizard%global%activate ()
	call command_list%execute (whizard%global)
	call command_list%final ()
	quit = whizard%global%quit
	quit_code = whizard%global%quit_code
	end subroutine whizard_process_stream

	@ %def whizard_process_stream
	@
	\subsection{The WHIZARD shell}
	This procedure implements interactive mode. One line is processed at
	a time.
	<<WHIZARD: whizard: TBP>>=
	procedure :: shell => whizard_shell
	<<WHIZARD: procedures>>=
	subroutine whizard_shell (whizard, quit_code)
	class(whizard_t), intent(inout), target :: whizard
	integer, intent(out) :: quit_code
	type(lexer_t), target :: lexer
	type(stream_t), target :: stream
	type(string_t) :: prompt1
	type(string_t) :: prompt2
	type(string_t) :: input
	type(string_t) :: extra
	integer :: last
	integer :: iostat
	logical :: mask_tmp
	logical :: quit
	call msg_message ("Launching interactive shell")
	call lexer_init_cmd_list (lexer)
	prompt1 = "whish? "
	prompt2 = " > "
	COMMAND_LOOP: do
	call put (6, prompt1)
	call get (5, input, iostat=iostat)
	if (iostat > 0 .or. iostat == EOF) exit COMMAND_LOOP
	CONTINUE_INPUT: do
	last = len_trim (input)
	if (extract (input, last, last) /= BACKSLASH) exit CONTINUE_INPUT
	call put (6, prompt2)
	call get (5, extra, iostat=iostat)
	if (iostat > 0) exit COMMAND_LOOP
	input = replace (input, last, extra)
	end do CONTINUE_INPUT
	call stream_init (stream, input)
	mask_tmp = mask_fatal_errors
	mask_fatal_errors = .true.
	call whizard%process_stream (stream, lexer, quit, quit_code)
	msg_count = 0
	mask_fatal_errors = mask_tmp
	call stream_final (stream)
	if (quit) exit COMMAND_LOOP
	end do COMMAND_LOOP
	print *
	call lexer_final (lexer)
	end subroutine whizard_shell

	@ %def whizard_shell
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Tools for the command line}

	We don't intent to be very smart here, but this module provides a few
	small tools that simplify dealing with the command line.
	<<[[cmdline_options.f90]]>>=
	<<File header>>

	module cmdline_options

	<<Use strings>>
	use diagnostics

	<<Standard module head>>

	public :: init_options
	public :: no_option_value
	public :: get_option_value

	<<Main: cmdline arg len declaration>>

	abstract interface
	subroutine msg
	end subroutine msg
	end interface

	procedure (msg), pointer :: print_usage => null ()

	contains

	subroutine init_options (usage_msg)
	procedure (msg) :: usage_msg
	print_usage => usage_msg
	end subroutine init_options

	subroutine no_option_value (option, value)
	type(string_t), intent(in) :: option, value
	if (value /= "") then
	call msg_error (" Option '" // char (option) // "' should have no value")
	end if
	end subroutine no_option_value

	function get_option_value (i, option, value) result (string)
	type(string_t) :: string
	integer, intent(inout) :: i
	type(string_t), intent(in) :: option
	type(string_t), intent(in), optional :: value
	character(CMDLINE_ARG_LEN) :: arg_value
	integer :: arg_len, arg_status
	logical :: has_value
	if (present (value)) then
	has_value = value /= ""
	else
	has_value = .false.
	end if
	if (has_value) then
	string = value
	else
	i = i + 1
	call get_command_argument (i, arg_value, arg_len, arg_status)
	select case (arg_status)
	case (0)
	case (-1)
	call msg_error (" Option value truncated: '" // arg_value // "'")
	case default
	call print_usage ()
	call msg_fatal (" Option '" // char (option) // "' needs a value")
	end select
	select case (arg_value(1:1))
	case ("-")
	call print_usage ()
	call msg_fatal (" Option '" // char (option) // "' needs a value")
	end select
	string = trim (arg_value)
	end if
	end function get_option_value

	end module cmdline_options

	@ %def init_options
	@ %def no_option_value
	@ %def get_option_value
	@ %def cmdline_options
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Query Feature Support}
	This module accesses the various optional features (modules) that
	WHIZARD can support and repors on their availability.
	<<[[features.f90]]>>=
	module features

	use string_utils, only: lower_case
	use system_dependencies, only: WHIZARD_VERSION
	<<Features: dependencies>>

	<<Standard module head>>

	<<Features: public>>

	contains

	<<Features: procedures>>

	end module features
	@ %def features
	@
	\subsection{Output}
	<<Features: public>>=
	public :: print_features
	<<Features: procedures>>=
	subroutine print_features ()
	print "(A)", "WHIZARD " // WHIZARD_VERSION
	print "(A)", "Build configuration:"
	<<Features: config>>
	print "(A)", "Optional features available in this build:"
	<<Features: print>>
	end subroutine print_features

	@ %def print_features
	@
	\subsection{Query function}
	<<Features: procedures>>=
	subroutine check (feature, recognized, result, help)
	character(*), intent(in) :: feature
	logical, intent(out) :: recognized
	character(*), intent(out) :: result, help
	recognized = .true.
	result = "no"
	select case (lower_case (trim (feature)))
	<<Features: cases>>
	case default
	recognized = .false.
	end select
	end subroutine check

	@ %def check
	@ Print this result:
	<<Features: procedures>>=
	subroutine print_check (feature)
	character(*), intent(in) :: feature
	character(16) :: f
	logical :: recognized
	character(10) :: result
	character(48) :: help
	call check (feature, recognized, result, help)
	if (.not. recognized) then
	result = "unknown"
	help = ""
	end if
	f = feature
	print "(2x,A,1x,A,'(',A,')')", f, result, trim (help)
	end subroutine print_check

	@ %def print_check
	@
	\subsection{Basic configuration}
	<<Features: config>>=
	call print_check ("precision")
	<<Features: dependencies>>=
	use kinds, only: default
	<<Features: cases>>=
	case ("precision")
	write (result, "(I0)") precision (1._default)
	help = "significant decimals of real/complex numbers"
	@
	\subsection{Optional features case by case}
	<<Features: print>>=
	call print_check ("OpenMP")
	<<Features: dependencies>>=
	use system_dependencies, only: openmp_is_active
	<<Features: cases>>=
	case ("openmp")
	if (openmp_is_active ()) then
	result = "yes"
	end if
	help = "OpenMP parallel execution"
	@
	<<Features: print>>=
	call print_check ("GoSam")
	<<Features: dependencies>>=
	use system_dependencies, only: GOSAM_AVAILABLE
	<<Features: cases>>=
	case ("gosam")
	if (GOSAM_AVAILABLE) then
	result = "yes"
	end if
	help = "external NLO matrix element provider"
	@
	<<Features: print>>=
	call print_check ("OpenLoops")
	<<Features: dependencies>>=
	use system_dependencies, only: OPENLOOPS_AVAILABLE
	<<Features: cases>>=
	case ("openloops")
	if (OPENLOOPS_AVAILABLE) then
	result = "yes"
	end if
	help = "external NLO matrix element provider"
	@
	<<Features: print>>=
	call print_check ("LHAPDF")
	<<Features: dependencies>>=
	use system_dependencies, only: LHAPDF5_AVAILABLE
	use system_dependencies, only: LHAPDF6_AVAILABLE
	<<Features: cases>>=
	case ("lhapdf")
	if (LHAPDF5_AVAILABLE) then
	result = "v5"
	else if (LHAPDF6_AVAILABLE) then
	result = "v6"
	end if
	help = "PDF library"
	@
	<<Features: print>>=
	call print_check ("HOPPET")
	<<Features: dependencies>>=
	use system_dependencies, only: HOPPET_AVAILABLE
	<<Features: cases>>=
	case ("hoppet")
	if (HOPPET_AVAILABLE) then
	result = "yes"
	end if
	help = "PDF evolution package"
	@
	<<Features: print>>=
	call print_check ("fastjet")
	<<Features: dependencies>>=
	use jets, only: fastjet_available
	<<Features: cases>>=
	case ("fastjet")
	if (fastjet_available ()) then
	result = "yes"
	end if
	help = "jet-clustering package"
	@
	<<Features: print>>=
	call print_check ("Pythia6")
	<<Features: dependencies>>=
	use system_dependencies, only: PYTHIA6_AVAILABLE
	<<Features: cases>>=
	case ("pythia6")
	if (PYTHIA6_AVAILABLE) then
	result = "yes"
	end if
	help = "direct access for shower/hadronization"
	@
	<<Features: print>>=
	call print_check ("Pythia8")
	<<Features: dependencies>>=
	use system_dependencies, only: PYTHIA8_AVAILABLE
	<<Features: cases>>=
	case ("pythia8")
	if (PYTHIA8_AVAILABLE) then
	result = "yes"
	end if
	help = "direct access for shower/hadronization"
	@
	<<Features: print>>=
	call print_check ("StdHEP")
	<<Features: cases>>=
	case ("stdhep")
	result = "yes"
	help = "event I/O format"
	@
	<<Features: print>>=
	call print_check ("HepMC")
	<<Features: dependencies>>=
	use hepmc_interface, only: hepmc_is_available
	<<Features: cases>>=
	case ("hepmc")
	if (hepmc_is_available ()) then
	result = "yes"
	end if
	help = "event I/O format"
	@
	<<Features: print>>=
	call print_check ("LCIO")
	<<Features: dependencies>>=
	use lcio_interface, only: lcio_is_available
	<<Features: cases>>=
	case ("lcio")
	if (lcio_is_available ()) then
	result = "yes"
	end if
	help = "event I/O format"
	@
	<<Features: print>>=
	call print_check ("MetaPost")
	<<Features: dependencies>>=
	use system_dependencies, only: EVENT_ANALYSIS
	<<Features: cases>>=
	case ("metapost")
	result = EVENT_ANALYSIS
	help = "graphical event analysis via LaTeX/MetaPost"
	@
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Driver program}
	The main program handles command options, initializes the environment,
	and runs WHIZARD in a particular mode (interactive, file, standard
	input).

	This is also used in the C interface:
	<<Main: cmdline arg len declaration>>=
	integer, parameter :: CMDLINE_ARG_LEN = 1000
	@ %def CMDLINE_ARG_LEN
	@
	The actual main program:
	<<[[main.f90]]>>=
	<<File header>>

	program main

	<<Use strings>>
	use unit_tests
	use system_dependencies
	use diagnostics
	use ifiles
	use os_interface
	use whizard

	use cmdline_options
	use features

	implicit none

	<<Main: cmdline arg len declaration>>

	!!! (WK 02/2016) Interface for the separate external routine below
	interface
	subroutine print_usage ()
	end subroutine print_usage
	end interface

	! Main program variable declarations
	character(CMDLINE_ARG_LEN) :: arg
	character(2) :: option
	type(string_t) :: long_option, value
	integer :: i, j, arg_len, arg_status, area
	logical :: look_for_options
	logical :: interactive
	logical :: banner
	type(string_t) :: files, this, model, default_lib, library, libraries
	type(string_t) :: logfile
	logical :: user_code_enable = .false.
	integer :: n_user_src = 0, n_user_lib = 0
	type(string_t) :: user_src, user_lib, user_target
	type(paths_t) :: paths
	logical :: rebuild_library, rebuild_user
	logical :: rebuild_phs, rebuild_grids, rebuild_events
	logical :: recompile_library
	type(ifile_t) :: commands
	type(string_t) :: command

	type(whizard_options_t), allocatable :: options
	type(whizard_t), allocatable, target :: whizard_instance

	! Exit status
	logical :: quit = .false.
	integer :: quit_code = 0

	! Initial values
	look_for_options = .true.
	interactive = .false.
	files = ""
	model = "SM"
	default_lib = "default_lib"
	library = ""
	libraries = ""
	banner = .true.
	logging = .true.
	msg_level = RESULT
	logfile = "whizard.log"
	user_src = ""
	user_lib = ""
	user_target = ""
	rebuild_library = .false.
	rebuild_user = .false.
	rebuild_phs = .false.
	rebuild_grids = .false.
	rebuild_events = .false.
	recompile_library = .false.
	call paths_init (paths)

	! Read and process options
	call init_options (print_usage)
	i = 0
	SCAN_CMDLINE: do
	i = i + 1
	call get_command_argument (i, arg, arg_len, arg_status)
	select case (arg_status)
	case (0)
	case (-1)
	call msg_error (" Command argument truncated: '" // arg // "'")
	case default
	exit SCAN_CMDLINE
	end select
	if (look_for_options) then
	select case (arg(1:2))
	case ("--")
	value = trim (arg)
	call split (value, long_option, "=")
	select case (char (long_option))
	case ("--version")
	call no_option_value (long_option, value)
	call print_version (); stop
	case ("--help")
	call no_option_value (long_option, value)
	call print_usage (); stop
	case ("--prefix")
	paths%prefix = get_option_value (i, long_option, value)
	cycle scan_cmdline
	case ("--exec-prefix")
	paths%exec_prefix = get_option_value (i, long_option, value)
	cycle SCAN_CMDLINE
	case ("--bindir")
	paths%bindir = get_option_value (i, long_option, value)
	cycle SCAN_CMDLINE
	case ("--libdir")
	paths%libdir = get_option_value (i, long_option, value)
	cycle SCAN_CMDLINE
	case ("--includedir")
	paths%includedir = get_option_value (i, long_option, value)
	cycle SCAN_CMDLINE
	case ("--datarootdir")
	paths%datarootdir = get_option_value (i, long_option, value)
	cycle SCAN_CMDLINE
	case ("--libtool")
	paths%libtool = get_option_value (i, long_option, value)
	cycle SCAN_CMDLINE
	case ("--lhapdfdir")
	paths%lhapdfdir = get_option_value (i, long_option, value)
	cycle SCAN_CMDLINE
	case ("--check")
	call print_usage ()
	call msg_fatal ("Option --check not supported &
	&(for unit tests, run whizard_ut instead)")
	case ("--show-config")
	call no_option_value (long_option, value)
	call print_features (); stop
	case ("--execute")
	command = get_option_value (i, long_option, value)
	call ifile_append (commands, command)
	cycle SCAN_CMDLINE
	case ("--interactive")
	call no_option_value (long_option, value)
	interactive = .true.
	cycle SCAN_CMDLINE
	case ("--library")
	library = get_option_value (i, long_option, value)
	libraries = libraries // " " // library
	cycle SCAN_CMDLINE
	case ("--no-library")
	call no_option_value (long_option, value)
	default_lib = ""
	library = ""
	libraries = ""
	cycle SCAN_CMDLINE
	case ("--localprefix")
	paths%localprefix = get_option_value (i, long_option, value)
	cycle SCAN_CMDLINE
	case ("--logfile")
	logfile = get_option_value (i, long_option, value)
	cycle SCAN_CMDLINE
	case ("--no-logfile")
	call no_option_value (long_option, value)
	logfile = ""
	cycle SCAN_CMDLINE
	case ("--logging")
	call no_option_value (long_option, value)
	logging = .true.
	cycle SCAN_CMDLINE
	case ("--no-logging")
	call no_option_value (long_option, value)
	logging = .false.
	cycle SCAN_CMDLINE
	case ("--debug")
	call no_option_value (long_option, value)
	area = d_area (get_option_value (i, long_option, value))
	msg_level(area) = DEBUG
	cycle SCAN_CMDLINE
	case ("--debug2")
	call no_option_value (long_option, value)
	area = d_area (get_option_value (i, long_option, value))
	msg_level(area) = DEBUG2
	cycle SCAN_CMDLINE
	case ("--single-event")
	call no_option_value (long_option, value)
	single_event = .true.
	cycle SCAN_CMDLINE
	case ("--banner")
	call no_option_value (long_option, value)
	banner = .true.
	cycle SCAN_CMDLINE
	case ("--no-banner")
	call no_option_value (long_option, value)
	banner = .false.
	cycle SCAN_CMDLINE
	case ("--model")
	model = get_option_value (i, long_option, value)
	cycle SCAN_CMDLINE
	case ("--no-model")
	call no_option_value (long_option, value)
	model = ""
	cycle SCAN_CMDLINE
	case ("--rebuild")
	call no_option_value (long_option, value)
	rebuild_library = .true.
	rebuild_user = .true.
	rebuild_phs = .true.
	rebuild_grids = .true.
	rebuild_events = .true.
	cycle SCAN_CMDLINE
	case ("--no-rebuild")
	call no_option_value (long_option, value)
	rebuild_library = .false.
	recompile_library = .false.
	rebuild_user = .false.
	rebuild_phs = .false.
	rebuild_grids = .false.
	rebuild_events = .false.
	cycle SCAN_CMDLINE
	case ("--rebuild-library")
	call no_option_value (long_option, value)
	rebuild_library = .true.
	cycle SCAN_CMDLINE
	case ("--rebuild-user")
	call no_option_value (long_option, value)
	rebuild_user = .true.
	cycle SCAN_CMDLINE
	case ("--rebuild-phase-space")
	call no_option_value (long_option, value)
	rebuild_phs = .true.
	cycle SCAN_CMDLINE
	case ("--rebuild-grids")
	call no_option_value (long_option, value)
	rebuild_grids = .true.
	cycle SCAN_CMDLINE
	case ("--rebuild-events")
	call no_option_value (long_option, value)
	rebuild_events = .true.
	cycle SCAN_CMDLINE
	case ("--recompile")
	call no_option_value (long_option, value)
	recompile_library = .true.
	rebuild_grids = .true.
	cycle SCAN_CMDLINE
	case ("--user")
	user_code_enable = .true.
	cycle SCAN_CMDLINE
	case ("--user-src")
	if (user_src == "") then
	user_src = get_option_value (i, long_option, value)
	else
	user_src = user_src // " " &
	// get_option_value (i, long_option, value)
	end if
	n_user_src = n_user_src + 1
	cycle SCAN_CMDLINE
	case ("--user-lib")
	if (user_lib == "") then
	user_lib = get_option_value (i, long_option, value)
	else
	user_lib = user_lib // " " &
	// get_option_value (i, long_option, value)
	end if
	n_user_lib = n_user_lib + 1
	cycle SCAN_CMDLINE
	case ("--user-target")
	user_target = get_option_value (i, long_option, value)
	cycle SCAN_CMDLINE
	case ("--write-syntax-tables")
	call no_option_value (long_option, value)
	call init_syntax_tables ()
	call write_syntax_tables ()
	call final_syntax_tables ()
	stop
	cycle SCAN_CMDLINE
	case default
	call print_usage ()
	call msg_fatal ("Option '" // trim (arg) // "' not recognized")
	end select
	end select
	select case (arg(1:1))
	case ("-")
	j = 1
	if (len_trim (arg) == 1) then
	look_for_options = .false.
	else
	SCAN_SHORT_OPTIONS: do
	j = j + 1
	if (j > len_trim (arg)) exit SCAN_SHORT_OPTIONS
	option = "-" // arg(j:j)
	select case (option)
	case ("-V")
	call print_version (); stop
	case ("-?", "-h")
	call print_usage (); stop
	case ("-e")
	command = get_option_value (i, var_str (option))
	call ifile_append (commands, command)
	cycle SCAN_CMDLINE
	case ("-i")
	interactive = .true.
	cycle SCAN_SHORT_OPTIONS
	case ("-l")
	if (j == len_trim (arg)) then
	library = get_option_value (i, var_str (option))
	else
	library = trim (arg(j+1:))
	end if
	libraries = libraries // " " // library
	cycle SCAN_CMDLINE
	case ("-L")
	if (j == len_trim (arg)) then
	logfile = get_option_value (i, var_str (option))
	else
	logfile = trim (arg(j+1:))
	end if
	cycle SCAN_CMDLINE
	case ("-m")
	if (j < len_trim (arg)) call msg_fatal &
	("Option '" // option // "' needs a value")
	model = get_option_value (i, var_str (option))
	cycle SCAN_CMDLINE
	case ("-r")
	rebuild_library = .true.
	rebuild_user = .true.
	rebuild_phs = .true.
	rebuild_grids = .true.
	rebuild_events = .true.
	cycle SCAN_SHORT_OPTIONS
	case ("-u")
	user_code_enable = .true.
	cycle SCAN_SHORT_OPTIONS
	case default
	call print_usage ()
	call msg_fatal &
	("Option '" // option // "' not recognized")
	end select
	end do SCAN_SHORT_OPTIONS
	end if
	case default
	files = files // " " // trim (arg)
	end select
	else
	files = files // " " // trim (arg)
	end if
	end do SCAN_CMDLINE

	! Overall initialization
	if (logfile /= "") call logfile_init (logfile)
	if (banner) call msg_banner ()

	allocate (options)
	allocate (whizard_instance)

	if (.not. quit) then

	! Set options and initialize the whizard object
	options%preload_model = model
	options%default_lib = default_lib
	options%preload_libraries = libraries
	options%rebuild_library = rebuild_library
	options%recompile_library = recompile_library
	options%rebuild_user = rebuild_user
	options%rebuild_phs = rebuild_phs
	options%rebuild_grids = rebuild_grids
	options%rebuild_events = rebuild_events

	call whizard_instance%init (options, paths, logfile)

	call mask_term_signals ()

	end if

	! Run commands given on the command line
	if (.not. quit .and. ifile_get_length (commands) > 0) then
	call whizard_instance%process_ifile (commands, quit, quit_code)
	end if

	if (.not. quit) then
	! Process commands from standard input
	if (.not. interactive .and. files == "") then
	call whizard_instance%process_stdin (quit, quit_code)

	! ... or process commands from file
	else
	files = trim (adjustl (files))
	SCAN_FILES: do while (files /= "")
	call split (files, this, " ")
	call whizard_instance%process_file (this, quit, quit_code)
	if (quit) exit SCAN_FILES
	end do SCAN_FILES

	end if
	end if

	! Enter an interactive shell if requested
	if (.not. quit .and. interactive) then
	call whizard_instance%shell (quit_code)
	end if

	! Overall finalization
	call ifile_final (commands)

	deallocate (options)

	call whizard_instance%final ()
	deallocate (whizard_instance)

	call terminate_now_if_signal ()
	call release_term_signals ()
	call msg_terminate (quit_code = quit_code)

	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	contains

	subroutine print_version ()
	print "(A)", "WHIZARD " // WHIZARD_VERSION
	print "(A)", "Copyright (C) 1999-2016 Wolfgang Kilian, Thorsten Ohl, Juergen Reuter"
	print "(A)", " --------------------------------------- "
	print "(A)", "This is free software; see the source for copying conditions. There is NO"
	print "(A)", "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
	print *
	end subroutine print_version

	end program main

	!!! (WK 02/2016)
	!!! Separate subroutine, because this becomes a procedure pointer target
	!!! Internal procedures as targets are not supported by some compilers.

	subroutine print_usage ()
	use system_dependencies, only: WHIZARD_VERSION
	print "(A)", "WHIZARD " // WHIZARD_VERSION
	print "(A)", "Usage: whizard [OPTIONS] [FILE]"
	print "(A)", "Run WHIZARD with the command list taken from FILE(s)"
	print "(A)", "Options for resetting default directories and tools" &
	// "(GNU naming conventions):"
	print "(A)", " --prefix DIR"
	print "(A)", " --exec_prefix DIR"
	print "(A)", " --bindir DIR"
	print "(A)", " --libdir DIR"
	print "(A)", " --includedir DIR"
	print "(A)", " --datarootdir DIR"
	print "(A)", " --libtool LOCAL_LIBTOOL"
	print "(A)", " --lhapdfdir DIR (PDF sets directory)"
	print "(A)", "Other options:"
	print "(A)", "-h, --help display this help and exit"
	print "(A)", " --banner display banner at startup (default)"
	print "(A)", " --debug AREA switch on debug output for AREA."
	print "(A)", " AREA can be one of Whizard's src dirs or 'all'"
	print "(A)", " --debug2 AREA switch on more verbose debug output for AREA."
	print "(A)", " --single-event only compute one phase-space point (for debugging)"
	print "(A)", "-e, --execute CMDS execute SINDARIN CMDS before reading FILE(s)"
	print "(A)", "-i, --interactive run interactively after reading FILE(s)"
	print "(A)", "-l, --library preload process library NAME"
	print "(A)", " --localprefix DIR"
	print "(A)", " search in DIR for local models (default: ~/.whizard)"
	print "(A)", "-L, --logfile FILE write log to FILE (default: 'whizard.log'"
	print "(A)", " --logging switch on logging at startup (default)"
	print "(A)", "-m, --model NAME preload model NAME (default: 'SM')"
	print "(A)", " --no-banner do not display banner at startup"
	print "(A)", " --no-library do not preload process library"
	print "(A)", " --no-logfile do not write a logfile"
	print "(A)", " --no-logging switch off logging at startup"
	print "(A)", " --no-model do not preload a model"
	print "(A)", " --no-rebuild do not force rebuilding"
	print "(A)", "-r, --rebuild rebuild all (see below)"
	print "(A)", " --rebuild-library"
	print "(A)", " rebuild process code library"
	print "(A)", " --rebuild-user rebuild user-provided code"
	print "(A)", " --rebuild-phase-space"
	print "(A)", " rebuild phase-space configuration"
	print "(A)", " --rebuild-grids rebuild integration grids"
	print "(A)", " --rebuild-events rebuild event samples"
	print "(A)", " --recompile recompile process code"
	print "(A)", " --show-config show build-time configuration"
	print "(A)", "-u --user enable user-provided code"
	print "(A)", " --user-src FILE user-provided source file"
	print "(A)", " --user-lib FILE user-provided library file"
	print "(A)", " --user-target BN basename of created user library (default: user)"
	print "(A)", "-V, --version output version information and exit"
	print "(A)", " --write-syntax-tables"
	print "(A)", " write the internal syntax tables to files and exit"
	print "(A)", "- further options are taken as filenames"
	print *
	print "(A)", "With no FILE, read standard input."
	end subroutine print_usage

	@ %def main
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Driver program for the unit tests}
	This is a variant of the above main program that takes unit-test names
	as command-line options and runs those tests.
	<<[[main_ut.f90]]>>=
	<<File header>>

	program main_ut

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

	use cmdline_options

	use model_testbed !NODEP!

	<<Main: use tests>>

	implicit none

	<<Main: cmdline arg len declaration>>

	!!! (WK 02/2016) Interface for the separate external routine below
	interface
	subroutine print_usage ()
	end subroutine print_usage
	end interface

	! Main program variable declarations
	character(CMDLINE_ARG_LEN) :: arg
	character(2) :: option
	type(string_t) :: long_option, value
	integer :: i, j, arg_len, arg_status, area
	logical :: look_for_options
	logical :: banner
	type(string_t) :: check, checks
	type(test_results_t) :: test_results
	logical :: success

	! Exit status
	integer :: quit_code = 0

	! Initial values
	look_for_options = .true.
	banner = .true.
	logging = .false.
	msg_level = RESULT
	check = ""
	checks = ""

	! Read and process options
	call init_options (print_usage)
	i = 0
	SCAN_CMDLINE: do
	i = i + 1
	call get_command_argument (i, arg, arg_len, arg_status)
	select case (arg_status)
	case (0)
	case (-1)
	call msg_error (" Command argument truncated: '" // arg // "'")
	case default
	exit SCAN_CMDLINE
	end select
	if (look_for_options) then
	select case (arg(1:2))
	case ("--")
	value = trim (arg)
	call split (value, long_option, "=")
	select case (char (long_option))
	case ("--version")
	call no_option_value (long_option, value)
	call print_version (); stop
	case ("--help")
	call no_option_value (long_option, value)
	call print_usage (); stop
	case ("--banner")
	call no_option_value (long_option, value)
	banner = .true.
	cycle SCAN_CMDLINE
	case ("--no-banner")
	call no_option_value (long_option, value)
	banner = .false.
	cycle SCAN_CMDLINE
	case ("--check")
	check = get_option_value (i, long_option, value)
	checks = checks // " " // check
	cycle SCAN_CMDLINE
	case ("--debug")
	call no_option_value (long_option, value)
	area = d_area (get_option_value (i, long_option, value))
	msg_level(area) = DEBUG
	cycle SCAN_CMDLINE
	case ("--debug2")
	call no_option_value (long_option, value)
	area = d_area (get_option_value (i, long_option, value))
	msg_level(area) = DEBUG
	cycle SCAN_CMDLINE
	case default
	call print_usage ()
	call msg_fatal ("Option '" // trim (arg) // "' not recognized")
	end select
	end select
	select case (arg(1:1))
	case ("-")
	j = 1
	if (len_trim (arg) == 1) then
	look_for_options = .false.
	else
	SCAN_SHORT_OPTIONS: do
	j = j + 1
	if (j > len_trim (arg)) exit SCAN_SHORT_OPTIONS
	option = "-" // arg(j:j)
	select case (option)
	case ("-V")
	call print_version (); stop
	case ("-?", "-h")
	call print_usage (); stop
	case default
	call print_usage ()
	call msg_fatal &
	("Option '" // option // "' not recognized")
	end select
	end do SCAN_SHORT_OPTIONS
	end if
	case default
	call print_usage ()
	call msg_fatal ("Option '" // trim (arg) // "' not recognized")
	end select
	else
	call print_usage ()
	call msg_fatal ("Option '" // trim (arg) // "' not recognized")
	end if
	end do SCAN_CMDLINE

	! Overall initialization
	if (banner) call msg_banner ()

	! Run any self-checks (and no commands)
	if (checks /= "") then
	checks = trim (adjustl (checks))
	RUN_CHECKS: do while (checks /= "")
	call split (checks, check, " ")
	call whizard_check (check, test_results)
	end do RUN_CHECKS
	call test_results%wrapup (6, success)
	if (.not. success) quit_code = 7
	end if

	call msg_terminate (quit_code = quit_code)

	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	contains

	subroutine print_version ()
	print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)"
	print "(A)", "Copyright (C) 1999-2016 Wolfgang Kilian, Thorsten Ohl, Juergen Reuter"
	print "(A)", " --------------------------------------- "
	print "(A)", "This is free software; see the source for copying conditions. There is NO"
	print "(A)", "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
	print *
	end subroutine print_version

	<<Main: tests>>

	end program main_ut

	!!! (WK 02/2016)
	!!! Separate subroutine, because this becomes a procedure pointer target
	!!! Internal procedures as targets are not supported by some compilers.

	subroutine print_usage ()
	use system_dependencies, only: WHIZARD_VERSION
	print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)"
	print "(A)", "Usage: whizard_ut [OPTIONS] [FILE]"
	print "(A)", "Run WHIZARD unit tests as given on the command line"
	print "(A)", "Options:"
	print "(A)", "-h, --help display this help and exit"
	print "(A)", " --banner display banner at startup (default)"
	print "(A)", " --no-banner do not display banner at startup"
	print "(A)", " --debug AREA switch on debug output for AREA."
	print "(A)", " AREA can be one of Whizard's src dirs or 'all'"
	print "(A)", " --debug2 AREA switch on more verbose debug output for AREA."
	print "(A)", "-V, --version output version information and exit"
	print "(A)", " --check TEST run unit test TEST"
	end subroutine print_usage
	@ %def main_ut
	@
	\subsection{Self-tests}
	For those self-tests, we need some auxiliary routines that provide an
	enviroment. The environment depends on things that are not available at the
	level of the module that we want to test.

	\subsubsection{Testbed for event I/O}
	This subroutine prepares a test process with a single event. All objects are
	allocated via anonymous pointers, because we want to recover the pointers and
	delete the objects in a separate procedure.
	<<Main: tests>>=
	subroutine prepare_eio_test (event, unweighted, n_alt)
	use variables
	use model_data
	use process, only: process_t
	use instances, only: process_instance_t
	use processes_ut, only: prepare_test_process
	use event_base
	use events

	class(generic_event_t), intent(inout), pointer :: event
	logical, intent(in), optional :: unweighted
	integer, intent(in), optional :: n_alt
	type(model_data_t), pointer :: model
	type(var_list_t) :: var_list
	type(process_t), pointer :: proc
	type(process_instance_t), pointer :: process_instance

	allocate (model)
	call model%init_test ()

	allocate (proc)
	allocate (process_instance)

	call prepare_test_process (proc, process_instance, model)
	call process_instance%setup_event_data ()

	call model%final ()
	deallocate (model)

	allocate (event_t :: event)
	select type (event)
	type is (event_t)
	if (present (unweighted)) then
	call var_list_append_log (var_list, &
	var_str ("?unweighted"), unweighted, &
	intrinsic = .true.)
	else
	call var_list_append_log (var_list, &
	var_str ("?unweighted"), .true., &
	intrinsic = .true.)
	end if
	call var_list_append_string (var_list, &
	var_str ("$sample_normalization"), &
	var_str ("auto"), intrinsic = .true.)
	call event%basic_init (var_list, n_alt)
	call event%connect (process_instance, proc%get_model_ptr ())
	call var_list%final ()
	end select

	end subroutine prepare_eio_test

	@ %def prepare_eio_test_event
	@ Recover those pointers, finalize the objects and deallocate.
	<<Main: tests>>=
	subroutine cleanup_eio_test (event)
	use model_data
	use process, only: process_t
	use instances, only: process_instance_t
	use processes_ut, only: cleanup_test_process
	use event_base
	use events

	class(generic_event_t), intent(inout), pointer :: event
	type(process_t), pointer :: proc
	type(process_instance_t), pointer :: process_instance

	select type (event)
	type is (event_t)
	proc => event%get_process_ptr ()
	process_instance => event%get_process_instance_ptr ()
	call cleanup_test_process (proc, process_instance)
	deallocate (process_instance)
	deallocate (proc)
	call event%final ()
	end select
	deallocate (event)

	end subroutine cleanup_eio_test

	@ %def cleanup_eio_test_event
	@ Assign those procedures to appropriate pointers (module variables) in the
	[[eio_base]] module, so they can be called as if they were module procedures.
	<<Main: use tests>>=
	use eio_base_ut, only: eio_prepare_test
	use eio_base_ut, only: eio_cleanup_test
	<<Main: prepare testbed>>=
	eio_prepare_test => prepare_eio_test
	eio_cleanup_test => cleanup_eio_test
	@
	\subsubsection{Any Model}
	This procedure reads any model from file and, optionally, assigns a
	var-list pointer.
	<<Main: tests>>=
	subroutine prepare_whizard_model (model, name, vars)
	<<Use strings>>
	use os_interface
	use model_data
	use var_base
	use models
	class(model_data_t), intent(inout), pointer :: model
	type(string_t), intent(in) :: name
	class(vars_t), pointer, intent(out), optional :: vars
	type(os_data_t) :: os_data
	call syntax_model_file_init ()
	call os_data_init (os_data)
	allocate (model_t :: model)
	select type (model)
	type is (model_t)
	call model%read (name // ".mdl", os_data)
	if (present (vars)) then
	vars => model%get_var_list_ptr ()
	end if
	end select
	end subroutine prepare_whizard_model

	@ %def prepare_whizard_model
	@ Cleanup after use. Includes deletion of the model-file syntax.
	<<Main: tests>>=
	subroutine cleanup_whizard_model (model)
	use model_data
	use models
	class(model_data_t), intent(inout), pointer :: model
	call model%final ()
	deallocate (model)
	call syntax_model_file_final ()
	end subroutine cleanup_whizard_model

	@ %def cleanup_whizard_model
	@ Assign those procedures to appropriate pointers (module variables) in the
	[[model_testbed]] module, so they can be called as if they were module
	procedures.
	<<Main: prepare testbed>>=
	prepare_model => prepare_whizard_model
	cleanup_model => cleanup_whizard_model
	@
	\subsubsection{Fallback model: hadrons}
	Some event format tests require the hadronic SM implementation, which
	has to be read from file. We provide the functionality here, so the
	tests do not depend on model I/O.
	<<Main: tests>>=
	subroutine prepare_fallback_model (model)
	use model_data
	class(model_data_t), intent(inout), pointer :: model
	call prepare_whizard_model (model, var_str ("SM_hadrons"))
	end subroutine prepare_fallback_model

	@ %def prepare_fallback_model
	@ Assign those procedures to appropriate pointers (module variables) in the
	[[eio_base]] module, so they can be called as if they were module procedures.
	<<Main: use tests>>=
	use eio_base_ut, only: eio_prepare_fallback_model
	use eio_base_ut, only: eio_cleanup_fallback_model
	<<Main: prepare testbed>>=
	eio_prepare_fallback_model => prepare_fallback_model
	eio_cleanup_fallback_model => cleanup_model
	@
	\subsubsection{Access to the test random-number generator}
	This generator is not normally available for the dispatcher. We assign an
	additional dispatch routine to the hook in the [[dispatch]] module
	which will be checked before the default rule.
	<<Main: use tests>>=
	use dispatch_rng, only: dispatch_rng_factory_extra
	use dispatch_ut, only: dispatch_rng_factory_test
	<<Main: prepare testbed>>=
	dispatch_rng_factory_extra => dispatch_rng_factory_test
	@
	\subsubsection{Access to the test structure functions}
	These are not normally available for the dispatcher. We assign an
	additional dispatch routine to the hook in the [[dispatch]] module
	which will be checked before the default rule.
	<<Main: use tests>>=
	use dispatch_beams, only: dispatch_sf_data_extra
	use dispatch_ut, only: dispatch_sf_data_test
	<<Main: prepare testbed>>=
	dispatch_sf_data_extra => dispatch_sf_data_test
	@
	\subsubsection{Procedure for Checking}
	This is for developers only, but needs a well-defined interface.
	<<Main: tests>>=
	subroutine whizard_check (check, results)

	type(string_t), intent(in) :: check
	type(test_results_t), intent(inout) :: results
	type(os_data_t) :: os_data
	integer :: u

	call os_data_init (os_data)
	u = free_unit ()
	open (u, file="whizard_check." // char (check) // ".log", &
	action="write", status="replace")
	call msg_message (repeat ('=', 76), 0)
	call msg_message ("Running self-test: " // char (check), 0)
	call msg_message (repeat ('-', 76), 0)
	<<Main: prepare testbed>>
	select case (char (check))
	<<Main: test cases>>
	case ("all")
	<<Main: all tests>>
	case default
	call msg_fatal ("Self-test '" // char (check) // "' not implemented.")
	end select
	close (u)
	end subroutine whizard_check

	@ %def whizard_check
	@
	\subsection{Unit test references}
	\subsubsection{Formats}
	<<Main: use tests>>=
	use formats_ut, only: format_test
	<<Main: test cases>>=
	case ("formats")
	call format_test (u, results)
	<<Main: all tests>>=
	call format_test (u, results)
	@
	\subsubsection{MD5}
	<<Main: use tests>>=
	use md5_ut, only: md5_test
	<<Main: test cases>>=
	case ("md5")
	call md5_test (u, results)
	<<Main: all tests>>=
	call md5_test (u, results)
	@
	\subsubsection{OS Interface}
	<<Main: use tests>>=
	use os_interface_ut, only: os_interface_test
	<<Main: test cases>>=
	case ("os_interface")
	call os_interface_test (u, results)
	<<Main: all tests>>=
	call os_interface_test (u, results)
	@
	\subsubsection{Sorting}
	<<Main: use tests>>=
	use sorting_ut, only: sorting_test
	<<Main: test cases>>=
	case ("sorting")
	call sorting_test (u, results)
	<<Main: all tests>>=
	call sorting_test (u, results)
	@
	\subsubsection{Codes}
	<<Main: use tests>>=
	use codes_ut, only: codes_test
	<<Main: test cases>>=
	case ("codes")
	call codes_test (u, results)
	<<Main: all tests>>=
	call codes_test (u, results)
	@
	\subsubsection{Object base}
	<<Main: use tests>>=
	use object_base_ut, only: object_base_test
	<<Main: test cases>>=
	case ("object_base")
	call object_base_test (u, results)
	<<Main: all tests>>=
	call object_base_test (u, results)
	@
	\subsubsection{Object builder}
	<<Main: use tests>>=
	use object_builder_ut, only: object_builder_test
	<<Main: test cases>>=
	case ("object_builder")
	call object_builder_test (u, results)
	<<Main: all tests>>=
	call object_builder_test (u, results)
	@
	\subsubsection{Object logical}
	<<Main: use tests>>=
	use object_logical_ut, only: object_logical_test
	<<Main: test cases>>=
	case ("object_logical")
	call object_logical_test (u, results)
	<<Main: all tests>>=
	call object_logical_test (u, results)
	@
	\subsubsection{Object integer}
	<<Main: use tests>>=
	use object_integer_ut, only: object_integer_test
	<<Main: test cases>>=
	case ("object_integer")
	call object_integer_test (u, results)
	<<Main: all tests>>=
	call object_integer_test (u, results)
	@
	\subsubsection{Object container}
	<<Main: use tests>>=
	use object_container_ut, only: object_container_test
	<<Main: test cases>>=
	case ("object_container")
	call object_container_test (u, results)
	<<Main: all tests>>=
	call object_container_test (u, results)
	@
	\subsubsection{Object comparison}
	<<Main: use tests>>=
	use object_comparison_ut, only: object_comparison_test
	<<Main: test cases>>=
	case ("object_comparison")
	call object_comparison_test (u, results)
	<<Main: all tests>>=
	call object_comparison_test (u, results)
	@
	\subsubsection{Object conditional}
	<<Main: use tests>>=
	use object_conditional_ut, only: object_conditional_test
	<<Main: test cases>>=
	case ("object_conditional")
	call object_conditional_test (u, results)
	<<Main: all tests>>=
	call object_conditional_test (u, results)
	@
	\subsubsection{Sindarin Parser}
	<<Main: use tests>>=
	use sindarin_parser_ut, only: sindarin_parser_test
	<<Main: test cases>>=
	case ("sindarin_parser")
	call sindarin_parser_test (u, results)
	<<Main: all tests>>=
	call sindarin_parser_test (u, results)
	@
	\subsubsection{Grids}
	<<Main: use tests>>=
	use grids_ut, only: grids_test
	<<Main: test cases>>=
	case ("grids")
	call grids_test (u, results)
	<<Main: all tests>>=
	call grids_test (u, results)
	@
	\subsubsection{Solver}
	<<Main: use tests>>=
	use solver_ut, only: solver_test
	<<Main: test cases>>=
	case ("solver")
	call solver_test (u, results)
	<<Main: all tests>>=
	call solver_test (u, results)
	@
	\subsubsection{CPU Time}
	<<Main: use tests>>=
	use cputime_ut, only: cputime_test
	<<Main: test cases>>=
	case ("cputime")
	call cputime_test (u, results)
	<<Main: all tests>>=
	call cputime_test (u, results)
	@
	\subsubsection{SM QCD}
	<<Main: use tests>>=
	use sm_qcd_ut, only: sm_qcd_test
	<<Main: test cases>>=
	case ("sm_qcd")
	call sm_qcd_test (u, results)
	<<Main: all tests>>=
	call sm_qcd_test (u, results)
	@
	\subsubsection{SM physics}
	<<Main: use tests>>=
	use sm_physics_ut, only: sm_physics_test
	<<Main: test cases>>=
	case ("sm_physics")
	call sm_physics_test (u, results)
	<<Main: all tests>>=
	call sm_physics_test (u, results)
	@
	\subsubsection{Lexers}
	<<Main: use tests>>=
	use lexers_ut, only: lexer_test
	<<Main: test cases>>=
	case ("lexers")
	call lexer_test (u, results)
	<<Main: all tests>>=
	call lexer_test (u, results)
	@
	\subsubsection{Parser}
	<<Main: use tests>>=
	use parser_ut, only: parse_test
	<<Main: test cases>>=
	case ("parser")
	call parse_test (u, results)
	<<Main: all tests>>=
	call parse_test (u, results)
	@
	\subsubsection{XML}
	<<Main: use tests>>=
	use xml_ut, only: xml_test
	<<Main: test cases>>=
	case ("xml")
	call xml_test (u, results)
	<<Main: all tests>>=
	call xml_test (u, results)
	@
	\subsubsection{Colors}
	<<Main: use tests>>=
	use colors_ut, only: color_test
	<<Main: test cases>>=
	case ("colors")
	call color_test (u, results)
	<<Main: all tests>>=
	call color_test (u, results)
	@
	\subsubsection{State matrices}
	<<Main: use tests>>=
	use state_matrices_ut, only: state_matrix_test
	<<Main: test cases>>=
	case ("state_matrices")
	call state_matrix_test (u, results)
	<<Main: all tests>>=
	call state_matrix_test (u, results)
	@
	\subsubsection{Analysis}
	<<Main: use tests>>=
	use analysis_ut, only: analysis_test
	<<Main: test cases>>=
	case ("analysis")
	call analysis_test (u, results)
	<<Main: all tests>>=
	call analysis_test (u, results)
	@
	\subsubsection{Particles}
	<<Main: use tests>>=
	use particles_ut, only: particles_test
	<<Main: test cases>>=
	case ("particles")
	call particles_test (u, results)
	<<Main: all tests>>=
	call particles_test (u, results)
	@
	\subsubsection{Models}
	<<Main: use tests>>=
	use models_ut, only: models_test
	<<Main: test cases>>=
	case ("models")
	call models_test (u, results)
	<<Main: all tests>>=
	call models_test (u, results)
	@
	\subsubsection{Auto Components}
	<<Main: use tests>>=
	use auto_components_ut, only: auto_components_test
	<<Main: test cases>>=
	case ("auto_components")
	call auto_components_test (u, results)
	<<Main: all tests>>=
	call auto_components_test (u, results)
	@
	\subsubsection{Radiation Generator}
	<<Main: use tests>>=
	use radiation_generator_ut, only: radiation_generator_test
	<<Main: test cases>>=
	case ("radiation_generator")
	call radiation_generator_test (u, results)
	<<Main: all tests>>=
	call radiation_generator_test (u, results)
	@
	\subsection{BLHA}
	<<Main: use tests>>=
	use blha_ut, only: blha_test
	<<Main: test cases>>=
	case ("blha")
	call blha_test (u, results)
	<<Main: all tests>>=
	call blha_test (u, results)
	@
	\subsubsection{Evaluators}
	<<Main: use tests>>=
	use evaluators_ut, only: evaluator_test
	<<Main: test cases>>=
	case ("evaluators")
	call evaluator_test (u, results)
	<<Main: all tests>>=
	call evaluator_test (u, results)
	@
	\subsubsection{Expressions}
	<<Main: use tests>>=
	use eval_trees_ut, only: expressions_test
	<<Main: test cases>>=
	case ("expressions")
	call expressions_test (u, results)
	<<Main: all tests>>=
	call expressions_test (u, results)
	@
	\subsubsection{PHS Forests}
	<<Main: use tests>>=
	use phs_forests_ut, only: phs_forests_test
	<<Main: test cases>>=
	case ("phs_forests")
	call phs_forests_test (u, results)
	<<Main: all tests>>=
	call phs_forests_test (u, results)
	@
	\subsubsection{Beams}
	<<Main: use tests>>=
	use beams_ut, only: beams_test
	<<Main: test cases>>=
	case ("beams")
	call beams_test (u, results)
	<<Main: all tests>>=
	call beams_test (u, results)
	@
	\subsubsection{$su(N)$ Algebra}
	<<Main: use tests>>=
	use su_algebra_ut, only: su_algebra_test
	<<Main: test cases>>=
	case ("su_algebra")
	call su_algebra_test (u, results)
	<<Main: all tests>>=
	call su_algebra_test (u, results)
	@
	\subsubsection{Bloch Vectors}
	<<Main: use tests>>=
	use bloch_vectors_ut, only: bloch_vectors_test
	<<Main: test cases>>=
	case ("bloch_vectors")
	call bloch_vectors_test (u, results)
	<<Main: all tests>>=
	call bloch_vectors_test (u, results)
	@
	\subsubsection{Polarizations}
	<<Main: use tests>>=
	use polarizations_ut, only: polarizations_test
	<<Main: test cases>>=
	case ("polarizations")
	call polarizations_test (u, results)
	<<Main: all tests>>=
	call polarizations_test (u, results)
	@
	\subsubsection{SF Aux}
	<<Main: use tests>>=
	use sf_aux_ut, only: sf_aux_test
	<<Main: test cases>>=
	case ("sf_aux")
	call sf_aux_test (u, results)
	<<Main: all tests>>=
	call sf_aux_test (u, results)
	@
	\subsubsection{SF Mappings}
	<<Main: use tests>>=
	use sf_mappings_ut, only: sf_mappings_test
	<<Main: test cases>>=
	case ("sf_mappings")
	call sf_mappings_test (u, results)
	<<Main: all tests>>=
	call sf_mappings_test (u, results)
	@
	\subsubsection{SF Base}
	<<Main: use tests>>=
	use sf_base_ut, only: sf_base_test
	<<Main: test cases>>=
	case ("sf_base")
	call sf_base_test (u, results)
	<<Main: all tests>>=
	call sf_base_test (u, results)
	@
	\subsubsection{SF PDF Builtin}
	<<Main: use tests>>=
	use sf_pdf_builtin_ut, only: sf_pdf_builtin_test
	<<Main: test cases>>=
	case ("sf_pdf_builtin")
	call sf_pdf_builtin_test (u, results)
	<<Main: all tests>>=
	call sf_pdf_builtin_test (u, results)
	@
	\subsubsection{SF LHAPDF}
	<<Main: use tests>>=
	use sf_lhapdf_ut, only: sf_lhapdf_test
	<<Main: test cases>>=
	case ("sf_lhapdf")
	call sf_lhapdf_test (u, results)
	<<Main: all tests>>=
	call sf_lhapdf_test (u, results)
	@
	\subsubsection{SF ISR}
	<<Main: use tests>>=
	use sf_isr_ut, only: sf_isr_test
	<<Main: test cases>>=
	case ("sf_isr")
	call sf_isr_test (u, results)
	<<Main: all tests>>=
	call sf_isr_test (u, results)
	@
	\subsubsection{SF EPA}
	<<Main: use tests>>=
	use sf_epa_ut, only: sf_epa_test
	<<Main: test cases>>=
	case ("sf_epa")
	call sf_epa_test (u, results)
	<<Main: all tests>>=
	call sf_epa_test (u, results)
	@
	\subsubsection{SF EWA}
	<<Main: use tests>>=
	use sf_ewa_ut, only: sf_ewa_test
	<<Main: test cases>>=
	case ("sf_ewa")
	call sf_ewa_test (u, results)
	<<Main: all tests>>=
	call sf_ewa_test (u, results)
	@
	\subsubsection{SF CIRCE1}
	<<Main: use tests>>=
	use sf_circe1_ut, only: sf_circe1_test
	<<Main: test cases>>=
	case ("sf_circe1")
	call sf_circe1_test (u, results)
	<<Main: all tests>>=
	call sf_circe1_test (u, results)
	@
	\subsubsection{SF CIRCE2}
	<<Main: use tests>>=
	use sf_circe2_ut, only: sf_circe2_test
	<<Main: test cases>>=
	case ("sf_circe2")
	call sf_circe2_test (u, results)
	<<Main: all tests>>=
	call sf_circe2_test (u, results)
	@
	\subsubsection{SF Gaussian}
	<<Main: use tests>>=
	use sf_gaussian_ut, only: sf_gaussian_test
	<<Main: test cases>>=
	case ("sf_gaussian")
	call sf_gaussian_test (u, results)
	<<Main: all tests>>=
	call sf_gaussian_test (u, results)
	@
	\subsubsection{SF Beam Events}
	<<Main: use tests>>=
	use sf_beam_events_ut, only: sf_beam_events_test
	<<Main: test cases>>=
	case ("sf_beam_events")
	call sf_beam_events_test (u, results)
	<<Main: all tests>>=
	call sf_beam_events_test (u, results)
	@
	\subsubsection{SF EScan}
	<<Main: use tests>>=
	use sf_escan_ut, only: sf_escan_test
	<<Main: test cases>>=
	case ("sf_escan")
	call sf_escan_test (u, results)
	<<Main: all tests>>=
	call sf_escan_test (u, results)
	@
	\subsubsection{PHS Base}
	<<Main: use tests>>=
	use phs_base_ut, only: phs_base_test
	<<Main: test cases>>=
	case ("phs_base")
	call phs_base_test (u, results)
	<<Main: all tests>>=
	call phs_base_test (u, results)
	@
	\subsubsection{PHS Single}
	<<Main: use tests>>=
	use phs_single_ut, only: phs_single_test
	<<Main: test cases>>=
	case ("phs_single")
	call phs_single_test (u, results)
	<<Main: all tests>>=
	call phs_single_test (u, results)
	@
	\subsubsection{PHS Wood}
	<<Main: use tests>>=
	use phs_wood_ut, only: phs_wood_test
	use phs_wood_ut, only: phs_wood_vis_test
	<<Main: test cases>>=
	case ("phs_wood")
	call phs_wood_test (u, results)
	case ("phs_wood_vis")
	call phs_wood_vis_test (u, results)
	<<Main: all tests>>=
	call phs_wood_test (u, results)
	call phs_wood_vis_test (u, results)
	@
	\subsubsection{PHS FKS Generator}
	<<Main: use tests>>=
	use phs_fks_ut, only: phs_fks_generator_test
	<<Main: test cases>>=
	case ("phs_fks_generator")
	call phs_fks_generator_test (u, results)
	<<Main: all tests>>=
	call phs_fks_generator_test (u, results)
	@
	\subsubsection{FKS regions}
	<<Main: use tests>>=
	use fks_regions_ut, only: fks_regions_test
	<<Main: test cases>>=
	case ("fks_regions")
	call fks_regions_test (u, results)
	<<Main: all tests>>=
	call fks_regions_test (u, results)
	@
	\subsubsection{NLO Color data}
	<<Main: use tests>>=
	use nlo_color_data_ut, only: nlo_color_data_test
	<<Main: test cases>>=
	case ("nlo_color_data")
	call nlo_color_data_test (u, results)
	<<Main: all tests>>=
	call nlo_color_data_test (u, results)
	@
	\subsubsection{RNG Base}
	<<Main: use tests>>=
	use rng_base_ut, only: rng_base_test
	<<Main: test cases>>=
	case ("rng_base")
	call rng_base_test (u, results)
	<<Main: all tests>>=
	call rng_base_test (u, results)
	@
	\subsubsection{RNG Tao}
	<<Main: use tests>>=
	use rng_tao_ut, only: rng_tao_test
	<<Main: test cases>>=
	case ("rng_tao")
	call rng_tao_test (u, results)
	<<Main: all tests>>=
	call rng_tao_test (u, results)
	@
	\subsubsection{Selectors}
	<<Main: use tests>>=
	use selectors_ut, only: selectors_test
	<<Main: test cases>>=
	case ("selectors")
	call selectors_test (u, results)
	<<Main: all tests>>=
	call selectors_test (u, results)
	@
	\subsubsection{MCI Base}
	<<Main: use tests>>=
	use mci_base_ut, only: mci_base_test
	<<Main: test cases>>=
	case ("mci_base")
	call mci_base_test (u, results)
	<<Main: all tests>>=
	call mci_base_test (u, results)
	@
	\subsubsection{MCI Midpoint}
	<<Main: use tests>>=
	use mci_midpoint_ut, only: mci_midpoint_test
	<<Main: test cases>>=
	case ("mci_midpoint")
	call mci_midpoint_test (u, results)
	<<Main: all tests>>=
	call mci_midpoint_test (u, results)
	@
	\subsubsection{MCI VAMP}
	<<Main: use tests>>=
	use mci_vamp_ut, only: mci_vamp_test
	<<Main: test cases>>=
	case ("mci_vamp")
	call mci_vamp_test (u, results)
	<<Main: all tests>>=
	call mci_vamp_test (u, results)
	@
	\subsubsection{PRCLib Interfaces}
	<<Main: use tests>>=
	use prclib_interfaces_ut, only: prclib_interfaces_test
	<<Main: test cases>>=
	case ("prclib_interfaces")
	call prclib_interfaces_test (u, results)
	<<Main: all tests>>=
	call prclib_interfaces_test (u, results)
	@
	\subsubsection{Particle Specifiers}
	<<Main: use tests>>=
	use particle_specifiers_ut, only: particle_specifiers_test
	<<Main: test cases>>=
	case ("particle_specifiers")
	call particle_specifiers_test (u, results)
	<<Main: all tests>>=
	call particle_specifiers_test (u, results)
	@
	\subsubsection{Process Libraries}
	<<Main: use tests>>=
	use process_libraries_ut, only: process_libraries_test
	<<Main: test cases>>=
	case ("process_libraries")
	call process_libraries_test (u, results)
	<<Main: all tests>>=
	call process_libraries_test (u, results)
	@
	\subsubsection{PRCLib Stacks}
	<<Main: use tests>>=
	use prclib_stacks_ut, only: prclib_stacks_test
	<<Main: test cases>>=
	case ("prclib_stacks")
	call prclib_stacks_test (u, results)
	<<Main: all tests>>=
	call prclib_stacks_test (u, results)
	@
	\subsubsection{HepMC}
	<<Main: use tests>>=
	use hepmc_interface_ut, only: hepmc_interface_test
	<<Main: test cases>>=
	case ("hepmc")
	call hepmc_interface_test (u, results)
	<<Main: all tests>>=
	call hepmc_interface_test (u, results)
	@
	\subsubsection{LCIO}
	<<Main: use tests>>=
	use lcio_interface_ut, only: lcio_interface_test
	<<Main: test cases>>=
	case ("lcio")
	call lcio_interface_test (u, results)
	<<Main: all tests>>=
	call lcio_interface_test (u, results)
	@
	\subsubsection{Jets}
	<<Main: use tests>>=
	use jets_ut, only: jets_test
	<<Main: test cases>>=
	case ("jets")
	call jets_test (u, results)
	<<Main: all tests>>=
	call jets_test (u, results)
	@
	\subsubsection{PDG Arrays}
	<<Main: use tests>>=
	use pdg_arrays_ut, only: pdg_arrays_test
	<<Main: test cases>>=
	case ("pdg_arrays")
	call pdg_arrays_test (u, results)
	<<Main: all tests>>=
	call pdg_arrays_test (u, results)
	@
	\subsubsection{interactions}
	<<Main: use tests>>=
	use interactions_ut, only: interaction_test
	<<Main: test cases>>=
	case ("interactions")
	call interaction_test (u, results)
	<<Main: all tests>>=
	call interaction_test (u, results)
	@
	\subsubsection{SLHA}
	<<Main: use tests>>=
	use slha_interface_ut, only: slha_test
	<<Main: test cases>>=
	case ("slha_interface")
	call slha_test (u, results)
	<<Main: all tests>>=
	call slha_test (u, results)
	@
	\subsubsection{Cascades}
	<<Main: use tests>>=
	use cascades_ut, only: cascades_test
	<<Main: test cases>>=
	case ("cascades")
	call cascades_test (u, results)
	<<Main: all tests>>=
	call cascades_test (u, results)
	@
	\subsubsection{PRC Test}
	<<Main: use tests>>=
	use prc_test_ut, only: prc_test_test
	<<Main: test cases>>=
	case ("prc_test")
	call prc_test_test (u, results)
	<<Main: all tests>>=
	call prc_test_test (u, results)
	@
	\subsubsection{PRC Template ME}
	<<Main: use tests>>=
	use prc_template_me_ut, only: prc_template_me_test
	<<Main: test cases>>=
	case ("prc_template_me")
	call prc_template_me_test (u, results)
	<<Main: all tests>>=
	call prc_template_me_test (u, results)
	@
	\subsubsection{PRC OMega}
	<<Main: use tests>>=
	use prc_omega_ut, only: prc_omega_test
	use prc_omega_ut, only: prc_omega_diags_test
	<<Main: test cases>>=
	case ("prc_omega")
	call prc_omega_test (u, results)
	case ("prc_omega_diags")
	call prc_omega_diags_test (u, results)
	<<Main: all tests>>=
	call prc_omega_test (u, results)
	call prc_omega_diags_test (u, results)
	@
	\subsubsection{Parton States}
	<<Main: use tests>>=
	use parton_states_ut, only: parton_states_test
	<<Main: test cases>>=
	case ("parton_states")
	call parton_states_test (u, results)
	<<Main: all tests>>=
	call parton_states_test (u, results)
	@
	\subsubsection{Subevt Expr}
	<<Main: use tests>>=
	use expr_tests_ut, only: subevt_expr_test
	<<Main: test cases>>=
	case ("subevt_expr")
	call subevt_expr_test (u, results)
	<<Main: all tests>>=
	call subevt_expr_test (u, results)
	@
	\subsubsection{Processes}
	<<Main: use tests>>=
	use processes_ut, only: processes_test
	<<Main: test cases>>=
	case ("processes")
	call processes_test (u, results)
	<<Main: all tests>>=
	call processes_test (u, results)
	@
	\subsubsection{Process Stacks}
	<<Main: use tests>>=
	use process_stacks_ut, only: process_stacks_test
	<<Main: test cases>>=
	case ("process_stacks")
	call process_stacks_test (u, results)
	<<Main: all tests>>=
	call process_stacks_test (u, results)
	@
	\subsubsection{Event Transforms}
	<<Main: use tests>>=
	use event_transforms_ut, only: event_transforms_test
	<<Main: test cases>>=
	case ("event_transforms")
	call event_transforms_test (u, results)
	<<Main: all tests>>=
	call event_transforms_test (u, results)
	@
	\subsubsection{Decays}
	<<Main: use tests>>=
	use decays_ut, only: decays_test
	<<Main: test cases>>=
	case ("decays")
	call decays_test (u, results)
	<<Main: all tests>>=
	call decays_test (u, results)
	@
	\subsubsection{Shower}
	<<Main: use tests>>=
	use shower_ut, only: shower_test
	<<Main: test cases>>=
	case ("shower")
	call shower_test (u, results)
	<<Main: all tests>>=
	call shower_test (u, results)
	@
	\subsubsection{Events}
	<<Main: use tests>>=
	use events_ut, only: events_test
	<<Main: test cases>>=
	case ("events")
	call events_test (u, results)
	<<Main: all tests>>=
	call events_test (u, results)
	@
	\subsubsection{HEP Events}
	<<Main: use tests>>=
	use hep_events_ut, only: hep_events_test
	<<Main: test cases>>=
	case ("hep_events")
	call hep_events_test (u, results)
	<<Main: all tests>>=
	call hep_events_test (u, results)
	@
	\subsubsection{EIO Data}
	<<Main: use tests>>=
	use eio_data_ut, only: eio_data_test
	<<Main: test cases>>=
	case ("eio_data")
	call eio_data_test (u, results)
	<<Main: all tests>>=
	call eio_data_test (u, results)
	@
	\subsubsection{EIO Base}
	<<Main: use tests>>=
	use eio_base_ut, only: eio_base_test
	<<Main: test cases>>=
	case ("eio_base")
	call eio_base_test (u, results)
	<<Main: all tests>>=
	call eio_base_test (u, results)
	@
	\subsubsection{EIO Raw}
	<<Main: use tests>>=
	use eio_raw_ut, only: eio_raw_test
	<<Main: test cases>>=
	case ("eio_raw")
	call eio_raw_test (u, results)
	<<Main: all tests>>=
	call eio_raw_test (u, results)
	@
	\subsubsection{EIO Checkpoints}
	<<Main: use tests>>=
	use eio_checkpoints_ut, only: eio_checkpoints_test
	<<Main: test cases>>=
	case ("eio_checkpoints")
	call eio_checkpoints_test (u, results)
	<<Main: all tests>>=
	call eio_checkpoints_test (u, results)
	@
	\subsubsection{EIO LHEF}
	<<Main: use tests>>=
	use eio_lhef_ut, only: eio_lhef_test
	<<Main: test cases>>=
	case ("eio_lhef")
	call eio_lhef_test (u, results)
	<<Main: all tests>>=
	call eio_lhef_test (u, results)
	@
	\subsubsection{EIO HepMC}
	<<Main: use tests>>=
	use eio_hepmc_ut, only: eio_hepmc_test
	<<Main: test cases>>=
	case ("eio_hepmc")
	call eio_hepmc_test (u, results)
	<<Main: all tests>>=
	call eio_hepmc_test (u, results)
	@
	\subsubsection{EIO LCIO}
	<<Main: use tests>>=
	use eio_lcio_ut, only: eio_lcio_test
	<<Main: test cases>>=
	case ("eio_lcio")
	call eio_lcio_test (u, results)
	<<Main: all tests>>=
	call eio_lcio_test (u, results)
	@
	\subsubsection{EIO StdHEP}
	<<Main: use tests>>=
	use eio_stdhep_ut, only: eio_stdhep_test
	<<Main: test cases>>=
	case ("eio_stdhep")
	call eio_stdhep_test (u, results)
	<<Main: all tests>>=
	call eio_stdhep_test (u, results)
	@
	\subsubsection{EIO ASCII}
	<<Main: use tests>>=
	use eio_ascii_ut, only: eio_ascii_test
	<<Main: test cases>>=
	case ("eio_ascii")
	call eio_ascii_test (u, results)
	<<Main: all tests>>=
	call eio_ascii_test (u, results)
	@
	\subsubsection{EIO Weights}
	<<Main: use tests>>=
	use eio_weights_ut, only: eio_weights_test
	<<Main: test cases>>=
	case ("eio_weights")
	call eio_weights_test (u, results)
	<<Main: all tests>>=
	call eio_weights_test (u, results)
	@
	\subsubsection{EIO Dump}
	<<Main: use tests>>=
	use eio_dump_ut, only: eio_dump_test
	<<Main: test cases>>=
	case ("eio_dump")
	call eio_dump_test (u, results)
	<<Main: all tests>>=
	call eio_dump_test (u, results)
	@
	\subsubsection{Iterations}
	<<Main: use tests>>=
	use iterations_ut, only: iterations_test
	<<Main: test cases>>=
	case ("iterations")
	call iterations_test (u, results)
	<<Main: all tests>>=
	call iterations_test (u, results)
	@
	\subsubsection{Beam Structures}
	<<Main: use tests>>=
	use beam_structures_ut, only: beam_structures_test
	<<Main: test cases>>=
	case ("beam_structures")
	call beam_structures_test (u, results)
	<<Main: all tests>>=
	call beam_structures_test (u, results)
	@
	\subsubsection{RT Data}
	<<Main: use tests>>=
	use rt_data_ut, only: rt_data_test
	<<Main: test cases>>=
	case ("rt_data")
	call rt_data_test (u, results)
	<<Main: all tests>>=
	call rt_data_test (u, results)
	@
	\subsubsection{Dispatch}
	<<Main: use tests>>=
	use dispatch_ut, only: dispatch_test
	<<Main: test cases>>=
	case ("dispatch")
	call dispatch_test (u, results)
	<<Main: all tests>>=
	call dispatch_test (u, results)
	@
	\subsubsection{Process Configurations}
	<<Main: use tests>>=
	use process_configurations_ut, only: process_configurations_test
	<<Main: test cases>>=
	case ("process_configurations")
	call process_configurations_test (u, results)
	<<Main: all tests>>=
	call process_configurations_test (u, results)
	@
	\subsubsection{Compilations}
	<<Main: use tests>>=
	use compilations_ut, only: compilations_test
	use compilations_ut, only: compilations_static_test
	<<Main: test cases>>=
	case ("compilations")
	call compilations_test (u, results)
	case ("compilations_static")
	call compilations_static_test (u, results)
	<<Main: all tests>>=
	call compilations_test (u, results)
	call compilations_static_test (u, results)
	@
	\subsubsection{Integrations}
	<<Main: use tests>>=
	use integrations_ut, only: integrations_test
	use integrations_ut, only: integrations_history_test
	<<Main: test cases>>=
	case ("integrations")
	call integrations_test (u, results)
	case ("integrations_history")
	call integrations_history_test (u, results)
	<<Main: all tests>>=
	call integrations_test (u, results)
	call integrations_history_test (u, results)
	@
	\subsubsection{Event Streams}
	<<Main: use tests>>=
	use event_streams_ut, only: event_streams_test
	<<Main: test cases>>=
	case ("event_streams")
	call event_streams_test (u, results)
	<<Main: all tests>>=
	call event_streams_test (u, results)
	@
	\subsubsection{Simulations}
	<<Main: use tests>>=
	use simulations_ut, only: simulations_test
	<<Main: test cases>>=
	case ("simulations")
	call simulations_test (u, results)
	<<Main: all tests>>=
	call simulations_test (u, results)
	@
	\subsubsection{Commands}
	<<Main: use tests>>=
	use commands_ut, only: commands_test
	<<Main: test cases>>=
	case ("commands")
	call commands_test (u, results)
	<<Main: all tests>>=
	call commands_test (u, results)
	@
	\subsubsection{$ttV$ formfactors}
	<<Main: use tests>>=
	use ttv_formfactors_ut, only: ttv_formfactors_test
	<<Main: test cases>>=
	case ("ttv_formfactors")
	call ttv_formfactors_test (u, results)
	<<Main: all tests>>=
	call ttv_formfactors_test (u, results)
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Whizard-C-Interface}
	<<[[whizard-c-interface.f90]]>>=
	<<File header>>

	<<Whizard-C-Interface: Internals>>
	<<Whizard-C-Interface: Init and Finalize>>
	<<Whizard-C-Interface: Interfaced Commads>>
	<<Whizard-C-Interface: HepMC>>

	@
	<<Whizard-C-Interface: Internals>>=
	subroutine c_whizard_convert_string (c_string, f_string)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!

	implicit none

	character(kind=c_char), intent(in) :: c_string(*)
	type(string_t), intent(inout) :: f_string
	character(len=1) :: dummy_char
	integer :: dummy_i = 1

	f_string = ""
	do
	if (c_string(dummy_i) == c_null_char) then
	exit
	else if (c_string(dummy_i) == c_new_line) then
	dummy_char = CHAR(13)
	f_string = f_string // dummy_char
	dummy_char = CHAR(10)
	else
	dummy_char = c_string (dummy_i)
	end if
	f_string = f_string // dummy_char
	dummy_i = dummy_i + 1
	end do
	dummy_i = 1
	end subroutine c_whizard_convert_string

	subroutine c_whizard_commands (w_c_instance, cmds)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!
	use commands
	use diagnostics
	use lexers
	use models
	use parser
	use whizard

	type(c_ptr), intent(inout) :: w_c_instance
	type(whizard_t), pointer :: whizard_instance
	type(string_t) :: cmds
	type(parse_tree_t) :: parse_tree
	type(parse_node_t), pointer :: pn_root
	type(stream_t), target :: stream
	type(lexer_t) :: lexer
	type(command_list_t), target :: cmd_list

	call c_f_pointer (w_c_instance, whizard_instance)
	call lexer_init_cmd_list (lexer)
	call syntax_cmd_list_init ()

	call stream_init (stream, cmds)
	call lexer_assign_stream (lexer, stream)
	call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
	pn_root => parse_tree%get_root_ptr ()

	if (associated (pn_root)) then
	call cmd_list%compile (pn_root, whizard_instance%global)
	end if
	call whizard_instance%global%activate ()
	call cmd_list%execute (whizard_instance%global)
	call cmd_list%final ()

	call parse_tree_final (parse_tree)
	call stream_final (stream)
	call lexer_final (lexer)
	call syntax_cmd_list_final ()
	end subroutine c_whizard_commands

	@
	<<Whizard-C-Interface: Init and Finalize>>=
	subroutine c_whizard_init (w_c_instance) bind(C)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!
	use system_dependencies
	use diagnostics
	use unit_tests
	use ifiles
	use os_interface
	use whizard

	implicit none

	<<Main: cmdline arg len declaration>>

	type(c_ptr), intent(out) :: w_c_instance
	logical :: banner
	type(string_t) :: files, model, default_lib, library, libraries
	! type(string_t) :: check, checks
	type(string_t) :: logfile
	type(string_t) :: user_src, user_lib
	type(paths_t) :: paths
	logical :: rebuild_library, rebuild_user
	logical :: rebuild_phs, rebuild_grids, rebuild_events

	type(whizard_options_t), allocatable :: options
	type(whizard_t), pointer :: whizard_instance


	! Initial values
	files = ""
	model = "SM"
	default_lib = "default_lib"
	library = ""
	libraries = ""
	banner = .true.
	logging = .true.
	logfile = "whizard.log"
	! check = ""
	! checks = ""
	user_src = ""
	user_lib = ""
	rebuild_library = .false.
	rebuild_user = .false.
	rebuild_phs = .false.
	rebuild_grids = .false.
	rebuild_events = .false.
	call paths_init (paths)

	! Overall initialization
	if (logfile /= "") call logfile_init (logfile)
	call mask_term_signals ()
	if (banner) call msg_banner ()

	! Set options and initialize the whizard object
	allocate (options)
	options%preload_model = model
	options%default_lib = default_lib
	options%preload_libraries = libraries
	options%rebuild_library = rebuild_library
	options%rebuild_user = rebuild_user
	options%rebuild_phs = rebuild_phs
	options%rebuild_grids = rebuild_grids
	options%rebuild_events = rebuild_events

	allocate (whizard_instance)
	call whizard_instance%init (options, paths)

	! if (checks /= "") then
	! checks = trim (adjustl (checks))
	! RUN_CHECKS: do while (checks /= "")
	! call split (checks, check, " ")
	! call whizard_check (check, test_results)
	! end do RUN_CHECKS
	! call test_results%wrapup (6, success)
	! if (.not. success) quit_code = 7
	! quit = .true.
	! end if

	w_c_instance = c_loc (whizard_instance)

	end subroutine c_whizard_init

	subroutine c_whizard_finalize (w_c_instance) bind(C)
	use, intrinsic :: iso_c_binding
	use system_dependencies
	use diagnostics
	use ifiles
	use os_interface
	use whizard

	type(c_ptr), intent(in) :: w_c_instance
	type(whizard_t), pointer :: whizard_instance
	integer :: quit_code = 0

	call c_f_pointer (w_c_instance, whizard_instance)
	call whizard_instance%final ()
	deallocate (whizard_instance)
	call terminate_now_if_signal ()
	call release_term_signals ()
	call msg_terminate (quit_code = quit_code)
	end subroutine c_whizard_finalize

	subroutine c_whizard_process_string (w_c_instance, c_cmds_in) bind(C)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!

	implicit none

	type(c_ptr), intent(inout) :: w_c_instance
	character(kind=c_char) :: c_cmds_in(*)
	type(string_t) :: f_cmds

	call c_whizard_convert_string (c_cmds_in, f_cmds)
	call c_whizard_commands (w_c_instance, f_cmds)
	end subroutine c_whizard_process_string

	@
	<<Whizard-C-Interface: Interfaced Commads>>=
	subroutine c_whizard_model (w_c_instance, c_model) bind(C)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!

	implicit none

	type(c_ptr), intent(inout) :: w_c_instance
	character(kind=c_char) :: c_model(*)
	type(string_t) :: model, mdl_str

	call c_whizard_convert_string (c_model, model)
	mdl_str = "model = " // model
	call c_whizard_commands (w_c_instance, mdl_str)
	end subroutine c_whizard_model

	subroutine c_whizard_library (w_c_instance, c_library) bind(C)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!

	implicit none

	type(c_ptr), intent(inout) :: w_c_instance
	character(kind=c_char) :: c_library(*)
	type(string_t) :: library, lib_str

	call c_whizard_convert_string(c_library, library)
	lib_str = "library = " // library
	call c_whizard_commands (w_c_instance, lib_str)
	end subroutine c_whizard_library

	subroutine c_whizard_process (w_c_instance, c_id, c_in, c_out) bind(C)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!

	implicit none

	type(c_ptr), intent(inout) :: w_c_instance
	character(kind=c_char) :: c_id(), c_in(), c_out(*)
	type(string_t) :: proc_str, id, in, out

	call c_whizard_convert_string (c_id, id)
	call c_whizard_convert_string (c_in, in)
	call c_whizard_convert_string (c_out, out)
	proc_str = "process " // id // " = " // in // " => " // out
	call c_whizard_commands (w_c_instance, proc_str)
	end subroutine c_whizard_process

	subroutine c_whizard_compile (w_c_instance) bind(C)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!

	type(c_ptr), intent(inout) :: w_c_instance
	type(string_t) :: cmp_str
	cmp_str = "compile"
	call c_whizard_commands (w_c_instance, cmp_str)
	end subroutine c_whizard_compile

	subroutine c_whizard_beams (w_c_instance, c_specs) bind(C)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!

	implicit none

	type(c_ptr), intent(inout) :: w_c_instance
	character(kind=c_char) :: c_specs(*)
	type(string_t) :: specs, beam_str

	call c_whizard_convert_string (c_specs, specs)
	beam_str = "beams = " // specs
	call c_whizard_commands (w_c_instance, beam_str)
	end subroutine c_whizard_beams

	subroutine c_whizard_integrate (w_c_instance, c_process) bind(C)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!

	implicit none

	type(c_ptr), intent(inout) :: w_c_instance
	character(kind=c_char) :: c_process(*)
	type(string_t) :: process, int_str

	call c_whizard_convert_string (c_process, process)
	int_str = "integrate (" // process //")"
	call c_whizard_commands (w_c_instance, int_str)
	end subroutine c_whizard_integrate

	subroutine c_whizard_matrix_element_test &
	(w_c_instance, c_process, n_calls) bind(C)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!

	implicit none

	type(c_ptr), intent(inout) :: w_c_instance
	integer(kind=c_int) :: n_calls
	character(kind=c_char) :: c_process(*)
	type(string_t) :: process, me_str
	character(len=8) :: buffer

	call c_whizard_convert_string (c_process, process)
	write (buffer, "(I0)") n_calls
	me_str = "integrate (" // process // ") { ?phs_only = true" // &
	" n_calls_test = " // trim (buffer)
	call c_whizard_commands (w_c_instance, me_str)
	end subroutine c_whizard_matrix_element_test

	subroutine c_whizard_simulate (w_c_instance, c_id) bind(C)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!

	implicit none

	type(c_ptr), intent(inout) :: w_c_instance
	character(kind=c_char) :: c_id(*)
	type(string_t) :: sim_str, id

	call c_whizard_convert_string(c_id, id)
	sim_str = "simulate (" // id // ")"
	call c_whizard_commands (w_c_instance, sim_str)
	end subroutine c_whizard_simulate

	subroutine c_whizard_sqrts (w_c_instance, c_value, c_unit) bind(C)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!

	implicit none

	type(c_ptr), intent(inout) :: w_c_instance
	character(kind=c_char) :: c_unit(*)
	integer(kind=c_int) :: c_value
	integer :: f_value
	character(len=8) :: f_val
	type(string_t) :: val, unit, sqrts_str

	f_value = c_value
	write (f_val,'(i8)') f_value
	val = f_val
	call c_whizard_convert_string (c_unit, unit)
	sqrts_str = "sqrts =" // val // unit
	call c_whizard_commands (w_c_instance, sqrts_str)
	end subroutine c_whizard_sqrts

	@
	<<Whizard-C-Interface: HepMC>>=
	type(c_ptr) function c_whizard_hepmc_test &
	(w_c_instance, c_id, c_proc_id, c_event_id) bind(C)
	use, intrinsic :: iso_c_binding
	use iso_varying_string, string_t => varying_string !NODEP!
	use commands
	use diagnostics
	use events
	use hepmc_interface
	use lexers
	use models
	use parser
	use instances
	use rt_data
	use simulations
	use whizard
	use os_interface

	implicit none

	type(c_ptr), intent(inout) :: w_c_instance
	type(string_t) :: sim_str
	type(parse_tree_t) :: parse_tree
	type(parse_node_t), pointer :: pn_root
	type(stream_t), target :: stream
	type(lexer_t) :: lexer
	type(command_list_t), pointer :: cmd_list
	type(whizard_t), pointer :: whizard_instance

	type(simulation_t), target :: sim

	character(kind=c_char), intent(in) :: c_id(*)
	type(string_t) :: id
	integer(kind=c_int), value :: c_proc_id, c_event_id
	integer :: proc_id

	type(hepmc_event_t), pointer :: hepmc_event

	call c_f_pointer (w_c_instance, whizard_instance)

	call c_whizard_convert_string (c_id, id)
	sim_str = "simulate (" // id // ")"

	proc_id = c_proc_id

	allocate (hepmc_event)
	call hepmc_event_init (hepmc_event, c_proc_id, c_event_id)

	call syntax_cmd_list_init ()
	call lexer_init_cmd_list (lexer)

	call stream_init (stream, sim_str)
	call lexer_assign_stream (lexer, stream)
	call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
	pn_root => parse_tree%get_root_ptr ()

	allocate (cmd_list)
	if (associated (pn_root)) then
	call cmd_list%compile (pn_root, whizard_instance%global)
	end if

	call sim%init ([id], .true., .true., whizard_instance%global)

	!!! This should generate a HepMC event as hepmc_event_t type
	call msg_message ("Not enabled for the moment.")

	call sim%final ()

	call cmd_list%final ()

	call parse_tree_final (parse_tree)
	call stream_final (stream)
	call lexer_final (lexer)
	call syntax_cmd_list_final ()

	c_whizard_hepmc_test = c_loc(hepmc_event)
	return
	end function c_whizard_hepmc_test
	@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

File Metadata

Mime Type: text/x-tex
Expires: Wed, May 14, 11:43 AM (10 h, 58 m)
Storage Engine: local-disk
Storage Format: Raw Data
Storage Handle: 1f/0c/e719f9f2843c2dab8f6dd1a604af
Default Alt Text: whizard.nw (989 KB)

whizard.nwNo OneTemporaryActions

whizard.nwView Options

File Metadata

Event Timeline

whizard.nw
No OneTemporary
Actions

whizard.nw
View Options