No OneTemporary
Actions

Size

4 MB

Subscribers

None

View Options

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

	Index: trunk/src/pythia8/LHAWhizardWrap.cpp
	===================================================================
	--- trunk/src/pythia8/LHAWhizardWrap.cpp (revision 0)
	+++ trunk/src/pythia8/LHAWhizardWrap.cpp (revision 8190)
	@@ -0,0 +1,47 @@
	+#include "Pythia8/Pythia.h"
	+#include "LHAWhizard.h"
	+#include "LHAWhizard_events.h"
	+
	+using namespace Pythia8;
	+
	+extern "C" {
	+
	+ // Tell the caller that this is the true LHAup interface and the true Pythia8 library
	+ bool lhaup_whizard_available() {
	+ return true;
	+ }
	+
	+ LHAupWhizard* new_whizard_lha () {
	+ LHAupWhizard* whizard_lha = new LHAupWhizard ();
	+ return whizard_lha;
	+ }
	+
	+ void lhaup_whizard_delete (LHAupWhizard* whizard_lha) {
	+ delete whizard_lha;
	+ }
	+
	+ bool lhaup_whizard_set_init (LHAupWhizard* whizard_lha, const int beam_pdg[2], const double beam_energy[2], const int n_processes, const bool unweighted, const bool negative_weights ) {
	+ return whizard_lha->setInit (beam_pdg, beam_energy, n_processes, unweighted, negative_weights);
	+ }
	+
	+ bool lhaup_whizard_set_process_parameters (LHAupWhizard* whizard_lha, const int process_id, const double cross_section, const double error, const double max_weight) {
	+ return whizard_lha->setProcessParameters (process_id, cross_section, error, max_weight);
	+ }
	+
	+ void lhaup_whizard_list_init (LHAupWhizard* whizard_lha) {
	+ whizard_lha->listInit ();
	+ }
	+
	+ void lhaup_whizard_list_event (LHAupWhizard* whizard_lha) {
	+ whizard_lha->listEvent ();
	+ }
	+
	+ void lhaup_whizard_set_event_process (LHAupWhizard* whizard_lha, const int idProcess, const double scale, const double alpha_qcd, const double alpha_qed, const double weight) {
	+ whizard_lha->setEventProcess (idProcess, scale, alpha_qcd, alpha_qed, weight);
	+ }
	+
	+ bool lhaup_whizard_set_event (LHAupWhizard* whizard_lha, const int idProcess, const int n_particles, const lha_particle_t particle_set[]) {
	+ return whizard_lha->setEvent (idProcess, n_particles, particle_set);
	+ }
	+
	+}
	Index: trunk/src/pythia8/Pythia8Wrap_dummy.f90
	===================================================================
	--- trunk/src/pythia8/Pythia8Wrap_dummy.f90 (revision 8189)
	+++ trunk/src/pythia8/Pythia8Wrap_dummy.f90 (revision 8190)
	@@ -1,5 +1,232 @@
	-! Tell the caller that this is NOT the true Fastjet library
	+! Tell the caller that this is NOT the true Pythia8 library
	logical(c_bool) function pythia8_available () bind(C)
	- use iso_c_binding
	+ use iso_c_binding !NODEP!
	pythia8_available = .false.
	end function pythia8_available
	+
	+function new_pythia8 (filename, subrun) bind(C) result (pythia)
	+ use iso_c_binding !NODEP!
	+ character(len=1, kind=c_char), intent(in) :: filename
	+ integer(c_int), intent(in) :: subrun
	+ type(c_ptr) :: pythia
	+ pythia = c_null_ptr
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function new_pythia8
	+
	+subroutine pythia8_delete (pythia) bind(C)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: pythia
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end subroutine pythia8_delete
	+
	+function pythia8_set_lhaup_ptr (cptr, whizard_lha) bind(C) result (flag)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ type(c_ptr), intent(in), value :: whizard_lha
	+ logical(c_bool) :: flag
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_set_lhaup_ptr
	+
	+function pythia8_set_rndm_engine_ptr (pythia, whizard_rndm) bind(C) result (flag)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), intent(in), value :: pythia
	+ type(c_ptr), intent(in), value :: whizard_rndm
	+ logical(c_bool) :: flag
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_set_rndm_engine_ptr
	+
	+function pythia8_read_file (cptr, filename, subrun) bind(C) result (flag)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ character(kind=c_char), dimension(*), intent(in) :: filename
	+ integer(c_int), intent(in), value :: subrun
	+ logical(c_bool) :: flag
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_read_file
	+
	+function pythia8_read_string (cptr, str) bind(C) result (flag)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ character(kind=c_char), dimension(*), intent(in) :: str
	+ logical(c_bool) :: flag
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_read_string
	+
	+function pythia8_init (cptr) bind(C) result (flag)
	+ use iso_c_binding !NODEP!
	+ logical(c_bool) :: flag
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_init
	+
	+function pythia8_next (cptr) bind(C) result (flag)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ logical(c_bool) :: flag
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_next
	+
	+subroutine pythia8_list_lha_event (cptr) bind(C)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), intent(in), value :: cptr
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end subroutine pythia8_list_lha_event
	+
	+subroutine pythia8_list_event (cptr) bind(C)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end subroutine pythia8_list_event
	+
	+function pythia8_get_event_size (cptr) bind(C) result(n)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ integer(c_int) :: n
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_get_event_size
	+
	+function pythia8_get_single_event (cptr, index) bind(C) result (particle)
	+ use iso_c_binding !NODEP!
	+ use whizard_lha, only: lha_particle_t
	+ type(c_ptr), value :: cptr
	+ integer(c_int), value :: index
	+ type(lha_particle_t) :: particle
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_get_single_event
	+
	+
	+function pythia8_get_particle_status (cptr, index) bind(C) result (status)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), intent(in), value :: index
	+ integer(c_int) :: status
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_get_particle_status
	+
	+function pythia8_get_particle_id (cptr, index) bind(C) result (status)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), intent(in), value :: index
	+ integer(c_int) :: status
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_get_particle_id
	+
	+subroutine pythia8_get_particle_momentum (cptr, index, momentum) bind(C)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), intent(in), value :: index
	+ real(c_double), dimension(*), intent(out) :: momentum
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end subroutine pythia8_get_particle_momentum
	+
	+function pythia8_get_n_mothers (cptr) bind(C) result (n_mothers)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ integer(c_int) :: n_mothers
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_get_n_mothers
	+
	+function pythia8_get_mother_array (cptr, i_prt, index) bind(C) result (mother)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ integer(c_int), value, intent(in) :: i_prt
	+ integer(c_int), value, intent(in) :: index
	+ integer(c_int) :: mother
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_get_mother_array
	+
	+function pythia8_get_n_daughters (cptr) bind(C) result (n_daughters)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ integer(c_int) :: n_daughters
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+
	+end function pythia8_get_n_daughters
	+
	+function pythia8_get_daughter_array (cptr, i_prt, index) bind(C) result (daughter)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ integer(c_int), value, intent(in) :: i_prt
	+ integer(c_int), value, intent(in) :: index
	+ integer(c_int) :: daughter
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_get_daughter_array
	+
	+function pythia8_get_status_hepmc (cptr, i_prt) bind(C) result (status)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), value, intent(in) :: i_prt
	+ integer(c_int) :: status
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function pythia8_get_status_hepmc
	+
	+subroutine pythia8_get_decay_vertex (cptr, i_prt, time, vertex) bind(C)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), value, intent(in) :: i_prt
	+ real(c_double), intent(out) :: time
	+ real(c_double), dimension(3), intent(out) :: vertex
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* Pythia8: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end subroutine pythia8_get_decay_vertex
	Index: trunk/src/pythia8/Makefile.am
	===================================================================
	--- trunk/src/pythia8/Makefile.am (revision 8189)
	+++ trunk/src/pythia8/Makefile.am (revision 8190)
	@@ -1,65 +1,221 @@
	## Makefile.am -- Makefile for WHIZARD
	##
	## Process this file with automake to produce Makefile.in
	#
	# Copyright (C) 1999-2018 by
	# Wolfgang Kilian <kilian@physik.uni-siegen.de>
	# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
	# Juergen Reuter <juergen.reuter@desy.de>
	# with contributions from
	# cf. main AUTHORS file
	#
	# WHIZARD is free software; you can redistribute it and/or modify it
	# under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 2, or (at your option)
	# any later version.
	#
	# WHIZARD is distributed in the hope that it will be useful, but
	# WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	# GNU General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with this program; if not, write to the Free Software
	# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
	#
	########################################################################

	+## The files in this directory implement the LHA user process interface for WHIZARD
	+## and the interface to Pythia8.
	+
	## The files in this directory end up in an auxiliary libtool library.
	+noinst_LTLIBRARIES = libwo_pythia8.la
	+check_LTLIBRARIES = libwo_pythia8_ut.la
	if PYTHIA8_AVAILABLE
	-noinst_LTLIBRARIES = libPythia8Wrap.la
	-libPythia8Wrap_la_SOURCES = \
	- Pythia8Wrap.cpp
	-libPythia8Wrap_la_CPPFLAGS = $(PYTHIA8_CXXFLAGS)
	+libwo_pythia8_la_SOURCES = \
	+ LHAWhizard_events.h \
	+ LHAWhizard.h \
	+ LHAWhizard.cpp \
	+ LHAWhizardWrap.cpp \
	+ Pythia8Wrap.h \
	+ Pythia8Wrap.cpp
	+libwo_pythia8_la_CPPFLAGS = $(PYTHIA8_CXXFLAGS)
	else
	-noinst_LTLIBRARIES = libPythia8Wrap_dummy.la
	-libPythia8Wrap_dummy_la_SOURCES = \
	- Pythia8Wrap_dummy.f90
	+libwo_pythia8_la_SOURCES = \
	+ LHAWhizard_dummy.f90 \
	+ Pythia8Wrap_dummy.f90
	endif

	-AM_FCFLAGS =
	+libwo_pythia8_la_SOURCES += \
	+ whizard_lha.f90 \
	+ pythia8.f90
	+
	+libwo_pythia8_ut_la_SOURCES = \
	+ whizard_lha_uti.f90 \
	+ whizard_lha_ut.f90 \
	+ pythia8_uti.f90 \
	+ pythia8_ut.f90
	+
	+SRC_FROM_NOWEB = \
	+ whizard_lha.f90 \
	+ pythia8.f90 \
	+ whizard_lha_uti.f90 whizard_lha_ut.f90 \
	+ pythia8_uti.f90 pythia8_ut.f90
	+
	+## Omitting this would exclude it from the distribution
	+dist_noinst_DATA = pythia8.nw
	+
	+# Dump module names into file Modules
	+libwo_pythia8_Modules = ${libwo_pythia8_la_SOURCES:.f90=} ${libwo_pythia8_ut_la_SOURCES:.f90=}
	+Modules: Makefile
	+ @for module in $(libwo_pythia8_Modules); do \
	+ echo $$module >> $@.new; \
	+ done
	+ @if diff $@ $@.new -q >/dev/null; then \
	+ rm $@.new; \
	+ else \
	+ mv $@.new $@; echo "Modules updated"; \
	+ fi
	+BUILT_SOURCES = Modules
	+
	+## Fortran module dependencies
	+# Get module lists from other directories
	+module_lists = \
	+ ../basics/Modules \
	+ ../events/Modules \
	+ ../utilities/Modules \
	+ ../particles/Modules \
	+ ../physics/Modules \
	+ ../qft/Modules \
	+ ../rng/Modules \
	+ ../types/Modules \
	+ ../testing/Modules \
	+ ../system/Modules
	+
	+$(module_lists):
	+ $(MAKE) -C `dirname $@` Modules
	+
	+Module_dependencies.sed: $(libwo_pythia8_la_SOURCES) $(libwo_pythia8_ut_la_SOURCES)
	+Module_dependencies.sed: $(module_lists)
	+ @rm -f $@
	+ echo 's/, only:.//' >> $@
	+ echo 's/, *&//' >> $@
	+ echo 's/, .=>.*//' >> $@
	+ echo 's/$$/.lo/' >> $@
	+ for list in $(module_lists); do \
	+ dir="`dirname $$list`"; \
	+ for mod in `cat $$list`; do \
	+ echo 's!: '$$mod'.lo$$!': $$dir/$$mod'.lo!' >> $@; \
	+ done ; \
	+ done
	+
	+DISTCLEANFILES = Module_dependencies.sed
	+
	+# The following line just says
	+# include Makefile.depend
	+# but in a portable fashion (depending on automake's AM_MAKE_INCLUDE
	+@am__include@ @am__quote@Makefile.depend@am__quote@
	+
	+Makefile.depend: Module_dependencies.sed
	+Makefile.depend: $(libwo_pythia8_la_SOURCES) ${libwo_pythia8_ut_la_SOURCES}
	+ @rm -f $@
	+ for src in $^; do \
	+ module="`basename $$src \| sed 's/\.f[90][0358]//'`"; \
	+ grep '^ *use ' $$src \
	+ \| grep -v '!NODEP!' \
	+ \| sed -e 's/^ use /'$$module'.lo: /' \
	+ -f Module_dependencies.sed; \
	+ done > $@
	+
	+DISTCLEANFILES += Makefile.depend
	+
	+
	+# Fortran90 module files are generated at the same time as object files
	+.lo.$(FC_MODULE_EXT):
	+ @:
	+# touch $@
	+
	+AM_FCFLAGS = -I../basics -I../events -I../utilities -I../testing -I../system -I../physics -I../particles -I../qft -I../rng -I../types -I../combinatorics -I../fastjet -I../variables

	########################################################################
	## Default Fortran compiler options

	## Profiling
	if FC_USE_PROFILING
	AM_FCFLAGS += $(FCFLAGS_PROFILING)
	endif

	## OpenMP
	if FC_USE_OPENMP
	AM_FCFLAGS += $(FCFLAGS_OPENMP)
	endif

	## MPI
	if FC_USE_MPI
	AM_FCFLAGS += $(FCFLAGS_MPI)
	endif

	########################################################################
	+## Non-standard targets and dependencies
	+
	+## (Re)create F90 sources from NOWEB source.
	+if NOWEB_AVAILABLE
	+
	+FILTER =
	+if FC_USE_MPI
	+FILTER += -filter "sed 's/defn MPI:/defn/'"
	+endif
	+
	+PRELUDE = $(top_srcdir)/src/noweb-frame/whizard-prelude.nw
	+POSTLUDE = $(top_srcdir)/src/noweb-frame/whizard-postlude.nw
	+
	+Pythia8.stamp: $(PRELUDE) $(srcdir)/pythia8.nw $(POSTLUDE)
	+ @rm -f Pythia8.tmp
	+ @touch Pythia8.tmp
	+ for src in $(SRC_FROM_NOWEB); do \
	+ $(NOTANGLE) -R[[$$src]] $(FILTER) $^ \| $(CPIF) $$src; \
	+ done
	+ @mv -f Pythia8.tmp Pythia8.stamp
	+
	+$(SRC_FROM_NOWEB): Pythia8.stamp
	+## Recover from the removal of $@
	+ @if test -f $@; then :; else \
	+ rm -f Pythia8.stamp; \
	+ $(MAKE) $(AM_MAKEFLAGS) Pythia8.stamp; \
	+ fi
	+
	+endif
	+
	+
	+########################################################################
	## Non-standard cleanup tasks
	+## Remove sources that can be recreated using NOWEB
	+
	+if NOWEB_AVAILABLE
	+maintainer-clean-noweb:
	+ -rm -f *.f90
	+endif
	+.PHONY: maintainer-clean-noweb
	+
	+## Remove those sources also if builddir and srcdir are different
	+if NOWEB_AVAILABLE
	+clean-noweb:
	+ test "$(srcdir)" != "." && rm -f *.f90 \|\| true
	+endif
	+.PHONY: clean-noweb
	+
	+## Remove F90 module files
	+clean-local: clean-noweb
	+ -rm -f Pythia8.stamp Pythia8.tmp
	+ -rm -f *.$(FC_MODULE_EXT)
	+if FC_SUBMODULES
	+ -rm -f *.smod
	+endif

	## Remove backup files
	-maintainer-clean-local:
	+maintainer-clean-backup:
	-rm -f *~
	+.PHONY: maintainer-clean-backup
	+
	+## Register additional clean targets
	+maintainer-clean-local: maintainer-clean-noweb maintainer-clean-backup
	Index: trunk/src/pythia8/pythia8.nw
	===================================================================
	--- trunk/src/pythia8/pythia8.nw (revision 0)
	+++ trunk/src/pythia8/pythia8.nw (revision 8190)
	@@ -0,0 +1,1773 @@
	+%% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	+% WHIZARD code as NOWEB source: LHA user process interface and Pythia8 interface
	+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	+
	+\chapter{LHA User Process and Pythia8}
	+\label{cha:lha-pythia8}
	+
	+We implement the Les Houches Accord interface for C++ specified in Pythia8 and
	+interface the Pythia with the given LHA User Process object of WHIZARD.
	+
	+\section{LHA User Process WHIZARD}
	+\label{sec:lha-whizard}
	+
	+<<[[whizard_lha.f90]]>>=
	+<<File header>>
	+
	+module whizard_lha
	+<<Use kinds>>
	+
	+<<whizard lha: modules>>
	+
	+<<Standard module head>>
	+
	+<<whizard lha: public>>
	+
	+<<whizard lha: parameters>>
	+
	+<<whizard lha: types>>
	+
	+<<whizard lha: interfaces>>
	+
	+contains
	+
	+<<whizard lha: procedures>>
	+
	+end module whizard_lha
	+@ %def whizard_lha
	+@
	+<<whizard lha: modules>>=
	+ use, intrinsic :: iso_c_binding
	+ use diagnostics
	+ use format_utils, only: write_separator
	+ use lorentz
	+ use io_units, only: given_output_unit
	+ use polarizations
	+ use particles
	+ use subevents, only: PRT_BEAM, PRT_INCOMING, PRT_OUTGOING, &
	+ PRT_UNDEFINED, PRT_VIRTUAL, PRT_RESONANT, PRT_BEAM_REMNANT
	+
	+@ %def whizard_lha_modules
	+@ We define a transport type for a particle corresponding to C-struct.
	+<<whizard lha: public>>=
	+ public :: lha_particle_t
	+<<whizard lha: types>>=
	+ type, bind(C) :: lha_particle_t
	+ integer(c_int) :: id, status
	+ integer(c_int), dimension(2) :: mother
	+ integer(c_int), dimension(2) :: color
	+ real(c_double), dimension(4) :: momentum
	+ real(c_double) :: mass, tau, spin
	+ end type lha_particle_t
	+
	+@ %def lha_particle_t
	+@ Private print routine for [[lha_particle_t]].
	+<<whizard lha: interfaces>>=
	+ interface lha_particle_write
	+ module procedure lha_particle_write_single, lha_particle_write_array
	+ end interface lha_particle_write
	+<<whizard lha: procedures>>=
	+ subroutine lha_particle_write_single (particle, unit)
	+ type(lha_particle_t) :: particle
	+ integer, intent(in), optional :: unit
	+ integer :: u
	+ u = given_output_unit (unit)
	+ write (u, "(I9,1X)", advance="no") particle%id
	+ write (u, "(I4,1X)", advance="no") particle%status
	+ write (u, "(2(I5,1X))", advance="no") particle%mother(1), particle%mother(2)
	+ write (u, "(2(I5,1X))", advance="no") particle%color(1), particle%color(2)
	+ write (u, "(5(F11.3,1X))", advance="no") particle%momentum(2), particle%momentum(3), &
	+ particle%momentum(4), particle%momentum(1), particle%mass
	+ write (u, "(F8.3,1X)", advance="no") particle%tau
	+ write (u, "(F8.3,1X)", advance="no") particle%tau
	+ write (u, "(A)")
	+ end subroutine lha_particle_write_single
	+
	+ subroutine lha_particle_write_array (particle_set, unit)
	+ type(lha_particle_t), dimension(:), intent(in) :: particle_set
	+ integer, intent(in), optional :: unit
	+ integer :: u, i
	+ u = given_output_unit (unit)
	+ write (u, "(1X,A)") "LHA Particle set:"
	+ call write_separator (u)
	+ write (u, "((A4,1X),(A9,1X),(A4,1X),(1X,A10,1X),(1X,A10,1X),5(A11,1X),2(A8,1X))") &
	+ "No", "ID", "Stat", "Mothers", "Colours", &
	+ "P(1)", "P(2)", "P(3)", "E", "M", "Tau", "Spin"
	+ if (size (particle_set) == 0) then
	+ write (u, "(3X,A)") "[empty]"
	+ else
	+ do i = 1, size(particle_set)
	+ write (u, "(I4,1X)", advance="no") i
	+ call lha_particle_write_single (particle_set(i), unit)
	+ end do
	+ end if
	+ call write_separator (u)
	+ end subroutine lha_particle_write_array
	+
	+@ %def lha_particle_write_single, lha_particle_write_array
	+@ We define the [[whizard_lha_t]] type which handles the C++ implementation of
	+the LHA User Procces class [[LHAupWhizard]].
	+<<whizard lha: public>>=
	+ public :: whizard_lha_t
	+<<whizard lha: types>>=
	+ type :: whizard_lha_t
	+ private
	+ type(c_ptr) :: cptr
	+ logical :: new_event = .false.
	+ contains
	+ <<whizard lha: whizard lha: TBP>>
	+ end type whizard_lha_t
	+
	+@ %def whizard_lha_t
	+@ Initialize. Construct a new C++ object of type [[LHAupWhizard]].
	+<<whizard lha: whizard lha: TBP>>=
	+ procedure :: init => whizard_lha_init
	+<<whizard lha: interfaces>>=
	+ interface
	+ function new_whizard_lha () bind(C) result (cptr)
	+ import
	+ type(c_ptr) :: cptr
	+ end function new_whizard_lha
	+ end interface
	+
	+<<whizard lha: procedures>>=
	+ subroutine whizard_lha_init (whizard_lha)
	+ class(whizard_lha_t), intent(out) :: whizard_lha
	+ whizard_lha%cptr = new_whizard_lha ()
	+ end subroutine whizard_lha_init
	+
	+@ %def whizard_lha_init
	+@ Finalize. Call the Destructor of the [[LHAupWhizard]] object.
	+<<whizard lha: whizard lha: TBP>>=
	+ procedure :: final => whizard_lha_final
	+<<whizard lha: interfaces>>=
	+ interface
	+ subroutine lhaup_whizard_delete (cptr) bind(C)
	+ import
	+ ! Attribute value cannot have intent(inout).
	+ type(c_ptr), value :: cptr
	+ end subroutine lhaup_whizard_delete
	+ end interface
	+
	+<<whizard lha: procedures>>=
	+ subroutine whizard_lha_final (whizard_lha)
	+ class(whizard_lha_t), intent(inout) :: whizard_lha
	+ call lhaup_whizard_delete (whizard_lha%cptr)
	+ end subroutine whizard_lha_final
	+
	+@ %def whizard_lha_final
	+@ Get [[c_ptr]].
	+<<whizard lha: whizard lha: TBP>>=
	+ procedure :: get_ptr => whizard_lha_get_ptr
	+<<whizard lha: procedures>>=
	+ function whizard_lha_get_ptr (whizard_lha) result (cptr)
	+ class(whizard_lha_t), intent(in) :: whizard_lha
	+ type(c_ptr) :: cptr
	+ cptr = whizard_lha%cptr
	+ end function whizard_lha_get_ptr
	+
	+@ %def whizard_lha_get_ptr
	+@ Set initialisation parameter.
	+<<whizard lha: whizard lha: TBP>>=
	+ procedure :: set_init => whizard_lha_set_init
	+<<whizard lha: interfaces>>=
	+ interface
	+ function lhaup_whizard_set_init (cptr, beam_pdg, beam_energy, n_processes, unweighted, negative_weights) bind(C) result (flag)
	+ import
	+ type(c_ptr), value :: cptr
	+ integer(c_int), dimension(2), intent(in) :: beam_pdg
	+ real(c_double), dimension(2), intent(in) :: beam_energy
	+ integer(c_int), intent(in), value :: n_processes
	+ logical(c_bool), intent(in), value :: unweighted, negative_weights
	+ logical(c_bool) :: flag
	+ end function lhaup_whizard_set_init
	+ end interface
	+
	+<<whizard lha: procedures>>=
	+ subroutine whizard_lha_set_init (whizard_lha, beam_pdg, beam_energy, n_processes, unweighted, negative_weights)
	+ class(whizard_lha_t), intent(inout) :: whizard_lha
	+ integer, dimension(2), intent(in) :: beam_pdg
	+ real(default), dimension(2), intent(in) :: beam_energy
	+ integer, intent(in) :: n_processes
	+ logical, intent(in) :: unweighted
	+ logical, intent(in) :: negative_weights
	+ logical(c_bool) :: flag
	+ integer(c_int) :: c_n_processes
	+ integer(c_int), dimension(2) :: c_beam_pdg
	+ real(c_double), dimension(2) :: c_beam_energy
	+ logical(c_bool) :: c_unweighted, c_negative_weights
	+ c_beam_pdg = int (beam_pdg, c_int)
	+ c_beam_energy = real (beam_energy, c_double)
	+ c_n_processes = int (n_processes, c_int)
	+ c_unweighted = unweighted
	+ c_negative_weights = negative_weights
	+ flag = lhaup_whizard_set_init (whizard_lha%cptr, c_beam_pdg, &
	+ c_beam_energy, c_n_processes, c_unweighted, c_negative_weights)
	+ if (.not. flag) then
	+ call msg_fatal ("[whizard_lha_set_init] could not " // &
	+ "initialize the LHAUpWhizard interface.")
	+ end if
	+ end subroutine whizard_lha_set_init
	+
	+@ %def whizard_lha_set_init
	+@ Set process parameters.
	+<<whizard lha: whizard lha: TBP>>=
	+ procedure :: set_process_parameters => whizard_lha_set_process_parameters
	+<<whizard lha: interfaces>>=
	+ interface
	+ function lhaup_whizard_set_process_parameters &
	+ (cptr, process_id, cross_section, error, max_weight) &
	+ bind(C) result (flag)
	+ import
	+ type(c_ptr), value :: cptr
	+ integer(c_int), intent(in), value :: process_id
	+ real(c_double), intent(in), value :: cross_section, error, max_weight
	+ logical(c_bool) :: flag
	+ end function lhaup_whizard_set_process_parameters
	+ end interface
	+
	+<<whizard lha: procedures>>=
	+ ! get this directly from event_sample_data_t
	+ subroutine whizard_lha_set_process_parameters (whizard_lha, process_id, cross_section, error, max_weight)
	+ class(whizard_lha_t), intent(inout) :: whizard_lha
	+ integer, intent(in) :: process_id
	+ real(default), intent(in), optional :: cross_section, error, max_weight
	+ real(default), parameter :: pb_per_fb = 1.e-3_default
	+ integer(c_int) :: c_process_id
	+ real(c_double) :: c_cross_section, c_error, c_max_weight
	+ logical(c_bool) :: flag
	+ c_process_id = int (process_id, c_int)
	+ if (present (cross_section)) then
	+ c_cross_section = real (cross_section * pb_per_fb, c_double)
	+ else
	+ c_cross_section = 0._c_double
	+ end if
	+ if (present (error)) then
	+ c_error = real (error * pb_per_fb, c_double)
	+ else
	+ c_error = 0._c_double
	+ end if
	+ if (present (max_weight)) then
	+ c_max_weight = real (max_weight, c_double)
	+ else
	+ c_max_weight = 0._c_double
	+ end if
	+ flag = lhaup_whizard_set_process_parameters (whizard_lha%cptr, &
	+ c_process_id, c_cross_section, c_error, c_max_weight)
	+ if (.not. flag) then
	+ call msg_fatal ("[whizard_lha_add_process] could not add a process.")
	+ end if
	+ end subroutine whizard_lha_set_process_parameters
	+
	+@ %def whizard_lha_set_process_parameters
	+@ Print LHA User Process initialisation.
	+<<whizard lha: whizard lha: TBP>>=
	+ procedure :: list_init => whizard_lha_list_init
	+ procedure :: list_event => whizard_lha_list_event
	+<<whizard lha: interfaces>>=
	+ interface
	+ subroutine lhaup_whizard_list_init (cptr) bind(C)
	+ import
	+ type(c_ptr), value :: cptr
	+ end subroutine lhaup_whizard_list_init
	+ end interface
	+
	+ interface
	+ subroutine lhaup_whizard_list_event (cptr) bind(C)
	+ import
	+ type(c_ptr), value :: cptr
	+ end subroutine lhaup_whizard_list_event
	+ end interface
	+
	+<<whizard lha: procedures>>=
	+ subroutine whizard_lha_list_init (whizard_lha)
	+ class(whizard_lha_t), intent(in) :: whizard_lha
	+ call lhaup_whizard_list_init (whizard_lha%cptr)
	+ end subroutine whizard_lha_list_init
	+
	+ subroutine whizard_lha_list_event (whizard_lha)
	+ class(whizard_lha_t), intent(in) :: whizard_lha
	+ call lhaup_whizard_list_event (whizard_lha%cptr)
	+ end subroutine whizard_lha_list_event
	+
	+@ %def whizard_lha_list_init, whizard_lha_list_event
	+@ Set the event process information.
	+We set the process’ scale, the coupling and the weight, iff we handle weighted events.
	+Also, we clean up and prepare the particle list.
	+<<whizard lha: whizard lha: TBP>>=
	+ procedure :: set_event_process => whizard_lha_set_event_process
	+<<whizard lha: interfaces>>=
	+ interface
	+ subroutine lhaup_whizard_set_event_process &
	+ (cptr, process_id, scale, alpha_qcd, alpha_qed, weight) bind(C)
	+ import
	+ type(c_ptr), value :: cptr
	+ integer(c_int), intent(in), value :: process_id
	+ real(c_double), intent(in), value :: scale, alpha_qcd, alpha_qed, weight
	+ end subroutine lhaup_whizard_set_event_process
	+ end interface
	+
	+<<whizard lha: procedures>>=
	+ subroutine whizard_lha_set_event_process &
	+ (whizard_lha, process_id, scale, alpha_qcd, alpha_qed, weight)
	+ class(whizard_lha_t), intent(inout) :: whizard_lha
	+ integer, intent(in) :: process_id
	+ real(default), intent(in) :: scale, alpha_qcd, alpha_qed, weight
	+ integer(c_int) :: c_process_id
	+ real(c_double) :: c_scale, c_alpha_qcd, c_alpha_qed, c_weight
	+ c_scale = real (scale, c_double)
	+ c_alpha_qcd = real (alpha_qcd, c_double)
	+ c_alpha_qed = real (alpha_qed, c_double)
	+ c_weight = real (weight, c_double)
	+ c_process_id = int (process_id, c_int)
	+ call lhaup_whizard_set_event_process (whizard_lha%cptr, &
	+ c_process_id, c_scale, c_alpha_qcd, c_alpha_qed, c_weight)
	+ whizard_lha%new_event = .true.
	+ end subroutine whizard_lha_set_event_process
	+
	+@ %def whizard_lha_set_event_process
	+@ Set particles in to LHA event record. Must be called after [[whizard_lha_set_event_process]].
	+
	+We first create a new particle set that contains only the particles that are
	+supported by the Les Houches Accord. These are: beam, incoming, resonant or outgoing.
	+We drop particles with unknown, virtual or beam-remnant status.
	+
	+From this we fill the LHA particle type.
	+<<whizard lha: whizard lha: TBP>>=
	+ procedure :: set_event => whizard_lha_set_event
	+<<whizard lha: interfaces>>=
	+ interface
	+ function lhaup_whizard_set_event (cptr, process_id, n_particles, &
	+ particle_set) bind(C) result (flag)
	+ import
	+ type(c_ptr), value :: cptr
	+ integer(c_int), intent(in), value :: process_id
	+ integer(c_int), intent(in), value :: n_particles
	+ ! IMPORTANT NOTE: Assumed-size array has to be defined by *.
	+ type(lha_particle_t), dimension(*), intent(in) :: particle_set
	+ logical(c_bool) :: flag
	+ end function lhaup_whizard_set_event
	+ end interface
	+
	+<<whizard lha: procedures>>=
	+ subroutine whizard_lha_set_event (whizard_lha, process_id, particle_set,&
	+ keep_beams, keep_remnants, polarization)
	+ class(whizard_lha_t), intent(inout) :: whizard_lha
	+ integer, intent(in) :: process_id
	+ type(particle_set_t), intent(in) :: particle_set
	+ logical, intent(in), optional :: keep_beams, keep_remnants, polarization
	+ type(particle_set_t) :: pset
	+ logical :: kr, pol
	+ type(lha_particle_t), dimension(:), allocatable :: c_particle_set
	+ integer(c_int) :: c_process_id, c_n_particles
	+ logical(c_bool) :: flag
	+ kr = .true.; if (present (keep_remnants)) kr = keep_remnants
	+ pol = .true.; if (present (polarization)) pol = polarization
	+ if (.not. whizard_lha%new_event) then
	+ call msg_bug ("[whizard_lha_set_event] new event was not prepared.")
	+ end if
	+ call particle_set%filter_particles (pset, real_parents = .true., &
	+ keep_beams = keep_beams, keep_virtuals = .false.)
	+ if (debug_active (D_SHOWER) .or. debug_active(D_TRANSFORMS)) then
	+ print *, "After particle_set%filter: pset"
	+ call pset%write (summary = .true., compressed = .true.)
	+ end if
	+ allocate (c_particle_set (pset%get_n_tot ()))
	+ call fill_c_particle_set (pset, c_particle_set, kr, pol)
	+ if (debug_active (D_SHOWER) .or. debug_active (D_TRANSFORMS)) &
	+ call lha_particle_write (c_particle_set)
	+ c_n_particles = pset%get_n_tot (); c_process_id = process_id
	+ flag = lhaup_whizard_set_event (whizard_lha%cptr, c_process_id, c_n_particles, c_particle_set)
	+ whizard_lha%new_event = .false.
	+ contains
	+ subroutine fill_c_particle_set (particle_set, c_particle_set, keep_remnants, polarization)
	+ type(particle_set_t), intent(in) :: particle_set
	+ type(lha_particle_t), dimension(:), intent(out) :: c_particle_set
	+ logical, intent(in) :: keep_remnants, polarization
	+ integer :: i, status
	+ integer, dimension(:), allocatable :: parent
	+ integer, dimension(2) :: color
	+ type(vector4_t) :: p
	+ do i = 1, particle_set%get_n_tot ()
	+ associate (c_prt => c_particle_set, prt => particle_set%prt(i))
	+ c_prt(i)%id = prt%get_pdg ()
	+ status = prt%get_status ()
	+ if (keep_remnants .and. status == PRT_BEAM_REMNANT &
	+ .and. prt%get_n_children () == 0) then
	+ status = PRT_OUTGOING
	+ end if
	+ select case (status)
	+ case (PRT_BEAM); c_prt(i)%status = -9
	+ case (PRT_INCOMING); c_prt(i)%status = -1
	+ case (PRT_OUTGOING); c_prt(i)%status = 1
	+ case (PRT_RESONANT); c_prt(i)%status = 2
	+ case (PRT_VIRTUAL); c_prt(i)%status = 3
	+ case default; c_prt(i)%status = 0
	+ end select
	+ parent = prt%get_parents ()
	+ select case (size (parent))
	+ case (0)
	+ c_prt(i)%mother(1) = 0; c_prt(i)%mother(2) = 0
	+ case (1)
	+ c_prt(i)%mother(1) = parent(1); c_prt(i)%mother(2) = 0
	+ case (2)
	+ c_prt(i)%mother(1) = parent(1); c_prt(i)%mother(2) = parent(2)
	+ case default
	+ call msg_bug("[c_fill_particle_set] Too many parents. &
	+ &Please contact the WHIZARD developers.")
	+ end select
	+ color = prt%get_color ()
	+ where (color > 0)
	+ c_prt(i)%color = 500 + color
	+ elsewhere
	+ c_prt(i)%color = 0
	+ end where
	+ p = prt%get_momentum ()
	+ c_prt(i)%momentum = p%p
	+ c_prt(i)%mass = invariant_mass(p)
	+ c_prt(i)%tau = prt%get_lifetime ()
	+ c_prt(i)%spin = 9
	+ if (polarization) then
	+ select case (prt%get_polarization_status ())
	+ case (PRT_GENERIC_POLARIZATION)
	+ if (prt%get_n_parents () == 1) then
	+ parent = prt%get_parents ()
	+ c_prt(i)%spin = polarization_to_spin &
	+ (prt%get_momentum (), prt%get_polarization (), &
	+ particle_set%prt(parent(1))%get_momentum ())
	+ end if
	+ end select
	+ end if
	+ end associate
	+ end do
	+ end subroutine fill_c_particle_set
	+
	+ real(default) function polarization_to_spin (p, pol, p_mother) result (spin)
	+ type(vector4_t), intent(in) :: p
	+ type(polarization_t), intent(in) :: pol
	+ type(vector4_t), intent(in) :: p_mother
	+ type(vector3_t) :: s3, p3
	+ type(vector4_t) :: s4
	+ ! TODO sbrass move the conversion of polarization to spin to a better place (with documentation)
	+ s3 = vector3_moving (pol%get_axis ())
	+ p3 = space_part (p)
	+ s4 = rotation_to_2nd (3, p3) * vector4_moving (0._default, s3)
	+ spin = enclosed_angle_ct (s4, p_mother)
	+ end function polarization_to_spin
	+
	+ end subroutine whizard_lha_set_event
	+
	+@ %def whizard_lha_set_event
	+@
	+\subsection{Unit tests}
	+\label{sec:whizard-lha-ut}
	+
	+Test module, followed by the corresponding implementation module.
	+
	+<<[[whizard_lha_ut.f90]]>>=
	+<<File header>>
	+
	+module whizard_lha_ut
	+ use unit_tests
	+ use whizard_lha_uti
	+
	+<<Standard module head>>
	+
	+<<whizard lha: public test>>
	+
	+contains
	+<<whizard lha: test driver>>
	+end module whizard_lha_ut
	+@ %def whizard_lha_ut
	+@
	+<<[[whizard_lha_uti.f90]]>>=
	+<<File header>>
	+
	+module whizard_lha_uti
	+<<Use kinds>>
	+ use io_units
	+ use whizard_lha
	+ use flavors, only: flavor_t
	+ use lorentz, only: vector4_at_rest
	+ use subevents, only: PRT_BEAM, PRT_INCOMING, PRT_OUTGOING, &
	+ PRT_UNDEFINED, PRT_VIRTUAL, PRT_RESONANT, PRT_BEAM_REMNANT
	+ use particles, only: particle_set_t
	+
	+<<Standard module head>>
	+
	+<<whizard lha: test declaration>>
	+
	+contains
	+<<whizard lha: tests>>
	+end module whizard_lha_uti
	+@ %def whizard_lha_uti
	+@ API: driver for the unit tests below.
	+<<whizard lha: public test>>=
	+ public :: whizard_lha_test
	+<<whizard lha: test driver>>=
	+ subroutine whizard_lha_test (u, results)
	+ integer, intent(in) :: u
	+ type(test_results_t), intent(inout) :: results
	+ <<whizard lha: execute tests>>
	+ end subroutine whizard_lha_test
	+
	+@ %def whizard_lha_test
	+@
	+\subsubsection{Setup LHA User Process}
	+<<whizard lha: execute tests>>=
	+ call test (whizard_lha_1, "whizard_lha_1", "Setup LHAupWhizard and&
	+ &initialize Beams.", u, results)
	+<<whizard lha: test declaration>>=
	+ public :: whizard_lha_1
	+<<whizard lha: tests>>=
	+ subroutine whizard_lha_1 (u)
	+ integer, intent(in) :: u
	+ type(whizard_lha_t) :: lha
	+ integer :: i
	+ integer, parameter :: N_PROC = 5
	+ real(default), dimension(N_PROC) :: xsec, xerror, max_weight
	+ write (u, "(A)") "* Test output: whizard_lha_1"
	+ write (u, "(A)") "* Purpose: Construct LHAupWhizard object and initialize the beams."
	+ write (u, *)
	+
	+ xsec = [1.0, 1.2, 1.4, 1.6, 1.8] * 1e3 ! fb
	+ xerror = 0.05 * xsec
	+ max_weight = 1e-3 * xsec
	+
	+ call lha%init ()
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Set initialisation (Beams) and weighting strategy."
	+ write (u, "(A)")
	+
	+ call lha%set_init &
	+ ([2212, 2212], [6500._default, 6500._default], 1, .true., .true.)
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Set process parameters for 5 different processes."
	+ write (u, "(A)")
	+ do i = 1, N_PROC
	+ call lha%set_process_parameters (process_id = i, &
	+ cross_section = xsec(i), error = xerror(i), &
	+ max_weight = max_weight(i))
	+ end do
	+
	+ call lha%list_init ()
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Cleanup"
	+
	+ call lha%final ()
	+ end subroutine whizard_lha_1
	+
	+@ %def whizard_lha_1
	+@
	+<<whizard lha: execute tests>>=
	+ call test (whizard_lha_2, "whizard_lha_2", "Setup LHAupWhizard&
	+ & and set event record.", u, results)
	+<<whizard lha: test declaration>>=
	+ public :: whizard_lha_2
	+<<whizard lha: tests>>=
	+ subroutine whizard_lha_2 (u)
	+ integer, intent(in) :: u
	+ type(whizard_lha_t) :: lha
	+ integer :: i
	+ integer, parameter :: N_PROC = 1
	+ real(default), dimension(N_PROC) :: xsec, xerror, max_weight
	+ type(particle_set_t) :: pset
	+ type(flavor_t), dimension(:), allocatable :: flv
	+ pset%n_beam = 2
	+ pset%n_in = 2
	+ pset%n_vir = 2
	+ pset%n_out = 3
	+ pset%n_tot = 9
	+
	+ write (u, "(A)") "* Test output: whizard_lha_2"
	+ write (u, "(A)") "* Purpose: Setup LHAupWhizard and set event record."
	+ write (u, "(A)")
	+
	+ xsec = [1.0] * 1e3
	+ xerror = 0.05 * xsec
	+ max_weight = 1e-3 * xsec
	+
	+ call lha%init ()
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Set initialisation (Beams) and weighting strategy."
	+ write (u, "(A)")
	+
	+ call lha%set_init &
	+ ([2212, 2212], [6500._default, 6500._default], 1, .true., .true.)
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Set process parameters for 5 different processes."
	+ write (u, "(A)")
	+ do i = 1, N_PROC
	+ call lha%set_process_parameters (process_id = i, &
	+ cross_section = xsec(i), error = xerror(i), &
	+ max_weight = max_weight(i))
	+ end do
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Set event record."
	+ write (u, "(A)")
	+
	+ allocate (pset%prt (pset%n_tot))
	+ call pset%prt(1)%reset_status (PRT_BEAM)
	+ call pset%prt(2)%reset_status (PRT_BEAM)
	+ call pset%prt(3)%reset_status (PRT_INCOMING)
	+ call pset%prt(4)%reset_status (PRT_INCOMING)
	+ call pset%prt(5)%reset_status (PRT_BEAM_REMNANT)
	+ call pset%prt(6)%reset_status (PRT_BEAM_REMNANT)
	+ call pset%prt(7)%reset_status (PRT_OUTGOING)
	+ call pset%prt(8)%reset_status (PRT_OUTGOING)
	+ call pset%prt(9)%reset_status (PRT_OUTGOING)
	+
	+ call pset%prt(1)%set_children ([3,5])
	+ call pset%prt(2)%set_children ([4,6])
	+ call pset%prt(3)%set_children ([7,8,9])
	+ call pset%prt(4)%set_children ([7,8,9])
	+
	+ call pset%prt(3)%set_parents ([1])
	+ call pset%prt(4)%set_parents ([2])
	+ call pset%prt(5)%set_parents ([1])
	+ call pset%prt(6)%set_parents ([2])
	+ call pset%prt(7)%set_parents ([3,4])
	+ call pset%prt(8)%set_parents ([3,4])
	+ call pset%prt(9)%set_parents ([3,4])
	+
	+ call pset%prt(1)%set_momentum (vector4_at_rest (1._default))
	+ call pset%prt(2)%set_momentum (vector4_at_rest (2._default))
	+ call pset%prt(3)%set_momentum (vector4_at_rest (4._default))
	+ call pset%prt(4)%set_momentum (vector4_at_rest (6._default))
	+ call pset%prt(5)%set_momentum (vector4_at_rest (3._default))
	+ call pset%prt(6)%set_momentum (vector4_at_rest (5._default))
	+ call pset%prt(7)%set_momentum (vector4_at_rest (7._default))
	+ call pset%prt(8)%set_momentum (vector4_at_rest (8._default))
	+ call pset%prt(9)%set_momentum (vector4_at_rest (9._default))
	+
	+ allocate (flv (9))
	+ call flv%init ([2011, 2012, 11, 12, 91, 92, 3, 4, 5])
	+ do i = 1, 9
	+ call pset%prt(i)%set_flavor (flv(i))
	+ end do
	+
	+ call lha%set_event_process (1, 1000._default, 0.1_default, 1._default / 127., 1._default)
	+ call lha%set_event (1, pset)
	+ call lha%list_init ()
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Cleanup"
	+
	+ call lha%final ()
	+ end subroutine whizard_lha_2
	+
	+@ %def whizard_lha_2
	+
	+\section{Pythia8}
	+\label{sec:pythia8}
	+
	+<<[[pythia8.f90]]>>=
	+<<File header>>
	+
	+module pythia8
	+<<Use kinds>>
	+
	+<<pythia8: modules>>
	+
	+<<Standard module head>>
	+
	+<<pythia8: public>>
	+
	+<<pythia8: parameters>>
	+
	+<<pythia8: variables>>
	+
	+<<pythia8: types>>
	+
	+<<pythia8: interfaces>>
	+
	+contains
	+
	+<<pythia8: procedures>>
	+
	+end module pythia8
	+@ %def pythia8
	+@
	+<<pythia8: modules>>=
	+ use, intrinsic :: iso_c_binding
	+ use constants, only: tiny_10, tiny_07
	+ use diagnostics
	+ use iso_varying_string, string_t => varying_string
	+ use lorentz, only: assignment(=), operator(/=), &
	+ vector3_moving, vector4_t, vector4_moving, vector4_null, &
	+ vector4_write
	+ use numeric_utils, only: vanishes, nearly_equal
	+ use model_data, only: model_data_t, find_model
	+ use pdg_arrays, only: is_elementary, is_colored, is_gluon
	+ use colors, only: color_t
	+ use flavors, only: flavor_t
	+ use helicities, only: helicity_t
	+ use particles, only: particle_set_t, particle_t, &
	+ PRT_DEFINITE_HELICITY, PRT_GENERIC_POLARIZATION, PRT_UNPOLARIZED
	+ use event_base, only: generic_event_t
	+ use subevents, only: PRT_BEAM, PRT_INCOMING, PRT_OUTGOING, &
	+ PRT_UNDEFINED, PRT_VIRTUAL, PRT_RESONANT, PRT_BEAM_REMNANT
	+ use rng_base, only: rng_t
	+ use whizard_lha
	+@ %def pythia8_modules
	+@ Random generator wrapper.
	+<<pythia8: types>>=
	+ type :: whizard_rndm_t
	+ class(rng_t), pointer :: rng
	+ end type whizard_rndm_t
	+
	+@ %def whizard_rndm_t
	+@
	+<<pythia8: public>>=
	+ public :: pythia8_t
	+<<pythia8: types>>=
	+ type :: pythia8_t
	+ private
	+ type(c_ptr) :: cptr
	+ type(whizard_rndm_t) :: rndm
	+ contains
	+ <<pythia8: pythia8: TBP>>
	+ end type pythia8_t
	+
	+@ %def pythia8_t
	+@ Init. Construct a C++-Pythia8 object and store it in an opaque type.
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: init => whizard_pythia8_init
	+<<pythia8: interfaces>>=
	+ interface
	+ function new_pythia8 (print_banner) bind(C) result (cptr)
	+ import
	+ type(c_ptr) :: cptr
	+ logical(c_bool), value, intent(in) :: print_banner
	+ end function new_pythia8
	+ end interface
	+
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_init (pythia, verbose)
	+ class(pythia8_t), intent(out) :: pythia
	+ logical, intent(in), optional :: verbose
	+ logical(c_bool) :: verbose_opt
	+ verbose_opt = .false.
	+ if (present (verbose)) verbose_opt = verbose
	+ pythia%cptr = new_pythia8 (verbose_opt)
	+ if (.not. verbose_opt) &
	+ call pythia%read_string (var_str ("Print:quiet = on"))
	+ end subroutine whizard_pythia8_init
	+
	+@ %def whizard_pythia8_init
	+@ Finalize. Destruct the C++-Ptyhia object.
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: final => whizard_pythia8_final
	+<<pythia8: interfaces>>=
	+ interface
	+ subroutine pythia8_delete (pythia) bind(C)
	+ import
	+ type(c_ptr), value :: pythia
	+ end subroutine pythia8_delete
	+ end interface
	+
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_final (pythia)
	+ class(pythia8_t), intent(inout) :: pythia
	+ call pythia8_delete (pythia%cptr)
	+ end subroutine whizard_pythia8_final
	+
	+@ %def whizard_pythia8_final
	+@ Set pointer to a LHA User Process object.
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: set_lhaup_ptr => whizard_pythia8_set_lhaup_ptr
	+<<pythia8: interfaces>>=
	+ interface
	+ function pythia8_set_lhaup_ptr (cptr, whizard_lha) bind(C) result (flag)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ type(c_ptr), intent(in), value :: whizard_lha
	+ logical(c_bool) :: flag
	+ end function pythia8_set_lhaup_ptr
	+ end interface
	+
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_set_lhaup_ptr (pythia, whizard_lha)
	+ class(pythia8_t), intent(inout) :: pythia
	+ type(whizard_lha_t), intent(in) :: whizard_lha
	+ logical(c_bool) :: flag
	+ flag = pythia8_set_lhaup_ptr (pythia%cptr, whizard_lha%get_ptr ())
	+ end subroutine whizard_pythia8_set_lhaup_ptr
	+
	+@ %def whizard_pythia8_set_lhaup_ptr
	+@ Import random number generator.
	+
	+We store a pointer to a target [[rng]] provided by the calling function in the
	+container [[whizard_rndm_t]].
	+The C-interface expects a C-pointer which we retrieve with [[c_loc]] from the container.
	+The container is an opaque objects for C and is a place-holder for the
	+polymorphic object [[rng]].
	+
	+When [[Pythia8]] requests a random-number, then we have to reverse the
	+containment of [[rng]] inside a container.
	+The container is mapped back to a Fortran pointer where we can access the target
	+[[rng]] and generate a random number.
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: import_rng => whizard_pythia8_import_rng
	+<<pythia8: interfaces>>=
	+ interface
	+ function pythia8_set_rndm_engine_ptr (pythia, whizard_rndm) bind(C) result (flag)
	+ import
	+ type(c_ptr), intent(in), value :: pythia
	+ type(c_ptr), intent(in), value :: whizard_rndm
	+ logical(c_bool) :: flag
	+ end function pythia8_set_rndm_engine_ptr
	+ end interface
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_import_rng (pythia, rng)
	+ class(pythia8_t), intent(inout), target :: pythia
	+ class(rng_t), allocatable, intent(in), target :: rng
	+ logical :: flag
	+ pythia%rndm%rng => rng
	+ flag = pythia8_set_rndm_engine_ptr (pythia%cptr, c_loc (pythia%rndm))
	+ if (.not. flag) then
	+ call msg_bug ("[whizard_pythia8_import_rng] Cannot export RNG to Pythia8.")
	+ end if
	+ end subroutine whizard_pythia8_import_rng
	+
	+ function whizard_rndm_generate (whizard_rndm) bind(C) result (c_x)
	+ type(c_ptr), intent(in), value :: whizard_rndm
	+ real(c_double) :: c_x
	+ real(default) :: x
	+ type(whizard_rndm_t), pointer :: f_whizard_rndm
	+ call c_f_pointer (whizard_rndm, f_whizard_rndm)
	+ if (.not. associated (f_whizard_rndm)) then
	+ call msg_bug ("[whizard_rndm_generate] Cannot import pointer to RNG object from Pythia8.")
	+ end if
	+ call f_whizard_rndm%rng%generate (x)
	+ c_x = real (x, c_double)
	+ end function whizard_rndm_generate
	+
	+@ %def pythia8_import_rng
	+@ Seed [[PYTHIA8]] random generator.
	+
	+Unfortunately, it is impossible to export the random number generator to C and
	+back to Fortran again in such a way that multiple instances of [[PYTHIA8]] could
	+exist coherently.
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: set_rng_seed => pythia8_set_rng_seed
	+<<pythia8: procedures>>=
	+ subroutine pythia8_set_rng_seed (pythia, r)
	+ class(pythia8_t), intent(inout) :: pythia
	+ real(default), intent(in) :: r
	+ real(default), parameter :: MAX_SEED = 900000000._default
	+ character(len=10) :: buffer; type(string_t) :: string
	+ write (buffer, "(I10)") floor (r * MAX_SEED)
	+ string = var_str ("Random:seed = " // buffer)
	+ call pythia%read_string (string)
	+ end subroutine pythia8_set_rng_seed
	+
	+@ %def pythia8_set_rng_seed
	+@ Read Pythia8 settings from file with path [[filename]].
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: read_file => whizard_pythia8_read_file
	+<<pythia8: interfaces>>=
	+ interface
	+ function pythia8_read_file (cptr, filename, subrun) bind(C) result (flag)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ character(kind=c_char), dimension(*), intent(in) :: filename
	+ integer(c_int), intent(in), value :: subrun
	+ logical(c_bool) :: flag
	+ end function pythia8_read_file
	+ end interface
	+
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_read_file (pythia, filename, subrun)
	+ class(pythia8_t), intent(inout) :: pythia
	+ type(string_t), intent(in) :: filename
	+ integer, intent(in), optional :: subrun
	+ character(len(filename) + 1, kind=c_char) :: c_filename
	+ integer(c_int) :: c_subrun
	+ logical(c_bool) :: flag
	+ c_filename = filename // c_null_char
	+ if (present (subrun)) then
	+ c_subrun = subrun
	+ else
	+ c_subrun = -1
	+ end if
	+ flag = pythia8_read_file (pythia%cptr, c_filename, c_subrun)
	+ end subroutine whizard_pythia8_read_file
	+
	+@ %def whizard_pythia8_read_file
	+@ Read a single Pythia8 string.
	+<<pythia8: parameters>>=
	+ integer, parameter :: C_MAX_STR_LEN = 100
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: read_string => whizard_pythia8_read_string
	+<<pythia8: interfaces>>=
	+ interface
	+ function pythia8_read_string (cptr, str) bind(C) result (flag)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ character(kind=c_char), dimension(*), intent(in) :: str
	+ logical(c_bool) :: flag
	+ end function pythia8_read_string
	+ end interface
	+
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_read_string (pythia, str)
	+ class(pythia8_t), intent(in) :: pythia
	+ type(string_t), intent(in) :: str
	+ character(len(str) + 1, kind=c_char) :: c_str
	+ logical(c_bool) :: flag
	+ c_str = char (str) // c_null_char
	+ flag = pythia8_read_string (pythia%cptr, c_str)
	+ end subroutine whizard_pythia8_read_string
	+
	+@ %def whizardd_pythia8_read_string
	+@ Parse and set the configuration string.
	+Different options are separeted either by a newline or by [[;]].
	+First, we separate lines, then we check on [[;]]. If none found, we take the
	+line as valid [[PYTHIA8]] string, else we the separate string into tokens which
	+we expect to be valid [[PYTHIA8]] tokens. We have to take care of the case that
	+the remaining string is empty after splitting with respect to [[;]].
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: parse_and_set_config => whizard_pythia8_parse_and_set_config
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_parse_and_set_config (pythia, config)
	+ class(pythia8_t), intent(in) :: pythia
	+ type(string_t), intent(in) :: config
	+ type(string_t) :: stream, line, token
	+ call msg_debug (D_SHOWER, "whizard_pythia8_parse_and_set_config")
	+ if (len (config) == 0) return
	+ stream = config
	+ do while (len (stream) > 0)
	+ call split (stream, line, new_line("A"))
	+ if (debug_active (D_SHOWER)) &
	+ print *, "LINE: ", char(line), " \| ", char(stream)
	+ if (index (line, ";") == 0) then
	+ call pythia%read_string (trim(line))
	+ else
	+ token = line
	+ do while (len (line) > 0)
	+ call split (line, token, ";")
	+ if (debug_active (D_SHOWER)) &
	+ print *, "→ ", char(token), " \| ", char(line)
	+ call pythia%read_string (trim(token))
	+ end do
	+ end if
	+ end do
	+
	+ end subroutine whizard_pythia8_parse_and_set_config
	+
	+@ %def whizard_pythia8_parse_and_set_config
	+@
	+@ Initialize the Pythia8 object itself after the complete setup has been done.
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: init_pythia => whizard_pythia8_init_pythia
	+<<pythia8: interfaces>>=
	+ interface
	+ function pythia8_init (cptr) bind(C) result (flag)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ logical(c_bool) :: flag
	+ end function pythia8_init
	+ end interface
	+
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_init_pythia (pythia)
	+ class(pythia8_t), intent(in) :: pythia
	+ logical(c_bool) :: flag
	+ flag = pythia8_init (pythia%cptr)
	+ if (.not. flag) then
	+ call msg_fatal ("[whizard_pythia8_init_pythia] Pythia8 initialisation failed.")
	+ end if
	+ end subroutine whizard_pythia8_init_pythia
	+
	+@ %def whizard_pythia8_init_pythia
	+@ Generate the next event in Pythia. Before the a new event has to be set with
	+the LHA User Process interface of WHIZARD.
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: next => whizard_pythia8_next
	+<<pythia8: interfaces>>=
	+ interface
	+ function pythia8_next (cptr) bind(C) result (flag)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ logical(c_bool) :: flag
	+ end function pythia8_next
	+ end interface
	+
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_next (pythia, flag)
	+ class(pythia8_t), intent(inout) :: pythia
	+ logical, intent(out), optional :: flag
	+ logical(c_bool) :: c_flag
	+ c_flag = pythia8_next (pythia%cptr)
	+ if (present (flag)) flag = c_flag
	+ end subroutine whizard_pythia8_next
	+
	+@ %def whizard_pythia8_next
	+@ List the current Les Houches event taken from the LHA Whizard interface or the last event generated by [[PYTHIA8]].
	+The procedure is for debug purpose only as the information are written to
	+[[cout]] (hard-wired).
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: list_lha_event => whizard_pythia8_list_lha_event
	+ procedure :: list_event => whizard_pythia8_list_event
	+<<pythia8: interfaces>>=
	+ interface
	+ subroutine pythia8_list_lha_event (cptr) bind(C)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ end subroutine pythia8_list_lha_event
	+ end interface
	+
	+ interface
	+ subroutine pythia8_list_event (cptr) bind(C)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ end subroutine pythia8_list_event
	+ end interface
	+
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_list_lha_event (pythia)
	+ class(pythia8_t), intent(in) :: pythia
	+ call pythia8_list_lha_event (pythia%cptr)
	+ end subroutine whizard_pythia8_list_lha_event
	+
	+ subroutine whizard_pythia8_list_event (pythia)
	+ class(pythia8_t), intent(in) :: pythia
	+ call pythia8_list_event (pythia%cptr)
	+ end subroutine whizard_pythia8_list_event
	+
	+@ %def whizard_pythia8_list_event
	+@ Get event size. We retrieve the number of particles associated with the last
	+event record in Pythia8. The first event entry is the overall system which we neglect.
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: get_event_size => whizard_pythia8_get_event_size
	+<<pythia8: interfaces>>=
	+ interface
	+ function pythia8_get_event_size (cptr) bind(C) result(n)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int) :: n
	+ end function pythia8_get_event_size
	+ end interface
	+
	+<<pythia8: procedures>>=
	+ function whizard_pythia8_get_event_size (pythia) result(n)
	+ class(pythia8_t), intent(in) :: pythia
	+ integer :: n
	+ integer(c_int) :: c_n
	+ c_n = pythia8_get_event_size (pythia%cptr)
	+ n = c_n - 1
	+ end function whizard_pythia8_get_event_size
	+
	+@ %def whizard_pythia8_get_event_size
	+@ Get the ith particle from the current event record in Pythia8.
	+<<pythia8: pythia8: TBP>>=
	+ procedure, private :: get_single_event => whizard_pythia8_get_single_event
	+<<pythia8: interfaces>>=
	+ interface
	+ function pythia8_get_single_event (cptr, index) bind(C) result (particle)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), intent(in), value :: index
	+ type(lha_particle_t) :: particle
	+ end function pythia8_get_single_event
	+ end interface
	+
	+<<pythia8: procedures>>=
	+ function whizard_pythia8_get_single_event (pythia, index) result (particle)
	+ class(pythia8_t), intent(in) :: pythia
	+ integer, intent(in) :: index
	+ type(lha_particle_t) :: particle
	+ integer(c_int) :: c_index
	+ c_index = index
	+ particle = pythia8_get_single_event (pythia%cptr, c_index)
	+ end function whizard_pythia8_get_single_event
	+
	+@ %def whizard_get_single_event
	+@ Convenient getter methods.
	+<<pythia8: interfaces>>=
	+ interface
	+ function pythia8_get_particle_status (cptr, index) bind(C) result (status)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), intent(in), value :: index
	+ integer(c_int) :: status
	+ end function pythia8_get_particle_status
	+ end interface
	+
	+ interface
	+ function pythia8_get_particle_id (cptr, index) bind(C) result (status)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), intent(in), value :: index
	+ integer(c_int) :: status
	+ end function pythia8_get_particle_id
	+ end interface
	+
	+ interface
	+ subroutine pythia8_get_particle_momentum (cptr, index, momentum) bind(C)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), intent(in), value :: index
	+ real(c_double), dimension(*), intent(out) :: momentum
	+ end subroutine pythia8_get_particle_momentum
	+ end interface
	+<<pythia8: pythia8: TBP>>=
	+ procedure, private :: get_particle_status => &
	+ whizard_pythia8_get_particle_status
	+ procedure, private :: get_particle_id => whizard_pythia8_get_particle_id
	+ procedure, private :: get_particle_momentum => &
	+ whizard_pythia8_get_particle_momentum
	+ procedure :: get_final_colored_ME_momenta => &
	+ whizard_pythia8_get_final_colored_ME_momenta
	+<<pythia8: procedures>>=
	+ function whizard_pythia8_get_particle_status (pythia, index) result (status)
	+ class(pythia8_t), intent(in) :: pythia
	+ integer, intent(in) :: index
	+ integer :: status
	+ status = pythia8_get_particle_status (pythia%cptr, int(index, c_int))
	+ end function whizard_pythia8_get_particle_status
	+
	+ function whizard_pythia8_get_particle_id (pythia, index) result (id)
	+ class(pythia8_t), intent(in) :: pythia
	+ integer, intent(in) :: index
	+ integer :: id
	+ id = pythia8_get_particle_id (pythia%cptr, int(index, c_int))
	+ end function whizard_pythia8_get_particle_id
	+
	+ function whizard_pythia8_get_particle_momentum &
	+ (pythia, index) result (momentum)
	+ class(pythia8_t), intent(in) :: pythia
	+ integer, intent(in) :: index
	+ real(default), dimension(4) :: momentum
	+ real(c_double), dimension(4) :: c_momentum
	+ call pythia8_get_particle_momentum (pythia%cptr, index, c_momentum)
	+ momentum = real (c_momentum, kind=default)
	+ end function whizard_pythia8_get_particle_momentum
	+
	+ subroutine whizard_pythia8_get_final_colored_ME_momenta &
	+ (pythia, momenta)
	+ class(pythia8_t), intent(in) :: pythia
	+ type(vector4_t), dimension(:), allocatable, intent(out) :: momenta
	+ logical, dimension(:), allocatable :: mask
	+ integer, parameter :: PYTHIA8_HARD_PROCESS_OUTGOING = 23
	+ integer :: i, j, n_particles, id, status
	+ call msg_debug (D_TRANSFORMS, "whizard_pythia8_get_final_colored_ME_momenta")
	+ n_particles = pythia%get_event_size ()
	+ allocate (mask(n_particles), source=.false.)
	+ do i = 1, n_particles
	+ status = pythia%get_particle_status (i)
	+ id = pythia%get_particle_id (i)
	+ if (abs (status) == PYTHIA8_HARD_PROCESS_OUTGOING &
	+ .and. (id == 21 .or. abs(id) <= 6)) mask(i) = .true.
	+ ! Particle record is ordered. First beam, beam remnants, then hard process, second hard process and so on...
	+ ! if (abs(status) > 30) exit
	+ end do
	+ if (all (.not. mask)) return
	+ allocate (momenta(count(mask)))
	+ j = 1
	+ do i = 1, n_particles
	+ if (.not. mask(i)) cycle
	+ momenta(j) = pythia%get_particle_momentum(i)
	+ j = j + 1
	+ end do
	+ end subroutine whizard_pythia8_get_final_colored_ME_momenta
	+
	+@ %def whizard_pythia8_get_particle_status
	+@ %def whizard_pythia8_get_particle_momentum
	+@ Get a logical mask on the shower entries in the current Pythia event
	+record.
	+
	+We skip the zeroth entry whichs holds overall system information.
	+We retrieve beam entries only when [[?ps_isr_active]] else we skip the
	+two beam entries. Furthermore, we check that all [[PYTHIA8]] have a
	+valid status code. We expect that the event record has been generated
	+with [[HadronLevel:all = Off]]. Furthermore, we skip entries which are
	+found in a reference particle set, or are too soft.
	+<<pythia8: pythia8: TBP>>=
	+ procedure, private :: get_shower_mask => pythia8_get_shower_mask
	+<<pythia8: procedures>>=
	+ subroutine pythia8_get_shower_mask (pythia, pset, mask, recover_beams)
	+ class(pythia8_t), intent(in) :: pythia
	+ type(particle_set_t), intent(in) :: pset
	+ logical, dimension(:), allocatable, intent(out) :: mask
	+ logical, intent(in) :: recover_beams
	+ integer :: skip_beams, i
	+ type(lha_particle_t) :: c_prt
	+ if (allocated (mask)) deallocate (mask)
	+ allocate (mask(pythia%get_event_size ()), source=.true.)
	+ if (.not. recover_beams) then
	+ skip_beams = 2
	+ mask(1:2) = .false.
	+ else
	+ skip_beams = 0
	+ end if
	+ do i = 1 + skip_beams, size(mask)
	+ c_prt = pythia%get_single_event (i)
	+ ! Search for unchanged entries
	+ mask(i) = (reverse_find_particle (c_prt, pset) == 0)
	+ end do
	+ end subroutine pythia8_get_shower_mask
	+
	+@ %def pythia8_get_shower_mask
	+@ Reverse find an existing entry in [[particle_set]].
	+Returns zero if non is found.
	+<<pythia8: procedures>>=
	+ pure function reverse_find_particle (c_prt, particle_set) result (idx)
	+ type(lha_particle_t), intent(in) :: c_prt
	+ type(particle_set_t), intent(in) :: particle_set
	+ integer :: idx
	+ type(vector4_t) :: momentum
	+ momentum = real (c_prt%momentum, default)
	+ idx = particle_set%reverse_find_particle (c_prt%id, momentum, tiny_10, tiny_07)
	+ end function reverse_find_particle
	+
	+@ %def reverse_find_particle
	+# Get a logical mask on the full hadronic entries in the current [[PYTHIA8]]
	+event record.
	+
	+The hadronic event record doesn't hold information about beams as those are only relevant in context of a partonic event.
	+We expect that the event record has been generated with [[ProcessLevel:all = Off]].
	+Furthermore, we skip entries which are found in a reference particle set.
	+<<pythia8: pythia8: TBP>>=
	+ procedure, private :: get_hadron_mask => pythia8_get_hadron_mask
	+<<pythia8: procedures>>=
	+ subroutine pythia8_get_hadron_mask (pythia, pset, mask)
	+ class(pythia8_t), intent(in) :: pythia
	+ type(particle_set_t), intent(in) :: pset
	+ logical, dimension(:), allocatable, intent(out) :: mask
	+ integer :: i
	+ integer(c_int) :: c_i_prt
	+ type(lha_particle_t) :: c_prt
	+ type(vector4_t) :: momentum
	+ if (allocated (mask)) deallocate (mask)
	+ allocate (mask(pythia%get_event_size ()), source=.true.)
	+ do i = 1, size(mask)
	+ c_prt = pythia%get_single_event (i)
	+ ! Search for unchanged entries
	+ mask(i) = (reverse_find_particle (c_prt, pset) == 0)
	+ end do
	+ end subroutine pythia8_get_hadron_mask
	+
	+@ %def pythia8_get_shower_mask
	+
	+@ Get [[particle_set]] from [[PYTHIA8]].
	+
	+A model and a fallback model have to be provided to declare the correct particle
	+content with a PDG code. We take a particle set and add the new particles by
	+parton shower. The polarization is explicity set (unpolarized or density matrix)
	+which is common to all particles. Correlated polarization information
	+is not available.
	+We recover beam particles only if explicitly stated.
	+
	+Pythia8 stores [[n_tot + 1]] particles where the zeroth particle represents the overall system.
	+We simply discard the zeroth event.
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: get_shower_particles => whizard_pythia8_get_shower_particles
	+<<pythia8: interfaces>>=
	+ interface
	+ function pythia8_get_n_mothers (cptr, i_prt) bind(C) result (n_mothers)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), value, intent(in) :: i_prt
	+ integer(c_int) :: n_mothers
	+ end function pythia8_get_n_mothers
	+
	+ subroutine pythia8_get_mother_array (cptr, i_prt, n_mothers, mother) bind (C)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), value :: i_prt
	+ integer(c_int), value :: n_mothers
	+ integer(c_int), dimension(*), intent(out) :: mother
	+ end subroutine pythia8_get_mother_array
	+
	+ function pythia8_get_n_daughters (cptr, i_prt) bind(C) result (n_daughters)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), value, intent(in) :: i_prt
	+ integer(c_int) :: n_daughters
	+ end function pythia8_get_n_daughters
	+
	+ subroutine pythia8_get_daughter_array (cptr, i_prt, n_daughters, daughter) bind (C)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), value :: i_prt
	+ integer(c_int), value :: n_daughters
	+ integer(c_int), dimension(*), intent(out) :: daughter
	+ end subroutine pythia8_get_daughter_array
	+
	+ function pythia8_get_status_hepmc (cptr, i_prt) bind(C) result (status)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), value, intent(in) :: i_prt
	+ integer(c_int) :: status
	+ end function pythia8_get_status_hepmc
	+
	+ subroutine pythia8_get_decay_vertex (cptr, i_prt, time, vertex) bind(C)
	+ import
	+ type(c_ptr), intent(in), value :: cptr
	+ integer(c_int), value, intent(in) :: i_prt
	+ real(c_double), intent(out) :: time
	+ real(c_double), dimension(3), intent(out) :: vertex
	+ end subroutine pythia8_get_decay_vertex
	+ end interface
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_get_shower_particles &
	+ (pythia, model, model_fallback, particle_set, helicity, recover_beams)
	+ class(pythia8_t), intent(in) :: pythia
	+ class(model_data_t), intent(in), target :: model, model_fallback
	+ type(particle_set_t), intent(inout) :: particle_set
	+ integer, intent(in), optional :: helicity
	+ logical, intent(in), optional :: recover_beams
	+ integer :: n_particles, n_old
	+ logical, dimension(:), allocatable :: mask
	+ type(particle_t), dimension(:), allocatable :: particle
	+ integer :: helicity_opt
	+ logical :: recover_beams_opt
	+ call msg_debug (D_SHOWER, "whizard_pythia8_get_particle_set")
	+ recover_beams_opt = .false.; if (present (recover_beams)) &
	+ recover_beams_opt = recover_beams
	+ helicity_opt = PRT_UNPOLARIZED; if (present (helicity)) &
	+ helicity_opt = helicity
	+ call pythia%get_shower_mask (particle_set, mask, recover_beams)
	+ n_particles = pythia%get_event_size ()
	+ if (.not. recover_beams_opt) n_particles = n_particles - 2
	+ allocate (particle(n_particles))
	+ call pythia%get_particles (model, model_fallback, mask, particle, particle_set, &
	+ helicity_opt, recover_beams_opt)
	+ end subroutine whizard_pythia8_get_shower_particles
	+
	+@ %def whizard_pythia8_get_shower_particles
	+@ Get hadron particles. Retrieve the full particle, respective the beam entries.
	+<<pythia8: pythia8: TBP>>=
	+ procedure :: get_hadron_particles => whizard_pythia8_get_hadron_particles
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_get_hadron_particles &
	+ (pythia, model, model_fallback, particle_set, helicity)
	+ class(pythia8_t), intent(in) :: pythia
	+ class(model_data_t), intent(in), target :: model, model_fallback
	+ type(particle_set_t), intent(inout) :: particle_set
	+ integer, intent(in), optional :: helicity
	+ integer :: n_particles
	+ logical, dimension(:), allocatable :: mask
	+ type(particle_t), dimension(:), allocatable :: particle
	+ integer, dimension(:), allocatable :: pythia_idx, whizard_idx
	+ integer :: helicity_opt
	+ call msg_debug (D_TRANSFORMS, "whizard_pythia8_get_particle_set")
	+ helicity_opt = PRT_UNPOLARIZED; if (present (helicity)) &
	+ helicity_opt = helicity
	+ call pythia%get_hadron_mask (particle_set, mask)
	+ n_particles = pythia%get_event_size ()
	+ allocate (particle(n_particles))
	+ call pythia%get_particles (model, model_fallback, mask, particle, particle_set, &
	+ helicity_opt, recover_beams = .true.)
	+ end subroutine whizard_pythia8_get_hadron_particles
	+
	+@ %def whizard_pythia8_get_hadron_particles
	+@ Get particles from [[PYTHIA8]].
	+
	+We take care of the status code of former outgoing particles (i.e. the unchanged particles entries of the outgoing particles of the hard process) and change it to [[PRT_VIRTUAL]].
	+<<pythia8: pythia8: TBP>>=
	+ procedure, private :: get_particles => whizard_pythia8_get_particles
	+<<pythia8: procedures>>=
	+ subroutine whizard_pythia8_get_particles (&
	+ pythia, model, model_fallback, mask, particle, particle_set, &
	+ helicity, recover_beams)
	+ class(pythia8_t), intent(in) :: pythia
	+ class(model_data_t), intent(in), target :: model, model_fallback
	+ logical, dimension(:), intent(in) :: mask
	+ type(particle_t), dimension(:), allocatable, intent(inout) :: particle
	+ type(particle_set_t), intent(inout) :: particle_set
	+ integer, intent(in) :: helicity
	+ logical, intent(in) :: recover_beams
	+ integer, dimension(:), allocatable :: pythia_idx, whizard_idx
	+ call msg_debug (D_SHOWER, "whizard_pythia8_get_particles")
	+ call pythia%import_pythia_particles (&
	+ model, model_fallback, mask, particle, particle_set, &
	+ pythia_idx, whizard_idx, helicity, recover_beams)
	+ call particle_set%replace (particle)
	+ call pythia%get_parent_child_relation (&
	+ pythia_idx, whizard_idx, particle_set, recover_beams)
	+ where (particle_set%prt%status == PRT_OUTGOING .and. &
	+ particle_set%prt%has_children ()) &
	+ particle_set%prt%status = PRT_VIRTUAL
	+ end subroutine whizard_pythia8_get_particles
	+
	+@ %def whizard_pythia8_get_particles
	+<<pythia8: pythia8: TBP>>=
	+ procedure, private :: import_pythia_particles => pythia8_import_pythia_particles
	+<<pythia8: procedures>>=
	+subroutine pythia8_import_pythia_particles (&
	+ pythia, model, model_fallback, mask, particle, particle_set, &
	+ pythia_idx, whizard_idx, helicity, recover_beams)
	+ class(pythia8_t), intent(in) :: pythia
	+ class(model_data_t), intent(in), target :: model, model_fallback
	+ logical, dimension(:), intent(in) :: mask
	+ type(particle_t), dimension(:), intent(inout) :: particle
	+ type(particle_set_t), intent(in) :: particle_set
	+ integer, dimension(:), allocatable, intent(out) :: pythia_idx, whizard_idx
	+ integer, intent(in) :: helicity
	+ logical, intent(in) :: recover_beams
	+ integer :: i_whizard, i_pythia, idx, skip_beams
	+ real(default) :: time
	+ real(default), dimension(3) :: vertex
	+ type(vector4_t) :: momentum
	+ type(lha_particle_t) :: c_prt
	+ allocate (whizard_idx(size (mask)), source = 0)
	+ allocate (pythia_idx(size (particle)), source = 0)
	+ i_whizard = 0;
	+ if (recover_beams) then
	+ skip_beams = 0
	+ else
	+ skip_beams = 2
	+ end if
	+ ADD_PARTICLE: do i_pythia = 1 + skip_beams, size(mask)
	+ idx = -1
	+ c_prt = pythia%get_single_event (i_pythia)
	+ ! Check on exisiting particle entry
	+ if (.not. mask(i_pythia)) then
	+ ! Retrieve particle from original particle_set
	+ whizard_idx(i_pythia) = reverse_find_particle (c_prt, particle_set)
	+ idx = reverse_find_particle (c_prt, particle_set)
	+ ! Skip entry completely
	+ if (idx > 0) then
	+ i_whizard = i_whizard + 1
	+ particle(i_whizard) = particle_set%get_particle (idx)
	+ whizard_idx(i_pythia) = i_whizard
	+ pythia_idx(i_whizard) = i_pythia
	+ if (debug2_active (D_SHOWER)) then
	+ print *, "Reverse search for particle ", i_pythia, " with PDG: ", c_prt%id
	+ print *, "Momentum: ", c_prt%momentum
	+ print *, "Found: ", whizard_idx(i_pythia)
	+ end if
	+ cycle ADD_PARTICLE
	+ end if
	+ ! Fallthrough: We could not retrieve the particle from our set, retrieve it from PYTHIA8.
	+ end if
	+ ! idx is exactly zero iff the reverse particle search failed.
	+ if (mask(i_pythia) .or. idx == 0) then
	+ i_whizard = i_whizard + 1
	+ call get_particle_status (i_pythia, c_prt, particle(i_whizard))
	+ call fill_particle (model, model_fallback, helicity, c_prt, particle(i_whizard))
	+ ! call get_particle_color (i_color, dangling_color, c_prt%status, particle(i_whizard))
	+ call get_particle_vertex (i_pythia, particle(i_whizard))
	+ whizard_idx(i_pythia) = i_whizard
	+ pythia_idx(i_whizard) = i_pythia
	+ end if
	+ if (debug2_active (D_SHOWER)) then
	+ print *, "Shower: ", mask(i_pythia)
	+ print *, "i_pythia: ", i_pythia, " → i_whizard: ", whizard_idx(i_pythia)
	+ end if
	+ end do ADD_PARTICLE
	+ contains
	+ subroutine get_particle_status (i_pythia, c_particle, particle)
	+ integer, intent(in) :: i_pythia
	+ type(lha_particle_t), intent(in) :: c_particle
	+ type(particle_t), intent(inout) :: particle
	+ integer :: whizard_status
	+ select case (pythia8_get_status_hepmc &
	+ (pythia%cptr, int(i_pythia, c_int)))
	+ case(1); whizard_status = (PRT_OUTGOING)
	+ case(2); whizard_status = (PRT_RESONANT)
	+ case(4); whizard_status = (PRT_BEAM)
	+ case default;
	+ if (c_particle%status < 0) &
	+ whizard_status = PRT_VIRTUAL
	+ end select
	+ if (debug2_active (D_SHOWER) .or. debug2_active (D_TRANSFORMS)) then
	+ write (*, "(1X,A,1X,I0)") "Particle's status code:", i_pythia
	+ write (*, "(1X,3(A,1X,I0,1X))") "HEPMC:", pythia8_get_status_hepmc (pythia%cptr, int(i_pythia, c_int)), &
	+ "PYTHIA:", c_particle%status, &
	+ "WHIZARD:", whizard_status
	+ end if
	+ call particle%set_status (whizard_status)
	+ end subroutine get_particle_status
	+
	+ subroutine fill_particle &
	+ (model_in, model_fallback, polarization, c_prt, prt)
	+ type(lha_particle_t), intent(in) :: c_prt
	+ class(model_data_t), intent(in), target :: model_in, model_fallback
	+ type(particle_t), intent(inout) :: prt
	+ integer, intent(in) :: polarization
	+ integer :: whizard_status, hmax
	+ class(model_data_t), pointer :: model
	+ type(flavor_t) :: flv
	+ type(color_t) :: color
	+ type(helicity_t) :: hel
	+ type(vector4_t) :: p
	+ integer :: col, acol
	+ call find_model (model, c_prt%id, model_in, model_fallback)
	+ call flv%init (c_prt%id, model)
	+ col = max (c_prt%color(1), 0)
	+ acol = max (c_prt%color(2), 0)
	+ call color%init_col_acl (col, acol)
	+ if (flv%is_beam_remnant ()) &
	+ call prt%set_status (PRT_BEAM_REMNANT)
	+ call prt%set_flavor (flv); call prt%set_color (color)
	+ p = real (c_prt%momentum, kind=default)
	+ call prt%set_momentum (p, real (c_prt%mass**2, default))
	+ select case (polarization)
	+ case (PRT_DEFINITE_HELICITY)
	+ if (abs (c_prt%spin) <= 1.) then
	+ hmax = flv%get_spin_type () / 2.
	+ call hel%init (sign (hmax, nint (c_prt%spin)))
	+ call prt%set_helicity (hel)
	+ end if
	+ case (PRT_GENERIC_POLARIZATION)
	+ call msg_fatal ("[whizard_pythia8_get_particle_set]" // &
	+ "generic polarization with Pythia8 not defined.")
	+ case (PRT_UNPOLARIZED)
	+ case default
	+ call msg_bug ("[whizard_pythia8_get_particle]" // &
	+ "Helicity handling is undefined.")
	+ end select
	+ if (.not. vanishes (real (c_prt%tau, kind=default))) &
	+ call prt%set_lifetime (real (c_prt%tau, kind=default))
	+ end subroutine fill_particle
	+
	+ subroutine get_particle_vertex (i_pythia, particle)
	+ integer, intent(in) :: i_pythia
	+ type(particle_t), intent(inout) :: particle
	+ real(c_double) :: time
	+ real(c_double), dimension(3) :: vertex
	+ type(vector4_t) :: vtx4
	+ call pythia8_get_decay_vertex (pythia%cptr, i_pythia, time, vertex)
	+ vtx4 = vector4_moving (real (time, kind=default), &
	+ vector3_moving (real (vertex, kind=default)))
	+ if (vtx4 /= vector4_null) call particle%set_vertex (vtx4)
	+ end subroutine get_particle_vertex
	+ end subroutine pythia8_import_pythia_particles
	+
	+@ %def pythia8_import_pythia_particles
	+@ Check on beam particle.
	+<<pythia8: pythia8: TBP>>=
	+ procedure, private :: is_beam_particle => pythia8_is_beam_particle
	+<<pythia8: procedures>>=
	+ function pythia8_is_beam_particle (pythia, i_pythia) result (flag)
	+ class(pythia8_t), intent(in) :: pythia
	+ integer, intent(in) :: i_pythia
	+ logical :: flag
	+ integer(c_int) :: c_i_pythia
	+ integer, parameter :: HEPMC_BEAM_PRT = 4
	+ c_i_pythia = int(i_pythia, c_int)
	+ flag = HEPMC_BEAM_PRT == pythia8_get_status_hepmc (pythia%cptr, c_i_pythia)
	+ end function pythia8_is_beam_particle
	+
	+@ %pythia8_is_beam_particle
	+@ Get parent child relation from [[PYTHIA8]].
	+
	+Apply the parent child relations from [[PYTHIA8]] to previously filled particle set.
	+<<pythia8: pythia8: TBP>>=
	+ procedure, private :: get_parent_child_relation => pythia8_get_parent_child_relation
	+<<pythia8: procedures>>=
	+ subroutine pythia8_get_parent_child_relation (&
	+ pythia, pythia_idx, whizard_idx, particle_set, recover_beams)
	+ class(pythia8_t), intent(in) :: pythia
	+ integer, dimension(:), intent(in) :: pythia_idx, whizard_idx
	+ type(particle_set_t), intent(inout) :: particle_set
	+ logical, intent(in) :: recover_beams
	+ integer(c_int) :: c_n_parents, c_n_children, c_i_pythia
	+ integer, dimension(:), allocatable :: parent, child
	+ integer :: i_pythia, i, skip_beams
	+ call msg_debug (D_SHOWER, "pythia8_get_parent_child_relation")
	+ skip_beams = 0; if (recover_beams) skip_beams = 2
	+ do i_pythia = 1 + skip_beams, size(whizard_idx)
	+ if (whizard_idx(i_pythia) == 0) cycle
	+ c_i_pythia = int(i_pythia, c_int)
	+ c_n_parents = pythia8_get_n_mothers (pythia%cptr, c_i_pythia)
	+ c_n_children = pythia8_get_n_daughters (pythia%cptr, c_i_pythia)
	+ allocate (parent(c_n_parents), child(c_n_children))
	+ parent = 0; child = 0
	+ if (c_n_parents > 0) then
	+ call pythia8_get_mother_array (pythia%cptr, c_i_pythia, c_n_parents, parent)
	+ if (count (parent > 0) > 0) then
	+ if (debug2_active (D_SHOWER) .or. debug2_active (D_TRANSFORMS)) then
	+ write (*, "(1X,A,1X,I0)") "Particle's parents ", whizard_idx(i_pythia)
	+ do i = 1, c_n_parents
	+ if (parent(i) > 0) &
	+ write (*, "(1X,I0,1X,'(',I0,')',1X)", advance="no") parent(i), whizard_idx(parent(i))
	+ end do
	+ write (, )
	+ end if
	+ call particle_set%prt(whizard_idx(i_pythia))%set_parents (&
	+ whizard_idx(pack(parent, parent > 0)))
	+ end if
	+ end if
	+ if (c_n_children > 0) then
	+ call pythia8_get_daughter_array (pythia%cptr, c_i_pythia, c_n_children, child)
	+ if (count (child > 0) > 0) then
	+ if (debug2_active (D_SHOWER) .or. debug2_active (D_TRANSFORMS)) then
	+ write (*, "(1X,A,1X,I0)") "Particle's children ", whizard_idx(i_pythia)
	+ do i = 1, c_n_children
	+ if (child(i) > 0) &
	+ write (*, "(1X,I0,1X,'(',I0,')',1X)", advance="no") child(i), whizard_idx(child(i))
	+ end do
	+ write (, )
	+ end if
	+ call particle_set%prt(whizard_idx(i_pythia))%set_children (&
	+ whizard_idx(pack (child, child > 0)))
	+ end if
	+ end if
	+ deallocate (parent, child)
	+ end do
	+ end subroutine pythia8_get_parent_child_relation
	+
	+@ %def pythia8_get_parent_child_relation
	+@
	+\subsection{Unit tests}
	+\label{sec:whizard-lha-ut}
	+
	+Test module, followed by the corresponding implementation module.
	+
	+<<[[pythia8_ut.f90]]>>=
	+<<File header>>
	+
	+module pythia8_ut
	+ use unit_tests
	+ use pythia8_uti
	+
	+<<Standard module head>>
	+
	+<<pythia8: public test>>
	+
	+contains
	+<<pythia8: test driver>>
	+end module pythia8_ut
	+@ %def pythia8_ut
	+@
	+<<[[pythia8_uti.f90]]>>=
	+<<File header>>
	+
	+module pythia8_uti
	+<<Use kinds>>
	+ use io_units
	+ use iso_varying_string, string_t => varying_string
	+ use model_data, only: model_data_t
	+ use particles, only: particle_t, PRT_DEFINITE_HELICITY, PRT_GENERIC_POLARIZATION
	+ use rng_base, only: rng_t
	+ use rng_stream, only: rng_stream_t
	+ use whizard_lha
	+ use pythia8
	+
	+<<Standard module head>>
	+
	+<<pythia8: test declaration>>
	+
	+contains
	+<<pythia8: tests>>
	+end module pythia8_uti
	+@ %def pythia8_uti
	+@ API: driver for the unit tests below.
	+<<pythia8: public test>>=
	+ public :: pythia8_test
	+<<pythia8: test driver>>=
	+ subroutine pythia8_test (u, results)
	+ integer, intent(in) :: u
	+ type(test_results_t), intent(inout) :: results
	+ <<pythia8: execute tests>>
	+ end subroutine pythia8_test
	+
	+@ %def pythia8_test
	+@
	+\subsubsection{Setup Pythia8}
	+<<pythia8: execute tests>>=
	+ call test (pythia8_1, "pythia8_1", "Construct and destruct Pythia8 object", u, results)
	+<<pythia8: test declaration>>=
	+ public :: pythia8_1
	+<<pythia8: tests>>=
	+ subroutine pythia8_1 (u)
	+ integer, intent(in) :: u
	+ type(pythia8_t) :: pythia
	+ type(whizard_lha_t) :: lha
	+
	+ write (u, "(A)") "* Test output: pythia8_1"
	+ write (u, "(A)") "* Purpose: Construct and destruct a Pythia8 object."
	+ write (u, "(A)")
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Construct Pythia8 object."
	+ write (u, "(A)")
	+
	+ call pythia%init ()
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Destruct Pythia8 object."
	+ write (u, "(A)")
	+
	+ call pythia%final ()
	+ end subroutine pythia8_1
	+
	+@ %def pythia8_1
	+@
	+<<pythia8: execute tests>>=
	+ call test (pythia8_2, "pythia8_2", "Initialize Pythia8 with a LHA User Process object.", u, results)
	+<<pythia8: test declaration>>=
	+ public :: pythia8_2
	+<<pythia8: tests>>=
	+ subroutine pythia8_2 (u)
	+ integer, intent(in) :: u
	+ type(pythia8_t) :: pythia
	+ type(whizard_lha_t) :: lha
	+ integer :: i
	+ integer, parameter :: N_PROC = 5
	+ real(default), dimension(N_PROC) :: xsec, xerror, max_weight
	+
	+ write (u, "(A)") "* Test output: pythia8_2"
	+ write (u, "(A)") &
	+ "* Purpose: Initialize Pythia8 with a LHA User Process object.."
	+ write (u, "(A)")
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Construct Pythia8 object."
	+ write (u, "(A)")
	+ call pythia%init ()
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Read string 'Beam:frameType = 5' into " // &
	+ "Pythia8 allowing for LHA user processes."
	+ write (u, "(A)")
	+
	+ call pythia%read_string (var_str ("Beams:frameType = 5"))
	+ call pythia%read_string (var_str ("Random:setSeed = on"))
	+ call pythia%read_string (var_str ("Random:seed = 1234"))
	+
	+ write (u, "(A)")
	+ write (u, "(A)") &
	+ "* Setup LHA User Process object and let Pythia8 point to it."
	+ write (u, "(A)")
	+
	+ call lha%init ()
	+ call lha%set_init &
	+ ([2212, 2212], [6500._default, 6500._default], 1, .true., .true.)
	+
	+ xsec = [1.0, 1.2, 1.4, 1.6, 1.8] * 1e3 ! fb
	+ xerror = 0.05 * xsec
	+ max_weight = 1e-3 * xsec
	+ do i = 1, N_PROC
	+ call lha%set_process_parameters (process_id = i, &
	+ cross_section = xsec(i), error = xerror(i), &
	+ max_weight = max_weight(i))
	+ end do
	+ call pythia%set_lhaup_ptr (lha)
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Initialize Pythia8."
	+ write (u, "(A)")
	+
	+ call pythia%init_pythia ()
	+
	+ write (u, "(A)")
	+ write (u, "(A)") "* Destruct Pythia8 object."
	+ write (u, "(A)")
	+
	+ call pythia%final ()
	+ end subroutine pythia8_2
	+
	+@ %def pythia8_2
	+@
	Index: trunk/src/pythia8/LHAWhizard.cpp
	===================================================================
	--- trunk/src/pythia8/LHAWhizard.cpp (revision 0)
	+++ trunk/src/pythia8/LHAWhizard.cpp (revision 8190)
	@@ -0,0 +1,57 @@
	+// Function definitions (not found in the header) for the LHAupWhizard class.
	+
	+#include "LHAWhizard.h"
	+
	+namespace Pythia8 {
	+ bool LHAupWhizard::setInit (const int beam_pdg[2], const double beam_energy[2], const int n_processes, const bool unweighted, bool negative_weights) {
	+ /* WHIZARD provides the full hadronic matrix element. Hence, we reset the PDF convolution from Pythia8. */
	+ // We support only unweighted events with unit weight (correspond to strategy 3) and weighted events with weight in pb.
	+ // As we are only supporting strategy 3 or 4, Pythia8 handles all processes commonly, no need to provide a meaningfull n_processes.
	+ // We take care about the unit convention as WHIZARD uses fb.
	+ int strategy = (unweighted) ? 3 : 4;
	+ if (negative_weights) strategy *= -1;
	+ setBeamA(beam_pdg[0], beam_energy[0], -1, -1);
	+ setBeamB(beam_pdg[1], beam_energy[1], -1, -1);
	+ setStrategy(strategy);
	+ return true;
	+ }
	+
	+ /* Fill the characteristics for a particular process.
	+ WHIZARD only supports strategy 3 and 4.
	+ */
	+ bool LHAupWhizard::setProcessParameters(const int idProcess, const double cross_section, const double error, const double max_weight) {
	+ // Althought we accept a process id, Pythia internally discards the number.
	+ // The only accpeted trategies 3 or 4 (unweighted or weighted events) don't care about the process specifics and handle all events commonly.
	+ int max_weight_ = 0;
	+ if (abs(strategy ()) == 3) {
	+ max_weight_ = 1;
	+ } else if (abs(strategy () == 4)) {
	+ max_weight_ = max_weight;
	+ }
	+ addProcess(idProcess, cross_section, error, max_weight_);
	+ return true;
	+ }
	+
	+ void LHAupWhizard::setEventProcess(const int idProcess, const double scale, const double alpha_qcd, const double alpha_qed, const double weight) {
	+ setProcess (idProcess, weight, scale, alpha_qed, alpha_qcd);
	+ }
	+
	+ bool LHAupWhizard::setEvent(const int idProcess, const int n_particles, const lha_particle_t particle_set[]) {
	+ for (int ip = 0; ip < n_particles; ++ip) {
	+ addParticle(particle_set[ip].idPart, particle_set[ip].statusPart,
	+ particle_set[ip].motherPart[0], particle_set[ip].motherPart[1],
	+ particle_set[ip].colorPart[0], particle_set[ip].colorPart[1],
	+ particle_set[ip].pPart[1], particle_set[ip].pPart[2], particle_set[ip].pPart[3], particle_set[ip].pPart[0],
	+ particle_set[ip].mPart, particle_set[ip].tauPart, particle_set[ip].spinPart, -1.);
	+ }
	+
	+ int id1 = id(1); int id2 = id(2);
	+ double x1 = (eBeamA() > 0.) ? e(1) / eBeamA() : 0.;
	+ double x2 = (eBeamB() > 0.) ? e(2) / eBeamB() : 0.;
	+ setIdX (id1, id2, x1, x2);
	+ // TODO sbrass What happens if we have pp beams?
	+ // Set id and x values even when not supplied.
	+ setPdf (id1, id2, x1, x2, 0., 0., 0., 0.);
	+ return true;
	+ }
	+}
	Index: trunk/src/pythia8/Pythia8Wrap.cpp
	===================================================================
	--- trunk/src/pythia8/Pythia8Wrap.cpp (revision 8189)
	+++ trunk/src/pythia8/Pythia8Wrap.cpp (revision 8190)
	@@ -1,13 +1,145 @@
	-#include "Pythia8/Pythia.h"
	-#include <iostream>
	+#include "Pythia8Wrap.h"

	using namespace Pythia8;

	+// Define external C-function.
	+
	extern "C" {

	- // Tell the caller that this is the true Fastjet library
	- bool pythia8_available() {
	+ bool pythia8_available () {
	return true;
	}

	+ Pythia* new_pythia8 (bool printBanner = true) {
	+ Pythia* pythia = new Pythia ("", printBanner);
	+ return pythia;
	+ }
	+
	+ void pythia8_delete (Pythia* pythia) {
	+ delete pythia;
	+ }
	+
	+ bool pythia8_set_lhaup_ptr (Pythia* pythia, LHAupWhizard* whizard_lha) {
	+ return pythia->setLHAupPtr (whizard_lha);
	+ }
	+
	+ bool pythia8_set_rndm_engine_ptr (Pythia* pythia, void* rndm) {
	+ WhizardRndm* whizard_rndm = new WhizardRndm (rndm);
	+ return pythia->setRndmEnginePtr (whizard_rndm);
	+ }
	+
	+ bool pythia8_read_string (Pythia* pythia, const char* str) {
	+ return pythia->readString (string (str));
	+ }
	+
	+ bool pythia8_read_file (Pythia* pythia, const char* filename, const int subrun) {
	+ return pythia->readFile (string (filename), subrun);
	+ }
	+
	+ bool pythia8_init (Pythia* pythia) {
	+ return pythia->init ();
	+ }
	+
	+ bool pythia8_next (Pythia* pythia) {
	+ return pythia->next ();
	+ }
	+
	+ int pythia8_get_event_size (Pythia* pythia) {
	+ return pythia->event.size ();
	+ }
	+
	+ lha_particle_t pythia8_get_single_event (Pythia* pythia, const int i) {
	+ Particle event = pythia->event[i];
	+ lha_particle_t lha_event;
	+ lha_event.idPart = event.id();
	+ lha_event.statusPart = event.status();
	+ lha_event.motherPart[0] = event.mother1();
	+ lha_event.motherPart[1] = event.mother2();
	+ lha_event.colorPart[0] = event.col();
	+ lha_event.colorPart[1] = event.acol();
	+ lha_event.pPart[0] = event.e();
	+ lha_event.pPart[1] = event.px();
	+ lha_event.pPart[2] = event.py();
	+ lha_event.pPart[3] = event.pz();
	+ lha_event.mPart = event.m();
	+ lha_event.tauPart = event.tau();
	+ lha_event.spinPart = event.pol();
	+ // TODO sbrass Implement scale of parton
	+ return lha_event;
	+ }
	+
	+ int pythia8_get_particle_status (Pythia* pythia, const int i) {
	+ return pythia->event[i].status();
	+ }
	+
	+ int pythia8_get_particle_id (Pythia* pythia, const int i) {
	+ return pythia->event[i].id();
	+ }
	+
	+ void pythia8_get_particle_momentum (Pythia* pythia, const int i, double* p) {
	+ // TODO sbrass implement a check on size of p
	+ Particle event = pythia->event[i];
	+ p[0] = event.e();
	+ p[1] = event.px();
	+ p[2] = event.py();
	+ p[3] = event.pz();
	+ }
	+
	+ int pythia8_get_n_mothers (Pythia* pythia, const int i) {
	+ vector<int> motherList = pythia->event[i].motherList ();
	+ return motherList.size ();
	+ }
	+
	+ int pythia8_get_n_daughters (Pythia* pythia, const int i) {
	+ vector<int> daughterList = pythia->event[i].daughterList ();
	+ return daughterList.size ();
	+ }
	+
	+ void pythia8_get_mother_array (Pythia* pythia, const int i, const int n_mothers, int mother[]) {
	+ vector<int> motherList = pythia->event[i].motherList ();
	+ if (std::size_t (n_mothers) != motherList.size ()) {
	+ std::cerr << "[pythia8_get_mother_array] mismatch in array size." << endl;
	+ exit(2);
	+ }
	+ std::copy (motherList.begin (), motherList.end (), mother);
	+ }
	+
	+ void pythia8_get_daughter_array (Pythia* pythia, const int i, const int n_daughters, int* daughter) {
	+ vector<int> daughterList = pythia->event[i].daughterList ();
	+ if (std::size_t (n_daughters) != daughterList.size ()) {
	+ std::cerr << "[pythia8_get_mother_array] mismatch in array size." << endl;
	+ exit(2);
	+ }
	+ std::copy (daughterList.begin (), daughterList.end (), daughter);
	+ }
	+
	+ int pythia8_get_status_hepmc (Pythia* pythia, const int i) {
	+ return pythia->event[i].statusHepMC();
	+ }
	+
	+ void pythia8_get_decay_vertex (Pythia* pythia, const int i, double* time, double space_vertex[3]) {
	+ *time = pythia->event[i].tDec();
	+ space_vertex[0] = pythia->event[i].xDec();
	+ space_vertex[1] = pythia->event[i].yDec();
	+ space_vertex[2] = pythia->event[i].zDec();
	+ }
	+
	+ void pythia8_get_event_info (Pythia* pythia, double* alpha_s, double* alpha_em, double* scale) {
	+ *alpha_s = pythia->info.alphaS();
	+ *alpha_em = pythia->info.alphaEM();
	+ *scale = pythia->info.scalup();
	+ // See: http://home.thep.lu.se/~torbjorn/pythia82html/EventInformation.html
	+ }
	+
	+ // Debug Output
	+ void pythia8_list_lha_event (Pythia* pythia) {
	+ pythia->LHAeventList ();
	+ }
	+
	+ void pythia8_list_event (Pythia* pythia) {
	+ pythia->event.list ();
	+ }
	+
	}
	+
	+
	Index: trunk/src/pythia8/LHAWhizard.h
	===================================================================
	--- trunk/src/pythia8/LHAWhizard.h (revision 0)
	+++ trunk/src/pythia8/LHAWhizard.h (revision 8190)
	@@ -0,0 +1,45 @@
	+/* LHAWHIZARD.h
	+
	+ Copyright Notice of WHIZARD
	+
	+ Author: Simon Braß, May 2018
	+*/
	+
	+#ifndef Pythia8_LHAWhizard_H
	+#define Pythia8_LHAWhizard_H
	+
	+#include "Pythia8/Pythia.h"
	+#include "LHAWhizard_events.h"
	+#include <iostream>
	+
	+namespace Pythia8 {
	+ /* A derived class from LHAupWhizard which retrieves an event from WHIZARD.
	+
	+ We provide an interface to WHIZARD to Pythia.
	+ */
	+ class LHAupWhizard : public LHAup {
	+
	+ public:
	+
	+ ~LHAupWhizard () {}
	+
	+ /* Define the basic setInit and overload it. */
	+ bool setInit () {return true;}
	+ bool setInit (const int beam_pdg[2], const double beam_energy[2], const int n_processes, const bool unweighted, bool negative_weights);
	+ bool setProcessParameters (const int idProcess, const double cross_section, const double error, const double max_weight);
	+ bool setEvent (int idProcess) {return true;}
	+ void setEventProcess (const int idProcess, const double scale, const double qlpha_qcd, const double alpha_qed, const double weight);
	+ bool setEvent (const int idProcess, const int n_particles, const lha_particle_t particle_set[]);
	+
	+ /* We use events provided directly by a Fortran-to-C++ interfeace from WHIZARD and do not need to read events from file. */
	+ bool fileFound () {return true;}
	+ bool useExternal () {return true;}
	+
	+ /* We do not need the member functions introduced for LHEF. Just ignoring them. */
	+ void newEventFile (const char*) {}
	+ bool skipEvent(int nSkip) {return true;}
	+ bool openLHEF (string filenameIn) {return false;}
	+ bool closeLHEF (bool updateInit = false) {return false;}
	+ };
	+}
	+#endif
	Index: trunk/src/pythia8/LHAWhizard_dummy.f90
	===================================================================
	--- trunk/src/pythia8/LHAWhizard_dummy.f90 (revision 0)
	+++ trunk/src/pythia8/LHAWhizard_dummy.f90 (revision 8190)
	@@ -0,0 +1,91 @@
	+function new_whizard_lha () bind(C) result (whizard_lha)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr) :: whizard_lha
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* LHAupWhizard: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function new_whizard_lha
	+
	+subroutine lhaup_whizard_delete (cptr) bind(C)
	+ use iso_c_binding !NODEP!
	+ ! Attribute value cannot have intent(inout).
	+ type(c_ptr), value :: cptr
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* LHAupWhizard: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end subroutine lhaup_whizard_delete
	+
	+
	+function lhaup_whizard_set_init (cptr, beam_pdg, beam_energy, n_processes, unweighted, negative_weights) bind(C) result (flag)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ integer(c_int), dimension(2), intent(in) :: beam_pdg
	+ real(c_double), dimension(2), intent(in) :: beam_energy
	+ integer(c_int), intent(in), value :: n_processes
	+ logical(c_bool), intent(in), value :: unweighted, negative_weights
	+ logical(c_bool) :: flag
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* LHAupWhizard: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function lhaup_whizard_set_init
	+
	+function lhaup_whizard_set_process_parameters (cptr, process_id, cross_section, error, max_weight) bind(C) result (flag)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ integer(c_int), intent(in), value :: process_id
	+ real(c_double), intent(in), value :: cross_section, error, max_weight
	+ logical(c_bool) :: flag
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* LHAupWhizard: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function lhaup_whizard_set_process_parameters
	+
	+subroutine lhaup_whizard_list_init (cptr) bind(C)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* LHAupWhizard: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end subroutine lhaup_whizard_list_init
	+
	+subroutine lhaup_whizard_list_event (cptr) bind(C)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* LHAupWhizard: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end subroutine lhaup_whizard_list_event
	+
	+subroutine lhaup_whizard_set_event_process &
	+ (cptr, process_id, scale, alpha_qcd, alpha_qed, weight) bind(C)
	+ use iso_c_binding !NODEP!
	+ type(c_ptr), value :: cptr
	+ integer(c_int), intent(in), value :: process_id
	+ real(c_double), intent(in), value :: scale, alpha_qcd, alpha_qed, weight
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* LHAupWhizard: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end subroutine lhaup_whizard_set_event_process
	+
	+
	+function lhaup_whizard_set_event (cptr, process_id, n_particles, particle_set) bind(C) result (flag)
	+ use iso_c_binding !NODEP!
	+ use whizard_lha, only: lha_particle_t
	+ type(c_ptr), value :: cptr
	+ integer(c_int), intent(in), value :: process_id
	+ integer(c_int), intent(in), value :: n_particles
	+ ! IMPORTANT NOTE: Assumed-size array has to be defined by *.
	+ type(lha_particle_t), dimension(*), intent(in) :: particle_set
	+ logical(c_bool) :: flag
	+ write (0, "(A)") "**************************************************************"
	+ write (0, "(A)") "* LHAupWhizard: Error: library not linked, WHIZARD terminates *"
	+ write (0, "(A)") "**************************************************************"
	+ stop
	+end function lhaup_whizard_set_event
	Index: trunk/src/pythia8/Pythia8Wrap.h
	===================================================================
	--- trunk/src/pythia8/Pythia8Wrap.h (revision 0)
	+++ trunk/src/pythia8/Pythia8Wrap.h (revision 8190)
	@@ -0,0 +1,41 @@
	+/* Pythia8Wrap.h
	+
	+ Copyright Notice of WHIZARD
	+
	+ Author: Simon Braß, Octobre 2018
	+
	+ */
	+
	+#ifndef Pythia8_Wrap_H
	+#define Pythia8_Wrap_H
	+#include "Pythia8/Pythia.h"
	+#include "LHAWhizard_events.h"
	+#include "LHAWhizard.h"
	+
	+extern "C" {
	+ double whizard_rndm_generate (void* rndm);
	+}
	+
	+namespace Pythia8 {
	+
	+ // --------------------------------------------------
	+ // Random Engine
	+ //
	+ // Import pointer.
	+
	+ class WhizardRndm : public RndmEngine {
	+
	+ public:
	+
	+ WhizardRndm (void* rndmIn) { rndm = rndmIn; }
	+
	+ ~WhizardRndm () {};
	+
	+ double flat () { return whizard_rndm_generate (rndm); }
	+
	+ private:
	+ // (void) pointer to a Fortran object
	+ void* rndm;
	+ };
	+}
	+#endif
	Index: trunk/src/pythia8/LHAWhizard_events.h
	===================================================================
	--- trunk/src/pythia8/LHAWhizard_events.h (revision 0)
	+++ trunk/src/pythia8/LHAWhizard_events.h (revision 8190)
	@@ -0,0 +1,14 @@
	+#ifndef LHAWhizard_Events_H
	+#define LHAWhizard_Events_H
	+
	+extern "C" {
	+ typedef struct {
	+ int idPart, statusPart;
	+ int motherPart[2];
	+ int colorPart[2];
	+ double pPart[4];
	+ double mPart, tauPart, spinPart;
	+ } lha_particle_t;
	+}
	+
	+#endif
	Index: trunk/src/matching/matching.nw
	===================================================================
	--- trunk/src/matching/matching.nw (revision 8189)
	+++ trunk/src/matching/matching.nw (revision 8190)
	@@ -1,4048 +1,4049 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: Matching and Merging
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Matching}
	\includemodulegraph{matching}

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

	module matching_base

	<<Use strings>>
	use diagnostics
	use sm_qcd
	use model_data
	use particles
	use variables
	use shower_base
	use instances, only: process_instance_t
	use rng_base

	<<Standard module head>>

	<<Matching base: public>>

	<<Matching base: parameters>>

	<<Matching base: types>>

	<<Matching base: interfaces>>

	contains

	<<Matching base: procedures>>

	end module matching_base
	@ %def matching_base
	@
	\section{Abstract Matching Type}
	A matching will need access to the [[shower]] as well as matrix elements
	that we currently get over [[process_instace]]. The [[model]] is
	intended for the backup [[model_hadrons]].
	<<Matching base: public>>=
	public :: matching_t
	<<Matching base: types>>=
	type, abstract :: matching_t
	logical :: is_hadron_collision = .false.
	type(qcd_t), pointer :: qcd => null ()
	class(shower_base_t), pointer :: shower => null ()
	type(process_instance_t), pointer :: process_instance => null ()
	class(model_data_t), pointer :: model => null ()
	class(rng_t), allocatable :: rng
	type(string_t) :: process_name
	contains
	<<Matching base: matching: TBP>>
	end type matching_t

	@ %def matching_t
	@
	<<Matching base: matching: TBP>>=
	procedure (matching_init), deferred :: init
	<<Matching base: interfaces>>=
	abstract interface
	subroutine matching_init (matching, var_list, process_name)
	import
	class(matching_t), intent(out) :: matching
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_name
	end subroutine matching_init
	end interface

	@ %def matching_init
	@ If we use a polymorphic settings type, this boilerplate wouldn't be
	necessary but then we introduce [[select type]] statements all over the place.
	<<default matching init>>=
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_name
	call msg_debug (D_MATCHING, "matching_init")
	call matching%settings%init (var_list)
	matching%process_name = process_name
	@
	<<Matching base: matching: TBP>>=
	procedure (matching_write), deferred :: write
	<<Matching base: interfaces>>=
	abstract interface
	subroutine matching_write (matching, unit)
	import
	class(matching_t), intent(in) :: matching
	integer, intent(in), optional :: unit
	end subroutine matching_write
	end interface

	@ %def matching_write
	@
	<<Matching base: matching: TBP>>=
	procedure :: import_rng => matching_import_rng
	<<Matching base: procedures>>=
	pure subroutine matching_import_rng (matching, rng)
	class(matching_t), intent(inout) :: matching
	class(rng_t), allocatable, intent(inout) :: rng
	call move_alloc (from = rng, to = matching%rng)
	end subroutine matching_import_rng

	@ %def matching_import_rng
	@
	<<Matching base: matching: TBP>>=
	procedure :: connect => matching_connect
	procedure :: base_connect => matching_connect
	<<Matching base: procedures>>=
	subroutine matching_connect (matching, process_instance, model, shower)
	class(matching_t), intent(inout) :: matching
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target, optional :: model
	class(shower_base_t), intent(in), target, optional :: shower
	call msg_debug (D_MATCHING, "matching_connect")
	matching%process_instance => process_instance
	if (present (model)) matching%model => model
	if (present (shower)) matching%shower => shower
	end subroutine matching_connect

	@ %def matching_base_connect
	@
	<<Matching base: matching: TBP>>=
	procedure (matching_before_shower), deferred :: before_shower
	<<Matching base: interfaces>>=
	abstract interface
	subroutine matching_before_shower (matching, particle_set, vetoed)
	import
	class(matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	end subroutine matching_before_shower
	end interface

	@ %def matching_before_shower
	@
	<<Matching base: matching: TBP>>=
	procedure (matching_after_shower), deferred :: after_shower
	<<Matching base: interfaces>>=
	abstract interface
	subroutine matching_after_shower (matching, particle_set, vetoed)
	import
	class(matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	end subroutine matching_after_shower
	end interface

	@ %def matching_after_shower
	@ Per default, do nothing here.
	<<Matching base: matching: TBP>>=
	procedure :: prepare_for_events => matching_prepare_for_events
	<<Matching base: procedures>>=
	subroutine matching_prepare_for_events (matching)
	class(matching_t), intent(inout), target :: matching
	end subroutine matching_prepare_for_events

	@ %def matching_prepare_for_events
	@
	<<Matching base: matching: TBP>>=
	procedure :: first_event => matching_first_event
	<<Matching base: procedures>>=
	subroutine matching_first_event (matching)
	class(matching_t), intent(inout), target :: matching
	end subroutine matching_first_event

	@ %def matching_first_event
	@
	<<Matching base: matching: TBP>>=
	procedure (matching_get_method), deferred :: get_method
	<<Matching base: interfaces>>=
	abstract interface
	function matching_get_method (matching) result (method)
	import
	type(string_t) :: method
	class(matching_t), intent(in) :: matching
	end function matching_get_method
	end interface

	@ %def matching_after_shower
	@
	<<Matching base: matching: TBP>>=
	procedure :: final => matching_final
	<<Matching base: procedures>>=
	subroutine matching_final (matching)
	class(matching_t), intent(in) :: matching
	end subroutine matching_final

	@ %def matching_final
	@
	\subsection{Matching implementations}
	<<Matching base: public>>=
	public :: MATCH_MLM, MATCH_CKKW, MATCH_POWHEG
	<<Matching base: parameters>>=
	integer, parameter :: MATCH_MLM = 1
	integer, parameter :: MATCH_CKKW = 2
	integer, parameter :: MATCH_POWHEG = 3
	integer, parameter :: MATCH_UNDEFINED = 17
	@ %def MATCH_MLM MATCH_CKKW MATCH_POWHEG MATCH_UNDEFINED
	@ A dictionary
	<<Matching base: public>>=
	public :: matching_method
	<<Matching base: interfaces>>=
	interface matching_method
	module procedure matching_method_of_string
	module procedure matching_method_to_string
	end interface
	<<Matching base: procedures>>=
	elemental function matching_method_of_string (string) result (i)
	integer :: i
	type(string_t), intent(in) :: string
	select case (char (string))
	case ("MLM")
	i = MATCH_MLM
	case ("CKKW")
	i = MATCH_CKKW
	case ("POWHEG")
	i = MATCH_POWHEG
	case default
	i = MATCH_UNDEFINED
	end select
	end function matching_method_of_string

	elemental function matching_method_to_string (i) result (string)
	type(string_t) :: string
	integer, intent(in) :: i
	select case (i)
	case (MATCH_MLM)
	string = "MLM"
	case (MATCH_CKKW)
	string = "CKKW"
	case (MATCH_POWHEG)
	string = "POWHEG"
	case default
	string = "UNDEFINED"
	end select
	end function matching_method_to_string

	@ %def matching_method
	@
	\section{MLM Matching}
	<<[[mlm_matching.f90]]>>=
	<<File header>>

	module mlm_matching

	<<Use kinds with double>>
	<<Use strings>>
	use io_units
	use constants
	use format_utils, only: write_separator
	use diagnostics
	use file_utils
	use lorentz
	use subevents, only: PRT_OUTGOING
	use particles
	use variables
	use shower_base
	use ktclus
	use matching_base

	<<Standard module head>>

	<<MLM matching: public>>

	<<MLM matching: types>>

	contains

	<<MLM matching: procedures>>

	end module mlm_matching
	@ %def mlm_matching
	@
	<<MLM matching: public>>=
	public :: mlm_matching_settings_t
	<<MLM matching: types>>=
	type :: mlm_matching_settings_t
	real(default) :: mlm_Qcut_ME = one
	real(default) :: mlm_Qcut_PS = one
	real(default) :: mlm_ptmin, mlm_etamax, mlm_Rmin, mlm_Emin
	real(default) :: mlm_ETclusfactor = 0.2_default
	real(default) :: mlm_ETclusminE = five
	real(default) :: mlm_etaclusfactor = one
	real(default) :: mlm_Rclusfactor = one
	real(default) :: mlm_Eclusfactor = one
	integer :: kt_imode_hadronic = 4313
	integer :: kt_imode_leptonic = 1111
	integer :: mlm_nmaxMEjets = 0
	contains
	<<MLM matching: mlm matching settings: TBP>>
	end type mlm_matching_settings_t

	@ %def mlm_matching_settings_t
	@
	<<MLM matching: mlm matching settings: TBP>>=
	procedure :: init => mlm_matching_settings_init
	<<MLM matching: procedures>>=
	subroutine mlm_matching_settings_init (settings, var_list)
	class(mlm_matching_settings_t), intent(out) :: settings
	type(var_list_t), intent(in) :: var_list
	settings%mlm_Qcut_ME = &
	var_list%get_rval (var_str ("mlm_Qcut_ME"))
	settings%mlm_Qcut_PS = &
	var_list%get_rval (var_str ("mlm_Qcut_PS"))
	settings%mlm_ptmin = &
	var_list%get_rval (var_str ("mlm_ptmin"))
	settings%mlm_etamax = &
	var_list%get_rval (var_str ("mlm_etamax"))
	settings%mlm_Rmin = &
	var_list%get_rval (var_str ("mlm_Rmin"))
	settings%mlm_Emin = &
	var_list%get_rval (var_str ("mlm_Emin"))
	settings%mlm_nmaxMEjets = &
	var_list%get_ival (var_str ("mlm_nmaxMEjets"))

	settings%mlm_ETclusfactor = &
	var_list%get_rval (var_str ("mlm_ETclusfactor"))
	settings%mlm_ETclusminE = &
	var_list%get_rval (var_str ("mlm_ETclusminE"))
	settings%mlm_etaclusfactor = &
	var_list%get_rval (var_str ("mlm_etaclusfactor"))
	settings%mlm_Rclusfactor = &
	var_list%get_rval (var_str ("mlm_Rclusfactor"))
	settings%mlm_Eclusfactor = &
	var_list%get_rval (var_str ("mlm_Eclusfactor"))
	end subroutine mlm_matching_settings_init

	@ %def mlm_matching_settings_init
	@
	<<MLM matching: mlm matching settings: TBP>>=
	procedure :: write => mlm_matching_settings_write
	<<MLM matching: procedures>>=
	subroutine mlm_matching_settings_write (settings, unit)
	class(mlm_matching_settings_t), intent(in) :: settings
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(3x,A,ES19.12)") &
	"mlm_Qcut_ME = ", settings%mlm_Qcut_ME
	write (u, "(3x,A,ES19.12)") &
	"mlm_Qcut_PS = ", settings%mlm_Qcut_PS
	write (u, "(3x,A,ES19.12)") &
	"mlm_ptmin = ", settings%mlm_ptmin
	write (u, "(3x,A,ES19.12)") &
	"mlm_etamax = ", settings%mlm_etamax
	write (u, "(3x,A,ES19.12)") &
	"mlm_Rmin = ", settings%mlm_Rmin
	write (u, "(3x,A,ES19.12)") &
	"mlm_Emin = ", settings%mlm_Emin
	write (u, "(3x,A,1x,I0)") &
	"mlm_nmaxMEjets = ", settings%mlm_nmaxMEjets
	write (u, "(3x,A,ES19.12)") &
	"mlm_ETclusfactor (D=0.2) = ", settings%mlm_ETclusfactor
	write (u, "(3x,A,ES19.12)") &
	"mlm_ETclusminE (D=5.0) = ", settings%mlm_ETclusminE
	write (u, "(3x,A,ES19.12)") &
	"mlm_etaclusfactor (D=1.0) = ", settings%mlm_etaClusfactor
	write (u, "(3x,A,ES19.12)") &
	"mlm_Rclusfactor (D=1.0) = ", settings%mlm_RClusfactor
	write (u, "(3x,A,ES19.12)") &
	"mlm_Eclusfactor (D=1.0) = ", settings%mlm_EClusfactor
	end subroutine mlm_matching_settings_write

	@ %def mlm_matching_settings_write
	@ This is a container for the (colored) parton momenta as well as the
	jet momenta.
	<<MLM matching: public>>=
	public :: mlm_matching_t
	<<MLM matching: types>>=
	type, extends (matching_t) :: mlm_matching_t
	type(vector4_t), dimension(:), allocatable, public :: P_ME
	type(vector4_t), dimension(:), allocatable, public :: P_PS
	type(vector4_t), dimension(:), allocatable, private :: JETS_ME
	type(vector4_t), dimension(:), allocatable, private :: JETS_PS
	type(mlm_matching_settings_t) :: settings
	contains
	<<MLM matching: mlm matching: TBP>>
	end type mlm_matching_t

	@ %def mlm_matching_t
	@
	<<MLM matching: mlm matching: TBP>>=
	procedure :: init => mlm_matching_init
	<<MLM matching: procedures>>=
	subroutine mlm_matching_init (matching, var_list, process_name)
	class(mlm_matching_t), intent(out) :: matching
	<<default matching init>>
	end subroutine mlm_matching_init

	@ %def mlm_matching_init
	@
	<<MLM matching: mlm matching: TBP>>=
	procedure :: write => mlm_matching_write
	<<MLM matching: procedures>>=
	subroutine mlm_matching_write (matching, unit)
	class(mlm_matching_t), intent(in) :: matching
	integer, intent(in), optional :: unit
	integer :: i, u
	u = given_output_unit (unit); if (u < 0) return

	write (u, "(1x,A)") "MLM matching:"
	call matching%settings%write (u)
	write (u, "(3x,A)") "Momenta of ME partons:"
	if (allocated (matching%P_ME)) then
	do i = 1, size (matching%P_ME)
	write (u, "(4x)", advance = "no")
	call vector4_write (matching%P_ME(i), unit = u)
	end do
	else
	write (u, "(5x,A)") "[empty]"
	end if
	call write_separator (u)
	write (u, "(3x,A)") "Momenta of ME jets:"
	if (allocated (matching%JETS_ME)) then
	do i = 1, size (matching%JETS_ME)
	write (u, "(4x)", advance = "no")
	call vector4_write (matching%JETS_ME(i), unit = u)
	end do
	else
	write (u, "(5x,A)") "[empty]"
	end if
	call write_separator (u)
	write(u, "(3x,A)") "Momenta of shower partons:"
	if (allocated (matching%P_PS)) then
	do i = 1, size (matching%P_PS)
	write (u, "(4x)", advance = "no")
	call vector4_write (matching%P_PS(i), unit = u)
	end do
	else
	write (u, "(5x,A)") "[empty]"
	end if
	call write_separator (u)
	write (u, "(3x,A)") "Momenta of shower jets:"
	if (allocated (matching%JETS_PS)) then
	do i = 1, size (matching%JETS_PS)
	write (u, "(4x)", advance = "no")
	call vector4_write (matching%JETS_PS(i), unit = u)
	end do
	else
	write (u, "(5x,A)") "[empty]"
	end if
	call write_separator (u)
	end subroutine mlm_matching_write

	@ %def mlm_matching_write
	@
	<<MLM matching: mlm matching: TBP>>=
	procedure :: get_method => mlm_matching_get_method
	<<MLM matching: procedures>>=
	function mlm_matching_get_method (matching) result (method)
	type(string_t) :: method
	class(mlm_matching_t), intent(in) :: matching
	method = matching_method (MATCH_MLM)
	end function mlm_matching_get_method

	@ %def mlm_matching_get_method
	@
	<<MLM matching: mlm matching: TBP>>=
	procedure :: before_shower => mlm_matching_before_shower
	<<MLM matching: procedures>>=
	subroutine mlm_matching_before_shower &
	(matching, particle_set, vetoed)
	class(mlm_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	vetoed = .false.
	end subroutine mlm_matching_before_shower

	@ %def mlm_matching_before_shower
	@
	<<MLM matching: mlm matching: TBP>>=
	procedure :: after_shower => mlm_matching_after_shower
	<<MLM matching: procedures>>=
	subroutine mlm_matching_after_shower (matching, particle_set, vetoed)
	class(mlm_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	call msg_debug (D_MATCHING, "mlm_matching_after_shower")
	call matching%shower%get_final_colored_ME_momenta (matching%P_ME)
	call matching%fill_P_PS (particle_set)
	!!! MLM stage 3 -> reconstruct and possibly reject
	call matching%apply (vetoed)
	+ if (debug_active (D_MATCHING)) call matching%write ()
	if (allocated (matching%P_ME)) deallocate (matching%P_ME)
	if (allocated (matching%P_PS)) deallocate (matching%P_PS)
	if (allocated (matching%JETS_ME)) deallocate (matching%JETS_ME)
	if (allocated (matching%JETS_PS)) deallocate (matching%JETS_PS)
	end subroutine mlm_matching_after_shower

	@ %def mlm_matching_after_shower
	@ Transfer partons after parton shower to [[matching%P_PS]]
	<<MLM matching: mlm matching: TBP>>=
	procedure :: fill_P_PS => mlm_matching_fill_P_PS
	<<MLM matching: procedures>>=
	subroutine mlm_matching_fill_P_PS (matching, particle_set)
	class(mlm_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(in) :: particle_set
	integer :: i, j, n_jets_PS
	integer, dimension(2) :: col
	type(particle_t) :: tempprt
	real(double) :: eta
	type(vector4_t) :: p_tmp

	!!! loop over particles and extract final colored ones with eta<etamax
	n_jets_PS = 0
	do i = 1, particle_set%get_n_tot ()
	if (signal_is_pending ()) return
	tempprt = particle_set%get_particle (i)
	if (tempprt%get_status () /= PRT_OUTGOING) cycle
	col = tempprt%get_color ()
	if (all (col == 0)) cycle
	! TODO: (bcn 2015-04-28) where is the corresponding part for lepton colliders?
	if (matching%is_hadron_collision) then
	p_tmp = tempprt%get_momentum ()
	if (energy (p_tmp) - longitudinal_part (p_tmp) < 1.E-10_default .or. &
	energy (p_tmp) + longitudinal_part (p_tmp) < 1.E-10_default) then
	eta = pseudorapidity (p_tmp)
	else
	eta = rapidity (p_tmp)
	end if
	if (eta > matching%settings%mlm_etaClusfactor * &
	matching%settings%mlm_etamax) then
	if (debug_active (D_MATCHING)) then
	call msg_debug (D_MATCHING, "Rejecting this particle")
	call tempprt%write ()
	end if
	cycle
	end if
	end if
	n_jets_PS = n_jets_PS + 1
	end do

	allocate (matching%P_PS(1:n_jets_PS))
	call msg_debug (D_MATCHING, "n_jets_ps", n_jets_ps)

	j = 1
	do i = 1, particle_set%get_n_tot ()
	tempprt = particle_set%get_particle (i)
	if (tempprt%get_status () /= PRT_OUTGOING) cycle
	col = tempprt%get_color ()
	if (all(col == 0)) cycle
	! TODO: (bcn 2015-04-28) where is the corresponding part for lepton colliders?
	if (matching%is_hadron_collision) then
	p_tmp = tempprt%get_momentum ()
	if (energy (p_tmp) - longitudinal_part (p_tmp) < 1.E-10_default .or. &
	energy (p_tmp) + longitudinal_part (p_tmp) < 1.E-10_default) then
	eta = pseudorapidity (p_tmp)
	else
	eta = rapidity (p_tmp)
	end if
	if (eta > matching%settings%mlm_etaClusfactor * &
	matching%settings%mlm_etamax) cycle
	end if
	matching%P_PS(j) = tempprt%get_momentum ()
	j = j + 1
	end do
	end subroutine mlm_matching_fill_P_PS

	@ %def mlm_matching_fill_P_PS
	@
	<<MLM matching: mlm matching: TBP>>=
	procedure :: apply => mlm_matching_apply
	<<MLM matching: procedures>>=
	subroutine mlm_matching_apply (matching, vetoed)
	class(mlm_matching_t), intent(inout) :: matching
	logical, intent(out) :: vetoed
	integer :: i, j
	integer :: n_jets_ME, n_jets_PS, n_jets_PS_atycut
	real(double) :: ycut
	real(double), dimension(:, :), allocatable :: PP
	real(double), dimension(:), allocatable :: Y
	real(double), dimension(:,:), allocatable :: P_JETS
	real(double), dimension(:,:), allocatable :: P_ME
	integer, dimension(:), allocatable :: JET
	integer :: NJET, NSUB
	integer :: imode
	!!! TODO: (bcn 2014-03-26) Why is ECUT hard coded to 1?
	!!! It is the denominator of the KT measure. Candidate for removal
	real(double) :: ECUT = 1._double
	integer :: ip1,ip2

	! KTCLUS COMMON BLOCK
	INTEGER NMAX,NUM,HIST
	PARAMETER (NMAX=512)
	DOUBLE PRECISION P,KT,KTP,KTS,ETOT,RSQ,KTLAST
	COMMON /KTCOMM/ETOT,RSQ,P(9,NMAX),KTP(NMAX,NMAX),KTS(NMAX), &
	KT(NMAX),KTLAST(NMAX),HIST(NMAX),NUM

	vetoed = .true.
	if (signal_is_pending ()) return

	<<Set [[n_jets_ME/PS]] from [[matching]] (or equal zero)>>

	<<Jet clustering for partons after matrix element>>

	<<Jet clustering for partons after shower>>

	<<Veto: too many or not enough jets after PS>>

	<<Cluster ME jets with PS jets one at a time>>

	vetoed = .false.
	999 continue
	end subroutine mlm_matching_apply

	@ %def mlm_matching_apply
	@
	<<Set [[n_jets_ME/PS]] from [[matching]] (or equal zero)>>=
	if (allocated (matching%P_ME)) then
	! print *, "number of partons after ME: ", size(matching%P_ME)
	n_jets_ME = size (matching%P_ME)
	else
	n_jets_ME = 0
	end if
	if (allocated (matching%p_PS)) then
	! print *, "number of partons after PS: ", size(matching%p_PS)
	n_jets_PS = size (matching%p_PS)
	else
	n_jets_PS = 0
	end if
	@
	<<Jet clustering for partons after matrix element>>=
	if (n_jets_ME > 0) then
	ycut = (matching%settings%mlm_ptmin)**2
	allocate (PP(1:4, 1:N_jets_ME))
	do i = 1, n_jets_ME
	PP(1:3,i) = matching%p_ME(i)%p(1:3)
	PP(4,i) = matching%p_ME(i)%p(0)
	end do

	<<Set [[imode]] for lepton or hadron collisions>>

	allocate (P_ME(1:4,1:n_jets_ME))
	allocate (JET(1:n_jets_ME))
	allocate (Y(1:n_jets_ME))

	if (signal_is_pending ()) return
	call KTCLUR (imode, PP, n_jets_ME, &
	dble (matching%settings%mlm_Rclusfactor * matching%settings%mlm_Rmin), ECUT, y, *999)
	call KTRECO (1, PP, n_jets_ME, ECUT, ycut, ycut, P_ME, JET, &
	NJET, NSUB, *999)

	n_jets_ME = NJET
	if (NJET > 0) then
	allocate (matching%JETS_ME (1:NJET))
	do i = 1, NJET
	matching%JETS_ME(i) = vector4_moving (REAL(P_ME(4,i), default), &
	vector3_moving([REAL(P_ME(1,i), default), &
	REAL(P_ME(2,i), default), REAL(P_ME(3,i), default)]))
	end do
	end if
	deallocate (P_ME)
	deallocate (JET)
	deallocate (Y)
	deallocate (PP)
	end if
	@
	<<Jet clustering for partons after shower>>=
	if (n_jets_PS > 0) then
	ycut = (matching%settings%mlm_ptmin + max (matching%settings%mlm_ETclusminE, &
	matching%settings%mlm_ETclusfactor * matching%settings%mlm_ptmin))**2
	allocate (PP(1:4, 1:n_jets_PS))
	do i = 1, n_jets_PS
	PP(1:3,i) = matching%p_PS(i)%p(1:3)
	PP(4,i) = matching%p_PS(i)%p(0)
	end do

	<<Set [[imode]] for lepton or hadron collisions>>

	allocate (P_JETS(1:4,1:n_jets_PS))
	allocate (JET(1:n_jets_PS))
	allocate (Y(1:n_jets_PS))

	if (signal_is_pending ()) return
	call KTCLUR (imode, PP, n_jets_PS, &
	dble (matching%settings%mlm_Rclusfactor * matching%settings%mlm_Rmin), &
	ECUT, y, *999)
	call KTRECO (1, PP, n_jets_PS, ECUT, ycut, ycut, P_JETS, JET, &
	NJET, NSUB, *999)
	n_jets_PS_atycut = NJET
	if (n_jets_ME == matching%settings%mlm_nmaxMEjets .and. NJET > 0) then
	! print *, " resetting ycut to ", Y(matching%settings%mlm_nmaxMEjets)
	ycut = y(matching%settings%mlm_nmaxMEjets)
	call KTRECO (1, PP, n_jets_PS, ECUT, ycut, ycut, P_JETS, JET, &
	NJET, NSUB, *999)
	end if

	! !Sample of code for a FastJet interface
	! palg = 1d0 ! 1.0d0 = kt, 0.0d0 = Cam/Aachen, -1.0d0 = anti-kt
	! R = 0.7_double ! radius parameter
	! f = 0.75_double ! overlap threshold
	! !call fastjetppgenkt(PP,n,R,palg,P_JETS,NJET) ! KT-Algorithm
	! !call fastjetsiscone(PP,n,R,f,P_JETS,NJET) ! SiSCone-Algorithm

	if (NJET > 0) then
	allocate (matching%JETS_PS(1:NJET))
	do i = 1, NJET
	matching%JETS_PS(i) = vector4_moving (REAL(P_JETS(4,i), default), &
	vector3_moving([REAL(P_JETS(1,i), default), &
	REAL(P_JETS(2,i), default), REAL(P_JETS(3,i), default)]))
	end do
	end if

	deallocate (P_JETS)
	deallocate (JET)
	deallocate (Y)
	else
	n_jets_PS_atycut = 0
	end if
	@
	<<Set [[imode]] for lepton or hadron collisions>>=
	if (matching%is_hadron_collision) then
	imode = matching%settings%kt_imode_hadronic
	else
	imode = matching%settings%kt_imode_leptonic
	end if
	@
	<<Veto: too many or not enough jets after PS>>=
	if (n_jets_PS_atycut < n_jets_ME) then
	! print *, "DISCARDING: Not enough PS jets: ", n_jets_PS_atycut
	return
	end if
	if (n_jets_PS_atycut > n_jets_ME .and. n_jets_ME /= matching%settings%mlm_nmaxMEjets) then
	! print *, "DISCARDING: Too many PS jets: ", n_jets_PS_atycut
	return
	end if
	@
	<<Cluster ME jets with PS jets one at a time>>=
	if (allocated(matching%JETS_PS)) then
	! print *, "number of jets after PS: ", size(matching%JETS_PS)
	n_jets_PS = size (matching%JETS_PS)
	else
	n_jets_PS = 0
	end if
	if (n_jets_ME > 0 .and. n_jets_PS > 0) then
	n_jets_PS = size (matching%JETS_PS)
	if (allocated (PP)) deallocate(PP)
	allocate (PP(1:4, 1:n_jets_PS + 1))
	do i = 1, n_jets_PS
	if (signal_is_pending ()) return
	PP(1:3,i) = matching%JETS_PS(i)%p(1:3)
	PP(4,i) = matching%JETS_PS(i)%p(0)
	end do
	if (allocated (Y)) deallocate(Y)
	allocate (Y(1:n_jets_PS + 1))
	y = zero
	do i = 1, n_jets_ME
	PP(1:3,n_jets_PS + 2 - i) = matching%JETS_ME(i)%p(1:3)
	PP(4,n_jets_PS + 2 - i) = matching%JETS_ME(i)%p(0)
	!!! This makes more sense than hardcoding
	! call KTCLUS (4313, PP, (n_jets_PS + 2 - i), 1.0_double, Y, *999)
	call KTCLUR (imode, PP, (n_jets_PS + 2 - i), &
	dble (matching%settings%mlm_Rclusfactor * matching%settings%mlm_Rmin), &
	ECUT, y, *999)
	if (0.99 * y(n_jets_PS + 1 - (i - 1)).gt.ycut) then
	! print *, "DISCARDING: Jet ", i, " not clusterd"
	return
	end if
	!!! search for and remove PS jet clustered with ME Jet
	ip1 = HIST(n_jets_PS + 2 - i) / NMAX
	ip2 = mod(hist(n_jets_PS + 2 - i), NMAX)
	if ((ip2 /= n_jets_PS + 2 - i) .or. (ip1 <= 0)) then
	! print *, "DISCARDING: Jet ", i, " not clustered ", ip1, ip2, &
	! hist(n_jets_PS + 2 - i)
	return
	else
	! print *, "PARTON clustered", ip1, ip2, hist(n_jets_PS + 2 - i)
	PP(:,IP1) = zero
	do j = IP1, n_jets_PS - i
	PP(:, j) = PP(:,j + 1)
	end do
	end if
	end do
	end if
	@
	\section{CKKW matching}
	This module contains the CKKW matching.

	The type [[ckkw_pseudo_shower_weights_t]] gives the (relative) weights
	for different clusterings of the final particles, as given in Eq.~(2.7) of
	hep-ph/0503281v1. Each particle has a binary labelling (power of 2)
	(first particle = 1, second particle = 2, third particle = 4,
	...). Each recombination therefore corresponds to an integer, that is
	not a power of 2. Fur multiple subsequent recombinations, no different
	weights for different sequences of clustering are stored. It is
	assumed that the weight of a multiply recombined state is a
	combination of the states with one fewer recombination and that these
	states' contributions are proportional to their weights. For a $2->n$
	event, the weights array thus has the size $2^{(2 + n) - 1}$. The
	[[weights_by_type]] array gives the weights depending on the type of
	the particle, the first index is the same as for weights, the second
	index gives the type of the new mother particle:
	\begin{itemize}
	\item[0:] uncolored ($\gamma$, $Z$, $W$, Higgs)
	\item[1:] colored (quark)
	\item[2:] gluon
	\item[3:] squark
	\item[4:] gluino
	\end{itemize}
	[[alphaS]] gives the value for $alpha_s$ used in the generation of the
	matrix element. This is needed for the reweighting using the values
	for a running $alpha_s$ at the scales of the clusterings.
	<<[[ckkw_matching.f90]]>>=
	<<File header>>

	module ckkw_matching

	<<Use kinds with double>>
	<<Use strings>>
	use io_units
	use constants
	use format_utils, only: write_separator
	use diagnostics
	use physics_defs
	use lorentz
	use particles
	use rng_base
	use shower_base
	use shower_partons
	use shower_core
	use variables
	use matching_base

	<<Standard module head>>

	<<CKKW matching: public>>

	<<CKKW matching: types>>

	contains

	<<CKKW matching: procedures>>

	end module ckkw_matching
	@ %def ckkw_matching
	@ The fundamental CKKW matching parameter are defined here:
	<<CKKW matching: public>>=
	public :: ckkw_matching_settings_t
	<<CKKW matching: types>>=
	type :: ckkw_matching_settings_t
	real(default) :: alphaS = 0.118_default
	real(default) :: Qmin = one
	integer :: n_max_jets = 0
	contains
	<<CKKW matching: ckkw matching settings: TBP>>
	end type ckkw_matching_settings_t

	@ %def ckkw_matching_settings_t
	@ This is empty for the moment.
	<<CKKW matching: ckkw matching settings: TBP>>=
	procedure :: init => ckkw_matching_settings_init
	<<CKKW matching: procedures>>=
	subroutine ckkw_matching_settings_init (settings, var_list)
	class(ckkw_matching_settings_t), intent(out) :: settings
	type(var_list_t), intent(in) :: var_list
	settings%alphaS = 1.0_default
	settings%Qmin = 1.0_default
	settings%n_max_jets = 3
	end subroutine ckkw_matching_settings_init

	@ %def ckkw_matching_settings_init
	@
	<<CKKW matching: ckkw matching settings: TBP>>=
	procedure :: write => ckkw_matching_settings_write
	<<CKKW matching: procedures>>=
	subroutine ckkw_matching_settings_write (settings, unit)
	class(ckkw_matching_settings_t), intent(in) :: settings
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "CKKW matching settings:"
	call write_separator (u)
	write (u, "(3x,A,1x,ES19.12)") &
	"alphaS = ", settings%alphaS
	write (u, "(3x,A,1x,ES19.12)") &
	"Qmin = ", settings%Qmin
	write (u, "(3x,A,1x,I0)") &
	"n_max_jets = ", settings%n_max_jets
	end subroutine ckkw_matching_settings_write

	@ %def ckkw_matching_settings_write
	@
	<<CKKW matching: public>>=
	public :: ckkw_pseudo_shower_weights_t
	<<CKKW matching: types>>=
	type :: ckkw_pseudo_shower_weights_t
	real(default) :: alphaS
	real(default), dimension(:), allocatable :: weights
	real(default), dimension(:,:), allocatable :: weights_by_type
	contains
	<<CKKW matching: ckkw pseudo shower weights: TBP>>
	end type ckkw_pseudo_shower_weights_t

	@ %def ckkw_pseudo_shower_weights_t
	@
	<<CKKW matching: ckkw pseudo shower weights: TBP>>=
	procedure :: init => ckkw_pseudo_shower_weights_init
	<<CKKW matching: procedures>>=
	subroutine ckkw_pseudo_shower_weights_init (weights)
	class(ckkw_pseudo_shower_weights_t), intent(out) :: weights
	weights%alphaS = zero
	end subroutine ckkw_pseudo_shower_weights_init

	@ %def ckkw_pseudo_shower_weights_init
	@
	<<CKKW matching: ckkw pseudo shower weights: TBP>>=
	procedure :: write => ckkw_pseudo_shower_weights_write
	<<CKKW matching: procedures>>=
	subroutine ckkw_pseudo_shower_weights_write (weights, unit)
	class(ckkw_pseudo_shower_weights_t), intent(in) :: weights
	integer, intent(in), optional :: unit
	integer :: s, i, u
	u = given_output_unit (unit); if (u < 0) return
	s = size (weights%weights)
	write (u, "(1x,A)") "CKKW (pseudo) shower weights: "
	do i = 1, s
	write (u, "(3x,I0,2(ES19.12))") i, weights%weights(i), &
	weights%weights_by_type(i,:)
	end do
	write (u, "(3x,A,1x,I0)") "alphaS =", weights%alphaS
	end subroutine ckkw_pseudo_shower_weights_write

	@ %def ckkw_pseudo_shower_weights_write
	@ Generate fake ckkw weights. This can be dropped, once information
	from the matrix element generation is available.
	<<CKKW matching: ckkw pseudo shower weights: TBP>>=
	procedure :: fake => ckkw_pseudo_shower_weights_fake
	<<CKKW matching: procedures>>=
	pure subroutine ckkw_pseudo_shower_weights_fake (weights, particle_set)
	class(ckkw_pseudo_shower_weights_t), intent(inout) :: weights
	type(particle_set_t), intent(in) :: particle_set
	integer :: i, j, n
	type(vector4_t) :: momentum
	n = 2**particle_set%n_tot
	if (allocated (weights%weights)) then
	deallocate (weights%weights)
	end if
	allocate (weights%weights (1:n))
	do i = 1, n
	momentum = vector4_null
	do j = 1, particle_set%n_tot
	if (btest (i,j-1)) then
	momentum = momentum + particle_set%prt(j)%p
	end if
	end do
	if (momentum**1 > 0.0) then
	weights%weights(i) = 1.0 / (momentum**2)
	end if
	end do
	! equally distribute the weights by type
	if (allocated (weights%weights_by_type)) then
	deallocate (weights%weights_by_type)
	end if
	allocate (weights%weights_by_type (1:n, 0:4))
	do i = 1, n
	do j = 0, 4
	weights%weights_by_type(i,j) = 0.2 * weights%weights(i)
	end do
	end do
	end subroutine ckkw_pseudo_shower_weights_fake

	@ %def ckkw_pseudo_shower_weights_fake
	@
	<<CKKW matching: public>>=
	public :: ckkw_matching_t
	<<CKKW matching: types>>=
	type, extends (matching_t) :: ckkw_matching_t
	type(ckkw_matching_settings_t) :: settings
	type(ckkw_pseudo_shower_weights_t) :: weights
	contains
	<<CKKW matching: ckkw matching: TBP>>
	end type ckkw_matching_t

	@ %def ckkw_matching_t
	@
	<<CKKW matching: ckkw matching: TBP>>=
	procedure :: init => ckkw_matching_init
	<<CKKW matching: procedures>>=
	subroutine ckkw_matching_init (matching, var_list, process_name)
	class(ckkw_matching_t), intent(out) :: matching
	<<default matching init>>
	end subroutine ckkw_matching_init

	@ %def ckkw_matching_init
	@
	<<CKKW matching: ckkw matching: TBP>>=
	procedure :: write => ckkw_matching_write
	<<CKKW matching: procedures>>=
	subroutine ckkw_matching_write (matching, unit)
	class(ckkw_matching_t), intent(in) :: matching
	integer, intent(in), optional :: unit
	call matching%settings%write (unit)
	call matching%weights%write (unit)
	end subroutine ckkw_matching_write

	@ %def ckkw_matching_write
	@
	<<CKKW matching: ckkw matching: TBP>>=
	procedure :: get_method => ckkw_matching_get_method
	<<CKKW matching: procedures>>=
	function ckkw_matching_get_method (matching) result (method)
	type(string_t) :: method
	class(ckkw_matching_t), intent(in) :: matching
	method = matching_method (MATCH_CKKW)
	end function ckkw_matching_get_method

	@ %def ckkw_matching_get_method
	@
	<<CKKW matching: ckkw matching: TBP>>=
	procedure :: before_shower => ckkw_matching_before_shower
	<<CKKW matching: procedures>>=
	subroutine ckkw_matching_before_shower &
	(matching, particle_set, vetoed)
	class(ckkw_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	call matching%weights%init ()
	call matching%weights%fake (particle_set)
	select type (shower => matching%shower)
	type is (shower_t)
	call ckkw_matching_apply (shower%partons, &
	matching%settings, &
	matching%weights, matching%rng, vetoed)
	class default
	call msg_bug ("CKKW matching only works with WHIZARD shower.")
	end select
	end subroutine ckkw_matching_before_shower

	@ %def ckkw_matching_before_shower
	@
	<<CKKW matching: public>>=
	public :: ckkw_matching_apply
	<<CKKW matching: procedures>>=
	subroutine ckkw_matching_apply (partons, settings, weights, rng, vetoed)
	type(parton_pointer_t), dimension(:), intent(inout), allocatable :: &
	partons
	type(ckkw_matching_settings_t), intent(in) :: settings
	type(ckkw_pseudo_shower_weights_t), intent(in) :: weights
	class(rng_t), intent(inout), allocatable :: rng
	logical, intent(out) :: vetoed

	real(default), dimension(:), allocatable :: scales
	real(double) :: weight, sf
	real(default) :: rand
	integer :: i, n_partons

	if (signal_is_pending ()) return
	weight = one

	n_partons = size (partons)

	do i = 1, n_partons
	call partons(i)%p%write ()
	end do

	!!! the pseudo parton shower is already simulated by shower_add_interaction
	!!! get the respective clustering scales
	allocate (scales (1:n_partons))
	do i = 1, n_partons
	if (.not. associated (partons(i)%p)) cycle
	if (partons(i)%p%type == INTERNAL) then
	scales(i) = two * min (partons(i)%p%child1%momentum%p(0), &
	partons(i)%p%child2%momentum%p(0))*2 &
	(1.0 - (space_part (partons(i)%p%child1%momentum) * &
	space_part (partons(i)%p%child2%momentum)) / &
	(space_part (partons(i)%p%child1%momentum)*1 &
	space_part (partons(i)%p%child2%momentum)**1))
	scales(i) = sqrt (scales(i))
	partons(i)%p%ckkwscale = scales(i)
	print *, scales(i)
	end if
	end do

	print *, " scales finished"
	!!! if (highest multiplicity) -> reweight with PDF(mu_F) / PDF(mu_cut)
	do i = 1, n_partons
	call partons(i)%p%write ()
	end do

	!!! Reweight and possibly veto the whole event

	!!! calculate the relative alpha_S weight

	!! calculate the Sudakov weights for internal lines
	!! calculate the Sudakov weights for external lines
	do i = 1, n_partons
	if (signal_is_pending ()) return
	if (.not. associated (partons(i)%p)) cycle
	if (partons(i)%p%type == INTERNAL) then
	!!! get type
	!!! check that all particles involved are colored
	if ((partons(i)%p%is_colored () .or. &
	partons(i)%p%ckkwtype > 0) .and. &
	(partons(i)%p%child1%is_colored () .or. &
	partons(i)%p%child1%ckkwtype > 0) .and. &
	(partons(i)%p%child1%is_colored () .or. &
	partons(i)%p%child1%ckkwtype > 0)) then
	print *, "reweight with alphaS(" , partons(i)%p%ckkwscale, &
	") for particle ", partons(i)%p%nr
	if (partons(i)%p%belongstoFSR) then
	print *, "FSR"
	weight = weight * D_alpha_s_fsr (partons(i)%p%ckkwscale**2, &
	partons(i)%p%settings) / settings%alphas
	else
	print *, "ISR"
	weight = weight * &
	D_alpha_s_isr (partons(i)%p%ckkwscale**2, &
	partons(i)%p%settings) / settings%alphas
	end if
	else
	print *, "no reweight with alphaS for ", partons(i)%p%nr
	end if
	if (partons(i)%p%child1%type == INTERNAL) then
	print *, "internal line from ", &
	partons(i)%p%child1%ckkwscale, &
	" to ", partons(i)%p%ckkwscale, &
	" for type ", partons(i)%p%child1%ckkwtype
	if (partons(i)%p%child1%ckkwtype == 0) then
	sf = 1.0
	else if (partons(i)%p%child1%ckkwtype == 1) then
	sf = SudakovQ (partons(i)%p%child1%ckkwscale, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFQ = ", sf
	else if (partons(i)%p%child1%ckkwtype == 2) then
	sf = SudakovG (partons(i)%p%child1%ckkwscale, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFG = ", sf
	else
	print *, "SUSY not yet implemented"
	end if
	weight = weight * min (one, sf)
	else
	print *, "external line from ", settings%Qmin, &
	partons(i)%p%ckkwscale
	if (partons(i)%p%child1%is_quark ()) then
	sf = SudakovQ (settings%Qmin, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFQ = ", sf
	else if (partons(i)%p%child1%is_gluon ()) then
	sf = SudakovG (settings%Qmin, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFG = ", sf
	else
	print *, "not yet implemented (", &
	partons(i)%p%child2%type, ")"
	sf = one
	end if
	weight = weight * min (one, sf)
	end if
	if (partons(i)%p%child2%type == INTERNAL) then
	print *, "internal line from ", partons(i)%p%child2%ckkwscale, &
	" to ", partons(i)%p%ckkwscale, &
	" for type ", partons(i)%p%child2%ckkwtype
	if (partons(i)%p%child2%ckkwtype == 0) then
	sf = 1.0
	else if (partons(i)%p%child2%ckkwtype == 1) then
	sf = SudakovQ (partons(i)%p%child2%ckkwscale, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFQ = ", sf
	else if (partons(i)%p%child2%ckkwtype == 2) then
	sf = SudakovG (partons(i)%p%child2%ckkwscale, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFG = ", sf
	else
	print *, "SUSY not yet implemented"
	end if
	weight = weight * min (one, sf)
	else
	print *, "external line from ", settings%Qmin, &
	partons(i)%p%ckkwscale
	if (partons(i)%p%child2%is_quark ()) then
	sf = SudakovQ (settings%Qmin, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFQ = ", sf
	else if (partons(i)%p%child2%is_gluon ()) then
	sf = SudakovG (settings%Qmin, &
	partons(i)%p%ckkwscale, &
	partons(i)%p%settings, .true., rng)
	print *, "SFG = ", sf
	else
	print *, "not yet implemented (", &
	partons(i)%p%child2%type, ")"
	sf = one
	end if
	weight = weight * min (one, sf)
	end if
	end if
	end do

	call rng%generate (rand)

	print *, "final weight: ", weight

	!!!!!!! WRONG
	vetoed = .false.
	! vetoed = (rand > weight)
	if (vetoed) then
	return
	end if

	!!! finally perform the parton shower
	!!! veto emissions that are too hard

	deallocate (scales)
	end subroutine ckkw_matching_apply

	@ %def ckkw_matching_apply
	@
	@
	<<CKKW matching: ckkw matching: TBP>>=
	procedure :: after_shower => ckkw_matching_after_shower
	<<CKKW matching: procedures>>=
	subroutine ckkw_matching_after_shower (matching, particle_set, vetoed)
	class(ckkw_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	vetoed = .false.
	end subroutine ckkw_matching_after_shower

	@ %def ckkw_matching_after_shower
	<<CKKW matching: procedures>>=
	function GammaQ (smallq, largeq, settings, fsr) result (gamma)
	real(default), intent(in) :: smallq, largeq
	type(shower_settings_t), intent(in) :: settings
	logical, intent(in) :: fsr
	real(default) :: gamma
	gamma = (8._default / three) / (pi * smallq)
	gamma = gamma * (log(largeq / smallq) - 0.75)
	if (fsr) then
	gamma = gamma * D_alpha_s_fsr (smallq**2, settings)
	else
	gamma = gamma * D_alpha_s_isr (smallq**2, settings)
	end if
	end function GammaQ

	@ %def GammaQ
	@
	<<CKKW matching: procedures>>=
	function GammaG (smallq, largeq, settings, fsr) result (gamma)
	real(default), intent(in) :: smallq, largeq
	type(shower_settings_t), intent(in) :: settings
	logical, intent(in) :: fsr
	real(default) :: gamma
	gamma = 6._default / (pi * smallq)
	gamma = gamma *( log(largeq / smallq) - 11.0 / 12.0)
	if (fsr) then
	gamma = gamma * D_alpha_s_fsr (smallq**2, settings)
	else
	gamma = gamma * D_alpha_s_isr (smallq**2, settings)
	end if
	end function GammaG

	@ %def GammaG
	@
	<<CKKW matching: procedures>>=
	function GammaF (smallq, settings, fsr) result (gamma)
	real(default), intent(in) :: smallq
	type(shower_settings_t), intent(in) :: settings
	logical, intent(in) :: fsr
	real(default) :: gamma
	gamma = number_of_flavors (smallq, settings%max_n_flavors, &
	settings%min_virtuality) / (three * pi * smallq)
	if (fsr) then
	gamma = gamma * D_alpha_s_fsr (smallq**2, settings)
	else
	gamma = gamma * D_alpha_s_isr (smallq**2, settings)
	end if
	end function GammaF

	@ %def GammaF
	@
	<<CKKW matching: procedures>>=
	function SudakovQ (Q1, Q, settings, fsr, rng) result (sf)
	real(default), intent(in) :: Q1, Q
	type(shower_settings_t), intent(in) :: settings
	class(rng_t), intent(inout), allocatable :: rng
	logical, intent(in) :: fsr
	real(default) :: sf
	real(default) :: integral
	integer, parameter :: NTRIES = 100
	integer :: i
	real(default) :: rand
	integral = zero
	do i = 1, NTRIES
	call rng%generate (rand)
	integral = integral + GammaQ (Q1 + rand * (Q - Q1), Q, settings, fsr)
	end do
	integral = integral / NTRIES
	sf = exp (-integral)
	end function SudakovQ

	@ %def SudakovQ
	@
	<<CKKW matching: procedures>>=
	function SudakovG (Q1, Q, settings, fsr, rng) result (sf)
	real(default), intent(in) :: Q1, Q
	type(shower_settings_t), intent(in) :: settings
	logical, intent(in) :: fsr
	real(default) :: sf
	real(default) :: integral
	class(rng_t), intent(inout), allocatable :: rng
	integer, parameter :: NTRIES = 100
	integer :: i
	real(default) :: rand
	integral = zero
	do i = 1, NTRIES
	call rng%generate (rand)
	integral = integral + &
	GammaG (Q1 + rand * (Q - Q1), Q, settings, fsr) + &
	GammaF (Q1 + rand * (Q - Q1), settings, fsr)
	end do
	integral = integral / NTRIES
	sf = exp (-integral)
	end function SudakovG

	@ %def SudakovG
	@
	\section{POWHEG}
	This module generates radiation according to the POWHEG Sudakov form factor
	\begin{equation}
	\Delta^{f_b} (\Phi_n, p_\text{T}) = \prod_{\alpha_r \in \{\alpha_r \|f_b \}}
	\Delta^{f_b}_{\alpha_r} (\Phi_n,
	p_\text{T}),
	\end{equation}
	with
	\begin{equation}
	\Delta^{f_b}_{\alpha_r} (\Phi_n, p_\text{T}) = \exp \left\{ - \left[ \int d
	\Phi_{\text{rad}} \,\frac{R (\Phi_{n+1})}{B^{f_b} (\Phi_n)}
	\,\theta( k_\text{T} (\Phi_{n+1}) - p_\text{T}) \right]^{\bar{\bf \Phi}_n^{\alpha_r} =
	\Phi_n}_{\alpha_r} \right\}
	\end{equation}

	We expect that an underlying Born flavor structure $f_b$ has been
	generated with a probability proportional to its contribution to the
	$\tilde B$ at the given kinematic point.
	<<[[powheg_matching.f90]]>>=
	<<File header>>

	module powheg_matching

	use, intrinsic :: iso_fortran_env

	<<Use kinds>>
	<<Use strings>>
	use diagnostics
	use constants, only: ZERO, ONE, TWO, FIVE, TINY_07, PI, TWOPI
	use numeric_utils
	use io_units, only: given_output_unit, free_unit
	use format_utils, only: write_separator
	use format_defs, only: FMT_16, FMT_19
	use string_utils, only: str
	use os_interface, only: os_file_exist
	use physics_defs, only: CA, BORN, NLO_REAL
	use lorentz
	use sm_qcd, only: qcd_t, alpha_qcd_from_scale_t, alpha_qcd_from_lambda_t
	use sm_physics, only: Li2
	use subevents, only: PRT_INCOMING, PRT_OUTGOING
	use colors
	use particles
	use grids
	use solver
	use rng_base
	use variables
	use process_config, only: COMP_REAL_FIN

	use phs_fks, only: phs_fks_generator_t, compute_dalitz_bounds, beta_emitter
	use phs_fks, only: phs_point_set_t, phs_identifier_t, phs_fks_t
	use phs_fks, only: I_XI, I_Y, FSR_SIMPLE, FSR_MASSIVE
	use matching_base
	use instances, only: process_instance_t, process_instance_hook_t
	use pcm, only: pcm_nlo_t, pcm_instance_nlo_t
	<<Use mpi f08>>

	<<Standard module head>>

	<<POWHEG matching: public>>

	<<POWHEG matching: parameters>>

	<<POWHEG matching: types>>

	<<POWHEG matching: interfaces>>

	contains

	<<POWHEG matching: procedures>>

	end module powheg_matching
	@ %def powheg_matching
	@
	\subsection{Base types for settings and data}
	[[lambda]] enters for now as the lowest scale
	$2 \Lambda^(5)_{\bar{\text{MS}}}$ where the radiation
	$\alpha_s^\text{rad}$ is still larger than the true $\alpha_s$.
	<<POWHEG matching: public>>=
	public :: powheg_settings_t
	<<POWHEG matching: types>>=
	type :: powheg_settings_t
	real(default) :: pt2_min = zero
	real(default) :: lambda = zero
	integer :: n_init = 0
	integer :: size_grid_xi = 0
	integer :: size_grid_y = 0
	integer :: upper_bound_func = UBF_SIMPLE
	logical :: rebuild_grids = .false.
	logical :: test_sudakov = .false.
	logical :: disable_sudakov = .false.
	logical :: singular_jacobian = .false.
	contains
	<<POWHEG matching: powheg settings: TBP>>
	end type powheg_settings_t

	@ %def powheg_settings_t
	@ These are the possible values for [[upper_bound_func]] and will be
	used to decide which ubf object is allocated.
	<<POWHEG matching: parameters>>=
	integer, parameter :: UBF_SIMPLE = 1
	integer, parameter :: UBF_EEQQ = 2
	integer, parameter :: UBF_MASSIVE = 3
	@ %def UBF_SIMPLE UBF_EEQQ
	@
	<<POWHEG matching: powheg settings: TBP>>=
	procedure :: init => powheg_settings_init
	<<POWHEG matching: procedures>>=
	subroutine powheg_settings_init (settings, var_list)
	class(powheg_settings_t), intent(out) :: settings
	type(var_list_t), intent(in) :: var_list
	settings%pt2_min = &
	var_list%get_rval (var_str ("powheg_pt_min"))**2
	settings%size_grid_xi = &
	var_list%get_ival (var_str ("powheg_grid_size_xi"))
	settings%size_grid_y = &
	var_list%get_ival (var_str ("powheg_grid_size_y"))
	settings%n_init = &
	var_list%get_ival (var_str ("powheg_grid_sampling_points"))
	settings%lambda = var_list%get_rval (var_str ("powheg_lambda"))
	settings%rebuild_grids = &
	var_list%get_lval (var_str ("?powheg_rebuild_grids"))
	settings%singular_jacobian = &
	var_list%get_lval (var_str ("?powheg_use_singular_jacobian"))
	settings%test_sudakov = &
	var_list%get_lval (var_str ("?powheg_test_sudakov"))
	settings%disable_sudakov = &
	var_list%get_lval (var_str ("?powheg_disable_sudakov"))
	end subroutine powheg_settings_init

	@ %def powheg_settings_init
	@
	<<POWHEG matching: powheg settings: TBP>>=
	procedure :: write => powheg_settings_write
	<<POWHEG matching: procedures>>=
	subroutine powheg_settings_write (powheg_settings, unit)
	class(powheg_settings_t), intent(in) :: powheg_settings
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1X,A)") "POWHEG settings:"
	write (u, "(3X,A," // FMT_16 //")") "pt2_min = ", powheg_settings%pt2_min
	write (u, "(3X,A," // FMT_16 //")") "lambda = ", powheg_settings%lambda
	write (u, "(3X,A,I12)") "n_init = ", powheg_settings%n_init
	write (u, "(3X,A,I12)") "size_grid_xi = ", powheg_settings%size_grid_xi
	write (u, "(3X,A,I12)") "size_grid_y = ", powheg_settings%size_grid_y
	write (u, "(3X,A,I12)") "upper_bound_func = ", powheg_settings%upper_bound_func
	end subroutine powheg_settings_write

	@ %def powheg_settings_write
	@
	<<POWHEG matching: public>>=
	public :: radiation_t
	<<POWHEG matching: types>>=
	type :: radiation_t
	real(default) :: xi, y, phi, pt2
	integer :: alr
	logical :: valid = .false.
	contains
	<<POWHEG matching: radiation: TBP>>
	end type radiation_t

	@ %def radiation_t
	@
	<<POWHEG matching: radiation: TBP>>=
	procedure :: write => radiation_write
	<<POWHEG matching: procedures>>=
	subroutine radiation_write (radiation, unit)
	class(radiation_t), intent(in) :: radiation
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1X, A)") "Radiation:"
	write (u, "(3X, A," // FMT_16 // ")") "xi = ", radiation%xi
	write (u, "(3X, A," // FMT_16 // ")") "y = ", radiation%y
	write (u, "(3X, A," // FMT_16 // ")") "phi = ", radiation%phi
	write (u, "(3X, A," // FMT_16 // ")") "pt2 = ", radiation%pt2
	write (u, "(3X, A, I12)") "alr = ", radiation%alr
	end subroutine radiation_write

	@ %def radiation_write
	@ [[lambda2_gen]] $\neq$ [[lambda]] and is used in the upper bounding
	functions.
	<<POWHEG matching: public>>=
	public :: process_deps_t
	<<POWHEG matching: types>>=
	type :: process_deps_t
	real(default) :: lambda2_gen, sqrts
	integer :: n_alr
	logical :: cm_frame = .true.
	type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers
	integer, dimension(:), allocatable :: alr_to_i_phs
	integer :: i_born
	integer, dimension(:), allocatable :: i_real
	contains
	<<POWHEG matching: process deps: TBP>>
	end type process_deps_t

	@ %def process_deps_t
	@
	<<POWHEG matching: process deps: TBP>>=
	procedure :: write => process_deps_write
	<<POWHEG matching: procedures>>=
	subroutine process_deps_write (process_deps, unit)
	class(process_deps_t), intent(in) :: process_deps
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1X,A)") "Process dependencies:"
	write (u, "(3X,A," // FMT_19 // ")") "lambda2_gen = ", process_deps%lambda2_gen
	write (u, "(3X,A, I12)") "n_alr = ", process_deps%n_alr
	end subroutine process_deps_write

	@ %def process_deps_write
	@
	<<POWHEG matching: public>>=
	public :: event_deps_t
	<<POWHEG matching: types>>=
	type :: event_deps_t
	real(default) :: s_hat
	type(phs_point_set_t) :: p_born_cms
	type(phs_point_set_t) :: p_born_lab
	type(phs_point_set_t) :: p_real_cms
	type(phs_point_set_t) :: p_real_lab
	real(default) :: sqme_born
	contains
	<<POWHEG matching: event deps: TBP>>
	end type event_deps_t

	@ %def event_deps_t
	@
	<<POWHEG matching: event deps: TBP>>=
	procedure :: write => event_deps_write
	<<POWHEG matching: procedures>>=
	subroutine event_deps_write (event_deps, unit)
	class(event_deps_t), intent(in) :: event_deps
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1X,A)") "Event dependencies:"
	write (u, "(3X,A," // FMT_19 // ")") "s_hat = ", event_deps%s_hat
	write (u, "(3X,A," // FMT_19 // ")") "sqme_born = ", event_deps%sqme_born
	end subroutine event_deps_write

	@ %def event_deps_write
	@
	<<POWHEG matching: event deps: TBP>>=
	procedure :: update => event_deps_update
	<<POWHEG matching: procedures>>=
	subroutine event_deps_update (event_deps, sqme_born, p_born, lt_lab_to_cms)
	class(event_deps_t), intent(inout) :: event_deps
	real(default), intent(in) :: sqme_born
	type(vector4_t), dimension(:), intent(in) :: p_born
	type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
	integer :: n_born
	event_deps%sqme_born = sqme_born
	n_born = size (p_born)
	if (debug_active (D_MATCHING)) then
	if (n_born /= event_deps%p_born_lab%get_n_particles (1)) then
	call msg_fatal &
	("event_deps_update: number of born_momenta has changed")
	end if
	end if
	call event_deps%p_born_lab%set_momenta (1, p_born)
	call event_deps%set_cms (lt_lab_to_cms)
	end subroutine event_deps_update

	@ %def event_deps_update
	@ This has to be changed when we have sorted out the handling of ISR,
	partonic vs hadronic cms as well as decays in POWHEG:
	<<POWHEG matching: event deps: TBP>>=
	procedure :: set_cms => event_deps_set_cms
	<<POWHEG matching: procedures>>=
	subroutine event_deps_set_cms (event_deps, lt_lab_to_cms)
	class(event_deps_t), intent(inout) :: event_deps
	type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
	associate (p => event_deps%p_born_lab%phs_point(1)%p)
	event_deps%s_hat = (p(1) + p(2))**2
	if (present (lt_lab_to_cms)) then
	event_deps%p_born_cms%phs_point(1)%p = lt_lab_to_cms * p
	else
	event_deps%p_born_cms%phs_point(1)%p = p
	end if
	end associate
	end subroutine event_deps_set_cms

	@ %def event_deps_set_cms
	@
	<<POWHEG matching: types>>=
	type :: veto_counter_t
	integer :: n_ubf = 0
	integer :: n_first_fail = 0
	integer :: n_alpha_s = 0
	integer :: n_xi_max = 0
	integer :: n_norm = 0
	integer :: n_sqme = 0
	integer :: veto_ubf = 0
	integer :: veto_alpha_s = 0
	integer :: veto_xi_max = 0
	integer :: veto_norm = 0
	integer :: veto_sqme = 0
	integer :: n_veto_fail = 0
	contains
	<<POWHEG matching: veto counter: TBP>>
	end type veto_counter_t

	@ %def veto_counter_t
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: record_ubf => veto_counter_record_ubf
	<<POWHEG matching: procedures>>=
	pure subroutine veto_counter_record_ubf (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	counter%n_ubf = counter%n_ubf + 1
	if (vetoed) counter%veto_ubf = counter%veto_ubf + 1
	end subroutine veto_counter_record_ubf

	@ %def veto_counter_record_ubf
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: record_first_fail => veto_counter_record_first_fail
	<<POWHEG matching: procedures>>=
	subroutine veto_counter_record_first_fail (counter)
	class(veto_counter_t), intent(inout) :: counter
	counter%n_first_fail = counter%n_first_fail + 1
	end subroutine veto_counter_record_first_fail

	@ %def veto_counter_record_first_fail
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: record_alpha_s => veto_counter_record_alpha_s
	<<POWHEG matching: procedures>>=
	subroutine veto_counter_record_alpha_s (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	counter%n_alpha_s = counter%n_alpha_s + 1
	if (vetoed) counter%veto_alpha_s = counter%veto_alpha_s + 1
	end subroutine veto_counter_record_alpha_s

	@ %def veto_counter_record_alpha_s
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: record_xi_max => veto_counter_record_xi_max
	<<POWHEG matching: procedures>>=
	subroutine veto_counter_record_xi_max (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	counter%n_xi_max = counter%n_xi_max + 1
	if (vetoed) counter%veto_xi_max = counter%veto_xi_max + 1
	end subroutine veto_counter_record_xi_max

	@ %def veto_counter_record_xi_max
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: record_norm => veto_counter_record_norm
	<<POWHEG matching: procedures>>=
	subroutine veto_counter_record_norm (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	counter%n_norm = counter%n_norm + 1
	if (vetoed) counter%veto_norm = counter%veto_norm + 1
	end subroutine veto_counter_record_norm

	@ %def veto_counter_record_norm
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: record_sqme => veto_counter_record_sqme
	<<POWHEG matching: procedures>>=
	subroutine veto_counter_record_sqme (counter, vetoed)
	class(veto_counter_t), intent(inout) :: counter
	logical, intent(in) :: vetoed
	counter%n_sqme = counter%n_sqme + 1
	if (vetoed) counter%veto_sqme = counter%veto_sqme + 1
	end subroutine veto_counter_record_sqme

	@ %def veto_counter_record_sqme
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: record_fail => veto_counter_record_fail
	<<POWHEG matching: procedures>>=
	subroutine veto_counter_record_fail (counter)
	class(veto_counter_t), intent(inout) :: counter
	counter%n_veto_fail = counter%n_veto_fail + 1
	end subroutine veto_counter_record_fail

	@ %def veto_counter_record_fail
	@
	<<POWHEG matching: veto counter: TBP>>=
	procedure :: write => veto_counter_write
	<<POWHEG matching: procedures>>=
	subroutine veto_counter_write (counter, unit)
	class(veto_counter_t), intent(in) :: counter
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A,I12)") "Nr. of ubf-veto calls: ", counter%n_ubf
	write (u, "(A,I12)") "Nr. of ubf-vetos: ", counter%veto_ubf
	if (counter%n_ubf > 0) &
	write (u, "(A,F4.2)") "Fraction of vetoed points: ", &
	one*counter%veto_ubf / counter%n_ubf
	call write_separator (u)

	write (u, "(A,I12)") "Nr. of alpha_s-veto calls: ", counter%n_alpha_s
	write (u, "(A,I12)") "Nr. of alpha_s-vetos: ", counter%veto_alpha_s
	if (counter%n_alpha_s > 0) &
	write (u, "(A,F4.2)") "Fraction of vetoed points: ", &
	one*counter%veto_alpha_s / counter%n_alpha_s
	call write_separator (u)

	write (u, "(A,I12)") "Nr. of xi_max-veto calls: ", counter%n_xi_max
	write (u, "(A,I12)") "Nr. of xi_max-vetos: ", counter%veto_xi_max
	if (counter%n_alpha_s > 0) &
	write (u, "(A,F4.2)") "Fraction of vetoed points: ", &
	one*counter%veto_xi_max / counter%n_xi_max
	call write_separator (u)

	write (u, "(A,I0)") "Nr. of norm-veto calls: ", counter%n_norm
	write (u, "(A,I0)") "Nr. of norm-vetos: ", counter%veto_norm
	if (counter%n_norm > 0) &
	write (u, "(A,F4.2)") "Fraction of vetoed points: ", &
	one*counter%veto_norm / counter%n_norm
	call write_separator (u)

	write (u, "(A,I0)") "Nr. of sqme-veto calls: ", counter%n_sqme
	write (u, "(A,I0)") "Nr. of sqme-vetos: ", counter%veto_sqme
	if (counter%n_sqme > 0) &
	write (u, "(A,F4.2)") "Fraction of vetoed points: ", &
	one*counter%veto_sqme / counter%n_sqme
	call write_separator (u)
	write (u, "(A,I0)") "Nr. of upper-bound failures: ", &
	counter%n_veto_fail
	end subroutine veto_counter_write

	@ %def veto_counter_write
	@
	\subsection{Upper bounding functions and [[sudakov]]s}
	\subsubsection{Abstract version}
	This contains the pieces that depend on the radiation region $\alpha_r$
	<<POWHEG matching: public>>=
	public :: sudakov_t
	<<POWHEG matching: types>>=
	type, abstract, extends (solver_function_t) :: sudakov_t
	type(process_deps_t), pointer :: process_deps => null()
	type(event_deps_t), pointer :: event_deps => null()
	type(powheg_settings_t), pointer :: powheg_settings => null()
	type(phs_fks_generator_t), pointer :: phs_fks_generator => null()
	type(qcd_t), pointer :: qcd => null()
	class(rng_t), pointer :: rng => null()
	real(default) :: xi2_max = zero
	real(default) :: norm_max = zero
	real(default) :: current_pt2_max = zero
	real(default) :: last_log = zero
	real(default) :: random = zero
	type(veto_counter_t) :: veto_counter
	integer :: i_phs = 0
	contains
	<<POWHEG matching: sudakov: TBP>>
	end type sudakov_t

	@ %def sudakov_t
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: write => sudakov_write
	<<POWHEG matching: procedures>>=
	subroutine sudakov_write (sudakov, unit)
	class(sudakov_t), intent(in) :: sudakov
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(3X,A," // FMT_19 // ")") "xi2_max = ", sudakov%xi2_max
	write (u, "(3X,A," // FMT_19 // ")") "norm_max = ", sudakov%norm_max
	write (u, "(3X,A," // FMT_19 // ")") &
	"current_pt2_max = ", sudakov%current_pt2_max
	write (u, "(3X,A," // FMT_19 // ")") "last_log = ", sudakov%last_log
	write (u, "(3X,A," // FMT_19 // ")") "random = ", sudakov%random
	end subroutine sudakov_write

	@ %def sudakov_write
	@ To allow for arrays of this class
	<<POWHEG matching: public>>=
	public :: sudakov_wrapper_t
	<<POWHEG matching: types>>=
	type :: sudakov_wrapper_t
	class(sudakov_t), allocatable :: s
	end type sudakov_wrapper_t

	@ %def sudakov_wrapper_t
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: init => sudakov_init
	<<POWHEG matching: procedures>>=
	subroutine sudakov_init (sudakov, process_deps, event_deps, &
	powheg_settings, qcd, phs_fks_generator, rng)
	class(sudakov_t), intent(out) :: sudakov
	type(process_deps_t), target, intent(in) :: process_deps
	type(event_deps_t), target, intent(in) :: event_deps
	type(powheg_settings_t), target, intent(in) :: powheg_settings
	type(qcd_t), target, intent(in) :: qcd
	type(phs_fks_generator_t), target, intent(in) :: phs_fks_generator
	class(rng_t), target, intent(in), optional :: rng
	sudakov%process_deps => process_deps
	sudakov%event_deps => event_deps
	sudakov%powheg_settings => powheg_settings
	sudakov%qcd => qcd
	sudakov%phs_fks_generator => phs_fks_generator
	if (present (rng)) sudakov%rng => rng
	end subroutine sudakov_init

	@ %def sudakov_init
	@ This has to be done after the grids are initialized.
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: set_normalization => sudakov_set_normalization
	<<POWHEG matching: procedures>>=
	pure subroutine sudakov_set_normalization (sudakov, norm_max)
	class(sudakov_t), intent(inout) :: sudakov
	real(default), intent(in) :: norm_max
	sudakov%norm_max = norm_max
	end subroutine sudakov_set_normalization

	@ %def sudakov_set_normalization
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: update => sudakov_update
	<<POWHEG matching: procedures>>=
	pure subroutine sudakov_update (sudakov, xi2_max)
	class(sudakov_t), intent(inout) :: sudakov
	real(default), intent(in) :: xi2_max
	sudakov%xi2_max = xi2_max
	end subroutine sudakov_update

	@ %def sudakov_update
	@ [[upper_bound_func]] does \emph{not} contain the normalization $N$
	which is given by the grids. In the notation of [[1002.2581]], it is
	thus $\frac 1 N U(\xi,y)$
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_upper_bound_func), deferred :: upper_bound_func
	<<POWHEG matching: interfaces>>=
	abstract interface
	pure function sudakov_upper_bound_func (sudakov, xi, y, alpha_s) result (u)
	import
	real(default) :: u
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	end function sudakov_upper_bound_func
	end interface

	@ %def sudakov_upper_bound_func
	@ Similar to the [[upper_bound_func]], this is
	$-\frac 1 N \log\Delta(p_T^2)$ where
	\begin{equation}
	\Delta^{(U)} (p_T) = \exp{-\int U(\xi,y)\theta(k_T - p_T)\;d\xi dy d\phi}
	\end{equation}
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_log_integrated_ubf), deferred :: log_integrated_ubf
	<<POWHEG matching: interfaces>>=
	abstract interface
	pure function sudakov_log_integrated_ubf (sudakov, pt2) result (y)
	import
	real(default) :: y
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	end function sudakov_log_integrated_ubf
	end interface

	@ %def sudakov_log_integrated_ubf
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_generate_xi_and_y_and_phi), deferred :: generate_xi_and_y_and_phi
	<<POWHEG matching: interfaces>>=
	abstract interface
	subroutine sudakov_generate_xi_and_y_and_phi (sudakov, r)
	import
	class(sudakov_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	end subroutine sudakov_generate_xi_and_y_and_phi
	end interface

	@ %def sudakov_generate_xi_and_y_and_phi
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_kt2), deferred :: kt2
	<<POWHEG matching: interfaces>>=
	abstract interface
	function sudakov_kt2 (sudakov, xi, y) result (kt2)
	import
	real(default) :: kt2
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	end function sudakov_kt2
	end interface

	@ %def sudakov_kt2
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_kt2_max), deferred :: kt2_max
	<<POWHEG matching: interfaces>>=
	abstract interface
	pure function sudakov_kt2_max (sudakov, s_hat) result (kt2_max)
	import
	real(default) :: kt2_max
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: s_hat
	end function sudakov_kt2_max
	end interface

	@ %def sudakov_kt2_max
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_reweight_ubf), deferred :: reweight_ubf
	<<POWHEG matching: interfaces>>=
	abstract interface
	function sudakov_reweight_ubf (sudakov, pt2) result (accepted)
	import
	logical :: accepted
	class(sudakov_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	end function sudakov_reweight_ubf
	end interface

	@ %def sudakov_reweight_ubf
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure (sudakov_reweight_xi_max), deferred :: reweight_xi_max
	<<POWHEG matching: interfaces>>=
	abstract interface
	function sudakov_reweight_xi_max (sudakov, xi) result (accepted)
	import
	logical :: accepted
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	end function sudakov_reweight_xi_max
	end interface

	@ %def sudakov_reweight_xi_max
	@ In the generation of $p_T^2$ via [[log_integrated_ubf]], we use the
	simplified version $\alpha_s^\text{rad}$ while the grids take the
	improved version.
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: alpha_s => sudakov_alpha_s
	<<POWHEG matching: procedures>>=
	function sudakov_alpha_s (sudakov, kT2, use_correct) result (a)
	real(default) :: a
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: kT2
	logical, intent(in), optional :: use_correct
	logical :: yorn
	yorn = .false.; if (present (use_correct)) yorn = use_correct
	if (yorn) then
	a = get_alpha (sudakov%qcd, kT2)
	else
	a = sudakov%alpha_s_rad (kT2)
	end if
	end function sudakov_alpha_s

	@ %def sudakov_alpha_s
	@ We have to solve the equation
	\begin{equation*}
	\frac{\log\Delta^{(U)} (p_T)}{\log\Delta^{(U)}(p_T^{\mathrm{max}}} = \log\Delta^{(U)}(p_T) = \log r_1
	\end{equation*}
	iteratively for $p_T$. If the current emission is not accepted, in the next step it is
	$\log\Delta^{(U)}(p_T^{\mathrm{max}}) = \log r_1$, so that we have to solve the equation
	\begin{equation*}
	\log\Delta^{(U)}(p_T) = \log r_1 + \log r_2
	\end{equation*}
	using the second random number $r_2$.
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: generate_pt2 => sudakov_generate_pt2
	<<POWHEG matching: procedures>>=
	function sudakov_generate_pt2 (sudakov) result (pt2)
	real(default) :: pt2
	class(sudakov_t), intent(inout) :: sudakov
	logical :: success
	success = .false.
	if (sudakov%current_pt2_max > sudakov%powheg_settings%pt2_min) then
	call sudakov%rng%generate (sudakov%random)
	sudakov%last_log = sudakov%last_log + log(sudakov%random)
	pt2 = solve_interval (sudakov, &
	sudakov%powheg_settings%pt2_min, &
	sudakov%current_pt2_max, success, &
	0.001_default)
	!sudakov%last_log = sudakov%norm_max * sudakov%log_integrated_ubf (pt2)
	!sudakov%last_log + &
	end if
	if (.not. success) then
	pt2 = sudakov%powheg_settings%pt2_min
	end if
	end function sudakov_generate_pt2

	@ %def sudakov_generate_pt2
	@ This could be activated [[if (debug_active (MATCHING))]].
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: check_solution_interval => sudakov_check_solution_interval
	<<POWHEG matching: procedures>>=
	subroutine sudakov_check_solution_interval (sudakov)
	class(sudakov_t), intent(inout) :: sudakov
	real(default) :: r
	real(default), parameter :: dr = 0.05
	real(default) :: pt2
	logical :: success
	r = 0._default
	do
	r = r + dr
	sudakov%random = r
	pt2 = solve_interval (sudakov, &
	sudakov%powheg_settings%pt2_min, &
	sudakov%current_pt2_max, success, &
	0.001_default)
	if (success) then
	print *, 'r: ', r, ' zero found'
	else
	print *, 'r: ', r, 'no zero found'
	end if
	if (r >= 1._default) exit
	end do
	end subroutine sudakov_check_solution_interval

	@ %def sudakov_check_solution_interval
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: generate_emission => sudakov_generate_emission
	<<POWHEG matching: procedures>>=
	subroutine sudakov_generate_emission (sudakov, r)
	class(sudakov_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	logical :: accepted
	sudakov%current_pt2_max = r%pt2
	call sudakov%generate_xi_and_y_and_phi (r)
	!sudakov%last_log = sudakov%norm_max * &
	!sudakov%log_integrated_ubf (sudakov%current_pt2_max)
	call msg_debug2 (D_MATCHING, "sudakov_generate_emission")
	call msg_debug2 (D_MATCHING, "sqrt (sudakov%current_pt2_max)", &
	sqrt (sudakov%current_pt2_max))
	call msg_debug2 (D_MATCHING, "sudakov%last_log", sudakov%last_log)
	LOOP_UNTIL_ACCEPTED: do
	if (signal_is_pending ()) return
	r%valid = .false.
	r%pt2 = sudakov%generate_pt2 ()
	call msg_debug2 (D_MATCHING, "sudakov_generate_emission: after generate_pt2")
	call msg_debug2 (D_MATCHING, "sqrt (r%pt2)", sqrt (r%pt2))
	call msg_debug2 (D_MATCHING, "sudakov%last_log", sudakov%last_log)
	if (r%pt2 <= sudakov%powheg_settings%pt2_min) then
	exit
	end if
	accepted = sudakov%reweight_ubf (r%pt2)
	call sudakov%veto_counter%record_ubf (.not. accepted)
	if (.not. accepted) then
	sudakov%current_pt2_max = r%pt2
	cycle
	end if
	accepted = sudakov%reweight_alpha_s (r%pt2)
	call sudakov%veto_counter%record_alpha_s (.not. accepted)
	if (.not. accepted) then
	sudakov%current_pt2_max = r%pt2
	cycle
	end if
	call sudakov%generate_xi_and_y_and_phi (r)
	accepted = sudakov%reweight_xi_max (r%xi)
	call sudakov%veto_counter%record_xi_max (.not. accepted)
	if (.not. accepted) then
	sudakov%current_pt2_max = r%pt2
	cycle
	end if
	if (debug_active (D_MATCHING)) then
	call assert_equal (OUTPUT_UNIT, r%pt2, &
	sudakov%kt2 (r%xi, r%y), &
	"sudakov_generate_xi_and_y_and_phi: pt2 inconsistency")
	! for this we have to recompute z?
	!call msg_bug ()
	end if
	r%valid = .true.
	exit
	end do LOOP_UNTIL_ACCEPTED
	end subroutine sudakov_generate_emission

	@ %def sudakov_generate_emission
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: evaluate => sudakov_evaluate
	<<POWHEG matching: procedures>>=
	function sudakov_evaluate (solver_f, x) result (f)
	complex(default) :: f
	class(sudakov_t), intent(in) :: solver_f
	real(default), intent(in) :: x
	f = solver_f%last_log + solver_f%norm_max * solver_f%log_integrated_ubf (x)
	!f = log (solver_f%random) + solver_f%norm_max * solver_f%log_integrated_ubf (x) &
	!- solver_f%last_log
	end function sudakov_evaluate

	@ %def sudakov_evaluate
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: associated_emitter => sudakov_associated_emitter
	<<POWHEG matching: procedures>>=
	elemental function sudakov_associated_emitter (sudakov) result (emitter)
	integer :: emitter
	class(sudakov_t), intent(in) :: sudakov
	emitter = sudakov%process_deps%phs_identifiers(sudakov%i_phs)%emitter
	end function sudakov_associated_emitter

	@ %def sudakov_associated_emitter
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: set_i_phs => sudakov_set_i_phs
	<<POWHEG matching: procedures>>=
	subroutine sudakov_set_i_phs (sudakov, alr)
	class(sudakov_t), intent(inout) :: sudakov
	integer, intent(in) :: alr
	sudakov%i_phs = sudakov%process_deps%alr_to_i_phs(alr)
	end subroutine sudakov_set_i_phs

	@ %def sudakov_set_i_phs
	@
	\subsubsection{Simple FSR}
	This corresponds to Appendix C of [[1002.2581]]
	<<POWHEG matching: public>>=
	public :: sudakov_simple_fsr_t
	<<POWHEG matching: types>>=
	type, extends (sudakov_t) :: sudakov_simple_fsr_t
	contains
	<<POWHEG matching: sudakov simple fsr: TBP>>
	end type sudakov_simple_fsr_t

	@ %def sudakov_simple_fsr_t
	@ The simplest upper bounding function for final-state radiation is
	\begin{equation}
	\mathtt{upper\_bound\_func} = \frac {U(\xi,y)} N
	= \frac {\alpha_s}{\xi (1-y)}
	\end{equation}
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: upper_bound_func => sudakov_simple_fsr_upper_bound_func
	<<POWHEG matching: procedures>>=
	pure function sudakov_simple_fsr_upper_bound_func (sudakov, xi, y, alpha_s) result (u)
	real(default) :: u
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	u = alpha_s / (xi * (1 - y))
	end function sudakov_simple_fsr_upper_bound_func

	@ %def sudakov_simple_fsr_upper_bound_func
	@ The above upper bounding function corresponds to the transverse momentum scale
	\begin{equation}
	k_T^2 = \frac{s}{2} \xi^2 (1-y).
	\end{equation}
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: kt2 => sudakov_simple_fsr_kt2
	<<POWHEG matching: procedures>>=
	function sudakov_simple_fsr_kt2 (sudakov, xi, y) result (kt2)
	real(default) :: kt2
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	kt2 = sudakov%phs_fks_generator%real_kinematics%kt2 &
	(sudakov%i_phs, sudakov%associated_emitter (), FSR_SIMPLE, xi, y)
	end function sudakov_simple_fsr_kt2

	@ %def sudakov_simple_fsr_kt2
	@ For massless emitters, the upper bound on the radiated energy is
	\begin{equation*}
	t_{\mathrm{max}} = \xi_{\mathrm{max}}^2 \hat{s}
	\end{equation*}
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: kt2_max => sudakov_simple_fsr_kt2_max
	<<POWHEG matching: procedures>>=
	pure function sudakov_simple_fsr_kt2_max (sudakov, s_hat) result (kt2_max)
	real(default) :: kt2_max
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: s_hat
	kt2_max = sudakov%xi2_max * s_hat
	end function sudakov_simple_fsr_kt2_max

	@ %def sudakov_simple_fsr_kt2_max
	@ This is
	\begin{equation}
	- \frac{\log{\Delta^{(U)}}(p_T)}{N} =
	\frac\pi{b_0} \theta\left(\xi_\text{max}^2-\frac{p_T^2}s\right)
	\left[\log{\frac{\xi^2_\text{max}s}{\Lambda^2}}
	\log{\frac{\log{{\xi^2_\text{max}s}/{\Lambda^2}}}
	{\log{p_T^2/\Lambda^2}}} -
	\log{\frac{\xi^2_\text{max}s}{p_T^2}}\right]
	\end{equation}
	with $p_\text{T,max}^2=\xi_\text{max}^2s$.
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: log_integrated_ubf => sudakov_simple_fsr_log_integrated_ubf
	<<POWHEG matching: procedures>>=
	pure function sudakov_simple_fsr_log_integrated_ubf (sudakov, pt2) result (y)
	real(default) :: y
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	real(default) :: xm2s, xm2sl, pt2l
	logical :: within_boundaries
	within_boundaries = pt2 / sudakov%event_deps%s_hat <= sudakov%xi2_max &
	.and. pt2 >= sudakov%powheg_settings%pt2_min
	if (within_boundaries) then
	xm2s = sudakov%xi2_max * sudakov%event_deps%s_hat
	xm2sl = xm2s / sudakov%process_deps%lambda2_gen
	pt2l = pt2 / sudakov%process_deps%lambda2_gen
	y = pi / b0rad * (log (xm2sl) * &
	log (log (xm2sl) / log (pt2l)) - &
	log (xm2s / pt2))
	else
	y = 0
	end if
	end function sudakov_simple_fsr_log_integrated_ubf

	@ %def sudakov_simple_fsr_log_integrated_ubf
	@ No further veto needed for this upper bounding function.
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: reweight_ubf => sudakov_simple_fsr_reweight_ubf
	<<POWHEG matching: procedures>>=
	function sudakov_simple_fsr_reweight_ubf (sudakov, pt2) result (accepted)
	logical :: accepted
	class(sudakov_simple_fsr_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	accepted = .true.
	end function sudakov_simple_fsr_reweight_ubf

	@ %def sudakov_simple_fsr_reweight_ubf
	@
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: reweight_xi_max => sudakov_simple_fsr_reweight_xi_max
	<<POWHEG matching: procedures>>=
	function sudakov_simple_fsr_reweight_xi_max (sudakov, xi) result (accepted)
	logical :: accepted
	class(sudakov_simple_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	accepted = .true.
	end function sudakov_simple_fsr_reweight_xi_max

	@ %def sudakov_simple_fsr_reweight_xi_max
	@ This depends on the choice of $p_T$ and is tested in the assertion.
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: generate_xi_and_y_and_phi => sudakov_simple_fsr_generate_xi_and_y_and_phi
	<<POWHEG matching: procedures>>=
	subroutine sudakov_simple_fsr_generate_xi_and_y_and_phi (sudakov, r)
	class(sudakov_simple_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: s
	s = sudakov%event_deps%s_hat
	call sudakov%generate_xi (r)
	r%y = one - (two * r%pt2) / (s * r%xi**2)
	call sudakov%rng%generate (sudakov%random)
	r%phi = sudakov%random * twopi
	end subroutine sudakov_simple_fsr_generate_xi_and_y_and_phi

	@ %def sudakov_generate_xi_and_y_and_phi
	@ Generate $\xi \in [\frac{p_\text{T}}{\sqrt{s}}, \xi_\text{max}]$
	with a density $1 / \xi$
	<<POWHEG matching: sudakov simple fsr: TBP>>=
	procedure :: generate_xi => sudakov_simple_fsr_generate_xi
	<<POWHEG matching: procedures>>=
	subroutine sudakov_simple_fsr_generate_xi (sudakov, r)
	class(sudakov_simple_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: s, xi2_max
	s = sudakov%event_deps%s_hat
	xi2_max = sudakov%xi2_max
	call sudakov%rng%generate (sudakov%random)
	r%xi = exp (((one - sudakov%random) * log (r%pt2 / s) + &
	sudakov%random * log (xi2_max)) / two)
	end subroutine sudakov_simple_fsr_generate_xi

	@ %def sudakov_simple_fsr_generate_xi
	@
	\subsubsection{Dijet production at lepton colliders}
	In the POWHEG method paper, this is done for $e^+e^-\to q\bar{q}$.
	There $k_\text{max}=q^0/2=\sqrt{s}/2$. We slightly extend this to
	<<POWHEG matching: public>>=
	public :: sudakov_eeqq_fsr_t
	<<POWHEG matching: types>>=
	type, extends (sudakov_t) :: sudakov_eeqq_fsr_t
	contains
	<<POWHEG matching: sudakov eeqq fsr: TBP>>
	end type sudakov_eeqq_fsr_t

	@ %def sudakov_eeqq_fsr_t
	@ This $k_T$ measure is the same as the simple FSR up to
	$\mathcal{O}(\theta^4)$ when $y=\cos\theta$.
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: kt2 => sudakov_eeqq_fsr_kt2
	<<POWHEG matching: procedures>>=
	function sudakov_eeqq_fsr_kt2 (sudakov, xi, y) result (kt2)
	real(default) :: kt2
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	kt2 = sudakov%event_deps%s_hat / 2 * xi*2 (1 - y**2) / 2
	! TODO: (bcn 2015-07-13) call here phs_fks_generator%real_kinematics%kt2
	end function sudakov_eeqq_fsr_kt2

	@ %def sudakov_eeqq_fsr_kt2
	@ Same expression as for [[sudakov_simple_fsr_kt2_max]]
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: kt2_max => sudakov_eeqq_fsr_kt2_max
	<<POWHEG matching: procedures>>=
	pure function sudakov_eeqq_fsr_kt2_max (sudakov, s_hat) result (kt2_max)
	real(default) :: kt2_max
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: s_hat
	kt2_max = sudakov%xi2_max * s_hat
	end function sudakov_eeqq_fsr_kt2_max

	@ %def sudakov_eeqq_fsr_kt2_max
	@ This covers also the singularity at $(\xi,y)\to(1,-1)$ that occurs for
	a massless recoiling system.
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: upper_bound_func => sudakov_eeqq_fsr_upper_bound_func
	<<POWHEG matching: procedures>>=
	pure function sudakov_eeqq_fsr_upper_bound_func (sudakov, xi, y, alpha_s) result (u)
	real(default) :: u
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	u = alpha_s / (xi * (1 - y**2))
	end function sudakov_eeqq_fsr_upper_bound_func

	@ %def sudakov_eeqq_fsr_upper_bound_func
	@
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: log_integrated_ubf => sudakov_eeqq_fsr_log_integrated_ubf
	<<POWHEG matching: procedures>>=
	pure function sudakov_eeqq_fsr_log_integrated_ubf (sudakov, pt2) result (y)
	real(default) :: y
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	logical :: within_boundaries
	within_boundaries = pt2 / sudakov%event_deps%s_hat <= sudakov%xi2_max &
	.and. pt2 >= sudakov%powheg_settings%pt2_min
	if (within_boundaries) then
	!xm2s = sudakov%xi2_max * sudakov%event_deps%s_hat
	!xm2sl = xm2s / sudakov%process_deps%lambda2_gen
	!pt2l = pt2 / sudakov%process_deps%lambda2_gen
	!y = pi / b0rad * (log (xm2sl) * &
	!log (log (xm2sl) / log (pt2l)) - &
	!log (xm2s / pt2))
	else
	y = 0
	end if
	end function sudakov_eeqq_fsr_log_integrated_ubf

	@ %def sudakov_eeqq_fsr_log_integrated_ubf
	@
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: reweight_ubf => sudakov_eeqq_fsr_reweight_ubf
	<<POWHEG matching: procedures>>=
	function sudakov_eeqq_fsr_reweight_ubf (sudakov, pt2) result (accepted)
	logical :: accepted
	class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	accepted = .false.
	end function sudakov_eeqq_fsr_reweight_ubf

	@ %def sudakov_eeqq_fsr_reweight_ubf
	@
	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: reweight_xi_max => sudakov_eeqq_fsr_reweight_xi_max
	<<POWHEG matching: procedures>>=
	function sudakov_eeqq_fsr_reweight_xi_max (sudakov, xi) result (accepted)
	logical :: accepted
	class(sudakov_eeqq_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	accepted = .true.
	end function sudakov_eeqq_fsr_reweight_xi_max

	@ %def sudakov_eeqq_fsr_reweight_xi_max

	<<POWHEG matching: sudakov eeqq fsr: TBP>>=
	procedure :: generate_xi_and_y_and_phi => sudakov_eeqq_fsr_generate_xi_and_y_and_phi
	<<POWHEG matching: procedures>>=
	subroutine sudakov_eeqq_fsr_generate_xi_and_y_and_phi (sudakov, r)
	class(sudakov_eeqq_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: s
	s = sudakov%event_deps%s_hat
	!r%xi = sudakov%generate_xi (r)
	!r%y = one - (two * r%pt2) / (s * r%xi**2)
	call sudakov%rng%generate (sudakov%random)
	r%phi = sudakov%random * twopi
	end subroutine sudakov_eeqq_fsr_generate_xi_and_y_and_phi

	@ %def sudakov_generate_xi_and_y_and_phi
	@
	\subsubsection{Massive FSR}
	<<POWHEG matching: public>>=
	public :: sudakov_massive_fsr_t
	<<POWHEG matching: types>>=
	type, extends (sudakov_t) :: sudakov_massive_fsr_t
	real(default) :: z, z1, z2 = 0._default
	real(default) :: xi_1, xi_min, xi_m = 0._default
	real(default) :: xi_max_extended = 1._default
	contains
	<<POWHEG matching: sudakov massive fsr: TBP>>
	end type sudakov_massive_fsr_t

	@ %def sudakov_massive_fsr_t
	@ During the radiation generation, an alternative expression for $\xi_{\mathrm{max}}$,
	\begin{equation*}
	\xi_{\mathrm{max}} = 1 - \frac{(m+m_{\mathrm{rec}})^2}{q^2},
	\end{equation*}
	is used, which corresponds to an extenden Dalitz region. Phase space points outside of
	the original Dalitz region will be vetoed afterwards.
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: compute_xi_max_extended &
	=> sudakov_massive_fsr_compute_xi_max_extended
	<<POWHEG matching: procedures>>=
	subroutine sudakov_massive_fsr_compute_xi_max_extended (sudakov, i_phs)
	class(sudakov_massive_fsr_t), intent(inout) :: sudakov
	integer, intent(in) :: i_phs
	real(default) :: m, mrec
	real(default) :: q0
	type(vector4_t) :: p
	q0 = sqrt(sudakov%event_deps%s_hat)
	p = sudakov%event_deps%p_born_lab%get_momentum (1, sudakov%associated_emitter())
	m = p**1
	mrec = sqrt ((q0 - p%p(0))2 - p%p(1)2 - p%p(2)2 - p%p(3)2)
	sudakov%xi_max_extended = one - (m + mrec)2 / q02
	end subroutine sudakov_massive_fsr_compute_xi_max_extended

	@ %def sudakov_massive_fsr_compute_xi_max_extended
	@ For massive emitters, the radiation variable $\xi$ is constructed as follows. First,
	\begin{equation}
	\xi_{\mathrm{min}}(k_T^2)
	= \frac{\sqrt{k_T^2 \left(k_T^2z_2^2 + 8\bar{p}^0q(1-z_2\right)} - k_T^2z_2}{2q^2(1-z_2)}
	\end{equation}
	is computed. Then $\xi_1$ is computed according to the same equation with $z_2 \leftrightarrow z_1$.
	Finally, $\xi$ is generated according to
	\begin{equation}
	\xi = \frac{1}{q^2}\exp\left[\log\left(\xi_{\rm{min}}q^2-k_T^2\right)
	+ r\log\frac{\xi_m q^2 - k_T^2}{\xi_{\rm{min}}q^2-k_T^2} + k_T^2\right],
	\end{equation}
	where $\xi_m = \rm{min}\left(\xi_{\rm{max}}, \xi_1\right)$.
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: generate_xi => sudakov_massive_fsr_generate_xi
	<<POWHEG matching: procedures>>=
	subroutine sudakov_massive_fsr_generate_xi (sudakov, r)
	class(sudakov_massive_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: pt2, q0, q02
	real(default) :: E_em, xi_max
	real(default) :: xi_1, xi_min, xi_m
	pt2 = r%pt2
	E_em = sudakov%event_deps%p_born_lab%get_energy &
	(1, sudakov%associated_emitter())
	q02 = sudakov%event_deps%s_hat; q0 = sqrt(q02)
	!xi_max = sqrt (sudakov%xi2_max)
	xi_max = sudakov%xi_max_extended
	associate (z1 => sudakov%z1, z2 => sudakov%z2)
	xi_1 = (sqrt(pt2 * (pt2 * z1*2 + 8 E_em * q0 * (one - z1))) - pt2 * z1) / &
	(two * q02 * (one - z1))
	xi_min = (sqrt(pt2 * (pt2 * z2*2 + 8 E_em * q0 * (one - z2))) - pt2 * z2) / &
	(two * q02 * (one - z2))
	end associate
	xi_m = min (xi_max, xi_1)
	call sudakov%rng%generate (sudakov%random)
	r%xi = (exp (log(xi_min * q02 - pt2) + sudakov%random * &
	log((xi_m * q02 - pt2) / (xi_min * q02 - pt2))) + pt2) / q02
	end subroutine sudakov_massive_fsr_generate_xi

	@ %def sudakov_massive_fsr_generate_xi
	@
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: generate_xi_and_y_and_phi => sudakov_massive_fsr_generate_xi_and_y_and_phi
	<<POWHEG matching: procedures>>=
	subroutine sudakov_massive_fsr_generate_xi_and_y_and_phi (sudakov, r)
	class(sudakov_massive_fsr_t), intent(inout) :: sudakov
	type(radiation_t), intent(inout) :: r
	real(default) :: q0
	real(default) :: m2, mrec2, k0_rec_max
	real(default) :: E_em
	type(vector4_t) :: p_emitter

	q0 = sqrt (sudakov%event_deps%s_hat)
	p_emitter = sudakov%event_deps%p_born_lab%get_momentum &
	(1, sudakov%associated_emitter())
	associate (p => p_emitter%p)
	mrec2 = (q0 - p(0))2 - p(1)2 - p(2)2 - p(3)2
	E_em = p(0)
	end associate
	m2 = p_emitter**2
	call compute_dalitz_bounds (q0, m2, mrec2, sudakov%z1, sudakov%z2, k0_rec_max)
	call sudakov%generate_xi (r)

	sudakov%z = (two * r%pt2 * E_em - r%xi*2 q0**3) / &
	(r%pt2 * r%xi * q0 - r%xi*2 q0**3)
	sudakov%xi2_max = - (q0*2 sudakov%z*2 - two q0 * k0_rec_max * sudakov%z + mrec2) / &
	(q0*2 sudakov%z * (one - sudakov%z))
	sudakov%xi2_max = sudakov%xi2_max**2
	r%y = two * (sudakov%z2 - sudakov%z) / (sudakov%z2 - sudakov%z1) - one
	call sudakov%rng%generate (sudakov%random)
	r%phi = sudakov%random * twopi
	end subroutine sudakov_massive_fsr_generate_xi_and_y_and_phi

	@ %def sudakov_massive_fsr_generate_xi_and_y_and_phi
	@ Computes the hardness scale:
	\begin{equation}
	K_T^2 = \frac{\xi^2q^2(1-z)}{2\bar{p}_{\rm{em}}^0 - z\xi q}
	\label{HardnessMassiveFSR}
	\end{equation}
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: kt2 => sudakov_massive_fsr_kt2
	<<POWHEG matching: procedures>>=
	function sudakov_massive_fsr_kt2 (sudakov, xi, y) result (kt2)
	real(default) :: kt2
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y
	kt2 = sudakov%phs_fks_generator%real_kinematics%kt2 &
	(sudakov%i_phs, sudakov%associated_emitter(), FSR_MASSIVE, xi, y)
	end function sudakov_massive_fsr_kt2

	@ %def sudakov_massive_fsr_kt2
	@ For massive emitters, the upper bound on the radiated $p_T$ is
	\begin{equation*}
	t_{\mathrm{max}} = \frac{\xi_{\mathrm{max}}^2q^3(1-z_2)}{2*\bar{p}^0 - z_2\xi_{\mathrm{max}}q}
	\end{equation*}
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: kt2_max => sudakov_massive_fsr_kt2_max
	<<POWHEG matching: procedures>>=
	pure function sudakov_massive_fsr_kt2_max (sudakov, s_hat) result (kt2_max)
	real(default) :: kt2_max
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: s_hat
	real(default) :: q, E_em, xi_max, z2
	q = sqrt(s_hat)
	E_em = sudakov%event_deps%p_born_lab%get_energy &
	(1, sudakov%associated_emitter())
	xi_max = sudakov%xi_max_extended
	z2 = sudakov%z2
	kt2_max = (xi_max*2 q*3 (one - z2)) / (two * E_em - z2 * xi_max * q)
	end function sudakov_massive_fsr_kt2_max

	@ %def sudakov_massive_fsr_kt2_max
	@ The upper bounding function for massive emitters is (disregarding a possible factor of $\alpha_s$)
	\begin{equation}
	U(\xi, y) \sim \frac{\sqrt{s}}{\bar{p}_{\rm{em}}} \frac{1}{\xi(1-z)}
	\label{UBFMassiveFSR}
	\end{equation}
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: upper_bound_func => sudakov_massive_fsr_upper_bound_func
	<<POWHEG matching: procedures>>=
	pure function sudakov_massive_fsr_upper_bound_func (sudakov, xi, y, alpha_s) result (u)
	real(default) :: u
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi, y, alpha_s
	real(default) :: q, p_em
	q = sqrt (sudakov%event_deps%s_hat)
	p_em = space_part_norm &
	(sudakov%event_deps%p_born_lab%get_momentum (1, &
	sudakov%associated_emitter()))
	u = alpha_s * q / p_em * one / (xi * (one - sudakov%z))
	end function sudakov_massive_fsr_upper_bound_func

	@ %def sudakov_massive_fsr_upper_bound_func
	@ The integrated upper-bounding function for massive final-state emitters is given by
	\begin{align*}
	I(t) &= \frac{q}{\bar{p}_{\rm{em}}}\left[\log\xi\log\left[(1-z_2)\frac{q}{k_T^2}\right] +
	\frac{1}{2} \log^2\xi + G(-k_T^2,q^2,\xi) - G(2\bar{p}_{\rm{em}},-q,\xi)\right]
	^{\rm{min}(\xi_1(k_T^2),\xi_{\rm{max}}}_{\xi_{\rm{min}}}) \\
	&+ \frac{q}{\bar{p}_{\rm{em}}} \theta (\xi_{\rm{max}} - \xi_1(k_T^2))
	\log\frac{\xi_{\rm{max}}}{\xi_1(k_T^2)}\log\frac{1-z_2}{1-z_1},
	\end{align*}
	where the function $G(a,b,\xi)$ is given by
	\begin{equation}
	G(a,b,\xi) = \log(a+b\xi)\log\left(1-\frac{a+b\xi}{a}\right) + Li_2\left(\frac{a+b\xi}{a}\right),
	\label{GMinusMassiveFSR}
	\end{equation}
	for $a < 0$ and by
	\begin{equation}
	G(a,b,\xi) = \log\left\|\frac{b\xi}{a}\right\|\log a - Li_2\left(-\frac{b\xi}{a}\right) + \frac{\pi^2}{6},
	\label{GPlusMassiveFSR}
	\end{equation}
	for $a > 0$.
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: log_integrated_ubf => sudakov_massive_fsr_log_integrated_ubf
	<<POWHEG matching: procedures>>=
	pure function sudakov_massive_fsr_log_integrated_ubf (sudakov, pt2) result (y)
	real(default) :: y
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: pt2
	real(default) :: xi, xi_max, xi_1, xi_min
	real(default) :: q0, p_em, E_em
	real(default) :: y1, y2
	q0 = sqrt (sudakov%event_deps%s_hat)
	E_em = sudakov%event_deps%p_born_lab%get_energy &
	(1, sudakov%associated_emitter())
	p_em = space_part_norm &
	(sudakov%event_deps%p_born_lab%get_momentum (1, sudakov%associated_emitter()))
	xi_max = sudakov%xi_max_extended
	associate (z1 => sudakov%z1, z2 => sudakov%z2)
	xi_1 = (sqrt (pt2 * (pt2 * z1*2 + 8 E_em * q0 * (one - z1))) - pt2 * z1) / &
	(two * q0*2 (one - z1))
	xi_min = (sqrt (pt2 * (pt2 * z2*2 + 8 E_em * q0 * (one - z2))) - pt2 * z2) / &
	(two * q0*2 (one - z2))
	xi = min (xi_1, xi_max)
	y1 = log(xi) * log((one - z2) * q0 / pt2) + log(xi)**2 / two + &
	G_FSR(-pt2,q0*2, xi) - G_FSR(two E_em, -q0, xi)
	xi = xi_min
	y2 = log(xi) * log((one - z2) * q0 / pt2) + log(xi)**2/two + &
	G_FSR(-pt2, q0*2, xi) - G_FSR(two E_em, -q0, xi)
	y = y1 - y2
	if (xi_max > xi_1) &
	y = y + log(xi_max / xi_1) * log((one - z2) / (one - z1))
	y = twopi * q0 / p_em * y
	end associate
	end function sudakov_massive_fsr_log_integrated_ubf

	@ %def sudakov_massive_fsr_log_integrated_ubf
	@ No further ubf veto needed for now.
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: reweight_ubf => sudakov_massive_fsr_reweight_ubf
	<<POWHEG matching: procedures>>=
	function sudakov_massive_fsr_reweight_ubf (sudakov, pt2) result (accepted)
	logical :: accepted
	class(sudakov_massive_fsr_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	accepted = .true.
	end function sudakov_massive_fsr_reweight_ubf

	@ %def sudakov_massive_fsr_reweight_ubf
	@
	<<POWHEG matching: sudakov massive fsr: TBP>>=
	procedure :: reweight_xi_max => sudakov_massive_fsr_reweight_xi_max
	<<POWHEG matching: procedures>>=
	function sudakov_massive_fsr_reweight_xi_max (sudakov, xi) result (accepted)
	logical :: accepted
	class(sudakov_massive_fsr_t), intent(in) :: sudakov
	real(default), intent(in) :: xi
	accepted = xi < sqrt (sudakov%xi2_max)
	end function sudakov_massive_fsr_reweight_xi_max

	@ %def sudakov_massive_fsr_reweight_xi_max
	@
	\subsubsection{Auxiliary functions}
	Implements the function $G(a,b,\xi)$ given in eq. (\ref{GPlusMassiveFSR}) and eq. (\ref{GMinusMassiveFSR}).
	<<POWHEG matching: procedures>>=
	elemental function G_FSR (a,b,xi)
	real(default) :: G_FSR
	real(default), intent(in) :: a, b, xi
	if (a > 0) then
	G_FSR = G_FSR_Plus (a,b,xi)
	else if (a < 0) then
	G_FSR = G_FSR_Minus (a,b,xi)
	!!! a == 0 ?
	end if
	end function G_FSR

	elemental function G_FSR_Minus (a,b,xi)
	real(default) :: G_FSR_Minus
	real(default), intent(in) :: a, b, xi
	G_FSR_Minus = log(a+bxi)log(one - (a+bxi)/a) + Li2((a+bxi)/a)
	end function G_FSR_Minus

	elemental function G_FSR_Plus (a,b,xi)
	real(default) :: G_FSR_Plus
	real(default), intent(in) :: a, b, xi
	G_FSR_Plus = log(abs(bxi/a))log(a) - Li2(-bxi/a) + pi*2/6
	end function G_FSR_Plus

	@ %def G_FSR, G_FSR_Minus, G_FSR_Plus
	@
	\subsection{Main POWHEG class}
	<<POWHEG matching: public>>=
	public :: powheg_matching_t
	<<POWHEG matching: types>>=
	type, extends(matching_t) :: powheg_matching_t
	type(grid_t) :: grid
	type(phs_fks_generator_t) :: phs_fks_generator
	type(powheg_settings_t) :: settings
	type(event_deps_t) :: event_deps
	type(process_deps_t) :: process_deps
	type(sudakov_wrapper_t), dimension(:), allocatable :: sudakov
	integer :: n_emissions = 0
	logical :: active = .true.
	contains
	<<POWHEG matching: powheg matching: TBP>>
	end type powheg_matching_t

	@ %def powheg_matching_t
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: get_method => powheg_matching_get_method
	<<POWHEG matching: procedures>>=
	function powheg_matching_get_method (matching) result (method)
	type(string_t) :: method
	class(powheg_matching_t), intent(in) :: matching
	method = matching_method (MATCH_POWHEG)
	end function powheg_matching_get_method

	@ %def powheg_matching_get_method
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: before_shower => powheg_matching_before_shower
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_before_shower &
	(matching, particle_set, vetoed)
	class(powheg_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	call msg_debug2 (D_MATCHING, "powheg_matching_before_shower")
	if (signal_is_pending ()) return
	if (.not. matching%active) return
	call matching%update (particle_set)
	if (matching%settings%test_sudakov) then
	call matching%test_sudakov ()
	stop
	end if
	if (.not. matching%settings%disable_sudakov) &
	call matching%generate_emission (particle_set = particle_set)
	vetoed = .false.
	end subroutine powheg_matching_before_shower

	@ %def powheg_matching_before_shower
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: first_event => powheg_matching_first_event
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_first_event (matching)
	class(powheg_matching_t), intent(inout), target :: matching
	associate (instance => matching%process_instance)
	matching%process_deps%cm_frame = instance%is_cm_frame (1)
	end associate
	call matching%setup_grids ()
	end subroutine powheg_matching_first_event

	@ %def powheg_matching_first_event
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: after_shower => powheg_matching_after_shower
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_after_shower (matching, particle_set, vetoed)
	class(powheg_matching_t), intent(inout) :: matching
	type(particle_set_t), intent(inout) :: particle_set
	logical, intent(out) :: vetoed
	vetoed = .false.
	end subroutine powheg_matching_after_shower

	@ %def powheg_matching_after_shower
	@
	\subsubsection{Output}
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: display_grid_startup_message => &
	powheg_display_grid_startup_message
	<<POWHEG matching: procedures>>=
	subroutine powheg_display_grid_startup_message (powheg)
	class(powheg_matching_t), intent(in) :: powheg
	real(default) :: points_per_cell
	write (msg_buffer, "(A,A,A)") "POWHEG: Generating grid for process '", &
	char (powheg%process_name), "'"
	call msg_message ()
	associate (settings => powheg%settings)
	write (msg_buffer, "(A,I10)") "Number of xi-points: ", &
	settings%size_grid_xi
	call msg_message ()
	write (msg_buffer, "(A,I10)") "Number of y-points: ", &
	settings%size_grid_y
	call msg_message ()
	write (msg_buffer, "(A,I10,A)") "Using ", settings%n_init , &
	" sampling points"
	call msg_message ()
	points_per_cell = settings%n_init*one / &
	(settings%size_grid_xi * settings%size_grid_y)
	write (msg_buffer, "(A,F10.2,A)") "Average: ", points_per_cell, &
	" points per cell"
	call msg_message ()
	call msg_message ("Progress:")
	end associate
	end subroutine powheg_display_grid_startup_message

	@ %def powheg_display_grid_startup_message
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: write => powheg_write
	<<POWHEG matching: procedures>>=
	subroutine powheg_write (matching, unit)
	class(powheg_matching_t), intent(in) :: matching
	integer, intent(in), optional :: unit
	integer :: u, alr
	u = given_output_unit (unit); if (u < 0) return
	call write_separator (u, 2)
	write (u, "(1X,A)") "POWHEG Emission Generator"
	write (u, "(1X,A)") "Process name: " // char (matching%process_name)
	if (allocated (matching%rng)) then
	call matching%rng%write (u)
	else
	write (u, "(1X,A)") "RNG not allocated"
	end if
	if (associated (matching%qcd)) then
	call matching%qcd%write (u)
	else
	write (u, "(1X,A)") "QCD not associated"
	end if
	call matching%settings%write (u)
	call matching%event_deps%write (u)
	call matching%process_deps%write (u)
	do alr = 1, size (matching%sudakov)
	call write_separator (u)
	write (u, "(1X,A,I12,A)") "sudakov (alr = ", alr, ")"
	call matching%sudakov(alr)%s%write (u)
	end do
	call write_separator (u, 2)
	end subroutine powheg_write

	@ %def powheg_write
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: final => powheg_matching_final
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_final (matching)
	class(powheg_matching_t), intent(in) :: matching
	integer :: u, alr
	type(string_t) :: filename
	u = free_unit ()
	filename = matching%process_name // "_veto.log"
	open (file=char(filename), unit=u, action='write')
	write (u, '(A)') "Summary of POWHEG veto procedure"
	do alr = 1, matching%process_deps%n_alr
	write(u,'(A,I0)') 'alr: ', alr
	call matching%sudakov(alr)%s%veto_counter%write (u)
	call write_separator (u)
	end do
	write (u,'(A,I0)') "Total number of events which radiate a gluon: ", &
	matching%n_emissions
	close (u)
	end subroutine powheg_matching_final

	@ %def powheg_matching_final
	@
	\subsubsection{Initialization and Finalization}
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: setup_grids => powheg_matching_setup_grids
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_setup_grids (matching)
	class(powheg_matching_t), intent(inout), target :: matching
	call matching%prepare_for_events ()
	if (matching%requires_new_grids ()) then
	call matching%fill_grids ()
	call matching%save_grids ()
	else
	call matching%load_grids ()
	end if
	call matching%grid%compute_and_write_mean_and_max ()
	call matching%import_norms_from_grid ()
	end subroutine powheg_matching_setup_grids

	@ %def powheg_matching_setup_grids
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: setup_sudakovs => powheg_matching_setup_sudakovs
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_setup_sudakovs (powheg)
	class(powheg_matching_t), intent(inout), target :: powheg
	integer :: alr
	logical :: is_fsr, is_massive
	integer :: ubf_type
	allocate (powheg%sudakov (powheg%process_deps%n_alr))
	is_fsr = .true.
	do alr = 1, powheg%process_deps%n_alr
	if (is_fsr) then
	ubf_type = powheg%settings%upper_bound_func
	select type (pcm => powheg%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	is_massive = powheg%phs_fks_generator%is_massive &
	(config%region_data%get_emitter (alr))
	end select
	end select
	if (is_massive) ubf_type = UBF_MASSIVE
	select case (ubf_type)
	case (UBF_SIMPLE)
	allocate (sudakov_simple_fsr_t :: powheg%sudakov(alr)%s)
	case (UBF_EEQQ)
	allocate (sudakov_eeqq_fsr_t :: powheg%sudakov(alr)%s)
	case (UBF_MASSIVE)
	allocate (sudakov_massive_fsr_t :: powheg%sudakov(alr)%s)
	case default
	call msg_fatal ("powheg_setup_sudakovs: Please choose upper bounding function!")
	end select
	else
	call msg_fatal ("powheg_setup_sudakovs: ISR not implemented yet!")
	end if
	if (allocated (powheg%rng)) then
	!!! generator mode
	call powheg%sudakov(alr)%s%init (powheg%process_deps, &
	powheg%event_deps, powheg%settings, &
	powheg%qcd, powheg%phs_fks_generator, powheg%rng)
	else
	!!! lookup mode
	call powheg%sudakov(alr)%s%init (powheg%process_deps, &
	powheg%event_deps, powheg%settings, &
	powheg%qcd, powheg%phs_fks_generator)
	end if

	call powheg%sudakov(alr)%s%set_i_phs (alr)
	end do
	end subroutine powheg_matching_setup_sudakovs

	@ %def powheg_matching_setup_sudakovs
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: init => powheg_matching_init
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_init (matching, var_list, process_name)
	class(powheg_matching_t), intent(out) :: matching
	<<default matching init>>
	end subroutine powheg_matching_init

	@ %def powheg_matching_init
	@
	<<POWHEG matching: powheg matching: TBP>>=
	generic :: update => update_momenta, &
	update_particle_set
	procedure :: update_momenta => powheg_matching_update_momenta
	procedure :: update_particle_set => powheg_matching_update_particle_set
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_update_momenta (powheg, p_born)
	class(powheg_matching_t), intent(inout) :: powheg
	type(vector4_t), dimension(:), intent(in) :: p_born
	type(lorentz_transformation_t) :: lt_lab_to_cms
	real(default) :: sqme_born

	sqme_born = powheg%process_instance%get_sqme (powheg%process_deps%i_born)
	if (.not. powheg%process_deps%cm_frame) then
	lt_lab_to_cms = powheg%process_instance%get_boost_to_cms (1)
	call powheg%update_event_deps (sqme_born, p_born, lt_lab_to_cms)
	else
	call powheg%update_event_deps (sqme_born, p_born)
	end if
	end subroutine powheg_matching_update_momenta

	subroutine powheg_matching_update_particle_set (powheg, particle_set)
	class(powheg_matching_t), intent(inout) :: powheg
	type(particle_set_t), intent(in) :: particle_set
	integer, dimension(:), allocatable :: indices
	logical, dimension(:), allocatable :: in_out_mask
	integer :: i
	allocate (in_out_mask (particle_set%get_n_tot()))
	do i = 1, particle_set%get_n_tot()
	in_out_mask(i) = particle_set%prt(i)%get_status () == PRT_INCOMING &
	.or. particle_set%prt(i)%get_status () == PRT_OUTGOING
	end do
	allocate (indices (size (particle_set%get_indices (in_out_mask))))
	indices = particle_set%get_indices (in_out_mask)
	call powheg%update_momenta (particle_set%get_momenta (indices))
	end subroutine powheg_matching_update_particle_set

	@ %def powheg_matching_update
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: update_event_deps => powheg_matching_update_event_deps
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_update_event_deps (powheg, sqme_born, p_born, lt_lab_to_cms)
	class(powheg_matching_t), intent(inout) :: powheg
	real(default), intent(in) :: sqme_born
	type(vector4_t), dimension(:), intent(in) :: p_born
	type(lorentz_transformation_t), intent(in), optional :: lt_lab_to_cms
	call powheg%event_deps%update (sqme_born, p_born, lt_lab_to_cms)
	end subroutine powheg_matching_update_event_deps

	@ %def powheg_matching_update_event_deps
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: boost_preal_to_lab_frame => powheg_matching_boost_preal_to_lab_frame
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_boost_preal_to_lab_frame (powheg, i_phs)
	class(powheg_matching_t), intent(inout) :: powheg
	type(lorentz_transformation_t) :: lt_cms_to_lab
	integer, intent(in) :: i_phs
	associate (event_deps => powheg%event_deps)
	if (powheg%process_deps%cm_frame) then
	event_deps%p_real_lab%phs_point(i_phs) = event_deps%p_real_cms%phs_point(i_phs)
	else
	lt_cms_to_lab = powheg%process_instance%get_boost_to_lab (1)
	event_deps%p_real_lab%phs_point(i_phs) = &
	lt_cms_to_lab * event_deps%p_real_cms%phs_point(i_phs)
	end if
	end associate
	end subroutine powheg_matching_boost_preal_to_lab_frame

	@ %def powheg_matching_boost_preal_to_lab_frame
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: reweight_matrix_elements => powheg_matching_reweight_matrix_elements
	<<POWHEG matching: procedures>>=
	function powheg_matching_reweight_matrix_elements (powheg, r) result (accepted)
	logical :: accepted
	class(powheg_matching_t), intent(inout) :: powheg
	type(radiation_t), intent(in) :: r
	integer :: emitter, i_phs
	real(default) :: sqme_real_x_jacobian, sqme_born
	real(default) :: norm, ubf, ubound, random, weight
	real(default) :: alpha_s
	call msg_debug (D_MATCHING, "reweight_matrix_elements")
	select type (pcm => powheg%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	call powheg%rng%generate (random)
	i_phs = powheg%process_deps%alr_to_i_phs (r%alr)
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	emitter = config%region_data%get_emitter (r%alr)
	end select
	call powheg%phs_fks_generator%generate_fsr_from_xi_and_y (r%xi, r%y, &
	r%phi, emitter, i_phs, powheg%event_deps%p_born_cms%get_momenta(1), &
	powheg%event_deps%p_real_cms%phs_point(i_phs)%p)
	call powheg%boost_preal_to_lab_frame (i_phs)
	call powheg%copy_momenta ()
	norm = powheg%norm_from_xi_and_y (r)
	associate (s => powheg%sudakov(r%alr)%s)
	alpha_s = s%alpha_s (s%kt2 (r%xi, r%y), use_correct=.true.)
	ubf = s%upper_bound_func (r%xi, r%y, alpha_s)
	sqme_real_x_jacobian = powheg%compute_sqme_real (r%alr, alpha_s)
	sqme_born = powheg%event_deps%sqme_born
	ubound = sqme_born * ubf * norm
	weight = sqme_real_x_jacobian / ubound
	if (weight > 1) call s%veto_counter%record_fail()
	if (debug_active (D_MATCHING)) then
	if (weight < 0) call msg_warning ("R/B < 0!")
	end if
	accepted = random < weight
	end associate
	if (debug_active (D_MATCHING)) then
	print *, ' r%alr = ', r%alr
	print *, ' r%xi = ', r%xi
	print *, ' r%y = ', r%y
	print *, ' emitter = ', emitter
	print *, ' random = ', random
	print *, ' sqme_real_x_jacobian = ', sqme_real_x_jacobian
	print *, ' sqme_born = ', sqme_born
	print *, ' ubf = ', ubf
	print *, ' norm = ', norm
	print *, ' ubound = ', ubound
	print *, ' matrix element accepted = ', accepted
	end if
	end select
	end function powheg_matching_reweight_matrix_elements

	@ %def powheg_matching_reweight_matrix_element
	@
	\subsubsection{Generation algorithm and grid initialization}
	[[compute_sqme_real]] is the projected real matrix element
	$R_{\alpha_r} = S_{\alpha_r} R$ whereby the current $\alpha_r$ is
	implied by the [[emitter]]. Furthermore, it is multiplied by the
	Jacobian.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: compute_sqme_real => powheg_matching_compute_sqme_real
	<<POWHEG matching: procedures>>=
	function powheg_matching_compute_sqme_real (powheg, alr, alpha_s) result (sqme)
	real(default) :: sqme
	class(powheg_matching_t), intent(inout) :: powheg
	integer, intent(in) :: alr
	real(default), intent(in) :: alpha_s
	integer :: i_phs, i_term
	select type (pcm => powheg%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	i_phs = powheg%process_deps%alr_to_i_phs (alr)
	i_term = powheg%process_deps%i_real(i_phs)
	associate (instance => powheg%process_instance)
	call instance%compute_sqme_rad (i_term, i_phs, .false., alpha_s)
	sqme = instance%get_sqme (i_term)
	end associate
	end select
	end function powheg_matching_compute_sqme_real

	@ %def powheg_matching_compute_sqme_real
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: set_scale => powheg_matching_set_scale
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_set_scale (powheg, pT2)
	class(powheg_matching_t), intent(inout) :: powheg
	real(default), intent(in) :: pT2
	call powheg%process_instance%set_fac_scale (sqrt(pT2))
	end subroutine powheg_matching_set_scale

	@ %def powheg_matching_set_scale
	@
	For each underlying Born $f_b$, there is a number of radiation regions.
	A radiation region rr may correspond multiple $\alpha_r$s. The phase
	space only depends upon the radiation region kinematics rr and not on
	the specific $\alpha_r$. $\alpha_r$ can be picked in the set
	$\{\alpha_r\|f_b,\text{rr}\}$ proportional to their $R_{\alpha_r}$. For
	now, we simplify things though and just work with the $\alpha_r$.

	The following is valid for one underlying Born.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: fill_grids => powheg_matching_fill_grids
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_fill_grids (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	real(default), dimension(3) :: radiation_variables
	real(default) :: f_alr, xi, y, norm, real_me, ubf
	integer :: alr
	integer :: n, n_points
	real(default) :: alpha_s
	call msg_debug (D_MATCHING, "powheg_fill_grids")
	call powheg%display_grid_startup_message()
	n_points = powheg%settings%n_init
	call msg_debug (D_MATCHING, "n_points", n_points)
	EVALUATE_GRID_POINTS: do n = 1, n_points
	if (signal_is_pending ()) return
	call powheg%prepare_momenta_for_fill_grids (radiation_variables)
	do alr = 1, powheg%process_deps%n_alr
	call powheg%generate_xi_and_y_for_grids &
	(radiation_variables, alr, xi, y)
	associate (s => powheg%sudakov(alr)%s)
	alpha_s = s%alpha_s (s%kt2(xi, y), use_correct=.true.)
	ubf = s%upper_bound_func (xi, y, alpha_s)
	end associate
	real_me = powheg%compute_sqme_real (alr, alpha_s)
	norm = real_me / (powheg%event_deps%sqme_born * ubf)
	f_alr = (one * alr) / powheg%process_deps%n_alr - tiny_07
	call powheg%grid%update_maxima &
	([radiation_variables(I_XI:I_Y), f_alr], norm)
	call msg_show_progress (n, n_points)
	if (debug2_active (D_MATCHING)) call show_vars ()
	end do
	end do EVALUATE_GRID_POINTS

	contains

	subroutine show_vars ()
	if (norm > 1E5_default) then
	call msg_debug2 (D_MATCHING, "alr", alr)
	call msg_debug2 (D_MATCHING, "f_alr", f_alr)
	call msg_debug2 (D_MATCHING, "radiation_variables(1)", &
	radiation_variables(1))
	call msg_debug2 (D_MATCHING, "radiation_variables(2)", &
	radiation_variables(2))
	call msg_debug2 (D_MATCHING, "radiation_variables(3)", &
	radiation_variables(3))
	call msg_debug2 (D_MATCHING, "xi", xi)
	call msg_debug2 (D_MATCHING, "y", y)
	call msg_debug2 (D_MATCHING, "powheg%sudakov(alr)%s%kt2(xi,y)", &
	powheg%sudakov(alr)%s%kt2(xi,y))
	call msg_debug2 (D_MATCHING, "powheg%event_deps%sqme_born", &
	powheg%event_deps%sqme_born)
	call msg_debug2 (D_MATCHING, "alpha_s", alpha_s)
	call msg_debug2 (D_MATCHING, "real_me", real_me)
	call msg_debug2 (D_MATCHING, "ubf", ubf)
	call msg_debug2 (D_MATCHING, "norm", norm)
	call msg_debug2 (D_MATCHING, "")
	end if
	end subroutine show_vars

	end subroutine powheg_matching_fill_grids

	@ %def powheg_matching_fill_grids
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: generate_xi_and_y_for_grids => powheg_matching_generate_xi_and_y_for_grids
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_generate_xi_and_y_for_grids (powheg, &
	radiation_randoms, alr, xi, y)
	class(powheg_matching_t), intent(inout) :: powheg
	integer, intent(in) :: alr
	real(default), dimension(:), intent(in) :: radiation_randoms
	real(default), intent(out) :: xi, y
	integer :: emitter, i_phs
	select type (pcm => powheg%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	associate (fks => powheg%phs_fks_generator)
	i_phs = powheg%process_deps%alr_to_i_phs (alr)
	emitter = powheg%process_deps%phs_identifiers(i_phs)%emitter
	associate (generator => powheg%phs_fks_generator)
	call generator%prepare_generation (radiation_randoms, &
	i_phs, emitter, powheg%event_deps%p_born_cms%phs_point(1)%p, &
	powheg%process_deps%phs_identifiers)
	call generator%generate_fsr (emitter, i_phs, &
	powheg%event_deps%p_born_cms%phs_point(1)%p, &
	powheg%event_deps%p_real_cms%phs_point(i_phs)%p)
	call generator%get_radiation_variables (i_phs, xi, y)
	end associate
	call powheg%boost_preal_to_lab_frame (i_phs)
	call powheg%copy_momenta ()
	end associate
	end select
	end subroutine powheg_matching_generate_xi_and_y_for_grids

	@ %def powheg_matching_generate_xi_and_y_for_grids
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: prepare_momenta_for_fill_grids => powheg_matching_prepare_momenta_for_fill_grids
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_prepare_momenta_for_fill_grids (powheg, &
	radiation_randoms)
	real(default), dimension(3), intent(out) :: radiation_randoms
	class(powheg_matching_t), intent(inout) :: powheg
	integer :: alr, i_phs, emitter
	select type (pcm => powheg%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	associate ( &
	fks => powheg%phs_fks_generator, &
	process => powheg%process_instance%process)
	do
	call powheg%process_instance%generate_weighted_event (1)
	call powheg%update (pcm%get_momenta (i_phs = 1, &
	born_phsp = .true., cms = .false.))
	call powheg%rng%generate (radiation_randoms)
	do alr = 1, powheg%process_deps%n_alr
	i_phs = powheg%process_deps%alr_to_i_phs (alr)
	emitter = powheg%sudakov(alr)%s%associated_emitter ()
	call fks%prepare_generation (radiation_randoms, i_phs, &
	emitter, powheg%event_deps%p_born_lab%get_momenta(1), &
	powheg%process_deps%phs_identifiers)
	call powheg%update_sudakovs (alr, i_phs, &
	fks%real_kinematics%y(i_phs))
	end do
	if (powheg%above_pt2_min ()) exit
	end do
	end associate
	end select
	end subroutine powheg_matching_prepare_momenta_for_fill_grids

	@ %def powheg_matching_prepare_momenta_for_fill_grids
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: above_pt2_min => powheg_matching_above_pt2_min
	<<POWHEG matching: procedures>>=
	function powheg_matching_above_pt2_min (powheg) result (above)
	logical :: above
	class(powheg_matching_t), intent(in) :: powheg
	integer :: alr, i_phs
	real(default) :: xi, y
	above = .true.
	select type (pcm => powheg%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	associate (fks => powheg%phs_fks_generator)
	do alr = 1, powheg%process_deps%n_alr
	i_phs = powheg%process_deps%alr_to_i_phs(alr)
	call fks%get_radiation_variables (i_phs, xi, y)
	above = powheg%sudakov(alr)%s%kt2 (xi, y) >= powheg%settings%pt2_min
	if (.not. above) exit
	end do
	end associate
	end select
	end function powheg_matching_above_pt2_min

	@ %def powheg_matching_above_pt2_min
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: update_sudakovs => powheg_matching_update_sudakovs
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_update_sudakovs (powheg, alr, i_phs, y)
	class(powheg_matching_t), intent(inout) :: powheg
	integer, intent(in) :: alr, i_phs
	real(default), intent(in) :: y
	real(default) :: q0, m2, mrec2, k0_rec_max
	type(vector4_t) :: p_emitter
	select type (s => powheg%sudakov(alr)%s)
	type is (sudakov_massive_fsr_t)
	q0 = sqrt (s%event_deps%s_hat)
	p_emitter = s%event_deps%p_born_lab%get_momentum (1, &
	s%associated_emitter ())
	associate (p => p_emitter%p)
	mrec2 = (q0 - p(0))2 - p(1)2 - p(2)2 - p(3)2
	end associate
	m2 = p_emitter**2
	call compute_dalitz_bounds (q0, m2, mrec2, s%z1, s%z2, k0_rec_max)
	s%z = s%z2 - (s%z2 - s%z1) * (one + y) / two
	end select
	end subroutine powheg_matching_update_sudakovs

	@ %def powheg_matching_update_sudakovs
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: import_norms_from_grid => powheg_matching_import_norms_from_grid
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_import_norms_from_grid (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	integer :: alr
	real(default) :: norm_max
	do alr = 1, powheg%process_deps%n_alr
	norm_max = powheg%grid%get_maximum_in_3d (alr)
	call powheg%sudakov(alr)%s%set_normalization (norm_max)
	end do
	end subroutine powheg_matching_import_norms_from_grid

	@ %def powheg_matching_import_norms_from_grid
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: save_grids => powheg_matching_save_grids
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_save_grids (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	type(string_t) :: filename, n_points
	n_points = str (powheg%settings%n_init)
	filename = powheg%process_name // "_" // n_points // ".pg"
	call powheg%grid%save_to_file (char (filename))
	end subroutine powheg_matching_save_grids

	@ %def powheg_matching_save_grids
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: load_grids => powheg_matching_load_grids
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_load_grids (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	type(string_t) :: filename, n_points
	n_points = str (powheg%settings%n_init)
	filename = powheg%process_name // "_" // n_points // ".pg"
	call powheg%grid%load_from_file (char (filename))
	write (msg_buffer, "(A,A,A)") "POWHEG: using grids from file '", &
	char (filename), "'"
	call msg_message ()
	end subroutine powheg_matching_load_grids

	@ %def powheg_matching_load_grids
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: requires_new_grids => powheg_matching_requires_new_grids
	<<POWHEG matching: procedures>>=
	function powheg_matching_requires_new_grids (powheg) result (requires)
	logical :: requires
	class(powheg_matching_t), intent(in) :: powheg
	type(string_t) :: filename, n_points
	n_points = str (powheg%settings%n_init)
	filename = powheg%process_name // "_" // n_points // ".pg"
	requires = .not. os_file_exist (filename) .or. &
	powheg%settings%rebuild_grids .or. &
	.not. verify_points_for_grid (char (filename), &
	[powheg%settings%size_grid_xi, &
	powheg%settings%size_grid_y, &
	powheg%process_deps%n_alr])
	end function powheg_matching_requires_new_grids

	@ %def powheg_matching_requires_new_grids
	@ By keeping the radiation with the largest [[pt2]], we are effectively
	implementing the highest bid procedure. This means that we generate
	values $(f_B)$
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: generate_emission => powheg_matching_generate_emission
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_generate_emission (powheg, particle_set, pt2_generated)
	class(powheg_matching_t), intent(inout) :: powheg
	type(particle_set_t), intent(inout), optional :: particle_set
	real(default), intent(out), optional :: pt2_generated
	type(radiation_t) :: r, r_max
	real(default) :: xi2_max
	integer :: alr, emitter
	logical :: accepted
	type(vector4_t), dimension(:), allocatable :: p_real_max
	if (signal_is_pending ()) return
	r_max%pt2 = zero
	r_max%alr = 0
	call msg_debug (D_MATCHING, "powheg_matching_generate_emission")
	select type (pcm => powheg%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	allocate (p_real_max (config%region_data%n_legs_real))
	end select
	do alr = 1, powheg%process_deps%n_alr
	if (signal_is_pending ()) return
	associate (sudakov => powheg%sudakov(alr)%s)
	xi2_max = pcm%get_xi_max (alr)**2
	call sudakov%update (xi2_max)
	select type (sudakov)
	type is (sudakov_massive_fsr_t)
	call sudakov%compute_xi_max_extended (sudakov%i_phs)
	end select
	r%alr = alr
	r%pt2 = sudakov%kt2_max (powheg%event_deps%s_hat)
	sudakov%last_log = 0
	call msg_debug (D_MATCHING, "Starting evolution at r%pt2", r%pt2)
	PT_EVOLUTION: do
	if (signal_is_pending ()) return
	call sudakov%generate_emission (r)
	if (signal_is_pending ()) return
	if (r%valid) then
	accepted = powheg%reweight_norm (r)
	call sudakov%veto_counter%record_norm (.not. accepted)
	if (.not. accepted) cycle PT_EVOLUTION
	accepted = powheg%reweight_matrix_elements (r)
	call sudakov%veto_counter%record_sqme (.not. accepted)
	if (.not. accepted) cycle PT_EVOLUTION
	end if
	exit
	end do PT_EVOLUTION
	if (r%pt2 > r_max%pt2 .and. r%valid) then
	r_max = r
	p_real_max = powheg%event_deps%p_real_lab%get_momenta (sudakov%i_phs)
	end if
	end associate
	end do
	if (r_max%pt2 > powheg%settings%pt2_min) then
	powheg%n_emissions = powheg%n_emissions + 1
	call powheg%set_scale (r_max%pt2)
	if (present (particle_set)) then
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	emitter = config%region_data%get_emitter (r_max%alr)
	call powheg%build_particle_set (particle_set, &
	powheg%event_deps%p_born_lab%get_momenta (1), &
	p_real_max, emitter)
	end select
	end if
	if (present (pt2_generated)) pt2_generated = r_max%pt2
	else
	call powheg%set_scale (powheg%settings%pt2_min)
	if (present (pt2_generated)) pt2_generated = powheg%settings%pt2_min
	end if
	end select
	end subroutine powheg_matching_generate_emission

	@ %def generate_emission
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: build_particle_set => powheg_matching_build_particle_set
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_build_particle_set &
	(powheg, particle_set, p_born, p_real, emitter)
	class(powheg_matching_t), intent(inout) :: powheg
	type(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), dimension(:), intent(in) :: p_born, p_real
	integer, intent(in) :: emitter
	integer, dimension(:), allocatable :: flv_radiated
	real(default) :: r_col
	select type (pcm => powheg%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	allocate (flv_radiated (size (config%region_data%get_flv_states_real (1))))
	flv_radiated = config%region_data%get_flv_states_real (1)
	end select
	call powheg%rng%generate (r_col)
	call particle_set%build_radiation (p_real, emitter, flv_radiated, &
	powheg%process_instance%process%get_model_ptr (), r_col)
	end select
	end subroutine powheg_matching_build_particle_set

	@ %def powheg_matching_build_particle_set
	@ Only massless for now
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: reweight_norm => powheg_matching_reweight_norm
	<<POWHEG matching: procedures>>=
	function powheg_matching_reweight_norm (powheg, r) result (accepted)
	logical :: accepted
	class(powheg_matching_t), intent(inout) :: powheg
	type(radiation_t), intent(in) :: r
	real(default) :: random, norm_max, norm_true
	call msg_debug2 (D_MATCHING, "reweight_norm")
	call powheg%rng%generate (random)
	associate (s => powheg%sudakov(r%alr)%s)
	norm_true = powheg%norm_from_xi_and_y (r)
	norm_max = s%norm_max
	end associate
	accepted = random < norm_true / norm_max
	if (debug2_active (D_MATCHING)) then
	print *, ' r%alr = ', r%alr
	print *, ' random = ', random
	print *, ' norm_true = ', norm_true
	print *, ' norm_max = ', norm_max
	print *, ' norm accepted = ', accepted
	end if
	if (debug_active (D_MATCHING)) then
	if (.not. (zero < r%xi .and. &
	r%xi < sqrt(powheg%sudakov(r%alr)%s%xi2_max))) then
	call msg_bug ("powheg_matching_reweight_norm: xi is out of bounds")
	end if
	if (norm_true > norm_max) then
	call msg_bug ("powheg_matching_reweight_norm: norm shouldnt be larger than norm_max")
	end if
	end if
	end function powheg_matching_reweight_norm

	@ %def powheg_matching_reweight_norm
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: norm_from_xi_and_y => powheg_matching_norm_from_xi_and_y
	<<POWHEG matching: procedures>>=
	function powheg_matching_norm_from_xi_and_y (powheg, r) result (norm_true)
	real(default) :: norm_true
	class(powheg_matching_t), intent(inout) :: powheg
	type(radiation_t), intent(in) :: r
	real(default) :: f_alr
	real(default), dimension(2) :: rands
	real(default) :: beta
	f_alr = (one * r%alr) / powheg%process_deps%n_alr - tiny_07
	rands(I_XI) = r%xi / sqrt (powheg%sudakov(r%alr)%s%xi2_max)
	select type (s => powheg%sudakov(r%alr)%s)
	type is (sudakov_simple_fsr_t)
	rands(I_Y) = (one - r%y) / two
	type is (sudakov_massive_fsr_t)
	beta = beta_emitter (sqrt (powheg%event_deps%s_hat), &
	powheg%event_deps%p_born_lab%get_momentum (1, s%associated_emitter()))
	rands(I_Y) = - log((one - r%y * beta) / (one + beta)) / &
	log((one + beta) / (one - beta))
	end select
	norm_true = powheg%grid%get_value ([rands, f_alr])
	end function powheg_matching_norm_from_xi_and_y

	@ %def powheg_matching_norm_from_xi_and_y
	@
	\subsection{$\alpha_s$ and its reweighting}
	The main point to ensure here is that the simple fixed-flavor-1-loop
	expression $\alpha_s^\text{rad}$ is larger than the more accurate
	$\alpha_s$ such that we can use a reweighting veto and use
	$\alpha_s^\text{rad}$ for the generation of the emission. This can be
	done by setting
	\begin{equation}
	\alpha_s^\text{rad}(\mu_0) = \alpha_s (\mu_0)
	\end{equation}
	whereby $\mu_0^2$ is the [[scale_to_relate2]] that is taken to be
	$p_{T,\text{min}}^2$.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: prepare_for_events => powheg_matching_prepare_for_events
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_prepare_for_events (matching)
	class(powheg_matching_t), intent(inout), target :: matching
	call msg_debug (D_MATCHING, "powheg_matching_prepare_for_events")
	call matching%setup_nlo_environment ()
	call matching%grid%init ([matching%settings%size_grid_xi, &
	matching%settings%size_grid_y, matching%process_deps%n_alr])
	call matching%compute_lambda2_gen ()
	call matching%setup_sudakovs ()
	end subroutine powheg_matching_prepare_for_events

	@ %def powheg_matching_prepare_for_events
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: compute_lambda2_gen => powheg_matching_compute_lambda2_gen
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_compute_lambda2_gen (matching)
	class(powheg_matching_t), intent(inout) :: matching
	real(default) :: scale_to_relate2, alpha_s
	scale_to_relate2 = matching%settings%pt2_min
	alpha_s = get_alpha (matching%qcd, scale_to_relate2)
	matching%process_deps%lambda2_gen = exp (- one / (b0rad * alpha_s)) * &
	scale_to_relate2
	end subroutine powheg_matching_compute_lambda2_gen

	@ %def powheg_matching_compute_lambda2_gen
	@
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: setup_nlo_environment => powheg_matching_setup_nlo_environment
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_setup_nlo_environment (matching)
	class(powheg_matching_t), intent(inout) :: matching
	integer :: n_tot_born, n_tot_real
	integer :: i, i_real, i_term
	integer :: n_phs, nlo_type
	call msg_debug (D_MATCHING, "powheg_matching_setup_nlo_environment")
	select type (pcm => matching%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	matching%process_deps%sqrts = matching%process_instance%get_sqrts ()
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	matching%process_deps%n_alr = config%region_data%n_regions
	n_tot_born = config%region_data%n_legs_born
	n_tot_real = config%region_data%n_legs_real
	call config%setup_phs_generator (pcm, &
	matching%phs_fks_generator, matching%process_deps%sqrts, &
	singular_jacobian = matching%settings%singular_jacobian)
	end select
	associate (process => matching%process_instance%process)
	i_real = process%get_first_real_component ()
	end associate
	associate (process_deps => matching%process_deps)
	select type (phs => matching%process_instance%term(i_real)%k_term%phs)
	type is (phs_fks_t)
	n_phs = size (phs%phs_identifiers)
	allocate (process_deps%phs_identifiers (n_phs))
	process_deps%phs_identifiers = phs%phs_identifiers
	end select
	allocate (matching%process_deps%alr_to_i_phs &
	(size (pcm%real_kinematics%alr_to_i_phs)))
	process_deps%alr_to_i_phs = pcm%real_kinematics%alr_to_i_phs
	allocate (process_deps%i_real (n_phs))
	i = 1
	do i_term = 1, size (matching%process_instance%term)
	nlo_type = matching%process_instance%term(i_term)%nlo_type
	if (nlo_type == BORN) then
	process_deps%i_born = i_term
	else if (nlo_type == NLO_REAL) then
	if (matching%process_instance%term(i_term)%k_term%emitter >= 0) then
	process_deps%i_real(i) = i_term
	i = i + 1
	end if
	end if
	end do
	end associate
	call matching%event_deps%p_born_lab%init (n_tot_born, 1)
	call matching%event_deps%p_born_cms%init (n_tot_born, 1)
	call matching%event_deps%p_real_lab%init (n_tot_real, n_phs)
	call matching%event_deps%p_real_cms%init (n_tot_real, n_phs)
	end select
	end subroutine powheg_matching_setup_nlo_environment

	@ %def powheg_matching_setup_nlo_environment
	@ Copy momenta from [[event_deps]] to [[real_kinematics]].
	So far this is only valid if the center-of-mass system is equal to
	the lab frame, i.e. for FSR processes without beamstrahlung or structure functions.
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: copy_momenta => powheg_matching_copy_momenta
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_copy_momenta (matching)
	class(powheg_matching_t), intent(inout) :: matching
	integer :: i_phs
	select type (pcm => matching%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	!!! Too much redundance!
	do i_phs = 1, matching%event_deps%p_real_cms%get_n_phs ()
	call pcm%real_kinematics%p_real_cms%set_momenta &
	(i_phs, matching%event_deps%p_real_cms%get_momenta (i_phs))
	call pcm%real_kinematics%p_real_lab%set_momenta &
	(i_phs, matching%event_deps%p_real_lab%get_momenta (i_phs))
	end do
	end select
	end subroutine powheg_matching_copy_momenta

	@ %def powheg_matching_copy_momenta
	@ [[qcd%alpha%get]] should implement a variable-flavor result and
	optionally return [[n_flavors]] that are active at the scale...
	<<POWHEG matching: procedures>>=
	function get_alpha (qcd, scale2) result (alpha_s)
	real(default) :: alpha_s
	class(qcd_t), intent(in) :: qcd
	real(default), intent(in) :: scale2
	integer :: nf, order
	! TODO: (bcn 2015-01-30) implement variable flavor alpha_s
	alpha_s = qcd%alpha%get (sqrt(scale2))
	select type (alpha => qcd%alpha)
	type is (alpha_qcd_from_scale_t)
	nf = alpha%nf
	order = alpha%order
	type is (alpha_qcd_from_lambda_t)
	nf = alpha%nf
	order = alpha%order
	class default
	call msg_warning ("get_alpha: QCD type is not running!" // &
	"Assuming 5-flavors and LO (1-loop) running!")
	nf = 5
	order = 0
	end select
	if (order > 0) alpha_s = improve_nll_accuracy (alpha_s, nf)
	end function get_alpha

	@ %def get_alpha
	@ See Eq. (4.31) in [[0709.2092]]. Should be used everywhere in the Sudakov
	exponent.
	<<POWHEG matching: procedures>>=
	pure function improve_nll_accuracy (alpha_s, n_flavors) result (alpha_s_imp)
	real(default) :: alpha_s_imp
	real(default), intent(in) :: alpha_s
	integer, intent(in) :: n_flavors
	alpha_s_imp = alpha_s * (one + alpha_s / (twopi) &
	((67.0_default/18 - pi*2/6) CA - five/9 * n_flavors))
	end function improve_nll_accuracy

	@ %def improve_nll_accuracy
	@ This is fixed to $n_f=5$ for radiation generation. It will be
	reweighted to the more precise $\alpha_s$.
	<<POWHEG matching: parameters>>=
	real(default), parameter :: b0rad = (33 - 2 * 5) / (12 * pi)
	@ %def b0rad
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: alpha_s_rad => sudakov_alpha_s_rad
	<<POWHEG matching: procedures>>=
	elemental function sudakov_alpha_s_rad (sudakov, scale2) result (y)
	real(default) :: y
	class(sudakov_t), intent(in) :: sudakov
	real(default), intent(in) :: scale2
	y = one / (b0rad * log (scale2 / sudakov%process_deps%lambda2_gen))
	end function sudakov_alpha_s_rad

	@ %def sudakov_alpha_s_rad
	@
	<<POWHEG matching: sudakov: TBP>>=
	procedure :: reweight_alpha_s => sudakov_reweight_alpha_s
	<<POWHEG matching: procedures>>=
	function sudakov_reweight_alpha_s (sudakov, pt2) result (accepted)
	logical :: accepted
	class(sudakov_t), intent(inout) :: sudakov
	real(default), intent(in) :: pt2
	real(default) :: alpha_s_true, alpha_s_rad
	logical :: alpha_s_equal
	call msg_debug2 (D_MATCHING, "reweight_alpha_s")
	alpha_s_true = get_alpha (sudakov%qcd, pt2)
	alpha_s_rad = sudakov%alpha_s_rad (pt2)
	call sudakov%rng%generate (sudakov%random)
	alpha_s_equal = nearly_equal (alpha_s_true, alpha_s_rad)
	accepted = alpha_s_equal .or. sudakov%random < alpha_s_true / alpha_s_rad
	if (debug2_active (D_MATCHING)) then
	print *, ' sudakov%random = ', sudakov%random
	print *, ' alpha_s_true = ', alpha_s_true
	print *, ' alpha_s_rad = ', alpha_s_rad
	print *, ' alpha_s accepted = ', accepted
	if (alpha_s_rad < alpha_s_true .and. .not. alpha_s_equal) then
	print *, 'pt2 = ', pt2
	print *, 'sudakov%process_deps%lambda2_gen = ', &
	sudakov%process_deps%lambda2_gen
	call msg_fatal ("sudakov_reweight_alpha_s: This should never happen. &
	&Have you chosen a running alpha_s?")
	end if
	end if
	end function sudakov_reweight_alpha_s

	@ %def sudakov_reweight_alpha_s
	@
	\subsection{POWHEG hook}
	We provide a POWHEG hook to be called by [[process_instance_evaluate]] to
	prefill the adaptation grid.

	We store the actual [[powheg]] object, which does the computations.
	<<POWHEG matching: public>>=
	public :: powheg_matching_hook_t
	<<POWHEG matching: types>>=
	type, extends(process_instance_hook_t) :: powheg_matching_hook_t
	type(string_t) :: process_name
	type(powheg_matching_t) :: powheg
	contains
	<<POWHEG matching: powheg matching hook: TBP>>
	end type powheg_matching_hook_t

	@ %def powheg_matching_t
	@ Init the hook. The init procedure will be called in [[setup_process]], after
	everything is set up.

	Additionally, we have to include [[var_list]] in order to retrieve the grid size
	in [[xi]] and [[y]].
	<<POWHEG matching: powheg matching hook: TBP>>=
	procedure :: init => powheg_matching_hook_init
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_hook_init (hook, var_list, instance)
	class(powheg_matching_hook_t), intent(inout), target :: hook
	type(var_list_t), intent(in) :: var_list
	class(process_instance_t), intent(in), target :: instance
	call msg_debug (D_MATCHING, "powheg_matching_hook_init")
	hook%process_name = instance%get_process_name ()
	call hook%powheg%init (var_list, hook%process_name)
	hook%powheg%qcd => instance%get_qcd_ptr ()
	call hook%powheg%connect (instance)
	hook%powheg%process_deps%cm_frame = &
	hook%powheg%process_instance%is_cm_frame (1)
	call hook%powheg%prepare_for_events ()
	end subroutine powheg_matching_hook_init

	@ %def powheg_matching_hook_init
	@ We save the filled grid to file, such that in can be retrieved later on.
	The hook object will be deallocated, when the instance gets deallocated.
	<<POWHEG matching: powheg matching hook: TBP>>=
	procedure :: final => powheg_matching_hook_final
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_hook_final (hook)
	class(powheg_matching_hook_t), intent(inout) :: hook
	type(string_t) :: filename
	call msg_debug (D_MATCHING, "powheg_matching_hook_final")
	<<POWHEG matching: powheg matching hook final: reduce>>
	call hook%powheg%save_grids ()
	end subroutine powheg_matching_hook_final

	@ %def powheg_matching_hook_final
	@
	<<POWHEG matching: powheg matching hook final: reduce>>=
	@ Reduce all grid to a single grid by using [[MPI_MAX]] on each element.
	<<MPI: POWHEG matching: powheg matching hook final: reduce>>=
	call hook%powheg%grid%mpi_reduce (MPI_MAX)
	@
	@
	<<POWHEG matching: powheg matching hook: TBP>>=
	procedure :: evaluate => powheg_matching_hook_evaluate
	<<POWHEG matching: procedures>>=
	subroutine powheg_matching_hook_evaluate (hook, instance)
	class(powheg_matching_hook_t), intent(inout) :: hook
	class(process_instance_t), intent(in), target :: instance
	type(vector4_t), dimension(:), allocatable :: p_hard
	real(default), dimension(:), allocatable :: x
	real(default) :: xi, y
	real(default) :: sqme_real, sqme_born, alpha_s
	real(default) :: f_alr, norm, ubf
	integer :: alr, i_phs, i_real, n_x
	if (instance%get_active_component_type () == COMP_REAL_FIN) return
	associate (powheg => hook%powheg)
	allocate (p_hard (size (instance%get_p_hard (1))))
	p_hard = instance%get_p_hard (1)
	call powheg%update (p_hard)
	i_real = instance%process%get_first_real_component ()
	do alr = 1, powheg%process_deps%n_alr
	i_phs = powheg%process_deps%alr_to_i_phs (alr)
	select type (phs => instance%term( &
	powheg%process_deps%i_real(i_phs))%k_term%phs)
	type is (phs_fks_t)
	call phs%generator%get_radiation_variables (i_phs, xi, y)
	end select
	call powheg%update_sudakovs (alr, i_phs, y)
	sqme_born = instance%get_sqme (powheg%process_deps%i_born)
	sqme_real = instance%get_sqme (powheg%process_deps%i_real(i_phs))
	if (powheg%sudakov(alr)%s%kt2 (xi, y) >= powheg%settings%pt2_min) then
	associate (s => powheg%sudakov(alr)%s)
	alpha_s = s%alpha_s (s%kt2(xi, y), use_correct=.true.)
	ubf = s%upper_bound_func (xi, y, alpha_s)
	end associate
	norm = sqme_real / (sqme_born * ubf)
	f_alr = (one * alr) / powheg%process_deps%n_alr - tiny_07
	if (.not. allocated (x)) &
	allocate (x(size (instance%get_x_process ())))
	x = instance%get_x_process ()
	n_x = size (x)
	call powheg%grid%update_maxima &
	([x(n_x - 2 : n_x - 1), f_alr], norm)
	end if
	end do
	end associate
	end subroutine powheg_matching_hook_evaluate

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

	module powheg_matching_ut
	use unit_tests
	use powheg_matching_uti

	<<Standard module head>>

	<<POWHEG matching: public test>>

	contains

	<<POWHEG matching: test driver>>

	end module powheg_matching_ut
	@ %def powheg_matching_ut
	@
	<<[[powheg_matching_uti.f90]]>>=
	<<File header>>

	module powheg_matching_uti

	<<Use kinds>>
	<<Use strings>>
	use constants, only: zero, one
	use lorentz
	use physics_defs, only: LAMBDA_QCD_REF
	use sm_qcd
	use subevents, only: PRT_INCOMING, PRT_OUTGOING
	use model_data
	use particles
	use rng_base
	use variables
	use shower_base
	use shower_core

	use powheg_matching

	use rng_base_ut, only: rng_test_factory_t

	<<Standard module head>>

	<<POWHEG matching: test declarations>>

	contains

	<<POWHEG matching: tests>>

	end module powheg_matching_uti
	@ %def powheg_matching_ut
	@ API: driver for the unit tests below.
	<<POWHEG matching: public test>>=
	public :: powheg_test
	<<POWHEG matching: test driver>>=
	subroutine powheg_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<POWHEG matching: execute tests>>
	end subroutine powheg_test

	@ %def powheg_test
	@
	\subsubsection{Initialization}
	No Powheg unit tests so far
	\subsubsection{Compare generated emission with Sudakov form factor}
	This is a nontrivial test of the generation algorithm and should be
	independent of the used upper bounding function (as long as all
	singularities are included).
	<<POWHEG matching: powheg matching: TBP>>=
	procedure :: test_sudakov => powheg_test_sudakov
	<<POWHEG matching: procedures>>=
	subroutine powheg_test_sudakov (powheg)
	class(powheg_matching_t), intent(inout) :: powheg
	integer :: n_calls1, n_calls2
	integer, parameter :: n_bins = 20
	real(default) :: sqme_real_x_jacobian, sqme_born
	type(vector4_t), dimension(:), allocatable :: p_born
	real(default), dimension(3) :: random
	real(default) :: xi, y
	integer :: i_call, i_bin, alr, emitter
	real(default) :: alpha_s, kT2, weight
	real(default) :: pt2_min, s, random_jacobian
	real(default), dimension(n_bins) :: histo1, histo2, histo1sq, histo2sq
	real(default), dimension(n_bins) :: tmp
	integer :: i_strip, n_in_strip, n_strips
	real(default), dimension(n_bins) :: average, average_sq, error
	real(default), dimension(n_bins) :: &
	sudakov_0, sudakov_p, sudakov_m, rel_error
	integer :: u

	p_born = powheg%event_deps%p_born_lab%get_momenta (1)
	sqme_born = powheg%event_deps%sqme_born
	s = powheg%event_deps%s_hat
	pt2_min = powheg%settings%pt2_min
	n_calls1 = 100000; n_calls2 = 1000000
	histo1 = zero; histo2 = zero; histo1sq = zero; histo2sq = zero
	n_strips = 10

	call compute_integrals ()
	call generate_emissions ()
	call write_to_screen_and_file ()

	contains

	<<POWHEG matching: powheg test sudakov: procedures>>

	end subroutine powheg_test_sudakov

	@ %def powheg_test_sudakov
	@
	<<POWHEG matching: powheg test sudakov: procedures>>=
	pure function binning (i) result (pt2)
	real(default) :: pt2
	integer, intent(in) :: i
	!pt2 = pt2_min + (s-pt2_min) * (i-1) / (n_bins-1)
	pt2 = pt2_min * exp (log (s / pt2_min) * (i-1) / (n_bins-1))
	end function

	@
	<<POWHEG matching: powheg test sudakov: procedures>>=
	subroutine compute_integrals ()
	write (msg_buffer, "(A)") "POWHEG: test_sudakov: Computing integrals"
	call msg_message ()
	select type (pcm => powheg%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	associate (fks => powheg%phs_fks_generator)
	do i_call = 1, n_calls1
	do alr = 1, powheg%process_deps%n_alr
	call powheg%rng%generate (random)
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	emitter = config%region_data%get_emitter (alr)
	end select
	!!! The sudakov test works only with lepton collisions without beam spectria
	!!! so we can identify the cms and lab momenta.
	powheg%event_deps%p_real_lab = powheg%event_deps%p_real_cms
	call powheg%copy_momenta ()
	call fks%get_radiation_variables (emitter, xi, y)
	kT2 = powheg%sudakov(alr)%s%kt2(xi, y)
	if (kT2 >= pt2_min .and. xi < one - tiny_07) then
	alpha_s = get_alpha (powheg%qcd, kT2)
	sqme_real_x_jacobian = powheg%compute_sqme_real (alr, alpha_s)
	random_jacobian = pcm%real_kinematics%jac_rand (emitter)
	weight = sqme_real_x_jacobian * random_jacobian / sqme_born
	do i_bin = 1, n_bins
	if (kT2 > binning(i_bin)) then
	histo1(i_bin) = histo1(i_bin) + weight
	histo1sq(i_bin) = histo1sq(i_bin) + weight**2
	end if
	end do
	end if
	! Do not cycle since there is a Heaviside in the exponent
	end do
	call msg_show_progress (i_call, n_calls1)
	end do
	end associate
	end select
	average = histo1 / n_calls1
	average_sq = histo1sq / n_calls1
	error = sqrt ((average_sq - average**2) / n_calls1)
	sudakov_0 = exp(-average)
	sudakov_p = exp(-(average + error))
	sudakov_m = exp(-(average - error))
	rel_error = (sudakov_0 - sudakov_p + sudakov_m - sudakov_0) / &
	(2 * sudakov_0) * 100
	end subroutine compute_integrals

	@
	<<POWHEG matching: powheg test sudakov: procedures>>=
	subroutine generate_emissions ()
	write (msg_buffer, "(A)") "POWHEG: test_sudakov: Generating emissions"
	call msg_message ()
	do i_strip = 1, n_strips
	tmp = 0
	n_in_strip = n_calls2 / n_strips
	do i_call = 1, n_in_strip
	if (signal_is_pending ()) return
	call powheg%generate_emission (pt2_generated = kT2)
	do i_bin = 1, n_bins
	if (kT2 > binning(i_bin)) then
	tmp(i_bin) = tmp(i_bin) + 1
	end if
	end do
	end do
	tmp = one - (one * tmp) / n_in_strip
	histo2 = histo2 + tmp
	histo2sq = histo2sq + tmp**2
	call msg_show_progress (i_strip, n_strips)
	end do
	average = histo2 / n_strips
	average_sq = histo2sq / n_strips
	error = sqrt ((average_sq - average**2) / n_strips)
	end subroutine generate_emissions

	@
	<<POWHEG matching: powheg test sudakov: procedures>>=
	subroutine write_to_screen_and_file ()
	u = free_unit ()
	open (file='sudakov.dat', unit=u, action='write')
	print *, 'exp(-Integrated R/B)-distribution: '
	print *, 'pT2 sudakov_+ sudakov_0 sudakov_- rel_err[%]: '
	do i_bin = 1, n_bins
	print *, binning(i_bin), &
	sudakov_p(i_bin), sudakov_0(i_bin), sudakov_m(i_bin), &
	rel_error(i_bin)
	write (u, "(6(" // FMT_16 // ",2X))") binning(i_bin), &
	sudakov_p(i_bin), sudakov_0(i_bin), sudakov_m(i_bin), &
	average(i_bin), error(i_bin)
	end do
	close (u)
	print , '******************************'
	print *, 'Noemission probability: '
	do i_bin = 1, n_bins
	print *, binning (i_bin), average (i_bin), error(i_bin)
	end do
	end subroutine write_to_screen_and_file

	@
	Index: trunk/src/qft/qft.nw
	===================================================================
	--- trunk/src/qft/qft.nw (revision 8189)
	+++ trunk/src/qft/qft.nw (revision 8190)
	@@ -1,15425 +1,15427 @@
	%% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: Quantum Field Theory concepts
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Quantum Field Theory Concepts}
	\includemodulegraph{qft}

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

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

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

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

	module model_data

	use, intrinsic :: iso_c_binding !NODEP!

	<<Use kinds>>
	use kinds, only: i8, i32
	use kinds, only: c_default_float
	<<Use strings>>
	use format_defs, only: FMT_19
	use io_units
	use diagnostics
	use md5
	use hashes, only: hash
	use physics_defs, only: UNDEFINED, SCALAR

	<<Standard module head>>

	<<Model data: public>>

	<<Model data: parameters>>

	<<Model data: types>>

	contains

	<<Model data: procedures>>

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

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

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

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

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

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

	subroutine modelpar_data_init_complex (par, name, value)
	class(modelpar_data_t), intent(out) :: par
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: value
	par%name = name
	par = value
	end subroutine modelpar_data_init_complex

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

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

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

	@ %def modelpar_data_get_name
	@
	Return the value. In case of a type mismatch, follow Fortran conventions.
	<<Model data: par data: TBP>>=
	procedure, pass :: get_real => modelpar_data_get_real
	procedure, pass :: get_complex => modelpar_data_get_complex
	<<Model data: procedures>>=
	elemental function modelpar_data_get_real (par) result (value)
	class(modelpar_data_t), intent(in), target :: par
	real(default) :: value
	select type (par)
	type is (modelpar_real_t)
	value = par%value
	type is (modelpar_complex_t)
	value = par%value
	end select
	end function modelpar_data_get_real

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	@ %def field_data_get_pdg field_data_get_pdg_anti
	@ Predicates:
	<<Model data: field data: TBP>>=
	procedure :: is_visible => field_data_is_visible
	procedure :: is_parton => field_data_is_parton
	procedure :: is_gauge => field_data_is_gauge
	procedure :: is_left_handed => field_data_is_left_handed
	procedure :: is_right_handed => field_data_is_right_handed
	procedure :: has_antiparticle => field_data_has_antiparticle
	procedure :: is_stable => field_data_is_stable
	procedure :: get_decays => field_data_get_decays
	procedure :: decays_isotropically => field_data_decays_isotropically
	procedure :: decays_diagonal => field_data_decays_diagonal
	procedure :: has_decay_helicity => field_data_has_decay_helicity
	procedure :: decay_helicity => field_data_decay_helicity
	procedure :: is_polarized => field_data_is_polarized
	<<Model data: procedures>>=
	elemental function field_data_is_visible (prt) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	flag = prt%visible
	end function field_data_is_visible

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

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

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

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

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

	elemental function field_data_is_stable (prt, anti) result (flag)
	logical :: flag
	class(field_data_t), intent(in) :: prt
	logical, intent(in), optional :: anti
	if (present (anti)) then
	if (anti) then
	flag = prt%a_is_stable
	else
	flag = prt%p_is_stable
	end if
	else
	flag = prt%p_is_stable
	end if
	end function field_data_is_stable

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	@ %def model_data_write
	@ Initialize, allocating pointer arrays. The second version makes a
	deep copy.
	<<Model data: model data: TBP>>=
	generic :: init => model_data_init
	procedure, private :: model_data_init
	<<Model data: procedures>>=
	subroutine model_data_init (model, name, &
	n_par_real, n_par_complex, n_field, n_vtx)
	class(model_data_t), intent(out) :: model
	type(string_t), intent(in) :: name
	integer, intent(in) :: n_par_real, n_par_complex
	integer, intent(in) :: n_field
	integer, intent(in) :: n_vtx
	model%name = name
	allocate (model%par_real (n_par_real))
	allocate (model%par_complex (n_par_complex))
	allocate (model%field (n_field))
	allocate (model%vtx (n_vtx))
	end subroutine model_data_init

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

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

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

	@ %def model_data_copy
	@ Return the model name and numeric scheme.
	<<Model data: model data: TBP>>=
	procedure :: get_name => model_data_get_name
	procedure :: get_scheme_num => model_data_get_scheme_num
	<<Model data: procedures>>=
	function model_data_get_name (model) result (name)
	class(model_data_t), intent(in) :: model
	type(string_t) :: name
	name = model%name
	end function model_data_get_name

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	@ %def model_data_set_field_mass
	@ %def model_data_set_field_width
	@ Mark a particle as unstable and provide a list of names for its
	decay processes. In contrast with the previous subroutine which is
	for internal use, we address the particle by its PDG code. If the
	index is negative, we address the antiparticle.
	<<Model data: model data: TBP>>=
	procedure :: set_unstable => model_data_set_unstable
	procedure :: set_stable => model_data_set_stable
	<<Model data: procedures>>=
	subroutine model_data_set_unstable &
	(model, pdg, decay, isotropic, diagonal, decay_helicity)
	class(model_data_t), intent(inout), target :: model
	integer, intent(in) :: pdg
	type(string_t), dimension(:), intent(in) :: decay
	logical, intent(in), optional :: isotropic, diagonal
	integer, intent(in), optional :: decay_helicity
	type(field_data_t), pointer :: field
	field => model%get_field_ptr (pdg)
	if (pdg > 0) then
	call field%set ( &
	p_is_stable = .false., p_decay = decay, &
	p_decays_isotropically = isotropic, &
	p_decays_diagonal = diagonal, &
	p_decay_helicity = decay_helicity)
	else
	call field%set ( &
	a_is_stable = .false., a_decay = decay, &
	a_decays_isotropically = isotropic, &
	a_decays_diagonal = diagonal, &
	a_decay_helicity = decay_helicity)
	end if
	end subroutine model_data_set_unstable

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	module model_testbed

	<<Use strings>>
	use model_data
	use var_base

	<<Standard module head>>

	<<Model testbed: public>>

	<<Model testbed: variables>>

	<<Model testbed: interfaces>>

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

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

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

	module helicities

	use io_units

	<<Standard module head>>

	<<Helicities: public>>

	<<Helicities: types>>

	<<Helicities: interfaces>>

	contains

	<<Helicities: procedures>>

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

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

	<<Helicities: procedures>>=
	pure function helicity0 () result (hel)
	type(helicity_t) :: hel
	end function helicity0

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

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

	@ %def helicity
	@ Initializers.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	module colors

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

	<<Standard module head>>

	<<Colors: public>>

	<<Colors: types>>

	<<Colors: interfaces>>

	contains

	<<Colors: procedures>>

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

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

	The color may be undefined.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	Gluon entries with equal color and anticolor are explicitly excluded.

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

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

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

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

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

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

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

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

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

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

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

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

	If the fusion fails, the result is undefined.

	NOTE: The [[select type]] casting is required by gfortran 4.8. It may not be
	required by the standard.
	<<Colors: color: TBP>>=
	generic :: operator (.fuse.) => color_fusion
	procedure, private :: color_fusion
	<<Colors: procedures>>=
	function color_fusion (col1, col2) result (col)
	class(color_t), intent(in) :: col1, col2
	type(color_t) :: col
	integer, dimension(2) :: ctype
	if (col1%is_defined () .and. col2%is_defined ()) then
	if (col1%is_diagonal () .and. col2%is_diagonal ()) then
	select type (col1)
	type is (color_t)
	select type (col2)
	type is (color_t)
	ctype = [col1%get_type (), col2%get_type ()]
	select case (ctype(1))
	case (1)
	select case (ctype(2))
	case (1,3,-3,8)
	col = col2
	end select
	case (3)
	select case (ctype(2))
	case (1)
	col = col1
	case (-3)
	call t_a (col1%get_col (), col2%get_acl ())
	case (8)
	call t_o (col1%get_col (), col2%get_acl (), &
	& col2%get_col ())
	end select
	case (-3)
	select case (ctype(2))
	case (1)
	col = col1
	case (3)
	call t_a (col2%get_col (), col1%get_acl ())
	case (8)
	call a_o (col1%get_acl (), col2%get_col (), &
	& col2%get_acl ())
	end select
	case (8)
	select case (ctype(2))
	case (1)
	col = col1
	case (3)
	call t_o (col2%get_col (), col1%get_acl (), &
	& col1%get_col ())
	case (-3)
	call a_o (col2%get_acl (), col1%get_col (), &
	& col1%get_acl ())
	case (8)
	call o_o (col1%get_col (), col1%get_acl (), &
	& col2%get_col (), col2%get_acl ())
	end select
	end select
	end select
	end select
	end if
	end if
	contains
	subroutine t_a (c1, c2)
	integer, intent(in) :: c1, c2
	if (c1 == c2) then
	call col%init_col_acl (0, 0)
	else
	call col%init_col_acl (c1, c2)
	end if
	end subroutine t_a
	subroutine t_o (c1, c2, c3)
	integer, intent(in) :: c1, c2, c3
	if (c1 == c2) then
	call col%init_col_acl (c3, 0)
	else if (c2 == 0 .and. c3 == 0) then
	call col%init_col_acl (c1, 0)
	end if
	end subroutine t_o
	subroutine a_o (c1, c2, c3)
	integer, intent(in) :: c1, c2, c3
	if (c1 == c2) then
	call col%init_col_acl (0, c3)
	else if (c2 == 0 .and. c3 == 0) then
	call col%init_col_acl (0, c1)
	end if
	end subroutine a_o
	subroutine o_o (c1, c2, c3, c4)
	integer, intent(in) :: c1, c2, c3, c4
	if (all ([c1,c2,c3,c4] /= 0)) then
	if (c2 == c3 .and. c4 == c1) then
	call col%init_col_acl (0, 0)
	else if (c2 == c3) then
	call col%init_col_acl (c1, c4)
	else if (c4 == c1) then
	call col%init_col_acl (c3, c2)
	end if
	end if
	end subroutine o_o
	end function color_fusion

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

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

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

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

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

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

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

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

	module colors_ut
	use unit_tests
	use colors_uti

	<<Standard module head>>

	<<Colors: public test>>

	contains

	<<Colors: test driver>>

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

	module colors_uti

	use colors

	<<Standard module head>>

	<<Colors: test declarations>>

	contains

	<<Colors: tests>>

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

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

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

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

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

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

	write (u, *)

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

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

	contains

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

	end subroutine color_2

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

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

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

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

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

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

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

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

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

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

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

	module flavors

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use diagnostics
	use physics_defs, only: UNDEFINED
	use physics_defs, only: INVALID
	use physics_defs, only: HADRON_REMNANT
	use physics_defs, only: HADRON_REMNANT_SINGLET
	use physics_defs, only: HADRON_REMNANT_TRIPLET
	use physics_defs, only: HADRON_REMNANT_OCTET
	use model_data
	use colors, only: color_t

	<<Standard module head>>

	<<Flavors: public>>

	<<Flavors: types>>

	<<Flavors: interfaces>>

	contains

	<<Flavors: procedures>>

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

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

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

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

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

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

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

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

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

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

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

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

	@ %def flavor_tag_radiated
	@ Set the [[hard_process]] flag.
	<<Flavors: flavor: TBP>>=
	procedure :: tag_hard_process => flavor_tag_hard_process
	<<Flavors: procedures>>=
	elemental subroutine flavor_tag_hard_process (flv)
	class(flavor_t), intent(inout) :: flv
	flv%hard_process = .true.
	end subroutine flavor_tag_hard_process

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

	@ %def flavor_undefine
	@ Output: dense, no linebreak
	<<Flavors: flavor: TBP>>=
	procedure :: write => flavor_write
	<<Flavors: procedures>>=
	subroutine flavor_write (flv, unit)
	class(flavor_t), intent(in) :: flv
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	if (associated (flv%field_data)) then
	write (u, "(A)", advance="no") "f("
	else
	write (u, "(A)", advance="no") "p("
	end if
	write (u, "(I0)", advance="no") flv%f
	if (flv%radiated) then
	write (u, "('*')", advance="no")
	end if
	write (u, "(A)", advance="no") ")"
	end subroutine flavor_write

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	@ %def flavor_get_pdg_abs
	@
	Generic properties
	<<Flavors: flavor: TBP>>=
	procedure :: is_visible => flavor_is_visible
	procedure :: is_parton => flavor_is_parton
	procedure :: is_beam_remnant => flavor_is_beam_remnant
	procedure :: is_gauge => flavor_is_gauge
	procedure :: is_left_handed => flavor_is_left_handed
	procedure :: is_right_handed => flavor_is_right_handed
	procedure :: is_antiparticle => flavor_is_antiparticle
	procedure :: has_antiparticle => flavor_has_antiparticle
	procedure :: is_stable => flavor_is_stable
	procedure :: get_decays => flavor_get_decays
	procedure :: decays_isotropically => flavor_decays_isotropically
	procedure :: decays_diagonal => flavor_decays_diagonal
	procedure :: has_decay_helicity => flavor_has_decay_helicity
	procedure :: get_decay_helicity => flavor_get_decay_helicity
	procedure :: is_polarized => flavor_is_polarized
	<<Flavors: procedures>>=
	elemental function flavor_is_visible (flv) result (flag)
	logical :: flag
	class(flavor_t), intent(in) :: flv
	if (associated (flv%field_data)) then
	flag = flv%field_data%is_visible ()
	else
	flag = .false.
	end if
	end function flavor_is_visible

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

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

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

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

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

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

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

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

	subroutine flavor_get_decays (flv, decay)
	class(flavor_t), intent(in) :: flv
	type(string_t), dimension(:), intent(out), allocatable :: decay
	logical :: anti
	anti = flv%f < 0
	if (.not. flv%field_data%is_stable (anti)) then
	call flv%field_data%get_decays (decay, anti)
	end if
	end subroutine flavor_get_decays

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	module quantum_numbers

	use io_units
	use model_data
	use helicities
	use colors
	use flavors

	<<Standard module head>>

	<<Quantum numbers: public>>

	<<Quantum numbers: types>>

	<<Quantum numbers: interfaces>>

	contains

	<<Quantum numbers: procedures>>

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	@ %def quantum_numbers_get_subtraction_index
	@ This is a convenience function: return the color type for the flavor
	(array).

	Note: keep the public version temporarily, this will be used in a
	complicated expression which triggers a compiler bug (nagfor 5.3) in
	the TBP version.
	<<Quantum numbers: public>>=
	public :: quantum_numbers_get_color_type
	<<Quantum numbers: quantum numbers: TBP>>=
	procedure :: get_color_type => quantum_numbers_get_color_type
	<<Quantum numbers: procedures>>=
	elemental function quantum_numbers_get_color_type (qn) result (color_type)
	integer :: color_type
	class(quantum_numbers_t), intent(in) :: qn
	color_type = qn%f%get_color_type ()
	end function quantum_numbers_get_color_type

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	module state_matrices

	<<Use kinds>>
	use io_units
	use format_utils, only: pac_fmt
	use format_defs, only: FMT_17, FMT_19
	use diagnostics
	use sorting
	use model_data
	use flavors
	use colors
	use helicities
	use quantum_numbers

	<<Standard module head>>

	<<State matrices: public>>

	<<State matrices: parameters>>

	<<State matrices: types>>

	<<State matrices: interfaces>>

	contains

	<<State matrices: procedures>>

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	pure subroutine state_matrix_set_matrix_element_single (state, i, value)
	class(state_matrix_t), intent(inout) :: state
	integer, intent(in) :: i
	complex(default), intent(in) :: value
	if (.not. allocated (state%me)) then
	allocate (state%me (state%n_matrix_elements))
	end if
	state%me(i) = value
	end subroutine state_matrix_set_matrix_element_single

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	@ An array slice (derived from the above).
	<<State matrices: procedures>>=
	function state_iterator_get_qn_slice (it, index) result (qn)
	class(state_iterator_t), intent(in) :: it
	integer, dimension(:), intent(in) :: index
	type(quantum_numbers_t), dimension(size(index)) :: qn
	type(quantum_numbers_t), dimension(it%depth) :: qn_tmp
	qn_tmp = state_iterator_get_qn_multi (it)
	qn = qn_tmp(index)
	end function state_iterator_get_qn_slice

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

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

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

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

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

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

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

	@ Just a specific single element
	<<State matrices: procedures>>=
	function state_iterator_get_qn_single (it, k) result (qn)
	class(state_iterator_t), intent(in) :: it
	integer, intent(in) :: k
	type(quantum_numbers_t) :: qn
	type(node_t), pointer :: node
	integer :: i
	node => it%node
	SCAN: do i = it%depth, 1, -1
	if (i == k) then
	qn = node%qn
	exit SCAN
	else
	node => node%parent
	end if
	end do SCAN
	end function state_iterator_get_qn_single

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	module state_matrices_ut
	use unit_tests
	use state_matrices_uti

	<<Standard module head>>

	<<State matrices: public test>>

	contains

	<<State matrices: test driver>>

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

	module state_matrices_uti

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

	use state_matrices

	<<Standard module head>>

	<<State matrices: test declarations>>

	contains

	<<State matrices: tests>>

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	end subroutine state_matrix_1

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

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

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

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

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

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

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

	call state%final ()

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

	end subroutine state_matrix_2

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

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

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

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

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

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

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

	call state%write (u)

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

	call state%final ()

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

	end subroutine state_matrix_3

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

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

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

	allocate (state)

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

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

	call state%write (u)

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

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

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

	call state%write (u)

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

	call state%final ()
	deallocate (state)

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

	end subroutine state_matrix_4

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	deallocate (state_flv)

	call state%final ()
	deallocate (state)

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

	contains

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

	end subroutine state_matrix_5

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

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

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

	allocate (state_orig)
	call state_orig%init ()

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

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

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

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

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

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

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

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

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

	allocate (state_orig)
	call state_orig%init ()

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

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

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

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

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

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

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

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

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

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

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

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

	module interactions

	<<Use kinds>>
	use io_units
	use diagnostics
	use sorting
	use lorentz
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use state_matrices

	<<Standard module head>>

	<<Interactions: public>>

	<<Interactions: types>>

	<<Interactions: interfaces>>

	contains

	<<Interactions: procedures>>

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

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

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

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

	We consider helicity matrix elements only, when [[qn_hel]] is allocated.
	Else the helicity index is handled trivially as [[1]].
	<<Interactions: qn index map: TBP>>=
	generic :: init => qn_index_map_init
	procedure, private :: qn_index_map_init
	<<Interactions: procedures>>=
	subroutine qn_index_map_init (self, int, qn_flv, n_sub, qn_hel)
	class(qn_index_map_t), intent(out) :: self
	class(interaction_t), intent(in) :: int
	type(quantum_numbers_t), dimension(:, :), intent(in) :: qn_flv
	integer, intent(in) :: n_sub
	type(quantum_numbers_t), dimension(:, :), intent(in), optional :: qn_hel
	type(quantum_numbers_t), dimension(:), allocatable :: qn, qn_int
	integer :: i, i_flv, i_hel, i_sub
	self%qn_flv = qn_flv
	self%n_flv = size (qn_flv, dim=2)
	self%n_sub = n_sub
	if (present (qn_hel)) then
	if (size (qn_flv, dim=1) /= size (qn_hel, dim=1)) then
	call msg_bug ("[qn_index_map_init] number of particles does not match.")
	end if
	self%qn_hel = qn_hel
	self%n_hel = size (qn_hel, dim=2)
	else
	self%n_hel = 1
	end if
	allocate (self%index (self%n_flv, self%n_hel, 0:self%n_sub), source=0)
	associate (n_me => int%get_n_matrix_elements ())
	do i = 1, n_me
	qn_int = int%get_quantum_numbers (i, by_me_index = .true.)
	qn = pack (qn_int, qn_int%are_hard_process ())
	i_flv = find_flv_index (self, qn)
	i_hel = 1; if (allocated (self%qn_hel)) &
	i_hel = find_hel_index (self, qn)
	i_sub = find_sub_index (self, qn)
	self%index(i_flv, i_hel, i_sub) = i
	end do
	end associate
	contains
	integer function find_flv_index (self, qn) result (i_flv)
	type(qn_index_map_t), intent(in) :: self
	type(quantum_numbers_t), dimension(:), intent(in) :: qn
	integer :: j
	i_flv = 0
	do j = 1, self%n_flv
	if (.not. all (qn .fmatch. self%qn_flv(:, j))) cycle
	i_flv = j
	exit
	end do
	if (i_flv < 1) then
	call msg_message ("QN:")
	call quantum_numbers_write (qn)
	call msg_message ("")
	call msg_message ("QN_FLV:")
	do j = 1, self%n_flv
	call quantum_numbers_write (self%qn_flv(:, j))
	call msg_message ("")
	end do
	call msg_bug ("[find_flv_index] could not find flv in qn_flv.")
	end if
	end function find_flv_index

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

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

	@ %def qn_index_map_init
	@ Construct a trivial mapping.
	<<Interactions: qn index map: TBP>>=
	generic :: init => qn_index_map_init_trivial
	procedure, private :: qn_index_map_init_trivial
	<<Interactions: procedures>>=
	subroutine qn_index_map_init_trivial (self, int)
	class(qn_index_map_t), intent(out) :: self
	class(interaction_t), intent(in) :: int
	integer :: qn
	self%n_flv = int%get_n_matrix_elements ()
	self%n_hel = 1
	self%n_sub = 0
	allocate (self%index(self%n_flv, self%n_hel, 0:self%n_sub), source = 0)
	do qn = 1, self%n_flv
	self%index(qn, 1, 0) = qn
	end do
	end subroutine qn_index_map_init_trivial

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	@ %def interaction_get_momenta interaction_get_momentum
	@ This is a variant as a subroutine. Redundant, but the function
	above fails at times for gfortran 4.5.0 (double allocation, compiler
	bug).
	<<Interactions: interaction: TBP>>=
	procedure :: get_momenta_sub => interaction_get_momenta_sub
	<<Interactions: procedures>>=
	subroutine interaction_get_momenta_sub (int, p, outgoing)
	class(interaction_t), intent(in) :: int
	type(vector4_t), dimension(:), intent(out) :: p
	logical, intent(in), optional :: outgoing
	integer :: i
	do i = 1, size (p)
	p(i) = int%p(idx (int, i, outgoing))
	end do
	end subroutine interaction_get_momenta_sub

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

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

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

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

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

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

	@ %def interaction_get_cm_transformation
	@ Return flavor, momentum, and position of the first outgoing
	unstable particle present in the interaction. Note that we need not
	iterate through the state matrix; if there is an unstable particle, it
	will be present in all state-matrix entries.
	<<Interactions: public>>=
	public :: interaction_get_unstable_particle
	<<Interactions: procedures>>=
	subroutine interaction_get_unstable_particle (int, flv, p, i)
	type(interaction_t), intent(in), target :: int
	type(flavor_t), intent(out) :: flv
	type(vector4_t), intent(out) :: p
	integer, intent(out) :: i
	type(state_iterator_t) :: it
	type(flavor_t), dimension(int%n_tot) :: flv_array
	call it%init (int%state_matrix)
	flv_array = it%get_flavor ()
	do i = int%n_in + int%n_vir + 1, int%n_tot
	if (.not. flv_array(i)%is_stable ()) then
	flv = flv_array(i)
	p = int%p(i)
	return
	end if
	end do
	end subroutine interaction_get_unstable_particle

	@ %def interaction_get_unstable_particle
	@ Return the complete set of \emph{outgoing} flavors, assuming that
	the flavor quantum number is not suppressed.
	<<Interactions: public>>=
	public :: interaction_get_flv_out
	<<Interactions: procedures>>=
	subroutine interaction_get_flv_out (int, flv)
	type(interaction_t), intent(in), target :: int
	type(flavor_t), dimension(:,:), allocatable, intent(out) :: flv
	type(state_iterator_t) :: it
	type(flavor_t), dimension(:), allocatable :: flv_state
	integer :: n_in, n_vir, n_out, n_tot, n_state, i
	n_in = int%get_n_in ()
	n_vir = int%get_n_vir ()
	n_out = int%get_n_out ()
	n_tot = int%get_n_tot ()
	n_state = int%get_n_matrix_elements ()
	allocate (flv (n_out, n_state))
	allocate (flv_state (n_tot))
	i = 1
	call it%init (int%get_state_matrix_ptr ())
	do while (it%is_valid ())
	flv_state = it%get_flavor ()
	flv(:,i) = flv_state(n_in + n_vir + 1 : )
	i = i + 1
	call it%advance ()
	end do
	end subroutine interaction_get_flv_out

	@ %def interaction_get_flv_out
	@ Determine the flavor content of the interaction. We analyze the
	state matrix for this, and we select the outgoing particles of the
	hard process only for the required mask, which indicates the particles
	that can appear in any order in a matching event record.

	We have to assume that any radiated particles (beam remnants) appear
	at the beginning of the particles marked as outgoing.
	<<Interactions: public>>=
	public :: interaction_get_flv_content
	<<Interactions: procedures>>=
	subroutine interaction_get_flv_content (int, state_flv, n_out_hard)
	type(interaction_t), intent(in), target :: int
	type(state_flv_content_t), intent(out) :: state_flv
	integer, intent(in) :: n_out_hard
	logical, dimension(:), allocatable :: mask
	integer :: n_tot
	n_tot = int%get_n_tot ()
	allocate (mask (n_tot), source = .false.)
	mask(n_tot-n_out_hard + 1 : ) = .true.
	call state_flv%fill (int%get_state_matrix_ptr (), mask)
	end subroutine interaction_get_flv_content

	@ %def interaction_get_flv_content
	@
	\subsection{Modifying contents}
	Set the quantum numbers mask.
	<<Interactions: interaction: TBP>>=
	procedure :: set_mask => interaction_set_mask
	<<Interactions: procedures>>=
	subroutine interaction_set_mask (int, mask)
	class(interaction_t), intent(inout) :: int
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: mask
	if (size (int%mask) /= size (mask)) &
	call msg_fatal ("Attempting to set mask with unfitting size!")
	int%mask = mask
	int%update_state_matrix = .true.
	end subroutine interaction_set_mask

	@ %def interaction_set_mask
	@ Merge a particular mask entry, respecting a possible helicity lock for this
	entry. We apply an OR relation, which means that quantum numbers are
	summed over if either of the two masks requires it.
	<<Interactions: procedures>>=
	subroutine interaction_merge_mask_entry (int, i, mask)
	type(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	type(quantum_numbers_mask_t), intent(in) :: mask
	type(quantum_numbers_mask_t) :: mask_tmp
	integer :: ii
	ii = idx (int, i)
	if (int%mask(ii) .neqv. mask) then
	int%mask(ii) = int%mask(ii) .or. mask
	if (int%hel_lock(ii) /= 0) then
	call mask_tmp%assign (mask, helicity=.true.)
	int%mask(int%hel_lock(ii)) = int%mask(int%hel_lock(ii)) .or. mask_tmp
	end if
	end if
	int%update_state_matrix = .true.
	end subroutine interaction_merge_mask_entry

	@ %def interaction_merge_mask_entry
	@ Fill the momenta array, do not care about the quantum numbers of
	particles.
	<<Interactions: interaction: TBP>>=
	procedure :: reset_momenta => interaction_reset_momenta
	procedure :: set_momenta => interaction_set_momenta
	procedure :: set_momentum => interaction_set_momentum
	<<Interactions: procedures>>=
	subroutine interaction_reset_momenta (int)
	class(interaction_t), intent(inout) :: int
	int%p = vector4_null
	int%p_is_known = .true.
	end subroutine interaction_reset_momenta

	subroutine interaction_set_momenta (int, p, outgoing)
	class(interaction_t), intent(inout) :: int
	type(vector4_t), dimension(:), intent(in) :: p
	logical, intent(in), optional :: outgoing
	integer :: i, index
	do i = 1, size (p)
	index = idx (int, i, outgoing)
	int%p(index) = p(i)
	int%p_is_known(index) = .true.
	end do
	end subroutine interaction_set_momenta

	subroutine interaction_set_momentum (int, p, i, outgoing)
	class(interaction_t), intent(inout) :: int
	type(vector4_t), intent(in) :: p
	integer, intent(in) :: i
	logical, intent(in), optional :: outgoing
	integer :: index
	index = idx (int, i, outgoing)
	int%p(index) = p
	int%p_is_known(index) = .true.
	end subroutine interaction_set_momentum

	@ %def interaction_reset_momenta
	@ %def interaction_set_momenta interaction_set_momentum
	@ This more sophisticated version of setting values is used for
	structure functions, in particular if nontrivial flavor, color, and
	helicity may be present: set values selectively for the given flavors.
	If there is more than one flavor, scan the interaction and check for a
	matching flavor at the specified particle location. If it matches,
	insert the value that corresponds to this flavor.
	<<Interactions: public>>=
	public :: interaction_set_flavored_values
	<<Interactions: procedures>>=
	subroutine interaction_set_flavored_values (int, value, flv_in, pos)
	type(interaction_t), intent(inout) :: int
	complex(default), dimension(:), intent(in) :: value
	type(flavor_t), dimension(:), intent(in) :: flv_in
	integer, intent(in) :: pos
	type(state_iterator_t) :: it
	type(flavor_t) :: flv
	integer :: i
	if (size (value) == 1) then
	call int%set_matrix_element (value(1))
	else
	call it%init (int%state_matrix)
	do while (it%is_valid ())
	flv = it%get_flavor (pos)
	SCAN_FLV: do i = 1, size (value)
	if (flv == flv_in(i)) then
	call it%set_matrix_element (value(i))
	exit SCAN_FLV
	end if
	end do SCAN_FLV
	call it%advance ()
	end do
	end if
	end subroutine interaction_set_flavored_values

	@ %def interaction_set_flavored_values
	@
	\subsection{Handling Linked interactions}
	Store relations between corresponding particles within one
	interaction. The first particle is the parent, the second one the
	child. Links are established in both directions.

	These relations have no effect on the propagation of momenta etc.,
	they are rather used for mother-daughter relations in event output.
	<<Interactions: interaction: TBP>>=
	procedure :: relate => interaction_relate
	<<Interactions: procedures>>=
	subroutine interaction_relate (int, i1, i2)
	class(interaction_t), intent(inout), target :: int
	integer, intent(in) :: i1, i2
	if (i1 /= 0 .and. i2 /= 0) then
	call int%children(i1)%append (i2)
	call int%parents(i2)%append (i1)
	end if
	end subroutine interaction_relate

	@ %def interaction_relate
	@ Transfer internal parent-child relations defined within interaction
	[[int1]] to a new interaction [[int]] where the particle indices are
	mapped to. Some particles in [[int1]] may have no image in [[int]].
	In that case, a child entry maps to zero, and we skip this relation.

	Also transfer resonance flags.
	<<Interactions: interaction: TBP>>=
	procedure :: transfer_relations => interaction_transfer_relations
	<<Interactions: procedures>>=
	subroutine interaction_transfer_relations (int1, int2, map)
	class(interaction_t), intent(in) :: int1
	class(interaction_t), intent(inout), target :: int2
	integer, dimension(:), intent(in) :: map
	integer :: i, j, k
	do i = 1, size (map)
	do j = 1, int1%parents(i)%get_length ()
	k = int1%parents(i)%get_link (j)
	call int2%relate (map(k), map(i))
	end do
	if (map(i) /= 0) then
	int2%resonant(map(i)) = int1%resonant(i)
	end if
	end do
	end subroutine interaction_transfer_relations

	@ %def interaction_transfer_relations
	@ Make up internal parent-child relations for the particle(s) that are
	connected to a new interaction [[int]].

	If [[resonant]] is defined and true, the connections are marked as
	resonant in the result interaction
	<<Interactions: interaction: TBP>>=
	procedure :: relate_connections => interaction_relate_connections
	<<Interactions: procedures>>=
	subroutine interaction_relate_connections &
	(int, int_in, connection_index, &
	map, map_connections, resonant)
	class(interaction_t), intent(inout), target :: int
	class(interaction_t), intent(in) :: int_in
	integer, dimension(:), intent(in) :: connection_index
	integer, dimension(:), intent(in) :: map, map_connections
	logical, intent(in), optional :: resonant
	logical :: reson
	integer :: i, j, i2, k2
	reson = .false.; if (present (resonant)) reson = resonant
	do i = 1, size (map_connections)
	k2 = connection_index(i)
	do j = 1, int_in%children(k2)%get_length ()
	i2 = int_in%children(k2)%get_link (j)
	call int%relate (map_connections(i), map(i2))
	end do
	int%resonant(map_connections(i)) = reson
	end do
	end subroutine interaction_relate_connections

	@ %def interaction_relate_connections.
	@ Return the number of source/target links of the internal connections of
	particle [[i]].
	<<Interactions: public>>=
	public :: interaction_get_n_children
	public :: interaction_get_n_parents
	<<Interactions: procedures>>=
	function interaction_get_n_children (int, i) result (n)
	integer :: n
	type(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	n = int%children(i)%get_length ()
	end function interaction_get_n_children

	function interaction_get_n_parents (int, i) result (n)
	integer :: n
	type(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	n = int%parents(i)%get_length ()
	end function interaction_get_n_parents

	@ %def interaction_get_n_children interaction_get_n_parents
	@ Return the source/target links of the internal connections of
	particle [[i]] as an array.
	<<Interactions: public>>=
	public :: interaction_get_children
	public :: interaction_get_parents
	<<Interactions: procedures>>=
	function interaction_get_children (int, i) result (idx)
	integer, dimension(:), allocatable :: idx
	type(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	integer :: k, l
	l = int%children(i)%get_length ()
	allocate (idx (l))
	do k = 1, l
	idx(k) = int%children(i)%get_link (k)
	end do
	end function interaction_get_children

	function interaction_get_parents (int, i) result (idx)
	integer, dimension(:), allocatable :: idx
	type(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	integer :: k, l
	l = int%parents(i)%get_length ()
	allocate (idx (l))
	do k = 1, l
	idx(k) = int%parents(i)%get_link (k)
	end do
	end function interaction_get_parents

	@ %def interaction_get_children interaction_get_parents
	@ Add a source link from an interaction to a corresponding particle
	within another interaction. These links affect the propagation of
	particles: the two linked particles are considered as the same
	particle, outgoing and incoming.
	<<Interactions: interaction: TBP>>=
	procedure :: set_source_link => interaction_set_source_link
	<<Interactions: procedures>>=
	subroutine interaction_set_source_link (int, i, int1, i1)
	class(interaction_t), intent(inout) :: int
	integer, intent(in) :: i
	class(interaction_t), intent(in), target :: int1
	integer, intent(in) :: i1
	if (i /= 0) call external_link_set (int%source(i), int1, i1)
	end subroutine interaction_set_source_link

	@ %def interaction_set_source_link
	@ Reassign links to a new interaction (which is an image of the
	current interaction).
	<<Interactions: public>>=
	public :: interaction_reassign_links
	<<Interactions: procedures>>=
	subroutine interaction_reassign_links (int, int_src, int_target)
	type(interaction_t), intent(inout) :: int
	type(interaction_t), intent(in) :: int_src
	type(interaction_t), intent(in), target :: int_target
	integer :: i
	if (allocated (int%source)) then
	do i = 1, size (int%source)
	call external_link_reassign (int%source(i), int_src, int_target)
	end do
	end if
	end subroutine interaction_reassign_links

	@ %def interaction_reassign_links
	@ Since links are one-directional, if we want to follow them backwards
	we have to scan all possibilities. This procedure returns the index
	of the particle within [[int]] which points to the particle [[i1]]
	within interaction [[int1]]. If unsuccessful, return zero.
	<<Interactions: public>>=
	public :: interaction_find_link
	<<Interactions: procedures>>=
	function interaction_find_link (int, int1, i1) result (i)
	integer :: i
	type(interaction_t), intent(in) :: int, int1
	integer, intent(in) :: i1
	type(interaction_t), pointer :: int_tmp
	do i = 1, int%n_tot
	int_tmp => external_link_get_ptr (int%source(i))
	if (int_tmp%tag == int1%tag) then
	if (external_link_get_index (int%source(i)) == i1) return
	end if
	end do
	i = 0
	end function interaction_find_link

	@ %def interaction_find_link
	@ The inverse: return interaction pointer and index for the ultimate source of
	[[i]] within [[int]].
	<<Interactions: interaction: TBP>>=
	procedure :: find_source => interaction_find_source
	<<Interactions: procedures>>=
	subroutine interaction_find_source (int, i, int1, i1)
	class(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	type(interaction_t), intent(out), pointer :: int1
	integer, intent(out) :: i1
	type(external_link_t) :: link
	link = interaction_get_ultimate_source (int, i)
	int1 => external_link_get_ptr (link)
	i1 = external_link_get_index (link)
	end subroutine interaction_find_source

	@ %def interaction_find_source
	@ Follow source links recursively to return the ultimate source of a particle.
	<<Interactions: procedures>>=
	function interaction_get_ultimate_source (int, i) result (link)
	type(external_link_t) :: link
	type(interaction_t), intent(in) :: int
	integer, intent(in) :: i
	type(interaction_t), pointer :: int_src
	integer :: i_src
	link = int%source(i)
	if (external_link_is_set (link)) then
	do
	int_src => external_link_get_ptr (link)
	i_src = external_link_get_index (link)
	if (external_link_is_set (int_src%source(i_src))) then
	link = int_src%source(i_src)
	else
	exit
	end if
	end do
	end if
	end function interaction_get_ultimate_source

	@ %def interaction_get_ultimate_source
	@ Update mask entries by merging them with corresponding masks in
	interactions linked to the current one. The mask determines quantum
	numbers which are summed over.

	Note that both the mask of the current interaction and the mask of the
	linked interaction are updated (side effect!). This ensures that both
	agree for the linked particle.
	<<Interactions: public>>=
	public :: interaction_exchange_mask
	<<Interactions: procedures>>=
	subroutine interaction_exchange_mask (int)
	type(interaction_t), intent(inout) :: int
	integer :: i, index_link
	type(interaction_t), pointer :: int_link
	do i = 1, int%n_tot
	if (external_link_is_set (int%source(i))) then
	int_link => external_link_get_ptr (int%source(i))
	index_link = external_link_get_index (int%source(i))
	call interaction_merge_mask_entry &
	(int, i, int_link%mask(index_link))
	call interaction_merge_mask_entry &
	(int_link, index_link, int%mask(i))
	end if
	end do
	call int%freeze ()
	end subroutine interaction_exchange_mask

	@ %def interaction_exchange_mask
	@ Copy momenta from interactions linked to the current one.
	<<Interactions: interaction: TBP>>=
	procedure :: receive_momenta => interaction_receive_momenta
	<<Interactions: procedures>>=
	subroutine interaction_receive_momenta (int)
	class(interaction_t), intent(inout) :: int
	integer :: i, index_link
	type(interaction_t), pointer :: int_link
	do i = 1, int%n_tot
	if (external_link_is_set (int%source(i))) then
	int_link => external_link_get_ptr (int%source(i))
	index_link = external_link_get_index (int%source(i))
	call int%set_momentum (int_link%p(index_link), i)
	end if
	end do
	end subroutine interaction_receive_momenta

	@ %def interaction_receive_momenta
	@ The inverse operation: Copy momenta back to the interactions linked
	to the current one.
	<<Interactions: public>>=
	public :: interaction_send_momenta
	<<Interactions: procedures>>=
	subroutine interaction_send_momenta (int)
	type(interaction_t), intent(in) :: int
	integer :: i, index_link
	type(interaction_t), pointer :: int_link
	do i = 1, int%n_tot
	if (external_link_is_set (int%source(i))) then
	int_link => external_link_get_ptr (int%source(i))
	index_link = external_link_get_index (int%source(i))
	call int_link%set_momentum (int%p(i), index_link)
	end if
	end do
	end subroutine interaction_send_momenta

	@ %def interaction_send_momenta
	@ For numerical comparisons: pacify all momenta in an interaction.
	<<Interactions: public>>=
	public :: interaction_pacify_momenta
	<<Interactions: procedures>>=
	subroutine interaction_pacify_momenta (int, acc)
	type(interaction_t), intent(inout) :: int
	real(default), intent(in) :: acc
	integer :: i
	do i = 1, int%n_tot
	call pacify (int%p(i), acc)
	end do
	end subroutine interaction_pacify_momenta

	@ %def interaction_pacify_momenta
	@ For each subtraction entry starting from [[SUB = 0]], we duplicate the original state matrix entries as is.
	<<Interactions: interaction: TBP>>=
	procedure :: declare_subtraction => interaction_declare_subtraction
	<<Interactions: procedures>>=
	subroutine interaction_declare_subtraction (int, n_sub)
	class(interaction_t), intent(inout), target :: int
	integer, intent(in) :: n_sub
	integer :: i_sub
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	type(state_matrix_t) :: state_matrix
	call state_matrix%init (store_values = .true.)
	allocate (qn (int%get_state_depth ()))
	do i_sub = 0, n_sub
	call it%init (int%state_matrix)
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	call qn%set_subtraction_index (i_sub)
	call state_matrix%add_state (qn, value = it%get_matrix_element ())
	call it%advance ()
	end do
	end do
	call state_matrix%freeze ()
	call state_matrix%set_n_sub ()
	call int%state_matrix%final ()
	int%state_matrix = state_matrix
	end subroutine interaction_declare_subtraction

	@ %def interaction_declare_subtraction
	@
	\subsection{Recovering connections}
	When creating an evaluator for two interactions, we have to know by
	which particles they are connected. The connection indices can be
	determined if we have two linked interactions. We assume that
	[[int1]] is the source and [[int2]] the target, so the connections of
	interest are stored within [[int2]]. A connection is found if either the
	source is [[int1]], or the (ultimate)
	source of a particle within [[int2]] coincides with the (ultimate) source of a
	aparticle within [[int1]]. The result is an array of
	index pairs.

	To make things simple, we scan the interaction twice,
	once for counting hits, then allocate the array, then scan again and
	store the connections.

	The connections are scanned for [[int2]], which has sources in [[int1]]. It
	may happen that the order of connections is interchanged (crossed). We
	require the indices in [[int1]] to be sorted, so we reorder both index arrays
	correspondingly before returning them. (After this, the indices in [[int2]]
	may be out of order.)
	<<Interactions: public>>=
	public :: find_connections
	<<Interactions: procedures>>=
	subroutine find_connections (int1, int2, n, connection_index)
	class(interaction_t), intent(in) :: int1, int2
	integer, intent(out) :: n
	integer, dimension(:,:), intent(out), allocatable :: connection_index
	integer, dimension(:,:), allocatable :: conn_index_tmp
	integer, dimension(:), allocatable :: ordering
	integer :: i, j, k
	type(external_link_t) :: link1, link2
	type(interaction_t), pointer :: int_link1, int_link2
	n = 0
	do i = 1, size (int2%source)
	link2 = interaction_get_ultimate_source (int2, i)
	if (external_link_is_set (link2)) then
	int_link2 => external_link_get_ptr (link2)
	if (int_link2%tag == int1%tag) then
	n = n + 1
	else
	k = external_link_get_index (link2)
	do j = 1, size (int1%source)
	link1 = interaction_get_ultimate_source (int1, j)
	if (external_link_is_set (link1)) then
	int_link1 => external_link_get_ptr (link1)
	if (int_link1%tag == int_link2%tag) then
	if (external_link_get_index (link1) == k) &
	n = n + 1
	end if
	end if
	end do
	end if
	end if
	end do
	allocate (conn_index_tmp (n, 2))
	n = 0
	do i = 1, size (int2%source)
	link2 = interaction_get_ultimate_source (int2, i)
	if (external_link_is_set (link2)) then
	int_link2 => external_link_get_ptr (link2)
	if (int_link2%tag == int1%tag) then
	n = n + 1
	conn_index_tmp(n,1) = external_link_get_index (int2%source(i))
	conn_index_tmp(n,2) = i
	else
	k = external_link_get_index (link2)
	do j = 1, size (int1%source)
	link1 = interaction_get_ultimate_source (int1, j)
	if (external_link_is_set (link1)) then
	int_link1 => external_link_get_ptr (link1)
	if (int_link1%tag == int_link2%tag) then
	if (external_link_get_index (link1) == k) then
	n = n + 1
	conn_index_tmp(n,1) = j
	conn_index_tmp(n,2) = i
	end if
	end if
	end if
	end do
	end if
	end if
	end do
	allocate (connection_index (n, 2))
	if (n > 1) then
	allocate (ordering (n))
	ordering = order (conn_index_tmp(:,1))
	connection_index = conn_index_tmp(ordering,:)
	else
	connection_index = conn_index_tmp
	end if
	end subroutine find_connections

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

	module interactions_ut
	use unit_tests
	use interactions_uti

	<<Standard module head>>

	<<Interactions: public test>>

	contains

	<<Interactions: test driver>>

	end module interactions_ut
	@ %def interactions_ut
	@
	<<[[interactions_uti.f90]]>>=
	<<File header>>

	module interactions_uti

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

	use interactions

	<<Standard module head>>

	<<Interactions: test declarations>>

	contains

	<<Interactions: tests>>

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

	@ %def interaction_test
	@ Generate an interaction of a polarized virtual photon and a colored
	quark which may be either up or down. Remove the quark polarization.
	Generate another interaction for the quark radiating a photon and link
	this to the first interation. The radiation ignores polarization;
	transfer this information to the first interaction to simplify it.
	Then, transfer the momentum to the radiating quark and perform a
	splitting.
	<<Interactions: execute tests>>=
	call test (interaction_1, "interaction_1", &
	"check interaction setup", &
	u, results)
	<<Interactions: test declarations>>=
	public :: interaction_1
	<<Interactions: tests>>=
	subroutine interaction_1 (u)
	integer, intent(in) :: u
	type(interaction_t), target :: int, rad
	type(vector4_t), dimension(3) :: p
	type(quantum_numbers_mask_t), dimension(3) :: mask
	p(2) = vector4_moving (500._default, 500._default, 1)
	p(3) = vector4_moving (500._default,-500._default, 1)
	p(1) = p(2) + p(3)

	write (u, "(A)") "* Test output: interaction"
	write (u, "(A)") "* Purpose: check routines for interactions"
	write (u, "(A)")

	call int%basic_init (1, 0, 2, set_relations=.true., &
	store_values = .true. )
	call int_set (int, 1, -1, 1, 1, &
	cmplx (0.3_default, 0.1_default, kind=default))
	call int_set (int, 1, -1,-1, 1, &
	cmplx (0.5_default,-0.7_default, kind=default))
	call int_set (int, 1, 1, 1, 1, &
	cmplx (0.1_default, 0._default, kind=default))
	call int_set (int, -1, 1, -1, 2, &
	cmplx (0.4_default, -0.1_default, kind=default))
	call int_set (int, 1, 1, 1, 2, &
	cmplx (0.2_default, 0._default, kind=default))
	call int%freeze ()
	call int%set_momenta (p)
	mask = quantum_numbers_mask (.false.,.false., [.true.,.true.,.true.])
	call rad%basic_init (1, 0, 2, &
	mask=mask, set_relations=.true., store_values = .true.)
	call rad_set (1)
	call rad_set (2)
	call rad%set_source_link (1, int, 2)
	call interaction_exchange_mask (rad)
	call rad%receive_momenta ()
	p(1) = rad%get_momentum (1)
	p(2) = 0.4_default * p(1)
	p(3) = p(1) - p(2)
	call rad%set_momenta (p(2:3), outgoing=.true.)
	call int%freeze ()
	call rad%freeze ()
	call rad%set_matrix_element &
	(cmplx (0._default, 0._default, kind=default))
	call int%basic_write (u)
	write (u, "(A)")
	call rad%basic_write (u)
	write (u, "(A)")
	write (u, "(A)") "* Cleanup"
	call int%final ()
	call rad%final ()
	write (u, "(A)")
	write (u, "(A)") "* Test interaction_1: successful."
	contains
	subroutine int_set (int, h1, h2, hq, q, val)
	type(interaction_t), target, intent(inout) :: int
	integer, intent(in) :: h1, h2, hq, q
	type(flavor_t), dimension(3) :: flv
	type(color_t), dimension(3) :: col
	type(helicity_t), dimension(3) :: hel
	type(quantum_numbers_t), dimension(3) :: qn
	complex(default), intent(in) :: val
	call flv%init ([21, q, -q])
	call col(2)%init_col_acl (5, 0)
	call col(3)%init_col_acl (0, 5)
	call hel%init ([h1, hq, -hq], [h2, hq, -hq])
	call qn%init (flv, col, hel)
	call int%add_state (qn)
	call int%set_matrix_element (val)
	end subroutine int_set
	subroutine rad_set (q)
	integer, intent(in) :: q
	type(flavor_t), dimension(3) :: flv
	type(quantum_numbers_t), dimension(3) :: qn
	call flv%init ([ q, q, 21 ])
	call qn%init (flv)
	call rad%add_state (qn)
	end subroutine rad_set
	end subroutine interaction_1

	@ %def interaction_1
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Matrix element evaluation}

	The [[evaluator_t]] type is an extension of the [[interaction_t]]
	type. It represents either a density matrix as the square of a
	transition matrix element, or the product of two density matrices.
	Usually, some quantum numbers are summed over in the result.

	The [[interaction_t]] subobject represents a multi-particle
	interaction with incoming, virtual, and outgoing particles and the
	associated (not necessarily diagonal) density matrix of quantum
	state. When the evaluator is initialized, this interaction is
	constructed from the input interaction(s).

	In addition, the initialization process sets up a multiplication
	table. For each matrix element of the result, it states which matrix
	elements are to be taken from the input interaction(s), multiplied
	(optionally, with an additional weight factor) and summed over.

	Eventually, to a processes we associate a chain of evaluators which
	are to be evaluated sequentially. The physical event and its matrix
	element value(s) can be extracted from the last evaluator in such a
	chain.

	Evaluators are constructed only once (as long as this is possible)
	during an initialization step. Then, for each event, momenta
	are computed and transferred among evaluators using the links within
	the interaction subobject. The multiplication tables enable fast
	evaluation of the result without looking at quantum numbers anymore.
	<<[[evaluators.f90]]>>=
	<<File header>>

	module evaluators

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_19
	use physics_defs, only: n_beam_structure_int
	use diagnostics
	use lorentz
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use state_matrices
	use interactions

	<<Standard module head>>

	<<Evaluators: public>>

	<<Evaluators: parameters>>

	<<Evaluators: types>>

	<<Evaluators: interfaces>>

	contains

	<<Evaluators: procedures>>

	end module evaluators
	@ %def evaluators
	@
	\subsection{Array of pairings}
	The evaluator contains an array of [[pairing_array]] objects. This
	makes up the multiplication table.

	Each pairing array contains two list of matrix element indices and a
	list of numerical factors. The matrix element indices correspond to
	the input interactions. The corresponding matrix elements are to be
	multiplied and optionally multiplied by a factor. The results are
	summed over to yield one specific matrix element of the result
	evaluator.
	<<Evaluators: types>>=
	type :: pairing_array_t
	integer, dimension(:), allocatable :: i1, i2
	complex(default), dimension(:), allocatable :: factor
	end type pairing_array_t

	@ %def pairing_array_t
	<<Evaluators: procedures>>=
	elemental subroutine pairing_array_init (pa, n, has_i2, has_factor)
	type(pairing_array_t), intent(out) :: pa
	integer, intent(in) :: n
	logical, intent(in) :: has_i2, has_factor
	allocate (pa%i1 (n))
	if (has_i2) allocate (pa%i2 (n))
	if (has_factor) allocate (pa%factor (n))
	end subroutine pairing_array_init

	@ %def pairing_array_init
	@
	<<Evaluators: public>>=
	public :: pairing_array_write
	<<Evaluators: procedures>>=
	subroutine pairing_array_write (pa, unit)
	type(pairing_array_t), intent(in) :: pa
	integer, intent(in), optional :: unit
	integer :: i, u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A)", advance = "no") "["
	if (allocated (pa%i1)) then
	write (u, "(I0,A)", advance = "no") pa%i1, ","
	else
	write (u, "(A)", advance = "no") "x,"
	end if
	if (allocated (pa%i2)) then
	write (u, "(I0,A)", advance = "no") pa%i1, ","
	else
	write (u, "(A)", advance = "no") "x,"
	end if
	write (u, "(A)", advance = "no") "]"
	if (allocated (pa%factor)) then
	write (u, "(A,F5.4,A,F5.4,A)") ";(", &
	real(pa%factor), ",", aimag(pa%factor), ")]"
	else
	write (u, "(A)") ""
	end if
	end subroutine pairing_array_write

	@ %def pairing_array_write
	@
	\subsection{The evaluator type}
	Possible variants of evaluators:
	<<Evaluators: parameters>>=
	integer, parameter :: &
	EVAL_UNDEFINED = 0, &
	EVAL_PRODUCT = 1, &
	EVAL_SQUARED_FLOWS = 2, &
	EVAL_SQUARE_WITH_COLOR_FACTORS = 3, &
	EVAL_COLOR_CONTRACTION = 4, &
	EVAL_IDENTITY = 5, &
	EVAL_QN_SUM = 6
	@ %def EVAL_PRODUCT EVAL_SQUARED_FLOWS EVAL_SQUARE_WITH_COLOR_FACTORS
	@ %def EVAL_COLOR_CONTRACTION EVAL_QN_SUM
	@ The evaluator type contains the result interaction and an array of
	pairing lists, one for each matrix element in the result interaction.
	<<Evaluators: public>>=
	public :: evaluator_t
	<<Evaluators: types>>=
	type, extends (interaction_t) :: evaluator_t
	private
	integer :: type = EVAL_UNDEFINED
	class(interaction_t), pointer :: int_in1 => null ()
	class(interaction_t), pointer :: int_in2 => null ()
	type(pairing_array_t), dimension(:), allocatable :: pairing_array
	contains
	<<Evaluators: evaluator: TBP>>
	end type evaluator_t

	@ %def evaluator_t
	@ Output.
	<<Evaluators: evaluator: TBP>>=
	procedure :: write => evaluator_write
	<<Evaluators: procedures>>=
	subroutine evaluator_write (eval, unit, &
	verbose, show_momentum_sum, show_mass, show_state, show_table, &
	col_verbose, testflag)
	class(evaluator_t), intent(in) :: eval
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, show_momentum_sum, show_mass
	logical, intent(in), optional :: show_state, show_table, col_verbose
	logical, intent(in), optional :: testflag
	logical :: conjugate, square, show_tab
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	show_tab = .true.; if (present (show_table)) show_tab = .false.
	call eval%basic_write &
	(unit, verbose, show_momentum_sum, show_mass, &
	show_state, col_verbose, testflag)
	if (show_tab) then
	write (u, "(1x,A)") "Matrix-element multiplication"
	write (u, "(2x,A)", advance="no") "Input interaction 1:"
	if (associated (eval%int_in1)) then
	write (u, "(1x,I0)") eval%int_in1%get_tag ()
	else
	write (u, "(A)") " [undefined]"
	end if
	write (u, "(2x,A)", advance="no") "Input interaction 2:"
	if (associated (eval%int_in2)) then
	write (u, "(1x,I0)") eval%int_in2%get_tag ()
	else
	write (u, "(A)") " [undefined]"
	end if
	select case (eval%type)
	case (EVAL_SQUARED_FLOWS, EVAL_SQUARE_WITH_COLOR_FACTORS)
	conjugate = .true.
	square = .true.
	case (EVAL_IDENTITY)
	write (u, "(1X,A)") "Identity evaluator, pairing array unused"
	return
	case default
	conjugate = .false.
	square = .false.
	end select
	call eval%write_pairing_array (conjugate, square, u)
	end if
	end subroutine evaluator_write

	@ %def evaluator_write
	@
	<<Evaluators: evaluator: TBP>>=
	procedure :: write_pairing_array => evaluator_write_pairing_array
	<<Evaluators: procedures>>=
	subroutine evaluator_write_pairing_array (eval, conjugate, square, unit)
	class(evaluator_t), intent(in) :: eval
	logical, intent(in) :: conjugate, square
	integer, intent(in), optional :: unit
	integer :: u, i, j
	u = given_output_unit (unit); if (u < 0) return
	if (allocated (eval%pairing_array)) then
	do i = 1, size (eval%pairing_array)
	write (u, "(2x,A,I0,A)") "ME(", i, ") = "
	do j = 1, size (eval%pairing_array(i)%i1)
	write (u, "(4x,A)", advance="no") "+"
	if (allocated (eval%pairing_array(i)%i2)) then
	write (u, "(1x,A,I0,A)", advance="no") &
	"ME1(", eval%pairing_array(i)%i1(j), ")"
	if (conjugate) then
	write (u, "(A)", advance="no") "* x"
	else
	write (u, "(A)", advance="no") " x"
	end if
	write (u, "(1x,A,I0,A)", advance="no") &
	"ME2(", eval%pairing_array(i)%i2(j), ")"
	else if (square) then
	write (u, "(1x,A)", advance="no") "\|"
	write (u, "(A,I0,A)", advance="no") &
	"ME1(", eval%pairing_array(i)%i1(j), ")"
	write (u, "(A)", advance="no") "\|^2"
	else
	write (u, "(1x,A,I0,A)", advance="no") &
	"ME1(", eval%pairing_array(i)%i1(j), ")"
	end if
	if (allocated (eval%pairing_array(i)%factor)) then
	write (u, "(1x,A)", advance="no") "x"
	write (u, "(1x,'('," // FMT_19 // ",','," // FMT_19 // &
	",')')") eval%pairing_array(i)%factor(j)
	else
	write (u, *)
	end if
	end do
	end do
	end if
	end subroutine evaluator_write_pairing_array

	@ %def evaluator_write_pairing_array
	@ Assignment: Deep copy of the interaction component.
	<<Evaluators: public>>=
	public :: assignment(=)
	<<Evaluators: interfaces>>=
	interface assignment(=)
	module procedure evaluator_assign
	end interface

	<<Evaluators: procedures>>=
	subroutine evaluator_assign (eval_out, eval_in)
	type(evaluator_t), intent(out) :: eval_out
	type(evaluator_t), intent(in) :: eval_in
	eval_out%type = eval_in%type
	eval_out%int_in1 => eval_in%int_in1
	eval_out%int_in2 => eval_in%int_in2
	eval_out%interaction_t = eval_in%interaction_t
	if (allocated (eval_in%pairing_array)) then
	allocate (eval_out%pairing_array (size (eval_in%pairing_array)))
	eval_out%pairing_array = eval_in%pairing_array
	end if
	end subroutine evaluator_assign

	@ %def evaluator_assign
	@
	\subsection{Auxiliary structures for evaluator creation}
	Creating an evaluator that properly handles all quantum numbers requires some
	bookkeeping. In this section, we define several auxiliary types and methods
	that organize and simplify this task. More structures are defined within the
	specific initializers (as local types and internal subroutines).

	These types are currently implemented in a partial object-oriented way: We
	define some basic methods for initialization etc.\ here, but the evaluator
	routines below do access their internals as well. This simplifies some things
	such as index addressing using array slices, at the expense of losing some
	clarity.

	\subsubsection{Index mapping}
	Index mapping are abundant when constructing an evaluator. To have arrays of
	index mappings, we define this:
	<<Evaluators: types>>=
	type :: index_map_t
	integer, dimension(:), allocatable :: entry
	end type index_map_t

	@ %def index_map_t
	<<Evaluators: procedures>>=
	elemental subroutine index_map_init (map, n)
	type(index_map_t), intent(out) :: map
	integer, intent(in) :: n
	allocate (map%entry (n))
	map%entry = 0
	end subroutine index_map_init

	@ %def index_map_init
	<<Evaluators: procedures>>=
	function index_map_exists (map) result (flag)
	logical :: flag
	type(index_map_t), intent(in) :: map
	flag = allocated (map%entry)
	end function index_map_exists

	@ %def index_map_exists
	<<Evaluators: interfaces>>=
	interface size
	module procedure index_map_size
	end interface

	@ %def size
	<<Evaluators: procedures>>=
	function index_map_size (map) result (s)
	integer :: s
	type(index_map_t), intent(in) :: map
	if (allocated (map%entry)) then
	s = size (map%entry)
	else
	s = 0
	end if
	end function index_map_size

	@ %def index_map_size
	<<Evaluators: interfaces>>=
	interface assignment(=)
	module procedure index_map_assign_int
	module procedure index_map_assign_array
	end interface

	@ %def =
	<<Evaluators: procedures>>=
	elemental subroutine index_map_assign_int (map, ival)
	type(index_map_t), intent(inout) :: map
	integer, intent(in) :: ival
	map%entry = ival
	end subroutine index_map_assign_int

	subroutine index_map_assign_array (map, array)
	type(index_map_t), intent(inout) :: map
	integer, dimension(:), intent(in) :: array
	map%entry = array
	end subroutine index_map_assign_array

	@ %def index_map_assign_int index_map_assign_array
	<<Evaluators: procedures>>=
	elemental subroutine index_map_set_entry (map, i, ival)
	type(index_map_t), intent(inout) :: map
	integer, intent(in) :: i
	integer, intent(in) :: ival
	map%entry(i) = ival
	end subroutine index_map_set_entry

	@ %def index_map_set_entry
	<<Evaluators: procedures>>=
	elemental function index_map_get_entry (map, i) result (ival)
	integer :: ival
	type(index_map_t), intent(in) :: map
	integer, intent(in) :: i
	ival = map%entry(i)
	end function index_map_get_entry

	@ %def index_map_get_entry
	@
	\subsubsection{Index mapping (two-dimensional)}
	This is a variant with a square matrix instead of an array.
	<<Evaluators: types>>=
	type :: index_map2_t
	integer :: s = 0
	integer, dimension(:,:), allocatable :: entry
	end type index_map2_t

	@ %def index_map2_t
	<<Evaluators: procedures>>=
	elemental subroutine index_map2_init (map, n)
	type(index_map2_t), intent(out) :: map
	integer, intent(in) :: n
	map%s = n
	allocate (map%entry (n, n))
	end subroutine index_map2_init

	@ %def index_map2_init
	<<Evaluators: procedures>>=
	function index_map2_exists (map) result (flag)
	logical :: flag
	type(index_map2_t), intent(in) :: map
	flag = allocated (map%entry)
	end function index_map2_exists

	@ %def index_map2_exists
	<<Evaluators: interfaces>>=
	interface size
	module procedure index_map2_size
	end interface

	@ %def size
	<<Evaluators: procedures>>=
	function index_map2_size (map) result (s)
	integer :: s
	type(index_map2_t), intent(in) :: map
	s = map%s
	end function index_map2_size

	@ %def index_map2_size
	<<Evaluators: interfaces>>=
	interface assignment(=)
	module procedure index_map2_assign_int
	end interface

	@ %def =
	<<Evaluators: procedures>>=
	elemental subroutine index_map2_assign_int (map, ival)
	type(index_map2_t), intent(inout) :: map
	integer, intent(in) :: ival
	map%entry = ival
	end subroutine index_map2_assign_int

	@ %def index_map2_assign_int
	<<Evaluators: procedures>>=
	elemental subroutine index_map2_set_entry (map, i, j, ival)
	type(index_map2_t), intent(inout) :: map
	integer, intent(in) :: i, j
	integer, intent(in) :: ival
	map%entry(i,j) = ival
	end subroutine index_map2_set_entry

	@ %def index_map2_set_entry
	<<Evaluators: procedures>>=
	elemental function index_map2_get_entry (map, i, j) result (ival)
	integer :: ival
	type(index_map2_t), intent(in) :: map
	integer, intent(in) :: i, j
	ival = map%entry(i,j)
	end function index_map2_get_entry

	@ %def index_map2_get_entry
	@
	\subsubsection{Auxiliary structures: particle mask}
	This is a simple container of a logical array.
	<<Evaluators: types>>=
	type :: prt_mask_t
	logical, dimension(:), allocatable :: entry
	end type prt_mask_t

	@ %def prt_mask_t
	<<Evaluators: procedures>>=
	subroutine prt_mask_init (mask, n)
	type(prt_mask_t), intent(out) :: mask
	integer, intent(in) :: n
	allocate (mask%entry (n))
	end subroutine prt_mask_init

	@ %def prt_mask_init
	<<Evaluators: interfaces>>=
	interface size
	module procedure prt_mask_size
	end interface

	@ %def size
	<<Evaluators: procedures>>=
	function prt_mask_size (mask) result (s)
	integer :: s
	type(prt_mask_t), intent(in) :: mask
	s = size (mask%entry)
	end function prt_mask_size

	@ %def prt_mask_size
	@
	\subsubsection{Quantum number containers}
	Trivial transparent containers:
	<<Evaluators: types>>=
	type :: qn_list_t
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	end type qn_list_t

	type :: qn_mask_array_t
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
	end type qn_mask_array_t

	@ %def qn_list_t qn_mask_array_t
	@
	\subsubsection{Auxiliary structures: connection entries}
	This type is used as intermediate storage when computing the product of two
	evaluators or the square of an evaluator. The quantum-number array [[qn]]
	corresponds to the particles common to both interactions, but irrelevant
	quantum numbers (color) masked out. The index arrays [[index_in]] determine
	the entries in the input interactions that contribute to this connection.
	[[n_index]] is the size of these arrays, and [[count]] is used while filling
	the entries. Finally, the quantum-number arrays [[qn_in_list]] are the actual
	entries in the input interaction that contribute. In the product case, they
	exclude the connected quantum numbers.

	Each evaluator has its own [[connection_table]] which contains an array of
	[[connection_entry]] objects, but also has stuff that specifically applies to
	the evaluator type. Hence, we do not generalize the [[connection_table_t]]
	type.

	The filling procedure [[connection_entry_add_state]] is specific to the
	various evaluator types.
	<<Evaluators: types>>=
	type :: connection_entry_t
	type(quantum_numbers_t), dimension(:), allocatable :: qn_conn
	integer, dimension(:), allocatable :: n_index
	integer, dimension(:), allocatable :: count
	type(index_map_t), dimension(:), allocatable :: index_in
	type(qn_list_t), dimension(:), allocatable :: qn_in_list
	end type connection_entry_t

	@ %def connection_entry_t
	<<Evaluators: procedures>>=
	subroutine connection_entry_init &
	(entry, n_count, n_map, qn_conn, count, n_rest)
	type(connection_entry_t), intent(out) :: entry
	integer, intent(in) :: n_count, n_map
	type(quantum_numbers_t), dimension(:), intent(in) :: qn_conn
	integer, dimension(n_count), intent(in) :: count
	integer, dimension(n_count), intent(in) :: n_rest
	integer :: i
	allocate (entry%qn_conn (size (qn_conn)))
	allocate (entry%n_index (n_count))
	allocate (entry%count (n_count))
	allocate (entry%index_in (n_map))
	allocate (entry%qn_in_list (n_count))
	entry%qn_conn = qn_conn
	entry%n_index = count
	entry%count = 0
	if (size (entry%index_in) == size (count)) then
	call index_map_init (entry%index_in, count)
	else
	call index_map_init (entry%index_in, count(1))
	end if
	do i = 1, n_count
	allocate (entry%qn_in_list(i)%qn (n_rest(i), count(i)))
	end do
	end subroutine connection_entry_init

	@ %def connection_entry_init
	<<Evaluators: procedures>>=
	subroutine connection_entry_write (entry, unit)
	type(connection_entry_t), intent(in) :: entry
	integer, intent(in), optional :: unit
	integer :: i, j
	integer :: u
	u = given_output_unit (unit)
	call quantum_numbers_write (entry%qn_conn, unit)
	write (u, *)
	do i = 1, size (entry%n_index)
	write (u, *) "Input interaction", i
	do j = 1, entry%n_index(i)
	if (size (entry%n_index) == size (entry%index_in)) then
	write (u, "(2x,I0,4x,I0,2x)", advance = "no") &
	j, index_map_get_entry (entry%index_in(i), j)
	else
	write (u, "(2x,I0,4x,I0,2x,I0,2x)", advance = "no") &
	j, index_map_get_entry (entry%index_in(1), j), &
	index_map_get_entry (entry%index_in(2), j)
	end if
	call quantum_numbers_write (entry%qn_in_list(i)%qn(:,j), unit)
	write (u, *)
	end do
	end do
	end subroutine connection_entry_write

	@ %def connection_entry_write
	@
	\subsubsection{Color handling}
	For managing color-factor computation, we introduce this local type. The
	[[index]] is the index in the color table that corresponds to a given matrix
	element index in the input interaction. The [[col]] array stores the color
	assignments in rows. The [[factor]] array associates a complex number with
	each pair of arrays in the color table. The [[factor_is_known]] array reveals
	whether a given factor is known already or still has to be computed.
	<<Evaluators: types>>=
	type :: color_table_t
	integer, dimension(:), allocatable :: index
	type(color_t), dimension(:,:), allocatable :: col
	logical, dimension(:,:), allocatable :: factor_is_known
	complex(default), dimension(:,:), allocatable :: factor
	end type color_table_t

	@ %def color_table_t
	@ This is the initializer. We extract the color states from the given state
	matrices, establish index mappings between the two states (implemented by the
	array [[me_index]]), make an array of color states, and initialize the
	color-factor table. The latter is two-dimensional (includes interference) and
	not yet filled.
	<<Evaluators: procedures>>=
	subroutine color_table_init (color_table, state, n_tot)
	type(color_table_t), intent(out) :: color_table
	type(state_matrix_t), intent(in) :: state
	integer, intent(in) :: n_tot
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	type(state_matrix_t) :: state_col
	integer :: index, n_col_state
	allocate (color_table%index (state%get_n_matrix_elements ()))
	color_table%index = 0
	allocate (qn (n_tot))
	call state_col%init ()
	call it%init (state)
	do while (it%is_valid ())
	index = it%get_me_index ()
	call qn%init (col = it%get_color ())
	call state_col%add_state (qn, me_index = color_table%index(index))
	call it%advance ()
	end do
	n_col_state = state_col%get_n_matrix_elements ()
	allocate (color_table%col (n_tot, n_col_state))
	call it%init (state_col)
	do while (it%is_valid ())
	index = it%get_me_index ()
	color_table%col(:,index) = it%get_color ()
	call it%advance ()
	end do
	call state_col%final ()
	allocate (color_table%factor_is_known (n_col_state, n_col_state))
	allocate (color_table%factor (n_col_state, n_col_state))
	color_table%factor_is_known = .false.
	end subroutine color_table_init

	@ %def color_table_init
	@ Output (debugging use):
	<<Evaluators: procedures>>=
	subroutine color_table_write (color_table, unit)
	type(color_table_t), intent(in) :: color_table
	integer, intent(in), optional :: unit
	integer :: i, j
	integer :: u
	u = given_output_unit (unit)
	write (u, *) "Color table:"
	if (allocated (color_table%index)) then
	write (u, *) " Index mapping state => color table:"
	do i = 1, size (color_table%index)
	write (u, "(3x,I0,2x,I0,2x)") i, color_table%index(i)
	end do
	write (u, *) " Color table:"
	do i = 1, size (color_table%col, 2)
	write (u, "(3x,I0,2x)", advance = "no") i
	call color_write (color_table%col(:,i), unit)
	write (u, *)
	end do
	write (u, *) " Defined color factors:"
	do i = 1, size (color_table%factor, 1)
	do j = 1, size (color_table%factor, 2)
	if (color_table%factor_is_known(i,j)) then
	write (u, *) i, j, color_table%factor(i,j)
	end if
	end do
	end do
	end if
	end subroutine color_table_write

	@ %def color_table_write
	@ This subroutine sets color factors, based on information from the hard
	matrix element: the list of pairs of color-flow indices (in the basis of the
	matrix element code), the list of corresponding factors, and the list of
	mappings from the matrix element index in the input interaction to the
	color-flow index in the hard matrix element object.

	We first determine the mapping of color-flow indices from the hard matrix
	element code to the current color table. The mapping could be nontrivial
	because the latter is derived from iterating over a state matrix, which may
	return states in non-canonical order. The translation table can be determined
	because we have, for the complete state matrix, both the mapping to the hard
	interaction (the input [[col_index_hi]]) and the mapping to the current
	color table (the component [[color_table%index]]).

	Once this mapping is known, we scan the list of index pairs
	[[color_flow_index]] and translate them to valid color-table index pairs. For
	this pair, the color factor is set using the corresponding entry in the list
	[[col_factor]].
	<<Evaluators: procedures>>=
	subroutine color_table_set_color_factors (color_table, &
	col_flow_index, col_factor, col_index_hi)
	type(color_table_t), intent(inout) :: color_table
	integer, dimension(:,:), intent(in) :: col_flow_index
	complex(default), dimension(:), intent(in) :: col_factor
	integer, dimension(:), intent(in) :: col_index_hi
	integer, dimension(:), allocatable :: hi_to_ct
	integer :: n_cflow
	integer :: hi_index, me_index, ct_index, cf_index
	integer, dimension(2) :: hi_index_pair, ct_index_pair
	n_cflow = size (col_index_hi)
	if (size (color_table%index) /= n_cflow) &
	call msg_bug ("Mismatch between hard matrix element and color table")
	allocate (hi_to_ct (n_cflow))
	do me_index = 1, size (color_table%index)
	ct_index = color_table%index(me_index)
	hi_index = col_index_hi(me_index)
	hi_to_ct(hi_index) = ct_index
	end do
	do cf_index = 1, size (col_flow_index, 2)
	hi_index_pair = col_flow_index(:,cf_index)
	ct_index_pair = hi_to_ct(hi_index_pair)
	color_table%factor(ct_index_pair(1), ct_index_pair(2)) = &
	col_factor(cf_index)
	color_table%factor_is_known(ct_index_pair(1), ct_index_pair(2)) = .true.
	end do
	end subroutine color_table_set_color_factors

	@ %def color_table_set_color_factors
	@ This function returns a color factor, given two indices which point to the
	matrix elements of the initial state matrix. Internally, we can map them to
	the corresponding indices in the color table. As a side effect, we store the
	color factor in the color table for later lookup. (I.e., this function is
	impure.)
	<<Evaluators: procedures>>=
	function color_table_get_color_factor (color_table, index1, index2, nc) &
	result (factor)
	real(default) :: factor
	type(color_table_t), intent(inout) :: color_table
	integer, intent(in) :: index1, index2
	integer, intent(in), optional :: nc
	integer :: i1, i2
	i1 = color_table%index(index1)
	i2 = color_table%index(index2)
	if (color_table%factor_is_known(i1,i2)) then
	factor = real(color_table%factor(i1,i2), kind=default)
	else
	factor = compute_color_factor &
	(color_table%col(:,i1), color_table%col(:,i2), nc)
	color_table%factor(i1,i2) = factor
	color_table%factor_is_known(i1,i2) = .true.
	end if
	end function color_table_get_color_factor

	@ %def color_table_get_color_factor
	@
	\subsection{Creating an evaluator: Matrix multiplication}
	The evaluator for matrix multiplication is the most complicated
	variant.

	The initializer takes two input interactions and constructs the result
	evaluator, which consists of the interaction and the multiplication
	table for the product (or convolution) of the two. Normally, the
	input interactions are connected by one or more common particles
	(e.g., decay, structure function convolution).

	In the result interaction, quantum numbers of the connections can be
	summed over. This is determined by the [[qn_mask_conn]] argument.
	The [[qn_mask_rest]] argument is its analog for the other particles
	within the result interaction. (E.g., for the trace of the state
	matrix, all quantum numbers are summed over.) Finally, the
	[[connections_are_resonant]] argument tells whether the connecting
	particles should be marked as resonant in the final event record.
	This is useful for decays.

	The algorithm consists of the following steps:
	\begin{enumerate}
	\item
	[[find_connections]]: Find the particles which are connected, i.e.,
	common to both input interactions. Either they are directly linked,
	or both are linked to a common source.
	\item
	[[compute_index_bounds_and_mappings]]: Compute the mappings of
	particle indices from the input interactions to the result
	interaction. There is a separate mapping for the connected
	particles.
	\item
	[[accumulate_connected_states]]: Create an auxiliary state matrix
	which lists the possible quantum numbers for the connected
	particles. When building this matrix, count the number of times
	each assignment is contained in any of the input states and, for
	each of the input states, record the index of the matrix element
	within the new state matrix. For the connected particles, reassign
	color indices such that no color state is present twice in different
	color-index assignment. Note that helicity assignments of the
	connected state can be (and will be) off-diagonal, so no spin
	correlations are lost in decays.

	Do this for both input interactions.
	\item
	[[allocate_connection_entries]]: Allocate a table of connections.
	Each table row corresponds to one state in the auxiliary matrix, and
	to multiple states of the input interactions. It collects all
	states of the unconnected particles in the two input interactions
	that are associated with the particular state (quantum-number
	assignment) of the connected particles.
	\item
	[[fill_connection_table]]: Fill the table of connections by scanning
	both input interactions. When copying states, reassign color
	indices for the unconnected particles such that they match between
	all involved particle sets (interaction 1, interaction 2, and
	connected particles).
	\item
	[[make_product_interaction]]: Scan the table of connections we have
	just built. For each entry, construct all possible pairs of states
	of the unconnected particles and combine them with the specific
	connected-particle state. This is a possible quantum-number
	assignment of the result interaction. Now mask all quantum numbers
	that should be summed over, and append this to the result state
	matrix. Record the matrix element index of the result. We now have
	the result interaction.
	\item
	[[make_pairing_array]]: First allocate the pairing array with the
	number of entries of the result interaction. Then scan the table of
	connections again. For each entry, record the indices of the matrix
	elements which have to be multiplied and summed over in order to
	compute this particular matrix element. This makes up the
	multiplication table.
	\item
	[[record_links]]: Transfer all source pointers from the input
	interactions to the result interaction. Do the same for the
	internal parent-child relations and resonance assignments. For the
	connected particles, make up appropriate additional parent-child
	relations. This allows for fetching momenta from other interactions
	when a new event is filled, and to reconstruct the event history
	when the event is analyzed.
	\end{enumerate}

	After all this is done, for each event, we just have to evaluate the
	pairing arrays (multiplication tables) in order to compute the result
	matrix elements in their proper positions. The quantum-number
	assignments remain fixed from now on.
	<<Evaluators: evaluator: TBP>>=
	procedure :: init_product => evaluator_init_product
	<<Evaluators: procedures>>=
	subroutine evaluator_init_product &
	(eval, int_in1, int_in2, qn_mask_conn, qn_filter_conn, qn_mask_rest, &
	connections_are_resonant, ignore_sub)

	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int_in1, int_in2
	type(quantum_numbers_mask_t), intent(in) :: qn_mask_conn
	type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
	type(quantum_numbers_mask_t), intent(in), optional :: qn_mask_rest
	logical, intent(in), optional :: connections_are_resonant
	logical, intent(in), optional :: ignore_sub

	type(qn_mask_array_t), dimension(2) :: qn_mask_in
	type(state_matrix_t), pointer :: state_in1, state_in2

	type :: connection_table_t
	integer :: n_conn = 0
	integer, dimension(2) :: n_rest = 0
	integer :: n_tot = 0
	integer :: n_me_conn = 0
	type(state_matrix_t) :: state
	type(index_map_t), dimension(:), allocatable :: index_conn
	type(connection_entry_t), dimension(:), allocatable :: entry
	type(index_map_t) :: index_result
	end type connection_table_t
	type(connection_table_t) :: connection_table

	integer :: n_in, n_vir, n_out, n_tot
	integer, dimension(2) :: n_rest
	integer :: n_conn

	integer, dimension(:,:), allocatable :: connection_index
	type(index_map_t), dimension(2) :: prt_map_in
	type(index_map_t) :: prt_map_conn
	type(prt_mask_t), dimension(2) :: prt_is_connected
	type(quantum_numbers_mask_t), dimension(:), allocatable :: &
	qn_mask_conn_initial, int_in1_mask, int_in2_mask

	integer :: i

	eval%type = EVAL_PRODUCT
	eval%int_in1 => int_in1
	eval%int_in2 => int_in2

	state_in1 => int_in1%get_state_matrix_ptr ()
	state_in2 => int_in2%get_state_matrix_ptr ()

	call find_connections (int_in1, int_in2, n_conn, connection_index)
	if (n_conn == 0) then
	call msg_message ("First interaction:")
	call int_in1%basic_write (col_verbose=.true.)
	call msg_message ("Second interaction:")
	call int_in2%basic_write (col_verbose=.true.)
	call msg_fatal ("Evaluator product: no connections found between factors")
	end if
	call compute_index_bounds_and_mappings &
	(int_in1, int_in2, n_conn, &
	n_in, n_vir, n_out, n_tot, &
	n_rest, prt_map_in, prt_map_conn)

	call prt_mask_init (prt_is_connected(1), int_in1%get_n_tot ())
	call prt_mask_init (prt_is_connected(2), int_in2%get_n_tot ())
	do i = 1, 2
	prt_is_connected(i)%entry = .true.
	prt_is_connected(i)%entry(connection_index(:,i)) = .false.
	end do
	allocate (qn_mask_conn_initial (n_conn), &
	int_in1_mask (n_conn), int_in2_mask (n_conn))
	int_in1_mask = int_in1%get_mask (connection_index(:,1))
	int_in2_mask = int_in2%get_mask (connection_index(:,2))
	do i = 1, n_conn
	qn_mask_conn_initial(i) = int_in1_mask(i) .or. int_in2_mask(i)
	end do
	allocate (qn_mask_in(1)%mask (int_in1%get_n_tot ()))
	allocate (qn_mask_in(2)%mask (int_in2%get_n_tot ()))
	qn_mask_in(1)%mask = int_in1%get_mask ()
	qn_mask_in(2)%mask = int_in2%get_mask ()

	call connection_table_init (connection_table, &
	state_in1, state_in2, &
	qn_mask_conn_initial, &
	n_conn, connection_index, n_rest, &
	qn_filter_conn, ignore_sub)
	call connection_table_fill (connection_table, &
	state_in1, state_in2, &
	connection_index, prt_is_connected)
	call make_product_interaction (eval%interaction_t, &
	n_in, n_vir, n_out, &
	connection_table, &
	prt_map_in, prt_is_connected, &
	qn_mask_in, qn_mask_conn_initial, &
	qn_mask_conn, qn_filter_conn, qn_mask_rest)
	call make_pairing_array (eval%pairing_array, &
	eval%get_n_matrix_elements (), &
	connection_table)
	call record_links (eval%interaction_t, &
	int_in1, int_in2, connection_index, prt_map_in, prt_map_conn, &
	prt_is_connected, connections_are_resonant)
	call connection_table_final (connection_table)


	if (eval%get_n_matrix_elements () == 0) then
	print *, "Evaluator product"
	print *, "First interaction"
	call int_in1%basic_write (col_verbose=.true.)
	print *
	print *, "Second interaction"
	call int_in2%basic_write (col_verbose=.true.)
	print *
	call msg_fatal ("Product of density matrices is empty", &
	[var_str (" --------------------------------------------"), &
	var_str ("This happens when two density matrices are convoluted "), &
	var_str ("but the processes they belong to (e.g., production "), &
	var_str ("and decay) do not match. This could happen if the "), &
	var_str ("beam specification does not match the hard "), &
	var_str ("process. Or it may indicate a WHIZARD bug.")])
	end if

	contains

	subroutine compute_index_bounds_and_mappings &
	(int1, int2, n_conn, &
	n_in, n_vir, n_out, n_tot, &
	n_rest, prt_map_in, prt_map_conn)
	class(interaction_t), intent(in) :: int1, int2
	integer, intent(in) :: n_conn
	integer, intent(out) :: n_in, n_vir, n_out, n_tot
	integer, dimension(2), intent(out) :: n_rest
	type(index_map_t), dimension(2), intent(out) :: prt_map_in
	type(index_map_t), intent(out) :: prt_map_conn
	integer, dimension(:), allocatable :: index
	integer :: n_in1, n_vir1, n_out1
	integer :: n_in2, n_vir2, n_out2
	integer :: k
	n_in1 = int1%get_n_in ()
	n_vir1 = int1%get_n_vir ()
	n_out1 = int1%get_n_out () - n_conn
	n_rest(1) = n_in1 + n_vir1 + n_out1
	n_in2 = int2%get_n_in () - n_conn
	n_vir2 = int2%get_n_vir ()
	n_out2 = int2%get_n_out ()
	n_rest(2) = n_in2 + n_vir2 + n_out2
	n_in = n_in1 + n_in2
	n_vir = n_vir1 + n_vir2 + n_conn
	n_out = n_out1 + n_out2
	n_tot = n_in + n_vir + n_out
	call index_map_init (prt_map_in, n_rest)
	call index_map_init (prt_map_conn, n_conn)
	allocate (index (n_tot))
	index = [ (i, i = 1, n_tot) ]
	prt_map_in(1)%entry(1 : n_in1) = index( 1 : n_in1)
	k = n_in1
	prt_map_in(2)%entry(1 : n_in2) = index(k + 1 : k + n_in2)
	k = k + n_in2
	prt_map_in(1)%entry(n_in1 + 1 : n_in1 + n_vir1) = index(k + 1 : k + n_vir1)
	k = k + n_vir1
	prt_map_in(2)%entry(n_in2 + 1 : n_in2 + n_vir2) = index(k + 1 : k + n_vir2)
	k = k + n_vir2
	prt_map_conn%entry = index(k + 1 : k + n_conn)
	k = k + n_conn
	prt_map_in(1)%entry(n_in1 + n_vir1 + 1 : n_rest(1)) = index(k + 1 : k + n_out1)
	k = k + n_out1
	prt_map_in(2)%entry(n_in2 + n_vir2 + 1 : n_rest(2)) = index(k + 1 : k + n_out2)
	end subroutine compute_index_bounds_and_mappings

	subroutine connection_table_init &
	(connection_table, state_in1, state_in2, qn_mask_conn, &
	n_conn, connection_index, n_rest, &
	qn_filter_conn, is_real_sub)
	type(connection_table_t), intent(out) :: connection_table
	type(state_matrix_t), intent(in), target :: state_in1, state_in2
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_conn
	integer, intent(in) :: n_conn
	integer, dimension(:,:), intent(in) :: connection_index
	integer, dimension(2), intent(in) :: n_rest
	type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
	logical, intent(in), optional :: is_real_sub
	integer, dimension(2) :: n_me_in
	type(state_iterator_t) :: it
	type(quantum_numbers_t), dimension(n_conn) :: qn
	integer :: i, me_index_in, me_index_conn, n_me_conn
	integer, dimension(2) :: me_count
	logical :: is_sub, has_sub_qn
	integer :: i_beam_sub
	connection_table%n_conn = n_conn
	connection_table%n_rest = n_rest
	n_me_in(1) = state_in1%get_n_matrix_elements ()
	n_me_in(2) = state_in2%get_n_matrix_elements ()
	allocate (connection_table%index_conn (2))
	call index_map_init (connection_table%index_conn, n_me_in)
	connection_table%index_conn = 0
	call connection_table%state%init (n_counters = 2)
	do i = 1, 2
	select case (i)
	case (1); call it%init (state_in1)
	case (2); call it%init (state_in2)
	end select
	do while (it%is_valid ())
	qn = it%get_quantum_numbers (connection_index(:,i))
	call qn%undefine (qn_mask_conn)
	if (present (qn_filter_conn)) then
	if (.not. all (qn .match. qn_filter_conn)) then
	call it%advance (); cycle
	end if
	end if
	call quantum_numbers_canonicalize_color (qn)
	me_index_in = it%get_me_index ()
	is_sub = .false.; if (present (is_real_sub)) is_sub = is_real_sub
	has_sub_qn = .false.
	do i_beam_sub = 1, n_beam_structure_int
	has_sub_qn = has_sub_qn .or. any (qn%get_sub () == i_beam_sub)
	end do
	call connection_table%state%add_state (qn, &
	counter_index = i, &
	ignore_sub = .not. (is_sub .and. has_sub_qn), &
	me_index = me_index_conn)
	call index_map_set_entry (connection_table%index_conn(i), &
	me_index_in, me_index_conn)
	call it%advance ()
	end do
	end do
	n_me_conn = connection_table%state%get_n_matrix_elements ()
	connection_table%n_me_conn = n_me_conn
	allocate (connection_table%entry (n_me_conn))
	call it%init (connection_table%state)
	do while (it%is_valid ())
	i = it%get_me_index ()
	me_count = it%get_me_count ()
	call connection_entry_init (connection_table%entry(i), 2, 2, &
	it%get_quantum_numbers (), me_count, n_rest)
	call it%advance ()
	end do
	end subroutine connection_table_init

	subroutine connection_table_final (connection_table)
	type(connection_table_t), intent(inout) :: connection_table
	call connection_table%state%final ()
	end subroutine connection_table_final

	subroutine connection_table_write (connection_table, unit)
	type(connection_table_t), intent(in) :: connection_table
	integer, intent(in), optional :: unit
	integer :: i, j
	integer :: u
	u = given_output_unit (unit)
	write (u, *) "Connection table:"
	call connection_table%state%write (unit)
	if (allocated (connection_table%index_conn)) then
	write (u, *) " Index mapping input => connection table:"
	do i = 1, size (connection_table%index_conn)
	write (u, *) " Input state", i
	do j = 1, size (connection_table%index_conn(i))
	write (u, *) j, &
	index_map_get_entry (connection_table%index_conn(i), j)
	end do
	end do
	end if
	if (allocated (connection_table%entry)) then
	write (u, *) " Connection table contents:"
	do i = 1, size (connection_table%entry)
	call connection_entry_write (connection_table%entry(i), unit)
	end do
	end if
	if (index_map_exists (connection_table%index_result)) then
	write (u, *) " Index mapping connection table => output:"
	do i = 1, size (connection_table%index_result)
	write (u, *) i, &
	index_map_get_entry (connection_table%index_result, i)
	end do
	end if
	end subroutine connection_table_write

	subroutine connection_table_fill &
	(connection_table, state_in1, state_in2, &
	connection_index, prt_is_connected)
	type(connection_table_t), intent(inout) :: connection_table
	type(state_matrix_t), intent(in), target :: state_in1, state_in2
	integer, dimension(:,:), intent(in) :: connection_index
	type(prt_mask_t), dimension(2), intent(in) :: prt_is_connected
	type(state_iterator_t) :: it
	integer :: index_in, index_conn
	integer :: color_offset
	integer :: n_result_entries
	integer :: i, k
	color_offset = connection_table%state%get_max_color_value ()
	do i = 1, 2
	select case (i)
	case (1); call it%init (state_in1)
	case (2); call it%init (state_in2)
	end select
	do while (it%is_valid ())
	index_in = it%get_me_index ()
	index_conn = index_map_get_entry &
	(connection_table%index_conn(i), index_in)
	if (index_conn /= 0) then
	call connection_entry_add_state &
	(connection_table%entry(index_conn), i, &
	index_in, it%get_quantum_numbers (), &
	connection_index(:,i), prt_is_connected(i), &
	color_offset)
	end if
	call it%advance ()
	end do
	color_offset = color_offset + state_in1%get_max_color_value ()
	end do
	n_result_entries = 0
	do k = 1, size (connection_table%entry)
	n_result_entries = &
	n_result_entries + product (connection_table%entry(k)%n_index)
	end do
	call index_map_init (connection_table%index_result, n_result_entries)
	end subroutine connection_table_fill

	subroutine connection_entry_add_state &
	(entry, i, index_in, qn_in, connection_index, prt_is_connected, &
	color_offset)
	type(connection_entry_t), intent(inout) :: entry
	integer, intent(in) :: i
	integer, intent(in) :: index_in
	type(quantum_numbers_t), dimension(:), intent(in) :: qn_in
	integer, dimension(:), intent(in) :: connection_index
	type(prt_mask_t), intent(in) :: prt_is_connected
	integer, intent(in) :: color_offset
	integer :: c
	integer, dimension(:,:), allocatable :: color_map
	entry%count(i) = entry%count(i) + 1
	c = entry%count(i)
	call make_color_map (color_map, &
	qn_in(connection_index), entry%qn_conn)
	call index_map_set_entry (entry%index_in(i), c, index_in)
	entry%qn_in_list(i)%qn(:,c) = pack (qn_in, prt_is_connected%entry)
	call quantum_numbers_translate_color &
	(entry%qn_in_list(i)%qn(:,c), color_map, color_offset)
	end subroutine connection_entry_add_state

	subroutine make_product_interaction (int, &
	n_in, n_vir, n_out, &
	connection_table, &
	prt_map_in, prt_is_connected, &
	qn_mask_in, qn_mask_conn_initial, &
	qn_mask_conn, qn_filter_conn, qn_mask_rest)
	type(interaction_t), intent(out), target :: int
	integer, intent(in) :: n_in, n_vir, n_out
	type(connection_table_t), intent(inout), target :: connection_table
	type(index_map_t), dimension(2), intent(in) :: prt_map_in
	type(prt_mask_t), dimension(2), intent(in) :: prt_is_connected
	type(qn_mask_array_t), dimension(2), intent(in) :: qn_mask_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: &
	qn_mask_conn_initial
	type(quantum_numbers_mask_t), intent(in) :: qn_mask_conn
	type(quantum_numbers_t), intent(in), optional :: qn_filter_conn
	type(quantum_numbers_mask_t), intent(in), optional :: qn_mask_rest
	type(index_map_t), dimension(2) :: prt_index_in
	type(index_map_t) :: prt_index_conn
	integer :: n_tot, n_conn
	integer, dimension(2) :: n_rest
	integer :: i, j, k, m
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
	type(connection_entry_t), pointer :: entry
	integer :: result_index
	n_conn = connection_table%n_conn
	n_rest = connection_table%n_rest
	n_tot = sum (n_rest) + n_conn
	allocate (qn (n_tot), qn_mask (n_tot))
	do i = 1, 2
	call index_map_init (prt_index_in(i), n_rest(i))
	prt_index_in(i) = &
	prt_map_in(i)%entry ([ (j, j = 1, n_rest(i)) ])
	end do
	call index_map_init (prt_index_conn, n_conn)
	prt_index_conn = prt_map_conn%entry ([ (j, j = 1, n_conn) ])
	do i = 1, 2
	if (present (qn_mask_rest)) then
	qn_mask(prt_index_in(i)%entry) = &
	pack (qn_mask_in(i)%mask, prt_is_connected(i)%entry) &
	.or. qn_mask_rest
	else
	qn_mask(prt_index_in(i)%entry) = &
	pack (qn_mask_in(i)%mask, prt_is_connected(i)%entry)
	end if
	end do
	qn_mask(prt_index_conn%entry) = qn_mask_conn_initial .or. qn_mask_conn
	call eval%interaction_t%basic_init (n_in, n_vir, n_out, mask = qn_mask)
	m = 1
	do i = 1, connection_table%n_me_conn
	entry => connection_table%entry(i)
	qn(prt_index_conn%entry) = &
	quantum_numbers_undefined (entry%qn_conn, qn_mask_conn)
	if (present (qn_filter_conn)) then
	if (.not. all (qn(prt_index_conn%entry) .match. qn_filter_conn)) &
	cycle
	end if
	do j = 1, entry%n_index(1)
	qn(prt_index_in(1)%entry) = entry%qn_in_list(1)%qn(:,j)
	do k = 1, entry%n_index(2)
	qn(prt_index_in(2)%entry) = entry%qn_in_list(2)%qn(:,k)
	call int%add_state (qn, me_index = result_index)
	call index_map_set_entry &
	(connection_table%index_result, m, result_index)
	m = m + 1
	end do
	end do
	end do
	call int%freeze ()
	end subroutine make_product_interaction

	subroutine make_pairing_array (pa, n_matrix_elements, connection_table)
	type(pairing_array_t), dimension(:), intent(out), allocatable :: pa
	integer, intent(in) :: n_matrix_elements
	type(connection_table_t), intent(in), target :: connection_table
	type(connection_entry_t), pointer :: entry
	integer, dimension(:), allocatable :: n_entries
	integer :: i, j, k, m, r
	allocate (pa (n_matrix_elements))
	allocate (n_entries (n_matrix_elements))
	n_entries = 0
	do m = 1, size (connection_table%index_result)
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	end do
	call pairing_array_init &
	(pa, n_entries, has_i2=.true., has_factor=.false.)
	m = 1
	n_entries = 0
	do i = 1, connection_table%n_me_conn
	entry => connection_table%entry(i)
	do j = 1, entry%n_index(1)
	do k = 1, entry%n_index(2)
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	pa(r)%i1(n_entries(r)) = &
	index_map_get_entry (entry%index_in(1), j)
	pa(r)%i2(n_entries(r)) = &
	index_map_get_entry (entry%index_in(2), k)
	m = m + 1
	end do
	end do
	end do
	end subroutine make_pairing_array

	subroutine record_links (int, &
	int_in1, int_in2, connection_index, prt_map_in, prt_map_conn, &
	prt_is_connected, connections_are_resonant)
	class(interaction_t), intent(inout) :: int
	class(interaction_t), intent(in), target :: int_in1, int_in2
	integer, dimension(:,:), intent(in) :: connection_index
	type(index_map_t), dimension(2), intent(in) :: prt_map_in
	type(index_map_t), intent(in) :: prt_map_conn
	type(prt_mask_t), dimension(2), intent(in) :: prt_is_connected
	logical, intent(in), optional :: connections_are_resonant
	type(index_map_t), dimension(2) :: prt_map_all
	integer :: i, j, k, ival
	call index_map_init (prt_map_all(1), size (prt_is_connected(1)))
	k = 0
	j = 0
	do i = 1, size (prt_is_connected(1))
	if (prt_is_connected(1)%entry(i)) then
	j = j + 1
	ival = index_map_get_entry (prt_map_in(1), j)
	call index_map_set_entry (prt_map_all(1), i, ival)
	else
	k = k + 1
	ival = index_map_get_entry (prt_map_conn, k)
	call index_map_set_entry (prt_map_all(1), i, ival)
	end if
	call int%set_source_link (ival, int_in1, i)
	end do
	call int_in1%transfer_relations (int, prt_map_all(1)%entry)
	call index_map_init (prt_map_all(2), size (prt_is_connected(2)))
	j = 0
	do i = 1, size (prt_is_connected(2))
	if (prt_is_connected(2)%entry(i)) then
	j = j + 1
	ival = index_map_get_entry (prt_map_in(2), j)
	call index_map_set_entry (prt_map_all(2), i, ival)
	call int%set_source_link (ival, int_in2, i)
	else
	call index_map_set_entry (prt_map_all(2), i, 0)
	end if
	end do
	call int_in2%transfer_relations (int, prt_map_all(2)%entry)
	call int%relate_connections &
	(int_in2, connection_index(:,2), prt_map_all(2)%entry, &
	prt_map_conn%entry, connections_are_resonant)
	end subroutine record_links

	end subroutine evaluator_init_product

	@ %def evaluator_init_product
	@
	\subsection{Creating an evaluator: square}
	The generic initializer for an evaluator that squares a matrix element.
	Depending on the provided mask, we select the appropriate specific initializer
	for either diagonal or non-diagonal helicity density matrices.
	<<Evaluators: evaluator: TBP>>=
	procedure :: init_square => evaluator_init_square
	<<Evaluators: procedures>>=
	subroutine evaluator_init_square (eval, int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)
	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, dimension(:,:), intent(in), optional :: col_flow_index
	complex(default), dimension(:), intent(in), optional :: col_factor
	integer, dimension(:), intent(in), optional :: col_index_hi
	logical, intent(in), optional :: expand_color_flows
	integer, intent(in), optional :: nc
	if (all (qn_mask%diagonal_helicity ())) then
	call eval%init_square_diag (int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)
	else
	call eval%init_square_nondiag (int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)
	end if
	end subroutine evaluator_init_square

	@ %def evaluator_init_square
	@
	\subsubsection{Color-summed squared matrix (diagonal helicities)}
	The initializer for an evaluator that squares a matrix element,
	including color factors. The mask must be such that off-diagonal matrix
	elements are excluded.

	If [[color_flows]] is set, the evaluator keeps color-flow entries
	separate and drops all interfering color structures. The color factors are
	set to unity in this case.

	There is only one input interaction. The quantum-number mask is an
	array, one entry for each particle, so they can be treated
	individually. For academic purposes, we allow for the number of
	colors being different from three (but 3 is the default).

	The algorithm is analogous to multiplication, with a few notable
	differences:
	\begin{enumerate}
	\item
	The connected particles are known, the correspondence is
	one-to-one. All particles are connected, and the mapping of indices
	is trivial, which simplifies the following steps.
	\item
	[[accumulate_connected_states]]: The matrix of connected states
	encompasses all particles, but color indices are removed. However,
	ghost states are still kept separate from physical color states. No
	color-index reassignment is necessary.
	\item
	The table of connections contains single index and quantum-number
	arrays instead of pairs of them. They are paired with themselves
	in all possible ways.
	\item
	[[make_squared_interaction]]: Now apply the predefined
	quantum-numbers mask, which usually collects all color states
	(physical and ghosts), and possibly a helicity sum.
	\item
	[[make_pairing_array]]: For each pair of input states, compute the
	color factor (including a potential ghost-parity sign) and store
	this in the pairing array together with the matrix-element indices
	for multiplication.
	\item
	[[record_links]]: This is again trivial due to the one-to-one
	correspondence.
	\end{enumerate}

	<<Evaluators: evaluator: TBP>>=
	procedure :: init_square_diag => evaluator_init_square_diag
	<<Evaluators: procedures>>=
	subroutine evaluator_init_square_diag (eval, int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)

	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, dimension(:,:), intent(in), optional :: col_flow_index
	complex(default), dimension(:), intent(in), optional :: col_factor
	integer, dimension(:), intent(in), optional :: col_index_hi
	logical, intent(in), optional :: expand_color_flows
	integer, intent(in), optional :: nc

	integer :: n_in, n_vir, n_out, n_tot
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask_initial
	type(state_matrix_t), pointer :: state_in

	type :: connection_table_t
	integer :: n_tot = 0
	integer :: n_me_conn = 0
	type(state_matrix_t) :: state
	type(index_map_t) :: index_conn
	type(connection_entry_t), dimension(:), allocatable :: entry
	type(index_map_t) :: index_result
	end type connection_table_t
	type(connection_table_t) :: connection_table

	logical :: sum_colors
	type(color_table_t) :: color_table

	if (present (expand_color_flows)) then
	sum_colors = .not. expand_color_flows
	else
	sum_colors = .true.
	end if

	if (sum_colors) then
	eval%type = EVAL_SQUARE_WITH_COLOR_FACTORS
	else
	eval%type = EVAL_SQUARED_FLOWS
	end if
	eval%int_in1 => int_in

	n_in = int_in%get_n_in ()
	n_vir = int_in%get_n_vir ()
	n_out = int_in%get_n_out ()
	n_tot = int_in%get_n_tot ()

	state_in => int_in%get_state_matrix_ptr ()

	allocate (qn_mask_initial (n_tot))
	qn_mask_initial = int_in%get_mask ()
	call qn_mask_initial%set_color (sum_colors, mask_cg=.false.)
	if (sum_colors) then
	call color_table_init (color_table, state_in, n_tot)
	if (present (col_flow_index) .and. present (col_factor) &
	.and. present (col_index_hi)) then
	call color_table_set_color_factors &
	(color_table, col_flow_index, col_factor, col_index_hi)
	end if
	end if

	call connection_table_init (connection_table, state_in, &
	qn_mask_initial, qn_mask, n_tot)
	call connection_table_fill (connection_table, state_in)
	call make_squared_interaction (eval%interaction_t, &
	n_in, n_vir, n_out, n_tot, &
	connection_table, sum_colors, qn_mask_initial .or. qn_mask)
	call make_pairing_array (eval%pairing_array, &
	eval%get_n_matrix_elements (), &
	connection_table, sum_colors, color_table, n_in, n_tot, nc)
	call record_links (eval, int_in, n_tot)
	call connection_table_final (connection_table)

	contains

	subroutine connection_table_init &
	(connection_table, state_in, qn_mask_in, qn_mask, n_tot)
	type(connection_table_t), intent(out) :: connection_table
	type(state_matrix_t), intent(in), target :: state_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, intent(in) :: n_tot
	type(quantum_numbers_t), dimension(n_tot) :: qn
	type(state_iterator_t) :: it
	integer :: i, n_me_in, me_index_in
	integer :: me_index_conn, n_me_conn
	integer, dimension(1) :: me_count
	logical :: qn_passed
	connection_table%n_tot = n_tot
	n_me_in = state_in%get_n_matrix_elements ()
	call index_map_init (connection_table%index_conn, n_me_in)
	connection_table%index_conn = 0
	call connection_table%state%init (n_counters=1)
	call it%init (state_in)
	do while (it%is_valid ())
	qn = it%get_quantum_numbers ()
	if (all (quantum_numbers_are_physical (qn, qn_mask))) then
	call qn%undefine (qn_mask_in)
	qn_passed = .true.
	if (qn_passed) then
	me_index_in = it%get_me_index ()
	call connection_table%state%add_state (qn, &
	counter_index = 1, me_index = me_index_conn)
	call index_map_set_entry (connection_table%index_conn, &
	me_index_in, me_index_conn)
	end if
	end if
	call it%advance ()
	end do
	n_me_conn = connection_table%state%get_n_matrix_elements ()
	connection_table%n_me_conn = n_me_conn
	allocate (connection_table%entry (n_me_conn))
	call it%init (connection_table%state)
	do while (it%is_valid ())
	i = it%get_me_index ()
	me_count = it%get_me_count ()
	call connection_entry_init (connection_table%entry(i), 1, 2, &
	it%get_quantum_numbers (), me_count, [n_tot])
	call it%advance ()
	end do
	end subroutine connection_table_init

	subroutine connection_table_final (connection_table)
	type(connection_table_t), intent(inout) :: connection_table
	call connection_table%state%final ()
	end subroutine connection_table_final

	subroutine connection_table_write (connection_table, unit)
	type(connection_table_t), intent(in) :: connection_table
	integer, intent(in), optional :: unit
	integer :: i
	integer :: u
	u = given_output_unit (unit)
	write (u, *) "Connection table:"
	call connection_table%state%write (unit)
	if (index_map_exists (connection_table%index_conn)) then
	write (u, *) " Index mapping input => connection table:"
	do i = 1, size (connection_table%index_conn)
	write (u, *) i, &
	index_map_get_entry (connection_table%index_conn, i)
	end do
	end if
	if (allocated (connection_table%entry)) then
	write (u, *) " Connection table contents"
	do i = 1, size (connection_table%entry)
	call connection_entry_write (connection_table%entry(i), unit)
	end do
	end if
	if (index_map_exists (connection_table%index_result)) then
	write (u, *) " Index mapping connection table => output"
	do i = 1, size (connection_table%index_result)
	write (u, *) i, &
	index_map_get_entry (connection_table%index_result, i)
	end do
	end if
	end subroutine connection_table_write

	subroutine connection_table_fill (connection_table, state)
	type(connection_table_t), intent(inout) :: connection_table
	type(state_matrix_t), intent(in), target :: state
	integer :: index_in, index_conn, n_result_entries
	type(state_iterator_t) :: it
	integer :: k
	call it%init (state)
	do while (it%is_valid ())
	index_in = it%get_me_index ()
	index_conn = &
	index_map_get_entry (connection_table%index_conn, index_in)
	if (index_conn /= 0) then
	call connection_entry_add_state &
	(connection_table%entry(index_conn), &
	index_in, it%get_quantum_numbers ())
	end if
	call it%advance ()
	end do
	n_result_entries = 0
	do k = 1, size (connection_table%entry)
	n_result_entries = &
	n_result_entries + connection_table%entry(k)%n_index(1) ** 2
	end do
	call index_map_init (connection_table%index_result, n_result_entries)
	connection_table%index_result = 0
	end subroutine connection_table_fill

	subroutine connection_entry_add_state (entry, index_in, qn_in)
	type(connection_entry_t), intent(inout) :: entry
	integer, intent(in) :: index_in
	type(quantum_numbers_t), dimension(:), intent(in) :: qn_in
	integer :: c
	entry%count = entry%count + 1
	c = entry%count(1)
	call index_map_set_entry (entry%index_in(1), c, index_in)
	entry%qn_in_list(1)%qn(:,c) = qn_in
	end subroutine connection_entry_add_state

	subroutine make_squared_interaction (int, &
	n_in, n_vir, n_out, n_tot, &
	connection_table, sum_colors, qn_mask)
	type(interaction_t), intent(out), target :: int
	integer, intent(in) :: n_in, n_vir, n_out, n_tot
	type(connection_table_t), intent(inout), target :: connection_table
	logical, intent(in) :: sum_colors
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	type(connection_entry_t), pointer :: entry
	integer :: result_index, n_contrib
	integer :: i, m
	type(quantum_numbers_t), dimension(n_tot) :: qn
	call eval%interaction_t%basic_init (n_in, n_vir, n_out, mask=qn_mask)
	m = 0
	do i = 1, connection_table%n_me_conn
	entry => connection_table%entry(i)
	qn = quantum_numbers_undefined (entry%qn_conn, qn_mask)
	if (.not. sum_colors) call qn(1:n_in)%invert_color ()
	call int%add_state (qn, me_index = result_index)
	n_contrib = entry%n_index(1) ** 2
	connection_table%index_result%entry(m+1:m+n_contrib) = result_index
	m = m + n_contrib
	end do
	call int%freeze ()
	end subroutine make_squared_interaction

	subroutine make_pairing_array (pa, &
	n_matrix_elements, connection_table, sum_colors, color_table, &
	n_in, n_tot, nc)
	type(pairing_array_t), dimension(:), intent(out), allocatable :: pa
	integer, intent(in) :: n_matrix_elements
	type(connection_table_t), intent(in), target :: connection_table
	logical, intent(in) :: sum_colors
	type(color_table_t), intent(inout) :: color_table
	type(connection_entry_t), pointer :: entry
	integer, intent(in) :: n_in, n_tot
	integer, intent(in), optional :: nc
	integer, dimension(:), allocatable :: n_entries
	integer :: i, k, l, ks, ls, m, r
	integer :: color_multiplicity_in
	allocate (pa (n_matrix_elements))
	allocate (n_entries (n_matrix_elements))
	n_entries = 0
	do m = 1, size (connection_table%index_result)
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	end do
	call pairing_array_init &
	(pa, n_entries, has_i2 = sum_colors, has_factor = sum_colors)
	m = 1
	n_entries = 0
	do i = 1, connection_table%n_me_conn
	entry => connection_table%entry(i)
	do k = 1, entry%n_index(1)
	if (sum_colors) then
	color_multiplicity_in = &
	product (abs (quantum_numbers_get_color_type &
	(entry%qn_in_list(1)%qn(:n_in, k))))
	do l = 1, entry%n_index(1)
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	ks = index_map_get_entry (entry%index_in(1), k)
	ls = index_map_get_entry (entry%index_in(1), l)
	pa(r)%i1(n_entries(r)) = ks
	pa(r)%i2(n_entries(r)) = ls
	pa(r)%factor(n_entries(r)) = &
	color_table_get_color_factor (color_table, ks, ls, nc) &
	/ color_multiplicity_in
	m = m + 1
	end do
	else
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	ks = index_map_get_entry (entry%index_in(1), k)
	pa(r)%i1(n_entries(r)) = ks
	m = m + 1
	end if
	end do
	end do
	end subroutine make_pairing_array

	subroutine record_links (int, int_in, n_tot)
	class(interaction_t), intent(inout) :: int
	class(interaction_t), intent(in), target :: int_in
	integer, intent(in) :: n_tot
	integer, dimension(n_tot) :: map
	integer :: i
	do i = 1, n_tot
	call int%set_source_link (i, int_in, i)
	end do
	map = [ (i, i = 1, n_tot) ]
	call int_in%transfer_relations (int, map)
	end subroutine record_links

	end subroutine evaluator_init_square_diag

	@ %def evaluator_init_square_diag
	@
	\subsubsection{Color-summed squared matrix (support nodiagonal helicities)}
	The initializer for an evaluator that squares a matrix element,
	including color factors. Unless requested otherwise by the
	quantum-number mask, the result contains off-diagonal matrix elements.
	(The input interaction must be diagonal since it represents an
	amplitude, not a density matrix.)

	There is only one input interaction. The quantum-number mask is an
	array, one entry for each particle, so they can be treated
	individually. For academic purposes, we allow for the number of
	colors being different from three (but 3 is the default).

	The algorithm is analogous to the previous one, with some additional
	complications due to the necessity to loop over two helicity indices.
	<<Evaluators: evaluator: TBP>>=
	procedure :: init_square_nondiag => evaluator_init_square_nondiag
	<<Evaluators: procedures>>=
	subroutine evaluator_init_square_nondiag (eval, int_in, qn_mask, &
	col_flow_index, col_factor, col_index_hi, expand_color_flows, nc)

	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, dimension(:,:), intent(in), optional :: col_flow_index
	complex(default), dimension(:), intent(in), optional :: col_factor
	integer, dimension(:), intent(in), optional :: col_index_hi
	logical, intent(in), optional :: expand_color_flows
	integer, intent(in), optional :: nc

	integer :: n_in, n_vir, n_out, n_tot
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask_initial
	type(state_matrix_t), pointer :: state_in

	type :: connection_table_t
	integer :: n_tot = 0
	integer :: n_me_conn = 0
	type(state_matrix_t) :: state
	type(index_map2_t) :: index_conn
	type(connection_entry_t), dimension(:), allocatable :: entry
	type(index_map_t) :: index_result
	end type connection_table_t
	type(connection_table_t) :: connection_table

	logical :: sum_colors
	type(color_table_t) :: color_table

	if (present (expand_color_flows)) then
	sum_colors = .not. expand_color_flows
	else
	sum_colors = .true.
	end if

	if (sum_colors) then
	eval%type = EVAL_SQUARE_WITH_COLOR_FACTORS
	else
	eval%type = EVAL_SQUARED_FLOWS
	end if
	eval%int_in1 => int_in

	n_in = int_in%get_n_in ()
	n_vir = int_in%get_n_vir ()
	n_out = int_in%get_n_out ()
	n_tot = int_in%get_n_tot ()

	state_in => int_in%get_state_matrix_ptr ()

	allocate (qn_mask_initial (n_tot))
	qn_mask_initial = int_in%get_mask ()
	call qn_mask_initial%set_color (sum_colors, mask_cg=.false.)
	if (sum_colors) then
	call color_table_init (color_table, state_in, n_tot)
	if (present (col_flow_index) .and. present (col_factor) &
	.and. present (col_index_hi)) then
	call color_table_set_color_factors &
	(color_table, col_flow_index, col_factor, col_index_hi)
	end if
	end if

	call connection_table_init (connection_table, state_in, &
	qn_mask_initial, qn_mask, n_tot)
	call connection_table_fill (connection_table, state_in)
	call make_squared_interaction (eval%interaction_t, &
	n_in, n_vir, n_out, n_tot, &
	connection_table, sum_colors, qn_mask_initial .or. qn_mask)
	call make_pairing_array (eval%pairing_array, &
	eval%get_n_matrix_elements (), &
	connection_table, sum_colors, color_table, n_in, n_tot, nc)
	call record_links (eval, int_in, n_tot)
	call connection_table_final (connection_table)

	contains

	subroutine connection_table_init &
	(connection_table, state_in, qn_mask_in, qn_mask, n_tot)
	type(connection_table_t), intent(out) :: connection_table
	type(state_matrix_t), intent(in), target :: state_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask_in
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	integer, intent(in) :: n_tot
	type(quantum_numbers_t), dimension(n_tot) :: qn1, qn2, qn
	type(state_iterator_t) :: it1, it2, it
	integer :: i, n_me_in, me_index_in1, me_index_in2
	integer :: me_index_conn, n_me_conn
	integer, dimension(1) :: me_count
	logical :: qn_passed
	connection_table%n_tot = n_tot
	n_me_in = state_in%get_n_matrix_elements ()
	call index_map2_init (connection_table%index_conn, n_me_in)
	connection_table%index_conn = 0
	call connection_table%state%init (n_counters=1)
	call it1%init (state_in)
	do while (it1%is_valid ())
	qn1 = it1%get_quantum_numbers ()
	me_index_in1 = it1%get_me_index ()
	call it2%init (state_in)
	do while (it2%is_valid ())
	qn2 = it2%get_quantum_numbers ()
	if (all (quantum_numbers_are_compatible (qn1, qn2, qn_mask))) then
	qn = qn1 .merge. qn2
	call qn%undefine (qn_mask_in)
	qn_passed = .true.
	if (qn_passed) then
	me_index_in2 = it2%get_me_index ()
	call connection_table%state%add_state (qn, &
	counter_index = 1, me_index = me_index_conn)
	call index_map2_set_entry (connection_table%index_conn, &
	me_index_in1, me_index_in2, me_index_conn)
	end if
	end if
	call it2%advance ()
	end do
	call it1%advance ()
	end do
	n_me_conn = connection_table%state%get_n_matrix_elements ()
	connection_table%n_me_conn = n_me_conn
	allocate (connection_table%entry (n_me_conn))
	call it%init (connection_table%state)
	do while (it%is_valid ())
	i = it%get_me_index ()
	me_count = it%get_me_count ()
	call connection_entry_init (connection_table%entry(i), 1, 2, &
	it%get_quantum_numbers (), me_count, [n_tot])
	call it%advance ()
	end do
	end subroutine connection_table_init

	subroutine connection_table_final (connection_table)
	type(connection_table_t), intent(inout) :: connection_table
	call connection_table%state%final ()
	end subroutine connection_table_final

	subroutine connection_table_write (connection_table, unit)
	type(connection_table_t), intent(in) :: connection_table
	integer, intent(in), optional :: unit
	integer :: i, j
	integer :: u
	u = given_output_unit (unit)
	write (u, *) "Connection table:"
	call connection_table%state%write (unit)
	if (index_map2_exists (connection_table%index_conn)) then
	write (u, *) " Index mapping input => connection table:"
	do i = 1, size (connection_table%index_conn)
	do j = 1, size (connection_table%index_conn)
	write (u, *) i, j, &
	index_map2_get_entry (connection_table%index_conn, i, j)
	end do
	end do
	end if
	if (allocated (connection_table%entry)) then
	write (u, *) " Connection table contents"
	do i = 1, size (connection_table%entry)
	call connection_entry_write (connection_table%entry(i), unit)
	end do
	end if
	if (index_map_exists (connection_table%index_result)) then
	write (u, *) " Index mapping connection table => output"
	do i = 1, size (connection_table%index_result)
	write (u, *) i, &
	index_map_get_entry (connection_table%index_result, i)
	end do
	end if
	end subroutine connection_table_write

	subroutine connection_table_fill (connection_table, state)
	type(connection_table_t), intent(inout), target :: connection_table
	type(state_matrix_t), intent(in), target :: state
	integer :: index1_in, index2_in, index_conn, n_result_entries
	type(state_iterator_t) :: it1, it2
	integer :: k
	call it1%init (state)
	do while (it1%is_valid ())
	index1_in = it1%get_me_index ()
	call it2%init (state)
	do while (it2%is_valid ())
	index2_in = it2%get_me_index ()
	index_conn = index_map2_get_entry &
	(connection_table%index_conn, index1_in, index2_in)
	if (index_conn /= 0) then
	call connection_entry_add_state &
	(connection_table%entry(index_conn), &
	index1_in, index2_in, &
	it1%get_quantum_numbers () &
	.merge. &
	it2%get_quantum_numbers ())
	end if
	call it2%advance ()
	end do
	call it1%advance ()
	end do
	n_result_entries = 0
	do k = 1, size (connection_table%entry)
	n_result_entries = &
	n_result_entries + connection_table%entry(k)%n_index(1)
	end do
	call index_map_init (connection_table%index_result, n_result_entries)
	connection_table%index_result = 0
	end subroutine connection_table_fill

	subroutine connection_entry_add_state (entry, index1_in, index2_in, qn_in)
	type(connection_entry_t), intent(inout) :: entry
	integer, intent(in) :: index1_in, index2_in
	type(quantum_numbers_t), dimension(:), intent(in) :: qn_in
	integer :: c
	entry%count = entry%count + 1
	c = entry%count(1)
	call index_map_set_entry (entry%index_in(1), c, index1_in)
	call index_map_set_entry (entry%index_in(2), c, index2_in)
	entry%qn_in_list(1)%qn(:,c) = qn_in
	end subroutine connection_entry_add_state

	subroutine make_squared_interaction (int, &
	n_in, n_vir, n_out, n_tot, &
	connection_table, sum_colors, qn_mask)
	type(interaction_t), intent(out), target :: int
	integer, intent(in) :: n_in, n_vir, n_out, n_tot
	type(connection_table_t), intent(inout), target :: connection_table
	logical, intent(in) :: sum_colors
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	type(connection_entry_t), pointer :: entry
	integer :: result_index
	integer :: i, k, m
	type(quantum_numbers_t), dimension(n_tot) :: qn
	call eval%interaction_t%basic_init (n_in, n_vir, n_out, mask=qn_mask)
	m = 0
	do i = 1, connection_table%n_me_conn
	entry => connection_table%entry(i)
	do k = 1, size (entry%qn_in_list(1)%qn, 2)
	qn = quantum_numbers_undefined &
	(entry%qn_in_list(1)%qn(:,k), qn_mask)
	if (.not. sum_colors) call qn(1:n_in)%invert_color ()
	call int%add_state (qn, me_index = result_index)
	call index_map_set_entry (connection_table%index_result, m + 1, &
	result_index)
	m = m + 1
	end do
	end do
	call int%freeze ()
	end subroutine make_squared_interaction

	subroutine make_pairing_array (pa, &
	n_matrix_elements, connection_table, sum_colors, color_table, &
	n_in, n_tot, nc)
	type(pairing_array_t), dimension(:), intent(out), allocatable :: pa
	integer, intent(in) :: n_matrix_elements
	type(connection_table_t), intent(in), target :: connection_table
	logical, intent(in) :: sum_colors
	type(color_table_t), intent(inout) :: color_table
	type(connection_entry_t), pointer :: entry
	integer, intent(in) :: n_in, n_tot
	integer, intent(in), optional :: nc
	integer, dimension(:), allocatable :: n_entries
	integer :: i, k, k1s, k2s, m, r
	integer :: color_multiplicity_in
	allocate (pa (n_matrix_elements))
	allocate (n_entries (n_matrix_elements))
	n_entries = 0
	do m = 1, size (connection_table%index_result)
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	end do
	call pairing_array_init &
	(pa, n_entries, has_i2 = sum_colors, has_factor = sum_colors)
	m = 1
	n_entries = 0
	do i = 1, connection_table%n_me_conn
	entry => connection_table%entry(i)
	do k = 1, entry%n_index(1)
	r = index_map_get_entry (connection_table%index_result, m)
	n_entries(r) = n_entries(r) + 1
	if (sum_colors) then
	k1s = index_map_get_entry (entry%index_in(1), k)
	k2s = index_map_get_entry (entry%index_in(2), k)
	pa(r)%i1(n_entries(r)) = k1s
	pa(r)%i2(n_entries(r)) = k2s
	color_multiplicity_in = &
	product (abs (quantum_numbers_get_color_type &
	(entry%qn_in_list(1)%qn(:n_in, k))))
	pa(r)%factor(n_entries(r)) = &
	color_table_get_color_factor (color_table, k1s, k2s, nc) &
	/ color_multiplicity_in
	else
	k1s = index_map_get_entry (entry%index_in(1), k)
	pa(r)%i1(n_entries(r)) = k1s
	end if
	m = m + 1
	end do
	end do
	end subroutine make_pairing_array

	subroutine record_links (int, int_in, n_tot)
	class(interaction_t), intent(inout) :: int
	class(interaction_t), intent(in), target :: int_in
	integer, intent(in) :: n_tot
	integer, dimension(n_tot) :: map
	integer :: i
	do i = 1, n_tot
	call int%set_source_link (i, int_in, i)
	end do
	map = [ (i, i = 1, n_tot) ]
	call int_in%transfer_relations (int, map)
	end subroutine record_links

	end subroutine evaluator_init_square_nondiag

	@ %def evaluator_init_square_nondiag
	@
	\subsubsection{Copy with additional contracted color states}
	This evaluator involves no square or multiplication, its matrix
	elements are just copies of the (single) input interaction. However,
	the state matrix of the interaction contains additional states that
	have color indices contracted. This is used for copies of the beam or
	structure-function interactions that need to match the hard
	interaction also in the case where its color indices coincide.
	<<Evaluators: evaluator: TBP>>=
	procedure :: init_color_contractions => evaluator_init_color_contractions
	<<Evaluators: procedures>>=
	subroutine evaluator_init_color_contractions (eval, int_in)
	class(evaluator_t), intent(out), target :: eval
	type(interaction_t), intent(in), target :: int_in
	integer :: n_in, n_vir, n_out, n_tot
	type(state_matrix_t) :: state_with_contractions
	integer, dimension(:), allocatable :: me_index
	integer, dimension(:), allocatable :: result_index
	eval%type = EVAL_COLOR_CONTRACTION
	eval%int_in1 => int_in
	n_in = int_in%get_n_in ()
	n_vir = int_in%get_n_vir ()
	n_out = int_in%get_n_out ()
	n_tot = int_in%get_n_tot ()
	state_with_contractions = int_in%get_state_matrix_ptr ()
	call state_with_contractions%add_color_contractions ()
	call make_contracted_interaction (eval%interaction_t, &
	me_index, result_index, &
	n_in, n_vir, n_out, n_tot, &
	state_with_contractions, int_in%get_mask ())
	call make_pairing_array (eval%pairing_array, me_index, result_index)
	call record_links (eval, int_in, n_tot)
	call state_with_contractions%final ()

	contains

	subroutine make_contracted_interaction (int, &
	me_index, result_index, &
	n_in, n_vir, n_out, n_tot, state, qn_mask)
	type(interaction_t), intent(out), target :: int
	integer, dimension(:), intent(out), allocatable :: me_index
	integer, dimension(:), intent(out), allocatable :: result_index
	integer, intent(in) :: n_in, n_vir, n_out, n_tot
	type(state_matrix_t), intent(in) :: state
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	type(state_iterator_t) :: it
	integer :: n_me, i
	type(quantum_numbers_t), dimension(n_tot) :: qn
	call int%basic_init (n_in, n_vir, n_out, mask=qn_mask)
	n_me = state%get_n_leaves ()
	allocate (me_index (n_me))
	allocate (result_index (n_me))
	call it%init (state)
	i = 0
	do while (it%is_valid ())
	i = i + 1
	me_index(i) = it%get_me_index ()
	qn = it%get_quantum_numbers ()
	call int%add_state (qn, me_index = result_index(i))
	call it%advance ()
	end do
	call int%freeze ()
	end subroutine make_contracted_interaction

	subroutine make_pairing_array (pa, me_index, result_index)
	type(pairing_array_t), dimension(:), intent(out), allocatable :: pa
	integer, dimension(:), intent(in) :: me_index, result_index
	integer, dimension(:), allocatable :: n_entries
	integer :: n_matrix_elements, r, i
	n_matrix_elements = size (me_index)
	allocate (pa (n_matrix_elements))
	allocate (n_entries (n_matrix_elements))
	n_entries = 1
	call pairing_array_init &
	(pa, n_entries, has_i2=.false., has_factor=.false.)
	do i = 1, n_matrix_elements
	r = result_index(i)
	pa(r)%i1(1) = me_index(i)
	end do
	end subroutine make_pairing_array

	subroutine record_links (int, int_in, n_tot)
	class(interaction_t), intent(inout) :: int
	class(interaction_t), intent(in), target :: int_in
	integer, intent(in) :: n_tot
	integer, dimension(n_tot) :: map
	integer :: i
	do i = 1, n_tot
	call int%set_source_link (i, int_in, i)
	end do
	map = [ (i, i = 1, n_tot) ]
	call int_in%transfer_relations (int, map)
	end subroutine record_links

	end subroutine evaluator_init_color_contractions

	@ %def evaluator_init_color_contractions
	@
	\subsubsection{Auxiliary procedure for initialization}
	This will become a standard procedure in F2008. The result is true if
	the number of true values in the mask is odd. We use the function for
	determining the ghost parity of a quantum-number array.

	[tho:] It's not used anymore and [[mod (count (mask), 2) == 1]] is
	a cooler implementation anyway.
	<<(UNUSED) Evaluators: procedures>>=
	function parity (mask)
	logical :: parity
	logical, dimension(:) :: mask
	integer :: i
	parity = .false.
	do i = 1, size (mask)
	if (mask(i)) parity = .not. parity
	end do
	end function parity

	@ %def parity
	@ Reassign external source links from one to another.
	<<Evaluators: public>>=
	public :: evaluator_reassign_links
	<<Evaluators: interfaces>>=
	interface evaluator_reassign_links
	module procedure evaluator_reassign_links_eval
	module procedure evaluator_reassign_links_int
	end interface

	<<Evaluators: procedures>>=
	subroutine evaluator_reassign_links_eval (eval, eval_src, eval_target)
	type(evaluator_t), intent(inout) :: eval
	type(evaluator_t), intent(in) :: eval_src
	type(evaluator_t), intent(in), target :: eval_target
	if (associated (eval%int_in1)) then
	if (eval%int_in1%get_tag () == eval_src%get_tag ()) then
	eval%int_in1 => eval_target%interaction_t
	end if
	end if
	if (associated (eval%int_in2)) then
	if (eval%int_in2%get_tag () == eval_src%get_tag ()) then
	eval%int_in2 => eval_target%interaction_t
	end if
	end if
	call interaction_reassign_links &
	(eval%interaction_t, eval_src%interaction_t, &
	eval_target%interaction_t)
	end subroutine evaluator_reassign_links_eval

	subroutine evaluator_reassign_links_int (eval, int_src, int_target)
	type(evaluator_t), intent(inout) :: eval
	type(interaction_t), intent(in) :: int_src
	type(interaction_t), intent(in), target :: int_target
	if (associated (eval%int_in1)) then
	if (eval%int_in1%get_tag () == int_src%get_tag ()) then
	eval%int_in1 => int_target
	end if
	end if
	if (associated (eval%int_in2)) then
	if (eval%int_in2%get_tag () == int_src%get_tag ()) then
	eval%int_in2 => int_target
	end if
	end if
	call interaction_reassign_links (eval%interaction_t, int_src, int_target)
	end subroutine evaluator_reassign_links_int

	@ %def evaluator_reassign_links
	@ Return flavor, momentum, and position of the first unstable particle
	present in the interaction.
	<<Evaluators: public>>=
	public :: evaluator_get_unstable_particle
	<<Evaluators: procedures>>=
	subroutine evaluator_get_unstable_particle (eval, flv, p, i)
	type(evaluator_t), intent(in) :: eval
	type(flavor_t), intent(out) :: flv
	type(vector4_t), intent(out) :: p
	integer, intent(out) :: i
	call interaction_get_unstable_particle (eval%interaction_t, flv, p, i)
	end subroutine evaluator_get_unstable_particle

	@ %def evaluator_get_unstable_particle
	@
	<<Evaluators: public>>=
	public :: evaluator_get_int_in_ptr
	<<Evaluators: procedures>>=
	function evaluator_get_int_in_ptr (eval, i) result (int_in)
	class(interaction_t), pointer :: int_in
	type(evaluator_t), intent(in), target :: eval
	integer, intent(in) :: i
	if (i == 1) then
	int_in => eval%int_in1
	else if (i == 2) then
	int_in => eval%int_in2
	else
	int_in => null ()
	end if
	end function evaluator_get_int_in_ptr

	@ %def evaluator_get_int_in_ptr
	@
	\subsection{Creating an evaluator: identity}
	The identity evaluator creates a copy of the first input evaluator; the second
	input is not used.

	All particles link back to the input evaluatorand the internal
	relations are copied. As evaluation does take a shortcut by cloning the matrix
	elements, the pairing array is not used and does not have to be set up.

	<<Evaluators: evaluator: TBP>>=
	procedure :: init_identity => evaluator_init_identity
	<<Evaluators: procedures>>=
	subroutine evaluator_init_identity (eval, int)
	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), intent(in), target :: int
	integer :: n_in, n_out, n_vir, n_tot
	integer :: i
	integer, dimension(:), allocatable :: map
	type(state_matrix_t), pointer :: state
	type(state_iterator_t) :: it
	eval%type = EVAL_IDENTITY
	eval%int_in1 => int
	nullify (eval%int_in2)
	n_in = int%get_n_in ()
	n_out = int%get_n_out ()
	n_vir = int%get_n_vir ()
	n_tot = int%get_n_tot ()
	call eval%interaction_t%basic_init (n_in, n_vir, n_out, &
	mask = int%get_mask (), &
	resonant = int%get_resonance_flags ())
	do i = 1, n_tot
	call eval%set_source_link (i, int, i)
	end do
	allocate (map(n_tot))
	map = [(i, i = 1, n_tot)]
	call int%transfer_relations (eval, map)
	state => int%get_state_matrix_ptr ()
	call it%init (state)
	do while (it%is_valid ())
	call eval%add_state (it%get_quantum_numbers (), &
	it%get_me_index ())
	call it%advance ()
	end do
	call eval%freeze ()

	end subroutine evaluator_init_identity

	@ %def evaluator_init_identity
	@
	\subsection {Creating an evaluator: quantum number sum}
	This evaluator operates on the diagonal of a density matrix and sums over the
	quantum numbers specified by the mask. The optional argument [[drop]] allows to
	drop a particle from the resulting density matrix. The handling of virtuals is
	not completely sane, especially in connection with dropping particles.

	When summing over matrix element entries, we keep the separation into
	entries and normalization (in the corresponding evaluation routine below).
	<<Evaluators: evaluator: TBP>>=
	procedure :: init_qn_sum => evaluator_init_qn_sum
	<<Evaluators: procedures>>=
	subroutine evaluator_init_qn_sum (eval, int, qn_mask, drop)
	class(evaluator_t), intent(out), target :: eval
	class(interaction_t), target, intent(in) :: int
	type(quantum_numbers_mask_t), dimension(:), intent(in) :: qn_mask
	logical, intent(in), optional, dimension(:) :: drop
	type(state_iterator_t) :: it_old, it_new
	integer, dimension(:), allocatable :: pairing_size, pairing_target, i_new
	integer, dimension(:), allocatable :: map
	integer :: n_in, n_out, n_vir, n_tot, n_me_old, n_me_new
	integer :: i, j
	type(state_matrix_t), pointer :: state_new, state_old
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	logical :: matched
	logical, dimension(size (qn_mask)) :: dropped
	integer :: ndropped
	integer, dimension(:), allocatable :: inotdropped
	type(quantum_numbers_mask_t), dimension(:), allocatable :: mask
	logical, dimension(:), allocatable :: resonant

	eval%type = EVAL_QN_SUM
	eval%int_in1 => int
	nullify (eval%int_in2)
	if (present (drop)) then
	dropped = drop
	else
	dropped = .false.
	end if
	ndropped = count (dropped)

	n_in = int%get_n_in ()
	n_out = int%get_n_out () - ndropped
	n_vir = int%get_n_vir ()
	n_tot = int%get_n_tot () - ndropped

	allocate (inotdropped (n_tot))
	i = 1
	do j = 1, n_tot + ndropped
	if (dropped (j)) cycle
	inotdropped(i) = j
	i = i + 1
	end do

	allocate (mask(n_tot + ndropped))
	mask = int%get_mask ()
	allocate (resonant(n_tot + ndropped))
	resonant = int%get_resonance_flags ()
	call eval%interaction_t%basic_init (n_in, n_vir, n_out, &
	mask = mask(inotdropped) .or. qn_mask(inotdropped), &
	resonant = resonant(inotdropped))
	i = 1
	do j = 1, n_tot + ndropped
	if (dropped(j)) cycle
	call eval%set_source_link (i, int, j)
	i = i + 1
	end do
	allocate (map(n_tot + ndropped))
	i = 1
	do j = 1, n_tot + ndropped
	if (dropped (j)) then
	map(j) = 0
	else
	map(j) = i
	i = i + 1
	end if
	end do
	call int%transfer_relations (eval, map)

	n_me_old = int%get_n_matrix_elements ()
	allocate (pairing_size (n_me_old), source = 0)
	allocate (pairing_target (n_me_old), source = 0)
	pairing_size = 0
	state_old => int%get_state_matrix_ptr ()
	state_new => eval%get_state_matrix_ptr ()
	call it_old%init (state_old)
	allocate (qn(n_tot + ndropped))
	do while (it_old%is_valid ())
	qn = it_old%get_quantum_numbers ()
	if (.not. all (qn%are_diagonal ())) then
	call it_old%advance ()
	cycle
	end if
	matched = .false.
	call it_new%init (state_new)
	if (eval%get_n_matrix_elements () > 0) then
	do while (it_new%is_valid ())
	if (all (qn(inotdropped) .match. &
	it_new%get_quantum_numbers ())) &
	then
	matched = .true.
	i = it_new%get_me_index ()
	exit
	end if
	call it_new%advance ()
	end do
	end if
	if (.not. matched) then
	call eval%add_state (qn(inotdropped))
	i = eval%get_n_matrix_elements ()
	end if
	pairing_size(i) = pairing_size(i) + 1
	pairing_target(it_old%get_me_index ()) = i
	call it_old%advance ()
	end do
	call eval%freeze ()

	n_me_new = eval%get_n_matrix_elements ()
	allocate (eval%pairing_array (n_me_new))
	do i = 1, n_me_new
	call pairing_array_init (eval%pairing_array(i), &
	pairing_size(i), .false., .false.)
	end do

	allocate (i_new (n_me_new), source = 0)
	do i = 1, n_me_old
	j = pairing_target(i)
	if (j > 0) then
	i_new(j) = i_new(j) + 1
	eval%pairing_array(j)%i1(i_new(j)) = i
	end if
	end do

	end subroutine evaluator_init_qn_sum

	@ %def evaluator_init_qn_sum
	@
	\subsection{Evaluation}
	When the input interactions (which are pointed to in the pairings
	stored within the evaluator) are filled with values, we can activate
	the evaluator, i.e., calculate the result values which are stored in
	the interaction.

	The evaluation of matrix elements can be done in parallel. A
	[[forall]] construct is not appropriate, however. We would need
	[[do concurrent]] here. Nevertheless, the evaluation functions are
	marked as [[pure]].
	<<Evaluators: evaluator: TBP>>=
	procedure :: evaluate => evaluator_evaluate
	<<Evaluators: procedures>>=
	subroutine evaluator_evaluate (eval)
	class(evaluator_t), intent(inout), target :: eval
	integer :: i
	select case (eval%type)
	case (EVAL_PRODUCT)
	do i = 1, size(eval%pairing_array)
	call eval%evaluate_product (i, &
	eval%int_in1, eval%int_in2, &
	eval%pairing_array(i)%i1, eval%pairing_array(i)%i2)
	if (debug2_active (D_QFT)) then
	print *, 'eval%pairing_array(i)%i1, eval%pairing_array(i)%i2 = ', &
	eval%pairing_array(i)%i1, eval%pairing_array(i)%i2
	print *, 'MEs = ', &
	eval%int_in1%get_matrix_element (eval%pairing_array(i)%i1), &
	eval%int_in2%get_matrix_element (eval%pairing_array(i)%i2)
	end if
	end do
	case (EVAL_SQUARE_WITH_COLOR_FACTORS)
	do i = 1, size(eval%pairing_array)
	call eval%evaluate_product_cf (i, &
	eval%int_in1, eval%int_in1, &
	eval%pairing_array(i)%i1, eval%pairing_array(i)%i2, &
	eval%pairing_array(i)%factor)
	end do
	case (EVAL_SQUARED_FLOWS)
	do i = 1, size(eval%pairing_array)
	call eval%evaluate_square_c (i, &
	eval%int_in1, &
	eval%pairing_array(i)%i1)
	end do
	case (EVAL_COLOR_CONTRACTION)
	do i = 1, size(eval%pairing_array)
	call eval%evaluate_sum (i, &
	eval%int_in1, &
	eval%pairing_array(i)%i1)
	end do
	case (EVAL_IDENTITY)
	call eval%set_matrix_element (eval%int_in1)
	case (EVAL_QN_SUM)
	do i = 1, size (eval%pairing_array)
	call eval%evaluate_me_sum (i, &
	eval%int_in1, eval%pairing_array(i)%i1)
	call eval%set_norm (eval%int_in1%get_norm ())
	end do
	end select
	end subroutine evaluator_evaluate

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

	module evaluators_ut
	use unit_tests
	use evaluators_uti

	<<Standard module head>>

	<<Evaluators: public test>>

	contains

	<<Evaluators: test driver>>

	end module evaluators_ut
	@ %def evaluators_ut
	@
	<<[[evaluators_uti.f90]]>>=
	<<File header>>

	module evaluators_uti

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

	use evaluators

	<<Standard module head>>

	<<Evaluators: test declarations>>

	contains

	<<Evaluators: tests>>

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

	@ %def evaluator_test
	@ Test: Create two interactions. The interactions are twofold
	connected. The first connection has a helicity index that is kept,
	the second connection has a helicity index that is summed over.
	Concatenate the interactions in an evaluator, which thus contains a
	result interaction. Fill the input interactions with values, activate
	the evaluator and print the result.
	<<Evaluators: execute tests>>=
	call test (evaluator_1, "evaluator_1", &
	"check evaluators (1)", &
	u, results)
	<<Evaluators: test declarations>>=
	public :: evaluator_1
	<<Evaluators: tests>>=
	subroutine evaluator_1 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(interaction_t), target :: int_qqtt, int_tbw, int1, int2
	type(flavor_t), dimension(:), allocatable :: flv
	type(color_t), dimension(:), allocatable :: col
	type(helicity_t), dimension(:), allocatable :: hel
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: f, c, h1, h2, h3
	type(vector4_t), dimension(4) :: p
	type(vector4_t), dimension(2) :: q
	type(quantum_numbers_mask_t) :: qn_mask_conn
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask2
	type(evaluator_t), target :: eval, eval2, eval3

	call model%init_sm_test ()

	write (u, "(A)") "*** Evaluator for matrix product"
	write (u, "(A)") "*** Construct interaction for qq -> tt"
	write (u, "(A)")
	call int_qqtt%basic_init (2, 0, 2, set_relations=.true.)
	allocate (flv (4), col (4), hel (4), qn (4))
	allocate (qn_mask2 (4))
	do c = 1, 2
	select case (c)
	case (1)
	call col%init_col_acl ([1, 0, 1, 0], [0, 2, 0, 2])
	case (2)
	call col%init_col_acl ([1, 0, 2, 0], [0, 1, 0, 2])
	end select
	do f = 1, 2
	call flv%init ([f, -f, 6, -6], model)
	do h1 = -1, 1, 2
	call hel(3)%init (h1)
	do h2 = -1, 1, 2
	call hel(4)%init (h2)
	call qn%init (flv, col, hel)
	call int_qqtt%add_state (qn)
	end do
	end do
	end do
	end do
	call int_qqtt%freeze ()
	deallocate (flv, col, hel, qn)
	write (u, "(A)") "*** Construct interaction for t -> bW"
	call int_tbw%basic_init (1, 0, 2, set_relations=.true.)
	allocate (flv (3), col (3), hel (3), qn (3))
	call flv%init ([6, 5, 24], model)
	call col%init_col_acl ([1, 1, 0], [0, 0, 0])
	do h1 = -1, 1, 2
	call hel(1)%init (h1)
	do h2 = -1, 1, 2
	call hel(2)%init (h2)
	do h3 = -1, 1
	call hel(3)%init (h3)
	call qn%init (flv, col, hel)
	call int_tbw%add_state (qn)
	end do
	end do
	end do
	call int_tbw%freeze ()
	deallocate (flv, col, hel, qn)
	write (u, "(A)") "*** Link interactions"
	call int_tbw%set_source_link (1, int_qqtt, 3)
	qn_mask_conn = quantum_numbers_mask (.false.,.false.,.true.)
	write (u, "(A)")
	write (u, "(A)") "*** Show input"
	call int_qqtt%basic_write (unit = u)
	write (u, "(A)")
	call int_tbw%basic_write (unit = u)
	write (u, "(A)")
	write (u, "(A)") "*** Evaluate product"
	call eval%init_product (int_qqtt, int_tbw, qn_mask_conn)
	call eval%write (unit = u)

	call int1%basic_init (2, 0, 2, set_relations=.true.)
	call int2%basic_init (1, 0, 2, set_relations=.true.)
	p(1) = vector4_moving (1000._default, 1000._default, 3)
	p(2) = vector4_moving (200._default, 200._default, 2)
	p(3) = vector4_moving (100._default, 200._default, 1)
	p(4) = p(1) - p(2) - p(3)
	call int1%set_momenta (p)
	q(1) = vector4_moving (50._default,-50._default, 3)
	q(2) = p(2) + p(4) - q(1)
	call int2%set_momenta (q, outgoing=.true.)
	call int1%set_matrix_element ([(2._default,0._default), &
	(4._default,1._default), (-3._default,0._default)])
	call int2%set_matrix_element ([(-3._default,0._default), &
	(0._default,1._default), (1._default,2._default)])
	call eval%receive_momenta ()
	call eval%evaluate ()
	call int1%basic_write (unit = u)
	write (u, "(A)")
	call int2%basic_write (unit = u)
	write (u, "(A)")
	call eval%write (unit = u)
	write (u, "(A)")
	call int1%final ()
	call int2%final ()
	call eval%final ()

	write (u, "(A)")
	write (u, "(A)") "*** Evaluator for matrix square"
	allocate (flv(4), col(4), qn(4))
	call int1%basic_init (2, 0, 2, set_relations=.true.)
	call flv%init ([1, -1, 21, 21], model)
	call col(1)%init ([1])
	call col(2)%init ([-2])
	call col(3)%init ([2, -3])
	call col(4)%init ([3, -1])
	call qn%init (flv, col)
	call int1%add_state (qn)
	call col(3)%init ([3, -1])
	call col(4)%init ([2, -3])
	call qn%init (flv, col)
	call int1%add_state (qn)
	call col(3)%init ([2, -1])
	call col(4)%init (.true.)
	call qn%init (flv, col)
	call int1%add_state (qn)
	call int1%freeze ()
	! [qn_mask2 not set since default is false]
	call eval%init_square (int1, qn_mask2, nc=3)
	call eval2%init_square_nondiag (int1, qn_mask2)
	qn_mask2 = quantum_numbers_mask (.false., .true., .true.)
	call eval3%init_square_diag (eval, qn_mask2)
	call int1%set_matrix_element &
	([(2._default,0._default), &
	(4._default,1._default), (-3._default,0._default)])
	call int1%set_momenta (p)
	call int1%basic_write (unit = u)
	write (u, "(A)")
	call eval%receive_momenta ()
	call eval%evaluate ()
	call eval%write (unit = u)
	write (u, "(A)")
	call eval2%receive_momenta ()
	call eval2%evaluate ()
	call eval2%write (unit = u)
	write (u, "(A)")
	call eval3%receive_momenta ()
	call eval3%evaluate ()
	call eval3%write (unit = u)
	call int1%final ()
	call eval%final ()
	call eval2%final ()
	call eval3%final ()

	call model%final ()
	end subroutine evaluator_1

	@ %def evaluator_1
	@
	<<Evaluators: execute tests>>=
	call test (evaluator_2, "evaluator_2", &
	"check evaluators (2)", &
	u, results)
	<<Evaluators: test declarations>>=
	public :: evaluator_2
	<<Evaluators: tests>>=
	subroutine evaluator_2 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(interaction_t), target :: int
	integer :: h1, h2, h3, h4
	type(helicity_t), dimension(4) :: hel
	type(color_t), dimension(4) :: col
	type(flavor_t), dimension(4) :: flv
	type(quantum_numbers_t), dimension(4) :: qn
	type(vector4_t), dimension(4) :: p
	type(evaluator_t) :: eval
	integer :: i

	call model%init_sm_test ()

	write (u, "(A)") "*** Creating interaction for e+ e- -> W+ W-"
	write (u, "(A)")

	call flv%init ([11, -11, 24, -24], model)
	do i = 1, 4
	call col(i)%init ()
	end do
	call int%basic_init (2, 0, 2, set_relations=.true.)
	do h1 = -1, 1, 2
	call hel(1)%init (h1)
	do h2 = -1, 1, 2
	call hel(2)%init (h2)
	do h3 = -1, 1
	call hel(3)%init (h3)
	do h4 = -1, 1
	call hel(4)%init (h4)
	call qn%init (flv, col, hel)
	call int%add_state (qn)
	end do
	end do
	end do
	end do
	call int%freeze ()
	call int%set_matrix_element &
	([(cmplx (i, kind=default), i = 1, 36)])
	p(1) = vector4_moving (1000._default, 1000._default, 3)
	p(2) = vector4_moving (1000._default, -1000._default, 3)
	p(3) = vector4_moving (1000._default, &
	sqrt (1E6_default - 80._default**2), 3)
	p(4) = p(1) + p(2) - p(3)
	call int%set_momenta (p)
	write (u, "(A)") "*** Setting up evaluator"
	write (u, "(A)")

	call eval%init_identity (int)
	write (u, "(A)") "*** Transferring momenta and evaluating"
	write (u, "(A)")

	call eval%receive_momenta ()
	call eval%evaluate ()
	write (u, "(A)") "*******************************************************"
	write (u, "(A)") " Interaction dump"
	write (u, "(A)") "*******************************************************"
	call int%basic_write (unit = u)
	write (u, "(A)")
	write (u, "(A)") "*******************************************************"
	write (u, "(A)") " Evaluator dump"
	write (u, "(A)") "*******************************************************"
	call eval%write (unit = u)
	write (u, "(A)")
	write (u, "(A)") "*** cleaning up"
	call int%final ()
	call eval%final ()

	call model%final ()
	end subroutine evaluator_2

	@ %def evaluator_2
	@
	<<Evaluators: execute tests>>=
	call test (evaluator_3, "evaluator_3", &
	"check evaluators (3)", &
	u, results)
	<<Evaluators: test declarations>>=
	public :: evaluator_3
	<<Evaluators: tests>>=
	subroutine evaluator_3 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(interaction_t), target :: int
	integer :: h1, h2, h3, h4
	type(helicity_t), dimension(4) :: hel
	type(color_t), dimension(4) :: col
	type(flavor_t), dimension(4) :: flv1, flv2
	type(quantum_numbers_t), dimension(4) :: qn
	type(vector4_t), dimension(4) :: p
	type(evaluator_t) :: eval1, eval2, eval3
	type(quantum_numbers_mask_t), dimension(4) :: qn_mask
	integer :: i

	call model%init_sm_test ()

	write (u, "(A)") "*** Creating interaction for e+/mu+ e-/mu- -> W+ W-"
	call flv1%init ([11, -11, 24, -24], model)
	call flv2%init ([13, -13, 24, -24], model)
	do i = 1, 4
	call col (i)%init ()
	end do
	call int%basic_init (2, 0, 2, set_relations=.true.)
	do h1 = -1, 1, 2
	call hel(1)%init (h1)
	do h2 = -1, 1, 2
	call hel(2)%init (h2)
	do h3 = -1, 1
	call hel(3)%init (h3)
	do h4 = -1, 1
	call hel(4)%init (h4)
	call qn%init (flv1, col, hel)
	call int%add_state (qn)
	call qn%init (flv2, col, hel)
	call int%add_state (qn)
	end do
	end do
	end do
	end do
	call int%freeze ()
	call int%set_matrix_element &
	([(cmplx (1, kind=default), i = 1, 72)])
	p(1) = vector4_moving (1000._default, 1000._default, 3)
	p(2) = vector4_moving (1000._default, -1000._default, 3)
	p(3) = vector4_moving (1000._default, &
	sqrt (1E6_default - 80._default**2), 3)
	p(4) = p(1) + p(2) - p(3)
	call int%set_momenta (p)
	write (u, "(A)") "*** Setting up evaluators"
	call qn_mask%init (.false., .true., .true.)
	call eval1%init_qn_sum (int, qn_mask)
	call qn_mask%init (.true., .true., .true.)
	call eval2%init_qn_sum (int, qn_mask)
	call qn_mask%init (.false., .true., .false.)
	call eval3%init_qn_sum (int, qn_mask, &
	[.false., .false., .false., .true.])
	write (u, "(A)") "*** Transferring momenta and evaluating"
	call eval1%receive_momenta ()
	call eval1%evaluate ()
	call eval2%receive_momenta ()
	call eval2%evaluate ()
	call eval3%receive_momenta ()
	call eval3%evaluate ()
	write (u, "(A)") "*******************************************************"
	write (u, "(A)") " Interaction dump"
	write (u, "(A)") "*******************************************************"
	call int%basic_write (unit = u)
	write (u, "(A)")
	write (u, "(A)") "*******************************************************"
	write (u, "(A)") " Evaluator dump --- spin sum"
	write (u, "(A)") "*******************************************************"
	call eval1%write (unit = u)
	call eval1%basic_write (unit = u)
	write (u, "(A)") "*******************************************************"
	write (u, "(A)") " Evaluator dump --- spin / flavor sum"
	write (u, "(A)") "*******************************************************"
	call eval2%write (unit = u)
	call eval2%basic_write (unit = u)
	write (u, "(A)") "*******************************************************"
	write (u, "(A)") " Evaluator dump --- flavor sum, drop last W"
	write (u, "(A)") "*******************************************************"
	call eval3%write (unit = u)
	call eval3%basic_write (unit = u)
	write (u, "(A)")
	write (u, "(A)") "*** cleaning up"
	call int%final ()
	call eval1%final ()
	call eval2%final ()
	call eval3%final ()

	call model%final ()
	end subroutine evaluator_3

	@ %def evaluator_3
	@ This test evaluates a product with different quantum-number masks and
	filters for the linked entry.
	<<Evaluators: execute tests>>=
	call test (evaluator_4, "evaluator_4", &
	"check evaluator product with filter", &
	u, results)
	<<Evaluators: test declarations>>=
	public :: evaluator_4
	<<Evaluators: tests>>=
	subroutine evaluator_4 (u)
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(interaction_t), target :: int1, int2
	integer :: h1, h2, h3
	type(helicity_t), dimension(3) :: hel
	type(color_t), dimension(3) :: col
	type(flavor_t), dimension(2) :: flv1, flv2
	type(flavor_t), dimension(3) :: flv3, flv4
	type(quantum_numbers_t), dimension(3) :: qn
	type(evaluator_t) :: eval1, eval2, eval3, eval4
	type(quantum_numbers_mask_t) :: qn_mask
	type(flavor_t) :: flv_filter
	type(helicity_t) :: hel_filter
	type(color_t) :: col_filter
	type(quantum_numbers_t) :: qn_filter
	integer :: i

	write (u, "(A)") "* Test output: evaluator_4"
	write (u, "(A)") "* Purpose: test evaluator products &
	&with mask and filter"
	write (u, "(A)")

	call model%init_sm_test ()

	write (u, "(A)") "* Creating interaction for e- -> W+/Z"
	write (u, "(A)")

	call flv1%init ([11, 24], model)
	call flv2%init ([11, 23], model)
	do i = 1, 3
	call col(i)%init ()
	end do
	call int1%basic_init (1, 0, 1, set_relations=.true.)
	do h1 = -1, 1, 2
	call hel(1)%init (h1)
	do h2 = -1, 1
	call hel(2)%init (h2)
	call qn(:2)%init (flv1, col(:2), hel(:2))
	call int1%add_state (qn(:2))
	call qn(:2)%init (flv2, col(:2), hel(:2))
	call int1%add_state (qn(:2))
	end do
	end do
	call int1%freeze ()
	call int1%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Creating interaction for W+/Z -> u ubar/dbar"
	write (u, "(A)")

	call flv3%init ([24, 2, -1], model)
	call flv4%init ([23, 2, -2], model)

	call int2%basic_init (1, 0, 2, set_relations=.true.)
	do h1 = -1, 1
	call hel(1)%init (h1)
	do h2 = -1, 1, 2
	call hel(2)%init (h2)
	do h3 = -1, 1, 2
	call hel(3)%init (h3)
	call qn(:3)%init (flv3, col(:3), hel(:3))
	call int2%add_state (qn(:3))
	call qn(:3)%init (flv4, col(:3), hel(:3))
	call int2%add_state (qn(:3))
	end do
	end do
	end do
	call int2%freeze ()

	call int2%set_source_link (1, int1, 2)
	call int2%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Product evaluator"
	write (u, "(A)")

	call qn_mask%init (.false., .false., .false.)
	call eval1%init_product (int1, int2, qn_mask_conn = qn_mask)
	call eval1%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Product evaluator with helicity mask"
	write (u, "(A)")

	call qn_mask%init (.false., .false., .true.)
	call eval2%init_product (int1, int2, qn_mask_conn = qn_mask)
	call eval2%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Product with flavor filter and helicity mask"
	write (u, "(A)")

	call qn_mask%init (.false., .false., .true.)
	call flv_filter%init (24, model)
	call hel_filter%init ()
	call col_filter%init ()
	call qn_filter%init (flv_filter, col_filter, hel_filter)
	call eval3%init_product (int1, int2, &
	qn_mask_conn = qn_mask, qn_filter_conn = qn_filter)
	call eval3%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Product with helicity filter and mask"
	write (u, "(A)")

	call qn_mask%init (.false., .false., .true.)
	call flv_filter%init ()
	call hel_filter%init (0)
	call col_filter%init ()
	call qn_filter%init (flv_filter, col_filter, hel_filter)
	call eval4%init_product (int1, int2, &
	qn_mask_conn = qn_mask, qn_filter_conn = qn_filter)
	call eval4%write (u)

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

	call eval1%final ()
	call eval2%final ()
	call eval3%final ()
	call eval4%final ()

	call int1%final ()
	call int2%final ()

	call model%final ()

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

	end subroutine evaluator_4

	@ %def evaluator_4


	Index: trunk/src/vegas/vegas.nw
	===================================================================
	--- trunk/src/vegas/vegas.nw (revision 8189)
	+++ trunk/src/vegas/vegas.nw (revision 8190)
	@@ -1,4724 +1,4729 @@
	%% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: VEGAS algorithm
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

	\chapter{VEGAS Integration}
	\label{cha:vegas-integration}

	@ The backbone integrator of WHIZARD is a object-oriented implemetation of the VEGAS algorithm.

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

	module vegas
	<<Use kinds>>

	<<vegas: modules>>

	<<Standard module head>>

	<<vegas: public>>

	<<vegas: parameters>>

	<<vegas: types>>

	<<vegas: interfaces>>

	contains

	<<vegas: procedures>>

	end module vegas
	@ %def vegas
	<<vegas: modules>>=
	use diagnostics
	use io_units
	use format_utils, only: write_indent
	use format_defs, only: FMT_17
	use rng_base, only: rng_t
	use rng_stream, only: rng_stream_t
	@
	@ MPI Module.
	<<MPI: vegas: modules>>=
	use mpi_f08 !NODEP!
	@

	\section{Integration modes}
	\label{sec:integration-modes}

	@ VEGAS operates in three different modes: [[vegas_mode_importance_only]], [[vegas_mode_importance]] or [[vegas_mode_stratified]].
	The default mode is [[vegas_mode_importance]], where the algorithm decides whether if it is possible to use importance sampling or stratified sampling.
	In low dimensions VEGAS uses strict stratified sampling.

	<<vegas: parameters>>=
	integer, parameter, public :: VEGAS_MODE_IMPORTANCE = 0, &
	& VEGAS_MODE_STRATIFIED = 1, VEGAS_MODE_IMPORTANCE_ONLY = 2
	@ %def vegas_mode_importance vegas_mode_stratified vegas_mode_importance_only
	@
	\section{Type: vegas\_func\_t}
	\label{sec:type:vegas_func_t}

	We define a abstract [[func]] type which only gives an interface to an [[evaluate]] procedure.
	The inside of implementation and also the optimization of are not a concern of the [[vegas]] implementation.
	<<vegas: public>>=
	public :: vegas_func_t
	<<vegas: types>>=
	type, abstract :: vegas_func_t
	!
	contains
	procedure(vegas_func_evaluate), deferred, pass, public :: evaluate
	end type vegas_func_t

	@ %def vegas_func_t
	@ The only procedure called in [[vegas]] is [[vegas_func_evaluate]].
	It takes a real value [[x]] and returns a real value [[f]].
	<<vegas: interfaces>>=
	abstract interface
	real(default) function vegas_func_evaluate (self, x) result (f)
	import :: default, vegas_func_t
	class(vegas_func_t), intent(inout) :: self
	real(default), dimension(:), intent(in) :: x
	end function vegas_func_evaluate
	end interface

	@ %def vegas_func_evaluate
	@
	\section{Type: vegas\_config\_t}
	\label{sec:type:vegas_config_t}

	We store the complete configuration in a transparent container.
	The [[vegas_config_t]] object inside VEGAS must not be directly accesible.
	We provide a get method which returns a copy of the [[vegas_config_t]] object.

	Apart from the options which can be set by the constructor of [[vegas_t]] object, we store the run-time configuration [[n_calls]], [[calls_per_box]], [[n_bins]] and [[n_boxes]].
	Those are calculated and set accordingly by VEGAS.
	<<vegas: public>>=
	public :: vegas_config_t
	<<vegas: types>>=
	type :: vegas_config_t
	integer :: n_dim = 0
	real(default) :: alpha = 1.5
	integer :: n_bins_max = 50
	integer :: iterations = 5
	integer :: mode = VEGAS_MODE_STRATIFIED
	integer :: calls_per_box = 0
	integer :: n_calls = 0
	integer :: n_calls_min = 20
	integer :: n_boxes = 1
	integer :: n_bins = 1
	contains
	<<vegas: vegas config: TBP>>
	end type vegas_config_t

	@ %def vegas_config_t, n_calls, calls_per_box, n_bins, n_boxes
	@ Write out the configuration of the grid.
	<<vegas: vegas config: TBP>>=
	procedure, public :: write => vegas_config_write
	<<vegas: procedures>>=
	subroutine vegas_config_write (self, unit, indent)
	class(vegas_config_t), intent(in) :: self
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: indent
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Number of dimensions = ", self%n_dim
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "Adaption power (alpha) = ", self%alpha
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Max. number of bins (per dim.) = ", self%n_bins_max
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Number of iterations = ", self%iterations
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Mode (stratified or importance) = ", self%mode
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Calls per box = ", self%calls_per_box
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Number of calls = ", self%n_calls
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Min. number of calls = ", self%n_calls_min
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Number of bins = ", self%n_bins
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Number of boxes = ", self%n_boxes
	end subroutine vegas_config_write

	@ %def vegas_config_write
	@
	\section{Type: vegas\_grid\_t}
	\label{sec:type:-vegas_g}

	We provide a simple and transparent grid container. The container can then later
	be used, to export the actual grid.
	<<vegas: public>>=
	public :: vegas_grid_t
	<<vegas: types>>=
	type :: vegas_grid_t
	integer :: n_dim = 1
	integer :: n_bins = 1
	real(default), dimension(:), allocatable :: x_lower
	real(default), dimension(:), allocatable :: x_upper
	real(default), dimension(:), allocatable :: delta_x
	real(default), dimension(:,:), allocatable :: xi
	contains
	<<vegas: vegas grid: TBP>>
	end type vegas_grid_t

	@ %def vegas_grid_t
	@ Initialise grid.
	<<vegas: interfaces>>=
	interface vegas_grid_t
	module procedure vegas_grid_init
	end interface vegas_grid_t

	<<vegas: procedures>>=
	type(vegas_grid_t) function vegas_grid_init (n_dim, n_bins_max) result (self)
	integer, intent(in) :: n_dim
	integer, intent(in) :: n_bins_max
	self%n_dim = n_dim
	self%n_bins = 1
	allocate (self%x_upper(n_dim), source=1.0_default)
	allocate (self%x_lower(n_dim), source=0.0_default)
	allocate (self%delta_x(n_dim), source=1.0_default)
	allocate (self%xi((n_bins_max + 1), n_dim), source=0.0_default)
	end function vegas_grid_init

	@ %def vegas_grid_init
	@ Output.
	<<vegas: vegas grid: TBP>>=
	procedure, public :: write => vegas_grid_write
	<<vegas: procedures>>=
	subroutine vegas_grid_write (self, unit)
	class(vegas_grid_t), intent(in) :: self
	integer, intent(in), optional :: unit
	integer :: u, i, j
	u = given_output_unit (unit)
	write (u, descr_fmt) "begin vegas_grid_t"
	write (u, integer_fmt) "n_dim = ", self%n_dim
	write (u, integer_fmt) "n_bins = ", self%n_bins
	write (u, descr_fmt) "begin x_lower"
	do j = 1, self%n_dim
	write (u, double_array_fmt) j, self%x_lower(j)
	end do
	write (u, descr_fmt) "end x_lower"
	write (u, descr_fmt) "begin x_upper"
	do j = 1, self%n_dim
	write (u, double_array_fmt) j, self%x_upper(j)
	end do
	write (u, descr_fmt) "end x_upper"
	write (u, descr_fmt) "begin delta_x"
	do j = 1, self%n_dim
	write (u, double_array_fmt) j, self%delta_x(j)
	end do
	write (u, descr_fmt) "end delta_x"
	write (u, descr_fmt) "begin xi"
	do j = 1, self%n_dim
	do i = 1, self%n_bins + 1
	write (u, double_array2_fmt) i, j, self%xi(i, j)
	end do
	end do
	write (u, descr_fmt) "end xi"
	write (u, descr_fmt) "end vegas_grid_t"
	end subroutine vegas_grid_write

	@ %def vegas_grid_write
	@ Compare two grids, if they match up to an given precision.
	<<vegas: public>>=
	public :: operator (==)
	<<vegas: interfaces>>=
	interface operator (==)
	module procedure vegas_grid_equal
	end interface operator (==)
	<<vegas: procedures>>=
	logical function vegas_grid_equal (grid_a, grid_b) result (yorn)
	type(vegas_grid_t), intent(in) :: grid_a, grid_b
	yorn = .true.
	yorn = yorn .and. (grid_a%n_dim == grid_b%n_dim)
	yorn = yorn .and. (grid_a%n_bins == grid_b%n_bins)
	yorn = yorn .and. all (grid_a%x_lower == grid_b%x_lower)
	yorn = yorn .and. all (grid_a%x_upper == grid_b%x_upper)
	yorn = yorn .and. all (grid_a%delta_x == grid_b%delta_x)
	yorn = yorn .and. all (grid_a%xi == grid_b%xi)
	end function vegas_grid_equal

	@ %def vegas_grid_equal
	@ Resize each bin accordingly to its corresponding weight [[w]]. Can be used to
	resize the grid to a new size of bins or refinement.

	The procedure expects two arguments, firstly, [[n_bins]] and, secondly, the
	refinement weights [[w]]. If [[n_bins]] differs from the internally stored one,
	we resize the grid under consideration of [[w]]. If each element of [[w]] equals
	one, then the bins are resized preserving their original bin density.

	Anytime else, we refine the grid accordingly to [[w]].
	<<vegas: vegas grid: TBP>>=
	procedure, private :: resize => vegas_grid_resize
	<<vegas: procedures>>=
	subroutine vegas_grid_resize (self, n_bins, w)
	class(vegas_grid_t), intent(inout) :: self
	integer, intent(in) :: n_bins
	real(default), dimension(:, :), intent(in) :: w
	real(default), dimension(size(self%xi)) :: xi_new
	integer :: i, j, k
	real(default) :: pts_per_bin
	real(default) :: d_width
	call msg_debug (D_VAMP2, "vegas_grid_resize")
	do j = 1, self%n_dim
	if (self%n_bins /= n_bins) then
	pts_per_bin = real(self%n_bins, default) / real(n_bins, default)
	self%n_bins = n_bins
	else
	if (all (w(:, j) == 0.)) then
	call msg_bug ("[VEGAS] grid_resize: resize weights are zero.")
	end if
	pts_per_bin = sum(w(:, j)) / self%n_bins
	end if
	d_width = 0.
	k = 0
	do i = 2, self%n_bins
	do while (pts_per_bin > d_width)
	k = k + 1
	d_width = d_width + w(k, j)
	end do
	d_width = d_width - pts_per_bin
	if (debug_active (D_VAMP2)) then
	print *, " pts_per_bin = ", pts_per_bin, ", d_width = ", d_width
	print *, " j = ", j, ", k = ", k, ", i = ", i
	end if
	associate (x_upper => self%xi(k + 1, j), x_lower => self%xi(k, j))
	xi_new(i) = x_upper - (x_upper - x_lower) * d_width / w(k, j)
	end associate
	end do
	self%xi(:, j) = 0. ! Reset grid explicitly
	self%xi(2:n_bins, j) = xi_new(2:n_bins)
	self%xi(n_bins + 1, j) = 1.
	end do
	end subroutine vegas_grid_resize

	@ %def vegas_grid_resize
	@ Find the probability for a given [[x]] in the unit hypercube.

	For the case [[n_bins < N_BINARY_SEARCH]], we utilize linear search which is faster for short arrays.
	Else we make use of a binary search. Furthermore, we calculate the inverse of
	the probability and invert the result only at the end (saving some time on division).
	<<vegas: vegas grid: TBP>>=
	procedure, public :: get_probability => vegas_grid_get_probability
	<<vegas: procedures>>=
	function vegas_grid_get_probability (self, x) result (g)
	class(vegas_grid_t), intent(in) :: self
	real(default), dimension(:), intent(in) :: x
	integer, parameter :: N_BINARY_SEARCH = 100
	real(default) :: g, y
	integer :: j, i_lower, i_higher, i_mid
	g = 1.
	if (self%n_bins > N_BINARY_SEARCH) then
	g = binary_search (x)
	else
	g = linear_search (x)
	end if
	! Move division to the end, which is more efficient.
	if (g /= 0) g = 1. / g
	contains
	real(default) function linear_search (x) result (g)
	real(default), dimension(:), intent(in) :: x
	real(default) :: y
	integer :: j, i
	g = 1.
	ndim: do j = 1, self%n_dim
	y = (x(j) - self%x_lower(j)) / self%delta_x(j)
	if (y >= 0. .and. y <= 1.) then
	do i = 2, self%n_bins + 1
	if (self%xi(i, j) > y) then
	g = g * (self%delta_x(j) * &
	& self%n_bins * (self%xi(i, j) - self%xi(i - 1, j)))
	cycle ndim
	end if
	end do
	g = 0
	exit ndim
	else
	g = 0
	exit ndim
	end if
	end do ndim
	end function linear_search

	real(default) function binary_search (x) result (g)
	real(default), dimension(:), intent(in) :: x
	ndim: do j = 1, self%n_dim
	y = (x(j) - self%x_lower(j)) / self%delta_x(j)
	if (y >= 0. .and. y <= 1.) then
	i_lower = 1
	i_higher = self%n_bins + 1
	search: do
	if (i_lower >= (i_higher - 1)) then
	g = g * (self%delta_x(j) * &
	& self%n_bins * (self%xi(i_higher, j) - self%xi(i_higher - 1, j)))
	cycle ndim
	end if
	i_mid = (i_higher + i_lower) / 2
	if (y > self%xi(i_mid, j)) then
	i_lower = i_mid
	else
	i_higher = i_mid
	end if
	end do search
	else
	g = 0.
	exit ndim
	end if
	end do ndim
	end function binary_search
	end function vegas_grid_get_probability

	@ %def vegas_grid_get_probability
	@ Broadcast the grid information. As safety measure, we get the actual grid
	object from VEGAS (correclty allocated, but for non-root unfilled) and broadcast
	the root object. On success, we set grid into VEGAS.

	We use the non-blocking broadcast routine, because we have to send quite a bunch
	of integers and reals.

	We have to be very careful with [[n_bins]], the number of bins can actually
	change during different iterations. If we reuse a grid, we have to take that,
	every grid uses the same [[n_bins]]. We expect, that the number of dimension
	does not change, which is in principle possible, but will be checked onto in
	[[vegas_set_grid]].
	<<MPI: vegas: vegas grid: TBP>>=
	procedure, public :: broadcast => vegas_grid_broadcast
	<<MPI: vegas: procedures>>=
	subroutine vegas_grid_broadcast (self)
	class(vegas_grid_t), intent(inout) :: self
	integer :: j, ierror
	type(MPI_Request), dimension(self%n_dim + 4) :: status
	! Blocking
	call MPI_Bcast (self%n_bins, 1, MPI_INTEGER, 0, MPI_COMM_WORLD)
	! Non blocking
	call MPI_Ibcast (self%n_dim, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, status(1))
	call MPI_Ibcast (self%x_lower, self%n_dim, &
	& MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, status(2))
	call MPI_Ibcast (self%x_upper, self%n_dim, &
	& MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, status(3))
	call MPI_Ibcast (self%delta_x, self%n_dim, &
	& MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, status(4))
	ndim: do j = 1, self%n_dim
	call MPI_Ibcast (self%xi(1:self%n_bins + 1, j), self%n_bins + 1,&
	& MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, status(4 + j))
	end do ndim
	call MPI_Waitall (self%n_dim + 4, status, MPI_STATUSES_IGNORE)
	end subroutine vegas_grid_broadcast

	@ %def vegas_grid_broadcast
	@
	\section{Type: vegas\_result\_t}
	\label{sec:type:-vegas_r}

	We store the result of the latest iteration(s) in a transparent container.
	The [[vegas_result_t]] object inside VEGAS must not be directly accessible.
	We export the a copy of the result via a get-method of the [[vegas_t]] object.

	We store latest event weight in [[evt_weight]] and a (possible) evebt weight
	excess in [[evt_weight_excess]], if the event weight is larger than
	[[max_abs_f]].
	<<vegas: public>>=
	public :: vegas_result_t
	<<vegas: types>>=
	type :: vegas_result_t
	integer :: it_start = 0
	integer :: it_num = 0
	integer :: samples = 0
	real(default) :: sum_int_wgtd = 0.
	real(default) :: sum_wgts
	real(default) :: sum_chi = 0.
	real(default) :: chi2 = 0.
	real(default) :: efficiency = 0.
	real(default) :: efficiency_pos = 0.
	real(default) :: efficiency_neg = 0.
	real(default) :: max_abs_f = 0.
	real(default) :: max_abs_f_pos = 0.
	real(default) :: max_abs_f_neg = 0.
	real(default) :: result = 0.
	real(default) :: std = 0.
	real(default) :: evt_weight = 0.
	real(default) :: evt_weight_excess = 0.
	contains
	<<vegas: vegas result: TBP>>
	end type vegas_result_t

	@ %def vegas_results_t
	@ Write out the current status of the integration result.
	<<vegas: vegas result: TBP>>=
	procedure, public :: write => vegas_result_write
	<<vegas: procedures>>=
	subroutine vegas_result_write (self, unit, indent)
	class(vegas_result_t), intent(in) :: self
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: indent
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Start iteration = ", self%it_start
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Iteration number = ", self%it_num
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Sample number = ", self%samples
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 //")") &
	& "Sum of weighted integrals = ", self%sum_int_wgtd
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "Sum of weights = ", self%sum_wgts
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "Sum of chi = ", self%sum_chi
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "chi2 = ", self%chi2
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "Overall efficiency = ", self%efficiency
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "f-positive efficiency = ", self%efficiency_pos
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "f-negative efficiency = ", self%efficiency_neg
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "Maximum absolute overall value = ", self%max_abs_f
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "Maximum absolute positive value = ", self%max_abs_f_pos
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "Maximum absolute negative value = ", self%max_abs_f_neg
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "Integral (of latest iteration) = ", self%result
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "Standard deviation = ", self%std
	write (u, "(2x,A," // FMT_17 // ")") &
	& "Event weight = ", self%evt_weight
	write (u, "(2x,A," // FMT_17 // ")") &
	& "Event weight excess = ", self%evt_weight_excess
	end subroutine vegas_result_write

	@ %def vegas_results_write
	@ Send the result object to specified rank, internally in a non-blocking way.

	We do not need to handle the event results, because each event result is atomic.
	<<MPI: vegas: vegas result: TBP>>=
	procedure, public :: send => vegas_result_send
	<<MPI: vegas: procedures>>=
	subroutine vegas_result_send (self, receiver, tag)
	class(vegas_result_t), intent(in) :: self
	integer, intent(in) :: receiver
	integer, intent(in) :: tag
	type(MPI_Request), dimension(13) :: request
	call MPI_Isend (self%it_start, 1, MPI_INTEGER, receiver, 1 + tag,&
	& MPI_COMM_WORLD, request(1))
	call MPI_Isend (self%it_num, 1, MPI_INTEGER, receiver , 2 + tag,&
	& MPI_COMM_WORLD, request(2))
	call MPI_Isend (self%samples, 1, MPI_INTEGER, receiver, 3 + tag,&
	& MPI_COMM_WORLD, request(3))
	call MPI_Isend (self%sum_int_wgtd, 1, MPI_DOUBLE_PRECISION, receiver, 4 +&
	& tag, MPI_COMM_WORLD, request(4))
	call MPI_Isend (self%sum_wgts, 1, MPI_DOUBLE_PRECISION, receiver, 5 + tag,&
	& MPI_COMM_WORLD, request(5))
	call MPI_Isend (self%sum_chi, 1, MPI_DOUBLE_PRECISION, receiver, 6 + tag,&
	& MPI_COMM_WORLD, request(6))
	call MPI_Isend (self%efficiency, 1, MPI_DOUBLE_PRECISION, receiver, 7 + tag&
	&, MPI_COMM_WORLD, request(7))
	call MPI_Isend (self%efficiency_pos, 1, MPI_DOUBLE_PRECISION, receiver, 8 +&
	& tag, MPI_COMM_WORLD, request(8))
	call MPI_Isend (self%efficiency_neg, 1, MPI_DOUBLE_PRECISION, receiver, 9 +&
	& tag, MPI_COMM_WORLD, request(9))
	call MPI_Isend (self%max_abs_f, 1, MPI_DOUBLE_PRECISION, receiver, 10 + tag&
	&, MPI_COMM_WORLD, request(10))
	call MPI_Isend (self%max_abs_f_pos, 1, MPI_DOUBLE_PRECISION, receiver, 11 +&
	& tag, MPI_COMM_WORLD, request(10))
	call MPI_Isend (self%max_abs_f_neg, 1, MPI_DOUBLE_PRECISION, receiver, 12 +&
	& tag, MPI_COMM_WORLD, request(11))
	call MPI_Isend (self%result, 1, MPI_DOUBLE_PRECISION, receiver, 13 + tag,&
	& MPI_COMM_WORLD, request(12))
	call MPI_Isend (self%std, 1, MPI_DOUBLE_PRECISION, receiver, 14 + tag,&
	& MPI_COMM_WORLD, request(13))
	call MPI_waitall (13, request, MPI_STATUSES_IGNORE)
	end subroutine vegas_result_send

	@ %def vegas_result_communicate
	@ Receive the result object from a specified rank, internally in a non-blocking way.
	<<MPI: vegas: vegas result: TBP>>=
	procedure, public :: receive => vegas_result_receive
	<<MPI: vegas: procedures>>=
	subroutine vegas_result_receive (self, sender, tag)
	class(vegas_result_t), intent(inout) :: self
	integer, intent(in) :: sender
	integer, intent(in) :: tag
	type(MPI_Request), dimension(13) :: request
	call MPI_Irecv (self%it_start, 1, MPI_INTEGER, sender, 1 + tag,&
	& MPI_COMM_WORLD, request(1))
	call MPI_Irecv (self%it_num, 1, MPI_INTEGER, sender , 2 + tag,&
	& MPI_COMM_WORLD, request(2))
	call MPI_Irecv (self%samples, 1, MPI_INTEGER, sender, 3 + tag,&
	& MPI_COMM_WORLD, request(3))
	call MPI_Irecv (self%sum_int_wgtd, 1, MPI_DOUBLE_PRECISION, sender, 4 + tag&
	&, MPI_COMM_WORLD, request(4))
	call MPI_Irecv (self%sum_wgts, 1, MPI_DOUBLE_PRECISION, sender, 5 + tag,&
	& MPI_COMM_WORLD, request(5))
	call MPI_Irecv (self%sum_chi, 1, MPI_DOUBLE_PRECISION, sender, 6 + tag,&
	& MPI_COMM_WORLD, request(6))
	call MPI_Irecv (self%efficiency, 1, MPI_DOUBLE_PRECISION, sender, 7 + tag,&
	& MPI_COMM_WORLD, request(7))
	call MPI_Irecv (self%efficiency_pos, 1, MPI_DOUBLE_PRECISION, sender, 8 +&
	& tag, MPI_COMM_WORLD, request(8))
	call MPI_Irecv (self%efficiency_neg, 1, MPI_DOUBLE_PRECISION, sender, 9 +&
	& tag, MPI_COMM_WORLD, request(9))
	call MPI_Irecv (self%max_abs_f, 1, MPI_DOUBLE_PRECISION, sender, 10 + tag,&
	& MPI_COMM_WORLD, request(10))
	call MPI_Irecv (self%max_abs_f_pos, 1, MPI_DOUBLE_PRECISION, sender, 11 +&
	& tag, MPI_COMM_WORLD, request(10))
	call MPI_Irecv (self%max_abs_f_neg, 1, MPI_DOUBLE_PRECISION, sender, 12 +&
	& tag, MPI_COMM_WORLD, request(11))
	call MPI_Irecv (self%result, 1, MPI_DOUBLE_PRECISION, sender, 13 + tag,&
	& MPI_COMM_WORLD, request(12))
	call MPI_Irecv (self%std, 1, MPI_DOUBLE_PRECISION, sender, 14 + tag,&
	& MPI_COMM_WORLD, request(13))
	call MPI_waitall (13, request, MPI_STATUSES_IGNORE)
	end subroutine vegas_result_receive

	@ %def vegas_result_receive
	\section{Type: vegas\_t}
	\label{sec:type:-vegas_t}

	The VEGAS object contains the methods for integration and grid resize- and
	refinement. We store the grid configuration and the (current) result in
	transparent containers alongside with the actual grid and the distribution.

	The values of the distribution depend on the chosen mode whether the function
	value or the variance is stored. The distribution is used after each iteration
	to refine the grid.
	<<vegas: public>>=
	public :: vegas_t
	<<vegas: types>>=
	type :: vegas_t
	private
	type(vegas_config_t) :: config
	real(default) :: hypercube_volume = 0.
	real(default) :: jacobian = 0.
	real(default), dimension(:, :), allocatable :: d
	type(vegas_grid_t) :: grid
	integer, dimension(:), allocatable :: bin
	integer, dimension(:), allocatable :: box
	type(vegas_result_t) :: result
	contains
	<<vegas: vegas: TBP>>
	end type vegas_t

	@ %def vegas_t
	@ We overload the type constructor of [[vegas_t]] which initialises the
	mandatory argument [[n_dim]] and allocate memory for the grid.
	<<vegas: interfaces>>=
	interface vegas_t
	module procedure vegas_init
	end interface vegas_t
	<<vegas: procedures>>=
	type(vegas_t) function vegas_init (n_dim, alpha, n_bins_max, iterations, mode) result (self)
	integer, intent(in) :: n_dim
	integer, intent(in), optional :: n_bins_max
	real(default), intent(in), optional :: alpha
	integer, intent(in), optional :: iterations
	integer, intent(in), optional :: mode
	self%config%n_dim = n_dim
	if (present (alpha)) self%config%alpha = alpha
	if (present (n_bins_max)) self%config%n_bins_max = n_bins_max
	if (present (iterations)) self%config%iterations = iterations
	if (present (mode)) self%config%mode = mode
	self%grid = vegas_grid_t (n_dim, self%config%n_bins_max)
	allocate (self%d(self%config%n_bins_max, n_dim), source=0.0_default)
	allocate (self%box(n_dim), source=1)
	allocate (self%bin(n_dim), source=1)
	self%config%n_bins = 1
	self%config%n_boxes = 1
	call self%set_limits (self%grid%x_lower, self%grid%x_upper)
	call self%reset_grid ()
	call self%reset_result ()
	end function vegas_init

	@ %def vegas_init

	@ Finalize the grid. Deallocate grid memory.
	<<vegas: vegas: TBP>>=
	procedure, public :: final => vegas_final
	<<vegas: procedures>>=
	subroutine vegas_final (self)
	class(vegas_t), intent(inout) :: self
	deallocate (self%grid%x_upper)
	deallocate (self%grid%x_lower)
	deallocate (self%grid%delta_x)
	deallocate (self%d)
	deallocate (self%grid%xi)
	deallocate (self%box)
	deallocate (self%bin)
	end subroutine vegas_final
	@ %def vegas_final

	\section{Get-/Set-methods}
	\label{sec:set-get-methods}

	@ The VEGAS object prohibits direct access from outside. Communication is handle
	via get- or set-methods. Set the limits of integration. The defaults limits
	correspong the $n$-dimensionl unit hypercube.

	\textit{Remark:} After setting the limits, the grid is initialised, again.
	Previous results are lost due to recalculation of the overall jacobian.
	<<vegas: vegas: TBP>>=
	procedure, public :: set_limits => vegas_set_limits
	<<vegas: procedures>>=
	subroutine vegas_set_limits (self, x_lower, x_upper)
	class(vegas_t), intent(inout) :: self
	real(default), dimension(:), intent(in) :: x_lower
	real(default), dimension(:), intent(in) :: x_upper
	if (size (x_lower) /= self%config%n_dim &
	& .or. size (x_upper) /= self%config%n_dim) then
	write (msg_buffer, "(A, I5, A, I5, A, I5)") &
	"VEGAS: [set_limits] n_dim of new lower/upper integration limit&
	& does not match previously set n_dim. ", self%config%n_dim, " =/=&
	& ", size (x_lower), " =/= ", size (x_upper)
	call msg_fatal ()
	end if
	if (any(x_upper < x_lower)) then
	call msg_fatal ("VEGAS: [set_limits] upper limits are smaller than lower limits.")
	end if
	if (any((x_upper - x_lower) > huge(0._default))) then
	call msg_fatal ("VEGAS: [set_limits] upper and lower limits exceed rendering.")
	end if
	self%grid%x_upper = x_upper
	self%grid%x_lower = x_lower
	self%grid%delta_x = self%grid%x_upper - self%grid%x_lower
	self%hypercube_volume = product (self%grid%delta_x)
	call self%reset_result ()
	end subroutine vegas_set_limits

	@ %def vegas_set_limits
	@ Set the number of calls. If the number of calls changed during different
	passes, we resize the grid preserving the probability density. We should reset
	the results after changing the number of calls which change the size of the grid
	and the running mode of VEGAS. But, this is a set method only for the number of
	calls.
	<<vegas: vegas: TBP>>=
	procedure, public :: set_calls => vegas_set_n_calls
	<<vegas: procedures>>=
	subroutine vegas_set_n_calls (self, n_calls)
	class(vegas_t), intent(inout) :: self
	integer, intent(in) :: n_calls
	if (.not. (n_calls > 0)) then
	write (msg_buffer, "(A, I5)") &
	"VEGAS: [set_calls] number of calls must be a positive number. Keep&
	& number of calls = ", self%config%n_calls
	call msg_warning ()
	else
	self%config%n_calls = max (n_calls, self%config%n_calls_min)
	if (self%config%n_calls /= n_calls) then
	write (msg_buffer, "(A,I5)") &
	"VEGAS: [set calls] number of calls is too few, reset to ", self%config%n_calls
	call msg_warning ()
	end if
	call self%init_grid ()
	end if
	end subroutine vegas_set_n_calls

	@ %def vegas_set_n_calls
	@ Get the grid object and set [[n_bins]], [[n_dim]] inside grid container.
	<<vegas: vegas: TBP>>=
	procedure, public :: get_grid => vegas_get_grid
	<<vegas: procedures>>=
	type(vegas_grid_t) function vegas_get_grid (self) result (grid)
	class(vegas_t), intent(in) :: self
	grid = self%grid
	grid%n_dim = self%config%n_dim
	grid%n_bins = self%config%n_bins
	end function vegas_get_grid

	@ %def vegas_get_grid
	@ Set grid. We need a set method for the parallelisation. We do some additional
	checks before copying the object. Be careful, we do not check on [[n_bins]],
	because the number of bins can change after setting [[n_calls]]. We remind you,
	that you will loose all your current progress, if you use set the grid. Hence,
	it will only be used when compiled with [[MPI]].
	<<MPI: vegas: vegas: TBP>>=
	procedure, public :: set_grid => vegas_set_grid
	<<MPI: vegas: procedures>>=
	subroutine vegas_set_grid (self, grid)
	class(vegas_t), intent(inout) :: self
	type(vegas_grid_t), intent(in) :: grid
	integer :: j, rank
	logical :: success
	call MPI_Comm_rank (MPI_COMM_WORLD, rank)
	success = .true.
	success = (success .and. (grid%n_dim .eq. self%config%n_dim))
	success = (success .and. all (grid%x_lower .eq. self%grid%x_lower))
	success = (success .and. all (grid%x_upper .eq. self%grid%x_upper))
	success = (success .and. all (grid%delta_x .eq. self%grid%delta_x))
	if (success) then
	self%config%n_bins = grid%n_bins
	do j = 1, self%config%n_dim
	self%grid%xi(1, j) = 0._default
	self%grid%xi(2:self%config%n_bins, j) = grid%xi(2:grid%n_bins, j)
	self%grid%xi(self%config%n_bins + 1, j) = 1._default
	end do
	else
	call msg_bug ("VEGAS: set grid: boundary conditions do not match.")
	end if
	end subroutine vegas_set_grid

	@ %def vegas_set_grid
	@ We check if it is senseful to parallelize the actual grid. In simple, this
	means that [[n_boxes]] has to be larger than 2. With the result that we could
	have an actual superimposed stratified grid. In advance, we can give the size of
	communicator [[n_size]] and check whether we have enough boxes to distribute.
	<<MPI: vegas: vegas: TBP>>=
	procedure, public :: is_parallelizable => vegas_is_parallelizable
	<<MPI: vegas: procedures>>=
	elemental logical function vegas_is_parallelizable (self, opt_n_size) result (flag)
	class(vegas_t), intent(in) :: self
	integer, intent(in), optional :: opt_n_size
	integer :: n_size
	n_size = 2
	if (present (opt_n_size)) n_size = opt_n_size
	flag = (self%config%n_boxes**floor (self%config%n_dim / 2.) >= n_size)
	end function vegas_is_parallelizable

	@ %def vegas_is_parallelizable
	@ Get the config object.
	<<vegas: vegas: TBP>>=
	procedure, public :: get_config => vegas_get_config
	<<vegas: procedures>>=
	subroutine vegas_get_config (self, config)
	class(vegas_t), intent(in) :: self
	type(vegas_config_t), intent(out) :: config
	config = self%config
	end subroutine vegas_get_config

	@ %def vegas_get_config
	@ Set non-runtime dependent configuration. It will no be possible to change
	[[n_bins_max]].
	<<vegas: vegas: TBP>>=
	procedure, public :: set_config => vegas_set_config
	<<vegas: procedures>>=
	subroutine vegas_set_config (self, config)
	class(vegas_t), intent(inout) :: self
	class(vegas_config_t), intent(in) :: config
	self%config%alpha = config%alpha
	self%config%iterations = config%iterations
	self%config%mode = config%mode
	self%config%n_calls_min = config%n_calls_min
	end subroutine vegas_set_config

	@ %def vegas_set_config
	@ Get the result object.
	<<vegas: vegas: TBP>>=
	procedure, public :: get_result => vegas_get_result
	<<vegas: procedures>>=
	type(vegas_result_t) function vegas_get_result (self) result (result)
	class(vegas_t), intent(in) :: self
	result = self%result
	end function vegas_get_result

	@ %def vegas_get_result
	@ Set the result object. Be reminded, that you will loose your current results,
	if you are not careful! Hence, it will only be avaible during usage with
	[[MPI]].
	<<MPI: vegas: vegas: TBP>>=
	procedure, public :: set_result => vegas_set_result
	<<MPI: vegas: procedures>>=
	subroutine vegas_set_result (self, result)
	class(vegas_t), intent(inout) :: self
	type(vegas_result_t), intent(in) :: result
	self%result = result
	end subroutine vegas_set_result

	@ %def vegas_set_result
	@ Get (actual) number of calls.
	<<vegas: vegas: TBP>>=
	procedure, public :: get_calls => vegas_get_n_calls
	<<vegas: procedures>>=
	elemental real(default) function vegas_get_n_calls (self) result (n_calls)
	class(vegas_t), intent(in) :: self
	n_calls = self%config%n_calls
	end function vegas_get_n_calls

	@ %def vegas_get_n_calls
	@ Get the cumulative result of the integration. Recalculate weighted average of the integration.
	<<vegas: vegas: TBP>>=
	procedure, public :: get_integral => vegas_get_integral
	<<vegas: procedures>>=
	elemental real(default) function vegas_get_integral (self) result (integral)
	class(vegas_t), intent(in) :: self
	integral = 0.
	if (self%result%sum_wgts > 0.) then
	integral = self%result%sum_int_wgtd / self%result%sum_wgts
	end if
	end function vegas_get_integral

	@ %def vegas_get_integral
	@ Get the cumulative variance of the integration. Recalculate the variance.
	<<vegas: vegas: TBP>>=
	procedure, public :: get_variance => vegas_get_variance
	<<vegas: procedures>>=
	elemental real(default) function vegas_get_variance (self) result (variance)
	class(vegas_t), intent(in) :: self
	variance = 0.
	if (self%result%sum_wgts > 0.) then
	variance = 1.0 / self%result%sum_wgts
	end if
	end function vegas_get_variance

	@ %def vegas_get_variance
	@ Get efficiency.
	<<vegas: vegas: TBP>>=
	procedure, public :: get_efficiency => vegas_get_efficiency
	<<vegas: procedures>>=
	elemental real(default) function vegas_get_efficiency (self) result (efficiency)
	class(vegas_t), intent(in) :: self
	efficiency = 0.
	if (self%result%efficiency > 0. ) then
	efficiency = self%result%efficiency
	end if
	end function vegas_get_efficiency

	@ %def vegas_get_efficiency
	@ Get [[f_max]].
	<<vegas: vegas: TBP>>=
	procedure, public :: get_max_abs_f => vegas_get_max_abs_f
	<<vegas: procedures>>=
	elemental real(default) function vegas_get_max_abs_f (self) result (max_abs_f)
	class(vegas_t), intent(in) :: self
	max_abs_f = 0.
	if (self%result%max_abs_f > 0.) then
	max_abs_f = self%result%max_abs_f
	end if
	end function vegas_get_max_abs_f

	@ %def vegas_get_max_abs_f
	@ Get [[f_max_pos]].
	<<vegas: vegas: TBP>>=
	procedure, public :: get_max_abs_f_pos => vegas_get_max_abs_f_pos
	<<vegas: procedures>>=
	elemental real(default) function vegas_get_max_abs_f_pos (self) result (max_abs_f)
	class(vegas_t), intent(in) :: self
	max_abs_f = 0.
	if (self%result%max_abs_f_pos > 0.) then
	max_abs_f = self%result%max_abs_f_pos
	end if
	end function vegas_get_max_abs_f_pos

	@ %def vegas_get_max_abs_f_pos
	@ Get [[f_max_neg]].
	<<vegas: vegas: TBP>>=
	procedure, public :: get_max_abs_f_neg => vegas_get_max_abs_f_neg
	<<vegas: procedures>>=
	elemental real(default) function vegas_get_max_abs_f_neg (self) result (max_abs_f)
	class(vegas_t), intent(in) :: self
	max_abs_f = 0.
	if (self%result%max_abs_f_neg > 0.) then
	max_abs_f = self%result%max_abs_f_neg
	end if
	end function vegas_get_max_abs_f_neg

	@ %def vegas_get_max_abs_f_neg
	@ Get event weight and excess.
	<<vegas: vegas: TBP>>=
	procedure, public :: get_evt_weight => vegas_get_evt_weight
	procedure, public :: get_evt_weight_excess => vegas_get_evt_weight_excess
	<<vegas: procedures>>=
	real(default) function vegas_get_evt_weight (self) result (evt_weight)
	class(vegas_t), intent(in) :: self
	evt_weight = self%result%evt_weight
	end function vegas_get_evt_weight

	real(default) function vegas_get_evt_weight_excess (self) result (evt_weight_excess)
	class(vegas_t), intent(in) :: self
	evt_weight_excess = self%result%evt_weight_excess
	end function vegas_get_evt_weight_excess

	@ %def vegas_get_evt_weight, vegas_get_evt_weight_excess
	@ Get and set distribution. Beware! This method is hideous as it allows to
	manipulate the algorithm at its very core.
	<<vegas: vegas: TBP>>=
	procedure, public :: get_distribution => vegas_get_distribution
	procedure, public :: set_distribution => vegas_set_distribution
	<<vegas: procedures>>=
	function vegas_get_distribution (self) result (d)
	class(vegas_t), intent(in) :: self
	real(default), dimension(:, :), allocatable :: d
	d = self%d
	end function vegas_get_distribution

	subroutine vegas_set_distribution (self, d)
	class(vegas_t), intent(inout) :: self
	real(default), dimension(:, :), intent(in) :: d
	if (size (d, dim = 2) /= self%config%n_dim) then
	call msg_bug ("[VEGAS] set_distribution: new distribution has wrong size of dimension")
	end if
	if (size (d, dim = 1) /= self%config%n_bins_max) then
	call msg_bug ("[VEGAS] set_distribution: new distribution has wrong number of bins")
	end if
	self%d = d
	end subroutine vegas_set_distribution

	@ %def vegas_set_distribution, vegas_get_distribution
	@ Send distribution to specified rank, internally in a non-blocking way.
	We send the complete array of [[d]], not just the actually used part.
	<<MPI: vegas: vegas: TBP>>=
	procedure, public :: send_distribution => vegas_send_distribution
	<<MPI: vegas: procedures>>=
	subroutine vegas_send_distribution (self, receiver, tag)
	class(vegas_t), intent(in) :: self
	integer, intent(in) :: receiver
	integer, intent(in) :: tag
	integer :: j
	type(MPI_Request), dimension(self%config%n_dim + 2) :: request
	call MPI_Isend (self%bin, self%config%n_dim, MPI_INTEGER, receiver, tag + 1&
	&, MPI_COMM_WORLD, request(1))
	call MPI_Isend (self%box, self%config%n_dim, MPI_INTEGER, receiver, tag + 2&
	&, MPI_COMM_WORLD, request(2))
	do j = 1, self%config%n_dim
	call MPI_Isend (self%d(:, j), self%config%n_bins_max,&
	& MPI_DOUBLE_PRECISION, receiver, tag + j + 2, MPI_COMM_WORLD,&
	& request(j + 2))
	end do
	call MPI_Waitall (self%config%n_dim, request, MPI_STATUSES_IGNORE)
	end subroutine vegas_send_distribution

	@ %def vegas_send_distribution
	@ Receive distribution from specified rank, internally in a non-blocking way.
	<<MPI: vegas: vegas: TBP>>=
	procedure, public :: receive_distribution => vegas_receive_distribution
	<<MPI: vegas: procedures>>=
	subroutine vegas_receive_distribution (self, sender, tag)
	class(vegas_t), intent(inout) :: self
	integer, intent(in) :: sender
	integer, intent(in) :: tag
	integer :: j
	type(MPI_Request), dimension(self%config%n_dim + 2) :: request
	call MPI_Irecv (self%bin, self%config%n_dim, MPI_INTEGER, sender, tag + 1&
	&, MPI_COMM_WORLD, request(1))
	call MPI_Irecv (self%box, self%config%n_dim, MPI_INTEGER, sender, tag + 2&
	&, MPI_COMM_WORLD, request(2))
	do j = 1, self%config%n_dim
	call MPI_Irecv (self%d(:, j), self%config%n_bins_max,&
	& MPI_DOUBLE_PRECISION, sender, tag + j + 2, MPI_COMM_WORLD,&
	& request(j + 2))
	end do
	call MPI_Waitall (self%config%n_dim, request, MPI_STATUSES_IGNORE)
	end subroutine vegas_receive_distribution

	@ %def vegas_receive_distribution
	\section{Grid resize- and refinement}
	\label{sec:grid-resize-refin}

	Before integration the grid itself must be initialised. Given the number of
	[[n_calls]] and [[n_dim]] we prepare the grid for the integration.

	The grid is binned according to the VEGAS mode and [[n_calls]]. If the mode is
	not set to [[vegas_importance_only]], the grid is divided in to equal boxes. We
	try for 2 calls per box
	\begin{equation}
	boxes = \sqrt[n_{dim}]{\frac{calls}{2}}.
	\end{equation}
	If the numbers of boxes exceeds the number of bins, which is the case for low
	dimensions, the algorithm switches to stratified sampling. Otherwise, we are
	still using importance sampling, but keep the boxes for book keeping. If the
	number of bins changes from the previous invocation, bins are expanded or
	contracted accordingly, while preserving bin density.
	<<vegas: vegas: TBP>>=
	procedure, private :: init_grid => vegas_init_grid
	<<vegas: procedures>>=
	subroutine vegas_init_grid (self)
	class(vegas_t), intent(inout) :: self
	integer :: n_bins, n_boxes, box_per_bin, n_total_boxes
	real(default), dimension(:, :), allocatable :: w
	n_bins = self%config%n_bins_max
	n_boxes = 1
	if (self%config%mode /= VEGAS_MODE_IMPORTANCE_ONLY) then
	! We try for 2 calls per box
	n_boxes = max (floor ((self%config%n_calls / 2.)**(1. / self%config%n_dim)), 1)
	self%config%mode = VEGAS_MODE_IMPORTANCE
	if (2 * n_boxes >= self%config%n_bins_max) then
	! if n_bins/box < 2
	box_per_bin = max (n_boxes / self%config%n_bins_max, 1)
	n_bins = min (n_boxes / box_per_bin, self%config%n_bins_max)
	n_boxes = box_per_bin * n_bins
	self%config%mode = VEGAS_MODE_STRATIFIED
	end if
	end if
	n_total_boxes = n_boxes**self%config%n_dim
	self%config%calls_per_box = max (floor (real (self%config%n_calls) / n_total_boxes), 2)
	self%config%n_calls = self%config%calls_per_box * n_total_boxes
	! Total volume of x-space/(average n_calls per bin)
	self%jacobian = self%hypercube_volume * real(n_bins, default)&
	&**self%config%n_dim / real(self%config%n_calls, default)
	self%config%n_boxes = n_boxes
	if (n_bins /= self%config%n_bins) then
	allocate (w(self%config%n_bins, self%config%n_dim), source=1.0_default)
	call self%grid%resize (n_bins, w)
	self%config%n_bins = n_bins
	end if
	end subroutine vegas_init_grid

	@ %def vegas_init_grid
	@ Reset the cumulative result, and efficiency and max. grid values.
	<<vegas: vegas: TBP>>=
	procedure, public :: reset_result => vegas_reset_result
	<<vegas: procedures>>=
	subroutine vegas_reset_result (self)
	class(vegas_t), intent(inout) :: self
	self%result%sum_int_wgtd = 0.
	self%result%sum_wgts = 0.
	self%result%sum_chi = 0.
	self%result%it_num = 0
	self%result%samples = 0
	self%result%chi2 = 0
	self%result%efficiency = 0.
	self%result%efficiency_pos = 0.
	self%result%efficiency_neg = 0.
	self%result%max_abs_f = 0.
	self%result%max_abs_f_pos = 0.
	self%result%max_abs_f_neg = 0.
	end subroutine vegas_reset_result

	@ %def vegas_reset_results
	@ Reset the grid. Purge the adapted grid and the distribution.
	Furthermore, reset the results. The maximal size of the grid remains.

	Note: Handle [[vegas_reset_grid]] with great care! Instead of reusing an old
	object, create a new one.
	<<vegas: vegas: TBP>>=
	procedure, public :: reset_grid => vegas_reset_grid
	<<vegas: procedures>>=
	subroutine vegas_reset_grid (self)
	class(vegas_t), intent(inout) :: self
	self%config%n_bins = 1
	self%d = 0._default
	self%grid%xi = 0._default
	self%grid%xi(1, :) = 0._default
	self%grid%xi(2, :) = 1._default
	call self%reset_result ()
	end subroutine vegas_reset_grid

	@ %def vegas_reset_grid
	@ Refine the grid to match the distribution [[d]].

	Average the distribution over neighbouring bins, then contract or expand the bins.
	The averaging dampens high fluctuations amog the integrand or the variance.

	We make the type-bound procedure public accessible because the multi-channel
	integration refines each grid after integration over all grids.
	<<vegas: vegas: TBP>>=
	procedure, public :: refine => vegas_refine_grid
	<<vegas: procedures>>=
	subroutine vegas_refine_grid (self)
	class(vegas_t), intent(inout) :: self
	integer :: j
	real(default), dimension(self%config%n_bins, self%config%n_dim) :: w
	ndim: do j = 1, self%config%n_dim
	call average_distribution (self%config%n_bins, self%d(:self%config&
	&%n_bins, j), self%config%alpha, w(:, j))
	end do ndim
	call self%grid%resize (self%config%n_bins, w)
	contains
	<<vegas: vegas refine grid: procedures>>
	end subroutine vegas_refine_grid

	@ %def vegas_refine_grid
	@ We average the collected values [[d]] of the (sq.) weighted [[f]] over
	neighbouring bins. The averaged [[d]] are then agian damped by a logarithm to
	enhance numerical stability. The results are then the refinement weights [[w]].

	We have to take care of the special case where we have a very low sampling rate.
	In those cases we can not be sure that the distribution is satisfying filled,
	although we have already averaged over neighbouring bins. This will lead to a
	squashing of the unfilled bins and such the boundaries of those will be pushed
	together. We circumvent this problem by setting those unfilled bins to the
	smallest representable value of a default real.

	The problem becomes very annoying in the multi-channel formualae where have to
	look up via binary search the corresponding probability of [[x]] and if the
	width is zero, the point will be neglected.
	<<vegas: vegas refine grid: procedures>>=
	subroutine average_distribution (n_bins, d, alpha, w)
	integer, intent(in) :: n_bins
	real(default), dimension(:), intent(inout) :: d
	real(default), intent(in) :: alpha
	real(default), dimension(n_bins), intent(out) :: w
	if (n_bins > 2) then
	d(1) = (d(1) + d(2)) / 2.0_default
	d(2:n_bins - 1) = (d(1:n_bins - 2) + d(2:n_bins - 1) + d(3:n_bins)) /&
	& 3.0_default
	d(n_bins) = d(n_bins - 1) + d(n_bins) / 2.0_default
	end if
	w = 1.0_default
	if (.not. all (d < tiny (1.0_default))) then
	d = d / sum (d)
	where (d < tiny (1.0_default))
	d = tiny (1.0_default)
	end where
	where (d /= 1.0_default)
	w = ((d - 1.) / log(d))**alpha
	elsewhere
	! Analytic limes for d -> 1
	w = 1.0_default
	end where
	end if
	end subroutine average_distribution

	@ %def average_distribution
	@
	\section{Integration}
	\label{sec:integration}

	Integrate [[func]], in the previous set bounds [[x_lower]] to [[x_upper]], with [[n_calls]].
	Use results from previous invocations of [[integrate]] with [[opt_reset_result =
	.false.]] and better with subsequent calls.

	Before we walk through the hybercube, we initialise the grid (at a central position).

	We step through the (equidistant) boxes which ensure we do not miss any place in the n-dim. hypercube.
	In each box we sample [[calls_per_box]] random points and transform them to bin coordinates.
	The total integral and the total (sample) variance over each box $i$ is then calculated by
	\begin{align*}
	E(I)_{i} = \sum_{j}^{\text{calls per box}} I_{i, j}, \\
	V(I)_{i} = \text{calls per box} \frac{\sum_{j}^{\text{calls per box}}} I_{i, j}^{2} - (\sum_{j}^{\text{calls per box}} I_{i, j})**2 \frac{\text{calls per box}}{\text{calls per box} - 1}.
	\end{align*}
	The stratification of the $n$-dimensional hybercube allows a simple
	parallelisation of the algorithm (R. Kreckel, "Parallelization of adaptive MC integrators", Computer Physics Communications, vol. 106, no. 3, pp. 258–266, Nov. 1997.).
	We have to ensure that all boxes are sampled, but the number of boxes to
	distribute is too large. We allow each thread to sample a fraction $r$ of all
	boxes $k$ such that $r \ll k$. Furthermore, we constrain that the number of
	process $p$ is much smaller than $r$.

	The overall constraint is
	\begin{equation}
	p \ll r \ll k.
	\end{equation}
	We divide the intgeration into a parallel and
	a perpendicular subspace. The number of parallel dimensions is $D_{\parallel} =
	\lfloor \frac{D}{2} \rfloor$.
	<<vegas: vegas: TBP>>=
	procedure, public :: integrate => vegas_integrate
	<<vegas: procedures>>=
	subroutine vegas_integrate (self, func, rng, iterations, opt_reset_result,&
	& opt_refine_grid, opt_verbose, result, abserr)
	class(vegas_t), intent(inout) :: self
	class(vegas_func_t), intent(inout) :: func
	class(rng_t), intent(inout) :: rng
	integer, intent(in), optional :: iterations
	logical, intent(in), optional :: opt_reset_result
	logical, intent(in), optional :: opt_refine_grid
	logical, intent(in), optional :: opt_verbose
	real(default), optional, intent(out) :: result, abserr
	integer :: it, j, k
	real(default), dimension(self%config%n_dim) :: x
	real(default) :: fval, fval_sq, bin_volume
	real(default) :: fval_box, fval_sq_box
	real(default) :: total_integral, total_sq_integral, total_variance, chi, wgt
	real(default) :: cumulative_int, cumulative_std
	real(default) :: sum_abs_f_pos, max_abs_f_pos
	real(default) :: sum_abs_f_neg, max_abs_f_neg
	logical :: reset_result = .true.
	logical :: refine_grid = .true.
	logical :: verbose = .false.
	<<vegas: vegas integrate: variables>>
	if (present (iterations)) self%config%iterations = iterations
	if (present (opt_reset_result)) reset_result = opt_reset_result
	if (present (opt_refine_grid)) refine_grid = opt_refine_grid
	if (present (opt_verbose)) verbose = opt_verbose
	<<vegas: vegas integrate: initialization>>
	if (verbose) then
	call msg_message ("Results: [it, calls, integral, error, chi^2, eff.]")
	end if
	iteration: do it = 1, self%config%iterations
	<<vegas: vegas integrate: pre sampling>>
	loop_over_par_boxes: do while (box_success)
	loop_over_perp_boxes: do while (box_success)
	fval_box = 0._default
	fval_sq_box = 0._default
	if (debug2_active (D_VAMP2)) then
	print *, "box:"
	print *, self%box
	end if
	do k = 1, self%config%calls_per_box
	call self%random_point (rng, x, bin_volume)
	! Call the function, yeah, call it...
	fval = self%jacobian * bin_volume * func%evaluate (x)
	fval_sq = fval**2
	fval_box = fval_box + fval
	fval_sq_box = fval_sq_box + fval_sq
	if (fval > 0.) then
	max_abs_f_pos = max(abs (fval), max_abs_f_pos)
	sum_abs_f_pos = sum_abs_f_pos + abs(fval)
	else
	max_abs_f_neg = max(abs (fval), max_abs_f_neg)
	sum_abs_f_neg = sum_abs_f_neg + abs(fval)
	end if
	if (self%config%mode /= VEGAS_MODE_STRATIFIED) then
	call self%accumulate_distribution (fval_sq)
	end if
	if (debug2_active (D_VAMP2)) then
	print *, "fval = ", fval
	print *, "fval_sq = ", fval_sq
	print *, "fval_box = ", fval_box
	print *, "fval_box_sq = ", fval_sq_box
	print *, "sum_abs_f_pos = ", sum_abs_f_pos
	print *, "sum_abs_f_neg = ", sum_abs_f_neg
	print *, "max_abs_f_pos = ", max_abs_f_pos
	print *, "max_abs_f_neg = ", max_abs_f_neg
	end if
	end do
	fval_sq_box = sqrt (fval_sq_box * self%config%calls_per_box)
	! (a - b) * (a + b) = a2 - b2
	fval_sq_box = (fval_sq_box - fval_box) * (fval_sq_box + fval_box)
	if (fval_sq_box <= 0.0) fval_sq_box = tiny (1.0_default)
	total_integral = total_integral + fval_box
	total_sq_integral = total_sq_integral + fval_sq_box
	if (self%config%mode == VEGAS_MODE_STRATIFIED) then
	call self%accumulate_distribution (fval_sq_box)
	end if
	call increment_box_coord (self%box(n_dim_par + 1:self%config&
	&%n_dim), box_success)
	end do loop_over_perp_boxes
	shift: do k = 1, n_size
	call increment_box_coord (self%box(1:n_dim_par), box_success)
	if (.not. box_success) exit shift
	end do shift
	<<vegas: vegas integrate: sampling>>
	end do loop_over_par_boxes
	<<vegas: vegas integrate: post sampling>>
	associate (result => self%result)
	! Compute final results for this iterations
	total_variance = total_sq_integral / (self%config%calls_per_box - 1.)
	! Ensure variance is always positive and larger than zero.
	if (total_variance < tiny (1._default) / epsilon (1._default) &
	& * max (total_integral**2, 1._default)) then
	total_variance = tiny (1._default) / epsilon (1._default) &
	& * max (total_integral**2, 1._default)
	end if
	wgt = 1. / total_variance
	total_sq_integral = total_integral**2
	result%result = total_integral
	result%std = sqrt (total_variance)
	result%samples = result%samples + 1
	if (result%samples == 1) then
	result%chi2 = 0._default
	else
	chi = total_integral
	if (result%sum_wgts > 0) then
	chi = chi - result%sum_int_wgtd / result%sum_wgts
	end if
	result%chi2 = result%chi2 * (result%samples - 2.0_default)
	result%chi2 = (wgt / (1._default + (wgt / result%sum_wgts))) &
	& * chi**2
	result%chi2 = result%chi2 / (result%samples - 1._default)
	end if
	result%sum_wgts = result%sum_wgts + wgt
	result%sum_int_wgtd = result%sum_int_wgtd + (total_integral * wgt)
	result%sum_chi = result%sum_chi + (total_sq_integral * wgt)
	cumulative_int = result%sum_int_wgtd / result%sum_wgts
	cumulative_std = sqrt (1. / result%sum_wgts)
	end associate
	call calculate_efficiency ()
	if (verbose) then
	write (msg_buffer, "(I0,1x,I0,1x, 4(E16.8E4,1x))") &
	& it, self%config%n_calls, cumulative_int, cumulative_std, &
	& self%result%chi2, self%result%efficiency
	call msg_message ()
	end if
	if (refine_grid) call self%refine ()
	end do iteration
	if (present(result)) result = cumulative_int
	if (present(abserr)) abserr = abs(cumulative_std)
	contains
	<<vegas: vegas integrate: procedures>>
	end subroutine vegas_integrate

	@ %def vegas_integrate
	@ Calculate the extras here.
	We define
	\begin{equation}
	\operatorname*{max}_{x} w(x) = \frac{f(x)}{p(x)} \Delta_{\text{jac}}.
	\end{equation}
	In the implementation we have to factor out [[n_calls]] in the jacobian.
	Also, during event generation.
	<<vegas: vegas integrate: procedures>>=
	subroutine calculate_efficiency ()
	self%result%max_abs_f_pos = self%config%n_calls * max_abs_f_pos
	self%result%max_abs_f_neg = self%config%n_calls * max_abs_f_neg
	call msg_debug (D_VAMP2, "max_abs_f_pos", self%result%max_abs_f_pos)
	call msg_debug (D_VAMP2, "max_abs_f_neg", self%result%max_abs_f_neg)
	call msg_debug (D_VAMP2, "sum_abs_f_pos", sum_abs_f_pos)
	call msg_debug (D_VAMP2, "sum_abs_f_neg", sum_abs_f_neg)
	self%result%max_abs_f = &
	& max (self%result%max_abs_f_pos, self%result%max_abs_f_neg)
	self%result%efficiency_pos = 0.
	if (max_abs_f_pos > 0.) then
	self%result%efficiency_pos = &
	& sum_abs_f_pos / max_abs_f_pos
	end if
	self%result%efficiency_neg = 0.
	if (max_abs_f_neg > 0.) then
	self%result%efficiency_neg = &
	& sum_abs_f_neg / max_abs_f_neg
	end if
	self%result%efficiency = 0.
	if (self%result%max_abs_f > 0.) then
	self%result%efficiency = (sum_abs_f_pos + sum_abs_f_neg) &
	& / self%result%max_abs_f
	end if
	end subroutine calculate_efficiency

	@ %def calculate_efficiency
	@ We define additional chunk, which will be used later on for inserting
	MPI/general MPI code. The code can is then removed by additional noweb filter if
	not compiled with the correspondig compiler flag.

	Overall variables, some additionally introduced due to the MPI parallelization
	and needed in sequentiell verison.
	<<vegas: vegas integrate: variables>>=
	integer :: n_size
	integer :: n_dim_par
	logical :: box_success
	! MPI-specific variables below
	@ Overall initialization.
	<<vegas: vegas integrate: initialization>>=
	call self%init_grid ()
	if (reset_result) call self%reset_result ()
	self%result%it_start = self%result%it_num
	cumulative_int = 0.
	cumulative_std = 0.
	n_size = 1
	n_dim_par = floor (self%config%n_dim / 2.)
	@ Reset all last-iteration results before sampling.
	<<vegas: vegas integrate: pre sampling>>=
	self%result%it_num = self%result%it_start + it
	self%d = 0.
	self%box = 1
	self%bin = 1
	total_integral = 0.
	total_sq_integral = 0.
	total_variance = 0.
	sum_abs_f_pos = 0.
	max_abs_f_pos = 0.
	sum_abs_f_neg = 0.
	max_abs_f_neg = 0.
	box_success = .true.
	select type (rng)
	type is (rng_stream_t)
	call rng%next_substream ()
	end select
	@ Pacify output by defining empty chunk (nothing to do here).
	<<vegas: vegas integrate: sampling>>=
	@
	<<vegas: vegas integrate: post sampling>>=
	@ Increment the box coordinates by 1. If we reach the largest value for the
	current axis (starting with the largest dimension number), we reset the counter
	to 1 and increment the next axis counter by 1. And so on, until we reach the
	maximum counter value of the axis with the lowest dimension, then we set
	[[success]] to false and the box coord is set to 1.
	<<vegas: vegas integrate: procedures>>=
	subroutine increment_box_coord (box, success)
	integer, dimension(:), intent(inout) :: box
	logical, intent(out) :: success
	integer :: j
	success = .true.
	do j = size (box), 1, -1
	box(j) = box(j) + 1
	if (box(j) <= self%config%n_boxes) return
	box(j) = 1
	end do
	success = .false.
	end subroutine increment_box_coord

	@ %def increment_box_coord
	@ We parallelize [[VEGAS]] in simple forward manner. The hyper-cube is dissambled
	in to equidistant boxes in which we sample the integrand [[calls_per_box]]
	times. The workload of calculating those boxes is distributed along the worker.

	The number of dimensions which will be parallelised are $\lfloor \frac{D}{2}
	\rfloor$, such MPI Variables for [[vegas_integrate]]. We have to duplicate all
	buffers for [[MPI_Ireduce]], because we cannot use the same send or receive
	buffer.

	We temporarily store a (empty) grid, before communicating.
	<<MPI: vegas: vegas integrate: variables>>=
	integer :: rank
	type(vegas_grid_t) :: grid
	@ MPI procedure-specific initialization.
	<<MPI: vegas: vegas integrate: initialization>>=
	call MPI_Comm_size (MPI_COMM_WORLD, n_size)
	call MPI_Comm_rank (MPI_COMM_WORLD, rank)
	@ Pre-sampling communication.

	We make a copy of the (actual) grid, which is unfilled when non-root.
	The actual grid is then broadcasted among the workers and inserted into the
	[[VEGAS]] object.
	<<MPI: vegas: vegas integrate: pre sampling>>=
	if (self%is_parallelizable ()) then
	grid = self%get_grid ()
	call grid%broadcast ()
	call self%set_grid (grid)
	end if
	@ Start index of the boxes for different ranks. If the random number generator
	is RngStream, we can advance the current stream in such a way, that we will
	getting matching numbers. Iff [[n_boxes]] is larger than 2, otherwise
	parallelization is useless.
	<<MPI: vegas: vegas integrate: pre sampling>>=
	if (self%is_parallelizable ()) then
	do k = 1, rank
	call increment_box_coord (self%box(1:n_dim_par), box_success)
	if (.not. box_success) exit
	end do
	select type (rng)
	type is (rng_stream_t)
	call rng%advance_state (self%config%n_dim * self%config%calls_per_box&
	& * self%config%n_boxes*(self%config%n_dim - n_dim_par) rank)
	end select
	end if
	@ Increment [[n_size]] times the box coordinates.
	<<MPI: vegas: vegas integrate: sampling>>=
	if (self%is_parallelizable ()) then
	select type (rng)
	type is (rng_stream_t)
	call rng%advance_state (self%config%n_dim * self%config%calls_per_box&
	& * self%config%n_boxes*(self%config%n_dim - n_dim_par) (n_size - 1))
	end select
	end if
	@ Call to [[vegas_integrate_collect]].
	<<MPI: vegas: vegas integrate: post sampling>>=
	if (self%is_parallelizable ()) then
	call vegas_integrate_collect ()
	if (rank /= 0) cycle iteration
	end if
	@ Reduce (in an non-blocking fashion) all sampled information via [[MPI_SUM]] or [[MPI_MAX]].
	<<MPI: vegas: vegas integrate: procedures>>=
	subroutine vegas_integrate_collect ()
	real(default) :: root_total_integral, root_total_sq_integral
	real(default) :: root_sum_abs_f_pos, root_max_abs_f_pos
	real(default) :: root_sum_abs_f_neg, root_max_abs_f_neg
	real(default), dimension(self%config%n_bins_max, self%config%n_dim) :: root_d
	type(MPI_Request), dimension(self%config%n_dim + 6) :: status
	root_d = 0._default
	root_sum_abs_f_pos = 0._default
	root_sum_abs_f_neg = 0._default
	root_max_abs_f_pos = 0._default
	root_sum_abs_f_neg = 0._default
	root_total_integral = 0._default
	root_total_sq_integral = 0._default
	call MPI_Ireduce (sum_abs_f_pos, root_sum_abs_f_pos, 1, MPI_DOUBLE_PRECISION,&
	& MPI_SUM, 0, MPI_COMM_WORLD, status(1))
	call MPI_Ireduce (sum_abs_f_neg, root_sum_abs_f_neg, 1, MPI_DOUBLE_PRECISION,&
	& MPI_SUM, 0, MPI_COMM_WORLD, status(2))
	call MPI_Ireduce (max_abs_f_pos, root_max_abs_f_pos, 1, MPI_DOUBLE_PRECISION,&
	& MPI_MAX, 0, MPI_COMM_WORLD, status(3))
	call MPI_Ireduce (max_abs_f_neg, root_max_abs_f_neg, 1, MPI_DOUBLE_PRECISION,&
	& MPI_MAX, 0, MPI_COMM_WORLD, status(4))
	call MPI_Ireduce (total_integral, root_total_integral, 1, MPI_DOUBLE_PRECISION,&
	& MPI_SUM, 0, MPI_COMM_WORLD, status(5))
	call MPI_Ireduce (total_sq_integral, root_total_sq_integral, 1,&
	& MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, status(6))
	do j = 1, self%config%n_dim
	call MPI_Ireduce (self%d(1:self%config%n_bins, j), root_d(1:self%config&
	&%n_bins, j), self%config%n_bins, MPI_DOUBLE_PRECISION, MPI_SUM, 0,&
	& MPI_COMM_WORLD, status(6 + j))
	end do
	call MPI_Waitall (self%config%n_dim + 6, status, MPI_STATUSES_IGNORE)
	if (rank == 0) sum_abs_f_pos = root_sum_abs_f_pos
	if (rank == 0) sum_abs_f_neg = root_sum_abs_f_neg
	if (rank == 0) max_abs_f_pos = root_max_abs_f_pos
	if (rank == 0) max_abs_f_neg = root_max_abs_f_neg
	if (rank == 0) total_integral = root_total_integral
	if (rank == 0) total_sq_integral = root_total_sq_integral
	if (rank == 0) self%d = root_d
	end subroutine vegas_integrate_collect

	@ %def vegas_integrate_collect
	@ Obtain a random point inside the $n$-dimensional hypercube, transform onto the correct interval and calculate the bin volume. The additional factor [[n_bins]] is already applied to the [[jacobian]] (per dimension).
	<<vegas: vegas: TBP>>=
	procedure, private :: random_point => vegas_random_point
	<<vegas: procedures>>=
	subroutine vegas_random_point (self, rng, x, bin_volume)
	class(vegas_t), intent(inout) :: self
	class(rng_t), intent(inout) :: rng
	real(default), dimension(self%config%n_dim), intent(out) :: x
	real(default), intent(out) :: bin_volume
	integer :: j
	real(default) :: r, y, z, bin_width
	bin_volume = 1.
	ndim: do j = 1, self%config%n_dim
	call msg_debug2 (D_VAMP2, "j", j)
	call rng%generate (r)
	z = ((self%box(j) - 1 + r) / self%config%n_boxes) * self%config%n_bins + 1
	self%bin(j) = max (min (int (z), self%config%n_bins), 1)
	if (self%bin(j) == 1) then
	bin_width = self%grid%xi(2, j)
	y = (z - self%bin(j)) * bin_width
	else
	bin_width = self%grid%xi(self%bin(j) + 1, j) - self%grid%xi(self%bin(j), j)
	y = self%grid%xi(self%bin(j), j) + (z - self%bin(j)) * bin_width
	end if
	x(j) = self%grid%x_lower(j) + y * self%grid%delta_x(j)
	bin_volume = bin_volume * bin_width
	if (debug2_active (D_VAMP2)) then
	print *, "r =", r
	print *, "z =", z
	print *, "bin(j) =", self%bin(j)
	print *, "y =", y
	print *, "x(j) =", x(j)
	end if
	end do ndim
	call msg_debug2 (D_VAMP2, "bin_volume", bin_volume)
	end subroutine vegas_random_point

	@ %def vegas_random_point
	@ Obtain a random point inside the $n$-dimensional hyper-cube. We neglect
	stratification and generate the random point in the most simple way. Hence, we
	do not need to know in which box we are actually sampling. This is useful for
	only for event generation.
	<<vegas: vegas: TBP>>=
	procedure, private :: simple_random_point => vegas_simple_random_point
	<<vegas: procedures>>=
	subroutine vegas_simple_random_point (self, rng, x, bin_volume)
	class(vegas_t), intent(inout) :: self
	class(rng_t), intent(inout) :: rng
	real(default), dimension(self%config%n_dim), intent(out) :: x
	real(default), intent(out) :: bin_volume
	integer :: j, k
	real(default) :: r, y, z, bin_width
	bin_volume = 1.
	ndim: do j = 1, self%config%n_dim
	call msg_debug2 (D_VAMP2, "j", j)
	call rng%generate (r)
	z = r * self%config%n_bins + 1
	k = max (min (int (z), self%config%n_bins), 1)
	if (k == 1) then
	bin_width = self%grid%xi(2, j)
	y = (z - 1) * bin_width
	else
	bin_width = self%grid%xi(k + 1, j) - self%grid%xi(k, j)
	y = self%grid%xi(k, j) + (z - k) * bin_width
	end if
	x(j) = self%grid%x_lower(j) + y * self%grid%delta_x(j)
	bin_volume = bin_volume * bin_width
	if (debug2_active (D_VAMP2)) then
	print *, "r =", r
	print *, "z =", z
	print *, "bin(j) =", self%bin(j)
	print *, "y =", y
	print *, "x(j) =", x(j)
	end if
	end do ndim
	call msg_debug2 (D_VAMP2, "bin_volume", bin_volume)
	end subroutine vegas_simple_random_point

	@ %def vegas_simple_random_point
	@
	<<vegas: vegas: TBP>>=
	procedure, private :: accumulate_distribution => vegas_accumulate_distribution
	<<vegas: procedures>>=
	subroutine vegas_accumulate_distribution (self, y)
	class(vegas_t), intent(inout) :: self
	real(default), intent(in) :: y
	integer :: j
	do j = 1, self%config%n_dim
	self%d(self%bin(j), j) = self%d(self%bin(j), j) + y
	end do
	end subroutine vegas_accumulate_distribution

	@ %def vegas_accumulate_distribution
	@ Generate weighted random event.

	The weight given by the overall jacobian
	\begin{equation}
	\Delta_{\text{jac}} = \prod_{j=1}^{d} \left( x_j^+ - x_j^- \right) \frac{N_{\text{bins}}^d}{N_{\text{calls}}}
	\end{equation}
	includes the overall non-changing factors $\frac{1}{N_{\text{calls}}}$-factor (divisions are
	expensive) and $N_{\text{bins}}^{d}$, the latter combined with [[bin_volume]]
	gives rise to the probability, see [[vegas_init_grid]] for details.
	We have to factor out $N_{\text{calls}}$ to retrieve the correct weight.
	<<vegas: vegas: TBP>>=
	procedure :: generate_weighted => vegas_generate_weighted_event
	<<vegas: procedures>>=
	subroutine vegas_generate_weighted_event (self, func, rng, x)
	class(vegas_t), intent(inout) :: self
	class(vegas_func_t), intent(inout) :: func
	class(rng_t), intent(inout) :: rng
	real(default), dimension(self%config%n_dim), intent(inout) :: x
	real(default) :: bin_volume
	call self%simple_random_point (rng, x, bin_volume)
	! Cancel n_calls from jacobian with n_calls
	self%result%evt_weight = self%config%n_calls * self%jacobian * bin_volume &
	& * func%evaluate (x)
	call msg_debug (D_VAMP2, "Event weight", self%result%evt_weight)
	end subroutine vegas_generate_weighted_event

	@ %def vegas_generate_weighted_event
	@ Generate random event. We accept on the rate
	\begin{equation}
	\frac{\|f(x)\|}{\underset{x}{\max} \|f(x)\|}.
	\end{equation}
	We keep separate maximum weights for positive and negative weights, and use
	them, accordingly.
	In the case of unweighted event generation, if the current weight exceeds the
	the maximum weight, we update the maximum, accordingly.
	<<vegas: vegas: TBP>>=
	procedure, public :: generate_unweighted=> vegas_generate_unweighted_event
	<<vegas: procedures>>=
	subroutine vegas_generate_unweighted_event (self, func, rng, x)
	class(vegas_t), intent(inout) :: self
	class(vegas_func_t), intent(inout) :: func
	class(rng_t), intent(inout) :: rng
	real(default), dimension(self%config%n_dim), intent(out) :: x
	real(default) :: bin_volume
	real(default) :: max_abs_f
	real(default) :: r
	associate (result => self%result)
	generate: do
	call self%generate_weighted (func, rng, x)
	max_abs_f = merge (result%max_abs_f_pos, result%max_abs_f_neg, &
	& result%evt_weight > 0.)
	if (result%evt_weight > max_abs_f) then
	result%evt_weight_excess = &
	& result%evt_weight / max_abs_f - 1._default
	exit generate
	end if
	call rng%generate (r)
	if (debug2_active (D_VAMP2)) then
	print *, "max_abs_f = ", max_abs_f
	print , "accept = ", max_abs_f r
	print *, "x = ", x
	end if
	! Do not use division, because max_abs_f could be zero.
	if (max_abs_f * r <= abs(result%evt_weight)) then
	exit generate
	end if
	end do generate
	end associate
	end subroutine vegas_generate_unweighted_event

	@ %def vegas_random_event
	\section{I/0 operation}
	\label{sec:i0-operation}
	@ Write grid to file. We use the original VAMP formater.
	<<vegas: parameters>>=
	character(len=*), parameter, private :: &
	descr_fmt = "(1X,A)", &
	integer_fmt = "(1X,A18,1X,I15)", &
	integer_array_fmt = "(1X,I18,1X,I15)", &
	logical_fmt = "(1X,A18,1X,L1)", &
	double_fmt = "(1X,A18,1X,E16.8E4)", &
	double_array_fmt = "(1X,I18,1X,E16.8E4)", &
	double_array2_fmt = "(1X,2(1X,I8),1X,E16.8E4)"

	@ %def descr_fmt integer_fmt integer_array_fmt logical_fmt
	@ %def double_fmt double_array_fmt double_array2_fmt
	<<vegas: vegas: TBP>>=
	procedure, public :: write_grid => vegas_write_grid
	<<vegas: procedures>>=
	subroutine vegas_write_grid (self, unit)
	class(vegas_t), intent(in) :: self
	integer, intent(in), optional :: unit
	integer :: u
	integer :: i, j
	u = given_output_unit (unit)
	write (u, descr_fmt) "begin type(vegas_t)"
	write (u, integer_fmt) "n_dim =", self%config%n_dim
	write (u, integer_fmt) "n_bins_max =", self%config%n_bins_max
	write (u, double_fmt) "alpha =", self%config%alpha
	write (u, integer_fmt) "iterations =", self%config%iterations
	write (u, integer_fmt) "mode =", self%config%mode
	write (u, integer_fmt) "calls_per_box =", self%config%calls_per_box
	write (u, integer_fmt) "n_calls =", self%config%n_calls
	write (u, integer_fmt) "n_calls_min =", self%config%n_calls_min
	write (u, integer_fmt) "n_boxes =", self%config%n_boxes
	write (u, integer_fmt) "n_bins =", self%config%n_bins
	write (u, integer_fmt) "it_start =", self%result%it_start
	write (u, integer_fmt) "it_num =", self%result%it_num
	write (u, integer_fmt) "samples =", self%result%samples
	write (u, double_fmt) "sum_int_wgtd =", self%result%sum_int_wgtd
	write (u, double_fmt) "sum_wgts =", self%result%sum_wgts
	write (u, double_fmt) "sum_chi =", self%result%sum_chi
	write (u, double_fmt) "chi2 =", self%result%chi2
	write (u, double_fmt) "efficiency =", self%result%efficiency
	write (u, double_fmt) "efficiency =", self%result%efficiency_pos
	write (u, double_fmt) "efficiency =", self%result%efficiency_neg
	write (u, double_fmt) "max_abs_f =", self%result%max_abs_f
	write (u, double_fmt) "max_abs_f_pos =", self%result%max_abs_f_pos
	write (u, double_fmt) "max_abs_f_neg =", self%result%max_abs_f_neg
	write (u, double_fmt) "result =", self%result%result
	write (u, double_fmt) "std =", self%result%std
	write (u, double_fmt) "hypercube_volume =", self%hypercube_volume
	write (u, double_fmt) "jacobian =", self%jacobian
	write (u, descr_fmt) "begin x_lower"
	do j = 1, self%config%n_dim
	write (u, double_array_fmt) j, self%grid%x_lower(j)
	end do
	write (u, descr_fmt) "end x_lower"
	write (u, descr_fmt) "begin x_upper"
	do j = 1, self%config%n_dim
	write (u, double_array_fmt) j, self%grid%x_upper(j)
	end do
	write (u, descr_fmt) "end x_upper"
	write (u, descr_fmt) "begin delta_x"
	do j = 1, self%config%n_dim
	write (u, double_array_fmt) j, self%grid%delta_x(j)
	end do
	write (u, descr_fmt) "end delta_x"
	write (u, integer_fmt) "n_bins =", self%config%n_bins
	write (u, descr_fmt) "begin bin"
	do j = 1, self%config%n_dim
	write (u, integer_array_fmt) j, self%bin(j)
	end do
	write (u, descr_fmt) "end n_bin"
	write (u, integer_fmt) "n_boxes =", self%config%n_boxes
	write (u, descr_fmt) "begin box"
	do j = 1, self%config%n_dim
	write (u, integer_array_fmt) j, self%box(j)
	end do
	write (u, descr_fmt) "end box"
	write (u, descr_fmt) "begin d"
	do j = 1, self%config%n_dim
	do i = 1, self%config%n_bins_max
	write (u, double_array2_fmt) i, j, self%d(i, j)
	end do
	end do
	write (u, descr_fmt) "end d"
	write (u, descr_fmt) "begin xi"
	do j = 1, self%config%n_dim
	do i = 1, self%config%n_bins_max + 1
	write (u, double_array2_fmt) i, j, self%grid%xi(i, j)
	end do
	end do
	write (u, descr_fmt) "end xi"
	write (u, descr_fmt) "end type(vegas_t)"
	end subroutine vegas_write_grid

	@ %def vegas_write_grid
	@ Read grid configuration from file.
	<<vegas: vegas: TBP>>=
	procedure, public :: read_grid => vegas_read_grid
	<<vegas: procedures>>=
	subroutine vegas_read_grid (self, unit)
	class(vegas_t), intent(out) :: self
	integer, intent(in) :: unit
	integer :: i, j
	character(len=80) :: buffer
	integer :: ibuffer, jbuffer
	read (unit, descr_fmt) buffer
	read (unit, integer_fmt) buffer, ibuffer
	read (unit, integer_fmt) buffer, jbuffer
	select type(self)
	type is (vegas_t)
	self = vegas_t (n_dim = ibuffer, n_bins_max = jbuffer)
	end select
	read (unit, double_fmt) buffer, self%config%alpha
	read (unit, integer_fmt) buffer, self%config%iterations
	read (unit, integer_fmt) buffer, self%config%mode
	read (unit, integer_fmt) buffer, self%config%calls_per_box
	read (unit, integer_fmt) buffer, self%config%n_calls
	read (unit, integer_fmt) buffer, self%config%n_calls_min
	read (unit, integer_fmt) buffer, self%config%n_boxes
	read (unit, integer_fmt) buffer, self%config%n_bins
	self%grid%n_bins = self%config%n_bins
	read (unit, integer_fmt) buffer, self%result%it_start
	read (unit, integer_fmt) buffer, self%result%it_num
	read (unit, integer_fmt) buffer, self%result%samples
	read (unit, double_fmt) buffer, self%result%sum_int_wgtd
	read (unit, double_fmt) buffer, self%result%sum_wgts
	read (unit, double_fmt) buffer, self%result%sum_chi
	read (unit, double_fmt) buffer, self%result%chi2
	read (unit, double_fmt) buffer, self%result%efficiency
	read (unit, double_fmt) buffer, self%result%efficiency_pos
	read (unit, double_fmt) buffer, self%result%efficiency_neg
	read (unit, double_fmt) buffer, self%result%max_abs_f
	read (unit, double_fmt) buffer, self%result%max_abs_f_pos
	read (unit, double_fmt) buffer, self%result%max_abs_f_neg
	read (unit, double_fmt) buffer, self%result%result
	read (unit, double_fmt) buffer, self%result%std
	read (unit, double_fmt) buffer, self%hypercube_volume
	read (unit, double_fmt) buffer, self%jacobian
	read (unit, descr_fmt) buffer
	do j = 1, self%config%n_dim
	read (unit, double_array_fmt) jbuffer, self%grid%x_lower(j)
	end do
	read (unit, descr_fmt) buffer
	read (unit, descr_fmt) buffer
	do j = 1, self%config%n_dim
	read (unit, double_array_fmt) jbuffer, self%grid%x_upper(j)
	end do
	read (unit, descr_fmt) buffer
	read (unit, descr_fmt) buffer
	do j = 1, self%config%n_dim
	read (unit, double_array_fmt) jbuffer, self%grid%delta_x(j)
	end do
	read (unit, descr_fmt) buffer
	read (unit, integer_fmt) buffer, self%config%n_bins
	read (unit, descr_fmt) buffer
	do j = 1, self%config%n_dim
	read (unit, integer_array_fmt) jbuffer, self%bin(j)
	end do
	read (unit, descr_fmt) buffer
	read (unit, integer_fmt) buffer, self%config%n_boxes
	read (unit, descr_fmt) buffer
	do j = 1, self%config%n_dim
	read (unit, integer_array_fmt) jbuffer, self%box(j)
	end do
	read (unit, descr_fmt) buffer
	read (unit, descr_fmt) buffer
	do j = 1, self%config%n_dim
	do i = 1, self%config%n_bins_max
	read (unit, double_array2_fmt) ibuffer, jbuffer, self%d(i, j)
	end do
	end do
	read (unit, descr_fmt) buffer
	read (unit, descr_fmt) buffer
	do j = 1, self%config%n_dim
	do i = 1, self%config%n_bins_max + 1
	read (unit, double_array2_fmt) ibuffer, jbuffer, self%grid%xi(i, j)
	end do
	end do
	read (unit, descr_fmt) buffer
	read (unit, descr_fmt) buffer
	end subroutine vegas_read_grid

	@ %def vegas_read_grid
	@
	\section{Unit tests}
	\label{sec:unit-tests}

	Test module, followed by the corresponding implementation module.

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

	module vegas_ut
	use unit_tests
	use vegas_uti

	<<Standard module head>>

	<<vegas: public test>>

	contains
	<<vegas: test driver>>
	end module vegas_ut
	@ %def vegas_ut
	@
	<<[[vegas_uti.f90]]>>=
	<<File header>>

	module vegas_uti
	<<Use kinds>>
	use io_units
	use constants, only: pi
	use format_defs, only: FMT_10, FMT_12
	use rng_base
	use rng_stream
	use vegas

	<<Standard module head>>

	<<vegas: test declaration>>

	<<vegas: test types>>

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

	@ %def vegas_test
	@
	\subsubsection{Test function}
	\label{sec:test-function}

	We use the example from the Monte Carlo Examples of the GSL library
	\begin{equation}
	I = \int_{-pi}^{+pi} {dk_x/(2 pi)} \int_{-pi}^{+pi} {dk_y/(2 pi)} \int_{-pi}^{+pi} {dk_z/(2 pi)} 1 / (1 - cos(k_x)cos(k_y)cos(k_z)).
	\end{equation}
	The integral is reduced to region (0,0,0) $\rightarrow$ ($\pi$, $\pi$, $\pi$) and multiplied by 8.
	<<vegas: test types>>=
	type, extends (vegas_func_t) :: vegas_test_func_t
	!
	contains
	<<vegas: vegas test func: TBP>>
	end type vegas_test_func_t

	@ %def vegas_test_func_t
	@ Evaluate the integrand.
	<<vegas: vegas test func: TBP>>=
	procedure, public :: evaluate => vegas_test_func_evaluate
	<<vegas: tests>>=
	real(default) function vegas_test_func_evaluate (self, x) result (f)
	class(vegas_test_func_t), intent(inout) :: self
	real(default), dimension(:), intent(in) :: x
	f = 1.0 / (pi**3)
	f = f / ( 1.0 - cos (x(1)) * cos (x(2)) * cos (x(3)))
	end function vegas_test_func_evaluate

	@ %def vegas_test_func_evaluate
	@ The second test function is the normalised n-dim.\@ gaussian distribution.
	<<vegas: test types>>=
	type, extends (vegas_func_t) :: vegas_gaussian_test_func_t
	!
	contains
	<<vegas: vegas gaussian test func: TBP>>
	end type vegas_gaussian_test_func_t

	@ %def vegas_gaussian_test_func_t
	@ Evaluate the integrand.
	<<vegas: vegas gaussian test func: TBP>>=
	procedure, public :: evaluate => vegas_gaussian_evaluate
	<<vegas: tests>>=
	real(default) function vegas_gaussian_evaluate (self, x) result (f)
	class(vegas_gaussian_test_func_t), intent(inout) :: self
	real(default), dimension(:), intent(in) :: x
	real(default), parameter :: inv_sqrt_pi = 1._default / sqrt(pi)
	f = inv_sqrt_pi**size (x)
	f = f * exp (- dot_product(x, x))
	end function vegas_gaussian_evaluate

	@ %def vegas_gaussian_evaluate
	@ The third test function is a three-dimensional polynomial function which
	factories. The function is defined in such a way that the integral in the unit
	range is normalised to zero.
	\begin{equation}
	f(x) = - \frac{8}{3} (x + 1)(y-1)z
	\end{equation}
	<<vegas: test types>>=
	type, extends (vegas_func_t) :: vegas_polynomial_func_t
	!
	contains
	<<vegas: vegas polynomial func: TBP>>
	end type vegas_polynomial_func_t

	@ %def vegas_polynomial_func_t
	<<vegas: vegas polynomial func: TBP>>=
	procedure, public :: evaluate => vegas_polynomial_evaluate
	<<vegas: tests>>=
	real(default) function vegas_polynomial_evaluate (self, x) result (f)
	class(vegas_polynomial_func_t), intent(inout) :: self
	real(default), dimension(:), intent(in) :: x
	f = - 8. / 3. * (x(1) + 1.) * (x(2) - 1.) * x(3)
	end function vegas_polynomial_evaluate

	@ %def vegas_polynomial_evaluate
	@
	\subsubsection{MC Integrator check}
	\label{sec:mc-integrator-check}

	Initialise the VEGAS MC integrator and call to [[vegas_init_grid]] for the
	initialisation of the grid.
	<<vegas: execute tests>>=
	call test (vegas_1, "vegas_1", "VEGAS initialisation and&
	& grid preparation", u, results)
	<<vegas: test declaration>>=
	public :: vegas_1
	<<vegas: tests>>=
	subroutine vegas_1 (u)
	integer, intent(in) :: u
	type(vegas_t) :: mc_integrator
	class(rng_t), allocatable :: rng
	class(vegas_func_t), allocatable :: func
	real(default), dimension(3), parameter :: x_lower = 0., &
	x_upper = pi
	real(default) :: result, abserr

	write (u, "(A)") "* Test output: vegas_1"
	write (u, "(A)") "* Purpose: initialise the VEGAS MC integrator and the grid"
	write (u, "(A)")

	write (u, "(A)") "* Initialise random number generator (default seed)"
	write (u, "(A)")

	allocate (rng_stream_t :: rng)
	call rng%init ()

	call rng%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise MC integrator with n_dim = 3"
	write (u, "(A)")

	allocate (vegas_test_func_t :: func)
	mc_integrator = vegas_t (3)

	write (u, "(A)")
	write (u, "(A)") "* Initialise grid with n_calls = 10000"
	write (u, "(A)")

	call mc_integrator%set_limits (x_lower, x_upper)
	call mc_integrator%set_calls (10000)

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

	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

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

	call mc_integrator%set_calls (2000)
	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

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

	call mc_integrator%final ()
	call rng%final ()
	deallocate (rng)
	end subroutine vegas_1
	@ %def vegas_1
	@
	\subsubsection{Configuration and result check}
	\label{sec:conf-result-check}

	Initialise the MC integrator. Get and write the config object, also the (empty) result object.
	<<vegas: execute tests>>=
	call test (vegas_2, "vegas_2", "VEGAS configuration and result object", u, results)
	<<vegas: test declaration>>=
	public :: vegas_2
	<<vegas: tests>>=
	subroutine vegas_2 (u)
	integer, intent(in) :: u
	type(vegas_t) :: mc_integrator
	type(vegas_config_t) :: mc_integrator_config
	type(vegas_result_t) :: mc_integrator_result

	write (u, "(A)") "* Test output: vegas_2"
	write (u, "(A)") "* Purpose: use transparent containers for&
	& configuration and result."
	write (u, "(A)")

	write (u, "(A)")
	write (u, "(A)") "* Initialise MC integrator with n_dim = 10"
	write (u, "(A)")

	mc_integrator = vegas_t (10)

	write (u, "(A)")
	write (u, "(A)") "* Initialise grid with n_calls = 10000 (Importance Sampling)"
	write (u, "(A)")

	call mc_integrator%set_calls (10000)

	write (u, "(A)")
	write (u, "(A)") "* Get VEGAS config object and write out"
	write (u, "(A)")

	call mc_integrator%get_config (mc_integrator_config)
	call mc_integrator_config%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Get VEGAS empty result object and write out"
	write (u, "(A)")

	mc_integrator_result = mc_integrator%get_result ()
	call mc_integrator_result%write (u)

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

	call mc_integrator%final ()
	end subroutine vegas_2
	@ %def vegas_2
	@
	\subsubsection{Grid check}
	\label{sec:conf-result-check}

	Initialise the MC integrator. Get and write the config object. Integrate the gaussian distribution.
	Get and write the result object. Before and after integration get the grid
	object and output both.
	Repeat with different number of dimensions.
	<<vegas: execute tests>>=
	call test (vegas_3, "vegas_3", "VEGAS integration of multi-dimensional gaussian", u, results)
	<<vegas: test declaration>>=
	public :: vegas_3
	<<vegas: tests>>=
	subroutine vegas_3 (u)
	integer, intent(in) :: u
	type(vegas_t) :: mc_integrator
	class(rng_t), allocatable :: rng
	class(vegas_func_t), allocatable :: func
	real(default), dimension(3), parameter :: x_lower_3 = -10._default, &
	x_upper_3 = 10._default
	type(vegas_config_t) :: mc_integrator_config
	type(vegas_grid_t) :: mc_integrator_grid
	type(vegas_result_t) :: mc_integrator_result

	real(default) :: result, abserr

	write (u, "(A)") "* Test output: vegas_3"
	write (u, "(A)") "* Purpose: Integrate gaussian distribution."
	write (u, "(A)")

	allocate (rng_stream_t :: rng)
	call rng%init ()

	call rng%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise MC integrator with n_dim = 3"
	write (u, "(A)")

	allocate (vegas_gaussian_test_func_t :: func)
	mc_integrator = vegas_t (3)

	write (u, "(A)")
	write (u, "(A)") "* Initialise grid with n_calls = 10000"
	write (u, "(A)")

	call mc_integrator%set_limits (x_lower_3, x_upper_3)
	call mc_integrator%set_calls (10000)

	write (u, "(A)")
	write (u, "(A)") "* Get VEGAS config object and write out"
	write (u, "(A)")

	call mc_integrator%get_config (mc_integrator_config)
	call mc_integrator_config%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Get VEGAS grid object and write out"
	write (u, "(A)")

	mc_integrator_grid = mc_integrator%get_grid ()
	call mc_integrator_grid%write (u)

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

	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

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

	call mc_integrator%set_calls (2000)
	call mc_integrator%get_config (mc_integrator_config)
	call mc_integrator_config%write (u)

	write (u, "(A)")

	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr


	write (u, "(A)")
	write (u, "(A)") "* Get VEGAS result object and write out"
	write (u, "(A)")

	mc_integrator_result = mc_integrator%get_result ()
	call mc_integrator_result%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Get VEGAS grid object and write out"
	write (u, "(A)")

	mc_integrator_grid = mc_integrator%get_grid ()
	call mc_integrator_grid%write (u)

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

	call mc_integrator%final ()
	end subroutine vegas_3
	@ %def vegas_3
	\subsubsection{Three-dimensional integration with polynomial function}
	\label{sec:conf-result-check}

	Initialise the MC integrator. Get and write the config object. Integrate the
	factorisable polynomial function. Get and write the result object. Repeat with
	different number of dimensions.
	<<vegas: execute tests>>=
	call test (vegas_4, "vegas_4", "VEGAS integration of three&
	&-dimensional factorisable polynomial function", u, results)
	<<vegas: test declaration>>=
	public :: vegas_4
	<<vegas: tests>>=
	subroutine vegas_4 (u)
	integer, intent(in) :: u
	type(vegas_t) :: mc_integrator
	class(rng_t), allocatable :: rng
	class(vegas_func_t), allocatable :: func
	real(default), dimension(3), parameter :: x_lower_3 = 0._default, &
	x_upper_3 = 1._default
	type(vegas_config_t) :: mc_integrator_config
	type(vegas_result_t) :: mc_integrator_result

	real(default) :: result, abserr

	write (u, "(A)") "* Test output: vegas_4"
	write (u, "(A)") "* Purpose: Integrate gaussian distribution."
	write (u, "(A)")

	allocate (rng_stream_t :: rng)
	call rng%init ()

	call rng%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise MC integrator with n_dim = 3"
	write (u, "(A)")

	allocate (vegas_polynomial_func_t :: func)
	mc_integrator = vegas_t (3)

	write (u, "(A)")
	write (u, "(A)") "* Initialise grid with n_calls = 2000"
	write (u, "(A)")

	call mc_integrator%set_limits (x_lower_3, x_upper_3)
	call mc_integrator%set_calls (2000)

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

	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)

	call mc_integrator%get_config (mc_integrator_config)
	call mc_integrator_config%write (u)

	write (u, "(A)")

	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

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

	call mc_integrator%set_calls (20000)

	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)

	call mc_integrator%get_config (mc_integrator_config)
	call mc_integrator_config%write (u)

	write (u, "(A)")
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

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

	call mc_integrator%final ()
	end subroutine vegas_4

	@ %def vegas_4
	@
	\subsubsection{Event generation}

	Initialise the MC integrator. Integrate the gaussian distribution.
	Get and write the result object. Finally, generate events in accordance to the
	adapted grid and print them out.
	<<vegas: execute tests>>=
	call test (vegas_5, "vegas_5", "VEGAS integration and event&
	& generation of multi-dimensional gaussian", u, results)
	<<vegas: test declaration>>=
	public :: vegas_5
	<<vegas: tests>>=
	subroutine vegas_5 (u)
	integer, intent(in) :: u
	type(vegas_t) :: mc_integrator
	class(rng_t), allocatable :: rng
	class(vegas_func_t), allocatable :: func
	real(default), dimension(1), parameter :: x_lower_1 = -10._default, &
	x_upper_1 = 10._default
	type(vegas_config_t) :: mc_integrator_config
	type(vegas_result_t) :: mc_integrator_result

	integer :: i, u_event
	real(default), dimension(1) :: event, mean, delta, M2
	real(default) :: result, abserr

	write (u, "(A)") "* Test output: vegas_5"
	write (u, "(A)") "* Purpose: Integrate gaussian distribution."
	write (u, "(A)")

	allocate (rng_stream_t :: rng)
	call rng%init ()

	call rng%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise MC integrator with n_dim = 1"
	write (u, "(A)")

	allocate (vegas_gaussian_test_func_t :: func)
	mc_integrator = vegas_t (1)

	write (u, "(A)")
	write (u, "(A)") "* Initialise grid with n_calls = 20000"
	write (u, "(A)")

	call mc_integrator%set_limits (x_lower_1, x_upper_1)
	call mc_integrator%set_calls (20000)

	write (u, "(A)")
	write (u, "(A)") "* Integrate with n_it = 3 (Adaptation)"
	write (u, "(A)")

	call mc_integrator%integrate (func, rng, 3, opt_verbose=.true., result=result, abserr=abserr)
	call mc_integrator%get_config (mc_integrator_config)
	call mc_integrator_config%write (u)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") &
	& "Result: ", result, " +/- ", abserr

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

	call mc_integrator%set_calls (2000)
	call mc_integrator%integrate (func, rng, 3, opt_verbose=.true., result=result, abserr=abserr)
	call mc_integrator%get_config (mc_integrator_config)
	call mc_integrator_config%write (u)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") &
	& "Result: ", result, " +/- ", abserr

	write (u, "(A)")
	write (u, "(A)") "* Generate 10000 events based on the adaptation and&
	& calculate mean and variance"
	write (u, "(A)")

	mean = 0._default
	M2 = 0._default
	do i = 1, 10000
	call mc_integrator%generate_unweighted (func, rng, event)
	delta = event - mean
	mean = mean + delta / i
	M2 = M2 + delta * (event - mean)
	end do

	write (u, "(2X,A)") "Result:"
	write (u, "(4X,A," // FMT_12 //")") &
	& "mean = ", mean
	write (u, "(4X,A," // FMT_12 //")") &
	& "(sample) std. dev. = ", sqrt (M2 / (9999))

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

	call mc_integrator%final ()
	end subroutine vegas_5

	@ %def vegas_5
	@
	\subsubsection{Grid I/O}
	\label{sec:grid-io}

	Initialise the MC integrator. Get and write the config object. Integrate the
	factorisable polynomial function. Get and write the result object. Write grid to
	file and start with fresh grid.
	<<vegas: execute tests>>=
	call test (vegas_6, "vegas_6", "VEGAS integrate and write grid, &
	& read grid and continue", u, results)
	<<vegas: test declaration>>=
	public :: vegas_6
	<<vegas: tests>>=
	subroutine vegas_6 (u)
	integer, intent(in) :: u
	type(vegas_t) :: mc_integrator
	class(rng_t), allocatable :: rng
	class(vegas_func_t), allocatable :: func
	real(default), dimension(3), parameter :: x_lower_3 = 0._default, &
	x_upper_3 = 1._default
	type(vegas_config_t) :: mc_integrator_config
	type(vegas_result_t) :: mc_integrator_result

	real(default) :: result, abserr
	integer :: unit

	write (u, "(A)") "* Test output: vegas_6"
	write (u, "(A)") "* Purpose: Write and read grid, and continue."
	write (u, "(A)")

	allocate (rng_stream_t :: rng)
	call rng%init ()

	call rng%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise MC integrator with n_dim = 3"
	write (u, "(A)")

	allocate (vegas_polynomial_func_t :: func)
	mc_integrator = vegas_t (3)

	write (u, "(A)")
	write (u, "(A)") "* Initialise grid with n_calls = 2000"
	write (u, "(A)")

	call mc_integrator%set_limits (x_lower_3, x_upper_3)
	call mc_integrator%set_calls (2000)

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

	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)

	call mc_integrator%get_config (mc_integrator_config)
	call mc_integrator_config%write (u)

	write (u, "(A)")

	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

	write (u, "(A)")
	write (u, "(A)") "* Write grid to file vegas_io.grid"
	write (u, "(A)")

	unit = free_unit ()
	open (unit, file = "vegas_io.grid", &
	action = "write", status = "replace")
	call mc_integrator%write_grid (unit)
	close (unit)

	write (u, "(A)")
	write (u, "(A)") "* Read grid from file vegas_io.grid"
	write (u, "(A)")

	call mc_integrator%final ()
	open (unit, file = "vegas_io.grid", &
	action = "read", status = "old")
	call mc_integrator%read_grid (unit)
	close (unit)

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

	call mc_integrator%set_calls (20000)

	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)

	call mc_integrator%get_config (mc_integrator_config)
	call mc_integrator_config%write (u)

	write (u, "(A)")
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

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

	call mc_integrator%final ()
	end subroutine vegas_6

	@ %def vegas_6
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{VAMP2}
	\label{sec:vamp2}

	We concentrate all configuration and run-time data in a derived-type, such that,
	[[mci_t]] can spwan each time a distinctive MCI VEGAS integrator object.

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

	module vamp2

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_utils, only: pac_fmt
	use format_utils, only: write_separator, write_indent
	use format_defs, only: FMT_17
	use diagnostics
	use rng_base
	use rng_stream, only: rng_stream_t

	use vegas

	<<vamp2: modules>>

	<<Standard module head>>

	<<vamp2: public>>

	<<vamp2: parameters>>

	<<vamp2: types>>

	<<vamp2: interfaces>>

	contains

	<<vamp2: procedures>>

	end module vamp2
	@ %def vamp2
	<<vamp2: modules>>=
	@
	<<MPI: vamp2: modules>>=
	use mpi_f08 !NODEP!
	@
	\subsection{Type: vamp2\_func\_t}
	\label{sec:vamp2-func}

	We extend [[vegas_func_t]] with the multi-channel weights and the
	[[vegas_grid_t]], such that, the overall multi-channel weight can be calculated
	by the function itself.

	We add an additional logicial [[valid_x]], if it is set to [[.false.]], we do
	not compute weighted function and just set the weighted integrand to zero.
	This behavior is in particular very useful, if a mapping is prohibited or fails.
	Or in the case of WHIZARD, a phase cut is applied.
	<<vamp2: public>>=
	public :: vamp2_func_t
	<<vamp2: types>>=
	type, abstract, extends(vegas_func_t) :: vamp2_func_t
	integer :: current_channel = 0
	integer :: n_dim = 0
	integer :: n_channel = 0
	integer :: n_calls = 0
	logical :: valid_x = .false.
	real(default), dimension(:, :), allocatable :: xi
	real(default), dimension(:), allocatable :: det
	real(default), dimension(:), allocatable :: wi
	real(default), dimension(:), allocatable :: gi
	type(vegas_grid_t), dimension(:), allocatable :: grids
	real(default) :: g = 0.
	contains
	<<vamp2: vamp2 func: TBP>>
	end type vamp2_func_t

	@ %def vamp2_func_t
	@ Init.
	<<vamp2: vamp2 func: TBP>>=
	procedure, public :: init => vamp2_func_init
	<<vamp2: procedures>>=
	subroutine vamp2_func_init (self, n_dim, n_channel)
	class(vamp2_func_t), intent(out) :: self
	integer, intent(in) :: n_dim
	integer, intent(in) :: n_channel
	self%n_dim = n_dim
	self%n_channel = n_channel
	allocate (self%xi(n_dim, n_channel), source=0._default)
	allocate (self%det(n_channel), source=1._default)
	allocate (self%wi(n_channel), source=0._default)
	allocate (self%gi(n_channel), source=0._default)
	allocate (self%grids(n_channel))
	end subroutine vamp2_func_init

	@ %def vamp2_func_init
	@ Set current channel.
	<<vamp2: vamp2 func: TBP>>=
	procedure, public :: set_channel => vamp2_func_set_channel
	<<vamp2: procedures>>=
	subroutine vamp2_func_set_channel (self, channel)
	class(vamp2_func_t), intent(inout) :: self
	integer, intent(in) :: channel
	self%current_channel = channel
	end subroutine vamp2_func_set_channel

	@ %def vamp2_func_set_channel
	@ Get number of function calls for which $f \neq 0$.
	<<vamp2: vamp2 func: TBP>>=
	procedure, public :: get_n_calls => vamp2_func_get_n_calls
	<<vamp2: procedures>>=
	integer function vamp2_func_get_n_calls (self) result (n_calls)
	class(vamp2_func_t), intent(in) :: self
	n_calls = self%n_calls
	end function vamp2_func_get_n_calls

	@ %def vamp2_func_get_func_calls
	@ Reset number of calls.
	<<vamp2: vamp2 func: TBP>>=
	procedure, public :: reset_n_calls => vamp2_func_reset_n_calls
	<<vamp2: procedures>>=
	subroutine vamp2_func_reset_n_calls (self)
	class(vamp2_func_t), intent(inout) :: self
	self%n_calls = 0
	end subroutine vamp2_func_reset_n_calls

	@ %def vamp2_func_reset_n_calls
	@ Evaluate mappings. We defer this method to be implemented by the user.
	The result must be written to [[xi]] and [[det]].

	The mapping is defined by $\phi : U \rightarrow M$. We map $x \in M$ to the
	different mappings of the hypercube $U_{i}$, such that $x_{i} \in U_{i}$.

	The mapping should determine, whether [[x]] is a valid point, e.g. can be
	mapped, or is restricted otherwise.
	<<vamp2: vamp2 func: TBP>>=
	procedure(vamp2_func_evaluate_maps), deferred :: evaluate_maps
	<<vamp2: interfaces>>=
	abstract interface
	subroutine vamp2_func_evaluate_maps (self, x)
	import :: vamp2_func_t, default
	class(vamp2_func_t), intent(inout) :: self
	real(default), dimension(:), intent(in) :: x
	end subroutine vamp2_func_evaluate_maps
	end interface

	@ %def vamp2_evaluate_func
	-@ Evaluate channel weights.
	+@ Evaluate channel weights.
	+
	+The calling procedure must handle the case of a vanishing overall probability
	+density where either a channel weight or a channel probability vanishes.
	<<vamp2: vamp2 func: TBP>>=
	procedure, private :: evaluate_weight => vamp2_func_evaluate_weight
	<<vamp2: procedures>>=
	subroutine vamp2_func_evaluate_weight (self)
	class(vamp2_func_t), intent(inout) :: self
	integer :: ch
	self%g = 0.
	self%gi = 0.
	!$OMP PARALLEL DO PRIVATE(ch) SHARED(self)
	do ch = 1, self%n_channel
	if (self%wi(ch) /= 0) then
	self%gi(ch) = self%grids(ch)%get_probability (self%xi(:, ch))
	end if
	end do
	!$OMP END PARALLEL DO
	if (self%gi(self%current_channel) /= 0) then
	do ch = 1, self%n_channel
	if (self%wi(ch) /= 0 .and. self%det(ch) /= 0) then
	self%g = self%g + self%wi(ch) * self%gi(ch) / self%det(ch)
	end if
	end do
	self%g = self%g / self%gi(self%current_channel)
	end if
	end subroutine vamp2_func_evaluate_weight

	@ %def vamp2_func_evaluate_weight
	@ Evaluate function at [[x]]. We call this procedure in [[vamp2_func_evaluate]].
	<<vamp2: vamp2 func: TBP>>=
	procedure(vamp2_func_evaluate_func), deferred :: evaluate_func
	<<vamp2: interfaces>>=
	abstract interface
	real(default) function vamp2_func_evaluate_func (self, x) result (f)
	import :: vamp2_func_t, default
	class(vamp2_func_t), intent(in) :: self
	real(default), dimension(:), intent(in) :: x
	end function vamp2_func_evaluate_func
	end interface

	@ %def vamp2_func_evaluate_func
	<<vamp2: vamp2 func: TBP>>=
	procedure, public :: evaluate => vamp2_func_evaluate
	<<vamp2: procedures>>=
	real(default) function vamp2_func_evaluate (self, x) result (f)
	class(vamp2_func_t), intent(inout) :: self
	real(default), dimension(:), intent(in) :: x
	call self%evaluate_maps (x)
	f = 0.
	self%gi = 0.
	self%g = 1
	if (self%valid_x) then
	call self%evaluate_weight ()
	- f = self%evaluate_func (x) / self%g
	- self%n_calls = self%n_calls + 1
	+ if (self%g /= 0) then
	+ f = self%evaluate_func (x) / self%g
	+ self%n_calls = self%n_calls + 1
	+ end if
	end if
	end function vamp2_func_evaluate

	@ %def vamp2_func_evaluate
	\subsection{Type: vamp2\_config\_t}
	\label{sec:vamp2-config}

	This is a transparent container which incorporates and extends the definitions
	in [[vegas_config]]. The parent object can then be used to parametrise the VEGAS
	grids directly, where the new parameters are exclusively used in the
	multi-channel implementation of VAMP2.
	[[n_calls_min]] is calculated by [[n_calls_min_per_channel]] and [[n_channel]].
	The channels weights (and the result [[n_calls]] for each channel) are
	calculated regarding [[n_calls_threshold]].
	<<vamp2: public>>=
	public :: vamp2_config_t
	<<vamp2: types>>=
	type, extends(vegas_config_t) :: vamp2_config_t
	integer :: n_channel = 0
	integer :: n_calls_min_per_channel = 20
	integer :: n_calls_threshold = 10
	integer :: n_chains = 0
	logical :: stratified = .true.
	logical :: equivalences = .false.
	real(default) :: beta = 0.5_default
	real(default) :: accuracy_goal = 0._default
	real(default) :: error_goal = 0._default
	real(default) :: rel_error_goal = 0._default
	contains
	<<vamp2: vamp2 config: TBP>>
	end type vamp2_config_t

	@ %def vamp2_config_t
	@ Write.
	<<vamp2: vamp2 config: TBP>>=
	procedure, public :: write => vamp2_config_write
	<<vamp2: procedures>>=
	subroutine vamp2_config_write (self, unit, indent)
	class(vamp2_config_t), intent(in) :: self
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: indent
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call self%vegas_config_t%write (unit, indent)
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Number of channels = ", self%n_channel
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Min. number of calls per channel (setting calls) = ", &
	& self%n_calls_min_per_channel
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Threshold number of calls (adapting weights) = ", &
	& self%n_calls_threshold
	call write_indent (u, ind)
	write (u, "(2x,A,I0)") &
	& "Number of chains = ", self%n_chains
	call write_indent (u, ind)
	write (u, "(2x,A,L1)") &
	& "Stratified = ", self%stratified
	call write_indent (u, ind)
	write (u, "(2x,A,L1)") &
	& "Equivalences = ", self%equivalences
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "Adaption power (beta) = ", self%beta
	if (self%accuracy_goal > 0) then
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "accuracy_goal = ", self%accuracy_goal
	end if
	if (self%error_goal > 0) then
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "error_goal = ", self%error_goal
	end if
	if (self%rel_error_goal > 0) then
	call write_indent (u, ind)
	write (u, "(2x,A," // FMT_17 // ")") &
	& "rel_error_goal = ", self%rel_error_goal
	end if
	end subroutine vamp2_config_write

	@ %def vamp2_config_write
	@
	\subsection{Type: vamp2\_result\_t}
	\label{sec:vamp2-result}

	This is a transparent container which incorporates and extends the definitions
	of [[vegas_result_t]].

	<<vamp2: public>>=
	public :: vamp2_result_t
	<<vamp2: types>>=
	type, extends(vegas_result_t) :: vamp2_result_t
	contains
	<<vamp2: vamp2 result: TBP>>
	end type vamp2_result_t

	@ %def vamp2_result_t
	@ Output.
	<<vamp2: vamp2 result: TBP>>=
	procedure, public :: write => vamp2_result_write
	<<vamp2: procedures>>=
	subroutine vamp2_result_write (self, unit, indent)
	class(vamp2_result_t), intent(in) :: self
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: indent
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call self%vegas_result_t%write (unit, indent)
	end subroutine vamp2_result_write

	@ %def vamp2_result_write
	@
	\subsection{Type: vamp2\_equivalences\_t}
	\label{sec:vamp2-eqv}

	<<vamp2: parameters>>=
	integer, parameter, public :: &
	VEQ_IDENTITY = 0, VEQ_INVERT = 1, VEQ_SYMMETRIC = 2, VEQ_INVARIANT = 3
	@
	@ Channel equivalences. Store retrieving and sourcing channel.
	<<vamp2: types>>=
	type :: vamp2_equi_t
	integer :: ch
	integer :: ch_src
	integer, dimension(:), allocatable :: perm
	integer, dimension(:), allocatable :: mode
	contains
	<<vamp2: vamp2 equi: TBP>>
	end type vamp2_equi_t

	@ %def vamp2_equi_t
	@ Write equivalence.
	<<vamp2: vamp2 equi: TBP>>=
	procedure :: write => vamp2_equi_write
	<<vamp2: procedures>>=
	subroutine vamp2_equi_write (self, unit, indent)
	class(vamp2_equi_t), intent(in) :: self
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: indent
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, ind)
	write (u, "(2(A,1X,I0))") "src:", self%ch_src, "-> dest:", self%ch
	call write_indent (u, ind)
	write (u, "(A,99(1X,I0))") "Perm: ", self%perm
	call write_indent (u, ind)
	write (u, "(A,99(1X,I0))") "Mode: ", self%mode
	end subroutine vamp2_equi_write

	@ %def vamp2_equi_write
	@
	<<vamp2: public>>=
	public :: vamp2_equivalences_t
	<<vamp2: types>>=
	type :: vamp2_equivalences_t
	private
	integer :: n_eqv = 0
	integer :: n_channel = 0
	integer :: n_dim = 0
	type(vamp2_equi_t), dimension(:), allocatable :: eqv
	integer, dimension(:), allocatable :: map
	integer, dimension(:), allocatable :: multiplicity
	integer, dimension(:), allocatable :: symmetry
	logical, dimension(:), allocatable :: independent
	integer, dimension(:), allocatable :: equivalent_to_ch
	logical, dimension(:, :), allocatable :: dim_is_invariant
	contains
	<<vamp2: vamp2 equivalences: TBP>>
	end type vamp2_equivalences_t

	@ %def vamp2_equivalences_t
	@ Constructor.
	<<vamp2: interfaces>>=
	interface vamp2_equivalences_t
	module procedure vamp2_equivalences_init
	end interface vamp2_equivalences_t

	<<vamp2: procedures>>=
	type(vamp2_equivalences_t) function vamp2_equivalences_init (&
	n_eqv, n_channel, n_dim) result (eqv)
	integer, intent(in) :: n_eqv, n_channel, n_dim
	eqv%n_eqv = n_eqv
	eqv%n_channel = n_channel
	eqv%n_dim = n_dim
	allocate (eqv%eqv(n_eqv))
	allocate (eqv%map(n_channel), source = 0)
	allocate (eqv%multiplicity(n_channel), source = 0)
	allocate (eqv%symmetry(n_channel), source = 0)
	allocate (eqv%independent(n_channel), source = .true.)
	allocate (eqv%equivalent_to_ch(n_channel), source = 0)
	allocate (eqv%dim_is_invariant(n_dim, n_channel), source = .false.)
	end function vamp2_equivalences_init

	@ %def vamp2_equivlences_init
	@ Write equivalences.
	<<vamp2: vamp2 equivalences: TBP>>=
	procedure :: write => vamp2_equivalences_write
	<<vamp2: procedures>>=
	subroutine vamp2_equivalences_write (self, unit, indent)
	class(vamp2_equivalences_t), intent(in) :: self
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: indent
	integer :: u, ind, i_eqv, ch
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	write (u, "(A)") "Inequivalent channels:"
	if (allocated (self%independent)) then
	do ch = 1, self%n_channel
	if (self%independent(ch)) then
	write (u, "(2X,A,1x,I0,A,4x,A,I0,4x,A,I0,4x,A,999(L1))") &
	"Channel", ch, ":", &
	"Mult. = ", self%multiplicity(ch), &
	"Symm. = ", self%symmetry(ch), &
	"Invar.: ", self%dim_is_invariant(:, ch)
	end if
	end do
	else
	write (u, "(A)") "[not allocated]"
	end if
	write (u, "(A)") "Equivalence list:"
	if (allocated (self%eqv)) then
	do i_eqv = 1, self%n_eqv
	write (u, "(2X,A,1X,I0)") "i_eqv:", i_eqv
	call self%eqv(i_eqv)%write (unit, indent = ind + 4)
	end do
	else
	write (u, "(A)") "[not allocated]"
	end if
	end subroutine vamp2_equivalences_write

	@ %def vamp2_equivalences_write
	@ Is allocated.
	<<vamp2: vamp2 equivalences: TBP>>=
	procedure, public :: is_allocated => vamp2_equivalences_is_allocated
	<<vamp2: procedures>>=
	logical function vamp2_equivalences_is_allocated (self) result (yorn)
	class(vamp2_equivalences_t), intent(in) :: self
	yorn = allocated (self%eqv)
	end function vamp2_equivalences_is_allocated

	@ %def vamp2_equivalences_is_allocated
	@ Get source channel and destination channel for given equivalence.
	<<vamp2: vamp2 equivalences: TBP>>=
	procedure, public :: get_channels => vamp2_equivalences_get_channels
	<<vamp2: procedures>>=
	subroutine vamp2_equivalences_get_channels (eqv, i_eqv, dest, src)
	class(vamp2_equivalences_t), intent(in) :: eqv
	integer, intent(in) :: i_eqv
	integer, intent(out) :: dest, src
	dest = eqv%eqv(i_eqv)%ch
	src = eqv%eqv(i_eqv)%ch_src
	end subroutine vamp2_equivalences_get_channels

	@ %def vamp2_equivalences_get_channels
	@
	<<vamp2: vamp2 equivalences: TBP>>=
	procedure, public :: get_mode => vamp2_equivalences_get_mode
	procedure, public :: get_perm => vamp2_equivalences_get_perm
	<<vamp2: procedures>>=
	function vamp2_equivalences_get_mode (eqv, i_eqv) result (mode)
	class(vamp2_equivalences_t), intent(in) :: eqv
	integer, intent(in) :: i_eqv
	integer, dimension(:), allocatable :: mode
	mode = eqv%eqv(i_eqv)%mode
	end function vamp2_equivalences_get_mode

	function vamp2_equivalences_get_perm (eqv, i_eqv) result (perm)
	class(vamp2_equivalences_t), intent(in) :: eqv
	integer, intent(in) :: i_eqv
	integer, dimension(:), allocatable :: perm
	perm = eqv%eqv(i_eqv)%perm
	end function vamp2_equivalences_get_perm

	@ %def vamp2_equivalences_get_perm, vamp2_equivalences_get_mode
	@
	<<vamp2: vamp2 equivalences: TBP>>=
	procedure, public :: set_equivalence => vamp2_equivalences_set_equivalence
	<<vamp2: procedures>>=
	subroutine vamp2_equivalences_set_equivalence &
	(eqv, i_eqv, dest, src, perm, mode)
	class(vamp2_equivalences_t), intent(inout) :: eqv
	integer, intent(in) :: i_eqv
	integer, intent(in) :: dest, src
	integer, dimension(:), intent(in) :: perm, mode
	integer :: i
	if (dest < 1 .or. dest > eqv%n_channel) call msg_bug &
	("[VAMP2] set_equivalences: destination channel out of range.")
	if (src < 1 .or. src > eqv%n_channel) call msg_bug &
	("[VAMP2] set_equivalences: source channel out of range.")
	if (size(perm) /= eqv%n_dim) call msg_bug &
	("[VAMP2] set_equivalences: size(perm) does not match n_dim.")
	if (size(mode) /= eqv%n_dim) call msg_bug &
	("[VAMP2] set_equivalences: size(mode) does not match n_dim.")
	eqv%eqv(i_eqv)%ch = dest
	eqv%eqv(i_eqv)%ch_src = src
	allocate (eqv%eqv(i_eqv)%perm (size (perm)))
	do i = 1, size (perm)
	eqv%eqv(i_eqv)%perm(i) = perm(i)
	end do
	allocate (eqv%eqv(i_eqv)%mode (size (mode)))
	do i = 1, size (mode)
	eqv%eqv(i_eqv)%mode(i) = mode(i)
	end do
	end subroutine vamp2_equivalences_set_equivalence

	@ %def vamp2_equivalences_set_equivalence
	@ Freeze equivalences.
	<<vamp2: vamp2 equivalences: TBP>>=
	procedure, public :: freeze => vamp2_equivalences_freeze
	<<vamp2: procedures>>=
	subroutine vamp2_equivalences_freeze (self)
	class(vamp2_equivalences_t), intent(inout) :: self
	integer :: i_eqv, ch, upper, lower
	ch = 0
	do i_eqv = 1, self%n_eqv
	if (ch /= self%eqv(i_eqv)%ch) then
	ch = self%eqv(i_eqv)%ch
	self%map(ch) = i_eqv
	end if
	end do
	do ch = 1, self%n_channel
	lower = self%map(ch)
	if (ch == self%n_channel) then
	upper = self%n_eqv
	else
	upper = self%map(ch + 1) - 1
	end if
	associate (eqv => self%eqv, n_eqv => size (self%eqv(lower:upper)))
	if (.not. all(eqv(lower:upper)%ch == ch) .or. &
	eqv(lower)%ch_src > ch) then
	do i_eqv = lower, upper
	call self%eqv(i_eqv)%write ()
	end do
	call msg_bug ("[VAMP2] vamp2_equivalences_freeze: &
	&equivalence order is not correct.")
	end if
	self%symmetry(ch) = count (eqv(lower:upper)%ch_src == ch)
	if (mod (n_eqv, self%symmetry(ch)) /= 0) then
	do i_eqv = lower, upper
	call self%eqv(i_eqv)%write ()
	end do
	call msg_bug ("[VAMP2] vamp2_equivalences_freeze: &
	&permutation count is not correct.")
	end if
	self%multiplicity(ch) = n_eqv / self%symmetry(ch)
	self%independent(ch) = all (eqv(lower:upper)%ch_src >= ch)
	self%equivalent_to_ch(ch) = eqv(lower)%ch_src
	self%dim_is_invariant(:, ch) = eqv(lower)%mode == VEQ_INVARIANT
	end associate
	end do
	end subroutine vamp2_equivalences_freeze

	@ %def vamp2_equivalences_freeze
	@
	\subsection{Type: vamp2\_t}
	\label{sec:vamp2-t}

	<<vamp2: public>>=
	public :: vamp2_t
	<<vamp2: types>>=
	type :: vamp2_t
	private
	type(vamp2_config_t) :: config
	type(vegas_t), dimension(:), allocatable :: integrator
	integer, dimension(:), allocatable :: chain
	real(default), dimension(:), allocatable :: weight
	real(default), dimension(:), allocatable :: integral
	real(default), dimension(:), allocatable :: variance
	real(default), dimension(:), allocatable :: efficiency
	type(vamp2_result_t) :: result
	type(vamp2_equivalences_t) :: equivalences
	logical :: event_prepared
	real(default), dimension(:), allocatable :: event_weight
	contains
	<<vamp2: vamp2: TBP>>
	end type vamp2_t

	<<vamp2: interfaces>>=
	interface vamp2_t
	module procedure vamp2_init
	end interface vamp2_t

	@ %def vamp2_t
	@ Constructor.
	<<vamp2: procedures>>=
	type(vamp2_t) function vamp2_init (n_channel, n_dim, alpha, beta, n_bins_max,&
	& n_calls_min_per_channel, iterations, mode) result (self)
	integer, intent(in) :: n_channel
	integer, intent(in) :: n_dim
	integer, intent(in), optional :: n_bins_max
	integer, intent(in), optional :: n_calls_min_per_channel
	real(default), intent(in), optional :: alpha
	real(default), intent(in), optional :: beta
	integer, intent(in), optional :: iterations
	integer, intent(in), optional :: mode
	integer :: ch
	self%config%n_dim = n_dim
	self%config%n_channel = n_channel
	if (present (n_bins_max)) self%config%n_bins_max = n_bins_max
	if (present (n_calls_min_per_channel)) self%config%n_calls_min_per_channel = n_calls_min_per_channel
	if (present (alpha)) self%config%alpha = alpha
	if (present (beta)) self%config%beta = beta
	if (present (iterations)) self%config%iterations = iterations
	if (present (mode)) self%config%mode = mode
	allocate (self%chain(n_channel), source=0)
	allocate (self%integrator(n_channel))
	allocate (self%weight(n_channel), source=0._default)
	do ch = 1, n_channel
	self%integrator(ch) = vegas_t (n_dim, alpha, n_bins_max, 1, mode)
	end do
	self%weight = 1. / self%config%n_channel
	call self%reset_result ()
	allocate (self%event_weight(self%config%n_channel), source = 0._default)
	self%event_prepared = .false.
	end function vamp2_init

	@ %def vamp2_init
	<<vamp2: vamp2: TBP>>=
	procedure, public :: final => vamp2_final
	<<vamp2: procedures>>=
	subroutine vamp2_final (self)
	class(vamp2_t), intent(inout) :: self
	integer :: ch
	do ch = 1, self%config%n_channel
	call self%integrator(ch)%final ()
	end do
	end subroutine vamp2_final

	@ %def vamp2_final
	@ Output.
	<<vamp2: vamp2: TBP>>=
	procedure, public :: write => vamp2_write
	<<vamp2: procedures>>=
	subroutine vamp2_write (self, unit, indent)
	class(vamp2_t), intent(in) :: self
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: indent
	integer :: u, ind, ch
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, ind)
	write (u, "(A)") "VAMP2: VEGAS AMPlified 2"
	call write_indent (u, ind)
	call self%config%write (unit, indent)
	call self%result%write (unit, indent)
	end subroutine vamp2_write

	@ %def vamp2_write
	@ Get the config object.
	<<vamp2: vamp2: TBP>>=
	procedure, public :: get_config => vamp2_get_config
	<<vamp2: procedures>>=
	subroutine vamp2_get_config (self, config)
	class(vamp2_t), intent(in) :: self
	type(vamp2_config_t), intent(out) :: config
	config = self%config
	end subroutine vamp2_get_config

	@ %def vamp2_get_config
	@ Set non-runtime dependent configuration. It will no be possible to change
	[[n_bins_max]].
	<<vamp2: vamp2: TBP>>=
	procedure, public :: set_config => vamp2_set_config
	<<vamp2: procedures>>=
	subroutine vamp2_set_config (self, config)
	class(vamp2_t), intent(inout) :: self
	class(vamp2_config_t), intent(in) :: config
	integer :: ch
	self%config%equivalences = config%equivalences
	self%config%n_calls_min_per_channel = config%n_calls_min_per_channel
	self%config%n_calls_threshold = config%n_calls_threshold
	self%config%n_calls_min = config%n_calls_min
	self%config%beta = config%beta
	self%config%accuracy_goal = config%accuracy_goal
	self%config%error_goal = config%error_goal
	self%config%rel_error_goal = config%rel_error_goal
	do ch = 1, self%config%n_channel
	call self%integrator(ch)%set_config (config)
	end do
	end subroutine vamp2_set_config

	@ %def vamp2_set_config
	@ Set the overall number of calls. The number of calls each channel is scaled by
	the channel weights
	\begin{equation}
	N_i = \alpha_i N.
	\end{equation}
	<<vamp2: vamp2: TBP>>=
	procedure, public :: set_calls => vamp2_set_n_calls
	<<vamp2: procedures>>=
	subroutine vamp2_set_n_calls (self, n_calls)
	class(vamp2_t), intent(inout) :: self
	integer, intent(in) :: n_calls
	integer :: ch
	self%config%n_calls_min = self%config%n_calls_min_per_channel &
	& * self%config%n_channel
	self%config%n_calls = max(n_calls, self%config%n_calls_min)
	if (self%config%n_calls > n_calls) then
	write (msg_buffer, "(A,I0)") "VAMP2: [set_calls] number of calls too few,&
	& reset to = ", self%config%n_calls
	call msg_message ()
	end if
	do ch = 1, self%config%n_channel
	call self%integrator(ch)%set_calls (max (nint (self%config%n_calls *&
	& self%weight(ch)), self%config%n_calls_min_per_channel))
	end do
	end subroutine vamp2_set_n_calls

	@ %def vamp2_set_n_calls
	@ Set limits. We only support same limits for all channels.
	<<vamp2: vamp2: TBP>>=
	procedure, public :: set_limits => vamp2_set_limits
	<<vamp2: procedures>>=
	subroutine vamp2_set_limits (self, x_upper, x_lower)
	class(vamp2_t), intent(inout) :: self
	real(default), dimension(:), intent(in) :: x_upper
	real(default), dimension(:), intent(in) :: x_lower
	integer :: ch
	do ch = 1, self%config%n_channel
	call self%integrator(ch)%set_limits (x_upper, x_lower)
	end do
	end subroutine vamp2_set_limits

	@ %def vamp2_set_limits
	@ Set [[n_chains]] and the (actual) chains. [[chain]] must have size
	[[n_channels]] and each elements must store an index to a corresponding chain.
	This means, that channels with equal index correspond to the same chain, and we
	refer to those as chained weights, where we average the contributions of the
	chained weights in [[vamp2_adapt_weights]].
	<<vamp2: vamp2: TBP>>=
	procedure, public :: set_chain => vamp2_set_chain
	<<vamp2: procedures>>=
	subroutine vamp2_set_chain (self, n_chains, chain)
	class(vamp2_t), intent(inout) :: self
	integer, intent(in) :: n_chains
	integer, dimension(:), intent(in) :: chain
	if (size (chain) /= self%config%n_channel) then
	call msg_bug ("[VAMP2] set chain: size of chain array does not match n_channel.")
	else
	call msg_message ("[VAMP2] set chain: use chained weights.")
	end if
	self%config%n_chains = n_chains
	self%chain = chain
	end subroutine vamp2_set_chain

	@ %def vamp2_set_chain
	@ Set channel equivalences.
	<<vamp2: vamp2: TBP>>=
	procedure, public :: set_equivalences => vamp2_set_equivalences
	<<vamp2: procedures>>=
	subroutine vamp2_set_equivalences (self, equivalences)
	class(vamp2_t), intent(inout) :: self
	type(vamp2_equivalences_t), intent(in) :: equivalences
	self%equivalences = equivalences
	end subroutine vamp2_set_equivalences

	@ %def vamp2_set_equivalences
	@ Get [[n_calls]] calculated by [[VEGAS]].
	<<vamp2: vamp2: TBP>>=
	procedure, public :: get_n_calls => vamp2_get_n_calls
	<<vamp2: procedures>>=
	elemental real(default) function vamp2_get_n_calls (self) result (n_calls)
	class(vamp2_t), intent(in) :: self
	n_calls = sum (self%integrator%get_calls ())
	end function vamp2_get_n_calls

	@ %def vamp2_get_n_calls
	@ Get the cumulative result of the integration. Recalculate weighted average of the integration.
	<<vamp2: vamp2: TBP>>=
	procedure, public :: get_integral => vamp2_get_integral
	<<vamp2: procedures>>=
	elemental real(default) function vamp2_get_integral (self) result (integral)
	class(vamp2_t), intent(in) :: self
	integral = 0.
	if (self%result%sum_wgts > 0.) then
	integral = self%result%sum_int_wgtd / self%result%sum_wgts
	end if
	end function vamp2_get_integral

	@ %def vamp2_get_integral
	@ Get the cumulative variance of the integration. Recalculate the variance.
	<<vamp2: vamp2: TBP>>=
	procedure, public :: get_variance => vamp2_get_variance
	<<vamp2: procedures>>=
	elemental real(default) function vamp2_get_variance (self) result (variance)
	class(vamp2_t), intent(in) :: self
	variance = 0.
	if (self%result%sum_wgts > 0.) then
	variance = 1.0 / self%result%sum_wgts
	end if
	end function vamp2_get_variance

	@ %def vamp2_get_variance
	@ Get efficiency.
	<<vamp2: vamp2: TBP>>=
	procedure, public :: get_efficiency => vamp2_get_efficiency
	<<vamp2: procedures>>=
	elemental real(default) function vamp2_get_efficiency (self) result (efficiency)
	class(vamp2_t), intent(in) :: self
	efficiency = 0.
	if (self%result%efficiency > 0.) then
	efficiency = self%result%efficiency
	end if
	end function vamp2_get_efficiency

	@ %def vamp2_get_efficiency
	@ Get event weight and event weight excess.
	<<vamp2: vamp2: TBP>>=
	procedure :: get_evt_weight => vamp2_get_evt_weight
	procedure :: get_evt_weight_excess => vamp2_get_evt_weight_excess
	<<vamp2: procedures>>=
	real(default) function vamp2_get_evt_weight (self) result (evt_weight)
	class(vamp2_t), intent(in) :: self
	evt_weight = self%result%evt_weight
	end function vamp2_get_evt_weight

	real(default) function vamp2_get_evt_weight_excess (self) result (evt_weight_excess)
	class(vamp2_t), intent(in) :: self
	evt_weight_excess = self%result%evt_weight_excess
	end function vamp2_get_evt_weight_excess

	@ %def vamp2_get_evt_weight, vamp2_get_evt_weight_excess
	@ Get procedure to retrieve channel-th grid.
	<<vamp2: vamp2: TBP>>=
	procedure :: get_grid => vamp2_get_grid
	<<vamp2: procedures>>=
	type(vegas_grid_t) function vamp2_get_grid (self, channel) result (grid)
	class(vamp2_t), intent(in) :: self
	integer, intent(in) :: channel
	if (channel < 1 .or. channel > self%config%n_channel) &
	call msg_bug ("[VAMP2] vamp2_get_grid: channel index < 1 or > n_channel.")
	grid = self%integrator(channel)%get_grid ()
	end function vamp2_get_grid

	@ %def vamp2_get_grid
	@ Adapt. We adapt the weights due the contribution of variances with $\beta >
	0$.
	\begin{equation}
	\alpha_i = \frac{\alpha_i V_i^\beta}{\sum_i \alpha_i V_i^\beta}
	\end{equation}
	If [[n_calls_threshold]] is set, we rescale the weights in such a way, that the
	[[n_calls]] for each channel are greater than [[n_calls_threshold]].
	We calculate the distance of the weights to the [[weight_min]] and reset those weights
	which are less than [[weight_mins]] to this value. The other values are
	accordingly resized to fit the boundary condition of the partition of unity.
	<<vamp2: vamp2: TBP>>=
	procedure, private :: adapt_weights => vamp2_adapt_weights
	<<vamp2: procedures>>=
	subroutine vamp2_adapt_weights (self)
	class(vamp2_t), intent(inout) :: self
	integer :: n_weights_underflow
	real(default) :: weight_min, sum_weights_underflow
	self%weight = self%weight * self%integrator%get_variance ()**self%config%beta
	if (sum (self%weight) == 0) self%weight = real(self%config%n_calls, default)
	if (self%config%n_chains > 0) then
	call chain_weights ()
	end if
	self%weight = self%weight / sum(self%weight)
	if (self%config%n_calls_threshold /= 0) then
	weight_min = real(self%config%n_calls_threshold, default) &
	& / self%config%n_calls
	sum_weights_underflow = sum (self%weight, self%weight < weight_min)
	n_weights_underflow = count (self%weight < weight_min)
	where (self%weight < weight_min)
	self%weight = weight_min
	elsewhere
	self%weight = self%weight * (1. - n_weights_underflow * weight_min) &
	& / (1. - sum_weights_underflow)
	end where
	end if
	call self%set_calls (self%config%n_calls)
	contains
	<<vamp2: vamp2 adapt weights: procedures>>
	end subroutine vamp2_adapt_weights

	@ %def vamp2_adapt_weights
	@ We average the weights over their respective chain members.
	<<vamp2: vamp2 adapt weights: procedures>>=
	subroutine chain_weights ()
	integer :: ch
	real(default) :: average
	do ch = 1, self%config%n_chains
	average = max (sum (self%weight, self%chain == ch), 0._default)
	if (average /= 0) then
	average = average / count (self%chain == ch)
	where (self%chain == ch)
	self%weight = average
	end where
	end if
	end do
	end subroutine chain_weights

	@ %def chain_weights
	<<vamp2: vamp2: TBP>>=
	procedure, private :: apply_equivalences => vamp2_apply_equivalences
	<<vamp2: procedures>>=
	subroutine vamp2_apply_equivalences (self)
	class(vamp2_t), intent(inout) :: self
	integer :: ch, ch_src, j, j_src, i_eqv
	real(default), dimension(:, :, :), allocatable :: d
	real(default), dimension(:, :), allocatable :: d_src
	integer, dimension(:), allocatable :: mode, perm
	if (.not. self%equivalences%is_allocated ()) then
	call msg_bug ("[VAMP2] vamp2_apply_equivalences: &
	&cannot apply not-allocated equivalences.")
	end if
	allocate (d(self%config%n_bins_max, self%config%n_dim, &
	self%config%n_channel), source=0._default)
	associate (eqv => self%equivalences, nb => self%config%n_bins_max)
	do i_eqv = 1, self%equivalences%n_eqv
	call eqv%get_channels (i_eqv, ch, ch_src)
	d_src = self%integrator(ch_src)%get_distribution ()
	mode = eqv%get_mode (i_eqv)
	perm = eqv%get_perm (i_eqv)
	do j = 1, self%config%n_dim
	select case (mode (j))
	case (VEQ_IDENTITY)
	d(:, j, ch) = d(:, j, ch) + &
	d_src(:, perm(j))
	case (VEQ_INVERT)
	d(:, j, ch) = d(:, j, ch) + &
	d_src(nb:1:-1, perm(j))
	case (VEQ_SYMMETRIC)
	d(:, j, ch) = d(:, j, ch) + &
	d_src(:, perm(j)) / 2. + &
	d_src(nb:1:-1, perm(j)) / 2.
	case (VEQ_INVARIANT)
	d(:, j, ch) = 1._default
	end select
	end do
	end do
	end associate
	do ch = 1, self%config%n_channel
	call self%integrator(ch)%set_distribution (d(:, :, ch))
	end do
	end subroutine vamp2_apply_equivalences

	@ %def vamp2_apply_equivalences
	@ Reset the cumulative result.
	<<vamp2: vamp2: TBP>>=
	procedure, public :: reset_result => vamp2_reset_result
	<<vamp2: procedures>>=
	subroutine vamp2_reset_result (self)
	class(vamp2_t), intent(inout) :: self
	self%result%sum_int_wgtd = 0.
	self%result%sum_wgts = 0.
	self%result%sum_chi = 0.
	self%result%it_num = 0
	self%result%samples = 0
	self%result%chi2 = 0
	self%result%efficiency = 0.
	end subroutine vamp2_reset_result

	@ %def vamp2_reset_result
	@ Integrate. We integrate each channel separately and combine the results
	\begin{align}
	I & = \sum_i \alpha_i I_i, \\
	\sigma^2 & = \sum_i \alpha_i^2 \sigma^2_i.
	\end{align}
	Although, the (population) variance is given by
	\begin{equation}
	\begin{split}
	\sigma^2 & = \frac{1}{N} \left( \sum_i \alpha_i I^2_i - I^2 \right) \\
	& = \frac{1}{N - 1} \left( \sum_i \left( N_i \sigma^2_i + I^2_i \right) -I^2
	\right) \\
	& = \frac{1}{N - 1} \left( \sum_i \alpha_i \sigma^2_i + \alpha_i I^2_i - I^2
	\right),
	\end{split}
	\end{equation}
	where we used $\sigma^2_i = \frac{1}{N} \left( \langle I^2_i \rangle - \langle
	I_i \rangle^2 \right)$, we use the approximation for numeric stability.
	The population variance relates to sample variance
	\begin{equation}
	s^2 = \frac{n}{n - 1} \sigma^2,
	\end{equation}
	which gives an unbiased error estimate.

	Beside those adaption to multichannel, the overall processing of
	[[total_integral]], [[total_sq_integral]] and [[total_variance]] is the same as
	in [[vegas_integrate]].
	<<vamp2: vamp2: TBP>>=
	procedure, public :: integrate => vamp2_integrate
	<<vamp2: procedures>>=
	subroutine vamp2_integrate (self, func, rng, iterations, opt_reset_result,&
	& opt_refine_grid, opt_adapt_weight, opt_verbose, result, abserr)
	class(vamp2_t), intent(inout) :: self
	class(vamp2_func_t), intent(inout) :: func
	class(rng_t), intent(inout) :: rng
	integer, intent(in), optional :: iterations
	logical, intent(in), optional :: opt_reset_result
	logical, intent(in), optional :: opt_refine_grid
	logical, intent(in), optional :: opt_adapt_weight
	logical, intent(in), optional :: opt_verbose
	real(default), optional, intent(out) :: result, abserr
	integer :: it, ch
	real(default) :: total_integral, total_sq_integral, total_variance, chi, wgt
	real(default) :: cumulative_int, cumulative_std
	logical :: reset_result = .true.
	logical :: adapt_weight = .true.
	logical :: refine_grid = .true.
	logical :: verbose = .false.
	<<vamp2: vamp2 integrate: variables>>
	if (present (iterations)) self%config%iterations = iterations
	if (present (opt_reset_result)) reset_result = opt_reset_result
	if (present (opt_adapt_weight)) adapt_weight = opt_adapt_weight
	if (present (opt_refine_grid)) refine_grid = opt_refine_grid
	if (present (opt_verbose)) verbose = opt_verbose
	<<vamp2: vamp2 integrate: initalization>>
	if (verbose) then
	call msg_message ("Results: [it, calls, integral, error, chi^2, eff.]")
	end if
	iteration: do it = 1, self%config%iterations
	<<vamp2: vamp2 integrate: pre sampling>>
	do ch = 1, self%config%n_channel
	func%wi(ch) = self%weight(ch)
	func%grids(ch) = self%integrator(ch)%get_grid ()
	end do
	channel: do ch = 1, self%config%n_channel
	<<vamp2: vamp2 integrate: sampling>>
	call func%set_channel (ch)
	call self%integrator(ch)%integrate ( &
	& func, rng, iterations, opt_refine_grid = .false., opt_verbose = verbose)
	end do channel
	<<vamp2: vamp2 integrate: post sampling>>
	total_integral = dot_product (self%weight, self%integrator%get_integral ())
	total_sq_integral = dot_product (self%weight, self%integrator%get_integral ()**2)
	total_variance = self%config%n_calls * dot_product (self%weight**2, self%integrator%get_variance ())
	associate (result => self%result)
	! a2 - b2 = (a - b) * (a + b)
	total_variance = sqrt (total_variance + total_sq_integral)
	total_variance = 1. / self%config%n_calls * &
	& (total_variance + total_integral) * (total_variance - total_integral)
	! Ensure variance is always positive and larger than zero
	if (total_variance < tiny (1._default) / epsilon (1._default) * max (total_integral**2, 1._default)) then
	total_variance = tiny (1._default) / epsilon (1._default) * max (total_integral**2, 1._default)
	end if
	wgt = 1. / total_variance
	result%result = total_integral
	result%std = sqrt (total_variance)
	result%samples = result%samples + 1
	if (result%samples == 1) then
	result%chi2 = 0._default
	else
	chi = total_integral
	if (result%sum_wgts > 0) chi = chi - result%sum_int_wgtd / result%sum_wgts
	result%chi2 = result%chi2 * (result%samples - 2.0_default)
	result%chi2 = (wgt / (1._default + (wgt / result%sum_wgts))) &
	& * chi**2
	result%chi2 = result%chi2 / (result%samples - 1._default)
	end if
	result%sum_wgts = result%sum_wgts + wgt
	result%sum_int_wgtd = result%sum_int_wgtd + (total_integral * wgt)
	result%sum_chi = result%sum_chi + (total_sq_integral * wgt)
	cumulative_int = result%sum_int_wgtd / result%sum_wgts
	cumulative_std = sqrt (1. / result%sum_wgts)
	call calculate_efficiency ()
	if (verbose) then
	write (msg_buffer, "(I0,1x,I0,1x, 4(E16.8E4,1x))") &
	& it, self%config%n_calls, cumulative_int, cumulative_std, &
	& self%result%chi2, self%result%efficiency
	call msg_message ()
	end if
	end associate
	if (adapt_weight) then
	call self%adapt_weights ()
	end if
	if (refine_grid) then
	if (self%config%equivalences .and. self%equivalences%is_allocated ()) then
	call self%apply_equivalences ()
	end if
	do ch = 1, self%config%n_channel
	call self%integrator(ch)%refine ()
	end do
	end if
	end do iteration
	if (present (result)) result = cumulative_int
	if (present (abserr)) abserr = abs (cumulative_std)
	<<vamp2: vamp2 integrate: procedures>>
	end subroutine vamp2_integrate

	@ %def vamp2_integrate
	@
	<<vamp2: vamp2 integrate: procedures>>=
	contains
	subroutine calculate_efficiency ()
	self%result%max_abs_f = dot_product (self%weight, &
	& self%integrator%get_max_abs_f ())
	self%result%max_abs_f_pos = dot_product (self%weight, &
	& self%integrator%get_max_abs_f_pos ())
	self%result%max_abs_f_neg = dot_product (self%weight, &
	& self%integrator%get_max_abs_f_neg ())
	self%result%efficiency = 0.
	if (self%result%max_abs_f > 0.) then
	self%result%efficiency = &
	& dot_product (self%weight * self%integrator%get_max_abs_f (), &
	& self%integrator%get_efficiency ()) / self%result%max_abs_f
	! TODO pos. or. negative efficiency would be very nice.
	end if
	end subroutine calculate_efficiency

	@ %def calculate_efficiency
	@
	We define additional chunks, which we use to insert parallel/MPI code.
	<<vamp2: vamp2 integrate: variables>>=
	@
	<<vamp2: vamp2 integrate: initalization>>=
	cumulative_int = 0.
	cumulative_std = 0.
	if (reset_result) call self%reset_result ()
	@
	<<vamp2: vamp2 integrate: pre sampling>>=
	total_integral = 0._default
	total_sq_integral = 0._default
	total_variance = 0._default
	@
	<<vamp2: vamp2 integrate: sampling>>=
	@
	<<vamp2: vamp2 integrate: post sampling>>=
	@
	@ Distribute workers up in chunks of [[n_size]].
	<<MPI: vamp2: vamp2 integrate: procedures>>=
	integer function map_channel_to_worker (channel, n_size) result (worker)
	integer, intent(in) :: channel
	integer, intent(in) :: n_size
	worker = mod (channel, n_size)
	end function map_channel_to_worker

	@ %def map_channel_to_rank
	<<MPI: vamp2: vamp2 integrate: variables>>=
	type(vegas_grid_t) :: grid
	type(MPI_Request) :: status
	integer :: rank, n_size, worker
	@
	<<MPI: vamp2: vamp2 integrate: initalization>>=
	call MPI_Comm_rank (MPI_COMM_WORLD, rank)
	call MPI_Comm_size (MPI_COMM_WORLD, n_size)
	@ Broadcast all a-priori weights. After setting the weights, we have to update
	the number of calls in each channel. Afterwards, we can collect the number of
	channels, which are not parallelized by [[VEGAS]] itself, [[n_channel_non_parallel]].
	<<MPI: vamp2: vamp2 integrate: pre sampling>>=
	call MPI_Ibcast (self%weight, self%config%n_channel, MPI_DOUBLE_PRECISION, 0,&
	& MPI_COMM_WORLD, status)
	do ch = 1, self%config%n_channel
	grid = self%integrator(ch)%get_grid ()
	call grid%broadcast ()
	call self%integrator(ch)%set_grid (grid)
	end do
	call MPI_Wait (status, MPI_STATUS_IGNORE)
	call self%set_calls (self%config%n_calls)
	@ We check on the parallelization state of the current [[VEGAS]] integrator.
	If [[VEGAS]] can not be parallelized on lowest level, we map the current channel
	to a rank and calculate the channel on that rank.
	On all other worker we just enhance the random-generator (when supported), see
	[[vegas_integrate]] for the details on the random-generator handling.
	<<MPI: vamp2: vamp2 integrate: sampling>>=
	if (.not. self%integrator(ch)%is_parallelizable ()) then
	worker = map_channel_to_worker (ch, n_size)
	if (rank /= worker) then
	select type (rng)
	type is (rng_stream_t)
	call rng%next_substream ()
	end select
	cycle channel
	end if
	else
	call MPI_Barrier (MPI_COMM_WORLD)
	end if
	@ Collect results, the actual communication is done inside the different objects.
	<<MPI: vamp2: vamp2 integrate: post sampling>>=
	call vamp2_integrate_collect ()
	<<MPI: vamp2: vamp2 integrate: procedures>>=
	subroutine vamp2_integrate_collect ()
	type(vegas_result_t) :: result
	integer :: root_n_calls
	integer :: worker
	do ch = 1, self%config%n_channel
	if (self%integrator(ch)%is_parallelizable ()) cycle
	worker = map_channel_to_worker (ch, n_size)
	result = self%integrator(ch)%get_result ()
	if (rank == 0) then
	if (worker /= 0) then
	call result%receive (worker, ch)
	call self%integrator(ch)%receive_distribution (worker, ch)
	call self%integrator(ch)%set_result (result)
	end if
	else
	if (rank == worker) then
	call result%send (0, ch)
	call self%integrator(ch)%send_distribution (0, ch)
	end if
	end if
	end do
	select type (func)
	class is (vamp2_func_t)
	call MPI_reduce (func%n_calls, root_n_calls, 1, MPI_INTEGER, MPI_SUM, 0, MPI_COMM_WORLD)
	if (rank == 0) then
	func%n_calls = root_n_calls
	else
	call func%reset_n_calls ()
	end if
	end select
	end subroutine vamp2_integrate_collect

	@ %def vegas_integrate_collect
	@ Skip results analyze if non-root, after waiting for all processes to reach the
	barrier.
	<<MPI: vamp2: vamp2 integrate: post sampling>>=
	call MPI_barrier (MPI_COMM_WORLD)
	if (rank /= 0) cycle iteration
	@ Generate event from multi-channel weight $w(x) = f(x) / g(x)$.

	We select a channel using the a-priori weights and $f_{i}^{\text{max}}$, to
	flatten possible unbalanced channel weight(s).

	An additional rescale factor [[opt_event_rescale]] is applied to [[f_max]], iff set.
	<<vamp2: vamp2: TBP>>=
	procedure, public :: generate_weighted => vamp2_generate_weighted_event
	<<vamp2: procedures>>=
	subroutine vamp2_generate_weighted_event (&
	self, func, rng, x)
	class(vamp2_t), intent(inout) :: self
	class(vamp2_func_t), intent(inout) :: func
	class(rng_t), intent(inout) :: rng
	real(default), dimension(self%config%n_dim), intent(out) :: x
	integer :: ch, i
	real(default) :: r
	if (.not. self%event_prepared) then
	call prepare_event ()
	end if
	call rng%generate (r)
	nchannel: do ch = 1, self%config%n_channel
	r = r - self%event_weight(ch)
	if (r <= 0._default) exit nchannel
	end do nchannel
	ch = min (ch, self%config%n_channel)
	call func%set_channel (ch)
	call msg_debug (D_VAMP2, "vamp2_generate_weighted_event")
	call msg_debug (D_VAMP2, "Selected channel", ch)
	call msg_debug (D_VAMP2, "Ch. Event weight", self%event_weight(ch))
	call self%integrator(ch)%generate_weighted (func, rng, x)
	! Norm weight by f_max, hidden in event_weight(ch), else by 1
	self%result%evt_weight = self%integrator(ch)%get_evt_weight () &
	* self%weight(ch) / self%event_weight(ch)
	call msg_debug2 (D_VAMP2, "Event weight", self%result%evt_weight)
	contains
	<<vamp2: vamp2 generate event: procedures>>
	end subroutine vamp2_generate_weighted_event

	@ %def vamp2_generate_weighted_event
	@ Generate unweighted events.

	After selecting a channel $ch$ by the acceptance $r$
	\begin{equation*}
	r > \operatorname*{argmax}_{ch} \sum_{i = 1}^{ch} \alpha_i,
	\end{equation*}
	we try for an event from the previously selected channel.
	If the event is rejected, we also reject the selected channel.
	<<vamp2: vamp2: TBP>>=
	procedure, public :: generate_unweighted => vamp2_generate_unweighted_event
	<<vamp2: procedures>>=
	subroutine vamp2_generate_unweighted_event ( &
	& self, func, rng, x, opt_event_rescale)
	class(vamp2_t), intent(inout) :: self
	class(vamp2_func_t), intent(inout) :: func
	class(rng_t), intent(inout) :: rng
	real(default), dimension(self%config%n_dim), intent(out) :: x
	real(default), intent(in), optional :: opt_event_rescale
	integer :: ch, i
	real(default) :: r, max_abs_f, event_rescale
	event_rescale = 1._default
	if (present (opt_event_rescale)) then
	event_rescale = opt_event_rescale
	end if
	if (.not. self%event_prepared) then
	call prepare_event ()
	end if
	generate: do
	call rng%generate (r)
	nchannel: do ch = 1, self%config%n_channel
	r = r - self%event_weight(ch)
	if (r <= 0._default) exit nchannel
	end do nchannel
	ch = min (ch, self%config%n_channel)
	call func%set_channel (ch)
	if (debug_active (D_VAMP2)) then
	call msg_debug (D_VAMP2, "vamp2_generate_unweighted_event")
	call msg_debug (D_VAMP2, "Selected channel", ch)
	call msg_debug (D_VAMP2, "Ch. Event weight", self%event_weight(ch))
	end if
	call self%integrator(ch)%generate_weighted (func, rng, x)
	self%result%evt_weight = self%integrator(ch)%get_evt_weight ()
	if (debug_active (D_VAMP2)) &
	call msg_debug (D_VAMP2, "Event weight", self%result%evt_weight)
	max_abs_f = merge ( &
	self%integrator(ch)%get_max_abs_f_pos (), &
	self%integrator(ch)%get_max_abs_f_neg (), &
	self%result%evt_weight > 0.)
	self%result%evt_weight_excess = 0._default
	if (self%result%evt_weight > max_abs_f) then
	self%result%evt_weight_excess = self%result%evt_weight / max_abs_f - 1._default
	exit generate
	end if
	call rng%generate (r)
	if (debug2_active (D_VAMP2)) then
	print *, "max_abs_f = ", max_abs_f
	print *, "rescale = ", event_rescale
	print *, "r = ", r
	print , "accept = ", event_rescale max_abs_f * r
	print *, "x = ", x
	print *, "Event Excess = ", self%result%evt_weight_excess
	end if
	! Do not use division, because max_abs_f could be zero.
	if (event_rescale * max_abs_f * r <= abs(self%result%evt_weight)) then
	call msg_debug (D_VAMP2, "accept event")
	exit generate
	else
	if (debug2_active (D_VAMP2)) then
	print , "diff = ", abs(self%result%evt_weight) - (event_rescale max_abs_f * r)
	print *, "max_abs_f_pos = ", self%integrator(ch)%get_max_abs_f_pos ()
	print *, "max_abs_f_neg = ", self%integrator(ch)%get_max_abs_f_neg ()
	print *, "sign = ", (self%result%evt_weight > 0.)
	end if
	call msg_debug (D_VAMP2, "do not accept event")
	end if
	end do generate
	contains
	<<vamp2: vamp2 generate event: procedures>>
	end subroutine vamp2_generate_unweighted_event

	@ %def vamp2_generate_event
	Prepare event generation. We have to set the channel weights and the grids for
	the integrand's object.

	We use an ansatz proposed by T. Ohl in the original VAMP code where we do not have to accept on
	\begin{equation*}
	\frac{w_i(x)}{\operatorname*{max}_{i, x} w_i(x)},
	\end{equation*}
	after we have selected a channel by the weights $\alpha_i$. But rather, we use a
	more efficient way where we rescale the channel weights $\alpha_i$
	\begin{equation*}
	\alpha_i \rightarrow \alpha_i \frac{\operatorname{max}_x w_i(x)}{\operatorname{max}_{i, x} w_i(x)}.
	\end{equation*}
	The overall magic is to insert a "1" and to move the uneasy part into the channel selection,
	such that we can generate events likewise in the single channel mode.
	We generate an unweighted event by
	\begin{equation*}
	\frac{w_i(x)}{\operatorname*{max}_{x} w_i{x}},
	\end{equation*}
	after we have selected a channel by the rescaled event channel weights.
	The overall normalization $\operatorname*{max}_{i, x}$ is not needed because we normalize the event channel weights
	to one and therefore the overall normalization cancels.
	<<vamp2: vamp2 generate event: procedures>>=
	subroutine prepare_event ()
	integer :: i
	self%event_prepared = .false.
	do i = 1, self%config%n_channel
	func%wi(i) = self%weight(i)
	func%grids(i) = self%integrator(i)%get_grid ()
	end do
	if (any (self%integrator%get_max_abs_f () > 0)) then
	self%event_weight = self%weight * self%integrator%get_max_abs_f ()
	else
	self%event_weight = self%weight
	end if
	self%event_weight = self%event_weight / sum (self%event_weight)
	self%event_prepared = .true.
	end subroutine prepare_event

	@ %def prepare_event
	@ Write grids to unit.
	<<vamp2: parameters>>=
	character(len=*), parameter, private :: &
	descr_fmt = "(1X,A)", &
	integer_fmt = "(1X,A18,1X,I15)", &
	integer_array_fmt = "(1X,I18,1X,I15)", &
	logical_fmt = "(1X,A18,1X,L1)", &
	double_fmt = "(1X,A18,1X,E16.8E4)", &
	double_array_fmt = "(1X,I18,1X,E16.8E4)", &
	double_array2_fmt = "(1X,2(1X,I8),1X,E16.8E4)"
	@ %def descr_fmt integer_fmt integer_array_fmt logical_fmt
	@ %def double_fmt double_array_fmt double_array2_fmt
	<<vamp2: vamp2: TBP>>=
	procedure, public :: write_grids => vamp2_write_grids
	<<vamp2: procedures>>=
	subroutine vamp2_write_grids (self, unit)
	class(vamp2_t), intent(in) :: self
	integer, intent(in), optional :: unit
	integer :: u
	integer :: ch
	u = given_output_unit (unit)
	write (u, descr_fmt) "begin type(vamp2_t)"
	write (u, integer_fmt) "n_channel =", self%config%n_channel
	write (u, integer_fmt) "n_dim =", self%config%n_dim
	write (u, integer_fmt) "n_calls_min_ch =", self%config%n_calls_min_per_channel
	write (u, integer_fmt) "n_calls_thres =", self%config%n_calls_threshold
	write (u, integer_fmt) "n_chains =", self%config%n_chains
	write (u, logical_fmt) "stratified =", self%config%stratified
	write (u, double_fmt) "alpha =", self%config%alpha
	write (u, double_fmt) "beta =", self%config%beta
	write (u, integer_fmt) "n_bins_max =", self%config%n_bins_max
	write (u, integer_fmt) "iterations =", self%config%iterations
	write (u, integer_fmt) "n_calls =", self%config%n_calls
	write (u, integer_fmt) "it_start =", self%result%it_start
	write (u, integer_fmt) "it_num =", self%result%it_num
	write (u, integer_fmt) "samples =", self%result%samples
	write (u, double_fmt) "sum_int_wgtd =", self%result%sum_int_wgtd
	write (u, double_fmt) "sum_wgts =", self%result%sum_wgts
	write (u, double_fmt) "sum_chi =", self%result%sum_chi
	write (u, double_fmt) "chi2 =", self%result%chi2
	write (u, double_fmt) "efficiency =", self%result%efficiency
	write (u, double_fmt) "efficiency_pos =", self%result%efficiency_pos
	write (u, double_fmt) "efficiency_neg =", self%result%efficiency_neg
	write (u, double_fmt) "max_abs_f =", self%result%max_abs_f
	write (u, double_fmt) "max_abs_f_pos =", self%result%max_abs_f_pos
	write (u, double_fmt) "max_abs_f_neg =", self%result%max_abs_f_neg
	write (u, double_fmt) "result =", self%result%result
	write (u, double_fmt) "std =", self%result%std
	write (u, descr_fmt) "begin weight"
	do ch = 1, self%config%n_channel
	write (u, double_array_fmt) ch, self%weight(ch)
	end do
	write (u, descr_fmt) "end weight"
	if (self%config%n_chains > 0) then
	write (u, descr_fmt) "begin chain"
	do ch = 1, self%config%n_channel
	write (u, integer_array_fmt) ch, self%chain(ch)
	end do
	write (u, descr_fmt) "end chain"
	end if
	write (u, descr_fmt) "begin integrator"
	do ch = 1, self%config%n_channel
	call self%integrator(ch)%write_grid (unit)
	end do
	write (u, descr_fmt) "end integrator"
	write (u, descr_fmt) "end type(vamp2_t)"
	end subroutine vamp2_write_grids

	@ %def vamp2_write_grids
	@ Read grids from unit.
	<<vamp2: vamp2: TBP>>=
	procedure, public :: read_grids => vamp2_read_grids
	<<vamp2: procedures>>=
	subroutine vamp2_read_grids (self, unit)
	class(vamp2_t), intent(out) :: self
	integer, intent(in), optional :: unit
	integer :: u
	integer :: ibuffer, jbuffer, ch
	character(len=80) :: buffer
	read (unit, descr_fmt) buffer
	read (unit, integer_fmt) buffer, ibuffer
	read (unit, integer_fmt) buffer, jbuffer
	select type (self)
	type is (vamp2_t)
	self = vamp2_t (n_channel = ibuffer, n_dim = jbuffer)
	end select
	read (unit, integer_fmt) buffer, self%config%n_calls_min_per_channel
	read (unit, integer_fmt) buffer, self%config%n_calls_threshold
	read (unit, integer_fmt) buffer, self%config%n_chains
	read (unit, logical_fmt) buffer, self%config%stratified
	read (unit, double_fmt) buffer, self%config%alpha
	read (unit, double_fmt) buffer, self%config%beta
	read (unit, integer_fmt) buffer, self%config%n_bins_max
	read (unit, integer_fmt) buffer, self%config%iterations
	read (unit, integer_fmt) buffer, self%config%n_calls
	read (unit, integer_fmt) buffer, self%result%it_start
	read (unit, integer_fmt) buffer, self%result%it_num
	read (unit, integer_fmt) buffer, self%result%samples
	read (unit, double_fmt) buffer, self%result%sum_int_wgtd
	read (unit, double_fmt) buffer, self%result%sum_wgts
	read (unit, double_fmt) buffer, self%result%sum_chi
	read (unit, double_fmt) buffer, self%result%chi2
	read (unit, double_fmt) buffer, self%result%efficiency
	read (unit, double_fmt) buffer, self%result%efficiency_pos
	read (unit, double_fmt) buffer, self%result%efficiency_neg
	read (unit, double_fmt) buffer, self%result%max_abs_f
	read (unit, double_fmt) buffer, self%result%max_abs_f_pos
	read (unit, double_fmt) buffer, self%result%max_abs_f_neg
	read (unit, double_fmt) buffer, self%result%result
	read (unit, double_fmt) buffer, self%result%std
	read (unit, descr_fmt) buffer
	do ch = 1, self%config%n_channel
	read (unit, double_array_fmt) ibuffer, self%weight(ch)
	end do
	read (unit, descr_fmt) buffer
	if (self%config%n_chains > 0) then
	read (unit, descr_fmt) buffer
	do ch = 1, self%config%n_channel
	read (unit, integer_array_fmt) ibuffer, self%chain(ch)
	end do
	read (unit, descr_fmt) buffer
	end if
	read (unit, descr_fmt) buffer
	do ch = 1, self%config%n_channel
	call self%integrator(ch)%read_grid (unit)
	end do
	read (unit, descr_fmt) buffer
	read (unit, descr_fmt) buffer
	end subroutine vamp2_read_grids

	@ %def vamp2_read_grids
	@
	\section{Unit tests}
	\label{sec:unit-tests}

	Test module, followed by the corresponding implementation module.

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

	module vamp2_ut
	use unit_tests
	use vamp2_uti

	<<Standard module head>>

	<<vamp2: public test>>

	contains
	<<vamp2: test driver>>
	end module vamp2_ut
	@ %def vamp2_ut
	@
	<<[[vamp2_uti.f90]]>>=
	<<File header>>

	module vamp2_uti
	<<Use kinds>>
	use io_units
	use constants, only: pi
	use numeric_utils, only: nearly_equal
	use format_defs, only: FMT_12
	use rng_base
	use rng_stream
	use vegas, only: vegas_func_t, vegas_grid_t, operator(==)
	use vamp2

	<<Standard module head>>

	<<vamp2: test declaration>>

	<<vamp2: test types>>

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

	@ %def vamp2_test
	@
	\subsubsection{Test function}
	\label{sec:test-function}

	We use the example from the Monte Carlo Examples of the GSL library
	\begin{equation}
	I = \int_{-pi}^{+pi} {dk_x/(2 pi)} \int_{-pi}^{+pi} {dk_y/(2 pi)} \int_{-pi}^{+pi} {dk_z/(2 pi)} 1 / (1 - cos(k_x)cos(k_y)cos(k_z)).
	\end{equation}
	The integral is reduced to region (0,0,0) $\rightarrow$ ($\pi$, $\pi$, $\pi$) and multiplied by 8.
	<<vamp2: test types>>=
	type, extends (vamp2_func_t) :: vamp2_test_func_t
	!
	contains
	<<vamp2: vamp2 test func: TBP>>
	end type vamp2_test_func_t

	@ %def vegas_test_func_t
	@
	<<vamp2: vamp2 test func: TBP>>=
	procedure, public :: evaluate_maps => vamp2_test_func_evaluate_maps
	<<vamp2: tests>>=
	subroutine vamp2_test_func_evaluate_maps (self, x)
	class(vamp2_test_func_t), intent(inout) :: self
	real(default), dimension(:), intent(in) :: x
	self%xi(:, 1) = x
	self%det(1) = 1
	self%valid_x = .true.
	end subroutine vamp2_test_func_evaluate_maps

	@ %def vamp2_test_func_evaluate_maps
	@ Evaluate the integrand.
	<<vamp2: vamp2 test func: TBP>>=
	procedure, public :: evaluate_func => vamp2_test_func_evaluate
	<<vamp2: tests>>=
	real(default) function vamp2_test_func_evaluate (self, x) result (f)
	class(vamp2_test_func_t), intent(in) :: self
	real(default), dimension(:), intent(in) :: x
	f = 1.0 / (pi**3)
	f = f / ( 1.0 - cos (x(1)) * cos (x(2)) * cos (x(3)))
	end function vamp2_test_func_evaluate

	@ %def vamp2_test_func_evaluate
	@ The second test function implements
	\begin{equation}
	f(\vec{x}) = 4 \sin^{2}(\pi x_{1})\sin^{2}(\pi x_{2}) + 2\sin^2(\pi v),
	\end{equation}
	where
	\begin{align}
	x = u^{v} & y = u^{1 - v} \\
	u = xy & v = \frac{1}{2} \left( 1 + \frac{\log(x/y}{\log(xy)} \right).
	\end{align}
	The jacobian is $\frac{\partial (x, y)}{\partial (u, v)}$.

	<<vamp2: test types>>=
	type, extends(vamp2_func_t) :: vamp2_test_func_2_t
	!
	contains
	<<vamp2: vamp2 test func 2: TBP>>
	end type vamp2_test_func_2_t

	@ %def vamp2_test_func_2_t
	@ Evaluate maps.
	<<vamp2: vamp2 test func 2: TBP>>=
	procedure :: evaluate_maps => vamp2_test_func_2_evaluate_maps
	<<vamp2: tests>>=
	subroutine vamp2_test_func_2_evaluate_maps (self, x)
	class(vamp2_test_func_2_t), intent(inout) :: self
	real(default), dimension(:), intent(in) :: x
	select case (self%current_channel)
	case (1)
	self%xi(:, 1) = x
	self%xi(1, 2) = x(1) * x(2)
	self%xi(2, 2) = 0.5 * ( 1. + log(x(1) / x(2)) / log(x(1) * x(2)))
	case (2)
	self%xi(1, 1) = x(1)**x(2)
	self%xi(2, 1) = x(1)**(1. - x(2))
	self%xi(:, 2) = x
	end select
	self%det(1) = 1.
	self%det(2) = abs (log(self%xi(1, 2)))
	self%valid_x = .true.
	end subroutine vamp2_test_func_2_evaluate_maps

	@ %def vamp2_test_func_2_evaluate_maps
	@ Evaluate func.
	<<vamp2: vamp2 test func 2: TBP>>=
	procedure :: evaluate_func => vamp2_test_func_2_evaluate_func
	<<vamp2: tests>>=
	real(default) function vamp2_test_func_2_evaluate_func (self, x) result (f)
	class(vamp2_test_func_2_t), intent(in) :: self
	real(default), dimension(:), intent(in) :: x
	f = 4. * sin(pi * self%xi(1, 1))*2 sin(pi * self%xi(2, 1))*2 + 2. sin(pi * self%xi(2, 2))**2
	end function vamp2_test_func_2_evaluate_func

	@ %def vamp2_test_func_2_evaluate_func
	@@ The third test function implements
	\begin{equation}
	f(\vec{x}) = 5 x_{1}^4 + 5 (1 - x_{1})^4,
	\end{equation}
	where
	\begin{align}
	x_1 = u^{1 / 5} & ∨ x_1 = 1 - v^{1 / 5} \\
	\end{align}
	The jacobians are $\frac{\partial x_1}{\partial u} = \frac{1}{5} u^{-\frac{4}{5}}$
	and $\frac{\partial x_1}{\partial v} = \frac{1}{5} v^{-\frac{4}{5}}$.
	<<vamp2: test types>>=
	type, extends(vamp2_func_t) :: vamp2_test_func_3_t
	!
	contains
	<<vamp2: vamp2 test func 3: TBP>>
	end type vamp2_test_func_3_t

	@ %def vamp2_test_func_3_t
	@ Evaluate maps.
	<<vamp2: vamp2 test func 3: TBP>>=
	procedure :: evaluate_maps => vamp2_test_func_3_evaluate_maps
	<<vamp2: tests>>=
	subroutine vamp2_test_func_3_evaluate_maps (self, x)
	class(vamp2_test_func_3_t), intent(inout) :: self
	real(default), dimension(:), intent(in) :: x
	real(default) :: u, v, xx
	select case (self%current_channel)
	case (1)
	u = x(1)
	xx = u**0.2_default
	v = (1 - xx)**5._default
	case (2)
	v = x(1)
	xx = 1 - v**0.2_default
	u = xx**5._default
	end select
	self%det(1) = 0.2_default * u**(-0.8_default)
	self%det(2) = 0.2_default * v**(-0.8_default)
	self%xi(:, 1) = [u]
	self%xi(:, 2) = [v]
	self%valid_x = .true.
	end subroutine vamp2_test_func_3_evaluate_maps

	@ %def vamp2_test_func_3_evaluate_maps
	@ Evaluate func.
	<<vamp2: vamp2 test func 3: TBP>>=
	procedure :: evaluate_func => vamp2_test_func_3_evaluate_func
	<<vamp2: tests>>=
	real(default) function vamp2_test_func_3_evaluate_func (self, x) result (f)
	class(vamp2_test_func_3_t), intent(in) :: self
	real(default), dimension(:), intent(in) :: x
	real(default) :: xx
	select case (self%current_channel)
	case (1)
	xx = x(1)**0.2_default
	case (2)
	xx = 1 - x(1)**0.2_default
	end select
	f = 5 * xx*4 + 5 (1 - xx)**4
	end function vamp2_test_func_3_evaluate_func

	@ %def vamp2_test_func_3_evaluate_func
	@
	\subsubsection{MC Integrator check}
	\label{sec:mc-integrator-check}

	We reproduce the first test case of VEGAS.
	Initialise the VAMP2 MC integrator and call to [[vamp2_init_grid]] for the initialisation of the grid.
	<<vamp2: execute tests>>=
	call test (vamp2_1, "vamp2_1", "VAMP2 initialisation and&
	& grid preparation", u, results)
	<<vamp2: test declaration>>=
	public :: vamp2_1
	<<vamp2: tests>>=
	subroutine vamp2_1 (u)
	integer, intent(in) :: u
	type(vamp2_t) :: mc_integrator
	class(rng_t), allocatable :: rng
	class(vamp2_func_t), allocatable :: func
	real(default), dimension(3), parameter :: x_lower = 0., &
	x_upper = pi
	real(default) :: result, abserr

	write (u, "(A)") "* Test output: vamp2_1"
	write (u, "(A)") "* Purpose: initialise the VAMP2 MC integrator and the grid"
	write (u, "(A)")

	write (u, "(A)") "* Initialise random number generator (default seed)"
	write (u, "(A)")

	allocate (rng_stream_t :: rng)
	call rng%init ()

	call rng%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise MC integrator with n_channel = 1 and n_dim = 3"
	write (u, "(A)")

	allocate (vamp2_test_func_t :: func)
	call func%init (n_dim = 3, n_channel = 1)
	mc_integrator = vamp2_t (1, 3)
	call mc_integrator%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise grid with n_calls = 10000"
	write (u, "(A)")

	call mc_integrator%set_limits (x_lower, x_upper)
	call mc_integrator%set_calls (10000)

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

	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

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

	call mc_integrator%set_calls (2000)
	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

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

	call mc_integrator%final ()
	call rng%final ()
	deallocate (rng)
	end subroutine vamp2_1

	@ %def vamp2_1
	@ Integrate a function with two-dimensional argument and two channels.
	<<vamp2: execute tests>>=
	call test (vamp2_2, "vamp2_2", "VAMP2 intgeration of two-dimensional &
	& function with two channels", u, results)
	<<vamp2: test declaration>>=
	public :: vamp2_2
	<<vamp2: tests>>=
	subroutine vamp2_2 (u)
	integer, intent(in) :: u
	type(vamp2_t) :: mc_integrator
	class(rng_t), allocatable :: rng
	class(vamp2_func_t), allocatable :: func
	real(default), dimension(2), parameter :: x_lower = 0., &
	x_upper = 1.
	real(default) :: result, abserr

	write (u, "(A)") "* Test output: vamp2_2"
	write (u, "(A)") "* Purpose: intgeration of two-dimensional &
	& function with two channels"
	write (u, "(A)")

	write (u, "(A)") "* Initialise random number generator (default seed)"
	write (u, "(A)")

	allocate (rng_stream_t :: rng)
	call rng%init ()

	call rng%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise MC integrator with n_channel = 1 and n_dim = 3"
	write (u, "(A)")

	allocate (vamp2_test_func_2_t :: func)
	call func%init (n_dim = 2, n_channel = 2)
	mc_integrator = vamp2_t (2, 2)
	call mc_integrator%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise grid with n_calls = 10000"
	write (u, "(A)")

	call mc_integrator%set_limits (x_lower, x_upper)
	call mc_integrator%set_calls (1000)

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

	call mc_integrator%integrate (func, rng, 3, opt_verbose = .true., result=result, abserr=abserr)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

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

	call mc_integrator%set_calls (200)
	call mc_integrator%integrate (func, rng, 3, opt_verbose = .true., result=result, abserr=abserr)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

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

	call mc_integrator%final ()
	call rng%final ()
	deallocate (rng)
	end subroutine vamp2_2

	@ %def vamp2_2
	@ Integrate a function with two-dimensional argument and two channels.
	<<vamp2: execute tests>>=
	call test (vamp2_3, "vamp2_3", "VAMP2 intgeration of two-dimensional &
	& function with two channels", u, results)
	<<vamp2: test declaration>>=
	public :: vamp2_3
	<<vamp2: tests>>=
	subroutine vamp2_3 (u)
	integer, intent(in) :: u
	type(vamp2_t) :: mc_integrator
	class(rng_t), allocatable :: rng
	class(vamp2_func_t), allocatable :: func
	real(default), dimension(2), parameter :: x_lower = 0., &
	x_upper = 1.
	real(default) :: result, abserr
	integer :: unit

	write (u, "(A)") "* Test output: vamp2_3"
	write (u, "(A)") "* Purpose: intgeration of two-dimensional &
	& function with two channels"
	write (u, "(A)")

	write (u, "(A)") "* Initialise random number generator (default seed)"
	write (u, "(A)")

	allocate (rng_stream_t :: rng)
	call rng%init ()

	call rng%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise MC integrator with n_channel = 1 and n_dim = 3"
	write (u, "(A)")

	allocate (vamp2_test_func_2_t :: func)
	call func%init (n_dim = 2, n_channel = 2)
	mc_integrator = vamp2_t (2, 2)
	call mc_integrator%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise grid with n_calls = 20000"
	write (u, "(A)")

	call mc_integrator%set_limits (x_lower, x_upper)
	call mc_integrator%set_calls (20000)

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

	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

	write (u, "(A)")
	write (u, "(A)") "* Write grid to file vamp2_3.grids"
	write (u, "(A)")

	unit = free_unit ()
	open (unit, file = "vamp2_3.grids", &
	action = "write", status = "replace")
	call mc_integrator%write_grids (unit)
	close (unit)

	write (u, "(A)")
	write (u, "(A)") "* Read grid from file vamp2_3.grids"
	write (u, "(A)")

	call mc_integrator%final ()

	unit = free_unit ()
	open (unit, file = "vamp2_3.grids", &
	action = "read", status = "old")
	call mc_integrator%read_grids (unit)
	close (unit)

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

	call mc_integrator%set_calls (5000)
	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

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

	call mc_integrator%final ()
	call rng%final ()
	deallocate (rng)
	end subroutine vamp2_3

	@ %def vamp2_3
	@ Integrate a function with two-dimensional argument and two channels.
	Use chained weights, although we average over each weight itself.
	<<vamp2: execute tests>>=
	call test (vamp2_4, "vamp2_4", "VAMP2 intgeration of two-dimensional &
	& function with two channels with chains", u, results)
	<<vamp2: test declaration>>=
	public :: vamp2_4
	<<vamp2: tests>>=
	subroutine vamp2_4 (u)
	integer, intent(in) :: u
	type(vamp2_t) :: mc_integrator
	class(rng_t), allocatable :: rng
	class(vamp2_func_t), allocatable :: func
	real(default), dimension(2), parameter :: x_lower = 0., &
	x_upper = 1.
	real(default) :: result, abserr
	integer :: unit

	write (u, "(A)") "* Test output: vamp2_4"
	write (u, "(A)") "* Purpose: intgeration of two-dimensional &
	& function with two channels with chains"
	write (u, "(A)")

	write (u, "(A)") "* Initialise random number generator (default seed)"
	write (u, "(A)")

	allocate (rng_stream_t :: rng)
	call rng%init ()

	call rng%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise MC integrator with n_channel = 2 and n_dim = 2"
	write (u, "(A)")

	allocate (vamp2_test_func_2_t :: func)
	call func%init (n_dim = 2, n_channel = 2)
	mc_integrator = vamp2_t (2, 2)
	call mc_integrator%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise grid with n_calls = 20000 and set chains"
	write (u, "(A)")

	call mc_integrator%set_limits (x_lower, x_upper)
	call mc_integrator%set_calls (20000)
	call mc_integrator%set_chain (2, [1, 2])

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

	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

	write (u, "(A)")
	write (u, "(A)") "* Write grid to file vamp2_4.grids"
	write (u, "(A)")

	unit = free_unit ()
	open (unit, file = "vamp2_4.grids", &
	action = "write", status = "replace")
	call mc_integrator%write_grids (unit)
	close (unit)

	write (u, "(A)")
	write (u, "(A)") "* Read grid from file vamp2_4.grids"
	write (u, "(A)")

	call mc_integrator%final ()

	unit = free_unit ()
	open (unit, file = "vamp2_4.grids", &
	action = "read", status = "old")
	call mc_integrator%read_grids (unit)
	close (unit)

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

	call mc_integrator%set_calls (5000)
	call mc_integrator%integrate (func, rng, 3, result=result, abserr=abserr)
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ")") "Result: ", result, " +/- ", abserr

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

	call mc_integrator%final ()
	call rng%final ()
	deallocate (rng)
	end subroutine vamp2_4

	@ %def vamp2_4
	@
	<<vamp2: execute tests>>=
	call test (vamp2_5, "vamp2_5", "VAMP2 intgeration of two-dimensional &
	& function with two channels with equivalences", u, results)
	<<vamp2: test declaration>>=
	public :: vamp2_5
	<<vamp2: tests>>=
	subroutine vamp2_5 (u)
	integer, intent(in) :: u
	type(vamp2_t) :: mc_integrator
	class(rng_t), allocatable :: rng
	class(vamp2_func_t), allocatable :: func
	real(default), dimension(1), parameter :: x_lower = 0., &
	x_upper = 1.
	real(default) :: result, abserr
	integer :: unit
	type(vamp2_config_t) :: config
	type(vamp2_equivalences_t) :: eqv
	type(vegas_grid_t), dimension(2) :: grid

	write (u, "(A)") "* Test output: vamp2_5"
	write (u, "(A)") "* Purpose: intgeration of two-dimensional &
	& function with two channels with equivalences"
	write (u, "(A)")

	write (u, "(A)") "* Initialise random number generator (default seed)"
	write (u, "(A)")

	allocate (rng_stream_t :: rng)
	call rng%init ()

	call rng%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise MC integrator with n_channel = 2 and n_dim = 1"
	write (u, "(A)")

	allocate (vamp2_test_func_3_t :: func)
	call func%init (n_dim = 1, n_channel = 2)
	config%equivalences = .true.
	mc_integrator = vamp2_t (n_channel = 2, n_dim = 1)
	call mc_integrator%set_config (config)
	call mc_integrator%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialise grid with n_calls = 20000 and set chains"
	write (u, "(A)")

	call mc_integrator%set_limits (x_lower, x_upper)
	call mc_integrator%set_calls (20000)

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

	eqv = vamp2_equivalences_t (n_eqv = 4, n_channel = 2, n_dim = 1)
	call eqv%set_equivalence &
	(i_eqv = 1, dest = 2, src = 1, perm = [1], mode = [VEQ_IDENTITY])
	call eqv%set_equivalence &
	(i_eqv = 2, dest = 1, src = 2, perm = [1], mode = [VEQ_IDENTITY])
	call eqv%set_equivalence &
	(i_eqv = 3, dest = 1, src = 1, perm = [1], mode = [VEQ_IDENTITY])
	call eqv%set_equivalence &
	(i_eqv = 4, dest = 2, src = 2, perm = [1], mode = [VEQ_IDENTITY])
	call eqv%write (u)
	call mc_integrator%set_equivalences (eqv)

	write (u, "(A)")
	write (u, "(A)") &
	"* Integrate with n_it = 3 and n_calls = 10000 (Grid-only Adaptation)"
	write (u, "(A)")

	call mc_integrator%integrate (func, rng, 3, &
	opt_adapt_weight = .false., result=result, abserr=abserr)
	if (nearly_equal &
	(result, 2.000_default, rel_smallness = 0.003_default)) then
	write (u, "(2x,A)") "Result: 2.000 [ok]"
	else
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ",A)") &
	"Result: ", result, " +/- ", abserr, " [not ok]"
	end if

	write (u, "(A)")
	write (u, "(A)") "* Compare the grids of both channels"
	write (u, "(A)")

	grid(1) = mc_integrator%get_grid(channel = 1)
	grid(2) = mc_integrator%get_grid(channel = 2)

	write (u, "(2X,A,1X,L1)") "Equal grids =", (grid(1) == grid(2))

	write (u, "(A)")
	write (u, "(A)") "* Write grid to file vamp2_5.grids"
	write (u, "(A)")

	unit = free_unit ()
	open (unit, file = "vamp2_5.grids", &
	action = "write", status = "replace")
	call mc_integrator%write_grids (unit)
	close (unit)

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

	call mc_integrator%set_calls (5000)
	call mc_integrator%integrate (func, rng, 3, opt_adapt_weight = .false., &
	opt_refine_grid = .false., result=result, abserr=abserr)
	if (nearly_equal &
	(result, 2.000_default, rel_smallness = 0.002_default)) then
	write (u, "(2x,A)") "Result: 2.000 [ok]"
	else
	write (u, "(2x,A," // FMT_12 // ",A," // FMT_12 // ",A)") &
	"Result: ", result, " +/- ", abserr, " [not ok]"
	end if

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

	call mc_integrator%final ()
	call rng%final ()
	deallocate (rng)
	end subroutine vamp2_5

	Index: trunk/src/shower/Makefile.am
	===================================================================
	--- trunk/src/shower/Makefile.am (revision 8189)
	+++ trunk/src/shower/Makefile.am (revision 8190)
	@@ -1,208 +1,210 @@
	## Makefile.am -- Makefile for WHIZARD
	##
	## Process this file with automake to produce Makefile.in
	#
	# Copyright (C) 1999-2018 by
	# Wolfgang Kilian <kilian@physik.uni-siegen.de>
	# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
	# Juergen Reuter <juergen.reuter@desy.de>
	# with contributions from
	# cf. main AUTHORS file
	#
	# WHIZARD is free software; you can redistribute it and/or modify it
	# under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 2, or (at your option)
	# any later version.
	#
	# WHIZARD is distributed in the hope that it will be useful, but
	# WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	# GNU General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with this program; if not, write to the Free Software
	# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
	#
	########################################################################

	## The files in this directory make up the shower routines

	noinst_LTLIBRARIES = libshower.la
	check_LTLIBRARIES = libshower_ut.la

	libshower_la_SOURCES = \
	pythia6_up.f \
	ktclus.f90 \
	shower_base.f90 \
	shower_partons.f90 \
	shower_core.f90 \
	- shower_pythia6.f90
	+ shower_pythia6.f90 \
	+ shower_pythia8.f90

	libshower_ut_la_SOURCES = \
	shower_base_uti.f90 shower_base_ut.f90

	## Omitting this would exclude it from the distribution
	dist_noinst_DATA = shower.nw

	# Dump module names into file Modules
	libshower_Modules = ${libshower_la_SOURCES:.f90=} ${libshower_ut_la_SOURCES:.f90=}
	Modules: Makefile
	@for module in $(libshower_Modules); do \
	- echo $$module >> $@.new; \
	- done
	+ echo $$module >> $@.new; \
	+ done
	@if diff $@ $@.new -q >/dev/null; then \
	- rm $@.new; \
	+ rm $@.new; \
	else \
	- mv $@.new $@; echo "Modules updated"; \
	- fi
	+ mv $@.new $@; echo "Modules updated"; \
	+ fi
	BUILT_SOURCES = Modules

	## Fortran module dependencies
	# Get module lists from other directories
	module_lists = \
	../basics/Modules \
	../utilities/Modules \
	../testing/Modules \
	../system/Modules \
	../combinatorics/Modules \
	../parsing/Modules \
	../rng/Modules \
	../physics/Modules \
	../qft/Modules \
	../expr_base/Modules \
	../particles/Modules \
	../types/Modules \
	../variables/Modules \
	../model_features/Modules \
	../muli/Modules \
	../events/Modules \
	../beams/Modules \
	- ../tauola/Modules
	+ ../tauola/Modules \
	+ ../pythia8/Modules

	include_modules_bare = ${module_lists:/Modules=}
	include_modules = ${include_modules_bare:../%=-I../%}

	$(module_lists):
	$(MAKE) -C `dirname $@` Modules

	Module_dependencies.sed: $(libshower_la_SOURCES) $(libshower_ut_la_SOURCES)
	Module_dependencies.sed: $(module_lists)
	@rm -f $@
	echo 's/, only:.//' >> $@
	echo 's/, *&//' >> $@
	echo 's/, .=>.*//' >> $@
	echo 's/$$/.lo/' >> $@
	for list in $(module_lists); do \
	dir="`dirname $$list`"; \
	for mod in `cat $$list`; do \
	echo 's!: '$$mod'.lo$$!': $$dir/$$mod'.lo!' >> $@; \
	done \
	done

	DISTCLEANFILES = Module_dependencies.sed

	# The following line just says
	# include Makefile.depend
	# but in a portable fashion (depending on automake's AM_MAKE_INCLUDE
	@am__include@ @am__quote@Makefile.depend@am__quote@

	Makefile.depend: Module_dependencies.sed
	Makefile.depend: $(libshower_la_SOURCES) $(libshower_ut_la_SOURCES)
	@rm -f $@
	for src in $^; do \
	module="`basename $$src \| sed 's/\.f[90][0358]//'`"; \
	grep '^ *use ' $$src \
	\| grep -v '!NODEP!' \
	\| sed -e 's/^ use /'$$module'.lo: /' \
	-f Module_dependencies.sed; \
	done > $@

	DISTCLEANFILES += Makefile.depend

	# Fortran90 module files are generated at the same time as object files
	.lo.$(FC_MODULE_EXT):
	@:
	# touch $@

	-AM_FCFLAGS = $(include_modules) -I../../vamp/src -I../fastjet -I../lhapdf -I ../pdf_builtin -I../tauola -I../../pythia6
	+AM_FCFLAGS = $(include_modules) -I../../vamp/src -I../fastjet -I../lhapdf -I ../pdf_builtin -I../tauola -I../../pythia6 -I../pythia8
	AM_FFLAGS =

	########################################################################
	## Default Fortran compiler options

	## Profiling
	if FC_USE_PROFILING
	AM_FFLAGS += $(FCFLAGS_PROFILING)
	AM_FCFLAGS += $(FCFLAGS_PROFILING)
	endif

	## OpenMP
	if FC_USE_OPENMP
	AM_FFLAGS += $(FCFLAGS_OPENMP)
	AM_FCFLAGS += $(FCFLAGS_OPENMP)
	endif

	## MPI
	if FC_USE_MPI
	AM_FFLAGS += $(FCFLAGS_MPI)
	AM_FCFLAGS += $(FCFLAGS_MPI)
	endif

	########################################################################
	## Non-standard targets and dependencies

	## (Re)create F90 sources from NOWEB source.

	if NOWEB_AVAILABLE

	PRELUDE = $(top_srcdir)/src/noweb-frame/whizard-prelude.nw
	POSTLUDE = $(top_srcdir)/src/noweb-frame/whizard-postlude.nw

	shower.stamp: $(PRELUDE) $(srcdir)/shower.nw $(POSTLUDE)
	@rm -f shower.tmp
	@touch shower.tmp
	for src in $(libshower_la_SOURCES) $(libshower_ut_la_SOURCES); do \
	$(NOTANGLE) -R[[$$src]] $^ \| $(CPIF) $$src; \
	done
	@mv -f shower.tmp shower.stamp

	$(libshower_la_SOURCES) $(libshower_ut_la_SOURCES): shower.stamp
	## Recover from the removal of $@
	@if test -f $@; then :; else \
	rm -f shower.stamp; \
	$(MAKE) $(AM_MAKEFLAGS) shower.stamp; \
	fi

	endif

	########################################################################
	## Non-standard cleanup tasks
	## Remove sources that can be recreated using NOWEB
	if NOWEB_AVAILABLE
	maintainer-clean-noweb:
	-rm -f .f90 .f
	endif
	.PHONY: maintainer-clean-noweb

	## Remove those sources also if builddir and srcdir are different
	if NOWEB_AVAILABLE
	clean-noweb:
	test "$(srcdir)" != "." && rm -f .f90 .f \|\| true
	endif
	.PHONY: clean-noweb

	## Remove F90 module files
	clean-local: clean-noweb
	-rm -f shower.stamp shower.tmp
	-rm -f *.$(FC_MODULE_EXT)
	if FC_SUBMODULES
	-rm -f *.smod
	endif

	## Remove backup files
	maintainer-clean-backup:
	-rm -f *~
	.PHONY: maintainer-clean-backup

	## Register additional clean targets
	maintainer-clean-local: maintainer-clean-noweb maintainer-clean-backup
	Index: trunk/src/shower/shower.nw
	===================================================================
	--- trunk/src/shower/shower.nw (revision 8189)
	+++ trunk/src/shower/shower.nw (revision 8190)
	@@ -1,8296 +1,8539 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD shower code as NOWEB source
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Parton shower and interface to PYTHIA6}
	\includemodulegraph{shower}

	This is the code for the \whizard\ QCD parton shower for final state
	radiation (FSR) and initial state radiation (ISR) as well as the interface
	to the \pythia\ module for showering and hadronization.

	\section{Basics of the shower}
	<<[[shower_base.f90]]>>=
	<<File header>>

	module shower_base

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use constants
	use diagnostics
	use format_utils, only: write_separator
	use lorentz
	use particles
	use os_interface
	use rng_base
	use physics_defs
	use sm_physics, only: running_as_lam
	use particles
	use variables
	use model_data
	use pdf
	use tauola_interface

	<<Standard module head>>

	<<Shower base: public>>

	<<Shower base: parameters>>

	<<Shower base: types>>

	<<Shower base: interfaces>>

	contains

	<<Shower base: procedures>>

	end module shower_base
	@ %def shower_base
	@
	\subsection{Shower implementations}
	<<Shower base: public>>=
	public :: PS_WHIZARD, PS_PYTHIA6, PS_PYTHIA8, PS_UNDEFINED
	<<Shower base: parameters>>=
	integer, parameter :: PS_UNDEFINED = 0
	integer, parameter :: PS_WHIZARD = 1
	integer, parameter :: PS_PYTHIA6 = 2
	integer, parameter :: PS_PYTHIA8 = 3
	@ %def PS_UNDEFINED PS_WHIZARD PS_PYTHIA6 PS_PYTHIA8
	@ A dictionary
	<<Shower base: public>>=
	public :: shower_method_of_string
	<<Shower base: procedures>>=
	elemental function shower_method_of_string (string) result (i)
	integer :: i
	type(string_t), intent(in) :: string
	select case (char(string))
	case ("WHIZARD")
	i = PS_WHIZARD
	case ("PYTHIA6")
	i = PS_PYTHIA6
	case ("PYTHIA8")
	i = PS_PYTHIA8
	case default
	i = PS_UNDEFINED
	end select
	end function shower_method_of_string

	@ %def shower_method_of_string
	@
	<<Shower base: public>>=
	public :: shower_method_to_string
	<<Shower base: procedures>>=
	elemental function shower_method_to_string (i) result (string)
	type(string_t) :: string
	integer, intent(in) :: i
	select case (i)
	case (PS_WHIZARD)
	string = "WHIZARD"
	case (PS_PYTHIA6)
	string = "PYTHIA6"
	case (PS_PYTHIA8)
	string = "PYTHIA8"
	case default
	string = "UNDEFINED"
	end select
	end function shower_method_to_string

	@ %def shower_method_to_string
	@
	\subsection{Shower settings}
	These the general shower settings, the settings and parameters for the
	matching are defined in the corresponding matching modules. The width
	and the cutoff of the Gaussian primordial $k_t$ distribution,
	[[PARP(91)]] and [[PARP(93)]], in GeV, are called
	[[isr_primordial_kt_width]] and [[isr_primordial_kt_cutoff]] in \whizard.
	The parameter [[MSTJ(45)]] gives the maximum number of flavors in
	gluon decay to quarks, and is here called [[max_n_flavors]].

	The two parameters [[isr_alphas_running] and [[fsr_alphas_running]]
	decide whether to use constant or running
	$alpha_s$ in the form of the function $D\_{alpha_s} (t)$ for the FSR
	and ISR ([[MSTJ(44)]], [[MSTP(64)]]), respectively. The next
	parameter, [[fixed_alpha_s]] is the parameter [[PARU(111)]], which
	sets the value for constant $\alpha_s$, and the flag whether to use
	$P_t$-ordered ISR is [[isr_pt_ordered]]. From the entry [[min_voirtuality]]
	on, parameters have meanings both for the \pythia\ and
	\whizard\ parton shower(s), where \pythia\ values are denoted at the
	end of the line.
	<<Shower base: public>>=
	public :: shower_settings_t
	<<Shower base: types>>=
	type :: shower_settings_t
	logical :: active = .false.
	logical :: isr_active = .false.
	logical :: fsr_active = .false.
	logical :: muli_active = .false.
	logical :: hadronization_active = .false.
	logical :: tau_dec = .false.
	logical :: verbose = .false.
	integer :: method = PS_UNDEFINED
	logical :: hadron_collision = .false.
	logical :: mlm_matching = .false.
	logical :: ckkw_matching = .false.
	logical :: powheg_matching = .false.
	type(string_t) :: pythia6_pygive
	+ type(string_t) :: pythia8_config
	+ type(string_t) :: pythia8_config_file
	real(default) :: min_virtuality = 1._default ! PARJ(82)^2
	real(default) :: fsr_lambda = 0.29_default ! PARP(72)
	real(default) :: isr_lambda = 0.29_default ! PARP(61)
	integer :: max_n_flavors = 5 ! MSTJ(45)
	logical :: isr_alphas_running = .true. ! MSTP(64)
	logical :: fsr_alphas_running = .true. ! MSTJ(44)
	real(default) :: fixed_alpha_s = 0.2_default ! PARU(111)
	logical :: alpha_s_fudged = .true.
	logical :: isr_pt_ordered = .false.
	logical :: isr_angular_ordered = .true. ! MSTP(62)
	real(default) :: isr_primordial_kt_width = 1.5_default ! PARP(91)
	real(default) :: isr_primordial_kt_cutoff = 5._default ! PARP(93)
	real(default) :: isr_z_cutoff = 0.999_default ! 1-PARP(66)
	real(default) :: isr_minenergy = 2._default ! PARP(65)
	real(default) :: isr_tscalefactor = 1._default
	logical :: isr_only_onshell_emitted_partons = .true. ! MSTP(63)
	contains
	<<Shower base: shower settings: TBP>>
	end type shower_settings_t

	@ %def shower_settings_t
	@ Read in the shower settings (and flags whether matching and
	hadronization are switched on).
	<<Shower base: shower settings: TBP>>=
	procedure :: init => shower_settings_init
	<<Shower base: procedures>>=
	subroutine shower_settings_init (settings, var_list)
	class(shower_settings_t), intent(out) :: settings
	type(var_list_t), intent(in) :: var_list

	settings%fsr_active = &
	var_list%get_lval (var_str ("?ps_fsr_active"))
	settings%isr_active = &
	var_list%get_lval (var_str ("?ps_isr_active"))
	settings%tau_dec = &
	var_list%get_lval (var_str ("?ps_taudec_active"))
	settings%muli_active = &
	var_list%get_lval (var_str ("?muli_active"))
	settings%hadronization_active = &
	var_list%get_lval (var_str ("?hadronization_active"))
	settings%mlm_matching = &
	var_list%get_lval (var_str ("?mlm_matching"))
	settings%ckkw_matching = &
	var_list%get_lval (var_str ("?ckkw_matching"))
	settings%powheg_matching = &
	var_list%get_lval (var_str ("?powheg_matching"))
	settings%method = shower_method_of_string ( &
	var_list%get_sval (var_str ("$shower_method")))
	settings%active = settings%isr_active .or. &
	settings%fsr_active .or. &
	settings%powheg_matching .or. &
	settings%muli_active .or. &
	settings%hadronization_active
	if (.not. settings%active) return
	settings%verbose = &
	var_list%get_lval (var_str ("?shower_verbose"))
	settings%pythia6_pygive = &
	var_list%get_sval (var_str ("$ps_PYTHIA_PYGIVE"))
	+ settings%pythia8_config = &
	+ var_list%get_sval (var_str ("$ps_PYTHIA8_config"))
	+ settings%pythia8_config_file = &
	+ var_list%get_sval (var_str ("$ps_PYTHIA8_config_file"))
	settings%min_virtuality = &
	(var_list%get_rval (var_str ("ps_mass_cutoff"))**2)
	settings%fsr_lambda = &
	var_list%get_rval (var_str ("ps_fsr_lambda"))
	settings%isr_lambda = &
	var_list%get_rval (var_str ("ps_isr_lambda"))
	settings%max_n_flavors = &
	var_list%get_ival (var_str ("ps_max_n_flavors"))
	settings%isr_alphas_running = &
	var_list%get_lval (var_str ("?ps_isr_alphas_running"))
	settings%fsr_alphas_running = &
	var_list%get_lval (var_str ("?ps_fsr_alphas_running"))
	settings%fixed_alpha_s = &
	var_list%get_rval (var_str ("ps_fixed_alphas"))
	settings%isr_pt_ordered = &
	var_list%get_lval (var_str ("?ps_isr_pt_ordered"))
	settings%isr_angular_ordered = &
	var_list%get_lval (var_str ("?ps_isr_angular_ordered"))
	settings%isr_primordial_kt_width = &
	var_list%get_rval (var_str ("ps_isr_primordial_kt_width"))
	settings%isr_primordial_kt_cutoff = &
	var_list%get_rval (var_str ("ps_isr_primordial_kt_cutoff"))
	settings%isr_z_cutoff = &
	var_list%get_rval (var_str ("ps_isr_z_cutoff"))
	settings%isr_minenergy = &
	var_list%get_rval (var_str ("ps_isr_minenergy"))
	settings%isr_tscalefactor = &
	var_list%get_rval (var_str ("ps_isr_tscalefactor"))
	settings%isr_only_onshell_emitted_partons = &
	var_list%get_lval (&
	var_str ("?ps_isr_only_onshell_emitted_partons"))
	end subroutine shower_settings_init

	@ %def shower_settings_init
	@
	<<Shower base: shower settings: TBP>>=
	procedure :: write => shower_settings_write
	<<Shower base: procedures>>=
	subroutine shower_settings_write (settings, unit)
	class(shower_settings_t), intent(in) :: settings
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "Shower settings:"
	call write_separator (u)
	write (u, "(1x,A)") "Master switches:"
	write (u, "(3x,A,1x,L1)") &
	"ps_isr_active = ", settings%isr_active
	write (u, "(3x,A,1x,L1)") &
	"ps_fsr_active = ", settings%fsr_active
	write (u, "(3x,A,1x,L1)") &
	"ps_tau_dec = ", settings%tau_dec
	write (u, "(3x,A,1x,L1)") &
	"muli_active = ", settings%muli_active
	write (u, "(3x,A,1x,L1)") &
	"hadronization_active = ", settings%hadronization_active
	write (u, "(1x,A)") "General settings:"
	if (settings%isr_active .or. settings%fsr_active) then
	write (u, "(3x,A)") &
	"method = " // &
	char (shower_method_to_string (settings%method))
	write (u, "(3x,A,1x,L1)") &
	"shower_verbose = ", settings%verbose
	write (u, "(3x,A,ES19.12)") &
	"ps_mass_cutoff = ", &
	sqrt (abs (settings%min_virtuality))
	write (u, "(3x,A,1x,I1)") &
	"ps_max_n_flavors = ", settings%max_n_flavors
	else
	write (u, "(3x,A)") " [ISR and FSR off]"
	end if
	if (settings%isr_active) then
	write (u, "(1x,A)") "ISR settings:"
	write (u, "(3x,A,1x,L1)") &
	"ps_isr_pt_ordered = ", settings%isr_pt_ordered
	write (u, "(3x,A,ES19.12)") &
	"ps_isr_lambda = ", settings%isr_lambda
	write (u, "(3x,A,1x,L1)") &
	"ps_isr_alphas_running = ", settings%isr_alphas_running
	write (u, "(3x,A,ES19.12)") &
	"ps_isr_primordial_kt_width = ", settings%isr_primordial_kt_width
	write (u, "(3x,A,ES19.12)") &
	"ps_isr_primordial_kt_cutoff = ", &
	settings%isr_primordial_kt_cutoff
	write (u, "(3x,A,ES19.12)") &
	"ps_isr_z_cutoff = ", settings%isr_z_cutoff
	write (u, "(3x,A,ES19.12)") &
	"ps_isr_minenergy = ", settings%isr_minenergy
	write (u, "(3x,A,ES19.12)") &
	"ps_isr_tscalefactor = ", settings%isr_tscalefactor
	else if (settings%fsr_active) then
	write (u, "(3x,A)") " [ISR off]"
	end if
	if (settings%fsr_active) then
	write (u, "(1x,A)") "FSR settings:"
	write (u, "(3x,A,ES19.12)") &
	"ps_fsr_lambda = ", settings%fsr_lambda
	write (u, "(3x,A,1x,L1)") &
	"ps_fsr_alphas_running = ", settings%fsr_alphas_running
	else if (settings%isr_active) then
	write (u, "(3x,A)") " [FSR off]"
	end if
	write (u, "(1x,A)") "Matching Settings:"
	write (u, "(3x,A,1x,L1)") &
	"mlm_matching = ", settings%mlm_matching
	write (u, "(3x,A,1x,L1)") &
	"ckkw_matching = ", settings%ckkw_matching
	write (u, "(1x,A)") "PYTHIA6 specific settings:"
	write (u, "(3x,A,A,A)") &
	"ps_PYTHIA_PYGIVE = '", &
	char(settings%pythia6_pygive), "'"
	+ write (u, "(1x,A)") "PYTHIA8 specific settings:"
	+ write (u, "(3x,A,A,A)") &
	+ "ps_PYTHIA8_config = '", &
	+ char (settings%pythia8_config), "'"
	+ write (u, "(3x,A,A,A)") &
	+ "ps_PYTHIA8_config_file = '", &
	+ char (settings%pythia8_config_file), "'"
	end subroutine shower_settings_write

	@ %def shower_settings_write
	@
	\subsection{Abstract Shower Type}
	Any parton shower implementation will use random numbers to generate
	emissions.
	<<Shower base: public>>=
	public :: shower_base_t
	<<Shower base: types>>=
	type, abstract :: shower_base_t
	class(rng_t), allocatable :: rng
	type(string_t) :: name
	type(pdf_data_t) :: pdf_data
	type(shower_settings_t) :: settings
	type(taudec_settings_t) :: taudec_settings
	+ type(os_data_t) :: os_data
	+ real(default) :: fac_scale
	+ real(default) :: alpha_s
	contains
	<<Shower base: shower base: TBP>>
	end type shower_base_t

	@ %def shower_base_t
	@
	<<Shower base: shower base: TBP>>=
	procedure :: write_msg => shower_base_write_msg
	<<Shower base: procedures>>=
	subroutine shower_base_write_msg (shower)
	class(shower_base_t), intent(inout) :: shower
	call msg_message ("Shower: Using " // char(shower%name) // " shower")
	end subroutine shower_base_write_msg

	@ %def shower_base_write_msg
	@
	<<Shower base: shower base: TBP>>=
	procedure :: import_rng => shower_base_import_rng
	<<Shower base: procedures>>=
	pure subroutine shower_base_import_rng (shower, rng)
	class(shower_base_t), intent(inout) :: shower
	class(rng_t), intent(inout), allocatable :: rng
	call move_alloc (from = rng, to = shower%rng)
	end subroutine shower_base_import_rng

	@ %def shower_base_import_rng
	@ Shower implementations need to know the overall settings as well as
	[[pdf_data_t]] if ISR needs to be simulated.
	+In order to use external files or tools we need access to [[os_data]].
	<<Shower base: shower base: TBP>>=
	procedure (shower_base_init), deferred :: init
	<<Shower base: interfaces>>=
	abstract interface
	- subroutine shower_base_init (shower, settings, taudec_settings, pdf_data)
	+ subroutine shower_base_init (shower, settings, taudec_settings, pdf_data, os_data)
	import
	class(shower_base_t), intent(out) :: shower
	type(shower_settings_t), intent(in) :: settings
	type(taudec_settings_t), intent(in) :: taudec_settings
	type(pdf_data_t), intent(in) :: pdf_data
	+ type(os_data_t), intent(in) :: os_data
	end subroutine shower_base_init
	end interface

	@ %def shower_base_init
	-@
	+@ Prepare a new event.
	+
	+Set event parameters: [[fac_scale]], [[alpha_s]]
	<<Shower base: shower base: TBP>>=
	- procedure (shower_base_prepare_new_event), deferred :: prepare_new_event
	-<<Shower base: interfaces>>=
	- abstract interface
	- subroutine shower_base_prepare_new_event &
	- (shower)
	- import
	- class(shower_base_t), intent(inout) :: shower
	- end subroutine shower_base_prepare_new_event
	- end interface
	+ procedure :: prepare_new_event => shower_base_prepare_new_event
	+<<Shower base: procedures>>=
	+ subroutine shower_base_prepare_new_event (shower, fac_scale, alpha_s)
	+ class(shower_base_t), intent(inout) :: shower
	+ real(default), intent(in) :: fac_scale, alpha_s
	+ shower%fac_scale = fac_scale
	+ shower%alpha_s = alpha_s
	+ end subroutine shower_base_prepare_new_event

	@ %def shower_base_prepare_new_event
	@
	<<Shower base: shower base: TBP>>=
	procedure (shower_base_import_particle_set), deferred :: import_particle_set
	<<Shower base: interfaces>>=
	abstract interface
	subroutine shower_base_import_particle_set &
	- (shower, particle_set, os_data, scale)
	+ (shower, particle_set)
	import
	class(shower_base_t), target, intent(inout) :: shower
	type(particle_set_t), intent(in) :: particle_set
	- type(os_data_t), intent(in) :: os_data
	- real(default), intent(in) :: scale
	end subroutine shower_base_import_particle_set
	end interface

	@ %def shower_base_import_particle_set
	@
	<<Shower base: shower base: TBP>>=
	procedure (shower_base_generate_emissions), deferred :: generate_emissions
	<<Shower base: interfaces>>=
	abstract interface
	subroutine shower_base_generate_emissions &
	(shower, valid, number_of_emissions)
	import
	class(shower_base_t), intent(inout), target :: shower
	logical, intent(out) :: valid
	integer, optional, intent(in) :: number_of_emissions
	end subroutine shower_base_generate_emissions
	end interface

	@ %def shower_base_generate_emissions
	@
	<<Shower base: shower base: TBP>>=
	procedure (shower_base_make_particle_set), deferred :: make_particle_set
	<<Shower base: interfaces>>=
	abstract interface
	subroutine shower_base_make_particle_set &
	(shower, particle_set, model, model_hadrons)
	import
	class(shower_base_t), intent(in) :: shower
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	class(model_data_t), intent(in), target :: model_hadrons
	end subroutine shower_base_make_particle_set
	end interface

	@ %def shower_base_make_particle_set
	@
	<<Shower base: shower base: TBP>>=
	procedure (shower_base_get_final_colored_ME_momenta), deferred :: &
	get_final_colored_ME_momenta
	<<Shower base: interfaces>>=
	abstract interface
	subroutine shower_base_get_final_colored_ME_momenta &
	(shower, momenta)
	import
	class(shower_base_t), intent(in) :: shower
	type(vector4_t), dimension(:), allocatable, intent(out) :: momenta
	end subroutine shower_base_get_final_colored_ME_momenta
	end interface

	@ %def shower_base_get_final_colored_ME_momenta
	@
	\subsection{Additional parameters}
	These parameters are the cut-off scale $t_{\text{cut}}$, given in
	GeV$^2$ ([[PARJ(82)]]), the cut-off scale for the $P_t^2$-ordered
	shower in GeV$^2$, and the two shower parameters [[PARP(72)]] and
	[[PARP(61)]], respectively.
	<<Shower base: parameters>>=
	real(default), public :: D_min_scale = 0.5_default
	@ %def D_min_scale
	Treating either $u$ and $d$, or all quarks except $t$ as massless:
	<<Shower base: parameters>>=
	logical, public :: treat_light_quarks_massless = .true.
	logical, public :: treat_duscb_quarks_massless = .false.
	@ %def treat_light_quarks_massless
	@ %def treat_duscb_quarks_massless
	Temporary parameters for the $P_t$-ordered shower:
	<<Shower base: parameters>>=
	real(default), public :: scalefactor1 = 0.02_default
	real(default), public :: scalefactor2 = 0.02_default
	@ %def scalefactor1 scalefactor2
	@
	<<Shower base: public>>=
	public :: D_alpha_s_isr
	public :: D_alpha_s_fsr
	<<Shower base: procedures>>=
	function D_alpha_s_isr (tin, settings) result (alpha_s)
	real(default), intent(in) :: tin
	type(shower_settings_t), intent(in) :: settings
	real(default) :: min_virtuality, d_constalpha_s, d_lambda_isr
	integer :: d_nf
	real(default) :: t
	real(default) :: alpha_s
	min_virtuality = settings%min_virtuality
	d_lambda_isr = settings%isr_lambda
	d_constalpha_s = settings%fixed_alpha_s
	d_nf = settings%max_n_flavors
	if (settings%alpha_s_fudged) then
	t = max (max (0.1_default * min_virtuality, &
	1.1_default * d_lambda_isr**2), abs(tin))
	else
	t = abs(tin)
	end if
	if (settings%isr_alphas_running) then
	alpha_s = running_as_lam (number_of_flavors(t, d_nf, min_virtuality), &
	sqrt(t), d_lambda_isr, 0)
	else
	alpha_s = d_constalpha_s
	end if
	end function D_alpha_s_isr

	function D_alpha_s_fsr (tin, settings) result (alpha_s)
	real(default), intent(in) :: tin
	type(shower_settings_t), intent(in) :: settings
	real(default) :: min_virtuality, d_lambda_fsr, d_constalpha_s
	integer :: d_nf
	real(default) :: t
	real(default) :: alpha_s
	min_virtuality = settings%min_virtuality
	d_lambda_fsr = settings%fsr_lambda
	d_constalpha_s = settings%fixed_alpha_s
	d_nf = settings%max_n_flavors
	if (settings%alpha_s_fudged) then
	t = max (max (0.1_default * min_virtuality, &
	1.1_default * d_lambda_fsr**2), abs(tin))
	else
	t = abs(tin)
	end if
	if (settings%fsr_alphas_running) then
	alpha_s = running_as_lam (number_of_flavors (t, d_nf, min_virtuality), &
	sqrt(t), d_lambda_fsr, 0)
	else
	alpha_s = d_constalpha_s
	end if
	end function D_alpha_s_fsr

	@ %def D_alpha_s_isr D_alpha_s_fsr
	@ Mass and mass squared selection functions. All masses are in
	GeV. Light quarks are assumed to be ordered, $m_1 < m_2 < m_3 \ldots$,
	and they get current masses, not elementary ones. Mesons and baryons
	other than proton and neutron are needed as beam-remnants. Particles
	with PDG number zero are taken massless, as well as proper beam
	remnants and any other particles.
	<<Shower base: public>>=
	public :: mass_type
	public :: mass_squared_type
	<<Shower base: procedures>>=
	elemental function mass_type (type, m2_default) result (mass)
	integer, intent(in) :: type
	real(default), intent(in) :: m2_default
	real(default) :: mass
	mass = sqrt (mass_squared_type (type, m2_default))
	end function mass_type

	elemental function mass_squared_type (type, m2_default) result (mass2)
	integer, intent(in) :: type
	real(default), intent(in) :: m2_default
	real(default) :: mass2
	select case (abs (type))
	!!! case (1,2)
	!!! if (treat_light_quarks_massless .or. &
	!!! treat_duscb_quarks_massless) then
	!!! mass2 = zero
	!!! else
	!!! mass2 = 0.330_default**2
	!!! end if
	!!! case (3)
	!!! if (treat_duscb_quarks_massless) then
	!!! mass2 = zero
	!!! else
	!!! mass2 = 0.500_default**2
	!!! end if
	!!! case (4)
	!!! if (treat_duscb_quarks_massless) then
	!!! mass2 = zero
	!!! else
	!!! mass2 = 1.500_default**2
	!!! end if
	!!! case (5)
	!!! if (treat_duscb_quarks_massless) then
	!!! mass2 = zero
	!!! else
	!!! mass2 = 4.800_default**2
	!!! end if
	!!! case (GLUON)
	!!! mass2 = zero
	case (NEUTRON)
	mass2 = 0.939565_default**2
	case (PROTON)
	mass2 = 0.93827_default**2
	case (DPLUS)
	mass2 = 1.86960_default**2
	case (D0)
	mass2 = 1.86483_default**2
	case (B0)
	mass2 = 5.27950_default**2
	case (BPLUS)
	mass2 = 5.27917_default**2
	case (DELTAPLUSPLUS)
	mass2 = 1.232_default**2
	case (SIGMA0)
	mass2 = 1.192642_default**2
	case (SIGMAPLUS)
	mass2 = 1.18937_default**2
	case (SIGMACPLUS)
	mass2 = 2.4529_default**2
	case (SIGMACPLUSPLUS)
	mass2 = 2.45402_default**2
	case (SIGMAB0)
	mass2 = 5.8152_default**2
	case (SIGMABPLUS)
	mass2 = 5.8078_default**2
	case (BEAM_REMNANT)
	mass2 = zero !!! don't know how to handle the beamremnant
	case default
	mass2 = m2_default
	end select
	end function mass_squared_type

	@ %def mass_type mass_squared_type
	@ The number of flavors active at a certain scale (virtuality) $t$.
	<<Shower base: public>>=
	public :: number_of_flavors
	<<Shower base: procedures>>=
	elemental function number_of_flavors (t, d_nf, min_virtuality) result (nr)
	real(default), intent(in) :: t, min_virtuality
	integer, intent(in) :: d_nf
	real(default) :: nr
	integer :: i
	nr = 0
	if (t < min_virtuality) return ! arbitrary cut off
	! TODO: do i = 1, min (max (3, d_nf), 6)
	do i = 1, min (3, d_nf)
	!!! to do: take heavier quarks(-> cuts on allowed costheta in g->qq)
	!!! into account
	if ((four * mass_squared_type (i, zero) + min_virtuality) < t ) then
	nr = i
	else
	exit
	end if
	end do
	end function number_of_flavors

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

	module shower_base_ut
	use unit_tests
	use shower_base_uti

	<<Standard module head>>

	<<Shower base: public test>>

	contains

	<<Shower base: test driver>>

	end module shower_base_ut
	@ %def shower_base_ut
	@
	<<[[shower_base_uti.f90]]>>=
	<<File header>>

	module shower_base_uti

	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use variables
	use shower_base

	<<Standard module head>>

	<<Shower base: test declarations>>

	contains

	<<Shower base: tests>>

	end module shower_base_uti
	@ %def shower_base_ut
	@ API: driver for the unit tests below.
	<<Shower base: public test>>=
	public :: shower_base_test
	<<Shower base: test driver>>=
	subroutine shower_base_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Shower base: execute tests>>
	end subroutine shower_base_test

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

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

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

	call var_list%init_defaults (0)
	call var_list%set_log (var_str ("?alphas_is_fixed"), &
	.true., is_known = .true.)
	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 var_list%set_string (var_str ("$shower_method"), &
	var_str ("PYTHIA6"), is_known = .true.)
	call var_list%set_log (var_str ("?ps_fsr_active"), &
	.true., is_known = .true.)
	call var_list%set_log (var_str ("?ps_isr_active"), &
	.true., is_known = .true.)
	call var_list%set_log (var_str ("?hadronization_active"), &
	.true., is_known = .true.)
	call var_list%set_log (var_str ("?mlm_matching"), &
	.true., is_known = .true.)
	call var_list%set_int &
	(var_str ("ps_max_n_flavors"), 4, is_known = .true.)
	call var_list%set_real &
	(var_str ("ps_isr_z_cutoff"), 0.1234_default, &
	is_known=.true.)
	call var_list%set_real (&
	var_str ("mlm_etamax"), 3.456_default, is_known=.true.)
	call var_list%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 var_list%final ()

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

	end subroutine shower_base_1

	@ %def shower_base_1
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Parton module for the shower}
	<<[[shower_partons.f90]]>>=
	<<File header>>

	module shower_partons

	<<Use kinds with double>>
	use io_units
	use constants
	use system_defs, only: TAB
	use diagnostics
	use physics_defs
	use lorentz
	use sm_physics
	use particles
	use flavors
	use colors
	use subevents
	use model_data
	use shower_base
	use rng_base

	<<Standard module head>>

	<<Shower partons: public>>

	<<Shower partons: types>>

	contains

	<<Shower partons: procedures>>

	end module shower_partons
	@ %def shower_partons
	@
	\subsection{The basic type defintions}

	The type [[parton_t]] defines a parton for the shower. The [[x]] value
	of the parton is only needed for spacelike showers. The pointer
	[[initial]] is only needed for partons in initial showers, it points to
	the hadron the parton is coming from. An auxiliary value for the
	$P_t$-ordered ISR is [[aux_pt]]. Then, there are two auxiliary entries
	for the clustering of CKKW pseudo weights and CKKW matching,
	[[ckkwlabel]] and [[ckkwscale]]. In order to make shower settings
	available to all operations on the shower partons, we endow the
	[[parton_t]] type with a pointer to [[shower_settings_t]].
	<<Shower partons: public>>=
	public :: parton_t
	<<Shower partons: types>>=
	type :: parton_t
	integer :: nr = 0
	integer :: type = 0
	type(shower_settings_t), pointer :: settings => null()
	type(vector4_t) :: momentum = vector4_null
	real(default) :: t = zero
	real(default) :: mass2 = zero
	real(default) :: scale = zero
	real(default) :: z = zero
	real(default) :: costheta = zero
	real(default) :: x = zero
	logical :: simulated = .false.
	logical :: belongstoFSR = .true.
	logical :: belongstointeraction = .false.
	type(parton_t), pointer :: parent => null ()
	type(parton_t), pointer :: child1 => null ()
	type(parton_t), pointer :: child2 => null ()
	type(parton_t), pointer :: initial => null ()
	integer :: c1 = 0, c2 = 0
	integer :: aux_pt = 0
	integer :: ckkwlabel = 0
	real(default) :: ckkwscale = zero
	integer :: ckkwtype = -1
	integer :: interactionnr = 0
	contains
	<<Shower partons: parton: TBP>>
	end type parton_t

	@ %def parton_t
	@
	<<Shower partons: public>>=
	public :: parton_pointer_t
	<<Shower partons: types>>=
	type :: parton_pointer_t
	type(parton_t), pointer :: p => null ()
	end type parton_pointer_t

	@ %def parton_pointer_t
	@
	\subsection{Routines}
	<<Shower partons: parton: TBP>>=
	procedure :: to_particle => parton_to_particle
	<<Shower partons: procedures>>=
	function parton_to_particle (parton, model, from_hard_int) result (particle)
	type(particle_t) :: particle
	class(parton_t), intent(in) :: parton
	class(model_data_t), pointer, intent(in) :: model
	logical, intent(in), optional :: from_hard_int
	integer :: col, anti_col
	call parton%to_color (col, anti_col, from_hard_int)
	call particle%init (parton%to_status (from_hard_int), parton%type, &
	model, col, anti_col, parton%momentum)
	end function parton_to_particle

	@ %def parton_to_particle
	@
	<<Shower partons: public>>=
	public :: parton_of_particle
	<<Shower partons: procedures>>=
	! pure
	function parton_of_particle (particle, nr) result (parton)
	type(parton_t) :: parton
	type(particle_t), intent(in) :: particle
	integer, intent(in) :: nr
	integer, dimension(2) :: col_array
	parton%nr = nr
	parton%momentum = particle%p
	parton%t = particle%p2
	parton%type = particle%flv%get_pdg ()
	col_array = particle%get_color ()
	parton%c1 = col_array (1)
	parton%c2 = col_array (2)
	parton%interactionnr = 1
	parton%mass2 = particle%flv%get_mass () ** 2
	end function parton_of_particle

	@ %def parton_of_particle
	@
	<<Shower partons: parton: TBP>>=
	procedure :: to_status => parton_to_status
	<<Shower partons: procedures>>=
	pure function parton_to_status (parton, from_hard_int) result (status)
	integer :: status
	class(parton_t), intent(in) :: parton
	logical, intent(in), optional :: from_hard_int
	logical :: fhi
	fhi = .false.; if (present (from_hard_int)) fhi = from_hard_int
	if (fhi .or. parton%is_colored ()) then
	if (associated (parton%initial) .and. .not. parton%belongstoFSR) then
	status = PRT_INCOMING
	else
	status = PRT_OUTGOING
	end if
	else
	status = PRT_BEAM_REMNANT
	end if
	end function parton_to_status

	@ %def parton_to_status
	@
	<<Shower partons: parton: TBP>>=
	procedure :: to_color => parton_to_color
	<<Shower partons: procedures>>=
	pure subroutine parton_to_color (parton, c1, c2, from_hard_int)
	class(parton_t), intent(in) :: parton
	integer, intent(out) :: c1, c2
	logical, intent(in), optional :: from_hard_int
	logical :: fhi
	fhi = .false.; if (present (from_hard_int)) fhi = from_hard_int
	c1 = 0
	c2 = 0
	if (parton%is_colored ()) then
	if (fhi) then
	if (parton%c1 /= 0) c1 = parton%c1
	if (parton%c2 /= 0) c2 = parton%c2
	else
	if (parton%c1 /= 0) c1 = 500 + parton%c1
	if (parton%c2 /= 0) c2 = 500 + parton%c2
	end if
	end if
	end subroutine parton_to_color

	@ %def parton_to_color
	<<Shower partons: public>>=
	public :: parton_copy
	<<Shower partons: procedures>>=
	subroutine parton_copy (prt1, prt2)
	type(parton_t), intent(in) :: prt1
	type(parton_t), intent(out) :: prt2
	if (associated (prt1%settings)) prt2%settings => prt1%settings
	prt2%nr = prt1%nr
	prt2%type = prt1%type
	prt2%momentum = prt1%momentum
	prt2%t = prt1%t
	prt2%mass2 = prt1%mass2
	prt2%scale = prt1%scale
	prt2%z = prt1%z
	prt2%costheta = prt1%costheta
	prt2%x = prt1%x
	prt2%simulated = prt1%simulated
	prt2%belongstoFSR = prt1%belongstoFSR
	prt2%belongstointeraction = prt1%belongstointeraction
	prt2%interactionnr = prt1%interactionnr
	if (associated (prt1%parent)) prt2%parent => prt1%parent
	if (associated (prt1%child1)) prt2%child1 => prt1%child1
	if (associated (prt1%child2)) prt2%child2 => prt1%child2
	if (associated (prt1%initial)) prt2%initial => prt1%initial
	prt2%c1 = prt1%c1
	prt2%c2 = prt1%c2
	prt2%aux_pt = prt1%aux_pt
	end subroutine parton_copy

	@ %def parton_copy
	@ This returns the angle between the daughters assuming them to be
	massless.
	<<Shower partons: parton: TBP>>=
	procedure :: get_costheta => parton_get_costheta
	<<Shower partons: procedures>>=
	elemental function parton_get_costheta (prt) result (costheta)
	class(parton_t), intent(in) :: prt
	real(default) :: costheta
	real(default) :: denom
	denom = two * prt%z * (one - prt%z) * prt%momentum%p(0)**2
	if (denom > eps0) then
	costheta = one - prt%t / denom
	else
	costheta = - one
	end if
	end function parton_get_costheta

	@ %def parton_get_costheta
	@ The same for massive daughters.
	<<Shower partons: parton: TBP>>=
	procedure :: get_costheta_mass => parton_get_costheta_mass
	<<Shower partons: procedures>>=
	elemental function parton_get_costheta_mass (prt) result (costheta)
	class(parton_t), intent(in) :: prt
	real(default) :: costheta, sqrt12
	if (prt%is_branched ()) then
	if (prt%child1%simulated .and. &
	prt%child2%simulated) then
	sqrt12 = sqrt (max (zero, (prt%z)*2 prt%momentum%p(0)**2 &
	- prt%child1%t)) * &
	sqrt (max (zero, (one - prt%z)*2 prt%momentum%p(0)**2 &
	- prt%child2%t))
	if (sqrt12 > eps0) then
	costheta = (prt%t - prt%child1%t - prt%child2%t - &
	two * prt%z * (one - prt%z) * prt%momentum%p(0)**2) / &
	(- two * sqrt12)
	return
	end if
	end if
	end if
	costheta = prt%get_costheta ()
	end function parton_get_costheta_mass

	@ %def parton_get_costheta_mass
	@ This function returns the angle between the momentum vectors of the
	parton and first daughter. This is only used for debugging.
	<<Shower partons: parton: TBP>>=
	procedure :: get_costheta_motherfirst => parton_get_costheta_motherfirst
	<<Shower partons: procedures>>=
	elemental function parton_get_costheta_motherfirst (prt) result (costheta)
	class(parton_t), intent(in) :: prt
	real(default) :: costheta
	if (prt%is_branched ()) then
	if ((prt%child1%simulated .or. &
	prt%child1%is_final () .or. &
	prt%child1%is_branched ()) .and. &
	(prt%child2%simulated .or. &
	prt%child2%is_final () .or. &
	prt%child2%is_branched ())) then
	costheta = enclosed_angle_ct (prt%momentum, prt%child1%momentum)
	return
	end if
	end if
	costheta = - two
	end function parton_get_costheta_motherfirst

	@ %def parton_get_costheta_motherfirst
	@ Get the parton velocities.
	<<Shower partons: parton: TBP>>=
	procedure :: get_beta => parton_get_beta
	@
	<<Shower partons: procedures>>=
	pure function get_beta (t,E) result (beta)
	real(default), intent(in) :: t,E
	real(default) :: beta
	beta = sqrt (max (tiny_07, one - t /(E**2)))
	end function get_beta

	elemental function parton_get_beta (prt) result (beta)
	class(parton_t), intent(in) :: prt
	real(default) :: beta
	beta = sqrt (max (tiny_07, one - prt%t / prt%momentum%p(0)**2))
	end function parton_get_beta

	@ %def get_beta parton_get_beta
	@ Write routine.
	<<Shower partons: parton: TBP>>=
	procedure :: write => parton_write
	<<Shower partons: procedures>>=
	subroutine parton_write (prt, unit)
	class(parton_t), intent(in) :: prt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return

	write (u, "(1x,7A)") "Shower parton <nr>", TAB, "<type>", TAB // TAB, &
	"<parent>", TAB, "<mom(0:3)>"
	write (u, "(2x,I5,3A)", advance = "no") prt%nr, TAB, TAB, TAB
	if (prt%is_final ()) then
	write (u, "(1x,I5,1x,A)", advance = "no") prt%type, TAB // TAB
	else
	write (u, "('[',I5,']',A)", advance = "no") prt%type, TAB // TAB
	end if
	if (associated (prt%parent)) then
	write (u, "(I5,A)", advance = "no") prt%parent%nr, TAB // TAB
	else
	write (u, "(5x,2A)", advance = "no") TAB, TAB
	end if
	write (u, "(4(ES12.5,A))") prt%momentum%p(0), TAB, &
	prt%momentum%p(1), TAB, &
	prt%momentum%p(2), TAB, &
	prt%momentum%p(3)
	write (u, "(1x,9A)") "<p4square>", TAB // TAB, "<t>", TAB // TAB, &
	"<scale>", TAB // TAB, "<c1>", TAB, "<c2>", TAB, "<mass2>"
	write (u, "(1x,3(ES12.5,A))", advance = "no") &
	prt%momentum ** 2, TAB // TAB, prt%t, TAB, prt%scale, TAB, prt%mass2
	write (u, "(2(I4,A))") prt%c1, TAB, prt%c2, TAB
	if (prt%is_branched ()) then
	if (prt%belongstoFSR) then
	write (u, "(1x,9A)") "costheta(prt)", TAB, &
	"costheta_correct(prt)", TAB, &
	"prt%costheta", TAB, "prt%z", TAB, &
	"costheta_motherfirst(prt)"
	write (u, "(1X,5(ES12.5,A))") &
	prt%get_costheta (), TAB, &
	prt%get_costheta_mass (), TAB // TAB, &
	prt%costheta, TAB, prt%z, TAB, &
	prt%get_costheta_motherfirst (), TAB
	else
	write (u, "(1x,9A)") "prt%z", TAB, "prt%x", TAB, &
	"costheta_correct(prt)", TAB, &
	"prt%costheta", TAB, &
	"costheta_motherfirst(prt)"
	write (u, "(1X,5(ES12.5,A))") &
	prt%z, TAB, prt%x, TAB, &
	prt%get_costheta_mass (), TAB, &
	prt%costheta, TAB, &
	prt%get_costheta_motherfirst (), TAB
	end if
	else
	if (prt%belongstoFSR) then
	write (u, "(1X,A)") "not branched."
	else
	write (u, "(1X,A,ES12.5)") "not branched. x = ", prt%x
	end if
	end if
	write (u, "(A)", advance = "no") " Parton"
	if (prt%belongstoFSR) then
	write (u, "(A)", advance = "no") " is FSR,"
	else
	if (associated (prt%initial)) then
	write (u, "(A,I1)", advance = "no") " from hadron,", prt%initial%nr
	else
	write (u, "(A)", advance = "no") ""
	end if
	end if
	if (prt%is_final ()) then
	write (u, "(A)", advance = "no") " is final,"
	else
	write (u, "(A)", advance = "no") ""
	end if
	if (prt%simulated) then
	write (u, "(A)", advance = "no") " is simulated,"
	else
	write (u, "(A)", advance = "no") ""
	end if
	if (associated (prt%child1) .and. associated (prt%child2)) then
	write (u, "(A,2(I5),A)", advance = "no") &
	" has children: ", prt%child1%nr, prt%child2%nr, ","
	else if (associated (prt%child1)) then
	write (u, "(A,1(I5),A)", advance = "no") &
	" has one child: ", prt%child1%nr, ", "
	end if
	if (prt%belongstointeraction) then
	write (u, "(A,I2)") " belongs to interaction ", &
	prt%interactionnr
	else
	write (u, "(A,I2)") " does not belong to interaction ", &
	prt%interactionnr
	end if
	write (u,"(A)") TAB
	end subroutine parton_write

	@ %def parton_write
	@
	<<Shower partons: parton: TBP>>=
	procedure :: is_final => parton_is_final
	<<Shower partons: procedures>>=
	elemental function parton_is_final (prt) result (is_final)
	class(parton_t), intent(in) :: prt
	logical :: is_final
	is_final = .false.
	if (prt%belongstoFSR) then
	is_final = .not. associated (prt%child1) .and. &
	(.not. prt%belongstointeraction .or. &
	(prt%belongstointeraction .and. prt%simulated))
	end if
	end function parton_is_final

	@ %def parton_is_final
	@
	<<Shower partons: parton: TBP>>=
	procedure :: is_branched => parton_is_branched
	<<Shower partons: procedures>>=
	elemental function parton_is_branched (prt) result (is_branched)
	class(parton_t), intent(in) :: prt
	logical :: is_branched
	is_branched = associated (prt%child1) .and. associated (prt%child2)
	end function parton_is_branched

	@ %def parton_is_branched
	@
	<<Shower partons: parton: TBP>>=
	procedure :: set_simulated => parton_set_simulated
	<<Shower partons: procedures>>=
	pure subroutine parton_set_simulated (prt, sim)
	class(parton_t), intent(inout) :: prt
	logical, intent(in), optional :: sim
	if (present (sim)) then
	prt%simulated = sim
	else
	prt%simulated = .true.
	end if
	end subroutine parton_set_simulated

	@ %def parton_set_simulated
	@
	<<Shower partons: public>>=
	public :: parton_set_parent
	<<Shower partons: procedures>>=
	subroutine parton_set_parent (prt, parent)
	type(parton_t), intent(inout) :: prt
	type(parton_t), intent(in) , target :: parent
	prt%parent => parent
	end subroutine parton_set_parent

	@ %def parton_set_parent
	@
	<<Shower partons: public>>=
	public :: parton_get_parent
	<<Shower partons: procedures>>=
	function parton_get_parent (prt) result (parent)
	type(parton_t), intent(in) :: prt
	type(parton_t), pointer :: parent
	parent => prt%parent
	end function parton_get_parent

	@ %def parton_get_parent
	@
	<<Shower partons: public>>=
	public :: parton_set_initial
	<<Shower partons: procedures>>=
	subroutine parton_set_initial (prt, initial)
	type(parton_t), intent(inout) :: prt
	type(parton_t), intent(in) , target :: initial
	prt%initial => initial
	end subroutine parton_set_initial

	@ %def parton_set_initial
	@
	<<Shower partons: public>>=
	public :: parton_get_initial
	<<Shower partons: procedures>>=
	function parton_get_initial (prt) result (initial)
	type(parton_t), intent(in) :: prt
	type(parton_t), pointer :: initial
	initial => prt%initial
	end function parton_get_initial

	@ %def parton_get_initial
	@
	<<Shower partons: public>>=
	public :: parton_set_child
	<<Shower partons: procedures>>=
	subroutine parton_set_child (prt, child, i)
	type(parton_t), intent(inout) :: prt
	type(parton_t), intent(in), target :: child
	integer, intent(in) :: i
	if (i == 1) then
	prt%child1 => child
	else
	prt%child2 => child
	end if
	end subroutine parton_set_child

	@ %def parton_set_child
	@
	<<Shower partons: public>>=
	public :: parton_get_child
	<<Shower partons: procedures>>=
	function parton_get_child (prt, i) result (child)
	type(parton_t), pointer :: child
	type(parton_t), intent(in) :: prt
	integer, intent(in) :: i
	child => null ()
	if (i == 1) then
	child => prt%child1
	else
	child => prt%child2
	end if
	end function parton_get_child

	@ %def parton_get_child
	@
	<<Shower partons: parton: TBP>>=
	procedure :: is_quark => parton_is_quark
	<<Shower partons: procedures>>=
	elemental function parton_is_quark (prt) result (is_quark)
	class(parton_t), intent(in) ::prt
	logical :: is_quark
	is_quark = abs (prt%type) <= 6 .and. prt%type /= 0
	end function parton_is_quark

	@ %def parton_is_quark
	@
	<<Shower partons: parton: TBP>>=
	procedure :: is_squark => parton_is_squark
	<<Shower partons: procedures>>=
	elemental function parton_is_squark (prt) result (is_squark)
	class(parton_t), intent(in) ::prt
	logical :: is_squark
	is_squark = ((abs(prt%type) >= 1000001) .and. (abs(prt%type) <= 1000006)) &
	.or. ((abs(prt%type) >= 2000001) .and. (abs(prt%type) <= 2000006))
	end function parton_is_squark

	@ %def parton_is_squark
	@ 9 can be used for gluons in codes for glueballs
	<<Shower partons: parton: TBP>>=
	procedure :: is_gluon => parton_is_gluon
	<<Shower partons: procedures>>=
	elemental function parton_is_gluon (prt) result (is_gluon)
	class(parton_t), intent(in) :: prt
	logical :: is_gluon
	is_gluon = prt%type == GLUON .or. prt%type == 9
	end function parton_is_gluon

	@ %def parton_is_gluon
	@
	<<Shower partons: parton: TBP>>=
	procedure :: is_gluino => parton_is_gluino
	<<Shower partons: procedures>>=
	elemental function parton_is_gluino (prt) result (is_gluino)
	class(parton_t), intent(in) :: prt
	logical :: is_gluino
	is_gluino = prt%type == 1000021
	end function parton_is_gluino

	@ %def parton_is_gluino
	@
	<<Shower partons: parton: TBP>>=
	procedure :: is_proton => parton_is_proton
	<<Shower partons: procedures>>=
	elemental function parton_is_proton (prt) result (is_hadron)
	class(parton_t), intent(in) :: prt
	logical :: is_hadron
	is_hadron = abs (prt%type) == PROTON
	end function parton_is_proton

	@ %def parton_is_proton
	@ TODO: SUSY partons.
	<<Shower partons: parton: TBP>>=
	procedure :: is_colored => parton_is_colored
	<<Shower partons: procedures>>=
	pure function parton_is_colored (parton) result (is_colored)
	logical :: is_colored
	class(parton_t), intent(in) :: parton
	is_colored = parton_is_quark (parton) .or. parton_is_gluon (parton)
	end function parton_is_colored

	@ %def parton_is_colored
	@
	<<Shower partons: parton: TBP>>=
	procedure :: mass => parton_mass
	<<Shower partons: procedures>>=
	elemental function parton_mass (prt) result (mass)
	class(parton_t), intent(in) :: prt
	real(default) :: mass
	mass = mass_type (prt%type, prt%mass2)
	end function parton_mass

	@ %def parton_mass
	@
	<<Shower partons: parton: TBP>>=
	procedure :: mass_squared => parton_mass_squared
	<<Shower partons: procedures>>=
	elemental function parton_mass_squared (prt) result (mass_squared)
	class(parton_t), intent(in) :: prt
	real(default) :: mass_squared
	mass_squared = mass_squared_type (prt%type, prt%mass2)
	end function parton_mass_squared

	@ %def parton_mass_squared
	@
	<<Shower partons: parton: TBP>>=
	procedure :: momentum_to_pythia6 => parton_momentum_to_pythia6
	<<Shower partons: procedures>>=
	pure function parton_momentum_to_pythia6 (prt) result (p)
	real(double), dimension(1:5) :: p
	class(parton_t), intent(in) :: prt
	real(default) :: mass
	!!! gfortran 5.1 complains about 'ELEMENTAL procedure pointer
	!!! component ‘mass’ is not allowed as an actual argument'
	!!! p = prt%momentum%to_pythia6 (prt%mass ())
	mass = prt%mass ()
	p = prt%momentum%to_pythia6 (mass)
	end function parton_momentum_to_pythia6

	@ %def parton_momentum_to_pythia6
	@
	<<Shower partons: public>>=
	public :: P_prt_to_child1
	<<Shower partons: procedures>>=
	function P_prt_to_child1 (prt) result (retvalue)
	type(parton_t), intent(in) :: prt
	real(default) :: retvalue
	retvalue = zero
	if (prt%is_gluon ()) then
	if (prt%child1%is_quark ()) then
	retvalue = P_gqq (prt%z)
	else if (prt%child1%is_gluon ()) then
	retvalue = P_ggg (prt%z) + P_ggg (one - prt%z)
	end if
	else if (prt%is_quark ()) then
	if (prt%child1%is_quark ()) then
	retvalue = P_qqg (prt%z)
	else if (prt%child1%is_gluon ()) then
	retvalue = P_qqg (one - prt%z)
	end if
	end if
	end function P_prt_to_child1

	@ %def P_prt_to_child1
	@ This function returns whether the kinematics of the branching of
	parton [[prt]] into its daughters are allowed or not.
	<<Shower partons: public>>=
	public :: thetabar
	<<Shower partons: procedures>>=
	function thetabar (prt, recoiler, isr_ang, E3out) result (retvalue)
	type(parton_t), intent(inout) :: prt
	type(parton_t), intent(in) :: recoiler
	real(default), intent(out), optional :: E3out
	logical, intent(in) :: isr_ang
	logical :: retvalue
	real(default) :: ctheta, cthetachild1
	real(default) p1, p4, p3, E3, shat

	shat = (prt%child1%momentum + recoiler%momentum)**2
	E3 = 0.5_default * (shat / prt%z -recoiler%t + prt%child1%t - &
	prt%child2%mass_squared ()) / sqrt(shat)
	if (present (E3out)) then
	E3out = E3
	end if
	!!! absolute values of momenta in a 3 -> 1 + 4 branching
	p3 = sqrt (E3**2 - prt%t)
	p1 = sqrt (prt%child1%momentum%p(0)**2 - prt%child1%t)
	p4 = sqrt (max (zero, (E3 - prt%child1%momentum%p(0))**2 &
	- prt%child2%t))
	if (p3 > zero) then
	retvalue = ((p1 + p4 >= p3) .and. (p3 >= abs(p1 - p4)) )
	if (retvalue .and. isr_ang) then
	!!! check angular ordering
	if (associated (prt%child1)) then
	if (associated (prt%child1%child2)) then
	ctheta = (E32 - p12 - p4*2 + prt%t) / (two p1 * p4)
	cthetachild1 = (prt%child1%momentum%p(0)**2 - &
	space_part (prt%child1%child1%momentum)**2 &
	- space_part (prt%child1%child2%momentum)**2 + prt%child1%t) &
	/ (two * space_part (prt%child1%child1%momentum)*1 &
	space_part (prt%child1%child2%momentum)**1)
	retvalue = (ctheta > cthetachild1)
	end if
	end if
	end if
	else
	retvalue = .false.
	end if
	end function thetabar

	@ %def thetabar
	@
	<<Shower partons: public>>=
	public :: parton_apply_costheta
	<<Shower partons: procedures>>=
	recursive subroutine parton_apply_costheta (prt, rng)
	type(parton_t), intent(inout) :: prt
	class(rng_t), intent(inout), allocatable :: rng
	if (debug2_active (D_SHOWER)) then
	print *, "D: parton_apply_costheta for parton " , prt%nr
	print *, 'prt%momentum%p = ', prt%momentum%p
	call msg_debug2 (D_SHOWER, "prt%type", prt%type)
	end if
	prt%z = 0.5_default * (one + prt%get_beta () * prt%costheta)
	if (associated (prt%child1) .and. associated (prt%child2)) then
	if (prt%child1%simulated .and. prt%child2%simulated) then
	prt%z = 0.5_default * (one + (prt%child1%t - prt%child2%t) / &
	prt%t + prt%get_beta () * prt%costheta * &
	sqrt((prt%t - prt%child1%t - prt%child2%t)**2 - &
	4 * prt%child1%t * prt%child2%t) / prt%t)
	if (prt%type /= INTERNAL) then
	prt%child1%momentum%p(0) = prt%z * prt%momentum%p(0)
	prt%child2%momentum%p(0) = (one - prt%z) * prt%momentum%p(0)
	end if
	call prt%generate_ps (rng)
	call parton_apply_costheta (prt%child1, rng)
	call parton_apply_costheta (prt%child2, rng)
	end if
	end if
	end subroutine parton_apply_costheta

	@ %def parton_apply_costheta
	@
	<<Shower partons: public>>=
	public :: parton_apply_lorentztrafo
	<<Shower partons: procedures>>=
	subroutine parton_apply_lorentztrafo (prt, L)
	type(parton_t), intent(inout) :: prt
	type(lorentz_transformation_t), intent(in) :: L
	prt%momentum = L * prt%momentum
	end subroutine parton_apply_lorentztrafo

	@ %def parton_apply_lorentztrafo
	@
	<<Shower partons: public>>=
	public :: parton_apply_lorentztrafo_recursive
	<<Shower partons: procedures>>=
	recursive subroutine parton_apply_lorentztrafo_recursive (prt, L)
	type(parton_t), intent(inout) :: prt
	type(lorentz_transformation_t) ,intent(in) :: L
	if (prt%type /= PROTON .and. prt%type /= BEAM_REMNANT) then
	!!! don't boost hadrons and beam-remnants
	call parton_apply_lorentztrafo (prt, L)
	end if
	if (associated (prt%child1) .and. associated (prt%child2)) then
	if ((space_part_norm (prt%child1%momentum) < eps0) .and. &
	(space_part_norm (prt%child2%momentum) < eps0) .and. &
	(.not. prt%child1%belongstointeraction) .and. &
	(.not. prt%child2%belongstointeraction)) then
	!!! don't boost unevolved timelike partons
	else
	call parton_apply_lorentztrafo_recursive (prt%child1, L)
	call parton_apply_lorentztrafo_recursive (prt%child2, L)
	end if
	else
	if (associated (prt%child1)) then
	call parton_apply_lorentztrafo_recursive (prt%child1, L)
	end if
	if (associated (prt%child2)) then
	call parton_apply_lorentztrafo_recursive (prt%child2, L)
	end if
	end if
	end subroutine parton_apply_lorentztrafo_recursive

	@ %def parton_apply_lorentztrafo_recursive
	@ This takes the three-momentum of a parton and generates
	three-momenta of its children given their energy and virtuality
	<<Shower partons: parton: TBP>>=
	procedure :: generate_ps => parton_generate_ps
	<<Shower partons: procedures>>=
	subroutine parton_generate_ps (prt, rng)
	class(parton_t), intent(inout) :: prt
	class(rng_t), intent(inout), allocatable :: rng
	real(default), dimension(1:3, 1:3) :: directions
	integer i,j
	real(default) :: scproduct, pabs, p1abs, p2abs, x, ptabs, phi
	real(default), dimension(1:3) :: momentum
	type(vector3_t) :: pchild1_direction
	type(lorentz_transformation_t) :: L, rotation
	if (debug2_active (D_SHOWER)) print *, "D: parton_generate_ps for parton " , prt%nr
	if (debug_active (D_SHOWER)) then
	if (.not. (associated (prt%child1) .and. associated (prt%child2))) then
	call msg_fatal ("no children for generate_ps")
	end if
	end if
	!!! test if parton is a virtual parton from the imagined parton shower history
	if (prt%type == INTERNAL) then
	L = inverse (boost (prt%momentum, sqrt(prt%t)))
	!!! boost to restframe of mother
	call parton_apply_lorentztrafo (prt, L)
	call parton_apply_lorentztrafo (prt%child1, L)
	call parton_apply_lorentztrafo (prt%child2, L)
	!!! Store child1's momenta
	pchild1_direction = direction (space_part (prt%child1%momentum))
	!!! Redistribute energy
	prt%child1%momentum%p(0) = (prt%momentum%p(0)**2 - &
	prt%child2%t + prt%child1%t) / (two * prt%momentum%p(0))
	prt%child2%momentum%p(0) = prt%momentum%p(0) - &
	prt%child1%momentum%p(0)

	! rescale momenta and set momenta to be along z-axis
	prt%child1%momentum = vector4_moving (prt%child1%momentum%p(0), &
	vector3_canonical(3) * &
	sqrt(prt%child1%momentum%p(0)**2 - prt%child1%t))
	prt%child2%momentum = vector4_moving (prt%child2%momentum%p(0), &
	- vector3_canonical(3) * &
	sqrt(prt%child2%momentum%p(0)**2 - prt%child2%t))

	!!! rotate so that total momentum is along former total momentum
	rotation = rotation_to_2nd (space_part (prt%child1%momentum), &
	pchild1_direction)
	call parton_apply_lorentztrafo (prt%child1, rotation)
	call parton_apply_lorentztrafo (prt%child2, rotation)

	L = inverse (L) !!! inverse of the boost to restframe of mother
	call parton_apply_lorentztrafo (prt, L)
	call parton_apply_lorentztrafo (prt%child1, L)
	call parton_apply_lorentztrafo (prt%child2, L)
	else
	!!! directions(1,:) -> direction of the parent parton
	if (space_part_norm (prt%momentum) < eps0) return
	directions(1,1:3) = prt%momentum%p(1:3) / space_part_norm (prt%momentum)
	!!! directions(2,:) and directions(3,:) -> two random directions
	!!! perpendicular to the direction of the parent parton
	do j = 2, 3
	call rng%generate (directions(j,:))
	end do
	do i = 2, 3
	scproduct = zero
	do j = 1, i - 1
	scproduct = directions(i,1) * directions(j,1) + &
	directions(i,2) * directions(j,2) + &
	directions(i,3) * directions(j,3)
	directions(i,1) = directions(i,1) - directions(j,1) * scproduct
	directions(i,2) = directions(i,2) - directions(j,2) * scproduct
	directions(i,3) = directions(i,3) - directions(j,3) * scproduct
	end do
	scproduct = directions(i,1)2 + directions(i,2)2 + &
	directions(i,3)**2
	do j = 1, 3
	directions(i,j) = directions(i,j) / sqrt(scproduct)
	end do
	end do
	<<Enforce right-handed system for [[directions]]>>

	pabs = space_part_norm (prt%momentum)
	if ((prt%child1%momentum%p(0)**2 - prt%child1%t < 0) .or. &
	(prt%child2%momentum%p(0)**2 - prt%child2%t < 0)) then
	call msg_debug(D_SHOWER, "generate_ps error at E^2 < t")
	return
	end if
	p1abs = sqrt (prt%child1%momentum%p(0)**2 - prt%child1%t)
	p2abs = sqrt (prt%child2%momentum%p(0)**2 - prt%child2%t)
	x = (pabs2 + p1abs2 - p2abs*2) / (two pabs)
	if (pabs > p1abs + p2abs .or. &
	pabs < abs(p1abs - p2abs)) then
	if (debug_active (D_SHOWER)) then
	print *, "D: parton_generate_ps Dreiecksungleichung error &
	&for parton ", prt%nr, " ", &
	space_part_norm (prt%momentum), " ", p1abs, " ", p2abs
	call prt%write ()
	call prt%child1%write ()
	call prt%child2%write ()
	end if
	return
	end if
	!!! Due to numerical problems transverse momentum could be imaginary ->
	!!! set transverse momentum to zero
	ptabs = sqrt (max (p1abs * p1abs - x * x, zero))
	call rng%generate (phi)
	phi = twopi * phi
	do i = 1, 3
	momentum(i) = x * directions(1,i) + ptabs * &
	(cos(phi) * directions(2,i) + sin(phi) * directions(3,i))
	end do
	prt%child1%momentum%p(1:3) = momentum(1:3)
	do i = 1, 3
	momentum(i) = (space_part_norm (prt%momentum) - x) * directions(1,i) - &
	ptabs * (cos(phi) * directions(2,i) + sin(phi) * directions(3,i))
	end do
	prt%child2%momentum%p(1:3) = momentum(1:3)
	end if
	end subroutine parton_generate_ps

	@ %def parton_generate_ps
	@
	<<Enforce right-handed system for [[directions]]>>=
	if ((directions(1,1) * (directions(2,2) * directions(3,3) - &
	directions(2,3) * directions(3,2)) + &
	directions(1,2) * (directions(2,3) * directions(3,1) - &
	directions(2,1) * directions(3,3)) + &
	directions(1,3) * (directions(2,1) * directions(3,2) - &
	directions(2,2) * directions(3,1))) < 0) then
	directions(3,:) = - directions(3,:)
	end if
	@
	This routine is similar to [[parton_generate_ps]], but now for the
	ISR. It takes the three-momentum of a parton's first child as fixed and
	generates the two remaining three-momenta.
	<<Shower partons: parton: TBP>>=
	procedure :: generate_ps_ini => parton_generate_ps_ini
	<<Shower partons: procedures>>=
	subroutine parton_generate_ps_ini (prt, rng)
	class(parton_t), intent(inout) :: prt
	class(rng_t), intent(inout), allocatable :: rng
	real(default), dimension(1:3, 1:3) :: directions
	integer :: i,j
	real(default) :: scproduct, pabs, p1abs, p2abs, x, ptabs, phi
	real(default), dimension(1:3) :: momentum
	if (debug_active (D_SHOWER)) print *, "D: parton_generate_ps_ini: for parton " , prt%nr
	if (debug_active (D_SHOWER)) then
	if (.not. (associated (prt%child1) .and. associated (prt%child2))) then
	call msg_fatal ("no children for generate_ps")
	end if
	end if

	if (.not. prt%is_proton()) then
	!!! generate ps for normal partons
	do i = 1, 3
	directions(1,i) = prt%child1%momentum%p(i) / &
	space_part_norm(prt%child1%momentum)
	end do
	do j = 2, 3
	call rng%generate (directions(j,:))
	end do
	do i = 2, 3
	scproduct = zero
	do j = 1, i - 1
	scproduct = directions(i,1) * directions(j,1) + &
	directions(i,2) * directions(j,2) + &
	directions(i,3) * directions(j,3)
	directions(i,1) = directions(i,1) - directions(j,1) * scproduct
	directions(i,2) = directions(i,2) - directions(j,2) * scproduct
	directions(i,3) = directions(i,3) - directions(j,3) * scproduct
	end do
	scproduct = directions(i,1)2 + directions(i,2)2 + &
	directions(i,3)**2
	do j = 1, 3
	directions(i,j) = directions(i,j) / sqrt(scproduct)
	end do
	end do
	<<Enforce right-handed system for [[directions]]>>

	pabs = space_part_norm (prt%child1%momentum)
	p1abs = sqrt (prt%momentum%p(0)**2 - prt%t)
	p2abs = sqrt (max(zero, prt%child2%momentum%p(0)**2 - &
	prt%child2%t))

	x = (pabs2 + p1abs2 - p2abs*2) / (two pabs)
	if (debug_active (D_SHOWER)) then
	if (pabs > p1abs + p2abs .or. pabs < abs(p1abs - p2abs)) then
	print *, "error at generate_ps, Dreiecksungleichung for parton ", &
	prt%nr, " ", pabs," ",p1abs," ",p2abs
	call prt%write ()
	call prt%child1%write ()
	call prt%child2%write ()
	call msg_fatal ("parton_generate_ps_ini: Dreiecksungleichung")
	end if
	end if
	if (debug_active (D_SHOWER)) print *, "D: parton_generate_ps_ini: x = ", x
	ptabs = sqrt (p1abs * p1abs - x**2)
	call rng%generate (phi)
	phi = twopi * phi
	do i = 1,3
	momentum(i) = x * directions(1,i) + ptabs * (cos(phi) * &
	directions(2,i) + sin(phi) * directions(3,i))
	end do
	prt%momentum%p(1:3) = momentum
	do i = 1, 3
	momentum(i) = (x - pabs) * directions(1,i) + ptabs * (cos(phi) * &
	directions(2,i) + sin(phi) * directions(3,i))
	end do
	prt%child2%momentum%p(1:3) = momentum(1:3)
	else
	!!! for first partons just set beam remnants momentum
	prt%child2%momentum = prt%momentum - prt%child1%momentum
	end if
	end subroutine parton_generate_ps_ini

	@ %def parton_generate_ps_ini
	@
	\subsection{The analytic FSR}
	<<Shower partons: parton: TBP>>=
	procedure :: next_t_ana => parton_next_t_ana
	<<Shower partons: procedures>>=
	subroutine parton_next_t_ana (prt, rng)
	class(parton_t), intent(inout) :: prt
	class(rng_t), intent(inout), allocatable :: rng
	integer :: gtoqq
	real(default) :: integral, random
	if (signal_is_pending ()) return
	call msg_debug (D_SHOWER, "next_t_ana")
	! check if branchings are possible at all
	if (min (prt%t, prt%momentum%p(0)**2) < &
	prt%mass_squared () + prt%settings%min_virtuality) then
	prt%t = prt%mass_squared ()
	call prt%set_simulated ()
	return
	end if
	integral = zero
	call rng%generate (random)
	do
	call parton_simulate_stept (prt, rng, integral, random, gtoqq, .false.)
	if (prt%simulated) then
	if (prt%is_gluon ()) then
	!!! Abusing the x-variable to store the information to which
	!!! quark flavor the gluon branches (if any)
	prt%x = one * gtoqq + 0.1_default
	!!! x = gtoqq + 0.1 -> int(x) will be the quark flavor or
	!!! zero for g -> gg
	end if
	exit
	end if
	end do
	end subroutine parton_next_t_ana

	@ %def parton_next_t_ana
	@ The shower is actually sensitive to how close we go to the one here.
	<<Shower partons: procedures>>=
	function cmax (prt, tt) result (cmaxx)
	type(parton_t), intent(in) :: prt
	real(default), intent(in), optional :: tt
	real(default) :: t, cost, cmaxx, radicand
	t = prt%t; if (present (tt)) t = tt
	if (associated (prt%parent)) then
	cost = prt%parent%get_costheta ()
	radicand = max(zero, one - &
	t / (prt%get_beta () * prt%momentum%p(0))*2 &
	(one + cost) / (one - cost))
	call msg_debug2 (D_SHOWER, "cmax: sqrt (radicand)", sqrt (radicand))
	cmaxx = min (0.99999_default, sqrt (radicand))
	else
	cmaxx = 0.99999_default
	end if
	end function cmax

	@ %def cmax
	@ Simulation routine. The variable [[lookatsister]] takes constraints
	from the sister parton into account, if not given it is assumed
	[[.true.]]. [[a]] and [[x]] are three-dimensional arrays for values
	used for the integration.
	<<Shower partons: public>>=
	public :: parton_simulate_stept
	<<Shower partons: procedures>>=
	subroutine parton_simulate_stept &
	(prt, rng, integral, random, gtoqq, lookatsister)
	type(parton_t), intent(inout) :: prt
	class(rng_t), intent(inout), allocatable :: rng
	real(default), intent(inout) :: integral
	real(default), intent(inout) :: random
	integer, intent(out) :: gtoqq
	logical, intent(in), optional :: lookatsister

	type(parton_t), pointer :: sister
	real(default) :: tstep, tmin, oldt
	real(default) :: c, cstep
	real(default), dimension(3) :: z, P
	real(default) :: to_integral
	real(default) :: a11,a12,a13,a21,a22,a23
	real(default) :: cmax_t
	real(default) :: temprand
	real(default), dimension(3) :: a, x

	! higher values -> faster but coarser
	real(default), parameter :: tstepfactor = 0.02_default
	real(default), parameter :: tstepmin = 0.5_default
	real(default), parameter :: cstepfactor = 0.8_default
	real(default), parameter :: cstepmin = 0.03_default

	if (signal_is_pending ()) return
	call msg_debug (D_SHOWER, "parton_simulate_stept")
	gtoqq = 111 ! illegal value
	call prt%set_simulated (.false.)

	<<Set [[sister]] if [[lookatsister]] is true or not given>>

	tmin = prt%settings%min_virtuality + prt%mass_squared ()
	if (prt%is_quark ()) then
	to_integral = three pi log(one / random)
	else if (prt%is_gluon ()) then
	to_integral = four pi log(one / random)
	else
	prt%t = prt%mass_squared ()
	call prt%set_simulated ()
	return
	end if

	if (associated (sister)) then
	if (sqrt(prt%t) > sqrt(prt%parent%t) - &
	sqrt(sister%mass_squared ())) then
	prt%t = (sqrt (prt%parent%t) - sqrt (sister%mass_squared ()))**2
	end if
	end if
	if (prt%t > prt%momentum%p(0)**2) then
	prt%t = prt%momentum%p(0)**2
	end if

	if (prt%t <= tmin) then
	prt%t = prt%mass_squared ()
	call prt%set_simulated ()
	return
	end if

	! simulate the branchings between prt%t and prt%t - tstep
	tstep = max(tstepfactor * (prt%t - 0.9_default * tmin), tstepmin)
	cmax_t = cmax(prt)
	c = - cmax_t ! take highest t -> minimal constraint
	cstep = max(cstepfactor * (one - abs(c)), cstepmin)
	! get values at border of "previous" bin -> to be used in first bin
	z(3) = 0.5_default + 0.5_default * get_beta (prt%t - &
	0.5_default * tstep, prt%momentum%p(0)) * c
	if (prt%is_gluon ()) then
	P(3) = P_ggg (z(3)) + P_gqq (z(3)) * number_of_flavors &
	(prt%t, prt%settings%max_n_flavors, prt%settings%min_virtuality)
	else
	P(3) = P_qqg (z(3))
	end if
	a(3) = D_alpha_s_fsr (z(3) * (one - z(3)) * prt%t, &
	prt%settings) * P(3) / (prt%t - 0.5_default * tstep)

	do while (c < cmax_t .and. (integral < to_integral))
	if (signal_is_pending ()) return
	cmax_t = cmax (prt)
	cstep = max (cstepfactor * (one - abs(c)**2), cstepmin)
	if (c + cstep > cmax_t) then
	cstep = cmax_t - c
	end if
	if (cstep < 1E-9_default) then
	!!! reject too small bins
	exit
	end if
	z(1) = z(3)
	z(2) = 0.5_default + 0.5_default * get_beta &
	(prt%t - 0.5_default * tstep, prt%momentum%p(0)) * &
	(c + 0.5_default * cstep)
	z(3) = 0.5_default + 0.5_default * get_beta &
	(prt%t - 0.5_default * tstep, prt%momentum%p(0)) * (c + cstep)
	P(1) = P(3)
	if (prt%is_gluon ()) then
	P(2) = P_ggg(z(2)) + P_gqq(z(2)) * number_of_flavors &
	(prt%t, prt%settings%max_n_flavors, prt%settings%min_virtuality)
	P(3) = P_ggg(z(3)) + P_gqq(z(3)) * number_of_flavors &
	(prt%t, prt%settings%max_n_flavors, prt%settings%min_virtuality)
	else
	P(2) = P_qqg(z(2))
	P(3) = P_qqg(z(3))
	end if
	! get values at borders of the intgral and in the middle
	a(1) = a(3)
	a(2) = D_alpha_s_fsr (z(2) * (one - z(2)) * prt%t, &
	prt%settings) * P(2) / &
	(prt%t - 0.5_default * tstep)
	a(3) = D_alpha_s_fsr (z(3) * (one - z(3)) * prt%t, &
	prt%settings) * P(3) / &
	(prt%t - 0.5_default * tstep)

	!!! a little tricky:
	!!! fit x(1) + x(2)/(1 + c) + x(3)/(1 - c) to these values
	a11 = (one+c+0.5_defaultcstep) (one-c-0.5_default*cstep) - &
	(one-c) * (one+c+0.5_default*cstep)
	a12 = (one-c-0.5_defaultcstep) - (one+c+0.5_defaultcstep) * &
	(one-c) / (one+c)
	a13 = a(2) * (one+c+0.5_defaultcstep) (one-c-0.5_default*cstep) - &
	a(1) * (one-c) * (one+c+0.5_default*cstep)
	a21 = (one+c+cstep) * (one-c-cstep) - (one+c+cstep) * (one-c)
	a22 = (one-c-cstep) - (one+c+cstep) * (one-c) / (one+c)
	a23 = a(3) * (one+c+cstep) * (one-c-cstep) - &
	a(1) * (one-c) * (one+c+cstep)

	x(2) = (a23 - a21 * a13 / a11) / (a22 - a12 * a21 / a11)
	x(1) = (a13 - a12 * x(2)) / a11
	x(3) = a(1) * (one - c) - x(1) * (one - c) - x(2) * (one - c) / (one + c)

	integral = integral + tstep * (x(1) * cstep + x(2) * &
	log((one + c + cstep) / (one + c)) - x(3) * &
	log((one - c - cstep) / (one - c)))

	if (integral > to_integral) then
	oldt = prt%t
	call rng%generate (temprand)
	prt%t = prt%t - temprand * tstep
	call rng%generate (temprand)
	prt%costheta = c + (0.5_default - temprand) * cstep
	call prt%set_simulated ()

	if (prt%t < prt%settings%min_virtuality + prt%mass_squared ()) then
	prt%t = prt%mass_squared ()
	end if
	if (abs(prt%costheta) > cmax_t) then
	! reject branching due to violation of costheta-limits
	call rng%generate (random)
	if (prt%is_quark ()) then
	to_integral = three * pi * log(one / random)
	else if (prt%is_gluon ()) then
	to_integral = four * pi * log(one / random)
	end if
	integral = zero
	prt%t = oldt
	call prt%set_simulated (.false.)
	end if
	if (prt%is_gluon ()) then
	! decide between g->gg and g->qqbar splitting
	z(1) = 0.5_default + 0.5_default * prt%costheta
	call rng%generate (temprand)
	if (P_ggg(z(1)) > temprand * (P_ggg (z(1)) + P_gqq (z(1)) * &
	number_of_flavors(prt%t, prt%settings%max_n_flavors, &
	prt%settings%min_virtuality))) then
	gtoqq = 0
	else
	call rng%generate (temprand)
	gtoqq = 1 + int (temprand * number_of_flavors &
	(prt%t, prt%settings%max_n_flavors, &
	prt%settings%min_virtuality))
	end if
	end if
	else
	c = c + cstep
	end if
	cmax_t = cmax (prt)
	end do
	if (integral <= to_integral) then
	prt%t = prt%t - tstep
	if (prt%t < prt%settings%min_virtuality + prt%mass_squared ()) then
	prt%t = prt%mass_squared ()
	call prt%set_simulated ()
	end if
	end if
	end subroutine parton_simulate_stept

	@ %def parton_simulate_stept
	@
	<<Set [[sister]] if [[lookatsister]] is true or not given>>=
	sister => null()
	SET_SISTER: do
	if (present (lookatsister)) then
	if (.not. lookatsister) then
	exit SET_SISTER
	end if
	end if
	if (prt%nr == prt%parent%child1%nr) then
	sister => prt%parent%child2
	else
	sister => prt%parent%child1
	end if
	exit SET_SISTER
	end do SET_SISTER
	@
	@ From the whole ISR algorithm all functionality has been moved to
	[[shower_core.f90]]. Only [[maxzz]] remains here, because more than
	one module needs to access it.
	<<Shower partons: public>>=
	public :: maxzz
	<<Shower partons: procedures>>=
	function maxzz (shat, s, maxz_isr, minenergy_timelike) result (maxz)
	real(default), intent(in) :: shat, s, minenergy_timelike, maxz_isr
	real(default) :: maxz
	maxz = min (maxz_isr, one - (two * minenergy_timelike * sqrt(shat)) / s)
	end function maxzz

	@ %def maxzz
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Main shower module}
	<<[[shower_core.f90]]>>=
	<<File header>>

	module shower_core

	<<Use kinds with double>>
	<<Use strings>>
	use io_units
	use constants
	use format_utils, only: write_separator
	use numeric_utils
	use diagnostics
	use physics_defs
	use os_interface
	use lorentz
	use sm_physics
	use particles
	use model_data
	use flavors
	use colors
	use subevents
	use pdf
	use rng_base
	use shower_base
	use shower_partons
	use muli, only: muli_t
	use hep_common
	use tauola_interface

	<<Standard module head>>

	<<Shower core: public>>

	<<Shower core: parameters>>

	<<Shower core: types>>

	<<Shower core: interfaces>>

	contains

	<<Shower core: procedures>>

	end module shower_core
	@ %def shower_core
	@
	<<Shower core: public>>=
	public :: shower_interaction_t
	<<Shower core: types>>=
	type :: shower_interaction_t
	type(parton_pointer_t), dimension(:), allocatable :: partons
	end type shower_interaction_t

	type :: shower_interaction_pointer_t
	type(shower_interaction_t), pointer :: i => null ()
	end type shower_interaction_pointer_t

	@ %def shower_interaction_t
	@ %def shower_interaction_pointer_t
	@ The WHIZARD internal shower. Flags distinguish between analytic and
	$k_T$-ordered showers.
	<<Shower core: public>>=
	public :: shower_t
	<<Shower core: types>>=
	type, extends (shower_base_t) :: shower_t
	type(shower_interaction_pointer_t), dimension(:), allocatable :: &
	interactions
	type(parton_pointer_t), dimension(:), allocatable :: partons
	type(muli_t) :: mi
	integer :: next_free_nr
	integer :: next_color_nr
	logical :: valid
	contains
	<<Shower core: shower: TBP>>
	end type shower_t

	@ %def shower_t
	@
	<<Shower core: shower: TBP>>=
	procedure :: init => shower_init
	<<Shower core: procedures>>=
	- subroutine shower_init (shower, settings, taudec_settings, pdf_data)
	+ subroutine shower_init (shower, settings, taudec_settings, pdf_data, os_data)
	class(shower_t), intent(out) :: shower
	type(shower_settings_t), intent(in) :: settings
	type(taudec_settings_t), intent(in) :: taudec_settings
	type(pdf_data_t), intent(in) :: pdf_data
	+ type(os_data_t), intent(in) :: os_data
	call msg_debug (D_SHOWER, "shower_init")
	shower%settings = settings
	shower%taudec_settings = taudec_settings
	+ shower%os_data = os_data
	call shower%pdf_data%init (pdf_data)
	shower%name = "WHIZARD internal"
	call shower%write_msg ()
	end subroutine shower_init

	@ %def shower_init
	@
	<<Shower core: shower: TBP>>=
	procedure :: prepare_new_event => shower_prepare_new_event
	<<Shower core: procedures>>=
	- subroutine shower_prepare_new_event (shower)
	+ subroutine shower_prepare_new_event (shower, fac_scale, alpha_s)
	class(shower_t), intent(inout) :: shower
	+ real(default), intent(in) :: fac_scale, alpha_s
	call shower%cleanup ()
	shower%next_free_nr = 1
	shower%next_color_nr = 1
	if (debug_active (D_SHOWER)) then
	if (allocated (shower%interactions)) then
	call msg_bug ("Shower: creating new shower while old one " // &
	"is still associated (interactions)")
	end if
	if (allocated (shower%partons)) then
	call msg_bug ("Shower: creating new shower while old one " // &
	"is still associated (partons)")
	end if
	end if
	treat_light_quarks_massless = .true.
	treat_duscb_quarks_massless = .false.
	shower%valid = .true.
	end subroutine shower_prepare_new_event

	@ %def shower_prepare_new_event
	@ It would be better to have the muli type outside of the shower.
	<<Shower core: shower: TBP>>=
	procedure :: activate_multiple_interactions => shower_activate_multiple_interactions
	<<Shower core: procedures>>=
	- subroutine shower_activate_multiple_interactions (shower, os_data)
	+ subroutine shower_activate_multiple_interactions (shower)
	class(shower_t), intent(inout) :: shower
	- type(os_data_t), intent(in) :: os_data
	if (shower%mi%is_initialized ()) then
	call shower%mi%restart ()
	else
	call shower%mi%initialize (&
	GeV2_scale_cutoff=shower%settings%min_virtuality, &
	GeV2_s=shower_interaction_get_s &
	(shower%interactions(1)%i), &
	- muli_dir=char(os_data%whizard_mulipath))
	+ muli_dir=char(shower%os_data%whizard_mulipath))
	end if
	call shower%mi%apply_initial_interaction ( &
	GeV2_s=shower_interaction_get_s(shower%interactions(1)%i), &
	x1=shower%interactions(1)%i%partons(1)%p%parent%x, &
	x2=shower%interactions(1)%i%partons(2)%p%parent%x, &
	pdg_f1=shower%interactions(1)%i%partons(1)%p%parent%type, &
	pdg_f2=shower%interactions(1)%i%partons(2)%p%parent%type, &
	n1=shower%interactions(1)%i%partons(1)%p%parent%nr, &
	n2=shower%interactions(1)%i%partons(2)%p%parent%nr)
	end subroutine shower_activate_multiple_interactions

	@ %def shower_activate_multiple_interactions
	@
	@
	<<Shower core: shower: TBP>>=
	procedure :: import_particle_set => shower_import_particle_set
	<<Shower core: procedures>>=
	- subroutine shower_import_particle_set (shower, particle_set, os_data, scale)
	+ subroutine shower_import_particle_set (shower, particle_set)
	class(shower_t), target, intent(inout) :: shower
	type(particle_set_t), intent(in) :: particle_set
	- type(os_data_t), intent(in) :: os_data
	- real(default), intent(in) :: scale
	!integer, dimension(:), allocatable :: connections
	type(parton_t), dimension(:), allocatable, target, save :: partons, hadrons
	type(parton_pointer_t), dimension(:), allocatable :: &
	parton_pointers
	integer :: n_beam, n_in, n_out, n_tot
	integer :: i, j, nr, max_color_nr
	call msg_debug (D_SHOWER, 'shower_import_particle_set')
	call count_and_allocate ()
	call setup_hadrons_from_particle_set ()
	call setup_partons_from_particle_set ()
	call shower%update_max_color_nr (1 + max_color_nr)
	call shower%add_interaction_2ton (parton_pointers)
	if (shower%settings%muli_active) then
	- call shower%activate_multiple_interactions (os_data)
	+ call shower%activate_multiple_interactions ()
	end if
	call msg_debug2 (D_SHOWER, 'shower%write() after shower_import_particle_set')
	if (debug2_active (D_SHOWER)) then
	call shower%write ()
	end if
	contains
	<<Shower core: shower import particle set: procedures>>
	end subroutine shower_import_particle_set

	@ %def shower_import_particle_set
	<<Shower core: shower import particle set: procedures>>=
	subroutine count_and_allocate ()
	max_color_nr = 0
	n_beam = particle_set%get_n_beam ()
	n_in = particle_set%get_n_in ()
	n_out = particle_set%get_n_out ()
	n_tot = particle_set%get_n_tot ()
	if (allocated (partons)) deallocate (partons)
	allocate (partons (n_in + n_out))
	allocate (parton_pointers (n_in+n_out))
	end subroutine count_and_allocate

	@
	<<Shower core: shower import particle set: procedures>>=
	subroutine setup_hadrons_from_particle_set ()
	j = 0
	!!! !!! !!! Workaround for Portland 16.1 compiler bug
	!!! if (n_beam > 0 .and. all (particle_set%prt(1:2)%flv%get_pdg_abs () > TAU)) then
	if (n_beam > 0 .and. particle_set%prt(1)%flv%get_pdg_abs () > TAU .and. &
	particle_set%prt(2)%flv%get_pdg_abs () > TAU) then
	call msg_debug (D_SHOWER, 'Copy hadrons from particle_set to hadrons')
	if (.not. allocated (hadrons)) allocate (hadrons (1:2))
	do i = 1, n_tot
	if (particle_set%prt(i)%status == PRT_BEAM) then
	j = j + 1
	nr = shower%get_next_free_nr ()
	hadrons(j) = parton_of_particle (particle_set%prt(i), nr)
	hadrons(j)%settings => shower%settings
	max_color_nr = max (max_color_nr, abs(hadrons(j)%c1), &
	abs(hadrons(j)%c2))
	end if
	end do
	end if
	end subroutine setup_hadrons_from_particle_set

	@
	<<Shower core: shower import particle set: procedures>>=
	subroutine setup_partons_from_particle_set ()
	integer, dimension(1) :: parent
	j = 0
	call msg_debug (D_SHOWER, "Copy partons from particle_set to partons")
	do i = 1, n_tot
	if (particle_set%prt(i)%get_status () == PRT_INCOMING .or. &
	particle_set%prt(i)%get_status () == PRT_OUTGOING) then
	j = j + 1
	nr = shower%get_next_free_nr ()
	partons(j) = parton_of_particle (particle_set%prt(i), nr)
	partons(j)%settings => shower%settings
	parton_pointers(j)%p => partons(j)
	max_color_nr = max (max_color_nr, abs (partons(j)%c1), &
	abs (partons(j)%c2))
	if (particle_set%prt(i)%get_status () == PRT_INCOMING .and. &
	particle_set%prt(i)%get_n_parents () == 1 .and. &
	allocated (hadrons)) then
	parent = particle_set%prt(i)%get_parents ()
	partons(j)%initial => hadrons (parent(1))
	partons(j)%x = space_part_norm (partons(j)%momentum) / &
	space_part_norm (partons(j)%initial%momentum)
	end if
	end if
	end do
	end subroutine setup_partons_from_particle_set

	@
	<<Shower core: shower: TBP>>=
	procedure :: generate_emissions => shower_generate_emissions
	<<Shower core: procedures>>=
	subroutine shower_generate_emissions &
	(shower, valid, number_of_emissions)
	class(shower_t), intent(inout), target :: shower
	logical, intent(out) :: valid
	integer, optional, intent(in) :: number_of_emissions

	type(parton_t), dimension(:), allocatable, target :: partons
	type(parton_pointer_t), dimension(:), allocatable :: &
	parton_pointers
	real(default) :: mi_scale, ps_scale, shat, phi
	type(parton_pointer_t) :: temppp
	integer :: i, j, k
	integer :: n_int, max_color_nr
	integer, dimension(2,4) :: color_corr
	call msg_debug (D_SHOWER, "shower_generate_emissions")
	if (shower%settings%isr_active) then
	call msg_debug (D_SHOWER, "Generate ISR with FSR")
	i = 0
	BRANCHINGS: do
	i = i + 1
	if (signal_is_pending ()) return
	if (shower%settings%muli_active) then
	call shower%mi%generate_gev2_pt2 &
	(shower%get_ISR_scale (), mi_scale)
	else
	mi_scale = 0.0
	end if

	!!! Shower: debugging
	!!! shower%generate_next_isr_branching returns a pointer to
	!!! the parton with the next ISR-branching, this parton's
	!!! scale is the scale of the next branching
	! temppp=shower%generate_next_isr_branching_veto ()
	temppp = shower%generate_next_isr_branching ()

	if (.not. associated (temppp%p) .and. &
	mi_scale < shower%settings%min_virtuality) then
	exit BRANCHINGS
	end if
	!!! check if branching or interaction occurs next
	if (associated (temppp%p)) then
	ps_scale = abs(temppp%p%t)
	else
	ps_scale = 0._default
	end if
	if (mi_scale > ps_scale) then
	!!! discard branching evolution lower than mi_scale
	call shower%set_max_ISR_scale (mi_scale)
	if (associated (temppp%p)) &
	call temppp%p%set_simulated (.false.)

	!!! execute new interaction
	deallocate (partons)
	deallocate (parton_pointers)
	allocate (partons(1:4))
	allocate (parton_pointers(1:4))
	do j = 1, 4
	partons(j)%nr = shower%get_next_free_nr ()
	partons(j)%belongstointeraction = .true.
	parton_pointers(j)%p => partons(j)
	end do
	call shower%mi%generate_partons (partons(1)%nr, partons(2)%nr, &
	partons(1)%x, partons(2)%x, &
	partons(1)%type, partons(2)%type, &
	partons(3)%type, partons(4)%type)
	!!! calculate momenta
	shat = partons(1)%x partons(2)%x &
	shower_interaction_get_s (shower%interactions(1)%i)
	partons(1)%momentum = [0.5_default * sqrt(shat), &
	zero, zero, 0.5_default*sqrt(shat)]
	partons(2)%momentum = [0.5_default * sqrt(shat), &
	zero, zero, -0.5_default*sqrt(shat)]
	call parton_set_initial (partons(1), &
	shower%interactions(1)%i%partons(1)%p%initial)
	call parton_set_initial (partons(2), &
	shower%interactions(1)%i%partons(2)%p%initial)
	partons(1)%belongstoFSR = .false.
	partons(2)%belongstoFSR = .false.
	!!! calculate color connection
	call shower%mi%get_color_correlations &
	(shower%get_next_color_nr (), &
	max_color_nr,color_corr)
	call shower%update_max_color_nr (max_color_nr)

	partons(1)%c1 = color_corr(1,1)
	partons(1)%c2 = color_corr(2,1)
	partons(2)%c1 = color_corr(1,2)
	partons(2)%c2 = color_corr(2,2)
	partons(3)%c1 = color_corr(1,3)
	partons(3)%c2 = color_corr(2,3)
	partons(4)%c1 = color_corr(1,4)
	partons(4)%c2 = color_corr(2,4)

	call shower%rng%generate (phi)
	phi = 2 * pi * phi
	partons(3)%momentum = [0.5_default*sqrt(shat), &
	sqrt(mi_scale)*cos(phi), &
	sqrt(mi_scale)*sin(phi), &
	sqrt(0.25_default*shat - mi_scale)]
	partons(4)%momentum = [ 0.5_default*sqrt(shat), &
	-sqrt(mi_scale)*cos(phi), &
	-sqrt(mi_scale)*sin(phi), &
	-sqrt(0.25_default*shat - mi_scale)]
	partons(3)%belongstoFSR = .true.
	partons(4)%belongstoFSR = .true.

	call shower%add_interaction_2ton (parton_pointers)
	n_int = size (shower%interactions)
	do k = 1, 2
	call shower%mi%replace_parton &
	(shower%interactions(n_int)%i%partons(k)%p%initial%nr, &
	shower%interactions(n_int)%i%partons(k)%p%nr, &
	shower%interactions(n_int)%i%partons(k)%p%parent%nr, &
	shower%interactions(n_int)%i%partons(k)%p%type, &
	shower%interactions(n_int)%i%partons(k)%p%x, &
	mi_scale)
	end do
	else
	!!! execute the next branching 'found' in the previous step
	call shower%execute_next_isr_branching (temppp)
	if (shower%settings%muli_active) then
	call shower%mi%replace_parton (temppp%p%initial%nr, &
	temppp%p%child1%nr, temppp%p%nr, &
	temppp%p%type, temppp%p%x, ps_scale)
	end if

	end if
	end do BRANCHINGS

	call shower%generate_fsr_for_isr_partons ()
	else
	if (signal_is_pending ()) return
	call msg_debug (D_SHOWER, "Generate FSR without ISR")
	call shower%simulate_no_isr_shower ()
	end if

	!!! some bookkeeping, needed after the shower is done
	call shower%boost_to_labframe ()
	call shower%generate_primordial_kt ()
	call shower%update_beamremnants ()

	if (shower%settings%fsr_active) then
	do i = 1, size (shower%interactions)
	if (signal_is_pending ()) return
	call shower%interaction_generate_fsr_2ton &
	(shower%interactions(i)%i)
	end do
	else
	call shower%simulate_no_fsr_shower ()
	end if
	call msg_debug (D_SHOWER, "Shower finished:")
	if (debug_active (D_SHOWER)) call shower%write ()

	valid = shower%valid
	!!! clean-up muli: we should finalize the muli pdf sets
	!!! when _all_ runs are done. Not after every event if possible
	! call shower%mi%finalize()
	end subroutine shower_generate_emissions

	@ %def shower_generate_emissions
	@
	<<Shower core: shower: TBP>>=
	procedure :: make_particle_set => shower_make_particle_set
	<<Shower core: procedures>>=
	subroutine shower_make_particle_set &
	(shower, particle_set, model, model_hadrons)
	class(shower_t), intent(in) :: shower
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	class(model_data_t), intent(in), target :: model_hadrons
	call shower%combine_with_particle_set (particle_set, model, &
	model_hadrons)
	if (shower%settings%hadronization_active) then
	call shower%converttopythia ()
	end if
	end subroutine shower_make_particle_set

	@ %def shower_make_particle_set
	@ The parameters of the shower module:
	<<Shower core: parameters>>=
	real(default), save :: alphasxpdfmax = 12._default

	@ %def alphasxpdfmax
	@
	@ In this routine, [[y]] and [[ymin]] are the jet measures, [[w]] and
	[[wmax]] are weights, [[s]] is the kinematic energy squared of the
	interaction. The flag [[isr_is_possible_and_allowed]] checks whether the initial
	parton is set, lepton-hadron collisions are not implemented (yet).

	% TODO: (bcn 2015-04-23) I dont understand the workaround
	As a workaround: as WHIZARD can treat partons as massless, there might
	be partons with $E < m$: if such a parton is found, quarks will be
	treated massless.
	<<Shower core: shower: TBP>>=
	procedure :: add_interaction_2ton => shower_add_interaction_2ton
	<<Shower core: procedures>>=
	subroutine shower_add_interaction_2ton (shower, partons)
	class(shower_t), intent(inout) :: shower
	type(parton_pointer_t), intent(in), dimension(:), allocatable :: partons
	!type(ckkw_pseudo_shower_weights_t), intent(in) :: ckkw_pseudo_weights

	integer :: n_partons, n_out
	integer :: i, j, imin, jmin
	real(default) :: y, ymin
	!real(default) :: w, wmax
	!real(default) :: random, sum
	type(parton_pointer_t), dimension(:), allocatable :: new_partons
	type(parton_t), pointer :: prt
	integer :: n_int
	type(shower_interaction_pointer_t), dimension(:), allocatable :: temp
	type(vector4_t) :: prtmomentum, childmomentum
	logical :: isr_is_possible_and_allowed
	type(lorentz_transformation_t) :: L

	if (signal_is_pending ()) return
	call msg_debug (D_SHOWER, "Add interaction2toN")
	n_partons = size (partons)
	n_out = n_partons - 2
	if (n_out < 2) then
	call msg_bug &
	("Shower core: trying to add a 2-> (something<2) interaction")
	end if

	isr_is_possible_and_allowed = (associated (partons(1)%p%initial) &
	.and. associated (partons(2)%p%initial)) .and. &
	shower%settings%isr_active
	call msg_debug (D_SHOWER, "isr_is_possible_and_allowed", &
	isr_is_possible_and_allowed)

	if (associated (partons(1)%p%initial) .and. &
	partons(1)%p%is_quark ()) then
	if (partons(1)%p%momentum%p(0) < &
	two * partons(1)%p%mass()) then
	if (abs(partons(1)%p%type) < 2) then
	treat_light_quarks_massless = .true.
	else
	treat_duscb_quarks_massless = .true.
	end if
	end if
	end if
	if (associated (partons(2)%p%initial) .and. &
	partons(2)%p%is_quark ()) then
	if (partons(2)%p%momentum%p(0) < &
	two * partons(2)%p%mass()) then
	if (abs(partons(2)%p%type) < 2) then
	treat_light_quarks_massless = .true.
	else
	treat_duscb_quarks_massless = .true.
	end if
	end if
	end if

	<<Add a new interaction to [[shower%interactions]]>>

	if (associated (shower%interactions(n_int)%i%partons(1)%p%initial)) &
	call shower%interactions(n_int)%i%partons(1)%p%initial%set_simulated ()
	if (associated (shower%interactions(n_int)%i%partons(2)%p%initial)) &
	call shower%interactions(n_int)%i%partons(2)%p%initial%set_simulated ()
	if (isr_is_possible_and_allowed) then
	!!! boost to the CMFrame of the incoming partons
	L = boost (-(shower%interactions(n_int)%i%partons(1)%p%momentum + &
	shower%interactions(n_int)%i%partons(2)%p%momentum), &
	(shower%interactions(n_int)%i%partons(1)%p%momentum + &
	shower%interactions(n_int)%i%partons(2)%p%momentum)**1 )
	do i = 1, n_partons
	call parton_apply_lorentztrafo &
	(shower%interactions(n_int)%i%partons(i)%p, L)
	end do
	end if
	do i = 1, size (partons)
	if (signal_is_pending ()) return
	!!! partons are marked as belonging to the hard interaction
	shower%interactions(n_int)%i%partons(i)%p%belongstointeraction &
	= .true.
	shower%interactions(n_int)%i%partons(i)%p%belongstoFSR = i > 2
	shower%interactions(n_int)%i%partons(i)%p%interactionnr = n_int
	!!! include a 2^(i - 1) number as a label for the ckkw clustering
	shower%interactions(n_int)%i%partons(i)%p%ckkwlabel = 2**(i - 1)
	end do

	<<Add partons from [[shower%interactions]] to [[shower%partons]]>>

	if (isr_is_possible_and_allowed) then
	if (shower%settings%isr_pt_ordered) then
	call shower_prepare_for_simulate_isr_pt &
	(shower, shower%interactions(size (shower%interactions))%i)
	else
	call shower_prepare_for_simulate_isr_ana_test &
	(shower, shower%interactions(n_int)%i%partons(1)%p, &
	shower%interactions(n_int)%i%partons(2)%p)
	end if
	end if

	!!! generate pseudo parton shower history and add all partons to
	!!! shower%partons-array
	!!! TODO initial -> initial + final branchings ??
	allocate (new_partons(1:(n_partons - 2)))
	do i = 1, size (new_partons)
	nullify (new_partons(i)%p)
	end do
	do i = 1, size (new_partons)
	new_partons(i)%p => shower%interactions(n_int)%i%partons(i + 2)%p
	end do
	imin = 0
	jmin = 0

	! TODO: (bcn 2015-04-24) make this a clustering step of the matching
	! if (allocated (ckkw_pseudo_weights%weights)) then
	! !<Perform clustering using the CKKW weights>>
	! else
	<<Perform clustering in the usual way>>
	! end if

	!!! set the FSR starting scale for all partons
	do i = 1, size (new_partons)
	!!! the imaginary mother is the only parton remaining in new_partons
	if (.not. associated (new_partons(i)%p)) cycle
	call set_starting_scale (new_partons(i)%p, &
	get_starting_scale (new_partons(i)%p))
	exit
	end do

	contains

	<<Procedures of [[shower_add_interaction_2ton]]>>
	end subroutine shower_add_interaction_2ton

	@ %def shower_add_interaction_2ton
	@
	<<Add a new interaction to [[shower%interactions]]>>=
	if (allocated (shower%interactions)) then
	n_int = size (shower%interactions) + 1
	else
	n_int = 1
	end if
	allocate (temp (1:n_int))
	do i = 1, n_int - 1
	allocate (temp(i)%i)
	temp(i)%i = shower%interactions(i)%i
	end do
	allocate (temp(n_int)%i)
	allocate (temp(n_int)%i%partons(1:n_partons))
	do i = 1, n_partons
	allocate (temp(n_int)%i%partons(i)%p)
	call parton_copy (partons(i)%p, temp(n_int)%i%partons(i)%p)
	end do
	if (allocated (shower%interactions)) deallocate(shower%interactions)
	allocate (shower%interactions(1:n_int))
	do i = 1, n_int
	shower%interactions(i)%i => temp(i)%i
	end do
	deallocate (temp)
	@
	<<Add partons from [[shower%interactions]] to [[shower%partons]]>>=
	if (allocated (shower%partons)) then
	allocate (new_partons(1:size(shower%partons) + &
	size(shower%interactions(n_int)%i%partons)))
	do i = 1, size (shower%partons)
	new_partons(i)%p => shower%partons(i)%p
	end do
	do i = 1, size (shower%interactions(n_int)%i%partons)
	new_partons(size(shower%partons) + i)%p => &
	shower%interactions(n_int)%i%partons(i)%p
	end do
	deallocate (shower%partons)
	else
	allocate (new_partons(1:size(shower%interactions(n_int)%i%partons)))
	do i = 1, size (partons)
	new_partons(i)%p => shower%interactions(n_int)%i%partons(i)%p
	end do
	end if
	allocate (shower%partons(1:size (new_partons)))
	do i = 1, size (new_partons)
	shower%partons(i)%p => new_partons(i)%p
	end do
	deallocate (new_partons)
	@
	<<Perform clustering using the CKKW weights>>=
	CKKW_CLUSTERING: do
	!!! search for the combination with the highest weight
	wmax = zero
	CKKW_OUTER: do i = 1, size (new_partons)
	CKKW_INNER: do j = i + 1, size (new_partons)
	if (.not. associated (new_partons(i)%p)) cycle
	if (.not. associated (new_partons(j)%p)) cycle
	w = ckkw_pseudo_weights%weights(new_partons(i)%p%ckkwlabel + &
	new_partons(j)%p%ckkwlabel)
	if (w > wmax .or. vanishes(wmax)) then
	wmax = w
	imin = i
	jmin = j
	end if
	end do CKKW_INNER
	end do CKKW_OUTER
	if (wmax > zero) then
	call shower%add_parent (new_partons(imin)%p)
	call parton_set_child (new_partons(imin)%p%parent, &
	new_partons(jmin)%p, 2)
	call parton_set_parent (new_partons(jmin)%p, &
	new_partons(imin)%p%parent)
	prt => new_partons(imin)%p%parent
	prt%nr = shower_get_next_free_nr (shower)
	prt%type = INTERNAL

	prt%momentum = new_partons(imin)%p%momentum + &
	new_partons(jmin)%p%momentum
	prt%t = prt%momentum**2

	!!! auxilliary values for the ckkw matching
	!!! for now, randomly choose the type of the intermediate
	prt%ckkwlabel = new_partons(imin)%p%ckkwlabel + &
	new_partons(jmin)%p%ckkwlabel
	sum = zero
	call shower%rng%generate (random)
	CKKW_TYPE: do i = 0, 4
	if (sum + &
	ckkw_pseudo_weights%weights_by_type(prt%ckkwlabel, i) > &
	random * ckkw_pseudo_weights%weights(prt%ckkwlabel) ) then
	prt%ckkwtype = i
	exit ckkw_type
	end if
	sum = sum + &
	ckkw_pseudo_weights%weights_by_type(prt%ckkwlabel, i)
	end do CKKW_TYPE

	!!! TODO -> calculate costheta and store it for
	!!! later use in generate_ps

	if (space_part_norm(prt%momentum) > tiny_10) then
	prtmomentum = prt%momentum
	childmomentum = prt%child1%momentum
	prtmomentum = boost (- prt%get_beta() / &
	sqrt (one - &
	(prt%get_beta ())**2), space_part (prt%momentum) / &
	space_part_norm(prt%momentum)) * prtmomentum
	childmomentum = boost (- prt%get_beta () / &
	sqrt(one - &
	(prt%get_beta ())**2), space_part (prt%momentum) / &
	space_part_norm(prt%momentum)) * childmomentum
	prt%costheta = enclosed_angle_ct(prtmomentum, childmomentum)
	else
	prt%costheta = - one
	end if

	prt%belongstointeraction = .true.
	prt%belongstoFSR = &
	new_partons(imin)%p%belongstoFSR .and. &
	new_partons(jmin)%p%belongstoFSR

	nullify (new_partons(imin)%p)
	nullify (new_partons(jmin)%p)
	new_partons(imin)%p => prt
	else
	exit CKKW_CLUSTERING
	end if
	end do CKKW_CLUSTERING
	@
	<<Perform clustering in the usual way>>=
	CLUSTERING: do
	!!! search for the partons to be clustered together
	ymin = zero
	OUTER: do i = 1, size (new_partons)
	INNER: do j = i + 1, size (new_partons)
	!!! calculate the jet measure
	if (.not.associated (new_partons(i)%p)) cycle INNER
	if (.not.associated (new_partons(j)%p)) cycle INNER
	!if (.not. shower_clustering_allowed &
	!(shower, new_partons, i,j)) &
	!cycle inner
	!!! Durham jet-measure ! don't care about constants
	y = min (new_partons(i)%p%momentum%p(0), &
	new_partons(j)%p%momentum%p(0)) * &
	(one - enclosed_angle_ct &
	(new_partons(i)%p%momentum, &
	new_partons(j)%p%momentum))
	if (y < ymin .or. vanishes(ymin)) then
	ymin = y
	imin = i
	jmin = j
	end if
	end do INNER
	end do OUTER
	if (ymin > zero) then
	call shower%add_parent (new_partons(imin)%p)
	call parton_set_child &
	(new_partons(imin)%p%parent, new_partons(jmin)%p, 2)
	call parton_set_parent &
	(new_partons(jmin)%p, new_partons(imin)%p%parent)
	prt => new_partons(imin)%p%parent
	prt%nr = shower_get_next_free_nr (shower)
	prt%type = INTERNAL

	prt%momentum = new_partons(imin)%p%momentum + &
	new_partons(jmin)%p%momentum
	prt%t = prt%momentum**2
	!!! TODO -> calculate costheta and store it for
	!!! later use in generate_ps

	if (space_part_norm(prt%momentum) > tiny_10) then
	prtmomentum = prt%momentum
	childmomentum = prt%child1%momentum
	prtmomentum = boost (- prt%get_beta () / sqrt(one - &
	(prt%get_beta ())**2), space_part(prt%momentum) / &
	space_part_norm(prt%momentum)) * prtmomentum
	childmomentum = boost (- prt%get_beta() / &
	sqrt(one - &
	(prt%get_beta ())**2), space_part(prt%momentum) / &
	space_part_norm(prt%momentum)) * childmomentum
	prt%costheta = enclosed_angle_ct (prtmomentum, childmomentum)
	else
	prt%costheta = - one
	end if

	prt%belongstointeraction = .true.
	nullify (new_partons(imin)%p)
	nullify (new_partons(jmin)%p)
	new_partons(imin)%p => prt
	else
	exit CLUSTERING
	end if
	end do CLUSTERING
	@
	<<Procedures of [[shower_add_interaction_2ton]]>>=
	recursive subroutine transfer_pointers (destiny, start, prt)
	type(parton_pointer_t), dimension(:), allocatable :: destiny
	integer, intent(inout) :: start
	type(parton_t), pointer :: prt
	destiny(start)%p => prt
	start = start + 1
	if (associated (prt%child1)) then
	call transfer_pointers (destiny, start, prt%child1)
	end if
	if (associated (prt%child2)) then
	call transfer_pointers (destiny, start, prt%child2)
	end if
	end subroutine transfer_pointers

	@
	<<Procedures of [[shower_add_interaction_2ton]]>>=
	recursive function get_starting_scale (prt) result (scale)
	type(parton_t), pointer :: prt
	real(default) :: scale
	scale = huge (scale)
	if (associated (prt%child1) .and. associated (prt%child2)) then
	scale = min(scale, prt%t)
	end if
	if (associated (prt%child1)) then
	scale = min (scale, get_starting_scale (prt%child1))
	end if
	if (associated (prt%child2)) then
	scale = min (scale, get_starting_scale (prt%child2))
	end if
	end function get_starting_scale

	@
	<<Procedures of [[shower_add_interaction_2ton]]>>=
	recursive subroutine set_starting_scale (prt, scale)
	type(parton_t), pointer :: prt
	real(default) :: scale
	if (prt%type /= INTERNAL) then
	if (scale > prt%settings%min_virtuality + prt%mass_squared ()) then
	prt%t = scale
	else
	prt%t = prt%mass_squared ()
	call prt%set_simulated ()
	end if
	end if
	if (associated (prt%child1)) then
	call set_starting_scale (prt%child1, scale)
	end if
	if (associated (prt%child2)) then
	call set_starting_scale (prt%child2, scale)
	end if
	end subroutine set_starting_scale

	@
	<<Shower core: shower: TBP>>=
	procedure :: simulate_no_isr_shower => shower_simulate_no_isr_shower
	<<Shower core: procedures>>=
	subroutine shower_simulate_no_isr_shower (shower)
	class(shower_t), intent(inout) :: shower
	integer :: i, j
	type(parton_t), pointer :: prt
	call msg_debug (D_SHOWER, "shower_simulate_no_isr_shower")
	do i = 1, size (shower%interactions)
	do j = 1, 2
	prt => shower%interactions(i)%i%partons(j)%p
	if (associated (prt%initial)) then
	!!! for virtuality ordered: remove unneeded partons
	if (associated (prt%parent)) then
	if (.not. prt%parent%is_proton ()) then
	if (associated (prt%parent%parent)) then
	if (.not. prt%parent%is_proton ()) then
	call shower_remove_parton_from_partons &
	(shower, prt%parent%parent)
	end if
	end if
	call shower_remove_parton_from_partons &
	(shower, prt%parent)
	end if
	end if
	call parton_set_parent (prt, prt%initial)
	call parton_set_child (prt%initial, prt, 1)
	if (associated (prt%initial%child2)) then
	call shower_remove_parton_from_partons &
	(shower,prt%initial%child2)
	deallocate (prt%initial%child2)
	end if
	call shower%add_child (prt%initial, 2)
	end if
	end do
	end do
	end subroutine shower_simulate_no_isr_shower

	@ %def shower_simulate_no_isr_shower
	@
	<<Shower core: shower: TBP>>=
	procedure :: simulate_no_fsr_shower => shower_simulate_no_fsr_shower
	<<Shower core: procedures>>=
	subroutine shower_simulate_no_fsr_shower (shower)
	class(shower_t), intent(inout) :: shower
	integer :: i, j
	type(parton_t), pointer :: prt
	do i = 1, size (shower%interactions)
	do j = 3, size (shower%interactions(i)%i%partons)
	prt => shower%interactions(i)%i%partons(j)%p
	call prt%set_simulated ()
	prt%scale = zero
	prt%t = prt%mass_squared ()
	end do
	end do
	end subroutine shower_simulate_no_fsr_shower

	@ %def shower_simulate_no_fsr_shower
	@
	<<Shower core: procedures>>=
	subroutine swap_pointers (prtp1, prtp2)
	type(parton_pointer_t), intent(inout) :: prtp1, prtp2
	type(parton_pointer_t) :: prtptemp
	prtptemp%p => prtp1%p
	prtp1%p => prtp2%p
	prtp2%p => prtptemp%p
	end subroutine swap_pointers

	@ %def swap_pointers
	@ This removes emitted timelike partons.
	<<Shower core: procedures>>=
	recursive subroutine shower_remove_parton_from_partons (shower, prt)
	type(shower_t), intent(inout) :: shower
	type(parton_t), pointer :: prt
	integer :: i
	if (.not. prt%belongstoFSR .and. associated (prt%child2)) then
	call shower_remove_parton_from_partons_recursive (shower, prt%child2)
	end if
	do i = 1, size (shower%partons)
	if (associated (shower%partons(i)%p, prt)) then
	shower%partons(i)%p => null()
	! TODO: (bcn 2015-05-05) memory leak here? no deallocation?
	exit
	end if
	if (debug_active (D_SHOWER)) then
	if (i == size (shower%partons)) then
	call msg_bug ("shower_remove_parton_from_partons: parton&
	&to be removed not found")
	end if
	end if
	end do
	end subroutine shower_remove_parton_from_partons

	@ %def shower_remove_parton_from_partons
	@ This removes the parton [[prt]] and all its children.
	<<Shower core: procedures>>=
	recursive subroutine shower_remove_parton_from_partons_recursive (shower, prt)
	type(shower_t), intent(inout) :: shower
	type(parton_t), pointer :: prt
	if (associated (prt%child1)) then
	call shower_remove_parton_from_partons_recursive (shower, prt%child1)
	deallocate (prt%child1)
	end if
	if (associated (prt%child2)) then
	call shower_remove_parton_from_partons_recursive (shower, prt%child2)
	deallocate (prt%child2)
	end if
	call shower_remove_parton_from_partons (shower, prt)
	end subroutine shower_remove_parton_from_partons_recursive

	@ %def shower_remove_parton_from_partons_recursive
	@
	<<Shower core: shower: TBP>>=
	procedure :: sort_partons => shower_sort_partons
	<<Shower core: procedures>>=
	subroutine shower_sort_partons (shower)
	class(shower_t), intent(inout) :: shower
	integer :: i, j, maxsort, size_partons
	logical :: changed
	call msg_debug2 (D_SHOWER, "shower_sort_partons")
	if (.not. allocated (shower%partons)) return
	size_partons = size (shower%partons)
	maxsort = 0
	do i = 1, size_partons
	if (associated (shower%partons(i)%p)) maxsort = i
	end do
	if (signal_is_pending ()) return
	size_partons = size (shower%partons)
	if (size_partons <= 1) return
	do i = 1, maxsort
	if (.not. associated (shower%partons(i)%p)) cycle
	if (.not. shower%settings%isr_pt_ordered) then
	!!! set unsimulated ISR partons to be "typeless" to prevent
	!!! influences from "wrong" masses
	if (.not. shower%partons(i)%p%belongstoFSR .and. &
	.not. shower%partons(i)%p%simulated .and. &
	.not. shower%partons(i)%p%belongstointeraction) then
	shower%partons(i)%p%type = 0
	end if
	end if
	end do
	if (signal_is_pending ()) return
	!!! Just a Bubblesort
	!!! Different algorithms needed for t-ordered and pt^2-ordered shower
	!!! Pt-ordered:
	if (shower%settings%isr_pt_ordered) then
	OUTERDO_PT: do i = 1, maxsort - 1
	changed = .false.
	INNERDO_PT: do j = 1, maxsort - i
	if (.not. associated (shower%partons(j + 1)%p)) cycle
	if (.not. associated (shower%partons(j)%p)) then
	!!! change if j + 1 ist assoaciated and j is not
	call swap_pointers (shower%partons(j), shower%partons(j + 1))
	changed = .true.
	else if (shower%partons(j)%p%scale < &
	shower%partons(j + 1)%p%scale) then
	call swap_pointers (shower%partons(j), shower%partons(j + 1))
	changed = .true.
	else if (nearly_equal(shower%partons(j)%p%scale, &
	shower%partons(j + 1)%p%scale)) then
	if (shower%partons(j)%p%nr > shower%partons(j + 1)%p%nr) then
	call swap_pointers (shower%partons(j), shower%partons(j + 1))
	changed = .true.
	end if
	end if
	end do INNERDO_PT
	if (.not. changed) exit OUTERDO_PT
	end do outerdo_pt
	!!! \|t\|-ordered
	else
	OUTERDO_T: do i = 1, maxsort - 1
	changed = .false.
	INNERDO_T: do j = 1, maxsort - i
	if (.not. associated (shower%partons(j + 1)%p)) cycle
	if (.not. associated (shower%partons(j)%p)) then
	!!! change if j+1 is associated and j isn't
	call swap_pointers (shower%partons(j), shower%partons(j + 1))
	changed = .true.
	else if (.not. shower%partons(j)%p%belongstointeraction .and. &
	shower%partons(j + 1)%p%belongstointeraction) then
	!!! move partons belonging to the interaction to the front
	call swap_pointers (shower%partons(j), shower%partons(j + 1))
	changed = .true.
	else if (.not. shower%partons(j)%p%belongstointeraction .and. &
	.not. shower%partons(j + 1)%p%belongstointeraction ) then
	if (abs (shower%partons(j)%p%t) - &
	shower%partons(j)%p%mass_squared () < &
	abs(shower%partons(j + 1)%p%t) - &
	shower%partons(j + 1)%p%mass_squared ()) then
	call swap_pointers (shower%partons(j), shower%partons(j + 1))
	changed = .true.
	else
	if (nearly_equal(abs (shower%partons(j)%p%t) - &
	shower%partons(j)%p%mass_squared (), &
	abs(shower%partons(j + 1)%p%t) - &
	shower%partons(j + 1)%p%mass_squared ())) then
	if (shower%partons(j)%p%nr > &
	shower%partons(j + 1)%p%nr) then
	call swap_pointers (shower%partons(j), &
	shower%partons(j + 1))
	changed = .true.
	end if
	end if
	end if
	end if
	end do INNERDO_T
	if (.not. changed) exit OUTERDO_T
	end do OUTERDO_T
	end if
	end subroutine shower_sort_partons

	@ %def shower_sort_partons
	@ Deallocate the interaction pointers.
	<<Shower core: shower: TBP>>=
	procedure :: cleanup => shower_cleanup
	<<Shower core: procedures>>=
	subroutine shower_cleanup (shower)
	class(shower_t), intent(inout) :: shower
	integer :: i
	if (allocated (shower%interactions)) then
	do i = 1, size (shower%interactions)
	if (allocated (shower%interactions(i)%i%partons)) &
	deallocate (shower%interactions(i)%i%partons)
	deallocate (shower%interactions(i)%i)
	end do
	deallocate (shower%interactions)
	end if
	if (allocated (shower%partons)) deallocate (shower%partons)
	end subroutine shower_cleanup

	@ %def shower_cleanup
	@ Bookkeeping functions.
	<<Shower core: shower: TBP>>=
	procedure :: get_next_free_nr => shower_get_next_free_nr
	<<Shower core: procedures>>=
	function shower_get_next_free_nr (shower) result (next_number)
	class(shower_t), intent(inout) :: shower
	integer :: next_number
	next_number = shower%next_free_nr
	shower%next_free_nr = shower%next_free_nr + 1
	end function shower_get_next_free_nr

	@ %def shower_get_next_free_nr
	@
	<<Shower core: shower: TBP>>=
	procedure :: update_max_color_nr => shower_update_max_color_nr
	<<Shower core: procedures>>=
	pure subroutine shower_update_max_color_nr (shower, index)
	class(shower_t), intent(inout) :: shower
	integer, intent(in) :: index
	if (index > shower%next_color_nr) then
	shower%next_color_nr = index
	end if
	end subroutine shower_update_max_color_nr

	@ %def shower_update_max_color_nr
	<<Shower core: shower: TBP>>=
	procedure :: get_next_color_nr => shower_get_next_color_nr
	<<Shower core: procedures>>=
	function shower_get_next_color_nr (shower) result (next_color)
	class(shower_t), intent(inout) :: shower
	integer :: next_color
	next_color = shower%next_color_nr
	shower%next_color_nr = shower%next_color_nr + 1
	end function shower_get_next_color_nr

	@ %def shower_get_next_color_nr
	@
	<<Shower core: procedures>>=
	subroutine shower_enlarge_partons_array (shower, custom_length)
	type(shower_t), intent(inout) :: shower
	integer, intent(in), optional :: custom_length
	integer :: i, length, oldlength
	type(parton_pointer_t), dimension(:), allocatable :: tmp_partons
	call msg_debug (D_SHOWER, "shower_enlarge_partons_array")
	if (present(custom_length)) then
	length = custom_length
	else
	length = 10
	end if
	if (debug_active (D_SHOWER)) then
	if (length < 1) then
	call msg_bug ("Shower: no parton_pointers added in shower%partons")
	end if
	end if
	if (allocated (shower%partons)) then
	oldlength = size (shower%partons)
	allocate (tmp_partons(1:oldlength))
	do i = 1, oldlength
	tmp_partons(i)%p => shower%partons(i)%p
	end do
	deallocate (shower%partons)
	else
	oldlength = 0
	end if
	allocate (shower%partons(1:oldlength + length))
	do i = 1, oldlength
	shower%partons(i)%p => tmp_partons(i)%p
	end do
	do i = oldlength + 1, oldlength + length
	shower%partons(i)%p => null()
	end do
	end subroutine shower_enlarge_partons_array

	@ %def shower_enlarge_partons_array
	@
	<<Shower core: shower: TBP>>=
	procedure :: add_child => shower_add_child
	<<Shower core: procedures>>=
	subroutine shower_add_child (shower, prt, child)
	class(shower_t), intent(inout) :: shower
	type(parton_t), pointer :: prt
	integer, intent(in) :: child
	integer :: i, lastfree
	type(parton_pointer_t) :: newprt
	if (child /= 1 .and. child /= 2) then
	call msg_bug ("Shower: Adding child in nonexisting place")
	end if
	allocate (newprt%p)
	newprt%p%nr = shower%get_next_free_nr ()
	!!! add new parton as child
	if (child == 1) then
	prt%child1 => newprt%p
	else
	prt%child2 => newprt%p
	end if
	newprt%p%parent => prt
	if (associated (prt%settings)) then
	newprt%p%settings => prt%settings
	end if
	newprt%p%interactionnr = prt%interactionnr
	!!! add new parton to shower%partons list
	if (associated (shower%partons (size(shower%partons))%p)) then
	call shower_enlarge_partons_array (shower)
	end if
	!!! find last free pointer and let it point to the new parton
	lastfree = 0
	do i = size (shower%partons), 1, -1
	if (.not. associated (shower%partons(i)%p)) then
	lastfree = i
	end if
	end do
	if (lastfree == 0) then
	call msg_bug ("Shower: no free pointers found")
	end if
	shower%partons(lastfree)%p => newprt%p
	end subroutine shower_add_child

	@ %def shower_add_child
	@
	<<Shower core: shower: TBP>>=
	procedure :: add_parent => shower_add_parent
	<<Shower core: procedures>>=
	subroutine shower_add_parent (shower, prt)
	class(shower_t), intent(inout) :: shower
	type(parton_t), intent(inout), target :: prt
	integer :: i, lastfree
	type(parton_pointer_t) :: newprt
	call msg_debug2 (D_SHOWER, "shower_add_parent: for parton nr", prt%nr)
	allocate (newprt%p)
	newprt%p%nr = shower%get_next_free_nr ()
	!!! add new parton as parent
	newprt%p%child1 => prt
	prt%parent => newprt%p
	if (associated (prt%settings)) then
	newprt%p%settings => prt%settings
	end if
	newprt%p%interactionnr = prt%interactionnr
	!!! add new parton to shower%partons list
	if (.not. allocated (shower%partons) .or. &
	associated (shower%partons(size(shower%partons))%p)) then
	call shower_enlarge_partons_array (shower)
	end if
	!!! find last free pointer and let it point to the new parton
	lastfree = 0
	do i = size(shower%partons), 1, -1
	if (.not. associated (shower%partons(i)%p)) then
	lastfree = i
	end if
	end do
	if (debug_active (D_SHOWER)) then
	if (lastfree == 0) then
	call msg_bug ("Shower: no free pointers found")
	end if
	end if
	shower%partons(lastfree)%p => newprt%p
	end subroutine shower_add_parent

	@ %def shower_add_parent
	@ For debugging:
	<<Shower core: procedures>>=
	pure function shower_get_total_momentum (shower) result (mom)
	type(shower_t), intent(in) :: shower
	type(vector4_t) :: mom
	integer :: i
	if (.not. allocated (shower%partons)) return
	mom = vector4_null
	do i = 1, size (shower%partons)
	if (.not. associated (shower%partons(i)%p)) cycle
	if (shower%partons(i)%p%is_final ()) then
	mom = mom + shower%partons(i)%p%momentum
	end if
	end do
	end function shower_get_total_momentum

	@ %def shower_get_total_momentum
	@ Count the number of partons by going through [[shower%partons]]
	whereby you can require a minimum energy [[mine]] and specify whether to
	[[include_remnants]], which is done if not given.
	<<Shower core: shower: TBP>>=
	procedure :: get_nr_of_partons => shower_get_nr_of_partons
	<<Shower core: procedures>>=
	function shower_get_nr_of_partons (shower, mine, &
	include_remnants, no_hard_prts, only_colored) result (nr)
	class(shower_t), intent(in) :: shower
	real(default), intent(in), optional :: mine
	logical, intent(in), optional :: include_remnants, no_hard_prts, &
	only_colored
	logical :: no_hard, only_col, include_rem
	integer :: nr, i
	nr = 0
	no_hard = .false.; if (present (no_hard_prts)) &
	no_hard = no_hard_prts
	only_col = .false.; if (present (only_colored)) &
	only_col = only_colored
	include_rem = .true.; if (present (include_remnants)) &
	include_rem = include_remnants
	do i = 1, size (shower%partons)
	if (.not. associated (shower%partons(i)%p)) cycle
	associate (prt => shower%partons(i)%p)
	if (.not. prt%is_final ()) cycle
	if (present (only_colored)) then
	if (only_col) then
	if (.not. prt%is_colored ()) cycle
	else
	if (prt%is_colored ()) cycle
	end if
	end if
	if (no_hard) then
	if (shower%partons(i)%p%belongstointeraction) cycle
	end if
	if (.not. include_rem) then
	if (prt%type == BEAM_REMNANT) cycle
	end if
	if (present(mine)) then
	if (prt%momentum%p(0) < mine) cycle
	end if
	nr = nr + 1
	end associate
	end do
	end function shower_get_nr_of_partons

	@ %def shower_get_nr_of_partons
	@
	<<Shower core: procedures>>=
	function shower_get_nr_of_final_colored_ME_partons (shower) result (nr)
	type(shower_t), intent(in) :: shower
	integer :: nr
	integer :: i, j
	type(parton_t), pointer :: prt
	nr = 0
	do i = 1, size (shower%interactions)
	do j = 1, size (shower%interactions(i)%i%partons)
	prt => shower%interactions(i)%i%partons(j)%p
	if (.not. associated (prt)) cycle
	if (.not. prt%is_colored ()) cycle
	if (prt%belongstointeraction .and. prt%belongstoFSR .and. &
	(prt%type /= INTERNAL)) then
	nr = nr +1
	end if
	end do
	end do
	end function shower_get_nr_of_final_colored_ME_partons

	@ %def shower_get_nr_of_final_colored_ME_partons
	@
	<<Shower core: shower: TBP>>=
	procedure :: get_final_colored_ME_momenta => &
	shower_get_final_colored_ME_momenta
	<<Shower core: procedures>>=
	subroutine shower_get_final_colored_ME_momenta (shower, momenta)
	class(shower_t), intent(in) :: shower
	type(vector4_t), dimension(:), allocatable, intent(out) :: momenta
	type(parton_pointer_t), dimension(:), allocatable :: partons
	integer :: i, j, index, s
	type(parton_t), pointer :: prt
	s = shower_get_nr_of_final_colored_ME_partons (shower)
	if (s == 0) return
	allocate (partons(1:s))
	allocate (momenta(1:s))
	index = 0
	do i = 1, size (shower%interactions)
	do j = 1, size (shower%interactions(i)%i%partons)
	prt => shower%interactions(i)%i%partons(j)%p
	if (.not. associated (prt)) cycle
	if (.not. prt%is_colored ()) cycle
	if (prt%belongstointeraction .and. prt%belongstoFSR .and. &
	(prt%type /= INTERNAL)) then
	index = index + 1
	partons(index)%p => prt
	end if
	end do
	end do
	do i = 1, s ! pointers forbid array notation
	momenta(i) = partons(i)%p%momentum
	end do
	end subroutine shower_get_final_colored_ME_momenta

	@ %def shower_get_final_colored_ME_momenta
	@
	<<Shower core: procedures>>=
	recursive function interaction_fsr_is_finished_for_parton &
	(prt) result (finished)
	type(parton_t), intent(in) :: prt
	logical :: finished
	if (prt%belongstoFSR) then
	!!! FSR partons
	if (associated (prt%child1)) then
	finished = interaction_fsr_is_finished_for_parton (prt%child1) &
	.and. interaction_fsr_is_finished_for_parton (prt%child2)
	else
	finished = prt%t <= prt%mass_squared ()
	end if
	else
	!!! search for emitted timelike partons in ISR shower
	if (.not. associated (prt%initial)) then
	!!! no inital -> no ISR
	finished = .true.
	else if (.not. associated (prt%parent)) then
	finished = .false.
	else
	if (.not. prt%parent%is_proton ()) then
	if (associated (prt%child2)) then
	finished = interaction_fsr_is_finished_for_parton (prt%parent) .and. &
	interaction_fsr_is_finished_for_parton (prt%child2)
	else
	finished = interaction_fsr_is_finished_for_parton (prt%parent)
	end if
	else
	if (associated (prt%child2)) then
	finished = interaction_fsr_is_finished_for_parton (prt%child2)
	else
	!!! only second partons can come here -> if that happens FSR
	!!! evolution is not existing
	finished = .true.
	end if
	end if
	end if
	end if
	end function interaction_fsr_is_finished_for_parton

	@ %def interaction_fsr_is_finished_for_parton
	@
	<<Shower core: procedures>>=
	function interaction_fsr_is_finished (interaction) result (finished)
	type(shower_interaction_t), intent(in) :: interaction
	logical :: finished
	integer :: i
	finished = .true.
	if (.not. allocated (interaction%partons)) return
	do i = 1, size (interaction%partons)
	if (.not. interaction_fsr_is_finished_for_parton &
	(interaction%partons(i)%p)) then
	finished = .false.
	exit
	end if
	end do
	end function interaction_fsr_is_finished

	@ %def interaction_fsr_is_finished
	@
	<<Shower core: public>>=
	public :: shower_interaction_get_s
	<<Shower core: procedures>>=
	function shower_interaction_get_s (interaction) result (s)
	type(shower_interaction_t), intent(in) :: interaction
	real(default) :: s
	s = (interaction%partons(1)%p%initial%momentum + &
	interaction%partons(2)%p%initial%momentum)**2
	end function shower_interaction_get_s

	@ %def shower_interaction_get_s
	@
	<<Shower core: procedures>>=
	function shower_fsr_is_finished (shower) result (finished)
	type(shower_t), intent(in) :: shower
	logical :: finished
	integer :: i
	finished = .true.
	if (.not. allocated (shower%interactions)) return
	do i = 1, size(shower%interactions)
	if (.not. interaction_fsr_is_finished (shower%interactions(i)%i)) then
	finished = .false.
	exit
	end if
	end do
	end function shower_fsr_is_finished

	@ %def shower_fsr_is_finished
	@
	<<Shower core: procedures>>=
	function shower_isr_is_finished (shower) result (finished)
	type(shower_t), intent(in) :: shower
	logical :: finished
	integer :: i
	type(parton_t), pointer :: prt
	finished = .true.
	if (.not.allocated (shower%partons)) return
	do i = 1, size (shower%partons)
	if (.not. associated (shower%partons(i)%p)) cycle
	prt => shower%partons(i)%p
	if (shower%settings%isr_pt_ordered) then
	if (.not. prt%belongstoFSR .and. .not. prt%simulated &
	.and. prt%scale > zero) then
	finished = .false.
	exit
	end if
	else
	if (.not. prt%belongstoFSR .and. .not. prt%simulated &
	.and. prt%t < zero) then
	finished = .false.
	exit
	end if
	end if
	end do
	end function shower_isr_is_finished

	@ %def shower_isr_is_finished
	@
	<<Shower core: procedures>>=
	subroutine interaction_find_partons_nearest_to_hadron &
	(interaction, prt1, prt2, isr_pt_ordered)
	type(shower_interaction_t), intent(in) :: interaction
	type(parton_t), pointer :: prt1, prt2
	logical, intent(in) :: isr_pt_ordered
	prt1 => null ()
	prt2 => null ()
	prt1 => interaction%partons(1)%p
	do
	if (associated (prt1%parent)) then
	if (prt1%parent%is_proton ()) then
	exit
	else if ((.not. isr_pt_ordered .and. .not. prt1%parent%simulated) &
	.or. (isr_pt_ordered .and. .not. prt1%simulated)) then
	exit
	else
	prt1 => prt1%parent
	end if
	else
	exit
	end if
	end do
	prt2 => interaction%partons(2)%p
	do
	if (associated (prt2%parent)) then
	if (prt2%parent%is_proton ()) then
	exit
	else if ((.not. isr_pt_ordered .and. .not. prt2%parent%simulated) &
	.or. (isr_pt_ordered .and. .not. prt2%simulated)) then
	exit
	else
	prt2 => prt2%parent
	end if
	else
	exit
	end if
	end do
	end subroutine interaction_find_partons_nearest_to_hadron

	@ %def interaction_find_partons_nearest_to_hadron
	@
	<<Shower core: shower: TBP>>=
	procedure :: update_beamremnants => shower_update_beamremnants
	<<Shower core: procedures>>=
	subroutine shower_update_beamremnants (shower)
	class(shower_t), intent(inout) :: shower
	type(parton_t), pointer :: hadron, remnant
	integer :: i
	real(default) :: random
	!!! only proton in first interaction !!?
	!!! currently only first beam-remnant will be updated
	do i = 1,2
	if (associated (shower%interactions(1)%i%partons(i)%p%initial)) then
	hadron => shower%interactions(1)%i%partons(i)%p%initial
	else
	cycle
	end if
	remnant => hadron%child2
	if (associated (remnant)) then
	remnant%momentum = hadron%momentum - hadron%child1%momentum
	end if
	!!! generate flavor of the beam-remnant if beam was proton
	if (abs (hadron%type) == PROTON .and. associated (hadron%child1)) then
	if (hadron%child1%is_quark ()) then
	!!! decide if valence (u,d) or sea quark (s,c,b)
	if ((abs (hadron%child1%type) <= 2) .and. &
	(hadron%type * hadron%child1%type > zero)) then
	!!! valence quark
	if (abs (hadron%child1%type) == 1) then
	!!! if d then remaining diquark is uu_1
	remnant%type = sign (UU1, hadron%type)
	else
	call shower%rng%generate (random)
	!!! if u then remaining diquark is ud_0 or ud_1
	if (random < 0.75_default) then
	remnant%type = sign (UD0, hadron%type)
	else
	remnant%type = sign (UD1, hadron%type)
	end if
	end if
	remnant%c1 = hadron%child1%c2
	remnant%c2 = hadron%child1%c1
	else if ((hadron%type * hadron%child1%type) < zero) then
	!!! antiquark
	if (.not. associated (remnant%child1)) then
	call shower%add_child (remnant, 1)
	end if
	if (.not. associated (remnant%child2)) then
	call shower%add_child (remnant, 2)
	end if
	call shower%rng%generate (random)
	if (random < 0.6666_default) then
	!!! 2/3 into udq + u
	if (abs (hadron%child1%type) == 1) then
	remnant%child1%type = sign (NEUTRON, hadron%type)
	else if (abs (hadron%child1%type) == 2) then
	remnant%child1%type = sign (PROTON, hadron%type)
	else if (abs (hadron%child1%type) == 3) then
	remnant%child1%type = sign (SIGMA0, hadron%type)
	else if (abs (hadron%child1%type) == 4) then
	remnant%child1%type = sign (SIGMACPLUS, hadron%type)
	else if (abs (hadron%child1%type) == 5) then
	remnant%child1%type = sign (SIGMAB0, hadron%type)
	end if
	remnant%child2%type = sign (2, hadron%type)
	else
	!!! 1/3 into uuq + d
	if (abs (hadron%child1%type) == 1) then
	remnant%child1%type = sign (PROTON, hadron%type)
	else if (abs (hadron%child1%type) == 2) then
	remnant%child1%type = sign (DELTAPLUSPLUS, hadron%type)
	else if (abs (hadron%child1%type) == 3) then
	remnant%child1%type = sign (SIGMAPLUS, hadron%type)
	else if (abs (hadron%child1%type) == 4) then
	remnant%child1%type = sign (SIGMACPLUSPLUS, hadron%type)
	else if (abs (hadron%child1%type) == 5) then
	remnant%child1%type = sign (SIGMABPLUS, hadron%type)
	end if
	remnant%child2%type = sign (1, hadron%type)
	end if
	remnant%c1 = hadron%child1%c2
	remnant%c2 = hadron%child1%c1
	remnant%child1%c1 = 0
	remnant%child1%c2 = 0
	remnant%child2%c1 = remnant%c1
	remnant%child2%c2 = remnant%c2
	else
	!!! sea quark
	if (.not. associated (remnant%child1)) then
	call shower%add_child (remnant, 1)
	end if
	if (.not. associated (remnant%child2)) then
	call shower%add_child (remnant, 2)
	end if
	call shower%rng%generate (random)
	if (random < 0.5_default) then
	!!! 1/2 into usbar + ud_0
	if (abs (hadron%child1%type) == 3) then
	remnant%child1%type = sign (KPLUS, hadron%type)
	else if (abs (hadron%child1%type) == 4) then
	remnant%child1%type = sign (D0, hadron%type)
	else if (abs (hadron%child1%type) == 5) then
	remnant%child1%type = sign (BPLUS, hadron%type)
	end if
	remnant%child2%type = sign (UD0, hadron%type)
	else if (random < 0.6666_default) then
	!!! 1/6 into usbar + ud_1
	if (abs (hadron%child1%type) == 3) then
	remnant%child1%type = sign (KPLUS, hadron%type)
	else if (abs (hadron%child1%type) == 4) then
	remnant%child1%type = sign (D0, hadron%type)
	else if (abs (hadron%child1%type) == 5) then
	remnant%child1%type = sign (BPLUS, hadron%type)
	end if
	remnant%child2%type = sign (UD1, hadron%type)
	else
	!!! 1/3 into dsbar + uu_1
	if (abs (hadron%child1%type) == 3) then
	remnant%child1%type = sign (K0, hadron%type)
	else if (abs (hadron%child1%type) == 4) then
	remnant%child1%type = sign (DPLUS, hadron%type)
	else if (abs (hadron%child1%type) == 5) then
	remnant%child1%type = sign (B0, hadron%type)
	end if
	remnant%child2%type = sign (UU1, hadron%type)
	end if
	remnant%c1 = hadron%child1%c2
	remnant%c2 = hadron%child1%c1
	remnant%child1%c1 = 0
	remnant%child1%c2 = 0
	remnant%child2%c1 = remnant%c1
	remnant%child2%c2 = remnant%c2
	end if
	else if (hadron%child1%is_gluon ()) then
	if (.not.associated (remnant%child1)) then
	call shower%add_child (remnant, 1)
	end if
	if (.not.associated (remnant%child2)) then
	call shower%add_child (remnant, 2)
	end if
	call shower%rng%generate (random)
	if (random < 0.5_default) then
	!!! 1/2 into u + ud_0
	remnant%child1%type = sign (2, hadron%type)
	remnant%child2%type = sign (UD0, hadron%type)
	else if (random < 0.6666_default) then
	!!! 1/6 into u + ud_1
	remnant%child1%type = sign (2, hadron%type)
	remnant%child2%type = sign (UD1, hadron%type)
	else
	!!! 1/3 into d + uu_1
	remnant%child1%type = sign (1, hadron%type)
	remnant%child2%type = sign (UU1, hadron%type)
	end if
	remnant%c1 = hadron%child1%c2
	remnant%c2 = hadron%child1%c1
	if (hadron%type > 0) then
	remnant%child1%c1 = remnant%c1
	remnant%child2%c2 = remnant%c2
	else
	remnant%child1%c2 = remnant%c2
	remnant%child2%c1 = remnant%c1
	end if
	end if
	remnant%initial => hadron
	if (associated (remnant%child1)) then
	remnant%child1%initial => hadron
	remnant%child2%initial => hadron
	!!! don't care about on-shellness for now
	remnant%child1%momentum = 0.5_default * remnant%momentum
	remnant%child2%momentum = 0.5_default * remnant%momentum
	!!! but care about on-shellness for baryons
	if (mod (remnant%child1%type, 100) >= 10) then
	!!! check if the third quark is set -> meson or baryon
	remnant%child1%t = remnant%child1%mass_squared ()
	remnant%child1%momentum = [remnant%child1%momentum%p(0), &
	(remnant%child1%momentum%p(1:3) / &
	remnant%child1%momentum%p(1:3)*1) &
	sqrt (remnant%child1%momentum%p(0)**2 - remnant%child1%t)]
	remnant%child2%momentum = remnant%momentum &
	- remnant%child1%momentum
	end if
	end if
	end if
	end do
	end subroutine shower_update_beamremnants

	@ %def shower_update_beamremnants
	@
	<<Shower core: procedures>>=
	subroutine interaction_apply_lorentztrafo (interaction, L)
	type(shower_interaction_t), intent(inout) :: interaction
	type(lorentz_transformation_t), intent(in) :: L
	type(parton_t), pointer :: prt
	integer :: i
	!!! ISR part
	do i = 1,2
	prt => interaction%partons(i)%p
	!!! loop over ancestors
	MOTHERS: do
	!!! boost parton
	call parton_apply_lorentztrafo (prt, L)
	if (associated (prt%child2)) then
	!!! boost emitted timelike parton (and daughters)
	call parton_apply_lorentztrafo_recursive (prt%child2, L)
	end if
	if (associated (prt%parent)) then
	if (.not. prt%parent%is_proton ()) then
	prt => prt%parent
	else
	exit
	end if
	else
	exit
	end if
	end do MOTHERS
	end do
	!!! FSR part
	if (associated (interaction%partons(3)%p%parent)) then
	!!! pseudo Parton-Shower histora has been generated -> find
	!!! mother and go on from there recursively
	prt => interaction%partons(3)%p
	do while (associated (prt%parent))
	prt => prt%parent
	end do
	call parton_apply_lorentztrafo_recursive (prt, L)
	else
	do i = 3, size (interaction%partons)
	call parton_apply_lorentztrafo (interaction%partons(i)%p, L)
	end do
	end if
	end subroutine interaction_apply_lorentztrafo

	@ %def interaction_apply_lorentztrafo
	@
	<<Shower core: procedures>>=
	subroutine shower_apply_lorentztrafo (shower, L)
	type(shower_t), intent(inout) :: shower
	type(lorentz_transformation_t), intent(in) :: L
	integer :: i
	do i = 1, size (shower%interactions)
	call interaction_apply_lorentztrafo (shower%interactions(i)%i, L)
	end do
	end subroutine shower_apply_lorentztrafo

	@ %def shower_apply_lorentztrafo
	@ This boosts partons belonging to the interaction to the
	center-of-mass frame of its partons nearest to the hadron.
	<<Shower core: procedures>>=
	subroutine interaction_boost_to_CMframe (interaction, isr_pt_ordered)
	type(shower_interaction_t), intent(inout) :: interaction
	logical, intent(in) :: isr_pt_ordered
	type(vector4_t) :: beta
	type(parton_t), pointer :: prt1, prt2
	call interaction_find_partons_nearest_to_hadron &
	(interaction, prt1, prt2, isr_pt_ordered)
	beta = prt1%momentum + prt2%momentum
	beta = beta / beta%p(0)
	if (debug_active (D_SHOWER)) then
	if (beta**2 > one) then
	call msg_error ("Shower: boost to CM frame: beta > 1")
	return
	end if
	end if
	if (space_part(beta)**2 > tiny_13) then
	call interaction_apply_lorentztrafo (interaction, &
	boost(space_part(beta)**1 / &
	sqrt (one - space_part(beta)**2), -direction(beta)))
	end if
	end subroutine interaction_boost_to_CMframe

	@ %def interaction_boost_to_CMframe
	@ This boosts every interaction to the center-of-mass-frame of its
	partons nearest to the hadron.
	<<Shower core: shower: TBP>>=
	procedure :: boost_to_CMframe => shower_boost_to_CMframe
	<<Shower core: procedures>>=
	subroutine shower_boost_to_CMframe (shower)
	class(shower_t), intent(inout) :: shower
	integer :: i
	do i = 1, size (shower%interactions)
	call interaction_boost_to_CMframe &
	(shower%interactions(i)%i, shower%settings%isr_pt_ordered)
	end do
	! TODO: (bcn 2015-03-23) this shouldnt be here !
	call shower%update_beamremnants ()
	end subroutine shower_boost_to_CMframe

	@ %def shower_boost_to_CMframe
	@ This boost all partons so that initial partons have their assigned
	$x$-value.
	<<Shower core: shower: TBP>>=
	procedure :: boost_to_labframe => shower_boost_to_labframe
	<<Shower core: procedures>>=
	subroutine shower_boost_to_labframe (shower)
	class(shower_t), intent(inout) :: shower
	integer :: i
	do i = 1, size (shower%interactions)
	call interaction_boost_to_labframe &
	(shower%interactions(i)%i, shower%settings%isr_pt_ordered)
	end do
	end subroutine shower_boost_to_labframe

	@ %def shower_boost_to_labframe
	@ This boosts all partons so that initial partons have their
	assigned $x$-value.
	<<Shower core: procedures>>=
	subroutine interaction_boost_to_labframe (interaction, isr_pt_ordered)
	type(shower_interaction_t), intent(inout) :: interaction
	logical, intent(in) :: isr_pt_ordered
	type(parton_t), pointer :: prt1, prt2
	type(vector3_t) :: beta
	call interaction_find_partons_nearest_to_hadron &
	(interaction, prt1, prt2, isr_pt_ordered)
	if (.not. associated (prt1%initial) .or. .not. &
	associated (prt2%initial)) then
	return
	end if
	!!! transform partons to overall labframe.
	beta = vector3_canonical(3) * &
	((prt1%x * prt2%momentum%p(0) - &
	prt2%x * prt1%momentum%p(0)) / &
	(prt1%x * prt2%momentum%p(3) - &
	prt2%x * prt1%momentum%p(3)))
	if (beta**1 > tiny_10) &
	call interaction_apply_lorentztrafo (interaction, &
	boost (beta1 / sqrt(one - beta2), -direction(beta)))
	end subroutine interaction_boost_to_labframe

	@ %def interaction_boost_to_labframe
	@ Only rotate to z if inital hadrons are given (and they are assumed
	to be aligned along the z-axis).
	<<Shower core: procedures>>=
	subroutine interaction_rotate_to_z (interaction, isr_pt_ordered)
	type(shower_interaction_t), intent(inout) :: interaction
	logical, intent(in) :: isr_pt_ordered
	type(parton_t), pointer :: prt1, prt2
	call interaction_find_partons_nearest_to_hadron &
	(interaction, prt1, prt2, isr_pt_ordered)
	if (associated (prt1%initial)) then
	call interaction_apply_lorentztrafo (interaction, &
	rotation_to_2nd (space_part (prt1%momentum), &
	vector3_canonical(3) * sign (one, &
	prt1%initial%momentum%p(3))))
	end if
	end subroutine interaction_rotate_to_z

	@ %def interaction_rotate_to_z
	@ Rotate initial partons to lie along $\pm z$ axis.
	<<Shower core: shower: TBP>>=
	procedure :: rotate_to_z => shower_rotate_to_z
	<<Shower core: procedures>>=
	subroutine shower_rotate_to_z (shower)
	class(shower_t), intent(inout) :: shower
	integer :: i
	do i = 1, size (shower%interactions)
	call interaction_rotate_to_z &
	(shower%interactions(i)%i, shower%settings%isr_pt_ordered)
	end do
	! TODO: (bcn 2015-03-23) this shouldnt be here !
	call shower%update_beamremnants ()
	end subroutine shower_rotate_to_z

	@ %def shower_rotate_to_z
	@ Return if there are no initials, electron-hadron collision not
	implemented.
	<<Shower core: procedures>>=
	subroutine interaction_generate_primordial_kt &
	(interaction, primordial_kt_width, primordial_kt_cutoff, rng)
	type(shower_interaction_t), intent(inout) :: interaction
	real(default), intent(in) :: primordial_kt_width, primordial_kt_cutoff
	class(rng_t), intent(inout), allocatable :: rng
	type(parton_t), pointer :: had1, had2
	type(vector4_t) :: momenta(2)
	type(vector3_t) :: beta
	real(default) :: pt (2), phi(2)
	real(default) :: shat
	real(default) :: btheta, bphi
	integer :: i
	if (vanishes (primordial_kt_width)) return
	if (.not. associated (interaction%partons(1)%p%initial) .or. &
	.not. associated (interaction%partons(2)%p%initial)) then
	return
	end if
	had1 => interaction%partons(1)%p%initial
	had2 => interaction%partons(2)%p%initial
	!!! copy momenta and energy
	momenta(1) = had1%child1%momentum
	momenta(2) = had2%child1%momentum
	GENERATE_PT_PHI: do i = 1, 2
	!!! generate transverse momentum and phi
	GENERATE_PT: do
	call rng%generate (pt (i))
	pt(i) = primordial_kt_width * sqrt(-log(pt(i)))
	if (pt(i) < primordial_kt_cutoff) exit
	end do GENERATE_PT
	call rng%generate (phi (i))
	phi(i) = twopi * phi(i)
	end do GENERATE_PT_PHI
	!!! adjust momenta
	shat = (momenta(1) + momenta(2))**2
	momenta(1) = [momenta(1)%p(0), &
	pt(1) * cos(phi(1)), &
	pt(1) * sin(phi(1)), &
	momenta(1)%p(3)]
	momenta(2) = [momenta(2)%p(0), &
	pt(2) * cos(phi(2)), &
	pt(2) * sin(phi(2)), &
	momenta(2)%p(3)]
	beta = [momenta(1)%p(1) + momenta(2)%p(1), &
	momenta(1)%p(2) + momenta(2)%p(2), zero] / sqrt(shat)
	momenta(1) = boost (beta1 / sqrt(one - beta2), -direction(beta)) &
	* momenta(1)
	bphi = azimuthal_angle (momenta(1))
	btheta = polar_angle (momenta(1))
	call interaction_apply_lorentztrafo (interaction, &
	rotation (cos(bphi), sin(bphi), 3) * rotation(cos(btheta), &
	sin(btheta), 2) * rotation(cos(-bphi), sin(-bphi), 3))
	call interaction_apply_lorentztrafo (interaction, &
	boost (beta1 / sqrt(one - beta2), -direction(beta)))
	end subroutine interaction_generate_primordial_kt

	@ %def interaction_generate_primordial_kt
	@
	<<Shower core: shower: TBP>>=
	procedure :: generate_primordial_kt => shower_generate_primordial_kt
	<<Shower core: procedures>>=
	subroutine shower_generate_primordial_kt (shower)
	class(shower_t), intent(inout) :: shower
	integer :: i
	do i = 1, size (shower%interactions)
	call interaction_generate_primordial_kt (shower%interactions(i)%i, &
	shower%settings%isr_primordial_kt_width, &
	shower%settings%isr_primordial_kt_cutoff, shower%rng)
	end do
	! TODO: (bcn 2015-03-23) this shouldnt be here !
	call shower%update_beamremnants ()
	end subroutine shower_generate_primordial_kt

	@ %def shower_generate_primordial_kt
	@ Output.
	<<Shower core: procedures>>=
	subroutine interaction_write (interaction, unit)
	type(shower_interaction_t), intent(in) :: interaction
	integer, intent(in), optional :: unit
	integer :: i, u
	u = given_output_unit (unit); if (u < 0) return
	if (associated (interaction%partons(1)%p)) then
	if (associated (interaction%partons(1)%p%initial)) &
	call interaction%partons(1)%p%initial%write (u)
	end if
	if (associated (interaction%partons(2)%p)) then
	if (associated (interaction%partons(2)%p%initial)) &
	call interaction%partons(2)%p%initial%write (u)
	end if
	if (allocated (interaction%partons)) then
	do i = 1, size (interaction%partons)
	call interaction%partons(i)%p%write (u)
	end do
	end if
	write (u, "(A)")
	end subroutine interaction_write

	@ %def interaction_write
	@
	<<Shower core: shower: TBP>>=
	procedure :: write => shower_write
	<<Shower core: procedures>>=
	subroutine shower_write (shower, unit)
	class(shower_t), intent(in) :: shower
	integer, intent(in), optional :: unit
	integer :: i, u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "------------------------------"
	write (u, "(1x,A)") "WHIZARD internal parton shower"
	write (u, "(1x,A)") "------------------------------"
	call shower%pdf_data%write (u)
	if (size (shower%interactions) > 0) then
	write (u, "(3x,A)") "Interactions: "
	do i = 1, size (shower%interactions)
	write (u, "(4x,A,I0)") "Interaction number ", i
	if (.not. associated (shower%interactions(i)%i)) then
	call msg_fatal ("Shower: missing interaction in shower")
	end if
	call interaction_write (shower%interactions(i)%i, u)
	end do
	else
	write (u, "(3x,A)") "[no interactions in shower]"
	end if
	write (u, "(A)")
	if (allocated (shower%partons)) then
	write (u, "(5x,A)") "Partons:"
	do i = 1, size (shower%partons)
	if (associated (shower%partons(i)%p)) then
	call shower%partons(i)%p%write (u)
	if (i < size (shower%partons)) then
	if (associated (shower%partons(i + 1)%p)) then
	if (shower%partons(i)%p%belongstointeraction .and. &
	.not. shower%partons(i + 1)%p%belongstointeraction) then
	call write_separator (u)
	end if
	end if
	end if
	end if
	end do
	else
	write (u, "(5x,A)") "[no partons in shower]"
	end if
	write (u, "(4x,A)") "Total Momentum: "
	call vector4_write (shower_get_total_momentum (shower))
	write (u, "(1x,A,L1)") "ISR finished: ", shower_isr_is_finished (shower)
	write (u, "(1x,A,L1)") "FSR finished: ", shower_fsr_is_finished (shower)
	end subroutine shower_write

	@ %def shower_write
	@ We combine the [[particle_set]] from the hard interaction with the
	partons of the shower. For simplicity, we do not maintain the
	mother-daughter-relations of the shower. Hadronic [[beam_remnants]] of
	the old [[particle_set]] are removed as they are provided, including
	proper flavor information, by the ISR shower.
	<<Shower core: shower: TBP>>=
	procedure :: combine_with_particle_set => shower_combine_with_particle_set
	<<Shower core: procedures>>=
	subroutine shower_combine_with_particle_set (shower, particle_set, &
	model_in, model_hadrons)
	class(shower_t), intent(in) :: shower
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model_in
	class(model_data_t), intent(in), target :: model_hadrons
	type(particle_t), dimension(:), allocatable :: particles
	integer, dimension(:), allocatable :: hard_colored_ids, &
	shower_partons_ids, incoming_ids, outgoing_ids
	class(model_data_t), pointer :: model
	logical, dimension(:), allocatable :: hard_colored_mask
	integer :: n_shower_partons, n_remnants, i, j
	integer :: n_in, n_out, n_beam, n_tot_old
	if (signal_is_pending ()) return
	call msg_debug (D_SHOWER, "shower_combine_with_particle_set")
	call msg_debug (D_SHOWER, "Particle set before replacing")
	if (debug_active (D_SHOWER)) &
	call particle_set%write (summary=.true., compressed=.true.)

	n_shower_partons = shower%get_nr_of_partons (only_colored = &
	.true., no_hard_prts = .true.)
	n_remnants = shower%get_nr_of_partons (only_colored = .false., &
	no_hard_prts = .true.)
	if (n_shower_partons + n_remnants > 0) then
	call particle_set%without_hadronic_remnants &
	(particles, n_tot_old, n_shower_partons + n_remnants)
	call count_and_allocate ()
	call replace_outgoings ()
	call set_hard_colored_as_resonant_parents_for_shower ()
	call add_to_pset (n_tot_old, .true.)
	call add_to_pset (n_tot_old + n_remnants, .false.)
	call particle_set%replace (particles)
	end if

	call msg_debug (D_SHOWER, 'Particle set after replacing')
	if (debug_active (D_SHOWER)) &
	call particle_set%write (summary=.true., compressed=.true.)

	contains

	<<Shower core: shower combine with particle set: procedures>>

	end subroutine shower_combine_with_particle_set

	@ %def shower_combine_with_particle_set
	<<Shower core: shower combine with particle set: procedures>>=
	subroutine count_and_allocate ()
	n_beam = particle_set%get_n_beam ()
	n_in = particle_set%get_n_in ()
	n_out = particle_set%get_n_out ()
	allocate (hard_colored_mask (size (particles)))
	hard_colored_mask = (particles%get_status () == PRT_INCOMING .or. &
	particles%get_status () == PRT_OUTGOING) .and. &
	particles%is_colored ()
	allocate (hard_colored_ids (count (hard_colored_mask)))
	hard_colored_ids = pack ([(i, i=1, size (particles))], hard_colored_mask)
	allocate (shower_partons_ids (n_shower_partons))
	shower_partons_ids = [(n_tot_old + n_remnants + i, i=1, n_shower_partons)]
	allocate (incoming_ids(n_in))
	incoming_ids = [(n_beam + i, i=1, n_in)]
	allocate (outgoing_ids(n_out))
	outgoing_ids = [(n_tot_old - n_out + i, i=1, n_out )]
	if (debug_active (D_SHOWER)) then
	print *, 'n_remnants = ', n_remnants
	print *, 'n_shower_partons = ', n_shower_partons
	print *, 'n_tot_old = ', n_tot_old
	print *, 'n_beam = ', n_beam
	print *, 'n_in, n_out = ', n_in, n_out
	end if
	end subroutine count_and_allocate

	@
	<<Shower core: shower combine with particle set: procedures>>=
	subroutine replace_outgoings ()
	do i = 1, size (shower%interactions)
	if (i > 1) then
	call msg_bug ('shower_combine_with_particle_set assumes 1 interaction')
	end if
	associate (interaction => shower%interactions(i)%i)
	do j = 3, size (interaction%partons)
	if (associated (interaction%partons(j)%p)) then
	call replace_parton_in_particles (j, interaction%partons(j)%p)
	end if
	end do
	end associate
	end do
	end subroutine replace_outgoings

	@
	<<Shower core: shower combine with particle set: procedures>>=
	subroutine replace_parton_in_particles (j, prt)
	integer, intent(in) :: j
	type(parton_t), intent(in) :: prt
	integer :: idx
	if (j <= 2) then
	idx = n_beam + j
	else
	idx = n_tot_old - n_out - n_in + j
	end if
	call particles(idx)%set_momentum (prt%momentum)
	end subroutine replace_parton_in_particles

	@
	<<Shower core: shower combine with particle set: procedures>>=
	subroutine set_hard_colored_as_resonant_parents_for_shower ()
	do i = 1, n_tot_old
	if (hard_colored_mask (i)) then
	if (has_splitted (i)) then
	call particles(i)%add_children (shower_partons_ids)
	if (particles(i)%get_status () == PRT_OUTGOING) then
	call particles(i)%set_status (PRT_RESONANT)
	end if
	end if
	end if
	end do
	end subroutine set_hard_colored_as_resonant_parents_for_shower

	@
	<<Shower core: shower combine with particle set: procedures>>=
	function has_splitted (i) result (splitted)
	logical :: splitted
	integer, intent(in) :: i
	splitted = .false.
	do j = 1, size (shower%partons)
	if (.not. associated (shower%partons(j)%p)) cycle
	if (particles(i)%flv%get_pdg () == shower%partons(j)%p%type) then
	if (all (nearly_equal (particles(i)%p%p, &
	shower%partons(j)%p%momentum%p))) then
	splitted = shower%partons(j)%p%is_branched ()
	end if
	end if
	end do
	end function has_splitted
	@
	<<Shower core: shower combine with particle set: procedures>>=
	subroutine add_to_pset (offset, remnants)
	integer, intent(in) :: offset
	logical, intent(in) :: remnants
	integer :: i, j
	j = offset
	do i = 1, size (shower%partons)
	if (.not. associated (shower%partons(i)%p)) cycle
	associate (prt => shower%partons(i)%p)
	if (.not. prt%is_final () .or. &
	prt%belongstointeraction) cycle
	if (remnants) then
	if (prt%is_colored ()) cycle
	else
	if (.not. (prt%is_colored ())) cycle
	end if
	j = j + 1
	call find_model (model, prt%type, model_in, model_hadrons)
	particles (j) = prt%to_particle (model)
	if (remnants) then
	call particles(j)%set_parents ([prt%initial%nr])
	call particles(prt%initial%nr)%add_child (j)
	else
	call particles(j)%set_parents (hard_colored_ids)
	end if
	end associate
	end do
	end subroutine add_to_pset

	@
	<<Shower core: shower: TBP>>=
	procedure :: write_lhef => shower_write_lhef
	<<Shower core: procedures>>=
	subroutine shower_write_lhef (shower, unit)
	class(shower_t), intent(in) :: shower
	integer, intent(in), optional :: unit
	integer :: u
	integer :: i
	integer :: c1, c2
	u = given_output_unit (unit); if (u < 0) return
	write(u,'(A)') '<LesHouchesEvents version="1.0">'
	write(u,'(A)') '<-- not a complete lhe file - just one event -->'
	write(u,'(A)') '<event>'
	write(u, *) 2 + shower%get_nr_of_partons (), 1, 1.0, 1.0, 1.0, 1.0
	!!! write incoming partons
	do i = 1, 2
	if (abs (shower%partons(i)%p%type) < 1000) then
	c1 = 0
	c2 = 0
	if (shower%partons(i)%p%is_colored ()) then
	if (shower%partons(i)%p%c1 /= 0) c1 = 500 + shower%partons(i)%p%c1
	if (shower%partons(i)%p%c2 /= 0) c2 = 500 + shower%partons(i)%p%c2
	end if
	write (u,*) shower%partons(i)%p%type, -1, 0, 0, c1, c2, &
	shower%partons(i)%p%momentum%p(1), &
	shower%partons(i)%p%momentum%p(2), &
	shower%partons(i)%p%momentum%p(3), &
	shower%partons(i)%p%momentum%p(0), &
	shower%partons(i)%p%momentum**2, zero, 9.0
	else
	write (u,*) shower%partons(i)%p%type, -9, 0, 0, 0, 0, &
	shower%partons(i)%p%momentum%p(1), &
	shower%partons(i)%p%momentum%p(2), &
	shower%partons(i)%p%momentum%p(3), &
	shower%partons(i)%p%momentum%p(0), &
	shower%partons(i)%p%momentum**2, zero, 9.0
	end if
	end do
	!!! write outgoing partons
	do i = 3, size (shower%partons)
	if (.not. associated (shower%partons(i)%p)) cycle
	if (.not. shower%partons(i)%p%is_final ()) cycle
	c1 = 0
	c2 = 0
	if (shower%partons(i)%p%is_colored ()) then
	if (shower%partons(i)%p%c1 /= 0) c1 = 500 + shower%partons(i)%p%c1
	if (shower%partons(i)%p%c2 /= 0) c2 = 500 + shower%partons(i)%p%c2
	end if
	write (u,*) shower%partons(i)%p%type, 1, 1, 2, c1, c2, &
	shower%partons(i)%p%momentum%p(1), &
	shower%partons(i)%p%momentum%p(2), &
	shower%partons(i)%p%momentum%p(3), &
	shower%partons(i)%p%momentum%p(0), &
	shower%partons(i)%p%momentum**2, zero, 9.0
	end do
	write(u,'(A)') '</event>'
	write(u,'(A)') '</LesHouchesEvents>'
	end subroutine shower_write_lhef

	@ %def shower_write_lhef
	@
	<<Shower core: procedures>>=
	subroutine shower_replace_parent_by_hadron (shower, prt)
	type(shower_t), intent(inout) :: shower
	type(parton_t), intent(inout), target :: prt
	type(parton_t), pointer :: remnant => null()
	if (associated (prt%parent)) then
	call shower_remove_parton_from_partons (shower, prt%parent)
	deallocate (prt%parent)
	end if
	if (.not. associated (prt%initial%child2)) then
	call shower%add_child (prt%initial, 2)
	end if
	prt%parent => prt%initial
	prt%parent%child1 => prt
	! make other child to be a beam-remnant
	remnant => prt%initial%child2
	remnant%type = BEAM_REMNANT
	remnant%momentum = prt%parent%momentum - prt%momentum
	remnant%x = one - prt%x
	remnant%parent => prt%initial
	remnant%t = zero
	end subroutine shower_replace_parent_by_hadron

	@ %def shower_replace_parent_by_hadron
	@
	<<Shower core: procedures>>=
	subroutine shower_get_first_ISR_scale_for_parton (shower, prt, tmax)
	type(shower_t), intent(inout), target :: shower
	type(parton_t), intent(inout), target :: prt
	real(default), intent(in), optional :: tmax
	real(default) :: t, tstep, random, integral, temp1
	real(default) :: temprand
	if (present(tmax)) then
	t = max (max (-shower%settings%isr_tscalefactor * prt%momentum%p(0)**2, &
	-abs(tmax)), prt%t)
	else
	t = max (-shower%settings%isr_tscalefactor * prt%momentum%p(0)**2, prt%t)
	end if
	call shower%rng%generate (random)
	random = -twopi * log(random)
	!!! compare Integral and log(random) instead of random and exp(-Integral)
	integral = zero
	call prt%set_simulated (.false.)
	do
	call shower%rng%generate (temprand)
	tstep = max (abs (0.01_default * t) * temprand, 0.1_default * &
	shower%settings%min_virtuality)
	if (t + 0.5_default * tstep > - shower%settings%min_virtuality) then
	prt%t = prt%mass_squared ()
	call prt%set_simulated ()
	exit
	end if
	prt%t = t + 0.5_default * tstep
	temp1 = integral_over_z_simple (prt, (random - integral) / tstep)
	integral = integral + tstep * temp1
	if (integral > random) then
	prt%t = t + 0.5_default * tstep
	exit
	end if
	t = t + tstep
	end do
	if (prt%t > - shower%settings%min_virtuality) then
	call shower_replace_parent_by_hadron (shower, prt)
	end if

	contains

	function integral_over_z_simple (prt, final) result (integral)
	type(parton_t), intent(inout) :: prt
	real(default), intent(in) :: final
	real(default), volatile :: integral

	real(default), parameter :: zstepfactor = one
	real(default), parameter :: zstepmin = 0.0001_default
	real(default) :: z, zstep, minz, maxz
	real(default) :: pdfsum
	integer :: quark, d_nf

	integral = zero
	if (debug2_active (D_SHOWER)) then
	print *, "D: integral_over_z_simple: t = ", prt%t
	end if
	minz = prt%x
	! maxz = maxzz(shat, s, shower%settings%isr_z_cutoff, shower%settings%isr_minenergy)
	maxz = shower%settings%isr_z_cutoff
	z = minz
	d_nf = shower%settings%max_n_flavors
	!!! TODO -> Adapt zstep to structure of divergencies
	if (prt%child1%is_gluon ()) then
	!!! gluon coming from g->gg
	do
	call shower%rng%generate (temprand)
	zstep = max(zstepmin, temprand * zstepfactor * z * (one - z))
	zstep = min(zstep, maxz - z)
	integral = integral + zstep * (D_alpha_s_isr ((one - &
	(z + 0.5_default * zstep)) * abs(prt%t), &
	shower%settings) / (abs(prt%t))) * &
	P_ggg (z + 0.5_default * zstep) * &
	shower%get_pdf (prt%initial%type, &
	prt%x / (z + 0.5_default * zstep), abs(prt%t), GLUON)
	if (integral > final) then
	exit
	end if
	z = z + zstep
	if (z >= maxz) then
	exit
	end if
	end do
	!!! gluon coming from q->qg ! correctly implemented yet?
	if (integral < final) then
	z = minz
	do
	call shower%rng%generate (temprand)
	zstep = max(zstepmin, temprand * zstepfactor * z * (one - z))
	zstep = min(zstep, maxz - z)
	pdfsum = zero
	do quark = -d_nf, d_nf
	if (quark == 0) cycle
	pdfsum = pdfsum + shower%get_pdf (prt%initial%type, &
	prt%x / (z + 0.5_default * zstep), abs(prt%t), quark)
	end do
	integral = integral + zstep * (D_alpha_s_isr &
	((z + 0.5_default * zstep) * abs(prt%t), &
	shower%settings) / (abs(prt%t))) * &
	P_qqg (one - (z + 0.5_default * zstep)) * pdfsum
	if (integral > final) then
	exit
	end if
	z = z + zstep
	if (z >= maxz) then
	exit
	end if
	end do
	end if
	else if (prt%child1%is_quark ()) then
	!!! quark coming from q->qg
	do
	call shower%rng%generate(temprand)
	zstep = max(zstepmin, temprand * zstepfactor * z * (one - z))
	zstep = min(zstep, maxz - z)
	integral = integral + zstep * (D_alpha_s_isr ((one - &
	(z + 0.5_default * zstep)) * abs(prt%t), &
	shower%settings) / (abs(prt%t))) * &
	P_qqg (z + 0.5_default * zstep) * &
	shower%get_pdf (prt%initial%type, &
	prt%x / (z + 0.5_default * zstep), abs(prt%t), prt%type)
	if (integral > final) then
	exit
	end if
	z = z + zstep
	if (z >= maxz) then
	exit
	end if
	end do
	!!! quark coming from g->qqbar
	if (integral < final) then
	z = minz
	do
	call shower%rng%generate (temprand)
	zstep = max(zstepmin, temprand * zstepfactor * z*(one - z))
	zstep = min(zstep, maxz - z)
	integral = integral + zstep * (D_alpha_s_isr &
	((one - (z + 0.5_default * zstep)) * abs(prt%t), &
	shower%settings) / (abs(prt%t))) * &
	P_gqq (z + 0.5_default * zstep) * &
	shower%get_pdf (prt%initial%type, &
	prt%x / (z + 0.5_default * zstep), abs(prt%t), GLUON)
	if (integral > final) then
	exit
	end if
	z = z + zstep
	if (z >= maxz) then
	exit
	end if
	end do
	end if

	end if
	integral = integral / shower%get_pdf (prt%initial%type, prt%x, &
	abs(prt%t), prt%type)
	end function integral_over_z_simple

	end subroutine shower_get_first_ISR_scale_for_parton

	@ %def shower_get_first_ISR_scale_for_parton
	@
	<<Shower core: procedures>>=
	subroutine shower_prepare_for_simulate_isr_pt (shower, interaction)
	type(shower_t), intent(inout) :: shower
	type(shower_interaction_t), intent(inout) :: interaction
	real(default) :: s
	s = (interaction%partons(1)%p%momentum + &
	interaction%partons(2)%p%momentum)**2
	interaction%partons(1)%p%scale = shower%settings%isr_tscalefactor * 0.25_default * s
	interaction%partons(2)%p%scale = shower%settings%isr_tscalefactor * 0.25_default * s
	end subroutine shower_prepare_for_simulate_isr_pt

	@ %def shower_prepare_for_simulate_isr_pt
	@
	<<Shower core: procedures>>=
	subroutine shower_prepare_for_simulate_isr_ana_test (shower, prt1, prt2)
	type(shower_t), intent(inout) :: shower
	type(parton_t), intent(inout), target :: prt1, prt2
	type(parton_t), pointer :: prt, prta, prtb
	real(default) :: scale, factor, E
	integer :: i
	if (.not. associated (prt1%initial) .or. .not. associated (prt2%initial)) then
	return
	end if
	scale = - (prt1%momentum + prt2%momentum) ** 2
	call prt1%set_simulated ()
	call prt2%set_simulated ()
	call shower%add_parent (prt1)
	call shower%add_parent (prt2)
	factor = sqrt (energy (prt1%momentum)**2 - scale) / &
	space_part_norm(prt1%momentum)
	prt1%parent%type = prt1%type
	prt1%parent%z = one
	prt1%parent%momentum = prt1%momentum
	prt1%parent%t = scale
	prt1%parent%x = prt1%x
	prt1%parent%initial => prt1%initial
	prt1%parent%belongstoFSR = .false.
	prt1%parent%c1 = prt1%c1
	prt1%parent%c2 = prt1%c2

	prt2%parent%type= prt2%type
	prt2%parent%z = one
	prt2%parent%momentum = prt2%momentum
	prt2%parent%t = scale
	prt2%parent%x = prt2%x
	prt2%parent%initial => prt2%initial
	prt2%parent%belongstoFSR = .false.
	prt2%parent%c1 = prt2%c1
	prt2%parent%c2 = prt2%c2

	call shower_get_first_ISR_scale_for_parton (shower, prt1%parent)
	call shower_get_first_ISR_scale_for_parton (shower, prt2%parent)

	!!! redistribute energy among first partons
	prta => prt1%parent
	prtb => prt2%parent

	E = energy (prt1%momentum + prt2%momentum)
	prta%momentum%p(0) = (E*2 - prtb%t + prta%t) / (two E)
	prtb%momentum%p(0) = E - prta%momentum%p(0)

	call prt1%parent%set_simulated ()
	call prt2%parent%set_simulated ()
	!!! rescale momenta
	do i = 1, 2
	if (i == 1) then
	prt => prt1%parent
	else
	prt => prt2%parent
	end if
	factor = sqrt (energy (prt%momentum)**2 - prt%t) &
	/ space_part_norm (prt%momentum)
	prt%momentum = vector4_moving (energy (prt%momentum), &
	factor * space_part (prt%momentum))
	end do

	if (prt1%parent%t < zero) then
	call shower%add_parent (prt1%parent)
	prt1%parent%parent%momentum = prt1%parent%momentum
	prt1%parent%parent%t = prt1%parent%t
	prt1%parent%parent%x = prt1%parent%x
	prt1%parent%parent%initial => prt1%parent%initial
	prt1%parent%parent%belongstoFSR = .false.
	call shower%add_child (prt1%parent%parent, 2)
	end if

	if (prt2%parent%t < zero) then
	call shower%add_parent (prt2%parent)
	prt2%parent%parent%momentum = prt2%parent%momentum
	prt2%parent%parent%t = prt2%parent%t
	prt2%parent%parent%x = prt2%parent%x
	prt2%parent%parent%initial => prt2%parent%initial
	prt2%parent%parent%belongstoFSR = .false.
	call shower%add_child (prt2%parent%parent, 2)
	end if

	end subroutine shower_prepare_for_simulate_isr_ana_test

	@ %def shower_prepare_for_simulate_isr_ana_test
	@
	<<Shower core: procedures>>=
	subroutine shower_add_children_of_emitted_timelike_parton (shower, prt)
	type(shower_t), intent(inout) :: shower
	type(parton_t), pointer :: prt

	if (prt%t > prt%mass_squared () + shower%settings%min_virtuality) then
	if (prt%is_quark ()) then
	!!! q -> qg
	call shower%add_child (prt, 1)
	prt%child1%type = prt%type
	prt%child1%momentum%p(0) = prt%z * prt%momentum%p(0)
	prt%child1%t = prt%t
	call shower%add_child (prt, 2)
	prt%child2%type = GLUON
	prt%child2%momentum%p(0) = (one - prt%z) * prt%momentum%p(0)
	prt%child2%t = prt%t
	else
	if (int (prt%x) > 0) then
	call shower%add_child (prt, 1)
	prt%child1%type = int (prt%x)
	prt%child1%momentum%p(0) = prt%z * prt%momentum%p(0)
	prt%child1%t = prt%t
	call shower%add_child (prt, 2)
	prt%child2%type = -int (prt%x)
	prt%child2%momentum%p(0) = (one - prt%z) * prt%momentum%p(0)
	prt%child2%t= prt%t
	else
	call shower%add_child (prt, 1)
	prt%child1%type = GLUON
	prt%child1%momentum%p(0) = prt%z * prt%momentum%p(0)
	prt%child1%t = prt%t
	call shower%add_child (prt, 2)
	prt%child2%type = GLUON
	prt%child2%momentum%p(0) = (one - prt%z) * prt%momentum%p(0)
	prt%child2%t = prt%t
	end if
	end if
	end if
	end subroutine shower_add_children_of_emitted_timelike_parton

	@ %def shower_add_children_of_emitted_timelike_parton
	@
	<<Shower core: procedures>>=
	subroutine shower_simulate_children_ana (shower,prt)
	type(shower_t), intent(inout), target :: shower
	type(parton_t), intent(inout) :: prt
	real(default), dimension(1:2) :: random, integral
	integer, dimension(1:2) :: gtoqq
	integer :: daughter
	type(parton_t), pointer :: daughterprt
	integer :: n_loop

	if (signal_is_pending ()) return
	if (debug2_active (D_SHOWER)) &
	print *, "D: shower_simulate_children_ana: for parton " , prt%nr
	gtoqq = 0
	if (.not. associated (prt%child1) .or. .not. associated (prt%child2)) then
	call msg_error ("Shower: error in simulate_children_ana: no children.")
	return
	end if

	<<Set beam-remnants and internal partons as simulated>>

	integral = zero

	!!! impose constraints by angular ordering -> cf. (26) of Gaining analytic control
	!!! check if no branchings are possible
	if (.not. prt%child1%simulated) then
	prt%child1%t = min (prt%child1%t, &
	0.5_default * prt%child1%momentum%p(0)*2 (one - &
	prt%get_costheta ()))
	if (.not. associated (prt%child1%settings)) &
	prt%child1%settings => shower%settings
	if (min (prt%child1%t, prt%child1%momentum%p(0)**2) < &
	prt%child1%mass_squared () + &
	prt%child1%settings%min_virtuality) then
	prt%child1%t = prt%child1%mass_squared ()
	call prt%child1%set_simulated ()
	end if
	end if
	if (.not. prt%child2%simulated) then
	prt%child2%t = min (prt%child2%t, &
	0.5_default * prt%child2%momentum%p(0)*2 (one - &
	prt%get_costheta ()))
	if (.not. associated (prt%child2%settings)) &
	prt%child2%settings => shower%settings
	if (min (prt%child2%t, prt%child2%momentum%p(0)**2) < &
	prt%child2%mass_squared () + &
	prt%child2%settings%min_virtuality) then
	prt%child2%t = prt%child2%mass_squared ()
	call prt%child2%set_simulated ()
	end if
	end if

	call shower%rng%generate (random)

	n_loop = 0
	do
	if (signal_is_pending ()) return
	n_loop = n_loop + 1
	if (n_loop > 900) then
	!!! try with massless quarks
	treat_duscb_quarks_massless = .true.
	end if
	if (n_loop > 1000) then
	call msg_message ("simulate_children_ana failed for parton ", prt%nr)
	call msg_warning ("too many loops in simulate_children_ana")
	call shower%write ()
	shower%valid = .false.
	return
	end if

	!!! check if a branching in the range t(i) to t(i) - tstep(i) occurs
	if (.not. prt%child1%simulated) then
	call parton_simulate_stept &
	(prt%child1, shower%rng, integral(1), random(1), gtoqq(1))
	end if
	if (.not. prt%child2%simulated) then
	call parton_simulate_stept &
	(prt%child2, shower%rng, integral(2), random(2), gtoqq(2))
	end if

	if (prt%child1%simulated .and. prt%child2%simulated) then
	if (sqrt (prt%t) <= sqrt (prt%child1%t) + sqrt (prt%child2%t)) then
	<<Repeat the simulation for the parton with the lower virtuality>>
	else
	exit
	end if
	end if
	end do

	call parton_apply_costheta (prt, shower%rng)

	<<Add children>>
	call shower_parton_update_color_connections (shower, prt)
	end subroutine shower_simulate_children_ana

	@ %def shower_simulate_children_ana
	@
	<<Set beam-remnants and internal partons as simulated>>=
	if (HADRON_REMNANT <= abs (prt%type) .and. abs (prt%type) <= HADRON_REMNANT_OCTET) then
	!!! prt is beam-remnant
	call prt%set_simulated ()
	return
	end if

	!!! check if partons are "internal" -> fixed scale
	if (prt%child1%type == INTERNAL) then
	call prt%child1%set_simulated ()
	end if
	if (prt%child2%type == INTERNAL) then
	call prt%child2%set_simulated ()
	end if
	@
	<<Repeat the simulation for the parton with the lower virtuality>>=
	!!! virtuality : t - m**2 (assuming it's not fixed)
	if (prt%child1%type == INTERNAL .and. prt%child2%type == INTERNAL) then
	call msg_fatal &
	("Shower: both partons fixed, but momentum not conserved")
	else if (prt%child1%type == INTERNAL) then
	!!! reset child2
	call prt%child2%set_simulated (.false.)
	prt%child2%t = min (prt%child1%t, (sqrt (prt%t) - &
	sqrt (prt%child1%t))**2)
	integral(2) = zero
	call shower%rng%generate (random(2))
	else if (prt%child2%type == INTERNAL) then
	! reset child1
	call prt%child1%set_simulated (.false.)
	prt%child1%t = min (prt%child2%t, (sqrt (prt%t) - &
	sqrt (prt%child2%t))**2)
	integral(1) = zero
	call shower%rng%generate (random(1))
	else if (prt%child1%t - prt%child1%mass_squared () > &
	prt%child2%t - prt%child2%mass_squared ()) then
	!!! reset child2
	call prt%child2%set_simulated (.false.)
	prt%child2%t = min (prt%child1%t, (sqrt (prt%t) - &
	sqrt (prt%child1%t))**2)
	integral(2) = zero
	call shower%rng%generate (random(2))
	else
	!!! reset child1 ! TODO choose child according to their t
	call prt%child1%set_simulated (.false.)
	prt%child1%t = min (prt%child2%t, (sqrt (prt%t) - &
	sqrt (prt%child2%t))**2)
	integral(1) = zero
	call shower%rng%generate (random(1))
	end if
	@
	<<Add children>>=
	if (.not. associated (prt%child1%settings)) &
	prt%child1%settings => shower%settings
	if (.not. associated (prt%child2%settings)) &
	prt%child2%settings => shower%settings
	do daughter = 1, 2
	if (signal_is_pending ()) return
	if (daughter == 1) then
	daughterprt => prt%child1
	else
	daughterprt => prt%child2
	end if
	if (daughterprt%t < daughterprt%mass_squared () + &
	daughterprt%settings%min_virtuality) then
	cycle
	end if
	if (.not. (daughterprt%is_quark () .or. daughterprt%is_gluon ())) then
	cycle
	end if
	if (daughterprt%is_quark ()) then
	!!! q -> qg
	call shower%add_child (daughterprt, 1)
	daughterprt%child1%type = daughterprt%type
	daughterprt%child1%momentum%p(0) = daughterprt%z * &
	daughterprt%momentum%p(0)
	daughterprt%child1%t = daughterprt%t
	call shower%add_child (daughterprt, 2)
	daughterprt%child2%type = GLUON
	daughterprt%child2%momentum%p(0) = (one - daughterprt%z) * &
	daughterprt%momentum%p(0)
	daughterprt%child2%t = daughterprt%t
	else if (daughterprt%is_gluon ()) then
	if (gtoqq(daughter) > 0) then
	call shower%add_child (daughterprt, 1)
	daughterprt%child1%type = gtoqq (daughter)
	daughterprt%child1%momentum%p(0) = &
	daughterprt%z * daughterprt%momentum%p(0)
	daughterprt%child1%t = daughterprt%t
	call shower%add_child (daughterprt, 2)
	daughterprt%child2%type = - gtoqq (daughter)
	daughterprt%child2%momentum%p(0) = (one - &
	daughterprt%z) * daughterprt%momentum%p(0)
	daughterprt%child2%t = daughterprt%t
	else
	call shower%add_child (daughterprt, 1)
	daughterprt%child1%type = GLUON
	daughterprt%child1%momentum%p(0) = &
	daughterprt%z * daughterprt%momentum%p(0)
	daughterprt%child1%t = daughterprt%t
	call shower%add_child (daughterprt, 2)
	daughterprt%child2%type = GLUON
	daughterprt%child2%momentum%p(0) = (one - &
	daughterprt%z) * daughterprt%momentum%p(0)
	daughterprt%child2%t = daughterprt%t
	end if
	end if
	end do
	@
	@ The recoiler is [[otherprt]]. Instead of the random number and the
	exponential of the integral, we compare the logarithm of the random
	number and the integral.
	<<Shower core: procedures>>=
	subroutine shower_isr_step_pt (shower, prt)
	type(shower_t), intent(inout) :: shower
	type(parton_t), target, intent(inout) :: prt
	type(parton_t), pointer :: otherprt

	real(default) :: scale, scalestep
	real(default), volatile :: integral
	real(default) :: random, factor
	real(default) :: temprand1, temprand2

	otherprt => shower%find_recoiler (prt)

	scale = prt%scale
	call shower%rng%generate (temprand1)
	call shower%rng%generate (temprand2)
	scalestep = max (abs (scalefactor1 * scale) * temprand1, &
	scalefactor2 * temprand2 * D_Min_scale)
	call shower%rng%generate (random)
	random = - twopi * log(random)
	integral = zero

	if (scale - 0.5_default * scalestep < D_Min_scale) then
	!!! close enough to cut-off scale -> ignore
	prt%scale = zero
	prt%t = prt%mass_squared ()
	call prt%set_simulated ()
	else
	prt%scale = scale - 0.5_default * scalestep
	factor = scalestep * (D_alpha_s_isr (prt%scale, &
	shower%settings) / (prt%scale * &
	shower%get_pdf (prt%initial%type, prt%x, prt%scale, prt%type)))
	integral = integral + factor * integral_over_z_isr_pt &
	(prt, otherprt, (random - integral) / factor)
	if (integral > random) then
	!!! prt%scale set above and prt%z set in integral_over_z_isr_pt
	call prt%set_simulated ()
	prt%t = - prt%scale / (one - prt%z)
	else
	prt%scale = scale - scalestep
	end if
	end if

	contains

	function integral_over_z_isr_pt (prt, otherprt, final) &
	result (integral)
	type(parton_t), intent(inout) :: prt, otherprt
	real(default), intent(in) :: final
	real(default), volatile :: integral
	real(default) :: mbr, r
	real(default) :: zmin, zmax, z, zstep
	integer :: n_bin
	integer, parameter :: n_total_bins = 100
	real(default) :: quarkpdfsum
	real(default) :: temprand
	integer :: quark, d_nf

	quarkpdfsum = zero
	d_nf = shower%settings%max_n_flavors
	if (debug2_active (D_SHOWER)) then
	print *, "D: integral_over_z_isr_pt: for scale = ", prt%scale
	end if

	integral = zero
	mbr = (prt%momentum + otherprt%momentum)**1
	zmin = prt%x
	zmax = min (one - (sqrt (prt%scale) / mbr) * &
	(sqrt(one + 0.25_default * prt%scale / mbr**2) - &
	0.25_default * sqrt(prt%scale) / mbr), shower%settings%isr_z_cutoff)
	zstep = (zmax - zmin) / n_total_bins

	if (debug_active (D_SHOWER)) then
	if (zmin > zmax) then
	call msg_bug(" error in integral_over_z_isr_pt: zmin > zmax ")
	integral = zero
	end if
	end if

	!!! divide the range [zmin:zmax] in n_total_bins
	BINS: do n_bin = 1, n_total_bins
	z = zmin + zstep * (n_bin - 0.5_default)
	!!! z-value in the middle of the bin

	if (prt%is_gluon ()) then
	QUARKS: do quark = -d_nf, d_nf
	if (quark == 0) cycle quarks
	quarkpdfsum = quarkpdfsum + shower%get_pdf &
	(prt%initial%type, prt%x / z, prt%scale, quark)
	end do QUARKS
	!!! g -> gg or q -> gq
	integral = integral + (zstep / z) * ((P_ggg (z) + &
	P_ggg (one - z)) * shower%get_pdf (prt%initial%type, &
	prt%x / z, prt%scale, GLUON) + P_qqg (one - z) * quarkpdfsum)
	else if (prt%is_quark ()) then
	!!! q -> qg or g -> qq
	integral = integral + (zstep / z) * ( P_qqg (z) * &
	shower%get_pdf (prt%initial%type, prt%x / z, prt%scale, &
	prt%type) + &
	P_gqq(z) * shower%get_pdf (prt%initial%type, prt%x / z, &
	prt%scale, GLUON))
	else
	! call msg_fatal ("Bug neither quark nor gluon in" &
	! // " integral_over_z_isr_pt")
	end if
	if (integral > final) then
	prt%z = z
	call shower%rng%generate (temprand)
	!!! decide type of father partons
	if (prt%is_gluon ()) then
	if (temprand > (P_qqg (one - z) * quarkpdfsum) / &
	((P_ggg (z) + P_ggg (one - z)) * shower%get_pdf &
	(prt%initial%type, prt%x / z, prt%scale, GLUON) &
	+ P_qqg (one - z) * quarkpdfsum)) then
	!!! gluon => gluon + gluon
	prt%aux_pt = GLUON
	else
	!!! quark => quark + gluon
	!!! decide which quark flavor the parent is
	r = temprand * quarkpdfsum
	WHICH_QUARK: do quark = -d_nf, d_nf
	if (quark == 0) cycle WHICH_QUARK
	if (r > quarkpdfsum - shower%get_pdf (prt%initial%type, &
	prt%x / z, prt%scale, quark)) then
	prt%aux_pt = quark
	exit WHICH_QUARK
	else
	quarkpdfsum = quarkpdfsum - shower%get_pdf &
	(prt%initial%type, prt%x / z, prt%scale, quark)
	end if
	end do WHICH_QUARK
	end if

	else if (prt%is_quark ()) then
	if (temprand > (P_qqg (z) * shower%get_pdf (prt%initial%type, &
	prt%x / z, prt%scale, prt%type)) / &
	(P_qqg (z) * shower%get_pdf (prt%initial%type, prt%x / z, &
	prt%scale, prt%type) + &
	P_gqq (z) * shower%get_pdf (prt%initial%type, prt%x / z, &
	prt%scale, GLUON))) then
	!!! gluon => quark + antiquark
	prt%aux_pt = GLUON
	else
	!!! quark => quark + gluon
	prt%aux_pt = prt%type
	end if
	end if
	exit BINS
	end if
	end do BINS
	end function integral_over_z_isr_pt
	end subroutine shower_isr_step_pt

	@ %def shower_isr_step_pt
	@ This function returns a pointer to the parton with the next ISR
	branching, while FSR branchings are ignored.
	<<Shower core: shower: TBP>>=
	procedure :: generate_next_isr_branching_veto => &
	shower_generate_next_isr_branching_veto
	<<Shower core: procedures>>=
	function shower_generate_next_isr_branching_veto &
	(shower) result (next_brancher)
	class(shower_t), intent(inout) :: shower
	type(parton_pointer_t) :: next_brancher
	integer :: i
	type(parton_t), pointer :: prt
	real(default) :: random
	!!! pointers to branchable partons
	type(parton_pointer_t), dimension(:), allocatable :: partons
	integer :: n_partons
	real(default) :: weight
	real(default) :: temp1, temp2, temp3, E3

	if (signal_is_pending ()) return

	if (shower%settings%isr_pt_ordered) then
	next_brancher = shower%generate_next_isr_branching ()
	return
	end if
	next_brancher%p => null()
	!!! branchable partons
	n_partons = 0
	do i = 1,size (shower%partons)
	prt => shower%partons(i)%p
	if (.not. associated (prt)) cycle
	if (prt%belongstoFSR) cycle
	if (prt%is_final ()) cycle
	if (.not. prt%belongstoFSR .and. prt%simulated) cycle
	n_partons = n_partons + 1
	end do
	if (n_partons == 0) then
	return
	end if
	allocate (partons(1:n_partons))
	n_partons = 1
	do i = 1, size (shower%partons)
	prt => shower%partons(i)%p
	if (.not. associated (prt)) cycle
	if (prt%belongstoFSR) cycle
	if (prt%is_final ()) cycle
	if (.not. prt%belongstoFSR .and. prt%simulated) cycle
	partons(n_partons)%p => shower%partons(i)%p
	n_partons = n_partons + 1
	end do
	!!! generate initial trial scales
	do i = 1, size (partons)
	if (signal_is_pending ()) return
	call generate_next_trial_scale (partons(i)%p)
	end do

	do
	!!! search for parton with the highest trial scale
	prt => partons(1)%p
	do i = 1, size (partons)
	if (prt%t >= zero) cycle
	if (abs (partons(i)%p%t) > abs (prt%t)) then
	prt => partons(i)%p
	end if
	end do

	if (prt%t >= zero) then
	next_brancher%p => null()
	exit
	end if
	!!! generate trial z and type of mother prt
	call generate_trial_z_and_typ (prt)

	!!! weight with pdf and alpha_s
	temp1 = (D_alpha_s_isr ((one - prt%z) * abs(prt%t), &
	shower%settings) / sqrt (alphasxpdfmax))
	temp2 = shower%get_xpdf (prt%initial%type, prt%x, prt%t, &
	prt%type) / sqrt (alphasxpdfmax)
	temp3 = shower%get_xpdf (prt%initial%type, prt%child1%x, prt%child1%t, &
	prt%child1%type) / &
	shower%get_xpdf (prt%initial%type, prt%child1%x, prt%t, &
	prt%child1%type)
	! TODO: (bcn 2015-02-19) ???
	if (temp1 * temp2 * temp3 > one) then
	print *, "weights:", temp1, temp2, temp3
	end if
	weight = (D_alpha_s_isr ((one - prt%z) * abs(prt%t), &
	shower%settings)) * &
	shower%get_xpdf (prt%initial%type, prt%x, prt%t, prt%type) * &
	shower%get_xpdf (prt%initial%type, prt%child1%x, prt%child1%t, &
	prt%child1%type) / &
	shower%get_xpdf &
	(prt%initial%type, prt%child1%x, prt%t, prt%child1%type)
	if (weight > alphasxpdfmax) then
	print *, "Setting alphasxpdfmax from ", alphasxpdfmax, " to ", weight
	alphasxpdfmax = weight
	end if
	weight = weight / alphasxpdfmax
	call shower%rng%generate (random)
	if (weight < random) then
	!!! discard branching
	call generate_next_trial_scale (prt)
	cycle
	end if
	!!! branching accepted so far
	!!! generate emitted parton
	prt%child2%t = abs(prt%t)
	prt%child2%momentum%p(0) = sqrt (abs(prt%t))
	if (shower%settings%isr_only_onshell_emitted_partons) then
	prt%child2%t = prt%child2%mass_squared ()
	else
	call prt%child2%next_t_ana (shower%rng)
	end if

	if (thetabar (prt, shower%find_recoiler (prt), &
	shower%settings%isr_angular_ordered, E3)) then
	prt%momentum%p(0) = E3
	prt%child2%momentum%p(0) = E3 - prt%child1%momentum%p(0)

	!!! found branching
	call prt%generate_ps_ini (shower%rng)
	next_brancher%p => prt
	call prt%set_simulated ()
	exit
	else
	call generate_next_trial_scale (prt)
	cycle
	end if
	end do
	if (.not. associated (next_brancher%p)) then
	!!! no further branching found -> all partons emitted by hadron
	print *, "--all partons emitted by hadrons---"
	do i = 1, size(partons)
	call shower_replace_parent_by_hadron (shower, partons(i)%p%child1)
	end do
	end if
	!!! some bookkeeping
	call shower%sort_partons ()
	! call shower%boost_to_CMframe () ! really necessary?
	! call shower%rotate_to_z () ! really necessary?
	contains

	subroutine generate_next_trial_scale (prt)
	type(parton_t), pointer, intent(inout) :: prt
	real(default) :: random, F
	real(default) :: zmax = 0.99_default !! ??
	call shower%rng%generate (random)
	F = one !!! TODO
	F = alphasxpdfmax / (two * pi)
	if (prt%child1%is_quark ()) then
	F = F * (integral_over_P_gqq (prt%child1%x, zmax) + &
	integral_over_P_qqg (prt%child1%x, zmax))
	else if (prt%child1%is_gluon ()) then
	F = F * (integral_over_P_ggg (prt%child1%x, zmax) + &
	two * shower%settings%max_n_flavors * &
	integral_over_P_qqg (one - zmax, one - prt%child1%x))
	else
	call msg_bug("neither quark nor gluon in generate_next_trial_scale")
	end if
	F = F / shower%get_xpdf (prt%child1%initial%type, prt%child1%x, &
	prt%child1%t, prt%child1%type)
	prt%t = prt%t * random**(one / F)
	if (abs (prt%t) - prt%mass_squared () < &
	prt%settings%min_virtuality) then
	prt%t = prt%mass_squared ()
	end if
	end subroutine generate_next_trial_scale

	subroutine generate_trial_z_and_typ (prt)
	type(parton_t), pointer, intent(inout) :: prt
	real(default) :: random
	real(default) :: z, zstep, zmin, integral
	real(default) :: zmax = 0.99_default !! ??
	call msg_debug (D_SHOWER, "generate_trial_z_and_typ")
	call shower%rng%generate (random)
	integral = zero
	!!! decide which branching a->bc occurs
	if (prt%child1%is_quark ()) then
	if (random < integral_over_P_qqg (prt%child1%x, zmax) / &
	(integral_over_P_qqg (prt%child1%x, zmax) + &
	integral_over_P_gqq (prt%child1%x, zmax))) then
	prt%type = prt%child1%type
	prt%child2%type = GLUON
	integral = integral_over_P_qqg (prt%child1%x, zmax)
	else
	prt%type = GLUON
	prt%child2%type = - prt%child1%type
	integral = integral_over_P_gqq (prt%child1%x, zmax)
	end if
	else if (prt%child1%is_gluon ()) then
	if (random < integral_over_P_ggg (prt%child1%x, zmax) / &
	(integral_over_P_ggg (prt%child1%x, zmax) + two * &
	shower%settings%max_n_flavors * &
	integral_over_P_qqg (one - zmax, &
	one - prt%child1%x))) then
	prt%type = GLUON
	prt%child2%type = GLUON
	integral = integral_over_P_ggg (prt%child1%x, zmax)
	else
	call shower%rng%generate (random)
	prt%type = 1 + floor(random * shower%settings%max_n_flavors)
	call shower%rng%generate (random)
	if (random > 0.5_default) prt%type = - prt%type
	prt%child2%type = prt%type
	integral = integral_over_P_qqg (one - zmax, &
	one - prt%child1%x)
	end if
	else
	call msg_bug("neither quark nor gluon in generate_next_trial_scale")
	end if
	!!! generate the z-value
	!!! z between prt%child1%x and zmax
	! prt%z = one - random * (one - prt%child1%x) ! TODO

	call shower%rng%generate (random)
	zmin = prt%child1%x
	zstep = max(0.1_default, 0.5_default * (zmax - zmin))
	z = zmin
	if (zmin > zmax) then
	print *, " zmin = ", zmin, " zmax = ", zmax
	call msg_fatal ("Shower: zmin greater than zmax")
	end if
	!!! procedure pointers would be helpful here
	if (prt%is_quark () .and. prt%child1%is_quark ()) then
	do
	zstep = min(zstep, 0.5_default * (zmax - z))
	if (abs(zstep) < 0.00001) exit
	if (integral_over_P_qqg (zmin, z) < random * integral) then
	if (integral_over_P_qqg (zmin, min(z + zstep, zmax)) &
	< random * integral) then
	z = min (z + zstep, zmax)
	cycle
	else
	zstep = zstep * 0.5_default
	cycle
	end if
	end if
	end do
	else if (prt%is_quark () .and. prt%child1%is_gluon ()) then
	do
	zstep = min(zstep, 0.5_default * (zmax - z))
	if (abs(zstep) < 0.00001) exit
	if (integral_over_P_qqg (zmin, z) < random * integral) then
	if (integral_over_P_qqg (zmin, min(z + zstep, zmax)) &
	< random * integral) then
	z = min(z + zstep, zmax)
	cycle
	else
	zstep = zstep * 0.5_default
	cycle
	end if
	end if
	end do
	else if (prt%is_gluon () .and. prt%child1%is_quark ()) then
	do
	zstep = min(zstep, 0.5_default * (zmax - z))
	if (abs (zstep) < 0.00001) exit
	if (integral_over_P_gqq (zmin, z) < random * integral) then
	if (integral_over_P_gqq (zmin, min(z + zstep, zmax)) &
	< random * integral) then
	z = min (z + zstep, zmax)
	cycle
	else
	zstep = zstep * 0.5_default
	cycle
	end if
	end if
	end do
	else if (prt%is_gluon () .and. prt%child1%is_gluon ()) then
	do
	zstep = min(zstep, 0.5_default * (zmax - z))
	if (abs (zstep) < 0.00001) exit
	if (integral_over_P_ggg (zmin, z) < random * integral) then
	if (integral_over_P_ggg (zmin, min(z + zstep, zmax)) &
	< random * integral) then
	z = min(z + zstep, zmax)
	cycle
	else
	zstep = zstep * 0.5_default
	cycle
	end if
	end if
	end do
	else
	end if
	prt%z = z
	prt%x = prt%child1%x / prt%z
	end subroutine generate_trial_z_and_typ
	end function shower_generate_next_isr_branching_veto

	@ %def shower_generate_next_isr_branching_veto
	@
	<<Shower core: shower: TBP>>=
	procedure :: find_recoiler => shower_find_recoiler
	<<Shower core: procedures>>=
	function shower_find_recoiler (shower, prt) result(recoiler)
	class(shower_t), intent(inout) :: shower
	type(parton_t), intent(inout), target :: prt
	type(parton_t), pointer :: recoiler
	type(parton_t), pointer :: otherprt1, otherprt2
	integer :: n_int
	otherprt1 => null()
	otherprt2 => null()
	DO_INTERACTIONS: do n_int = 1, size(shower%interactions)
	otherprt1 => shower%interactions(n_int)%i%partons(1)%p
	otherprt2 => shower%interactions(n_int)%i%partons(2)%p
	PARTON1: do
	if (associated (otherprt1%parent)) then
	if (.not. otherprt1%parent%is_proton () .and. &
	otherprt1%parent%simulated) then
	otherprt1 => otherprt1%parent
	if (associated (otherprt1, prt)) then
	exit PARTON1
	end if
	else
	exit PARTON1
	end if
	else
	exit PARTON1
	end if
	end do PARTON1
	PARTON2: do
	if (associated (otherprt2%parent)) then
	if (.not. otherprt2%parent%is_proton () .and. &
	otherprt2%parent%simulated) then
	otherprt2 => otherprt2%parent
	if (associated (otherprt2, prt)) then
	exit PARTON2
	end if
	else
	exit PARTON2
	end if
	else
	exit PARTON2
	end if
	end do PARTON2

	if (associated (otherprt1, prt) .or. associated (otherprt2, prt)) then
	exit DO_INTERACTIONS
	end if
	if (associated (otherprt1%parent, prt) .or. &
	associated (otherprt2%parent, prt)) then
	exit DO_INTERACTIONS
	end if
	end do DO_INTERACTIONS

	recoiler => null()
	if (associated (otherprt1%parent, prt)) then
	recoiler => otherprt2
	else if (associated (otherprt2%parent, prt)) then
	recoiler => otherprt1
	else if (associated (otherprt1, prt)) then
	recoiler => otherprt2
	else if (associated (otherprt2, prt)) then
	recoiler => otherprt1
	else
	call shower%write ()
	call prt%write ()
	call msg_error ("shower_find_recoiler: no otherparton found")
	end if
	end function shower_find_recoiler

	@ %def shower_find_recoiler
	@
	<<Shower core: procedures>>=
	subroutine shower_isr_step (shower, prt)
	type(shower_t), intent(inout) :: shower
	type(parton_t), target, intent(inout) :: prt
	type(parton_t), pointer :: otherprt => null()
	real(default) :: t, tstep
	real(default), volatile :: integral
	real(default) :: random
	real(default) :: temprand1, temprand2
	otherprt => shower%find_recoiler (prt)
	! if (.not. otherprt%child1%belongstointeraction) then
	! otherprt => otherprt%child1
	! end if

	if (signal_is_pending ()) return
	t = max(prt%t, prt%child1%t)
	call shower%rng%generate (random)
	! compare Integral and log(random) instead of random and exp(-Integral)
	random = - twopi * log(random)
	integral = zero
	call shower%rng%generate (temprand1)
	call shower%rng%generate (temprand2)
	tstep = max (abs (0.02_default * t) * temprand1, &
	0.02_default * temprand2 * shower%settings%min_virtuality)
	if (t + 0.5_default * tstep > - shower%settings%min_virtuality) then
	prt%t = prt%mass_squared ()
	call prt%set_simulated ()
	else
	prt%t = t + 0.5_default * tstep
	integral = integral + tstep * &
	integral_over_z_isr (shower, prt, otherprt,(random - integral) / tstep)
	if (integral > random) then
	prt%t = t + 0.5_default * tstep
	prt%x = prt%child1%x / prt%z
	call prt%set_simulated ()
	else
	prt%t = t + tstep
	end if
	end if
	end subroutine shower_isr_step

	@ %def shower_isr_step

	<<Shower core: procedures>>=
	function integral_over_z_isr (shower, prt, otherprt, final) result (integral)
	type(shower_t), intent(inout) :: shower
	type(parton_t), intent(inout) :: prt, otherprt
	real(default), intent(in) :: final
	!!! !!! !!! volatile argument: gfortran 7 aggressive optimization (#809)
	real(default), volatile :: integral
	real(default) :: minz, maxz, shat,s
	integer :: quark

	!!! calculate shat -> s of parton-parton system
	shat = (otherprt%momentum + prt%child1%momentum)**2
	!!! calculate s -> s of hadron-hadron system
	s = (otherprt%initial%momentum + prt%initial%momentum)**2
	integral = zero
	minz = prt%child1%x
	maxz = maxzz (shat, s, shower%settings%isr_z_cutoff, &
	shower%settings%isr_minenergy)

	!!! for gluon
	if (prt%child1%is_gluon ()) then
	!!! 1: g->gg
	prt%type = GLUON
	prt%child2%type = GLUON
	prt%child2%t = abs(prt%t)
	call integral_over_z_part_isr &
	(shower, prt, otherprt, shat, minz, maxz, integral, final)
	if (integral > final) then
	return
	else
	!!! 2: q->gq
	do quark = - shower%settings%max_n_flavors, &
	shower%settings%max_n_flavors
	if (quark == 0) cycle
	prt%type = quark
	prt%child2%type = quark
	prt%child2%t = abs(prt%t)
	call integral_over_z_part_isr &
	(shower, prt, otherprt, shat, minz, maxz, integral, final)
	if (integral > final) then
	return
	end if
	end do
	end if
	else if (prt%child1%is_quark ()) then
	!!! 1: q->qg
	prt%type = prt%child1%type
	prt%child2%type = GLUON
	prt%child2%t = abs(prt%t)
	call integral_over_z_part_isr &
	(shower, prt,otherprt, shat, minz, maxz, integral, final)
	if (integral > final) then
	return
	else
	!!! 2: g->qqbar
	prt%type = GLUON
	prt%child2%type = -prt%child1%type
	prt%child2%t = abs(prt%t)
	call integral_over_z_part_isr &
	(shower, prt,otherprt, shat, minz, maxz, integral, final)
	end if
	end if
	end function integral_over_z_isr

	@ % integral_over_z_isr
	<<Shower core: procedures>>=
	subroutine integral_over_z_part_isr &
	(shower, prt, otherprt, shat ,minz, maxz, retvalue, final)
	type(shower_t), intent(inout) :: shower
	type(parton_t), intent(inout) :: prt, otherprt
	real(default), intent(in) :: shat, minz, maxz, final
	real(default), intent(inout) :: retvalue
	real(default) :: z, zstep
	real(default) :: r1,r3,s1,s3
	real(default) :: pdf_divisor
	real(default) :: temprand
	real(default), parameter :: zstepfactor = 0.1_default
	real(default), parameter :: zstepmin = 0.0001_default
	call msg_debug2 (D_SHOWER, "integral_over_z_part_isr")
	if (signal_is_pending ()) return
	pdf_divisor = shower%get_pdf &
	(prt%initial%type, prt%child1%x, prt%t, prt%child1%type)
	z = minz
	s1 = shat + abs(otherprt%t) + abs(prt%child1%t)
	r1 = sqrt (s1*2 - four abs(otherprt%t * prt%child1%t))
	ZLOOP: do
	if (signal_is_pending ()) return
	if (z >= maxz) then
	exit
	end if
	call shower%rng%generate (temprand)
	if (prt%child1%is_gluon ()) then
	if (prt%is_gluon ()) then
	!!! g-> gg -> divergencies at z->0 and z->1
	zstep = max(zstepmin, temprand * zstepfactor * z * (one - z))
	else
	!!! q-> gq -> divergencies at z->0
	zstep = max(zstepmin, temprand * zstepfactor * (one - z))
	end if
	else
	if (prt%is_gluon ()) then
	!!! g-> qqbar -> no divergencies
	zstep = max(zstepmin, temprand * zstepfactor)
	else
	!!! q-> qg -> divergencies at z->1
	zstep = max(zstepmin, temprand * zstepfactor * (one - z))
	end if
	end if
	zstep = min(zstep, maxz - z)
	prt%z = z + 0.5_default * zstep
	s3 = shat / prt%z + abs(otherprt%t) + abs(prt%t)
	r3 = sqrt (s3*2 - four abs(otherprt%t * prt%t))
	!!! TODO: WHY is this if needed?
	if (abs(otherprt%t) > eps0) then
	prt%child2%t = min ((s1 * s3 - r1 * r3) / &
	(two * abs(otherprt%t)) - abs(prt%child1%t) - &
	abs(prt%t), abs(prt%child1%t))
	else
	prt%child2%t = abs(prt%child1%t)
	end if
	do
	prt%child2%momentum%p(0) = sqrt (abs(prt%child2%t))
	if (shower%settings%isr_only_onshell_emitted_partons) then
	prt%child2%t = prt%child2%mass_squared ()
	else
	call prt%child2%next_t_ana (shower%rng)
	end if
	!!! take limits by recoiler into account
	prt%momentum%p(0) = (shat / prt%z + &
	abs(otherprt%t) - abs(prt%child1%t) - &
	prt%child2%t) / (two * sqrt(shat))
	prt%child2%momentum%p(0) = &
	prt%momentum%p(0) - prt%child1%momentum%p(0)
	!!! check if E and t of prt%child2 are consistent
	if (prt%child2%momentum%p(0)**2 < prt%child2%t &
	.and. prt%child2%t > prt%child2%mass_squared ()) then
	!!! E is too small to have p_T^2 = E^2 - t > 0
	!!! -> cycle to find another solution
	cycle
	else
	!!! E is big enough -> exit
	exit
	end if
	end do
	if (thetabar (prt, otherprt, shower%settings%isr_angular_ordered) &
	.and. pdf_divisor > zero &
	.and. prt%child2%momentum%p(0) > zero) then
	retvalue = retvalue + (zstep / prt%z) * &
	(D_alpha_s_isr ((one - prt%z) * prt%t, &
	shower%settings) * &
	P_prt_to_child1 (prt) * &
	shower%get_pdf (prt%initial%type, prt%child1%x / prt%z, &
	prt%t, prt%type)) / (abs(prt%t) * pdf_divisor)
	end if
	if (retvalue > final) then
	exit
	else
	z = z + zstep
	end if
	end do ZLOOP
	end subroutine integral_over_z_part_isr

	@ % integral_over_z_part_isr
	@ This returns a pointer to the parton with the next ISR branching, again
	FSR branchings are ignored.
	<<Shower core: shower: TBP>>=
	procedure :: generate_next_isr_branching => &
	shower_generate_next_isr_branching
	<<Shower core: procedures>>=
	function shower_generate_next_isr_branching &
	(shower) result (next_brancher)
	class(shower_t), intent(inout) :: shower
	type(parton_pointer_t) :: next_brancher
	integer i, index
	type(parton_t), pointer :: prt
	next_brancher%p => null()
	do
	if (signal_is_pending ()) return
	if (shower_isr_is_finished (shower)) exit
	!!! find mother with highest \|t\| or pt to be simulated
	index = 0
	call shower%sort_partons ()
	do i = 1,size (shower%partons)
	prt => shower%partons(i)%p
	if (.not. associated (prt)) cycle
	if (.not. shower%settings%isr_pt_ordered) then
	if (prt%belongstointeraction) cycle
	end if
	if (prt%belongstoFSR) cycle
	if (prt%is_final ()) cycle
	if (.not. prt%belongstoFSR .and. prt%simulated) cycle
	index = i
	exit
	end do
	if (debug_active (D_SHOWER)) then
	if (index == 0) then
	call msg_fatal(" no branchable partons found")
	end if
	end if

	prt => shower%partons(index)%p

	!!! ISR simulation
	if (shower%settings%isr_pt_ordered) then
	call shower_isr_step_pt (shower, prt)
	else
	call shower_isr_step (shower, prt)
	end if
	if (prt%simulated) then
	if (prt%t < zero) then
	next_brancher%p => prt
	if (.not. shower%settings%isr_pt_ordered) &
	call prt%generate_ps_ini (shower%rng)
	exit
	else
	if (.not. shower%settings%isr_pt_ordered) then
	call shower_replace_parent_by_hadron (shower, prt%child1)
	else
	call shower_replace_parent_by_hadron (shower, prt)
	end if
	end if
	end if
	end do

	!!! some bookkeeping
	call shower%sort_partons ()
	call shower%boost_to_CMframe () !!! really necessary?
	call shower%rotate_to_z () !!! really necessary?
	end function shower_generate_next_isr_branching

	@ %def shower_generate_next_isr_branching
	@ This is a loop which searches for all emitted and branched partons.
	<<Shower core: shower: TBP>>=
	procedure :: generate_fsr_for_isr_partons => &
	shower_generate_fsr_for_partons_emitted_in_ISR
	<<Shower core: procedures>>=
	subroutine shower_generate_fsr_for_partons_emitted_in_ISR (shower)
	class(shower_t), intent(inout) :: shower
	integer :: n_int, i
	type(parton_t), pointer :: prt
	if (shower%settings%isr_only_onshell_emitted_partons) return
	call msg_debug (D_SHOWER, "shower_generate_fsr_for_partons_emitted_in_ISR")
	INTERACTIONS_LOOP: do n_int = 1, size (shower%interactions)
	INCOMING_PARTONS_LOOP: do i = 1, 2
	if (signal_is_pending ()) return
	prt => shower%interactions(n_int)%i%partons(i)%p
	PARENT_PARTONS_LOOP: do
	if (associated (prt%parent)) then
	if (.not. prt%parent%is_proton ()) then
	prt => prt%parent
	else
	exit
	end if
	else
	exit
	end if
	if (associated (prt%child2)) then
	if (prt%child2%is_branched ()) then
	call shower_parton_generate_fsr (shower, prt%child2)
	end if
	else
	! call msg_fatal ("Shower: no child2 associated?")
	end if
	end do PARENT_PARTONS_LOOP
	end do INCOMING_PARTONS_LOOP
	end do INTERACTIONS_LOOP
	end subroutine shower_generate_fsr_for_partons_emitted_in_ISR

	@ %def shower_generate_fsr_for_partons_emitted_in_ISR
	@ This executes the branching generated by
	[[shower_generate_next_isr_branching]], that means it generates the
	flavors, momenta, etc.
	<<Shower core: shower: TBP>>=
	procedure :: execute_next_isr_branching => shower_execute_next_isr_branching
	<<Shower core: procedures>>=
	subroutine shower_execute_next_isr_branching (shower, prtp)
	class(shower_t), intent(inout) :: shower
	type(parton_pointer_t), intent(inout) :: prtp
	type(parton_t), pointer :: prt, otherprt
	type(parton_t), pointer :: prta, prtb, prtc, prtr
	real(default) :: mbr
	real(default) :: phirand
	call msg_debug (D_SHOWER, "shower_execute_next_isr_branching")
	if (.not. associated (prtp%p)) then
	call msg_fatal ("Shower: prtp not associated")
	end if

	prt => prtp%p

	if ((.not. shower%settings%isr_pt_ordered .and. &
	prt%t > - shower%settings%min_virtuality) .or. &
	(shower%settings%isr_pt_ordered .and. prt%scale < D_Min_scale)) then
	call msg_error ("Shower: no branching to be executed.")
	end if

	otherprt => shower%find_recoiler (prt)
	if (shower%settings%isr_pt_ordered) then
	!!! get the recoiler
	otherprt => shower%find_recoiler (prt)
	if (associated (otherprt%parent)) then
	!!! Why only for pt ordered
	if (.not. otherprt%parent%is_proton () .and. &
	shower%settings%isr_pt_ordered) otherprt => otherprt%parent
	end if
	if (.not. associated (prt%parent)) then
	call shower%add_parent (prt)
	end if
	prt%parent%belongstoFSR = .false.
	if (.not. associated (prt%parent%child2)) then
	call shower%add_child (prt%parent, 2)
	end if

	prta => prt%parent !!! new parton a with branching a->bc
	prtb => prt !!! former parton
	prtc => prt%parent%child2 !!! emitted parton
	prtr => otherprt !!! recoiler

	mbr = (prtb%momentum + prtr%momentum)**1

	!!! 1. assume you are in the restframe
	!!! 2. rotate by random phi
	call shower%rng%generate (phirand)
	phirand = twopi * phirand
	call shower_apply_lorentztrafo (shower, &
	rotation(cos(phirand), sin(phirand),vector3_canonical(3)))
	!!! 3. Put the b off-shell
	!!! and
	!!! 4. construct the massless a
	!!! and the parton (eventually emitted by a)

	!!! generate the flavor of the parent (prta)
	if (prtb%aux_pt /= 0) prta%type = prtb%aux_pt
	if (prtb%is_quark ()) then
	if (prta%type == prtb%type) then
	!!! (anti)-quark -> (anti-)quark + gluon
	prta%type = prtb%type ! quarks have same flavor
	prtc%type = GLUON ! emitted gluon
	else
	!!! gluon -> quark + antiquark
	prta%type = GLUON
	prtc%type = - prtb%type
	end if
	else if (prtb%is_gluon ()) then
	prta%type = GLUON
	prtc%type = GLUON
	else
	! STOP "Bug in shower_execute_next_branching: neither quark nor gluon"
	end if

	prta%initial => prtb%initial
	prta%belongstoFSR = .false.
	prta%scale = prtb%scale
	prta%x = prtb%x / prtb%z

	prtb%momentum = vector4_moving ((mbr*2 + prtb%t) / (two mbr), &
	vector3_canonical(3) * &
	sign ((mbr*2 - prtb%t) / (two mbr), &
	prtb%momentum%p(3)))
	prtr%momentum = vector4_moving ((mbr*2 - prtb%t) / (two mbr), &
	vector3_canonical(3) * &
	sign( (mbr*2 - prtb%t) / (two mbr), &
	prtr%momentum%p(3)))

	prta%momentum = vector4_moving ((0.5_default / mbr) * &
	((mbr**2 / prtb%z) + prtb%t - prtc%mass_squared ()), &
	vector3_null)
	prta%momentum = vector4_moving (prta%momentum%p(0), &
	vector3_canonical(3) * &
	(0.5_default / prtb%momentum%p(3)) * &
	((mbr**2 / prtb%z) - two &
	* prtr%momentum%p(0) * prta%momentum%p(0) ) )
	if (prta%momentum%p(0)2 - prta%momentum%p(3)2 - &
	prtc%mass_squared () > zero) then
	!!! This SHOULD be always fulfilled???
	prta%momentum = vector4_moving (prta%momentum%p(0), &
	vector3_moving([sqrt (prta%momentum%p(0)**2 - &
	prta%momentum%p(3)**2 - &
	prtc%mass_squared ()), zero, &
	prta%momentum%p(3)]))
	end if
	prtc%momentum = prta%momentum - prtb%momentum

	!!! 5. rotate to have a along z-axis
	call shower%boost_to_CMframe ()
	call shower%rotate_to_z ()
	!!! 6. rotate back in phi
	call shower_apply_lorentztrafo (shower, rotation &
	(cos(-phirand), sin(-phirand), vector3_canonical(3)))
	else
	if (prt%child2%t > prt%child2%mass_squared ()) then
	call shower_add_children_of_emitted_timelike_parton &
	(shower, prt%child2)
	call prt%child2%set_simulated ()
	end if

	call shower%add_parent (prt)
	call shower%add_child (prt%parent, 2)

	prt%parent%momentum = prt%momentum
	prt%parent%t = prt%t
	prt%parent%x = prt%x
	prt%parent%initial => prt%initial
	prt%parent%belongstoFSR = .false.

	prta => prt
	prtb => prt%child1
	prtc => prt%child2
	end if
	if (signal_is_pending ()) return
	if (shower%settings%isr_pt_ordered) then
	call prt%parent%generate_ps_ini (shower%rng)
	else
	call prt%generate_ps_ini (shower%rng)
	end if

	!!! add color connections
	if (prtb%is_quark ()) then

	if (prta%type == prtb%type) then
	if (prtb%type > 0) then
	!!! quark -> quark + gluon
	prtc%c2 = prtb%c1
	prtc%c1 = shower%get_next_color_nr ()
	prta%c1 = prtc%c1
	else
	!!! antiquark -> antiquark + gluon
	prtc%c1 = prtb%c2
	prtc%c2 = shower%get_next_color_nr ()
	prta%c2 = prtc%c2
	end if
	else
	!!! gluon -> quark + antiquark
	if (prtb%type > 0) then
	!!! gluon -> quark + antiquark
	prta%c1 = prtb%c1
	prtc%c1 = 0
	prtc%c2 = shower%get_next_color_nr ()
	prta%c2 = prtc%c2
	else
	!!! gluon -> antiquark + quark
	prta%c2 = prtb%c2
	prtc%c1 = shower%get_next_color_nr ()
	prtc%c2 = 0
	prta%c1 = prtc%c1
	end if
	end if
	else if (prtb%is_gluon ()) then
	if (prta%is_gluon ()) then
	!!! g -> gg
	prtc%c2 = prtb%c1
	prtc%c1 = shower%get_next_color_nr ()
	prta%c1 = prtc%c1
	prta%c2 = prtb%c2
	else if (prta%is_quark ()) then
	if (prta%type > 0) then
	prta%c1 = prtb%c1
	prta%c2 = 0
	prtc%c1 = prtb%c2
	prtc%c2 = 0
	else
	prta%c1 = 0
	prta%c2 = prtb%c2
	prtc%c1 = 0
	prtc%c2 = prtb%c1
	end if
	end if
	end if

	call shower%sort_partons ()
	call shower%boost_to_CMframe ()
	call shower%rotate_to_z ()

	end subroutine shower_execute_next_isr_branching

	@ %def shower_execute_next_isr_branching
	@
	<<Shower core: procedures>>=
	subroutine shower_remove_parents_and_stuff (shower, prt)
	type(shower_t), intent(inout) :: shower
	type(parton_t), intent(inout), target :: prt
	type(parton_t), pointer :: actprt, nextprt
	nextprt => prt%parent
	actprt => null()
	!!! remove children of emitted timelike parton
	if (associated (prt%child2)) then
	if (associated (prt%child2%child1)) then
	call shower_remove_parton_from_partons_recursive &
	(shower, prt%child2%child1)
	end if
	prt%child2%child1 => null()
	if (associated (prt%child2%child2)) then
	call shower_remove_parton_from_partons_recursive &
	(shower, prt%child2%child2)
	end if
	prt%child2%child2 => null()
	end if
	do
	actprt => nextprt
	if (.not. associated (actprt)) then
	exit
	else if (actprt%is_proton ()) then
	!!! remove beam-remnant
	call shower_remove_parton_from_partons (shower, actprt%child2)
	exit
	end if
	if (associated (actprt%parent)) then
	nextprt => actprt%parent
	else
	nextprt => null()
	end if
	call shower_remove_parton_from_partons_recursive &
	(shower, actprt%child2)
	call shower_remove_parton_from_partons (shower, actprt)

	end do
	prt%parent=>null()

	end subroutine shower_remove_parents_and_stuff

	@ %def shower_remove_parents_and_stuff
	@
	<<Shower core: shower: TBP>>=
	procedure :: get_ISR_scale => shower_get_ISR_scale
	<<Shower core: procedures>>=
	function shower_get_ISR_scale (shower) result (scale)
	class(shower_t), intent(in) :: shower
	real(default) :: scale
	type(parton_t), pointer :: prt1, prt2
	integer :: i
	scale = zero
	do i = 1, size (shower%interactions)
	call interaction_find_partons_nearest_to_hadron &
	(shower%interactions(i)%i, prt1, prt2, &
	shower%settings%isr_pt_ordered)
	if (.not. prt1%simulated .and. abs(prt1%scale) > scale) &
	scale = abs(prt1%scale)
	if (.not. prt1%simulated .and. abs(prt2%scale) > scale) &
	scale = abs(prt2%scale)
	end do
	end function shower_get_ISR_scale

	@ %def shower_get_ISR_scale
	@
	<<Shower core: shower: TBP>>=
	procedure :: set_max_isr_scale => shower_set_max_isr_scale
	<<Shower core: procedures>>=
	subroutine shower_set_max_isr_scale (shower, newscale)
	class(shower_t), intent(inout) :: shower
	real(default), intent(in) :: newscale
	real(default) :: scale
	type(parton_t), pointer :: prt
	integer :: i,j
	call msg_debug (D_SHOWER, "shower_set_max_isr_scale: newscale", &
	newscale)
	if (shower%settings%isr_pt_ordered) then
	scale = newscale
	else
	scale = - abs (newscale)
	end if

	INTERACTIONS: do i = 1, size (shower%interactions)
	PARTONS: do j = 1, 2
	prt => shower%interactions(i)%i%partons(j)%p
	do
	if (.not. shower%settings%isr_pt_ordered) then
	if (prt%belongstointeraction) prt => prt%parent
	end if
	if (prt%t < scale) then
	if (associated (prt%parent)) then
	prt => prt%parent
	else
	exit !!! unresolved prt found
	end if
	else
	exit !!! prt with scale above newscale found
	end if
	end do
	if (.not. shower%settings%isr_pt_ordered) then
	if (prt%child1%belongstointeraction .or. &
	prt%is_proton ()) then
	!!! don't reset scales of "first" spacelike partons
	!!! in virtuality ordered shower or hadrons
	cycle
	end if
	else
	if (prt%is_proton ()) then
	!!! don't reset scales of hadrons
	cycle
	end if
	end if
	if (shower%settings%isr_pt_ordered) then
	prt%scale = scale
	else
	prt%t = scale
	end if
	call prt%set_simulated (.false.)
	call shower_remove_parents_and_stuff (shower, prt)
	end do PARTONS
	end do INTERACTIONS
	end subroutine shower_set_max_isr_scale

	@ %def shower_set_max_isr_scale
	@
	<<Shower core: shower: TBP>>=
	procedure :: interaction_generate_fsr_2ton => &
	shower_interaction_generate_fsr_2ton
	@
	<<Shower core: procedures>>=
	subroutine shower_interaction_generate_fsr_2ton (shower, interaction)
	class(shower_t), intent(inout) :: shower
	type(shower_interaction_t), intent(inout) :: interaction
	type(parton_t), pointer :: prt
	prt => interaction%partons(3)%p
	do
	if (.not. associated (prt%parent)) exit
	prt => prt%parent
	end do
	call shower_parton_generate_fsr (shower, prt)
	call shower_parton_update_color_connections (shower, prt)
	end subroutine shower_interaction_generate_fsr_2ton

	@ %def shower_interaction_generate_fsr_2ton
	@ Perform the FSR for one parton, it is assumed, that the parton
	already branched. Hence, its children are to be simulated. This
	procedure is intended for branched FSR-partons emitted in the ISR.
	<<Shower core: procedures>>=
	subroutine shower_parton_generate_fsr (shower, prt)
	type(shower_t), intent(inout) :: shower
	type(parton_t), intent(inout), target :: prt
	type(parton_pointer_t), dimension(:), allocatable :: partons
	logical :: single_emission = .false.
	call msg_debug (D_SHOWER, "shower_parton_generate_fsr")
	if (signal_is_pending ()) return
	if (debug_active (D_SHOWER)) then
	if (.not. prt%is_branched ()) then
	call msg_error ("shower_parton_generate_fsr: parton not branched")
	return
	end if
	if (prt%child1%simulated .or. &
	prt%child2%simulated) then
	print *, "children already simulated for parton ", prt%nr
	return
	end if
	end if
	allocate (partons(1))
	partons(1)%p => prt
	if (single_emission) then
	call shower%parton_pointer_array_generate_fsr (partons, partons)
	else
	call shower%parton_pointer_array_generate_fsr_recursive (partons)
	end if
	end subroutine shower_parton_generate_fsr

	@ %def shower_parton_generate_fsr
	@
	<<Shower core: shower: TBP>>=
	procedure :: parton_pointer_array_generate_fsr_recursive => &
	shower_parton_pointer_array_generate_fsr_recursive
	@
	<<Shower core: procedures>>=
	recursive subroutine shower_parton_pointer_array_generate_fsr_recursive &
	(shower, partons)
	class(shower_t), intent(inout) :: shower
	type(parton_pointer_t), dimension(:), allocatable, intent(inout) :: &
	partons
	type(parton_pointer_t), dimension(:), allocatable :: partons_new
	call msg_debug (D_SHOWER, "shower_parton_pointer_array_generate_fsr_recursive")
	if (signal_is_pending ()) return
	if (size (partons) == 0) return
	call shower%parton_pointer_array_generate_fsr (partons, partons_new)
	call shower%parton_pointer_array_generate_fsr_recursive (partons_new)
	end subroutine shower_parton_pointer_array_generate_fsr_recursive
	@
	<<Shower core: shower: TBP>>=
	procedure :: parton_pointer_array_generate_fsr => &
	shower_parton_pointer_array_generate_fsr
	@
	<<Shower core: procedures>>=
	subroutine shower_parton_pointer_array_generate_fsr &
	(shower, partons, partons_new)
	class(shower_t), intent(inout) :: shower
	type(parton_pointer_t), dimension(:), allocatable, intent(inout) :: &
	partons
	type(parton_pointer_t), dimension(:), allocatable, intent(out) :: &
	partons_new
	integer :: i, size_partons, size_partons_new
	call msg_debug (D_SHOWER, "shower_parton_pointer_array_generate_fsr")
	!!! Simulate highest/first parton
	call shower_simulate_children_ana (shower, partons(1)%p)
	!!! check for new daughters to be included in new_partons
	size_partons = size (partons)
	size_partons_new = size_partons - 1 !!! partons(1) not needed anymore
	if (partons(1)%p%child1%is_branched ()) &
	size_partons_new = size_partons_new + 1
	if (partons(1)%p%child2%is_branched ()) &
	size_partons_new = size_partons_new + 1

	allocate (partons_new (1:size_partons_new))

	if (size_partons > 1) then
	do i = 2, size_partons
	partons_new (i - 1)%p => partons(i)%p
	end do
	end if
	if (partons(1)%p%child1%is_branched ()) &
	partons_new (size_partons)%p => partons(1)%p%child1
	if (partons(1)%p%child2%is_branched ()) then
	!!! check if child1 is already included
	if (size_partons_new == size_partons) then
	partons_new (size_partons)%p => partons(1)%p%child2
	else if (size_partons_new == size_partons + 1) then
	partons_new (size_partons + 1)%p => partons(1)%p%child2
	else
	call msg_fatal ("Shower: wrong sizes in" &
	// "shower_parton_pointer_array_generate_fsr")
	end if
	end if
	deallocate (partons)

	end subroutine shower_parton_pointer_array_generate_fsr

	@ %def shower_parton_pointer_array_generate_fsr
	@
	<<Shower core: procedures>>=
	recursive subroutine shower_parton_update_color_connections &
	(shower, prt)
	type(shower_t), intent(inout) :: shower
	type(parton_t), intent(inout) :: prt
	real(default) :: temprand
	if (.not. associated (prt%child1) .or. &
	.not. associated (prt%child2)) return

	if (signal_is_pending ()) return
	if (prt%is_gluon ()) then
	if (prt%child1%is_quark ()) then
	!!! give the quark the colorpartner and the antiquark
	!!! the anticolorpartner
	if (prt%child1%type > 0) then
	!!! child1 is quark, child2 is antiquark
	prt%child1%c1 = prt%c1
	prt%child2%c2 = prt%c2
	else
	!!! child1 is antiquark, child2 is quark
	prt%child1%c2 = prt%c2
	prt%child2%c1 = prt%c1
	end if
	else
	!!! g -> gg splitting -> random choosing of partners
	call shower%rng%generate (temprand)
	if (temprand > 0.5_default) then
	prt%child1%c1 = prt%c1
	prt%child1%c2 = shower%get_next_color_nr ()
	prt%child2%c1 = prt%child1%c2
	prt%child2%c2 = prt%c2
	else
	prt%child1%c2 = prt%c2
	prt%child2%c1 = prt%c1
	prt%child2%c2 = shower%get_next_color_nr ()
	prt%child1%c1 = prt%child2%c2
	end if
	end if
	else if (prt%is_quark ()) then
	if (prt%child1%is_quark ()) then
	if (prt%child1%type > 0) then
	!!! q -> q + g
	prt%child2%c1 = prt%c1
	prt%child2%c2 = shower%get_next_color_nr ()
	prt%child1%c1 = prt%child2%c2
	else
	!!! qbar -> qbar + g
	prt%child2%c2 = prt%c2
	prt%child2%c1 = shower%get_next_color_nr ()
	prt%child1%c2 = prt%child2%c1
	end if
	else
	if (prt%child2%type > 0) then
	!!! q -> g + q
	prt%child1%c1 = prt%c1
	prt%child1%c2 = shower%get_next_color_nr ()
	prt%child2%c1 = prt%child1%c2
	else
	!!! qbar -> g + qbar
	prt%child1%c2 = prt%c2
	prt%child1%c1 = shower%get_next_color_nr ()
	prt%child2%c2 = prt%child1%c1
	end if
	end if
	end if

	call shower_parton_update_color_connections (shower, prt%child1)
	call shower_parton_update_color_connections (shower, prt%child2)
	end subroutine shower_parton_update_color_connections

	@ %def shower_parton_update_color_connections
	@ The next two routines are for PDFs. Wrapper function to return
	parton densities.
	<<Shower core: shower: TBP>>=
	procedure :: get_pdf => shower_get_pdf
	<<Shower core: procedures>>=
	function shower_get_pdf (shower, mother, x, Q2, daughter) result (pdf)
	<<get pdf>>
	if (x > eps0) then
	pdf = pdf / x
	end if
	end function shower_get_pdf

	@ %def shower_get_pdf
	<<Shower core: shower: TBP>>=
	procedure :: get_xpdf => shower_get_xpdf
	<<Shower core: procedures>>=
	function shower_get_xpdf (shower, mother, x, Q2, daughter) result (pdf)
	<<get pdf>>
	end function shower_get_xpdf

	@ %def shower_get_xpdf
	@
	<<get pdf>>=
	class(shower_t), intent(inout), target :: shower
	integer, intent(in) :: mother, daughter
	real(default), intent(in) :: x, Q2
	real(default) :: pdf
	real(double), save :: f(-6:6) = 0._double
	real(double), save :: lastx, lastQ2 = 0._double
	pdf = zero
	if (debug_active (D_SHOWER)) then
	if (abs (mother) /= PROTON) then
	call msg_debug (D_SHOWER, "mother", mother)
	call msg_fatal ("Shower: pdf only implemented for (anti-)proton")
	end if
	if (.not. (abs (daughter) >= 1 .and. abs (daughter) <= 6 .or. &
	daughter == GLUON)) then
	call msg_debug (D_SHOWER, "daughter", daughter)
	call msg_fatal ("Shower: error in pdf, unknown daughter")
	end if
	end if
	if (x > zero .and. x < one) then
	if ((dble(Q2) - lastQ2) > eps0 .or. (dble(x) - lastx) > eps0) then
	call shower%pdf_data%evolve &
	(dble(x), sqrt (abs (dble(Q2))), f)
	end if
	if (abs (daughter) >= 1 .and. abs (daughter) <= 6) then
	pdf = max (f(daughter * sign (1,mother)), tiny_10)
	else
	pdf = max (f(0), tiny_10)
	end if
	end if
	lastQ2 = dble(Q2)
	lastx = dble(x)
	@
	@ Convert Whizard shower to Pythia6. Currently only works for one
	interaction.
	<<Shower core: shower: TBP>>=
	procedure :: converttopythia => shower_converttopythia
	<<Shower core: procedures>>=
	subroutine shower_converttopythia (shower)
	class(shower_t), intent(in) :: shower
	<<PYJETS COMMON BLOCK>>
	type(parton_t), pointer :: pp, ppparent
	integer :: i
	K = 0
	do i = 1, 2
	!!! get history of the event
	pp => shower%interactions(1)%i%partons(i)%p
	!!! add these partons to the event record
	if (associated (pp%initial)) then
	!!! add hadrons
	K(i,1) = 21
	K(i,2) = pp%initial%type
	K(i,3) = 0
	P(i,1:5) = pp%initial%momentum_to_pythia6 ()
	!!! add partons emitted by the hadron
	ppparent => pp
	do while (associated (ppparent%parent))
	if (ppparent%parent%is_proton ()) then
	exit
	else
	ppparent => ppparent%parent
	end if
	end do
	K(i+2,1) = 21
	K(i+2,2) = ppparent%type
	K(i+2,3) = i
	P(i+2,1:5) = ppparent%momentum_to_pythia6 ()
	!!! add partons in the initial state of the ME
	K(i+4,1) = 21
	K(i+4,2) = pp%type
	K(i+4,3) = i
	P(i+4,1:5) = pp%momentum_to_pythia6 ()
	else
	!!! for e+e- without ISR all entries are the same
	K(i,1) = 21
	K(i,2) = pp%type
	K(i,3) = 0
	P(i,1:5) = pp%momentum_to_pythia6 ()
	P(i+2,:) = P(1,:)
	K(i+2,:) = K(1,:)
	K(i+2,3) = i
	P(i+4,:) = P(1,:)
	K(i+4,:) = K(1,:)
	K(i+4,3) = i
	P(i+4,5) = 0.
	end if
	end do
	N = 6
	!!! create intermediate (fake) Z-Boson
	!K(7,1) = 21
	!K(7,2) = 23
	!K(7,3) = 0
	!P(7,1:4) = P(5,1:4) + P(6,1:4)
	!P(7,5) = P(7,4)2 - P(7,3)2 - P(7,2)2 - P(7,1)2
	!N = 7
	!!! include partons in the final state of the hard matrix element
	do i = 1, size (shower%interactions(1)%i%partons) - 2
	!!! get partons that are in the final state of the hard matrix element
	pp => shower%interactions(1)%i%partons(2+i)%p
	!!! add these partons to the event record
	K(7+I,1) = 21
	K(7+I,2) = pp%type
	K(7+I,3) = 7
	P(7+I,1:5) = pp%momentum_to_pythia6 ()
	!N = 7 + I
	N = 6 + I
	end do
	!!! include "Z" (again)
	!N = N + 1
	!K(N,1) = 11
	!K(N,2) = 23
	!K(N,3) = 7
	!P(N,1:5) = P(7,1:5)
	!nz = N
	!!! include partons from the final state of the parton shower
	call shower_transfer_final_partons_to_pythia (shower, 8)
	!!! set "children" of "Z"
	!K(nz,4) = 11
	!K(nz,5) = N

	!!! be sure to remove the next partons (=first obsolete partons)
	!!! otherwise they might be interpreted as thrust information
	K(N+1:N+3,1:3) = 0
	end subroutine shower_converttopythia

	@ %def shower_converttopythia
	@
	<<Shower core: procedures>>=
	subroutine shower_transfer_final_partons_to_pythia (shower, first)
	<<PYJETS COMMON BLOCK>>
	type(shower_t), intent(in) :: shower
	integer, intent(in) :: first
	type(parton_t), pointer :: prt
	integer :: i, j, n_finals
	type(parton_t), dimension(:), allocatable :: final_partons
	type(parton_t) :: temp_parton
	integer :: minindex, maxindex

	prt => null()

	!!! get total number of final partons
	n_finals = 0
	do i = 1, size (shower%partons)
	if (.not. associated (shower%partons(i)%p)) cycle
	prt => shower%partons(i)%p
	if (.not. prt%belongstoFSR) cycle
	if (associated (prt%child1)) cycle
	n_finals = n_finals + 1
	end do

	allocate (final_partons(1:n_finals))
	j = 1
	do i = 1, size (shower%partons)
	if (.not. associated (shower%partons(i)%p)) cycle
	prt => shower%partons(i)%p
	if (.not. prt%belongstoFSR) cycle
	if (associated (prt%child1)) cycle
	final_partons(j) = shower%partons(i)%p
	j = j + 1
	end do

	!!! move quark to front as beginning of color string
	minindex = 1
	maxindex = size (final_partons)
	FIND_Q: do i = minindex, maxindex
	if (final_partons(i)%type >= 1 .and. final_partons(i)%type <= 6) then
	temp_parton = final_partons(minindex)
	final_partons(minindex) = final_partons(i)
	final_partons(i) = temp_parton
	exit FIND_Q
	end if
	end do FIND_Q

	!!! sort so that connected partons are next to each other, don't care about zeros
	do i = 1, size (final_partons)
	!!! ensure that final_partnons begins with a color (not an anticolor)
	if (final_partons(i)%c1 > 0 .and. final_partons(i)%c2 == 0) then
	if (i == 1) then
	exit
	else
	temp_parton = final_partons(1)
	final_partons(1) = final_partons(i)
	final_partons(i) = temp_parton
	exit
	end if
	end if
	end do

	do i = 1, size (final_partons) - 1
	!!! search for color partner and move it to i + 1
	PARTNERS: do j = i + 1, size (final_partons)
	if (final_partons(j)%c2 == final_partons(i)%c1) exit PARTNERS
	end do PARTNERS
	if (j > size (final_partons)) then
	print *, "no color connected parton found" !WRONG???
	print *, "particle: ", final_partons(i)%nr, " index: ", &
	final_partons(i)%c1
	exit
	end if
	temp_parton = final_partons(i + 1)
	final_partons(i + 1) = final_partons(j)
	final_partons(j) = temp_parton
	end do

	!!! transfering partons
	do i = 1, size (final_partons)
	prt = final_partons(i)
	N = N + 1
	K(N,1) = 2
	if (prt%c1 == 0) K(N,1) = 1 !!! end of color string
	K(N,2) = prt%type
	!K(N,3) = first
	K(N,3) = 0
	K(N,4) = 0
	K(N,5) = 0
	P(N,1:5) = prt%momentum_to_pythia6()
	end do
	deallocate (final_partons)
	end subroutine shower_transfer_final_partons_to_pythia

	@ %def shower_transfer_final_partons_to_pythia
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	-\section{Interface to PYTHIA}
	+\section{Interface to PYTHIA 6}
	<<[[shower_pythia6.f90]]>>=
	<<File header>>

	module shower_pythia6

	<<Use kinds with double>>
	<<Use strings>>
	use constants
	use numeric_utils, only: vanishes
	use io_units
	use physics_defs
	use diagnostics
	use os_interface
	use lorentz
	use subevents
	use shower_base
	use particles
	use model_data
	use hep_common
	use pdf
	use helicities
	use tauola_interface

	<<Standard module head>>

	<<Shower pythia6: public>>
	<<Shower pythia6: variables>>
	<<Shower pythia6: types>>

	contains

	<<Shower pythia6: procedures>>

	end module shower_pythia6

	@ %def shower_topythia
	<<PYJETS COMMON BLOCK>>=
	integer :: N, NPAD, K
	real(double) :: P, V
	COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
	SAVE /PYJETS/
	@
	<<Shower pythia6: variables>>=
	integer :: N_old

	@ %def N_old
	@ The PYTHIA6 shower type.
	<<Shower pythia6: public>>=
	public :: shower_pythia6_t
	<<Shower pythia6: types>>=
	type, extends (shower_base_t) :: shower_pythia6_t
	integer :: initialized_for_NPRUP = 0
	logical :: warning_given = .false.
	contains
	<<Shower pythia6: shower pythia6: TBP>>
	end type shower_pythia6_t

	@ %def shower_pythia6_t
	@ Initialize the PYTHIA6 shower.
	<<Shower pythia6: shower pythia6: TBP>>=
	procedure :: init => shower_pythia6_init
	<<Shower pythia6: procedures>>=
	- subroutine shower_pythia6_init (shower, settings, taudec_settings, pdf_data)
	+ subroutine shower_pythia6_init (shower, settings, taudec_settings, pdf_data, os_data)
	class(shower_pythia6_t), intent(out) :: shower
	type(shower_settings_t), intent(in) :: settings
	type(taudec_settings_t), intent(in) :: taudec_settings
	type(pdf_data_t), intent(in) :: pdf_data
	+ type(os_data_t), intent(in) :: os_data
	call msg_debug (D_SHOWER, "shower_pythia6_init")
	shower%settings = settings
	shower%taudec_settings = taudec_settings
	+ shower%os_data = os_data
	call pythia6_set_verbose (settings%verbose)
	call shower%pdf_data%init (pdf_data)
	shower%name = "PYTHIA6"
	call shower%write_msg ()
	end subroutine shower_pythia6_init

	@ %def shower_pythia6_init
	@
	-@
	-<<Shower pythia6: shower pythia6: TBP>>=
	- procedure :: prepare_new_event => shower_pythia6_prepare_new_event
	-<<Shower pythia6: procedures>>=
	- subroutine shower_pythia6_prepare_new_event (shower)
	- class(shower_pythia6_t), intent(inout) :: shower
	- end subroutine shower_pythia6_prepare_new_event
	-
	-@ %def shower_pythia6_prepare_new_event
	<<Shower pythia6: shower pythia6: TBP>>=
	procedure :: import_particle_set => shower_pythia6_import_particle_set
	<<Shower pythia6: procedures>>=
	subroutine shower_pythia6_import_particle_set &
	- (shower, particle_set, os_data, scale)
	+ (shower, particle_set)
	class(shower_pythia6_t), target, intent(inout) :: shower
	type(particle_set_t), intent(in) :: particle_set
	- type(os_data_t), intent(in) :: os_data
	- real(default), intent(in) :: scale
	type(particle_set_t) :: pset_reduced
	call msg_debug (D_SHOWER, "shower_pythia6_import_particle_set")
	if (debug_active (D_SHOWER)) then
	print *, 'IDBMUP(1:2) = ', IDBMUP(1:2)
	print *, 'EBMUP, PDFGUP = ', EBMUP, PDFGUP
	print *, 'PDFSUP, IDWTUP = ', PDFSUP, IDWTUP
	print *, "NPRUP = ", NPRUP
	call particle_set%write (summary=.true., compressed=.true.)
	end if
	call particle_set%reduce (pset_reduced)
	if (debug2_active (D_SHOWER)) then
	print *, 'After particle_set%reduce: pset_reduced'
	call pset_reduced%write (summary=.true., compressed=.true.)
	end if
	call hepeup_from_particle_set (pset_reduced, tauola_convention=.true.)
	call hepeup_set_event_parameters (proc_id = 1)
	- call hepeup_set_event_parameters (scale = scale)
	+ call hepeup_set_event_parameters (scale = shower%fac_scale)
	end subroutine shower_pythia6_import_particle_set

	@ %def shower_pythia6_import_particle_set
	@
	<<Shower pythia6: shower pythia6: TBP>>=
	procedure :: generate_emissions => shower_pythia6_generate_emissions
	<<Shower pythia6: procedures>>=
	subroutine shower_pythia6_generate_emissions &
	(shower, valid, number_of_emissions)
	IMPLICIT DOUBLE PRECISION(A-H, O-Z)
	IMPLICIT INTEGER(I-N)
	COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
	SAVE/PYDAT1/
	class(shower_pythia6_t), intent(inout), target :: shower
	logical, intent(out) :: valid
	integer, optional, intent(in) :: number_of_emissions
	integer :: N, NPAD, K
	real(double) :: P, V
	common /PYJETS/ N, NPAD, K(4000,5), P(4000,5), V(4000,5)
	COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
	COMMON/PYINT4/MWID(500),WIDS(500,5)
	save /PYJETS/,/PYDAT2/,/PYINT4/
	integer :: u_W2P
	integer :: i
	real(double) :: beta_z, pz_in, E_in
	integer, parameter :: lower = 5
	real(double), parameter :: beta_x = 0.0_double
	real(double), parameter :: beta_y = 0.0_double
	real(double), parameter :: theta = 0.0_double
	real(double), parameter :: phi = 0.0_double
	if (signal_is_pending ()) return
	call pythia6_setup_lhe_io_units (u_W2P)
	call w2p_write_lhef_event (u_W2P)
	rewind (u_W2P)
	call pythia6_set_last_treated_line(6)
	call shower%transfer_settings ()
	if (debug_active (D_SHOWER)) then
	print *, ' Before pyevnt, before boosting :'
	call pylist(2)
	end if
	call msg_debug (D_SHOWER, "calling pyevnt")
	! TODO: (bcn 2015-04-24) doesnt change anything I think
	! P(1,1:5) = pset_reduced%prt(1)%momentum_to_pythia6 ()
	! P(2,1:5) = pset_reduced%prt(2)%momentum_to_pythia6 ()
	call pyevnt ()
	call pyedit(12)
	do i = 1, n
	if (K(i,1) == 14 .and. abs(K(i,2)) >= 11 .and. abs(K(i,2)) <= 16) then
	if (K(i,4) > 0 .and. K(i,5) > 0 .and. K(i,4) < N .and. K(i,5) < N) then
	K(i,1) = 11
	K(i,4) = K(K(i,4),3)
	K(i,5) = K(K(i,5),3)
	end if
	end if
	end do
	if (.not. shower%settings%hadron_collision) then
	pz_in = pup(3,1) + pup(3,2)
	E_in = pup(4,1) + pup(4,2)
	beta_z = pz_in / E_in
	call pyrobo (lower, N, theta, phi, beta_x, beta_y, beta_z)
	end if
	if (debug_active (D_SHOWER)) then
	print *, ' After pyevnt, after boosting :'
	call pylist(2)
	if (debug2_active (D_SHOWER)) then
	call pystat (5)
	do i = 1, 200
	print *, 'MSTJ (', i, ') = ', MSTJ(i)
	print *, 'MSTU (', i, ') = ', MSTU(i)
	print *, 'PMAS (', i, ') = ', PMAS(i,1), PMAS(i,2)
	print *, 'MWID (', i, ') = ', MWID(i)
	print *, 'PARJ (', i, ') = ', PARJ(i)
	end do
	end if
	end if
	close (u_W2P)
	valid = pythia6_handle_errors ()
	end subroutine shower_pythia6_generate_emissions

	@ %def shower_pythia6_generate_emissions
	@
	<<Shower pythia6: shower pythia6: TBP>>=
	procedure :: make_particle_set => shower_pythia6_make_particle_set
	<<Shower pythia6: procedures>>=
	subroutine shower_pythia6_make_particle_set &
	(shower, particle_set, model, model_hadrons)
	class(shower_pythia6_t), intent(in) :: shower
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	class(model_data_t), intent(in), target :: model_hadrons
	call shower%combine_with_particle_set (particle_set, model, model_hadrons)
	end subroutine shower_pythia6_make_particle_set

	@ %def shower_pythia6_make_particle_set
	@
	<<Shower pythia6: shower pythia6: TBP>>=
	procedure :: transfer_settings => shower_pythia6_transfer_settings
	<<Shower pythia6: procedures>>=
	subroutine shower_pythia6_transfer_settings (shower)
	class(shower_pythia6_t), intent(inout) :: shower
	character(len=10) :: buffer
	real(default) :: rand
	logical, save :: tauola_initialized = .false.
	call msg_debug (D_SHOWER, "shower_pythia6_transfer_settings")
	!!! We repeat these as they are overwritten by the hadronization
	call pygive ("MSTP(111)=1") !!! Allow hadronization and decays
	call pygive ("MSTJ(1)=0") !!! No jet fragmentation
	call pygive ("MSTJ(21)=1") !!! Allow decays but no jet fragmentation

	if (shower%initialized_for_NPRUP >= NPRUP) then
	call msg_debug (D_SHOWER, "calling upinit")
	call upinit ()
	else
	if (shower%settings%isr_active) then
	call pygive ("MSTP(61)=1")
	else
	call pygive ("MSTP(61)=0") !!! switch off ISR
	end if
	if (shower%settings%fsr_active) then
	call pygive ("MSTP(71)=1")
	else
	call pygive ("MSTP(71)=0") !!! switch off FSR
	end if
	call pygive ("MSTP(11)=0") !!! Disable Pythias QED-ISR per default
	call pygive ("MSTP(171)=1") !!! Allow variable energies

	write (buffer, "(F10.5)") sqrt (abs (shower%settings%min_virtuality))
	call pygive ("PARJ(82)=" // buffer)
	write (buffer, "(F10.5)") shower%settings%isr_tscalefactor
	call pygive ("PARP(71)=" // buffer)
	write (buffer, "(F10.5)") shower%settings%fsr_lambda
	call pygive ("PARP(72)=" // buffer)
	write(buffer, "(F10.5)") shower%settings%isr_lambda
	call pygive ("PARP(61)=" // buffer)
	write (buffer, "(I10)") shower%settings%max_n_flavors
	call pygive ("MSTJ(45)=" // buffer)
	if (shower%settings%isr_alphas_running) then
	call pygive ("MSTP(64)=2")
	else
	call pygive ("MSTP(64)=0")
	end if
	if (shower%settings%fsr_alphas_running) then
	call pygive ("MSTJ(44)=2")
	else
	call pygive ("MSTJ(44)=0")
	end if
	write (buffer, "(F10.5)") shower%settings%fixed_alpha_s
	call pygive ("PARU(111)=" // buffer)
	write (buffer, "(F10.5)") shower%settings%isr_primordial_kt_width
	call pygive ("PARP(91)=" // buffer)
	write (buffer, "(F10.5)") shower%settings%isr_primordial_kt_cutoff
	call pygive ("PARP(93)=" // buffer)
	write (buffer, "(F10.5)") 1._double - shower%settings%isr_z_cutoff
	call pygive ("PARP(66)=" // buffer)
	write (buffer, "(F10.5)") shower%settings%isr_minenergy
	call pygive ("PARP(65)=" // buffer)
	if (shower%settings%isr_only_onshell_emitted_partons) then
	call pygive ("MSTP(63)=0")
	else
	call pygive ("MSTP(63)=2")
	end if
	if (shower%settings%mlm_matching) then
	call pygive ("MSTP(62)=2")
	call pygive ("MSTP(67)=0")
	end if
	call pythia6_set_config (shower%settings%pythia6_pygive)
	call msg_debug (D_SHOWER, "calling pyinit")
	call PYINIT ("USER", "", "", 0D0)
	call shower%rng%generate (rand)
	write (buffer, "(I10)") floor (rand*900000000)
	call pygive ("MRPY(1)=" // buffer)
	call pygive ("MRPY(2)=0")
	call pythia6_set_config (shower%settings%pythia6_pygive)
	shower%initialized_for_NPRUP = NPRUP
	end if
	if (shower%settings%tau_dec) then
	call pygive ("MSTJ(28)=2")
	end if
	if (pythia6_tauola_active() .and. .not. tauola_initialized) then
	call wo_tauola_init_call (shower%taudec_settings)
	tauola_initialized = .true.
	end if
	end subroutine shower_pythia6_transfer_settings

	@ %def shower_pythia6_transfer_settings
	<<Shower pythia6: shower pythia6: TBP>>=
	procedure :: combine_with_particle_set => &
	shower_pythia6_combine_with_particle_set
	<<Shower pythia6: procedures>>=
	subroutine shower_pythia6_combine_with_particle_set &
	(shower, particle_set, model_in, model_hadrons)
	class(shower_pythia6_t), intent(in) :: shower
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model_in
	class(model_data_t), intent(in), target :: model_hadrons
	call pythia6_combine_with_particle_set &
	(particle_set, model_in, model_hadrons, shower%settings)
	end subroutine shower_pythia6_combine_with_particle_set

	@ %def shower_pythia6_combine_with_particle_set
	@
	\begin{tabular}{l l}
	K(I,1) & pythia status code \\
	& 1 = undecayed particle or unfragmented parton \\
	& (single or last of parton system) \\
	& 2 = unfragmented parton \\
	& (followed by more partons in the same color singlet \\
	& 3 = unfragmented parton (color info in K(I,4), K(I,5)) \\
	& 11 = decayed particle or fragmented parton \\
	& 12 = fragmented parton \\
	& 13 = fragmented parton that has been removed \\
	& 14 = branched parton with color info like 3 \\
	& 21 = documentation lines \\
	K(I,2) & PDG code \\
	K(I,3) & Parent where known else 0. Unphysical to assign \\
	& particles partons as parents \\
	K(I,4) & Normally first daughter \\
	K(I,5) & Normally last daughter
	\end{tabular}
	The first two particles are always the beams, in Pythia and Whizard.
	We remove all beam remnants (including the ISR photons) since those are
	added back in by Pythia.
	@
	<<Shower pythia6: public>>=
	public :: pythia6_combine_with_particle_set
	@
	<<Shower pythia6: procedures>>=
	subroutine pythia6_combine_with_particle_set (particle_set, model_in, &
	model_hadrons, settings)
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model_in
	class(model_data_t), intent(in), target :: model_hadrons
	type(shower_settings_t), intent(in) :: settings
	class(model_data_t), pointer :: model
	type(vector4_t) :: momentum
	type(particle_t), dimension(:), allocatable :: particles, beams
	integer :: dangling_col, dangling_anti_col, color, anti_color
	integer :: i, j, py_entries, next_color, n_tot_old, parent, real_parent
	integer :: pdg, status, child, hadro_start, i_py, i_whz
	integer, allocatable, dimension(:) :: py_index, whz_index
	logical, allocatable, dimension(:) :: valid
	real(default), parameter :: py_tiny = 1E-10_default
	integer :: N, NPAD, K
	real(double) :: P, V
	common /PYJETS/ N, NPAD, K(4000,5), P(4000,5), V(4000,5)
	save /PYJETS/
	integer, parameter :: KSUSY1 = 1000000, KSUSY2 = 2000000

	if (signal_is_pending ()) return
	if (debug_active (D_SHOWER)) then
	call msg_debug (D_SHOWER, 'Combine PYTHIA6 with particle set')
	call msg_debug (D_SHOWER, 'Particle set before replacing')
	call particle_set%write (summary=.true., compressed=.true.)
	call pylist (2)
	call msg_debug (D_SHOWER, string = "settings%hadron_collision", &
	value = settings%hadron_collision)
	end if
	if (settings%method == PS_PYTHIA6 .and. settings%hadron_collision) then
	call pythia6_set_last_treated_line(2)
	allocate (beams(2))
	beams = particle_set%prt(1:2)
	call particle_set%replace (beams)
	if (debug_active (D_SHOWER)) then
	call msg_debug (D_SHOWER, 'Resetting particle set to')
	call particle_set%write (summary=.true., compressed=.true.)
	end if
	end if
	call fill_hepevt_block_from_pythia ()
	call count_valid_entries_in_pythia_record ()
	call particle_set%without_hadronic_remnants &
	(particles, n_tot_old, py_entries)
	if (debug_active (D_SHOWER)) then
	print *, 'n_tot_old = ', n_tot_old
	print *, 'py_entries = ', py_entries
	end if
	call add_particles_of_pythia ()
	call particle_set%replace (particles)
	if (settings%hadron_collision) then
	call set_parent_child_relations_from_K ()
	call set_parent_child_relations_of_color_strings_to_hadrons ()
	!!! call particle_set%remove_duplicates (py_tiny * 100.0_default)
	else
	call set_parent_child_relations_from_hepevt ()
	end if
	!call fix_nonemitting_outgoings ()
	if (settings%method == PS_WHIZARD) then
	call fudge_whizard_partons_in_hadro ()
	end if
	where ((particle_set%prt%status == PRT_OUTGOING .or. &
	particle_set%prt%status == PRT_VIRTUAL .or. &
	particle_set%prt%status == PRT_BEAM_REMNANT) .and. &
	particle_set%prt%has_children ()) &
	particle_set%prt%status = PRT_RESONANT
	if (debug_active (D_SHOWER)) then
	print *, 'Particle set after replacing'
	call particle_set%write (summary=.true., compressed=.true.)
	print *, ' pythia6_set_last_treated_line will set to: ', N
	end if
	call pythia6_set_last_treated_line(N)

	contains

	<<Shower pythia6: combine with particle set: procedures>>

	end subroutine pythia6_combine_with_particle_set

	@ %def pythia6_combine_with_particle_set
	<<Shower pythia6: combine with particle set: procedures>>=
	subroutine count_valid_entries_in_pythia_record ()
	<<HEPEVT BLOCK>>
	integer :: pset_idx
	logical :: comes_from_cmshower, emitted_zero_momentum_photon, &
	direct_decendent
	integer, parameter :: cmshower = 94
	hadro_start = 0
	allocate (valid(N))
	valid = .false.
	FIND: do i_py = 5, N
	!if (K(i_py,2) >= 91 .and. K(i_py,2) <= 94) then
	if (K(i_py,2) >= 91 .and. K(i_py,2) <= 93) then
	hadro_start = i_py
	exit FIND
	end if
	end do FIND
	do i_py = N, N_old+1, -1
	status = K(i_py,1)
	if (any (P(i_py,1:4) > 1E-8_default * P(1,4)) .and. &
	(status >= 1 .and. status <= 21)) then
	pset_idx = find_pythia_particle (i_py, more_fuzzy=.false.)
	direct_decendent = IDHEP(JMOHEP(1,i_py)) == cmshower .and. &
	JMOHEP(2,i_py) == 0
	emitted_zero_momentum_photon = find_pythia_particle &
	(JMOHEP(1,i_py), more_fuzzy=.false.) == pset_idx
	comes_from_cmshower = status == 1 .and. &
	(direct_decendent .or. emitted_zero_momentum_photon)
	valid(i_py) = pset_idx == 0 .or. comes_from_cmshower
	end if
	end do
	py_entries = count (valid)
	allocate (py_index (py_entries))
	allocate (whz_index (N))
	whz_index = 0
	end subroutine count_valid_entries_in_pythia_record

	@
	<<Shower pythia6: combine with particle set: procedures>>=
	subroutine add_particles_of_pythia ()
	integer :: whizard_status
	integer :: pset_idx, start_in_py
	integer :: ihelicity
	type(helicity_t) :: hel
	real(default) :: lifetime
	type(vector4_t) :: vertex
	dangling_col = 0
	dangling_anti_col = 0
	next_color = 500
	i_whz = 1
	if (settings%method == PS_PYTHIA6 .and. settings%hadron_collision) then
	start_in_py = 3
	else
	start_in_py = 7
	end if
	do i_py = start_in_py, N
	status = K(i_py,1)
	if (valid(i_py)) then
	call assign_colors (color, anti_color)
	momentum = real ([P(i_py,4), P(i_py,1:3)], kind=default)
	pdg = K(i_py,2)
	parent = K(i_py,3)
	call find_model (model, pdg, model_in, model_hadrons)
	if (i_py <= 4) then
	whizard_status = PRT_INCOMING
	else
	if (status <= 10) then
	whizard_status = PRT_OUTGOING
	else
	whizard_status = PRT_VIRTUAL
	end if
	end if
	call particles(n_tot_old+i_whz)%init &
	(whizard_status, pdg, model, color, anti_color, momentum)
	lifetime = V(i_py,5)
	vertex = [real (V(i_py,4), kind=default), &
	real (V(i_py,1), kind=default), &
	real (V(i_py,2), kind=default), &
	real (V(i_py,3), kind=default)]
	if (.not. vanishes(lifetime)) &
	call particles(n_tot_old+i_whz)%set_lifetime (lifetime)
	if (any (.not. vanishes(real(V(i_py,1:4), kind = default)))) &
	call particles(n_tot_old+i_whz)%set_vertex (vertex)
	!!! Set tau helicity set by TAUOLA
	if (abs (pdg) == 15) then
	call wo_tauola_get_helicity (i_py, ihelicity)
	call hel%init (ihelicity)
	call particles(n_tot_old+i_whz)%set_helicity(hel)
	call particles(n_tot_old+i_whz)%set_polarization(PRT_DEFINITE_HELICITY)
	end if
	py_index(i_whz) = i_py
	whz_index(i_py) = n_tot_old + i_whz
	i_whz = i_whz + 1
	else
	pset_idx = find_pythia_particle (i_py, more_fuzzy=.true.)
	whz_index(i_py) = pset_idx
	end if
	end do
	end subroutine add_particles_of_pythia

	@
	<<Shower pythia6: combine with particle set: procedures>>=
	subroutine assign_colors (color, anti_color)
	integer, intent(out) :: color, anti_color
	if ((K(i_py,2) == 21) .or. (abs (K(i_py,2)) <= 8) .or. &
	(abs (K(i_py,2)) >= KSUSY1+1 .and. abs (K(i_py,2)) <= KSUSY1+8) .or. &
	(abs (K(i_py,2)) >= KSUSY2+1 .and. abs (K(i_py,2)) <= KSUSY2+8) .or. &
	(abs (K(i_py,2)) >= 1000 .and. abs (K(i_py,2)) <= 9999) .and. &
	hadro_start == 0) then
	if (dangling_col == 0 .and. dangling_anti_col == 0) then
	! new color string
	! Gluon and gluino only color octets implemented so far
	if (K(i_py,2) == 21 .or. K(i_py,2) == 1000021) then
	color = next_color
	dangling_col = color
	next_color = next_color + 1
	anti_color = next_color
	dangling_anti_col = anti_color
	next_color = next_color + 1
	else if (K(i_py,2) > 0) then ! particles have color
	color = next_color
	dangling_col = color
	anti_color = 0
	next_color = next_color + 1
	else if (K(i_py,2) < 0) then ! antiparticles have anticolor
	anti_color = next_color
	dangling_anti_col = anti_color
	color = 0
	next_color = next_color + 1
	end if
	else if(status == 1) then
	! end of string
	color = dangling_anti_col
	anti_color = dangling_col
	dangling_col = 0
	dangling_anti_col = 0
	else
	! inside the string
	if(dangling_col /= 0) then
	anti_color = dangling_col
	color = next_color
	dangling_col = next_color
	next_color = next_color +1
	else if(dangling_anti_col /= 0) then
	color = dangling_anti_col
	anti_color = next_color
	dangling_anti_col = next_color
	next_color = next_color +1
	else
	call msg_bug ("Couldn't assign colors")
	end if
	end if
	else
	color = 0
	anti_color = 0
	end if
	end subroutine assign_colors

	@
	<<Shower pythia6: combine with particle set: procedures>>=
	subroutine fill_hepevt_block_from_pythia ()
	integer :: first_daughter, second_mother_of_first_daughter, i_hep
	logical :: inconsistent_mother, more_than_one_points_to_first_daugther
	<<HEPEVT BLOCK>>
	call pyhepc(1)
	do i_hep = 1, NHEP
	first_daughter = JDAHEP(1,i_hep)
	if (first_daughter > 0) then
	more_than_one_points_to_first_daugther = &
	count (JDAHEP(1,i_hep:NHEP) == first_daughter) > 1
	if (more_than_one_points_to_first_daugther) then
	second_mother_of_first_daughter = JMOHEP(2,first_daughter)
	! Only entries with codes 91-94 should have a second mother
	if (second_mother_of_first_daughter == 0) then
	inconsistent_mother = JMOHEP(1,first_daughter) /= i_hep
	if (inconsistent_mother) then
	JMOHEP(1,first_daughter) = i_hep
	do j = i_hep + 1, NHEP
	if (JDAHEP(1,j) == first_daughter) then
	JMOHEP(2,first_daughter) = j
	end if
	end do
	end if
	end if
	end if
	end if
	end do
	end subroutine fill_hepevt_block_from_pythia

	<<HEPEVT BLOCK>>=
	integer, parameter :: NMXHEP = 4000
	integer :: NEVHEP
	integer :: NHEP
	integer, dimension(NMXHEP) :: ISTHEP
	integer, dimension(NMXHEP) :: IDHEP
	integer, dimension(2, NMXHEP) :: JMOHEP
	integer, dimension(2, NMXHEP) :: JDAHEP
	double precision, dimension(5, NMXHEP) :: PHEP
	double precision, dimension(4, NMXHEP) :: VHEP
	common /HEPEVT/ &
	NEVHEP, NHEP, ISTHEP, IDHEP, &
	JMOHEP, JDAHEP, PHEP, VHEP
	save /HEPEVT/
	@ Use HEPEVT for parent-child informations
	<<Shower pythia6: combine with particle set: procedures>>=
	subroutine set_parent_child_relations_from_hepevt ()
	integer, allocatable, dimension(:) :: parents
	<<HEPEVT BLOCK>>
	integer :: parent2, parent1, npar
	integer :: jsearch
	call msg_debug (D_SHOWER, &
	"set_parent_child_relations_from_hepevt")
	if (debug_active (D_SHOWER)) then
	print *, 'NHEP, n, py_entries:' , NHEP, n, py_entries
	call pylist(5)
	end if
	do i_whz = 1, py_entries
	parent1 = JMOHEP(1,py_index(i_whz))

	if (IDHEP(py_index(i_whz)) == 94) then
	firstmother: do jsearch = parent1-1, 1, -1
	if (JDAHEP(1,jsearch) /= py_index(i_whz)) then
	exit firstmother
	end if
	parent1 = jsearch
	end do firstmother
	end if

	parent2 = parent1
	if (JMOHEP(2,py_index(i_whz)) > 0) then
	parent2 = JMOHEP(2,py_index(i_whz))
	end if
	if (IDHEP(py_index(i_whz)) == 94) then
	lastmother: do jsearch = parent1+1, py_index(i_whz)
	if (JDAHEP(1,jsearch) /= py_index(i_whz)) then
	exit lastmother
	end if
	parent2 = jsearch
	end do lastmother
	end if

	allocate (parents(parent2-parent1+1))
	parents = 0
	child = n_tot_old + i_whz
	npar = 0
	do parent = parent1, parent2
	if (parent > 0) then
	if (parent <= 2) then
	call particle_set%parent_add_child (parent, child)
	else
	if (whz_index(parent) > 0) then
	npar = npar + 1
	parents(npar) = whz_index(parent)
	call particle_set%prt(whz_index(parent))%add_child (child)
	end if
	end if
	end if
	end do
	parents = pack (parents, parents > 0)
	if (npar > 0) call particle_set%prt(child)%set_parents (parents)
	if (allocated (parents)) deallocate (parents)
	end do
	NHEP = 0
	end subroutine set_parent_child_relations_from_hepevt

	@
	<<Shower pythia6: combine with particle set: procedures>>=
	subroutine fix_nonemitting_outgoings ()
	integer, dimension(1) :: child
	integer, parameter :: cmshower = 94
	do i = 1, size (particle_set%prt)
	associate (p => particle_set%prt(i))
	if (p%get_n_children () == 1) then
	child = p%get_children ()
	if (particle_set%prt(child(1))%get_pdg () == cmshower) then
	j = particle_set%reverse_find_particle (p%get_pdg (), p%p)
	if (j == i) then
	deallocate (p%child)
	p%status = PRT_OUTGOING
	end if
	end if
	end if
	end associate
	end do
	end subroutine fix_nonemitting_outgoings

	<<Shower pythia6: combine with particle set: procedures>>=
	subroutine set_parent_child_relations_from_K ()
	do j = 1, py_entries
	parent = K(py_index(j),3)
	child = n_tot_old + j
	if (parent > 0) then
	if (parent >= 1 .and. parent <= 2) then
	call particle_set%parent_add_child (parent, child)
	else
	real_parent = whz_index (parent)
	if (real_parent > 0 .and. real_parent /= child) then
	call particle_set%parent_add_child (real_parent, child)
	end if
	end if
	end if
	end do
	end subroutine set_parent_child_relations_from_K

	@
	<<Shower pythia6: combine with particle set: procedures>>=
	subroutine set_parent_child_relations_of_color_strings_to_hadrons ()
	integer :: begin_string, end_string, old_start, next_start, real_child
	integer, allocatable, dimension(:) :: parents
	call msg_debug (D_SHOWER, "set_parent_child_relations_of_color_strings_to_hadrons")
	call msg_debug (D_SHOWER, "hadro_start", hadro_start)
	if (hadro_start > 0) then
	old_start = hadro_start
	do
	next_start = 0
	FIND: do i = old_start + 1, N
	if (K(i,2) >= 91 .and. K(i,2) <= 94) then
	next_start = i
	exit FIND
	end if
	end do FIND
	begin_string = K(old_start,3)
	end_string = N
	do i = begin_string, N
	if (K(i,1) == 11) then
	end_string = i
	exit
	end if
	end do
	allocate (parents (end_string - begin_string + 1))
	parents = 0
	real_child = whz_index (old_start)
	do i = begin_string, end_string
	real_parent = whz_index (i)
	if (real_parent > 0) then
	call particle_set%prt(real_parent)%add_child (real_child)
	parents (i - begin_string + 1) = real_parent
	end if
	end do
	call particle_set%prt(real_child)%set_parents (parents)
	deallocate (parents)
	if (next_start == 0) exit
	old_start = next_start
	end do
	end if
	end subroutine set_parent_child_relations_of_color_strings_to_hadrons

	@ We allow to be [[more_fuzzy]] when finding particles for parent child
	relations than when deciding whether we add particles or not.
	<<Shower pythia6: combine with particle set: procedures>>=
	function find_pythia_particle (i_py, more_fuzzy) result (j)
	integer :: j
	integer, intent(in) :: i_py
	logical, intent(in) :: more_fuzzy
	real(default) :: rel_small
	pdg = K(i_py,2)
	momentum = real([P(i_py,4), P(i_py,1:3)], kind=default)
	if (more_fuzzy) then
	rel_small = 1E-6_default
	else
	rel_small = 1E-10_default
	end if
	j = particle_set%reverse_find_particle (pdg, momentum, &
	abs_smallness = py_tiny, &
	rel_smallness = rel_small)
	end function find_pythia_particle

	@ Outgoing partons after hadronization shouldn't happen and is a dirty
	fix to missing mother daughter relation. I suspect that it has to do
	with the ordering of the color string but am not sure.
	<<Shower pythia6: combine with particle set: procedures>>=
	subroutine fudge_whizard_partons_in_hadro ()
	do i = 1, size (particle_set%prt)
	if (particle_set%prt(i)%status == PRT_OUTGOING .and. &
	(particle_set%prt(i)%flv%get_pdg () == GLUON .or. &
	particle_set%prt(i)%flv%get_pdg_abs () < 6) .or. &
	particle_set%prt(i)%status == PRT_BEAM_REMNANT) then
	particle_set%prt(i)%status = PRT_VIRTUAL
	end if
	end do
	end subroutine fudge_whizard_partons_in_hadro

	@ %def fudge_whizard_partons_in_hadro
	@
	<<Shower pythia6: shower pythia6: TBP>>=
	procedure :: get_final_colored_ME_momenta => shower_pythia6_get_final_colored_ME_momenta
	<<Shower pythia6: procedures>>=
	subroutine shower_pythia6_get_final_colored_ME_momenta &
	(shower, momenta)
	class(shower_pythia6_t), intent(in) :: shower
	type(vector4_t), dimension(:), allocatable, intent(out) :: momenta
	<<PYJETS COMMON BLOCK>>
	integer :: i, j, n_jets
	if (signal_is_pending ()) return

	i = 7 !!! final ME partons start in 7th row of event record
	n_jets = 0
	do
	if (K(I,1) /= 21) exit
	if ((K(I,2) == 21) .or. (abs(K(I,2)) <= 6)) then
	n_jets = n_jets + 1
	end if
	i = i + 1
	end do
	if (n_jets == 0) return
	allocate (momenta(1:n_jets))
	i = 7
	j = 1
	do
	if (K(I,1) /= 21) exit
	if ((K(I,2) == 21) .or. (abs(K(I,2)) <= 6)) then
	momenta(j) = real ([P(i,4), P(i,1:3)], kind=default)
	j = j + 1
	end if
	i = i + 1
	end do
	end subroutine shower_pythia6_get_final_colored_ME_momenta

	@ %def shower_pythia6_get_final_colored_ME_momenta
	@
	<<Shower pythia6: public>>=
	public :: pythia6_setup_lhe_io_units
	<<Shower pythia6: procedures>>=
	subroutine pythia6_setup_lhe_io_units (u_W2P, u_P2W)
	integer, intent(out) :: u_W2P
	integer, intent(out), optional :: u_P2W
	character(len=10) :: buffer
	u_W2P = free_unit ()
	if (debug_active (D_SHOWER)) then
	open (unit=u_W2P, status="replace", file="whizardout.lhe", &
	action="readwrite")
	else
	open (unit=u_W2P, status="scratch", action="readwrite")
	end if
	write (buffer, "(I10)") u_W2P
	call pygive ("MSTP(161)=" // buffer) !!! Unit for PYUPIN (LHA)
	call pygive ("MSTP(162)=" // buffer) !!! Unit for PYUPEV (LHA)
	if (present (u_P2W)) then
	u_P2W = free_unit ()
	write (buffer, "(I10)") u_P2W
	call pygive ("MSTP(163)=" // buffer)
	if (debug_active (D_SHOWER)) then
	open (unit=u_P2W, file="pythiaout2.lhe", status="replace", &
	action="readwrite")
	else
	open (unit=u_P2W, status="scratch", action="readwrite")
	end if
	end if
	end subroutine pythia6_setup_lhe_io_units

	@ %def pythia6_setup_lhe_io_units
	@
	<<Shower pythia6: public>>=
	public :: pythia6_set_config
	<<Shower pythia6: procedures>>=
	subroutine pythia6_set_config (pygive_all)
	type(string_t), intent(in) :: pygive_all
	type(string_t) :: pygive_remaining, pygive_partial
	if (len (pygive_all) > 0) then
	pygive_remaining = pygive_all
	do while (len (pygive_remaining) > 0)
	call split (pygive_remaining, pygive_partial, ";")
	call pygive (char (pygive_partial))
	end do
	if (pythia6_get_error() /= 0) then
	call msg_fatal &
	(" PYTHIA6 did not recognize ps_PYTHIA_PYGIVE setting.")
	end if
	end if
	end subroutine pythia6_set_config

	@ %def pythia_6_set_config
	@ Exchanging error messages with PYTHIA6.
	<<Shower pythia6: public>>=
	public :: pythia6_set_error
	<<Shower pythia6: procedures>>=
	subroutine pythia6_set_error (mstu23)
	IMPLICIT DOUBLE PRECISION(A-H, O-Z)
	IMPLICIT INTEGER(I-N)
	COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
	SAVE/PYDAT1/
	integer, intent(in) :: mstu23
	MSTU(23) = mstu23
	end subroutine pythia6_set_error

	@ %def pythia6_set_error
	@
	<<Shower pythia6: public>>=
	public :: pythia6_get_error
	<<Shower pythia6: procedures>>=
	function pythia6_get_error () result (mstu23)
	IMPLICIT DOUBLE PRECISION(A-H, O-Z)
	IMPLICIT INTEGER(I-N)
	COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
	SAVE/PYDAT1/
	integer :: mstu23
	mstu23 = MSTU(23)
	end function pythia6_get_error

	@ %def pythia6_get_error
	@
	<<Shower pythia6: public>>=
	public :: pythia6_tauola_active
	<<Shower pythia6: procedures>>=
	function pythia6_tauola_active () result (active)
	IMPLICIT DOUBLE PRECISION(A-H, O-Z)
	IMPLICIT INTEGER(I-N)
	COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
	SAVE/PYDAT1/
	logical :: active
	active = MSTJ(28) == 2
	end function pythia6_tauola_active

	@ %def pythia6_tauola_active
	@
	<<Shower pythia6: public>>=
	public :: pythia6_handle_errors
	<<Shower pythia6: procedures>>=
	function pythia6_handle_errors () result (valid)
	logical :: valid
	valid = pythia6_get_error () == 0
	if (.not. valid) then
	call pythia6_set_error (0)
	end if
	end function pythia6_handle_errors

	@ %def pythia6_handle_errors
	@
	<<Shower pythia6: public>>=
	public :: pythia6_set_verbose
	<<Shower pythia6: procedures>>=
	subroutine pythia6_set_verbose (verbose)
	logical, intent(in) :: verbose
	if (verbose) then
	call pygive ('MSTU(13)=1')
	else
	call pygive ('MSTU(12)=12345') !!! No title page is written
	call pygive ('MSTU(13)=0') !!! No information is written
	end if
	end subroutine pythia6_set_verbose

	@ %def pythia6_set_verbose
	@
	<<Shower pythia6: public>>=
	public :: pythia6_set_last_treated_line
	<<Shower pythia6: procedures>>=
	subroutine pythia6_set_last_treated_line (last_line)
	integer,intent(in) :: last_line
	N_old = last_line
	end subroutine pythia6_set_last_treated_line

	@ %def pythia6_set_last_treated_line
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	@
	<<[[pythia6_up.f]]>>=
	C...UPINIT
	C...Is supposed to fill the HEPRUP commonblock with info
	C...on incoming beams and allowed processes.

	SUBROUTINE UPINIT

	C...Double precision and integer declarations.
	IMPLICIT DOUBLE PRECISION(A-H, O-Z)
	IMPLICIT INTEGER(I-N)

	C...PYTHIA commonblock: only used to provide read unit MSTP(161).
	COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
	SAVE /PYPARS/

	C...User process initialization commonblock.
	INTEGER MAXPUP
	PARAMETER (MAXPUP=100)
	INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
	DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
	COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
	&IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
	&LPRUP(MAXPUP)
	SAVE /HEPRUP/

	C...Lines to read in assumed never longer than 200 characters.
	PARAMETER (MAXLEN=200)
	CHARACTER*(MAXLEN) STRING

	C...Format for reading lines.
	CHARACTER(len=6) STRFMT
	STRFMT='(A000)'
	WRITE(STRFMT(3:5),'(I3)') MAXLEN

	C...Loop until finds line beginning with "<init>" or "<init ".
	100 READ(MSTP(161),STRFMT,END=130,ERR=130) STRING
	IBEG=0
	110 IBEG=IBEG+1
	C...Allow indentation.
	IF(STRING(IBEG:IBEG).EQ.' '.AND.IBEG.LT.MAXLEN-5) GOTO 110
	IF(STRING(IBEG:IBEG+5).NE.'<init>'.AND.
	&STRING(IBEG:IBEG+5).NE.'<init ') GOTO 100

	C...Read first line of initialization info.
	READ(MSTP(161),*,END=130,ERR=130) IDBMUP(1),IDBMUP(2),EBMUP(1),
	&EBMUP(2),PDFGUP(1),PDFGUP(2),PDFSUP(1),PDFSUP(2),IDWTUP,NPRUP

	C...Read NPRUP subsequent lines with information on each process.
	DO 120 IPR=1,NPRUP
	READ(MSTP(161),*,END=130,ERR=130) XSECUP(IPR),XERRUP(IPR),
	& XMAXUP(IPR),LPRUP(IPR)
	120 CONTINUE
	RETURN

	C...Error exit: give up if initalization does not work.
	130 WRITE(,) ' Failed to read LHEF initialization information.'
	WRITE(,) ' Event generation will be stopped.'
	CALL PYSTOP(12)

	RETURN
	END

	@
	<<[[pythia6_up.f]]>>=
	C...UPEVNT
	C...Dummy routine, to be replaced by a user implementing external
	C...processes. Depending on cross section model chosen, it either has
	C...to generate a process of the type IDPRUP requested, or pick a type
	C...itself and generate this event. The event is to be stored in the
	C...HEPEUP commonblock, including (often) an event weight.

	C...New example: handles a standard Les Houches Events File.

	SUBROUTINE UPEVNT

	C...Double precision and integer declarations.
	IMPLICIT DOUBLE PRECISION(A-H, O-Z)
	IMPLICIT INTEGER(I-N)

	C...PYTHIA commonblock: only used to provide read unit MSTP(162).
	COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
	SAVE /PYPARS/

	C...Added by WHIZARD
	COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
	SAVE/PYDAT1/

	C...User process event common block.
	INTEGER MAXNUP
	PARAMETER (MAXNUP=500)
	INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
	DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
	COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP),
	&ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP),
	&VTIMUP(MAXNUP),SPINUP(MAXNUP)
	SAVE /HEPEUP/

	C...Lines to read in assumed never longer than 200 characters.
	PARAMETER (MAXLEN=200)
	CHARACTER*(MAXLEN) STRING

	C...Format for reading lines.
	CHARACTER(len=6) STRFMT
	STRFMT='(A000)'
	WRITE(STRFMT(3:5),'(I3)') MAXLEN

	C...Loop until finds line beginning with "<event>" or "<event ".
	100 READ(MSTP(162),STRFMT,END=130,ERR=130) STRING
	IBEG=0
	110 IBEG=IBEG+1
	C...Allow indentation.
	IF(STRING(IBEG:IBEG).EQ.' '.AND.IBEG.LT.MAXLEN-6) GOTO 110
	IF(STRING(IBEG:IBEG+6).NE.'<event>'.AND.
	&STRING(IBEG:IBEG+6).NE.'<event ') GOTO 100

	C...Read first line of event info.
	READ(MSTP(162),*,END=130,ERR=130) NUP,IDPRUP,XWGTUP,SCALUP,
	&AQEDUP,AQCDUP

	C...Read NUP subsequent lines with information on each particle.
	DO 120 I=1,NUP
	READ(MSTP(162),*,END=130,ERR=130) IDUP(I),ISTUP(I),
	& MOTHUP(1,I),MOTHUP(2,I),ICOLUP(1,I),ICOLUP(2,I),
	& (PUP(J,I),J=1,5),VTIMUP(I),SPINUP(I)
	120 CONTINUE
	RETURN

	C...Error exit, typically when no more events.
	130 CONTINUE
	C WRITE(,) ' Failed to read LHEF event information.'
	C WRITE(,) ' Will assume end of file has been reached.'
	NUP=0
	MSTI(51)=1
	C...Added by WHIZARD, mark these failed events
	MSTU(23)=1

	RETURN
	END

	@
	<<[[pythia6_up.f]]>>=
	C...UPVETO
	C...Dummy routine, to be replaced by user, to veto event generation
	C...on the parton level, after parton showers but before multiple
	C...interactions, beam remnants and hadronization is added.
	C...If resonances like W, Z, top, Higgs and SUSY particles are handed
	C...undecayed from UPEVNT, or are generated by PYTHIA, they will also
	C...be undecayed at this stage; if decayed their decay products will
	C...have been allowed to shower.

	C...All partons at the end of the shower phase are stored in the
	C...HEPEVT commonblock. The interesting information is
	C...NHEP = the number of such partons, in entries 1 <= i <= NHEP,
	C...IDHEP(I) = the particle ID code according to PDG conventions,
	C...PHEP(J,I) = the (p_x, p_y, p_z, E, m) of the particle.
	C...All ISTHEP entries are 1, while the rest is zeroed.

	C...The user decision is to be conveyed by the IVETO value.
	C...IVETO = 0 : retain current event and generate in full;
	C... = 1 : abort generation of current event and move to next.

	SUBROUTINE UPVETO(IVETO)

	C...HEPEVT commonblock.
	PARAMETER (NMXHEP=4000)
	COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
	&JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
	DOUBLE PRECISION PHEP,VHEP
	SAVE /HEPEVT/

	C...Next few lines allow you to see what info PYVETO extracted from
	C...the full event record for the first two events.
	C...Delete if you don't want it.
	DATA NLIST/0/
	SAVE NLIST
	IF(NLIST.LE.2) THEN
	WRITE(,) ' Full event record at time of UPVETO call:'
	CALL PYLIST(1)
	WRITE(,) ' Part of event record made available to UPVETO:'
	CALL PYLIST(5)
	NLIST=NLIST+1
	ENDIF

	C...Make decision here.
	IVETO = 0

	RETURN
	END

	@ %def pythia6_up.f
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	@
	<<[[ktclus.f90]]>>=
	<<File header>>

	module ktclus

	<<Use kinds>>

	<<KTCLUS: public>>

	contains

	<<KTCLUS: procedures>>

	end module ktclus
	@ %def ktclus
	<<KTCLUS: procedures>>=
	!C-----------------------------------------------------------------------
	!C-----------------------------------------------------------------------
	!C-----------------------------------------------------------------------
	!C KTCLUS: written by Mike Seymour, July 1992.
	!C Last modified November 2000.
	!C Please send comments or suggestions to Mike.Seymour@rl.ac.uk
	!C
	!C This is a general-purpose kt clustering package.
	!C It can handle ee, ep and pp collisions.
	!C It is loosely based on the program of Siggi Bethke.
	!C
	!C The time taken (on a 10MIP machine) is (0.2microsec)N*3
	!C where N is the number of particles.
	!C Over 90 percent of this time is used in subroutine KTPMIN, which
	!C simply finds the minimum member of a one-dimensional array.
	!C It is well worth thinking about optimization: on the SPARCstation
	!C a factor of two increase was obtained simply by increasing the
	!C optimization level from its default value.
	!C
	!C The approach is to separate the different stages of analysis.
	!C KTCLUS does all the clustering and records a merging history.
	!C It returns a simple list of the y values at which each merging
	!C occured. Then the following routines can be called to give extra
	!C information on the most recently analysed event.
	!C KTCLUR is identical but includes an R parameter, see below.
	!C KTYCUT gives the number of jets at each given YCUT value.
	!C KTYSUB gives the number of sub-jets at each given YCUT value.
	!C KTBEAM gives same info as KTCLUS but only for merges with the beam
	!C KTJOIN gives same info as KTCLUS but for merges of sub-jets.
	!C KTRECO reconstructs the jet momenta at a given value of YCUT.
	!C It also gives information on which jets at scale YCUT belong to
	!C which macro-jets at scale YMAC, for studying sub-jet properties.
	!C KTINCL reconstructs the jet momenta according to the inclusive jet
	!C definition of Ellis and Soper.
	!C KTISUB, KTIJOI and KTIREC are like KTYSUB, KTJOIN and KTRECO,
	!C except that they only apply to one inclusive jet at a time,
	!C with the pt of that jet automatically used for ECUT.
	!C KTWICH gives a list of which particles ended up in which jets.
	!C KTWCHS gives the same thing, but only for subjets.
	!C Note that the numbering of jets used by these two routines is
	!C guaranteed to be the same as that used by KTRECO.
	!C
	!C The collision type and analysis type are indicated by the first
	!C argument of KTCLUS. IMODE=<TYPE><ANGLE><MONO><RECOM> where
	!C TYPE: 1=>ee, 2=>ep with p in -z direction, 3=>pe, 4=>pp
	!C ANGLE: 1=>angular kt def., 2=>DeltaR, 3=>f(DeltaEta,DeltaPhi)
	!C where f()=2(cosh(eta)-cos(phi)) is the QCD emission metric
	!C MONO: 1=>derive relative pseudoparticle angles from jets
	!C 2=>monotonic definitions of relative angles
	!C RECOM: 1=>E recombination scheme, 2=>pt scheme, 3=>pt**2 scheme
	!C
	!C There are also abbreviated forms for the most common combinations:
	!C IMODE=1 => E scheme in e+e- (=1111)
	!C 2 => E scheme in ep (=2111)
	!C 3 => E scheme in pe (=3111)
	!C 4 => E scheme in pp (=4111)
	!C 5 => covariant E scheme in pp (=4211)
	!C 6 => covariant pt-scheme in pp (=4212)
	!C 7 => covariant monotonic pt**2-scheme in pp (=4223)
	!C
	!C KTRECO no longer needs to reconstruct the momenta according to the
	!C same recombination scheme in which they were clustered. Its first
	!C argument gives the scheme, taking the same values as RECOM above.
	!C
	!C Note that unlike previous versions, all variables which hold y
	!C values have been named in a consistent way:
	!C Y() is the output scale at which jets were merged,
	!C YCUT is the input scale at which jets should be counted, and
	!C jet-momenta reconstructed etc,
	!C YMAC is the input macro-jet scale, used in determining whether
	!C or not each jet is a sub-jet.
	!C The original scheme defined in our papers is equivalent to always
	!C setting YMAC=1.
	!C Whenever a YCUT or YMAC variable is used, it is rounded down
	!C infinitesimally, so that for example, setting YCUT=Y(2) refers
	!C to the scale where the event is 2-jet, even if rounding errors
	!C have shifted its value slightly.
	!C
	!C An R parameter can be used in hadron-hadron collisions by
	!C calling KTCLUR instead of KTCLUS. This is as suggested by
	!C Ellis and Soper, but implemented slightly differently,
	!C as in M.H. Seymour, LU TP 94/2 (submitted to Nucl. Phys. B.).
	!C R**2 multiplies the single Kt everywhere it is used.
	!C Calling KTCLUR with R=1 is identical to calling KTCLUS.
	!C R plays a similar role to the jet radius in a cone-type algorithm,
	!C but is scaled up by about 40% (ie R=0.7 in a cone algorithm is
	!C similar to this algorithm with R=1).
	!C Note that R.EQ.1 must be used for the e+e- and ep versions,
	!C and is strongly recommended for the hadron-hadron version.
	!C However, R values smaller than 1 have been found to be useful for
	!C certain applications, particularly the mass reconstruction of
	!C highly-boosted colour-singlets such as high-pt hadronic Ws,
	!C as in M.H. Seymour, LU TP 93/8 (to appear in Z. Phys. C.).
	!C Situations in which R<1 is useful are likely to also be those in
	!C which the inclusive reconstruction method is more useful.
	!C
	!C Also included is a set of routines for doing Lorentz boosts:
	!C KTLBST finds the boost matrix to/from the cm frame of a 4-vector
	!C KTRROT finds the rotation matrix from one vector to another
	!C KTMMUL multiplies together two matrices
	!C KTVMUL multiplies a vector by a matrix
	!C KTINVT inverts a transformation matrix (nb NOT a general 4 by 4)
	!C KTFRAM boosts a list of vectors between two arbitrary frames
	!C KTBREI boosts a list of vectors between the lab and Breit frames
	!C KTHADR boosts a list of vectors between the lab and hadronic cmf
	!C The last two need the momenta in the +z direction of the lepton
	!C and hadron beams, and the 4-momentum of the outgoing lepton.
	!C
	!C The main reference is:
	!C S. Catani, Yu.L. Dokshitzer, M.H. Seymour and B.R. Webber,
	!C Nucl.Phys.B406(1993)187.
	!C The ep version was proposed in:
	!C S. Catani, Yu.L. Dokshitzer and B.R. Webber,
	!C Phys.Lett.285B(1992)291.
	!C The inclusive reconstruction method was proposed in:
	!C S.D. Ellis and D.E. Soper,
	!C Phys.Rev.D48(1993)3160.
	!C
	!C-----------------------------------------------------------------------
	!C-----------------------------------------------------------------------
	!C-----------------------------------------------------------------------
	<<KTCLUS: public>>=
	public :: ktclur
	<<KTCLUS: procedures>>=
	SUBROUTINE KTCLUR(IMODE,PP,NN,R,ECUT,Y,*)
	use io_units
	IMPLICIT NONE
	!C---DO CLUSTER ANALYSIS OF PARTICLES IN PP
	!C
	!C IMODE = INPUT : DESCRIBED ABOVE
	!C PP(I,J) = INPUT : 4-MOMENTUM OF Jth PARTICLE: I=1,4 => PX,PY,PZ,E
	!C NN = INPUT : NUMBER OF PARTICLES
	!C R = INPUT : ELLIS AND SOPER'S R PARAMETER, SEE ABOVE.
	!C ECUT = INPUT : DENOMINATOR OF KT MEASURE. IF ZERO, ETOT IS USED
	!C Y(J) = OUTPUT : VALUE OF Y FOR WHICH EVENT CHANGES FROM BEING
	!C J JET TO J-1 JET
	!C LAST ARGUMENT IS LABEL TO JUMP TO IF FOR ANY REASON THE EVENT
	!C COULD NOT BE PROCESSED (MOST LIKELY DUE TO TOO MANY PARTICLES)
	!C
	!C NOTE THAT THE MOMENTA ARE DECLARED DOUBLE PRECISION,
	!C AND ALL OTHER FLOATING POINT VARIABLES ARE DECLARED DOUBLE PRECISION
	!C
	INTEGER NMAX,IM,IMODE,TYPE,ANGL,MONO,RECO,N,I,J,NN, &
	IMIN,JMIN,KMIN,NUM,HIST,INJET,IABBR,NABBR
	PARAMETER (NMAX=512,NABBR=7)
	DOUBLE PRECISION PP(4,*)
	integer :: u
	!CHANGE DOUBLE PRECISION R,ECUT,Y(*),P,KT,ETOT,RSQ,KTP,KTS,KTPAIR,KTSING, &
	DOUBLE PRECISION R,ECUT,Y(*),P,KT,ETOT,RSQ,KTP,KTS, &
	KTMIN,ETSQ,KTLAST,KTMAX,KTTMP
	LOGICAL FIRST
	CHARACTER TITLE(4,4)*10
	!C---KT RECORDS THE KT**2 OF EACH MERGING.
	!C---KTLAST RECORDS FOR EACH MERGING, THE HIGHEST ECUT**2 FOR WHICH THE
	!C RESULT IS NOT MERGED WITH THE BEAM (COULD BE LARGER THAN THE
	!C KT**2 AT WHICH IT WAS MERGED IF THE KT VALUES ARE NOT MONOTONIC).
	!C THIS MAY SOUND POINTLESS, BUT ITS USEFUL FOR DETERMINING WHETHER
	!C SUB-JETS SURVIVED TO SCALE Y=YMAC OR NOT.
	!C---HIST RECORDS MERGING HISTORY:
	!C N=>DELETED TRACK N, M*NMAX+N=>MERGED TRACKS M AND N (M<N).
	COMMON /KTCOMM/ETOT,RSQ,P(9,NMAX),KTP(NMAX,NMAX),KTS(NMAX), &
	KT(NMAX),KTLAST(NMAX),HIST(NMAX),NUM
	DIMENSION INJET(NMAX),IABBR(NABBR)
	DATA FIRST,TITLE,IABBR/.TRUE., &
	'e+e- ','ep ','pe ','pp ', &
	'angle ','DeltaR ','f(DeltaR) ','**********', &
	'no ','yes ','********','********', &
	'E ','Pt ','Pt2 ','********', &
	1111,2111,3111,4111,4211,4212,4223/
	!C---CHECK INPUT
	IM=IMODE
	IF (IM.GE.1.AND.IM.LE.NABBR) IM=IABBR(IM)
	TYPE=MOD(IM/1000,10)
	ANGL=MOD(IM/100 ,10)
	MONO=MOD(IM/10 ,10)
	RECO=MOD(IM ,10)
	IF (NN.GT.NMAX) CALL KTWARN('KT-MAX',100,*999)
	IF (NN.LT.1) CALL KTWARN('KT-LT1',100,*999)
	IF (NN.LT.2.AND.TYPE.EQ.1) CALL KTWARN('KT-LT2',100,*999)
	IF (TYPE.LT.1.OR.TYPE.GT.4.OR.ANGL.LT.1.OR.ANGL.GT.4.OR. &
	MONO.LT.1.OR.MONO.GT.2.OR.RECO.LT.1.OR.RECO.GT.3) CALL KTWARN('KTCLUS',101,*999)
	u = given_output_unit ()
	IF (FIRST) THEN
	WRITE (u,'(/,1X,54(''*'')/A)') &
	' KTCLUS: written by Mike Seymour, July 1992.'
	WRITE (u,'(A)') &
	' Last modified November 2000.'
	WRITE (u,'(A)') &
	' Please send comments or suggestions to Mike.Seymour@rl.ac.uk'
	WRITE (u,'(/A,I2,2A)') &
	' Collision type =',TYPE,' = ',TITLE(TYPE,1)
	WRITE (u,'(A,I2,2A)') &
	' Angular variable =',ANGL,' = ',TITLE(ANGL,2)
	WRITE (u,'(A,I2,2A)') &
	' Monotonic definition =',MONO,' = ',TITLE(MONO,3)
	WRITE (u,'(A,I2,2A)') &
	' Recombination scheme =',RECO,' = ',TITLE(RECO,4)
	IF (R.NE.1) THEN
	WRITE (u,'(A,F5.2)') &
	' Radius parameter =',R
	IF (TYPE.NE.4) WRITE (u,'(A)') &
	' R.NE.1 is strongly discouraged for this collision type!'
	ENDIF
	WRITE (u,'(1X,54(''*'')/)')
	FIRST=.FALSE.
	ENDIF
	!C---COPY PP TO P
	N=NN
	NUM=NN
	CALL KTCOPY(PP,N,P,(RECO.NE.1))
	ETOT=0
	DO I=1,N
	ETOT=ETOT+P(4,I)
	END DO
	IF (ETOT.EQ.0) CALL KTWARN('KTCLUS',102,*999)
	IF (ECUT.EQ.0) THEN
	ETSQ=1/ETOT**2
	ELSE
	ETSQ=1/ECUT**2
	ENDIF
	RSQ=R**2
	!C---CALCULATE ALL PAIR KT's
	DO I=1,N-1
	DO J=I+1,N
	KTP(J,I)=-1
	KTP(I,J)=KTPAIR(ANGL,P(1,I),P(1,J),KTP(J,I))
	END DO
	END DO
	!C---CALCULATE ALL SINGLE KT's
	DO I=1,N
	KTS(I)=KTSING(ANGL,TYPE,P(1,I))
	END DO
	KTMAX=0
	!C---MAIN LOOP
	300 CONTINUE
	!C---FIND MINIMUM MEMBER OF KTP
	CALL KTPMIN(KTP,NMAX,N,IMIN,JMIN)
	!C---FIND MINIMUM MEMBER OF KTS
	CALL KTSMIN(KTS,NMAX,N,KMIN)
	!C---STORE Y VALUE OF TRANSITION FROM N TO N-1 JETS
	KTMIN=KTP(IMIN,JMIN)
	KTTMP=RSQ*KTS(KMIN)
	IF ((TYPE.GE.2.AND.TYPE.LE.4).AND. &
	(KTTMP.LE.KTMIN.OR.N.EQ.1)) &
	KTMIN=KTTMP
	KT(N)=KTMIN
	Y(N)=KT(N)*ETSQ
	!C---IF MONO.GT.1, SEQUENCE IS SUPPOSED TO BE MONOTONIC, IF NOT, WARN
	IF (KTMIN.LT.KTMAX.AND.MONO.GT.1) CALL KTWARN('KTCLUS',1,*999)
	IF (KTMIN.GE.KTMAX) KTMAX=KTMIN
	!C---IF LOWEST KT IS TO A BEAM, THROW IT AWAY AND MOVE LAST ENTRY UP
	IF (KTMIN.EQ.KTTMP) THEN
	CALL KTMOVE(P,KTP,KTS,NMAX,N,KMIN,1)
	!C---UPDATE HISTORY AND CROSS-REFERENCES
	HIST(N)=KMIN
	INJET(N)=KMIN
	DO I=N,NN
	IF (INJET(I).EQ.KMIN) THEN
	KTLAST(I)=KTMAX
	INJET(I)=0
	ELSEIF (INJET(I).EQ.N) THEN
	INJET(I)=KMIN
	ENDIF
	END DO
	!C---OTHERWISE MERGE JETS IMIN AND JMIN AND MOVE LAST ENTRY UP
	ELSE
	CALL KTMERG(P,KTP,KTS,NMAX,IMIN,JMIN,N,TYPE,ANGL,MONO,RECO)
	CALL KTMOVE(P,KTP,KTS,NMAX,N,JMIN,1)
	!C---UPDATE HISTORY AND CROSS-REFERENCES
	HIST(N)=IMIN*NMAX+JMIN
	INJET(N)=IMIN
	DO I=N,NN
	IF (INJET(I).EQ.JMIN) THEN
	INJET(I)=IMIN
	ELSEIF (INJET(I).EQ.N) THEN
	INJET(I)=JMIN
	ENDIF
	END DO
	ENDIF
	!C---THATS ALL THERE IS TO IT
	N=N-1
	IF (N.GT.1 .OR. N.GT.0.AND.(TYPE.GE.2.AND.TYPE.LE.4)) GOTO 300
	IF (N.EQ.1) THEN
	KT(N)=1D20
	Y(N)=KT(N)*ETSQ
	ENDIF
	RETURN
	999 RETURN 1
	END SUBROUTINE KTCLUR
	!C-----------------------------------------------------------------------
	<<KTCLUS: public>>=
	public :: ktreco
	<<KTCLUS: procedures>>=
	!C-----------------------------------------------------------------------
	SUBROUTINE KTRECO(RECO,PP,NN,ECUT,YCUT,YMAC,PJET,JET,NJET,NSUB,*)
	IMPLICIT NONE
	!C---RECONSTRUCT KINEMATICS OF JET SYSTEM, WHICH HAS ALREADY BEEN
	!C ANALYSED BY KTCLUS. NOTE THAT NO CONSISTENCY CHECK IS MADE: USER
	!C IS TRUSTED TO USE THE SAME PP VALUES AS FOR KTCLUS
	!C
	!C RECO = INPUT : RECOMBINATION SCHEME (NEED NOT BE SAME AS KTCLUS)
	!C PP(I,J) = INPUT : 4-MOMENTUM OF Jth PARTICLE: I=1,4 => PX,PY,PZ,E
	!C NN = INPUT : NUMBER OF PARTICLES
	!C ECUT = INPUT : DENOMINATOR OF KT MEASURE. IF ZERO, ETOT IS USED
	!C YCUT = INPUT : Y VALUE AT WHICH TO RECONSTRUCT JET MOMENTA
	!C YMAC = INPUT : Y VALUE USED TO DEFINE MACRO-JETS, TO DETERMINE
	!C WHICH JETS ARE SUB-JETS
	!C PJET(I,J)=OUTPUT : 4-MOMENTUM OF Jth JET AT SCALE YCUT
	!C JET(J) =OUTPUT : THE MACRO-JET WHICH CONTAINS THE Jth JET,
	!C SET TO ZERO IF JET IS NOT A SUB-JET
	!C NJET =OUTPUT : THE NUMBER OF JETS
	!C NSUB =OUTPUT : THE NUMBER OF SUB-JETS (EQUAL TO THE NUMBER OF
	!C NON-ZERO ENTRIES IN JET())
	!C LAST ARGUMENT IS LABEL TO JUMP TO IF FOR ANY REASON THE EVENT
	!C COULD NOT BE PROCESSED
	!C
	!C NOTE THAT THE MOMENTA ARE DECLARED DOUBLE PRECISION,
	!C AND ALL OTHER FLOATING POINT VARIABLES ARE DECLARED DOUBLE PRECISION
	!C
	INTEGER NMAX,RECO,NUM,N,NN,NJET,NSUB,JET(*),HIST,IMIN,JMIN,I,J
	PARAMETER (NMAX=512)
	DOUBLE PRECISION PP(4,),PJET(4,)
	DOUBLE PRECISION ECUT,P,KT,KTP,KTS,ETOT,RSQ,ETSQ,YCUT,YMAC,KTLAST, &
	ROUND
	PARAMETER (ROUND=0.99999D0)
	COMMON /KTCOMM/ETOT,RSQ,P(9,NMAX),KTP(NMAX,NMAX),KTS(NMAX), &
	KT(NMAX),KTLAST(NMAX),HIST(NMAX),NUM
	!C---CHECK INPUT
	IF (RECO.LT.1.OR.RECO.GT.3) THEN
	PRINT *,'RECO=',RECO
	CALL KTWARN('KTRECO',100,*999)
	ENDIF
	!C---COPY PP TO P
	N=NN
	IF (NUM.NE.NN) CALL KTWARN('KTRECO',101,*999)
	CALL KTCOPY(PP,N,P,(RECO.NE.1))
	IF (ECUT.EQ.0) THEN
	ETSQ=1/ETOT**2
	ELSE
	ETSQ=1/ECUT**2
	ENDIF
	!C---KEEP MERGING UNTIL YCUT
	100 IF (ETSQKT(N).LT.ROUNDYCUT) THEN
	IF (HIST(N).LE.NMAX) THEN
	CALL KTMOVE(P,KTP,KTS,NMAX,N,HIST(N),0)
	ELSE
	IMIN=HIST(N)/NMAX
	JMIN=HIST(N)-IMIN*NMAX
	CALL KTMERG(P,KTP,KTS,NMAX,IMIN,JMIN,N,0,0,0,RECO)
	CALL KTMOVE(P,KTP,KTS,NMAX,N,JMIN,0)
	ENDIF
	N=N-1
	IF (N.GT.0) GOTO 100
	ENDIF
	!C---IF YCUT IS TOO LARGE THERE ARE NO JETS
	NJET=N
	NSUB=N
	IF (N.EQ.0) RETURN
	!C---SET UP OUTPUT MOMENTA
	DO I=1,NJET
	IF (RECO.EQ.1) THEN
	DO J=1,4
	PJET(J,I)=P(J,I)
	END DO
	ELSE
	PJET(1,I)=P(6,I)*COS(P(8,I))
	PJET(2,I)=P(6,I)*SIN(P(8,I))
	PJET(3,I)=P(6,I)*SINH(P(7,I))
	PJET(4,I)=P(6,I)*COSH(P(7,I))
	ENDIF
	JET(I)=I
	END DO
	!C---KEEP MERGING UNTIL YMAC TO FIND THE FATE OF EACH JET
	300 IF (ETSQKT(N).LT.ROUNDYMAC) THEN
	IF (HIST(N).LE.NMAX) THEN
	IMIN=0
	JMIN=HIST(N)
	NSUB=NSUB-1
	ELSE
	IMIN=HIST(N)/NMAX
	JMIN=HIST(N)-IMIN*NMAX
	IF (ETSQKTLAST(N).LT.ROUNDYMAC) NSUB=NSUB-1
	ENDIF
	DO I=1,NJET
	IF (JET(I).EQ.JMIN) JET(I)=IMIN
	IF (JET(I).EQ.N) JET(I)=JMIN
	END DO
	N=N-1
	IF (N.GT.0) GOTO 300
	ENDIF
	RETURN
	999 RETURN 1
	END SUBROUTINE KTRECO
	!C-----------------------------------------------------------------------
	<<KTCLUS: procedures>>=
	!C-----------------------------------------------------------------------
	FUNCTION KTPAIR(ANGL,P,Q,ANGLE)
	IMPLICIT NONE
	!C---CALCULATE LOCAL KT OF PAIR, USING ANGULAR SCHEME:
	!C 1=>ANGULAR, 2=>DeltaR, 3=>f(DeltaEta,DeltaPhi)
	!C WHERE f(eta,phi)=2(COSH(eta)-COS(phi)) IS THE QCD EMISSION METRIC
	!C---IF ANGLE<0, IT IS SET TO THE ANGULAR PART OF THE LOCAL KT ON RETURN
	!C IF ANGLE>0, IT IS USED INSTEAD OF THE ANGULAR PART OF THE LOCAL KT
	INTEGER ANGL
	! CHANGE DOUBLE PRECISION P(9),Q(9),KTPAIR,R,KTMDPI,ANGLE,ETA,PHI,ESQ
	DOUBLE PRECISION P(9),Q(9),KTPAIR,R,ANGLE,ETA,PHI,ESQ
	!C---COMPONENTS OF MOMENTA ARE PX,PY,PZ,E,1/P,PT,ETA,PHI,PT**2
	R=ANGLE
	IF (ANGL.EQ.1) THEN
	IF (R.LE.0) R=2(1-(P(1)Q(1)+P(2)Q(2)+P(3)Q(3))(P(5)Q(5)))
	ESQ=MIN(P(4),Q(4))**2
	ELSEIF (ANGL.EQ.2.OR.ANGL.EQ.3) THEN
	IF (R.LE.0) THEN
	ETA=P(7)-Q(7)
	PHI=KTMDPI(P(8)-Q(8))
	IF (ANGL.EQ.2) THEN
	R=ETA2+PHI2
	ELSE
	R=2*(COSH(ETA)-COS(PHI))
	ENDIF
	ENDIF
	ESQ=MIN(P(9),Q(9))
	ELSEIF (ANGL.EQ.4) THEN
	ESQ=(1d0/(P(5)Q(5))-P(1)Q(1)-P(2)*Q(2)- &
	P(3)Q(3))2D0/(P(5)Q(5))/(0.0001D0+1d0/P(5)+1d0/Q(5))*2
	R=1d0
	ELSE
	CALL KTWARN('KTPAIR',200,*999)
	STOP
	ENDIF
	KTPAIR=ESQ*R
	IF (ANGLE.LT.0) ANGLE=R
	999 END FUNCTION KTPAIR
	!C-----------------------------------------------------------------------
	FUNCTION KTSING(ANGL,TYPE,P)
	IMPLICIT NONE
	!C---CALCULATE KT OF PARTICLE, USING ANGULAR SCHEME:
	!C 1=>ANGULAR, 2=>DeltaR, 3=>f(DeltaEta,DeltaPhi)
	!C---TYPE=1 FOR E+E-, 2 FOR EP, 3 FOR PE, 4 FOR PP
	!C FOR EP, PROTON DIRECTION IS DEFINED AS -Z
	!C FOR PE, PROTON DIRECTION IS DEFINED AS +Z
	INTEGER ANGL,TYPE
	DOUBLE PRECISION P(9),KTSING,COSTH,R,SMALL
	DATA SMALL/1D-4/
	IF (ANGL.EQ.1.OR.ANGL.EQ.4) THEN
	COSTH=P(3)*P(5)
	IF (TYPE.EQ.2) THEN
	COSTH=-COSTH
	ELSEIF (TYPE.EQ.4) THEN
	COSTH=ABS(COSTH)
	ELSEIF (TYPE.NE.1.AND.TYPE.NE.3) THEN
	CALL KTWARN('KTSING',200,*999)
	STOP
	ENDIF
	R=2*(1-COSTH)
	!C---IF CLOSE TO BEAM, USE APPROX 2(1-COS(THETA))=SIN*2(THETA)
	IF (R.LT.SMALL) R=(P(1)2+P(2)2)P(5)*2
	KTSING=P(4)*2R
	ELSEIF (ANGL.EQ.2.OR.ANGL.EQ.3) THEN
	KTSING=P(9)
	ELSE
	CALL KTWARN('KTSING',201,*999)
	STOP
	ENDIF
	999 END FUNCTION KTSING
	!C-----------------------------------------------------------------------
	SUBROUTINE KTPMIN(A,NMAX,N,IMIN,JMIN)
	IMPLICIT NONE
	!C---FIND THE MINIMUM MEMBER OF A(NMAX,NMAX) WITH IMIN < JMIN <= N
	INTEGER NMAX,N,IMIN,JMIN,KMIN,I,J,K
	!C---REMEMBER THAT A(X+(Y-1)*NMAX)=A(X,Y)
	!C THESE LOOPING VARIABLES ARE J=Y-2, I=X+(Y-1)*NMAX
	DOUBLE PRECISION A(*),AMIN
	K=1+NMAX
	KMIN=K
	AMIN=A(KMIN)
	DO J=0,N-2
	DO I=K,K+J
	IF (A(I).LT.AMIN) THEN
	KMIN=I
	AMIN=A(KMIN)
	ENDIF
	END DO
	K=K+NMAX
	END DO
	JMIN=KMIN/NMAX+1
	IMIN=KMIN-(JMIN-1)*NMAX
	END SUBROUTINE KTPMIN
	!C-----------------------------------------------------------------------
	SUBROUTINE KTSMIN(A,NMAX,N,IMIN)
	IMPLICIT NONE
	!C---FIND THE MINIMUM MEMBER OF A
	INTEGER N,NMAX,IMIN,I
	DOUBLE PRECISION A(NMAX)
	IMIN=1
	DO I=1,N
	IF (A(I).LT.A(IMIN)) IMIN=I
	END DO
	END SUBROUTINE KTSMIN
	!C-----------------------------------------------------------------------
	SUBROUTINE KTCOPY(A,N,B,ONSHLL)
	IMPLICIT NONE
	!C---COPY FROM A TO B. 5TH=1/(3-MTM), 6TH=PT, 7TH=ETA, 8TH=PHI, 9TH=PT**2
	!C IF ONSHLL IS .TRUE. PARTICLE ENTRIES ARE PUT ON-SHELL BY SETTING E=P
	INTEGER I,N
	DOUBLE PRECISION A(4,N)
	LOGICAL ONSHLL
	DOUBLE PRECISION B(9,N),ETAMAX,SINMIN,EPS
	DATA ETAMAX,SINMIN,EPS/10,0,1D-6/
	!C---SINMIN GETS CALCULATED ON FIRST CALL
	IF (SINMIN.EQ.0) SINMIN=1/COSH(ETAMAX)
	DO I=1,N
	B(1,I)=A(1,I)
	B(2,I)=A(2,I)
	B(3,I)=A(3,I)
	B(4,I)=A(4,I)
	B(5,I)=SQRT(A(1,I)2+A(2,I)2+A(3,I)**2)
	IF (ONSHLL) B(4,I)=B(5,I)
	IF (B(5,I).EQ.0) B(5,I)=1D-10
	B(5,I)=1/B(5,I)
	B(9,I)=A(1,I)2+A(2,I)2
	B(6,I)=SQRT(B(9,I))
	B(7,I)=B(6,I)*B(5,I)
	IF (B(7,I).GT.SINMIN) THEN
	B(7,I)=A(4,I)2-A(3,I)2
	IF (B(7,I).LE.EPSB(4,I)*2.OR.ONSHLL) B(7,I)=B(9,I)
	B(7,I)=LOG((B(4,I)+ABS(B(3,I)))**2/B(7,I))/2
	ELSE
	B(7,I)=ETAMAX+2
	ENDIF
	B(7,I)=SIGN(B(7,I),B(3,I))
	IF (A(1,I).EQ.0 .AND. A(2,I).EQ.0) THEN
	B(8,I)=0
	ELSE
	B(8,I)=ATAN2(A(2,I),A(1,I))
	ENDIF
	END DO
	END SUBROUTINE KTCOPY
	!C-----------------------------------------------------------------------
	SUBROUTINE KTMERG(P,KTP,KTS,NMAX,I,J,N,TYPE,ANGL,MONO,RECO)
	IMPLICIT NONE
	!C---MERGE THE Jth PARTICLE IN P INTO THE Ith PARTICLE
	!C J IS ASSUMED GREATER THAN I. P CONTAINS N PARTICLES BEFORE MERGING.
	!C---ALSO RECALCULATING THE CORRESPONDING KTP AND KTS VALUES IF MONO.GT.0
	!C FROM THE RECOMBINED ANGULAR MEASURES IF MONO.GT.1
	!C---NOTE THAT IF MONO.LE.0, TYPE AND ANGL ARE NOT USED
	INTEGER ANGL,RECO,TYPE,I,J,K,N,NMAX,MONO
	DOUBLE PRECISION P(9,NMAX),KTP(NMAX,NMAX),KTS(NMAX),PT,PTT, &
	! CHANGE KTMDPI,KTUP,PI,PJ,ANG,KTPAIR,KTSING,ETAMAX,EPS
	KTUP,PI,PJ,ANG,ETAMAX,EPS
	KTUP(I,J)=KTP(MAX(I,J),MIN(I,J))
	DATA ETAMAX,EPS/10,1D-6/
	IF (J.LE.I) CALL KTWARN('KTMERG',200,*999)
	!C---COMBINE ANGULAR MEASURES IF NECESSARY
	IF (MONO.GT.1) THEN
	DO K=1,N
	IF (K.NE.I.AND.K.NE.J) THEN
	IF (RECO.EQ.1) THEN
	PI=P(4,I)
	PJ=P(4,J)
	ELSEIF (RECO.EQ.2) THEN
	PI=P(6,I)
	PJ=P(6,J)
	ELSEIF (RECO.EQ.3) THEN
	PI=P(9,I)
	PJ=P(9,J)
	ELSE
	CALL KTWARN('KTMERG',201,*999)
	STOP
	ENDIF
	IF (PI.EQ.0.AND.PJ.EQ.0) THEN
	PI=1
	PJ=1
	ENDIF
	KTP(MAX(I,K),MIN(I,K))= &
	(PIKTUP(I,K)+PJKTUP(J,K))/(PI+PJ)
	ENDIF
	END DO
	ENDIF
	IF (RECO.EQ.1) THEN
	!C---VECTOR ADDITION
	P(1,I)=P(1,I)+P(1,J)
	P(2,I)=P(2,I)+P(2,J)
	P(3,I)=P(3,I)+P(3,J)
	!c P(4,I)=P(4,I)+P(4,J) ! JA
	P(5,I)=SQRT(P(1,I)2+P(2,I)2+P(3,I)**2)
	P(4,I)=P(5,I) ! JA (Massless scheme)
	IF (P(5,I).EQ.0) THEN
	P(5,I)=1
	ELSE
	P(5,I)=1/P(5,I)
	ENDIF
	ELSEIF (RECO.EQ.2) THEN
	!C---PT WEIGHTED ETA-PHI ADDITION
	PT=P(6,I)+P(6,J)
	IF (PT.EQ.0) THEN
	PTT=1
	ELSE
	PTT=1/PT
	ENDIF
	P(7,I)=(P(6,I)P(7,I)+P(6,J)P(7,J))*PTT
	P(8,I)=KTMDPI(P(8,I)+P(6,J)PTTKTMDPI(P(8,J)-P(8,I)))
	P(6,I)=PT
	P(9,I)=PT**2
	ELSEIF (RECO.EQ.3) THEN
	!C---PT**2 WEIGHTED ETA-PHI ADDITION
	PT=P(9,I)+P(9,J)
	IF (PT.EQ.0) THEN
	PTT=1
	ELSE
	PTT=1/PT
	ENDIF
	P(7,I)=(P(9,I)P(7,I)+P(9,J)P(7,J))*PTT
	P(8,I)=KTMDPI(P(8,I)+P(9,J)PTTKTMDPI(P(8,J)-P(8,I)))
	P(6,I)=P(6,I)+P(6,J)
	P(9,I)=P(6,I)**2
	ELSE
	CALL KTWARN('KTMERG',202,*999)
	STOP
	ENDIF
	!C---IF MONO.GT.0 CALCULATE NEW KT MEASURES. IF MONO.GT.1 USE ANGULAR ONES.
	IF (MONO.LE.0) RETURN
	!C---CONVERTING BETWEEN 4-MTM AND PT,ETA,PHI IF NECESSARY
	IF (ANGL.NE.1.AND.RECO.EQ.1) THEN
	P(9,I)=P(1,I)2+P(2,I)2
	P(7,I)=P(4,I)2-P(3,I)2
	IF (P(7,I).LE.EPSP(4,I)*2) P(7,I)=P(9,I)
	IF (P(7,I).GT.0) THEN
	P(7,I)=LOG((P(4,I)+ABS(P(3,I)))**2/P(7,I))/2
	IF (P(7,I).GT.ETAMAX) P(7,I)=ETAMAX+2
	ELSE
	P(7,I)=ETAMAX+2
	ENDIF
	P(7,I)=SIGN(P(7,I),P(3,I))
	IF (P(1,I).NE.0.AND.P(2,I).NE.0) THEN
	P(8,I)=ATAN2(P(2,I),P(1,I))
	ELSE
	P(8,I)=0
	ENDIF
	ELSEIF (ANGL.EQ.1.AND.RECO.NE.1) THEN
	P(1,I)=P(6,I)*COS(P(8,I))
	P(2,I)=P(6,I)*SIN(P(8,I))
	P(3,I)=P(6,I)*SINH(P(7,I))
	P(4,I)=P(6,I)*COSH(P(7,I))
	IF (P(4,I).NE.0) THEN
	P(5,I)=1/P(4,I)
	ELSE
	P(5,I)=1
	ENDIF
	ENDIF
	ANG=0
	DO K=1,N
	IF (K.NE.I.AND.K.NE.J) THEN
	IF (MONO.GT.1) ANG=KTUP(I,K)
	KTP(MIN(I,K),MAX(I,K))= &
	KTPAIR(ANGL,P(1,I),P(1,K),ANG)
	ENDIF
	END DO
	KTS(I)=KTSING(ANGL,TYPE,P(1,I))
	999 END SUBROUTINE KTMERG
	!C-----------------------------------------------------------------------
	SUBROUTINE KTMOVE(P,KTP,KTS,NMAX,N,J,IOPT)
	IMPLICIT NONE
	!C---MOVE THE Nth PARTICLE IN P TO THE Jth POSITION
	!C---ALSO MOVING KTP AND KTS IF IOPT.GT.0
	INTEGER I,J,N,NMAX,IOPT
	DOUBLE PRECISION P(9,NMAX),KTP(NMAX,NMAX),KTS(NMAX)
	DO I=1,9
	P(I,J)=P(I,N)
	END DO
	IF (IOPT.LE.0) RETURN
	DO I=1,J-1
	KTP(I,J)=KTP(I,N)
	KTP(J,I)=KTP(N,I)
	END DO
	DO I=J+1,N-1
	KTP(J,I)=KTP(I,N)
	KTP(I,J)=KTP(N,I)
	END DO
	KTS(J)=KTS(N)
	END SUBROUTINE KTMOVE
	!C-----------------------------------------------------------------------
	<<KTCLUS: procedures>>=
	FUNCTION KTMDPI(PHI)
	IMPLICIT NONE
	!C---RETURNS PHI, MOVED ONTO THE RANGE [-PI,PI)
	DOUBLE PRECISION KTMDPI,PHI,PI,TWOPI,THRPI,EPS
	PARAMETER (PI=3.14159265358979324D0,TWOPI=6.28318530717958648D0, &
	THRPI=9.42477796076937972D0)
	PARAMETER (EPS=1D-15)
	KTMDPI=PHI
	IF (KTMDPI.LE.PI) THEN
	IF (KTMDPI.GT.-PI) THEN
	GOTO 100
	ELSEIF (KTMDPI.GT.-THRPI) THEN
	KTMDPI=KTMDPI+TWOPI
	ELSE
	KTMDPI=-MOD(PI-KTMDPI,TWOPI)+PI
	ENDIF
	ELSEIF (KTMDPI.LE.THRPI) THEN
	KTMDPI=KTMDPI-TWOPI
	ELSE
	KTMDPI=MOD(PI+KTMDPI,TWOPI)-PI
	ENDIF
	100 IF (ABS(KTMDPI).LT.EPS) KTMDPI=0
	END FUNCTION KTMDPI
	!C-----------------------------------------------------------------------
	SUBROUTINE KTWARN(SUBRTN,ICODE,*)
	!C DEALS WITH ERRORS DURING EXECUTION
	!C SUBRTN = NAME OF CALLING SUBROUTINE
	!C ICODE = ERROR CODE: - 99 PRINT WARNING & CONTINUE
	!C 100-199 PRINT WARNING & JUMP
	!C 200- PRINT WARNING & STOP DEAD
	!C-----------------------------------------------------------------------
	INTEGER ICODE
	CHARACTER(len=6) SUBRTN
	WRITE (6,10) SUBRTN,ICODE
	10 FORMAT(/' KTWARN CALLED FROM SUBPROGRAM ',A6,': CODE =',I4/)
	IF (ICODE.LT.100) RETURN
	IF (ICODE.LT.200) RETURN 1
	STOP
	END SUBROUTINE KTWARN
	!C-----------------------------------------------------------------------
	!C-----------------------------------------------------------------------
	!C-----------------------------------------------------------------------

	@ %def ktclus ktclur ktycut ktysub
	@ %def ktbeam ktjoin ktreco ktincl
	@ %def ktisub ktijoi ktirec ktwich
	@ %def ktwchs ktfram ktbrei kthadr
	@ %def ktpair ktsing ktpmin ktsmin
	@ %def ktcopy ktmerg ktmove ktunit
	@ %def ktlbst ktrrot ktvmul ktmmul
	@ %def ktinvt ktmdpi ktwarn
	+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	+\section{Interface to PYTHIA 8}
	+<<[[shower_pythia8.f90]]>>=
	+<<File header>>
	+
	+module shower_pythia8
	+
	+ <<Use kinds with double>>
	+ <<Use strings>>
	+ use constants
	+ use numeric_utils, only: vanishes
	+ use io_units
	+ use physics_defs
	+ use diagnostics
	+ use os_interface
	+ use lorentz
	+ use subevents
	+ use shower_base
	+ use particles
	+ use model_data
	+ use pdf
	+ use helicities
	+ use whizard_lha
	+ use pythia8
	+ use tauola_interface, only: taudec_settings_t
	+
	+ <<Standard module head>>
	+
	+ <<Shower pythia8: public>>
	+ <<Shower pythia8: variables>>
	+ <<Shower pythia8: types>>
	+
	+contains
	+
	+ <<Shower pythia8: procedures>>
	+
	+end module shower_pythia8
	+
	+@ %def shower_pythia8
	+@
	+<<Shower pythia8: public>>=
	+ public :: shower_pythia8_t
	+<<Shower pythia8: types>>=
	+ type, extends(shower_base_t) :: shower_pythia8_t
	+ private
	+ type(pythia8_t) :: pythia
	+ type(whizard_lha_t) :: lhaup
	+ logical :: user_process_set = .false.
	+ logical :: pythia_initialized = .false., &
	+ lhaup_initialized = .false.
	+ contains
	+ <<Shower pythia8: shower pythia8: TBP>>
	+ end type shower_pythia8_t
	+
	+@ %def shower_pythia8_t
	+@
	+<<Shower pythia8: shower pythia8: TBP>>=
	+ procedure :: init => shower_pythia8_init
	+<<Shower pythia8: procedures>>=
	+ subroutine shower_pythia8_init (shower, settings, taudec_settings, pdf_data, os_data)
	+ class(shower_pythia8_t), intent(out) :: shower
	+ type(shower_settings_t), intent(in) :: settings
	+ type(taudec_settings_t), intent(in) :: taudec_settings
	+ type(pdf_data_t), intent(in) :: pdf_data
	+ type(os_data_t), intent(in) :: os_data
	+ call msg_debug (D_SHOWER, "shower_pythia8_init")
	+ shower%settings = settings
	+ shower%taudec_settings = taudec_settings
	+ shower%os_data = os_data
	+ call shower%pdf_data%init (pdf_data)
	+ shower%name = "PYTHIA8"
	+ call shower%write_msg ()
	+ call shower%pythia%init (verbose = settings%verbose)
	+ call shower%lhaup%init ()
	+ end subroutine shower_pythia8_init
	+
	+@ %def shower_pythia8_init
	+@ Setup the user process for the LHA interface.
	+
	+We fill the user process with the correct information on the beams,
	+and set the strategy of the user process to weighted events.
	+[[process_id]] and [[n_processes]] are not used by LHA user process for weighted
	+(or unweighted) events, but required by the LHA user process interface.
	+Therefore, we choose arbitrary defaults.
	+<<Shower pythia8: shower pythia8: TBP>>=
	+ procedure, private :: set_user_process => shower_pythia8_set_user_process
	+<<Shower pythia8: procedures>>=
	+ subroutine shower_pythia8_set_user_process (shower, pset)
	+ class(shower_pythia8_t), intent(inout) :: shower
	+ type(particle_set_t), intent(in) :: pset
	+ integer, dimension(2) :: beam_pdg
	+ real(default), dimension(2) :: beam_energy
	+ integer, parameter :: process_id = 1, n_processes = 1
	+ call msg_debug (D_SHOWER, "shower_pythia8_set_user_process")
	+ ! TODO sbrass find correct beam entries, fallback would be first two entries
	+ beam_pdg = [pset%prt(1)%get_pdg (), pset%prt(2)%get_pdg ()]
	+ beam_energy = [energy(pset%prt(1)%p), energy(pset%prt(2)%p)]
	+ call shower%lhaup%set_init (beam_pdg, beam_energy, &
	+ n_processes, unweighted = .false., negative_weights = .false.)
	+ call shower%lhaup%set_process_parameters (process_id = process_id, &
	+ cross_section = one, error = one)
	+ end subroutine shower_pythia8_set_user_process
	+@ %def shower_pythia_set_user_process
	+@ Import a particle set and make it accessible for PYTHIA8 as an user process.
	+We check whether the LHA object needs to be initialized and do the appropriate steps.
	+<<Shower pythia8: shower pythia8: TBP>>=
	+ procedure :: import_particle_set => shower_pythia8_import_particle_set
	+<<Shower pythia8: procedures>>=
	+ subroutine shower_pythia8_import_particle_set &
	+ (shower, particle_set)
	+ class(shower_pythia8_t), target, intent(inout) :: shower
	+ type(particle_set_t), intent(in) :: particle_set
	+ type(particle_set_t) :: pset_reduced
	+ integer, parameter :: PROCESS_ID = 1
	+ logical :: keep_beams
	+ call msg_debug (D_SHOWER, "shower_pythia8_import_particle_set")
	+ if (.not. shower%user_process_set) then
	+ call shower%set_user_process (particle_set)
	+ shower%user_process_set = .true.
	+ end if
	+ if (debug_active (D_SHOWER)) then
	+ call particle_set%write (summary=.true., compressed=.true.)
	+ end if
	+ call shower%lhaup%set_event_process (process_id = PROCESS_ID, scale = shower%fac_scale, &
	+ alpha_qcd = shower%alpha_s, alpha_qed = -one, weight = -one)
	+ call shower%lhaup%set_event (process_id = PROCESS_ID, particle_set = particle_set, &
	+ keep_beams = .false., keep_remnants = .true., polarization = .true.)
	+ if (debug_active (D_SHOWER)) then
	+ call shower%lhaup%list_init ()
	+ call shower%lhaup%list_event ()
	+ end if
	+ end subroutine shower_pythia8_import_particle_set
	+
	+@ %def shower_pythia8_import_particle_set
	+@
	+<<Shower pythia8: shower pythia8: TBP>>=
	+ procedure :: generate_emissions => shower_pythia8_generate_emissions
	+<<Shower pythia8: procedures>>=
	+ subroutine shower_pythia8_generate_emissions &
	+ (shower, valid, number_of_emissions)
	+ class(shower_pythia8_t), intent(inout), target :: shower
	+ logical, intent(out) :: valid
	+ integer, optional, intent(in) :: number_of_emissions
	+ if (signal_is_pending ()) return
	+ call shower%transfer_settings ()
	+ call shower%pythia%next (valid)
	+ end subroutine shower_pythia8_generate_emissions
	+
	+@ %def shower_pythia8_generate_emission
	+@
	+<<Shower pythia8: shower pythia8: TBP>>=
	+ procedure :: make_particle_set => shower_pythia8_make_particle_set
	+<<Shower pythia8: procedures>>=
	+ subroutine shower_pythia8_make_particle_set &
	+ (shower, particle_set, model, model_hadrons)
	+ class(shower_pythia8_t), intent(in) :: shower
	+ type(particle_set_t), intent(inout) :: particle_set
	+ class(model_data_t), intent(in), target :: model
	+ class(model_data_t), intent(in), target :: model_hadrons
	+ type(particle_t), dimension(:), allocatable :: beam
	+ integer :: n_whizard, n_tot_pythia
	+ call msg_debug (D_SHOWER, "shower_pythia8_make_particle_set")
	+ if (signal_is_pending ()) return
	+ associate (settings => shower%settings)
	+ if (debug_active (D_SHOWER)) then
	+ call msg_debug (D_SHOWER, 'Combine PYTHIA8 with particle set')
	+ call msg_debug (D_SHOWER, 'Particle set before replacing')
	+ call particle_set%write (summary=.true., compressed=.true.)
	+ call shower%pythia%list_event ()
	+ call msg_debug (D_SHOWER, string = "settings%hadron_collision", &
	+ value = settings%hadron_collision)
	+ end if
	+ end associate
	+ call shower%pythia%get_shower_particles (&
	+ model, model_hadrons, particle_set, &
	+ helicity = PRT_DEFINITE_HELICITY, &
	+ recover_beams = shower%settings%hadron_collision)
	+ if (debug_active (D_SHOWER)) then
	+ print *, 'Particle set after replacing'
	+ call particle_set%write (summary=.true., compressed=.true.)
	+ end if
	+ end subroutine shower_pythia8_make_particle_set
	+
	+@ %def shower_pythia8_make_particle_set
	+@ Transfer WHIZARD shower settings to Pythia8.
	+Import a pointer to [[shower%rng]] and initialize Pythia itself, at once.
	+<<Shower pythia8: shower pythia8: TBP>>=
	+ procedure, private :: transfer_settings => shower_pythia8_transfer_settings
	+<<Shower pythia8: procedures>>=
	+ subroutine shower_pythia8_transfer_settings (shower)
	+ class(shower_pythia8_t), intent(inout), target :: shower
	+ call msg_debug (D_SHOWER, "shower_pythia8_transfer_settings")
	+ call msg_debug2 (D_SHOWER, "pythia_initialized", shower%pythia_initialized)
	+ if (shower%pythia_initialized) return
	+ associate (pythia => shower%pythia)
	+ call pythia%set_lhaup_ptr (shower%lhaup)
	+ call pythia%import_rng (shower%rng)
	+ call shower%pythia%parse_and_set_config (shower%settings%pythia8_config)
	+ if (len (shower%settings%pythia8_config_file) > 0) &
	+ call pythia%read_file (shower%settings%pythia8_config_file)
	+ call pythia%read_string (var_str ("Beams:frameType = 5"))
	+ ! call pythia%read_string (var_str ("ParticleDecays:allowPhotonRadiation = off"))
	+ call pythia%read_string (var_str ("HadronLevel:all = off"))
	+ if (.not. shower%settings%verbose) then
	+ call pythia%read_string (var_str ("Print:quiet = on"))
	+ end if
	+ if (.not. shower%settings%isr_active) then
	+ call pythia%read_string (var_str ("PartonLevel:ISR = off"))
	+ else
	+ call pythia%read_string (var_str ("PartonLevel:ISR = on"))
	+ end if
	+ if (.not. shower%settings%fsr_active) then
	+ call pythia%read_string (var_str ("PartonLevel:FSR = off"))
	+ else
	+ call pythia%read_string (var_str ("PartonLevel:FSR = on"))
	+ end if
	+ call pythia%init_pythia ()
	+ end associate
	+ shower%pythia_initialized = .true.
	+ end subroutine shower_pythia8_transfer_settings
	+
	+@ %def shower_pythia8_transfer_settings
	+@
	+<<Shower pythia8: shower pythia8: TBP>>=
	+ procedure :: get_final_colored_ME_momenta => shower_pythia8_get_final_colored_ME_momenta
	+<<Shower pythia8: procedures>>=
	+ subroutine shower_pythia8_get_final_colored_ME_momenta &
	+ (shower, momenta)
	+ class(shower_pythia8_t), intent(in) :: shower
	+ type(vector4_t), dimension(:), allocatable, intent(out) :: momenta
	+ call msg_debug (D_MATCHING, "shower_pythia8_get_final_colored_ME_momenta")
	+ call shower%pythia%get_final_colored_ME_momenta (momenta)
	+ end subroutine shower_pythia8_get_final_colored_ME_momenta
	+
	+@ %def shower_pythia8_get_final_colored_ME_momenta
	Index: trunk/src/variables/variables.nw
	===================================================================
	--- trunk/src/variables/variables.nw (revision 8189)
	+++ trunk/src/variables/variables.nw (revision 8190)
	@@ -1,6755 +1,6766 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: variables for processes
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Variables for Processes}
	\includemodulegraph{variables}

	This part introduces variables as user-controlled objects that
	influence the behavior of objects and calculations. Variables contain
	objects of intrinsic type or of a type as introced above.
	\begin{description}
	\item[variables]
	Store values of various kind, used by expressions and accessed by
	the command interface. This provides an implementation of the [[vars_t]]
	abstract type.
	\item[observables]
	Concrete implementation of observables (functions in the variable tree),
	applicable for \whizard.
	abstract type.
	\end{description}

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Variables: Implementation}
	The user interface deals with variables that are handled similarly to
	full-flegded programming languages. The system will add a lot of
	predefined variables (model parameters, flags, etc.) that are
	accessible to the user by the same methods.

	Variables can be of various type: logical (boolean/flag), integer,
	real (default precision), subevents (used in cut expressions),
	arrays of PDG codes (aliases for particles), strings. Furthermore, in
	cut expressions we have unary and binary observables, which are used
	like real parameters but behave like functions.
	<<[[variables.f90]]>>=
	<<File header>>

	module variables

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_utils, only: pac_fmt
	use format_defs, only: FMT_12, FMT_19
	use constants, only: eps0
	use os_interface, only: paths_t
	use physics_defs, only: LAMBDA_QCD_REF
	use system_dependencies
	use fastjet !NODEP!
	use diagnostics
	use pdg_arrays
	use subevents

	use var_base

	<<Standard module head>>

	<<Variables: public>>

	<<Variables: parameters>>

	<<Variables: types>>

	<<Variables: interfaces>>

	contains

	<<Variables: procedures>>

	end module variables
	@ %def variables
	@
	\subsection{Variable list entries}
	Variable (and constant) values can be of one of the following types:
	<<Variables: parameters>>=
	integer, parameter, public :: V_NONE = 0, V_LOG = 1, V_INT = 2, V_REAL = 3
	integer, parameter, public :: V_CMPLX = 4, V_SEV = 5, V_PDG = 6, V_STR = 7
	integer, parameter, public :: V_OBS1_INT = 11, V_OBS2_INT = 12
	integer, parameter, public :: V_OBS1_REAL = 21, V_OBS2_REAL = 22
	integer, parameter, public :: V_UOBS1_INT = 31, V_UOBS2_INT = 32
	integer, parameter, public :: V_UOBS1_REAL = 41, V_UOBS2_REAL = 42

	@ %def V_NONE V_LOG V_INT V_REAL V_CMPLX V_PRT V_SEV V_PDG
	@ %def V_OBS1_INT V_OBS2_INT V_OBS1_REAL V_OBS2_REAL
	@ %def V_UOBS1_INT V_UOBS2_INT V_UOBS1_REAL V_UOBS2_REAL
	@
	\subsubsection{The type}
	This is an entry in the variable list. It can be of any type; in
	each case only one value is allocated. It may be physically
	allocated upon creation, in which case [[is_allocated]] is true, or
	it may contain just a pointer to a value somewhere else, in which case
	[[is_allocated]] is false.

	The flag [[is_defined]] is set when the variable is given a value, even the
	undefined value. (Therefore it is distinct from [[is_known]].) This matters
	for variable declaration in the SINDARIN language. The variable is set up in
	the compilation step and initially marked as defined, but after compilation
	all variables are set undefined. Each variable becomes defined when it is
	explicitly set. The difference matters in loops.

	[[is_locked]] means that it cannot be given a value using the interface
	routines [[var_list_set_XXX]] below. It can only be initialized, or change
	automatically due to a side effect.

	[[is_copy]] means that this is a local copy of a global variable. The copy
	has a pointer to the original, which can be used to restore a previous value.

	[[is_intrinsic]] means that this variable is defined by the program, not by
	the user. Intrinsic variables cannot be (re)declared, but their values can be
	reset unless they are locked. [[is_user_var]] means that the variable has
	been declared by the user. It could be a new variable, or a local copy of an
	intrinsic variable.

	The flag [[is_known]] is a pointer which parallels the use of the
	value pointer. For pointer variables, it is set if the value should point to
	a known value. For ordinary variables, it should be true.

	The value is implemented as a set of alternative type-specific pointers. This
	emulates polymorphism, and it allows for actual pointer variables.
	Observable-type variables have function pointers as values, so they behave
	like macros. The functions make use of the particle objects accessible via
	the pointers [[prt1]] and [[prt2]].

	Finally, the [[next]] pointer indicates that we are making lists of
	variables. A more efficient implementation might switch to hashes or
	similar; the current implementation has $O(N)$ lookup.
	<<Variables: public>>=
	public :: var_entry_t
	<<Variables: types>>=
	type :: var_entry_t
	private
	integer :: type = V_NONE
	type(string_t) :: name
	logical :: is_allocated = .false.
	logical :: is_defined = .false.
	logical :: is_locked = .false.
	logical :: is_intrinsic = .false.
	logical :: is_user_var = .false.
	logical, pointer :: is_known => null ()
	logical, pointer :: lval => null ()
	integer, pointer :: ival => null ()
	real(default), pointer :: rval => null ()
	complex(default), pointer :: cval => null ()
	type(subevt_t), pointer :: pval => null ()
	type(pdg_array_t), pointer :: aval => null ()
	type(string_t), pointer :: sval => null ()
	procedure(obs_unary_int), nopass, pointer :: obs1_int => null ()
	procedure(obs_unary_real), nopass, pointer :: obs1_real => null ()
	procedure(obs_binary_int), nopass, pointer :: obs2_int => null ()
	procedure(obs_binary_real), nopass, pointer :: obs2_real => null ()
	type(prt_t), pointer :: prt1 => null ()
	type(prt_t), pointer :: prt2 => null ()
	type(var_entry_t), pointer :: next => null ()
	type(var_entry_t), pointer :: previous => null ()
	type(string_t) :: description
	end type var_entry_t

	@ %def var_entry_t
	@
	\subsubsection{Interfaces for the observable functions}
	<<Variables: public>>=
	public :: obs_unary_int
	public :: obs_unary_real
	public :: obs_binary_int
	public :: obs_binary_real
	<<Variables: interfaces>>=
	abstract interface
	function obs_unary_int (prt1) result (ival)
	import
	integer :: ival
	type(prt_t), intent(in) :: prt1
	end function obs_unary_int
	end interface
	abstract interface
	function obs_unary_real (prt1) result (rval)
	import
	real(default) :: rval
	type(prt_t), intent(in) :: prt1
	end function obs_unary_real
	end interface
	abstract interface
	function obs_binary_int (prt1, prt2) result (ival)
	import
	integer :: ival
	type(prt_t), intent(in) :: prt1, prt2
	end function obs_binary_int
	end interface
	abstract interface
	function obs_binary_real (prt1, prt2) result (rval)
	import
	real(default) :: rval
	type(prt_t), intent(in) :: prt1, prt2
	end function obs_binary_real
	end interface

	@ %def obs_unary_int obs_unary_real obs_binary_real
	@
	\subsubsection{Initialization}
	Initialize an entry, optionally with a physical value. We also
	allocate the [[is_known]] flag and set it if the value is set.
	<<Variables: public>>=
	public :: var_entry_init_int
	<<Variables: procedures>>=
	subroutine var_entry_init_log (var, name, lval, intrinsic, user)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	logical, intent(in), optional :: lval
	logical, intent(in), optional :: intrinsic, user
	var%name = name
	var%type = V_LOG
	allocate (var%lval, var%is_known)
	if (present (lval)) then
	var%lval = lval
	var%is_defined = .true.
	var%is_known = .true.
	else
	var%is_known = .false.
	end if
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	if (present (user)) var%is_user_var = user
	var%is_allocated = .true.
	end subroutine var_entry_init_log

	subroutine var_entry_init_int (var, name, ival, intrinsic, user)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	integer, intent(in), optional :: ival
	logical, intent(in), optional :: intrinsic, user
	var%name = name
	var%type = V_INT
	allocate (var%ival, var%is_known)
	if (present (ival)) then
	var%ival = ival
	var%is_defined = .true.
	var%is_known = .true.
	else
	var%is_known = .false.
	end if
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	if (present (user)) var%is_user_var = user
	var%is_allocated = .true.
	end subroutine var_entry_init_int

	subroutine var_entry_init_real (var, name, rval, intrinsic, user)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	real(default), intent(in), optional :: rval
	logical, intent(in), optional :: intrinsic, user
	var%name = name
	var%type = V_REAL
	allocate (var%rval, var%is_known)
	if (present (rval)) then
	var%rval = rval
	var%is_defined = .true.
	var%is_known = .true.
	else
	var%is_known = .false.
	end if
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	if (present (user)) var%is_user_var = user
	var%is_allocated = .true.
	end subroutine var_entry_init_real

	subroutine var_entry_init_cmplx (var, name, cval, intrinsic, user)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	complex(default), intent(in), optional :: cval
	logical, intent(in), optional :: intrinsic, user
	var%name = name
	var%type = V_CMPLX
	allocate (var%cval, var%is_known)
	if (present (cval)) then
	var%cval = cval
	var%is_defined = .true.
	var%is_known = .true.
	else
	var%is_known = .false.
	end if
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	if (present (user)) var%is_user_var = user
	var%is_allocated = .true.
	end subroutine var_entry_init_cmplx

	subroutine var_entry_init_subevt (var, name, pval, intrinsic, user)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in), optional :: pval
	logical, intent(in), optional :: intrinsic, user
	var%name = name
	var%type = V_SEV
	allocate (var%pval, var%is_known)
	if (present (pval)) then
	var%pval = pval
	var%is_defined = .true.
	var%is_known = .true.
	else
	var%is_known = .false.
	end if
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	if (present (user)) var%is_user_var = user
	var%is_allocated = .true.
	end subroutine var_entry_init_subevt

	subroutine var_entry_init_pdg_array (var, name, aval, intrinsic, user)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in), optional :: aval
	logical, intent(in), optional :: intrinsic, user
	var%name = name
	var%type = V_PDG
	allocate (var%aval, var%is_known)
	if (present (aval)) then
	var%aval = aval
	var%is_defined = .true.
	var%is_known = .true.
	else
	var%is_known = .false.
	end if
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	if (present (user)) var%is_user_var = user
	var%is_allocated = .true.
	end subroutine var_entry_init_pdg_array

	subroutine var_entry_init_string (var, name, sval, intrinsic, user)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: sval
	logical, intent(in), optional :: intrinsic, user
	var%name = name
	var%type = V_STR
	allocate (var%sval, var%is_known)
	if (present (sval)) then
	var%sval = sval
	var%is_defined = .true.
	var%is_known = .true.
	else
	var%is_known = .false.
	end if
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	if (present (user)) var%is_user_var = user
	var%is_allocated = .true.
	end subroutine var_entry_init_string

	@ %def var_entry_init_log
	@ %def var_entry_init_int
	@ %def var_entry_init_real
	@ %def var_entry_init_cmplx
	@ %def var_entry_init_subevt
	@ %def var_entry_init_pdg_array
	@ %def var_entry_init_string
	@ Initialize an entry with a pointer to the value and, for numeric/logical
	values, a pointer to the [[is_known]] flag.
	<<Variables: procedures>>=
	subroutine var_entry_init_log_ptr (var, name, lval, is_known, intrinsic)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	logical, intent(in), target :: lval
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: intrinsic
	var%name = name
	var%type = V_LOG
	var%lval => lval
	var%is_known => is_known
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	var%is_defined = .true.
	end subroutine var_entry_init_log_ptr

	subroutine var_entry_init_int_ptr (var, name, ival, is_known, intrinsic)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	integer, intent(in), target :: ival
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: intrinsic
	var%name = name
	var%type = V_INT
	var%ival => ival
	var%is_known => is_known
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	var%is_defined = .true.
	end subroutine var_entry_init_int_ptr

	subroutine var_entry_init_real_ptr (var, name, rval, is_known, intrinsic)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	real(default), intent(in), target :: rval
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: intrinsic
	var%name = name
	var%type = V_REAL
	var%rval => rval
	var%is_known => is_known
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	var%is_defined = .true.
	end subroutine var_entry_init_real_ptr

	subroutine var_entry_init_cmplx_ptr (var, name, cval, is_known, intrinsic)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	complex(default), intent(in), target :: cval
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: intrinsic
	var%name = name
	var%type = V_CMPLX
	var%cval => cval
	var%is_known => is_known
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	var%is_defined = .true.
	end subroutine var_entry_init_cmplx_ptr

	subroutine var_entry_init_pdg_array_ptr (var, name, aval, is_known, intrinsic)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in), target :: aval
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: intrinsic
	var%name = name
	var%type = V_PDG
	var%aval => aval
	var%is_known => is_known
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	var%is_defined = .true.
	end subroutine var_entry_init_pdg_array_ptr

	subroutine var_entry_init_subevt_ptr (var, name, pval, is_known, intrinsic)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in), target :: pval
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: intrinsic
	var%name = name
	var%type = V_SEV
	var%pval => pval
	var%is_known => is_known
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	var%is_defined = .true.
	end subroutine var_entry_init_subevt_ptr

	subroutine var_entry_init_string_ptr (var, name, sval, is_known, intrinsic)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	type(string_t), intent(in), target :: sval
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: intrinsic
	var%name = name
	var%type = V_STR
	var%sval => sval
	var%is_known => is_known
	if (present (intrinsic)) var%is_intrinsic = intrinsic
	var%is_defined = .true.
	end subroutine var_entry_init_string_ptr

	@ %def var_entry_init_log_ptr
	@ %def var_entry_init_int_ptr
	@ %def var_entry_init_real_ptr
	@ %def var_entry_init_cmplx_ptr
	@ %def var_entry_init_pdg_array_ptr
	@ %def var_entry_init_subevt_ptr
	@ %def var_entry_init_string_ptr
	@ Initialize an entry with an observable. The procedure pointer is
	not yet set.
	<<Variables: procedures>>=
	subroutine var_entry_init_obs (var, name, type, prt1, prt2)
	type(var_entry_t), intent(out) :: var
	type(string_t), intent(in) :: name
	integer, intent(in) :: type
	type(prt_t), intent(in), target :: prt1
	type(prt_t), intent(in), optional, target :: prt2
	var%type = type
	var%name = name
	var%prt1 => prt1
	if (present (prt2)) var%prt2 => prt2
	var%is_intrinsic = .true.
	var%is_defined = .true.
	end subroutine var_entry_init_obs

	@ %def var_entry_init_obs
	@ Mark an entry as undefined it it is a user-defined variable object, so force
	re-initialization.
	<<Variables: procedures>>=
	subroutine var_entry_undefine (var)
	type(var_entry_t), intent(inout) :: var
	var%is_defined = .not. var%is_user_var
	var%is_known = var%is_defined .and. var%is_known
	end subroutine var_entry_undefine

	@ %def var_entry_undefine
	@ Clear an entry: mark it as unknown.
	<<Variables: procedures>>=
	subroutine var_entry_clear (var)
	type(var_entry_t), intent(inout) :: var
	var%is_known = .false.
	end subroutine var_entry_clear

	@ %def var_entry_clear
	@ Lock an entry: forbid resetting the entry after initialization.
	<<Variables: procedures>>=
	subroutine var_entry_lock (var, locked)
	type(var_entry_t), intent(inout) :: var
	logical, intent(in), optional :: locked
	if (present (locked)) then
	var%is_locked = locked
	else
	var%is_locked = .true.
	end if
	end subroutine var_entry_lock

	@ %def var_entry_lock
	@
	\subsubsection{Finalizer}
	<<Variables: procedures>>=
	subroutine var_entry_final (var)
	type(var_entry_t), intent(inout) :: var
	if (var%is_allocated) then
	select case (var%type)
	case (V_LOG); deallocate (var%lval)
	case (V_INT); deallocate (var%ival)
	case (V_REAL);deallocate (var%rval)
	case (V_CMPLX);deallocate (var%cval)
	case (V_SEV); deallocate (var%pval)
	case (V_PDG); deallocate (var%aval)
	case (V_STR); deallocate (var%sval)
	end select
	deallocate (var%is_known)
	var%is_allocated = .false.
	var%is_defined = .false.
	end if
	end subroutine var_entry_final

	@ %def var_entry_final
	@
	\subsubsection{Output}
	<<Variables: procedures>>=
	recursive subroutine var_entry_write (var, unit, model_name, &
	intrinsic, pacified, descriptions, ascii_output)
	type(var_entry_t), intent(in) :: var
	integer, intent(in), optional :: unit
	type(string_t), intent(in), optional :: model_name
	logical, intent(in), optional :: intrinsic
	logical, intent(in), optional :: pacified
	logical, intent(in), optional :: descriptions
	logical, intent(in), optional :: ascii_output
	type(string_t) :: col_string
	logical :: show_desc, ao
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	show_desc = .false.; if (present (descriptions)) show_desc = descriptions
	ao = .false.; if (present (ascii_output)) ao = ascii_output
	if (show_desc) then
	if (ao) then
	col_string = create_col_string (COL_BLUE)
	if (var%is_locked) then
	write (u, "(A)", advance="no") char (achar(27) // col_string) // &
	char (var%name) // achar(27) // "[0m" //" fixed-value="
	else
	write (u, "(A)", advance="no") char (achar(27) // col_string) // &
	char (var%name) // achar(27) // "[0m" //" default="
	end if
	col_string = create_col_string (COL_RED)
	write (u, "(A)", advance="no") char (achar(27) // col_string)
	call var_write_val (var, u, "no", pacified=.true.)
	write (u, "(A)") achar(27) // "[0m"
	write (u, "(A)") char (var%description)
	return
	else
	write (u, "(A)") "\item"
	write (u, "(A)", advance="no") "\ttt{" // char ( &
	replace (replace (var%name, "_", "\_", every=.true.), "$", "\$" )) // &
	"} "
	if (var%is_known) then
	if (var%is_locked) then
	write (u, "(A)", advance="no") "\qquad (fixed value: \ttt{"
	else
	write (u, "(A)", advance="no") "\qquad (default: \ttt{"
	end if
	call var_write_val (var, u, "no", pacified=.true., escape_tex=.true.)
	write (u, "(A)", advance="no") "})"
	end if
	write (u, "(A)") " \newline"
	write (u, "(A)") char (var%description)
	write (u, "(A)") "%%%%%"
	return
	end if
	end if
	if (present (intrinsic)) then
	if (var%is_intrinsic .neqv. intrinsic) return
	end if
	if (.not. var%is_defined) then
	write (u, "(A,1x)", advance="no") "[undefined]"
	end if
	if (.not. var%is_intrinsic) then
	write (u, "(A,1x)", advance="no") "[user variable]"
	end if
	if (present (model_name)) then
	write (u, "(A,A)", advance="no") char(model_name), "."
	end if
	write (u, "(A)", advance="no") char (var%name)
	if (var%is_locked) write (u, "(A)", advance="no") "*"
	if (var%is_allocated) then
	write (u, "(A)", advance="no") " = "
	else if (var%type /= V_NONE) then
	write (u, "(A)", advance="no") " => "
	end if
	call var_write_val (var, u, "yes", pacified)
	end subroutine var_entry_write

	@ %def var_entry_write
	@
	<<Variables: procedures>>=
	subroutine var_write_val (var, u, advance, pacified, escape_tex)
	type(var_entry_t), intent(in) :: var
	integer, intent(in) :: u
	character(*), intent(in) :: advance
	logical, intent(in), optional :: pacified, escape_tex
	logical :: num_pac, et
	real(default) :: rval
	complex(default) :: cval
	character(len=7) :: fmt
	call pac_fmt (fmt, FMT_19, FMT_12, pacified)
	num_pac = .false.; if (present (pacified)) num_pac = pacified
	et = .false.; if (present (escape_tex)) et = escape_tex
	select case (var%type)
	case (V_NONE); write (u, '()', advance=advance)
	case (V_LOG)
	if (var%is_known) then
	if (var%lval) then
	write (u, "(A)", advance=advance) "true"
	else
	write (u, "(A)", advance=advance) "false"
	end if
	else
	write (u, "(A)", advance=advance) "[unknown logical]"
	end if
	case (V_INT)
	if (var%is_known) then
	write (u, "(I0)", advance=advance) var%ival
	else
	write (u, "(A)", advance=advance) "[unknown integer]"
	end if
	case (V_REAL)
	if (var%is_known) then
	rval = var%rval
	if (num_pac) then
	call pacify (rval, 10 * eps0)
	end if
	write (u, "(" // fmt // ")", advance=advance) rval
	else
	write (u, "(A)", advance=advance) "[unknown real]"
	end if
	case (V_CMPLX)
	if (var%is_known) then
	cval = var%cval
	if (num_pac) then
	call pacify (cval, 10 * eps0)
	end if
	write (u, "('('," // fmt // ",','," // fmt // ",')')", advance=advance) cval
	else
	write (u, "(A)", advance=advance) "[unknown complex]"
	end if
	case (V_SEV)
	if (var%is_known) then
	call subevt_write (var%pval, u, prefix=" ", &
	pacified = pacified)
	else
	write (u, "(A)", advance=advance) "[unknown subevent]"
	end if
	case (V_PDG)
	if (var%is_known) then
	call pdg_array_write (var%aval, u); write (u, *)
	else
	write (u, "(A)", advance=advance) "[unknown PDG array]"
	end if
	case (V_STR)
	if (var%is_known) then
	if (et) then
	write (u, "(A)", advance=advance) '"' // char (replace ( &
	replace (var%sval, "_", "\_", every=.true.), "$", "\$" )) // '"'
	else
	write (u, "(A)", advance=advance) '"' // char (var%sval) // '"'
	end if
	else
	write (u, "(A)", advance=advance) "[unknown string]"
	end if
	case (V_OBS1_INT); write (u, "(A)", advance=advance) "[int] = unary observable"
	case (V_OBS2_INT); write (u, "(A)", advance=advance) "[int] = binary observable"
	case (V_OBS1_REAL); write (u, "(A)", advance=advance) "[real] = unary observable"
	case (V_OBS2_REAL); write (u, "(A)", advance=advance) "[real] = binary observable"
	case (V_UOBS1_INT); write (u, "(A)", advance=advance) "[int] = unary user observable"
	case (V_UOBS2_INT); write (u, "(A)", advance=advance) "[int] = binary user observable"
	case (V_UOBS1_REAL); write (u, "(A)", advance=advance) "[real] = unary user observable"
	case (V_UOBS2_REAL); write (u, "(A)", advance=advance) "[real] = binary user observable"
	end select
	end subroutine var_write_val

	@ %def procedure
	@
	\subsubsection{Accessing contents}
	<<Variables: procedures>>=
	function var_entry_get_name (var) result (name)
	type(string_t) :: name
	type(var_entry_t), intent(in) :: var
	name = var%name
	end function var_entry_get_name

	function var_entry_get_type (var) result (type)
	integer :: type
	type(var_entry_t), intent(in) :: var
	type = var%type
	end function var_entry_get_type

	@ %def var_entry_get_name var_entry_get_type
	@ Return true if the variable is defined. This the case if it is allocated
	and known, or if it is a pointer.
	<<Variables: procedures>>=
	function var_entry_is_defined (var) result (defined)
	logical :: defined
	type(var_entry_t), intent(in) :: var
	defined = var%is_defined
	end function var_entry_is_defined

	@ %def var_entry_is_defined
	@ Return true if the variable is locked. If [[force]] is active,
	always return false.
	<<Variables: procedures>>=
	function var_entry_is_locked (var, force) result (locked)
	logical :: locked
	type(var_entry_t), intent(in) :: var
	logical, intent(in), optional :: force
	if (present (force)) then
	if (force) then
	locked = .false.; return
	end if
	end if
	locked = var%is_locked
	end function var_entry_is_locked

	@ %def var_entry_is_locked
	@ Return true if the variable is intrinsic
	<<Variables: procedures>>=
	function var_entry_is_intrinsic (var) result (flag)
	logical :: flag
	type(var_entry_t), intent(in) :: var
	flag = var%is_intrinsic
	end function var_entry_is_intrinsic

	@ %def var_entry_is_intrinsic
	@ Return components
	<<Variables: procedures>>=
	function var_entry_is_known (var) result (flag)
	logical :: flag
	type(var_entry_t), intent(in) :: var
	flag = var%is_known
	end function var_entry_is_known

	function var_entry_get_lval (var) result (lval)
	logical :: lval
	type(var_entry_t), intent(in) :: var
	lval = var%lval
	end function var_entry_get_lval

	function var_entry_get_ival (var) result (ival)
	integer :: ival
	type(var_entry_t), intent(in) :: var
	ival = var%ival
	end function var_entry_get_ival

	function var_entry_get_rval (var) result (rval)
	real(default) :: rval
	type(var_entry_t), intent(in) :: var
	rval = var%rval
	end function var_entry_get_rval

	function var_entry_get_cval (var) result (cval)
	complex(default) :: cval
	type(var_entry_t), intent(in) :: var
	cval = var%cval
	end function var_entry_get_cval

	function var_entry_get_aval (var) result (aval)
	type(pdg_array_t) :: aval
	type(var_entry_t), intent(in) :: var
	aval = var%aval
	end function var_entry_get_aval

	function var_entry_get_pval (var) result (pval)
	type(subevt_t) :: pval
	type(var_entry_t), intent(in) :: var
	pval = var%pval
	end function var_entry_get_pval

	function var_entry_get_sval (var) result (sval)
	type(string_t) :: sval
	type(var_entry_t), intent(in) :: var
	sval = var%sval
	end function var_entry_get_sval

	@ %def var_entry_get_lval
	@ %def var_entry_get_ival
	@ %def var_entry_get_rval
	@ %def var_entry_get_cval
	@ %def var_entry_get_aval
	@ %def var_entry_get_pval
	@ %def var_entry_get_sval
	@ Return pointers to components.
	<<Variables: procedures>>=
	function var_entry_get_known_ptr (var) result (ptr)
	logical, pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%is_known
	end function var_entry_get_known_ptr

	function var_entry_get_lval_ptr (var) result (ptr)
	logical, pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%lval
	end function var_entry_get_lval_ptr

	function var_entry_get_ival_ptr (var) result (ptr)
	integer, pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%ival
	end function var_entry_get_ival_ptr

	function var_entry_get_rval_ptr (var) result (ptr)
	real(default), pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%rval
	end function var_entry_get_rval_ptr

	function var_entry_get_cval_ptr (var) result (ptr)
	complex(default), pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%cval
	end function var_entry_get_cval_ptr

	function var_entry_get_pval_ptr (var) result (ptr)
	type(subevt_t), pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%pval
	end function var_entry_get_pval_ptr

	function var_entry_get_aval_ptr (var) result (ptr)
	type(pdg_array_t), pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%aval
	end function var_entry_get_aval_ptr

	function var_entry_get_sval_ptr (var) result (ptr)
	type(string_t), pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%sval
	end function var_entry_get_sval_ptr

	@ %def var_entry_get_known_ptr
	@ %def var_entry_get_lval_ptr var_entry_get_ival_ptr var_entry_get_rval_ptr
	@ %def var_entry_get_cval_ptr var_entry_get_aval_ptr var_entry_get_pval_ptr
	@ %def var_entry_get_sval_ptr
	@ Furthermore,
	<<Variables: procedures>>=
	function var_entry_get_prt1_ptr (var) result (ptr)
	type(prt_t), pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%prt1
	end function var_entry_get_prt1_ptr

	function var_entry_get_prt2_ptr (var) result (ptr)
	type(prt_t), pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%prt2
	end function var_entry_get_prt2_ptr

	@ %def var_entry_get_prt1_ptr
	@ %def var_entry_get_prt2_ptr
	@ Subroutines might be safer than functions for procedure pointer transfer
	(there was a nagfor bug).
	<<Variables: procedures>>=
	subroutine var_entry_assign_obs1_int_ptr (ptr, var)
	procedure(obs_unary_int), pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%obs1_int
	end subroutine var_entry_assign_obs1_int_ptr

	subroutine var_entry_assign_obs1_real_ptr (ptr, var)
	procedure(obs_unary_real), pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%obs1_real
	end subroutine var_entry_assign_obs1_real_ptr

	subroutine var_entry_assign_obs2_int_ptr (ptr, var)
	procedure(obs_binary_int), pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%obs2_int
	end subroutine var_entry_assign_obs2_int_ptr

	subroutine var_entry_assign_obs2_real_ptr (ptr, var)
	procedure(obs_binary_real), pointer :: ptr
	type(var_entry_t), intent(in), target :: var
	ptr => var%obs2_real
	end subroutine var_entry_assign_obs2_real_ptr

	@ %def var_entry_assign_obs1_int_ptr var_entry_assign_obs1_real_ptr
	@ %def var_entry_assign_obs2_int_ptr var_entry_assign_obs2_real_ptr
	@
	\subsection{Setting values}
	Undefine the value.
	<<Variables: procedures>>=
	subroutine var_entry_clear_value (var)
	type(var_entry_t), intent(inout) :: var
	var%is_known = .false.
	end subroutine var_entry_clear_value

	@ %def var_entry_clear_value
	<<Variables: procedures>>=
	recursive subroutine var_entry_set_log &
	(var, lval, is_known, verbose, model_name)
	type(var_entry_t), intent(inout) :: var
	logical, intent(in) :: lval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose
	type(string_t), intent(in), optional :: model_name
	integer :: u
	u = logfile_unit ()
	var%lval = lval
	var%is_known = is_known
	var%is_defined = .true.
	if (present (verbose)) then
	if (verbose) then
	call var_entry_write (var, model_name=model_name)
	call var_entry_write (var, model_name=model_name, unit=u)
	if (u >= 0) flush (u)
	end if
	end if
	end subroutine var_entry_set_log

	recursive subroutine var_entry_set_int &
	(var, ival, is_known, verbose, model_name)
	type(var_entry_t), intent(inout) :: var
	integer, intent(in) :: ival
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose
	type(string_t), intent(in), optional :: model_name
	integer :: u
	u = logfile_unit ()
	var%ival = ival
	var%is_known = is_known
	var%is_defined = .true.
	if (present (verbose)) then
	if (verbose) then
	call var_entry_write (var, model_name=model_name)
	call var_entry_write (var, model_name=model_name, unit=u)
	if (u >= 0) flush (u)
	end if
	end if
	end subroutine var_entry_set_int

	recursive subroutine var_entry_set_real &
	(var, rval, is_known, verbose, model_name, pacified)
	type(var_entry_t), intent(inout) :: var
	real(default), intent(in) :: rval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose, pacified
	type(string_t), intent(in), optional :: model_name
	integer :: u
	u = logfile_unit ()
	var%rval = rval
	var%is_known = is_known
	var%is_defined = .true.
	if (present (verbose)) then
	if (verbose) then
	call var_entry_write &
	(var, model_name=model_name, pacified = pacified)
	call var_entry_write &
	(var, model_name=model_name, unit=u, pacified = pacified)
	if (u >= 0) flush (u)
	end if
	end if
	end subroutine var_entry_set_real

	recursive subroutine var_entry_set_cmplx &
	(var, cval, is_known, verbose, model_name, pacified)
	type(var_entry_t), intent(inout) :: var
	complex(default), intent(in) :: cval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose, pacified
	type(string_t), intent(in), optional :: model_name
	integer :: u
	u = logfile_unit ()
	var%cval = cval
	var%is_known = is_known
	var%is_defined = .true.
	if (present (verbose)) then
	if (verbose) then
	call var_entry_write &
	(var, model_name=model_name, pacified = pacified)
	call var_entry_write &
	(var, model_name=model_name, unit=u, pacified = pacified)
	if (u >= 0) flush (u)
	end if
	end if
	end subroutine var_entry_set_cmplx

	recursive subroutine var_entry_set_pdg_array &
	(var, aval, is_known, verbose, model_name)
	type(var_entry_t), intent(inout) :: var
	type(pdg_array_t), intent(in) :: aval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose
	type(string_t), intent(in), optional :: model_name
	integer :: u
	u = logfile_unit ()
	var%aval = aval
	var%is_known = is_known
	var%is_defined = .true.
	if (present (verbose)) then
	if (verbose) then
	call var_entry_write (var, model_name=model_name)
	call var_entry_write (var, model_name=model_name, unit=u)
	if (u >= 0) flush (u)
	end if
	end if
	end subroutine var_entry_set_pdg_array

	recursive subroutine var_entry_set_subevt &
	(var, pval, is_known, verbose, model_name)
	type(var_entry_t), intent(inout) :: var
	type(subevt_t), intent(in) :: pval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose
	type(string_t), intent(in), optional :: model_name
	integer :: u
	u = logfile_unit ()
	var%pval = pval
	var%is_known = is_known
	var%is_defined = .true.
	if (present (verbose)) then
	if (verbose) then
	call var_entry_write (var, model_name=model_name)
	call var_entry_write (var, model_name=model_name, unit=u)
	if (u >= 0) flush (u)
	end if
	end if
	end subroutine var_entry_set_subevt

	recursive subroutine var_entry_set_string &
	(var, sval, is_known, verbose, model_name)
	type(var_entry_t), intent(inout) :: var
	type(string_t), intent(in) :: sval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: verbose
	type(string_t), intent(in), optional :: model_name
	integer :: u
	u = logfile_unit ()
	var%sval = sval
	var%is_known = is_known
	var%is_defined = .true.
	if (present (verbose)) then
	if (verbose) then
	call var_entry_write (var, model_name=model_name)
	call var_entry_write (var, model_name=model_name, unit=u)
	if (u >= 0) flush (u)
	end if
	end if
	end subroutine var_entry_set_string

	@ %def var_entry_set_log
	@ %def var_entry_set_int
	@ %def var_entry_set_real
	@ %def var_entry_set_cmplx
	@ %def var_entry_set_pdg_array
	@ %def var_entry_set_subevt
	@ %def var_entry_set_string
	@
	<<Variables: public>>=
	public :: var_entry_set_description
	<<Variables: procedures>>=
	pure subroutine var_entry_set_description (var_entry, description)
	type(var_entry_t), intent(inout) :: var_entry
	type(string_t), intent(in) :: description
	var_entry%description = description
	end subroutine var_entry_set_description

	@ %def var_entry_set_description
	@
	\subsection{Copies and pointer variables}
	Initialize an entry with a copy of an existing variable entry. The
	copy is physically allocated with the same type as the original.
	<<Variables: procedures>>=
	subroutine var_entry_init_copy (var, original, user)
	type(var_entry_t), intent(out) :: var
	type(var_entry_t), intent(in), target :: original
	logical, intent(in), optional :: user
	type(string_t) :: name
	logical :: intrinsic
	name = var_entry_get_name (original)
	intrinsic = original%is_intrinsic
	select case (original%type)
	case (V_LOG)
	call var_entry_init_log (var, name, intrinsic=intrinsic, user=user)
	case (V_INT)
	call var_entry_init_int (var, name, intrinsic=intrinsic, user=user)
	case (V_REAL)
	call var_entry_init_real (var, name, intrinsic=intrinsic, user=user)
	case (V_CMPLX)
	call var_entry_init_cmplx (var, name, intrinsic=intrinsic, user=user)
	case (V_SEV)
	call var_entry_init_subevt (var, name, intrinsic=intrinsic, user=user)
	case (V_PDG)
	call var_entry_init_pdg_array (var, name, intrinsic=intrinsic, user=user)
	case (V_STR)
	call var_entry_init_string (var, name, intrinsic=intrinsic, user=user)
	end select
	end subroutine var_entry_init_copy

	@ %def var_entry_init_copy
	@ Copy the value of an entry. The target variable entry must be initialized
	correctly.
	<<Variables: procedures>>=
	subroutine var_entry_copy_value (var, original)
	type(var_entry_t), intent(inout) :: var
	type(var_entry_t), intent(in), target :: original
	if (var_entry_is_known (original)) then
	select case (original%type)
	case (V_LOG)
	call var_entry_set_log (var, var_entry_get_lval (original), .true.)
	case (V_INT)
	call var_entry_set_int (var, var_entry_get_ival (original), .true.)
	case (V_REAL)
	call var_entry_set_real (var, var_entry_get_rval (original), .true.)
	case (V_CMPLX)
	call var_entry_set_cmplx (var, var_entry_get_cval (original), .true.)
	case (V_SEV)
	call var_entry_set_subevt (var, var_entry_get_pval (original), .true.)
	case (V_PDG)
	call var_entry_set_pdg_array (var, var_entry_get_aval (original), .true.)
	case (V_STR)
	call var_entry_set_string (var, var_entry_get_sval (original), .true.)
	end select
	else
	call var_entry_clear (var)
	end if
	end subroutine var_entry_copy_value

	@ %def var_entry_copy_value
	@
	\subsection{Variable lists}
	\subsubsection{The type}
	Variable lists can be linked together. No initializer needed.
	They are deleted separately.
	<<Variables: public>>=
	public :: var_list_t
	<<Variables: types>>=
	type, extends (vars_t) :: var_list_t
	private
	type(var_entry_t), pointer :: first => null ()
	type(var_entry_t), pointer :: last => null ()
	type(var_list_t), pointer :: next => null ()
	contains
	<<Variables: var list: TBP>>
	end type var_list_t

	@ %def var_list_t
	@
	\subsubsection{Constructors}
	Implementation of the [[link]] deferred method. The implementation
	restricts itself to var lists of the same type. We might need to
	relax this constraint.
	<<Variables: var list: TBP>>=
	procedure :: link => var_list_link
	<<Variables: procedures>>=
	subroutine var_list_link (vars, target_vars)
	class(var_list_t), intent(inout) :: vars
	class(vars_t), intent(in), target :: target_vars
	select type (target_vars)
	type is (var_list_t)
	vars%next => target_vars
	class default
	call msg_bug ("var_list_link: unsupported target type")
	end select
	end subroutine var_list_link

	@ %def var_list_link
	@ Append a new entry to an existing list.
	<<Variables: procedures>>=
	subroutine var_list_append (var_list, var, verbose)
	type(var_list_t), intent(inout), target :: var_list
	type(var_entry_t), intent(inout), target :: var
	logical, intent(in), optional :: verbose
	if (associated (var_list%last)) then
	var%previous => var_list%last
	var_list%last%next => var
	else
	var%previous => null ()
	var_list%first => var
	end if
	var_list%last => var
	if (present (verbose)) then
	if (verbose) call var_entry_write (var)
	end if
	end subroutine var_list_append

	@ %def var_list_append
	@ Sort a list.
	<<Variables: var list: TBP>>=
	procedure :: sort => var_list_sort
	<<Variables: procedures>>=
	subroutine var_list_sort (var_list)
	class(var_list_t), intent(inout) :: var_list
	type(var_entry_t), pointer :: var, previous
	if (associated (var_list%first)) then
	var => var_list%first
	do while (associated (var))
	previous => var%previous
	do while (associated (previous))
	if (larger_var (previous, var)) then
	call var_list%swap_with_next (previous)
	end if
	previous => previous%previous
	end do
	var => var%next
	end do
	end if
	end subroutine var_list_sort

	@ %def var_list_sort
	@
	<<Variables: procedures>>=
	pure function larger_var (var1, var2) result (larger)
	logical :: larger
	type(var_entry_t), intent(in) :: var1, var2
	type(string_t) :: str1, str2
	str1 = replace (var1%name, "?", "")
	str1 = replace (str1, "$", "")
	str2 = replace (var2%name, "?", "")
	str2 = replace (str2, "$", "")
	larger = str1 > str2
	end function larger_var

	@ %def larger_var
	@
	<<Variables: var list: TBP>>=
	procedure :: get_previous => var_list_get_previous
	<<Variables: procedures>>=
	function var_list_get_previous (var_list, var_entry) result (previous)
	type(var_entry_t), pointer :: previous
	class(var_list_t), intent(in) :: var_list
	type(var_entry_t), intent(in) :: var_entry
	previous => var_list%first
	if (previous%name == var_entry%name) then
	previous => null ()
	else
	do while (associated (previous))
	if (previous%next%name == var_entry%name) exit
	previous => previous%next
	end do
	end if
	end function var_list_get_previous

	@ %def var_list_get_previous
	@
	<<Variables: var list: TBP>>=
	procedure :: swap_with_next => var_list_swap_with_next
	<<Variables: procedures>>=
	subroutine var_list_swap_with_next (var_list, var_entry)
	class(var_list_t), intent(inout) :: var_list
	type(var_entry_t), intent(in) :: var_entry
	type(var_entry_t), pointer :: previous, this, next, next_next
	previous => var_list%get_previous (var_entry)
	if (.not. associated (previous)) then
	this => var_list%first
	else
	this => previous%next
	end if
	next => this%next
	next_next => next%next
	if (associated (previous)) then
	previous%next => next
	next%previous => previous
	else
	var_list%first => next
	next%previous => null ()
	end if
	this%next => next_next
	if (associated (next_next)) then
	next_next%previous => this
	end if
	next%next => this
	this%previous => next
	if (.not. associated (next%next)) then
	var_list%last => next
	end if
	end subroutine var_list_swap_with_next

	@ %def var_list_swap_with_next
	@ Public methods for expanding the variable list (as subroutines)
	<<Variables: var list: TBP>>=
	generic :: append_log => var_list_append_log_s, var_list_append_log_c
	procedure, private :: var_list_append_log_s
	procedure, private :: var_list_append_log_c
	generic :: append_int => var_list_append_int_s, var_list_append_int_c
	procedure, private :: var_list_append_int_s
	procedure, private :: var_list_append_int_c
	generic :: append_real => var_list_append_real_s, var_list_append_real_c
	procedure, private :: var_list_append_real_s
	procedure, private :: var_list_append_real_c
	generic :: append_cmplx => var_list_append_cmplx_s, var_list_append_cmplx_c
	procedure, private :: var_list_append_cmplx_s
	procedure, private :: var_list_append_cmplx_c
	generic :: append_subevt => var_list_append_subevt_s, var_list_append_subevt_c
	procedure, private :: var_list_append_subevt_s
	procedure, private :: var_list_append_subevt_c
	generic :: append_pdg_array => var_list_append_pdg_array_s, var_list_append_pdg_array_c
	procedure, private :: var_list_append_pdg_array_s
	procedure, private :: var_list_append_pdg_array_c
	generic :: append_string => var_list_append_string_s, var_list_append_string_c
	procedure, private :: var_list_append_string_s
	procedure, private :: var_list_append_string_c
	<<Variables: public>>=
	public :: var_list_append_log
	public :: var_list_append_int
	public :: var_list_append_real
	public :: var_list_append_cmplx
	public :: var_list_append_subevt
	public :: var_list_append_pdg_array
	public :: var_list_append_string
	<<Variables: interfaces>>=
	interface var_list_append_log
	module procedure var_list_append_log_s
	module procedure var_list_append_log_c
	end interface
	interface var_list_append_int
	module procedure var_list_append_int_s
	module procedure var_list_append_int_c
	end interface
	interface var_list_append_real
	module procedure var_list_append_real_s
	module procedure var_list_append_real_c
	end interface
	interface var_list_append_cmplx
	module procedure var_list_append_cmplx_s
	module procedure var_list_append_cmplx_c
	end interface
	interface var_list_append_subevt
	module procedure var_list_append_subevt_s
	module procedure var_list_append_subevt_c
	end interface
	interface var_list_append_pdg_array
	module procedure var_list_append_pdg_array_s
	module procedure var_list_append_pdg_array_c
	end interface
	interface var_list_append_string
	module procedure var_list_append_string_s
	module procedure var_list_append_string_c
	end interface
	<<Variables: procedures>>=
	subroutine var_list_append_log_s &
	(var_list, name, lval, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	logical, intent(in), optional :: lval
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_log (var, name, lval, intrinsic, user)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_log_s

	subroutine var_list_append_int_s &
	(var_list, name, ival, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	integer, intent(in), optional :: ival
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_int (var, name, ival, intrinsic, user)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_int_s

	subroutine var_list_append_real_s &
	(var_list, name, rval, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	real(default), intent(in), optional :: rval
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_real (var, name, rval, intrinsic, user)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_real_s

	subroutine var_list_append_cmplx_s &
	(var_list, name, cval, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	complex(default), intent(in), optional :: cval
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_cmplx (var, name, cval, intrinsic, user)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_cmplx_s

	subroutine var_list_append_subevt_s &
	(var_list, name, pval, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in), optional :: pval
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_subevt (var, name, pval, intrinsic, user)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_subevt_s

	subroutine var_list_append_pdg_array_s &
	(var_list, name, aval, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in), optional :: aval
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_pdg_array (var, name, aval, intrinsic, user)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_pdg_array_s

	subroutine var_list_append_string_s &
	(var_list, name, sval, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: sval
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_string (var, name, sval, intrinsic, user)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_string_s

	subroutine var_list_append_log_c &
	(var_list, name, lval, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	character(*), intent(in) :: name
	logical, intent(in), optional :: lval
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	call var_list_append_log_s &
	(var_list, var_str (name), lval, locked, verbose, &
	intrinsic, user, description)
	end subroutine var_list_append_log_c

	subroutine var_list_append_int_c &
	(var_list, name, ival, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	character(*), intent(in) :: name
	integer, intent(in), optional :: ival
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	call var_list_append_int_s &
	(var_list, var_str (name), ival, locked, verbose, &
	intrinsic, user, description)
	end subroutine var_list_append_int_c

	subroutine var_list_append_real_c &
	(var_list, name, rval, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	character(*), intent(in) :: name
	real(default), intent(in), optional :: rval
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	call var_list_append_real_s &
	(var_list, var_str (name), rval, locked, verbose, &
	intrinsic, user, description)
	end subroutine var_list_append_real_c

	subroutine var_list_append_cmplx_c &
	(var_list, name, cval, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	character(*), intent(in) :: name
	complex(default), intent(in), optional :: cval
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	call var_list_append_cmplx_s &
	(var_list, var_str (name), cval, locked, verbose, &
	intrinsic, user, description)
	end subroutine var_list_append_cmplx_c

	subroutine var_list_append_subevt_c &
	(var_list, name, pval, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	character(*), intent(in) :: name
	type(subevt_t), intent(in), optional :: pval
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	call var_list_append_subevt_s &
	(var_list, var_str (name), pval, locked, verbose, &
	intrinsic, user, description)
	end subroutine var_list_append_subevt_c

	subroutine var_list_append_pdg_array_c &
	(var_list, name, aval, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	character(*), intent(in) :: name
	type(pdg_array_t), intent(in), optional :: aval
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	call var_list_append_pdg_array_s &
	(var_list, var_str (name), aval, locked, verbose, &
	intrinsic, user, description)
	end subroutine var_list_append_pdg_array_c

	subroutine var_list_append_string_c &
	(var_list, name, sval, locked, verbose, intrinsic, user, description)
	class(var_list_t), intent(inout) :: var_list
	character(*), intent(in) :: name
	character(*), intent(in), optional :: sval
	logical, intent(in), optional :: locked, verbose, intrinsic, user
	type(string_t), intent(in), optional :: description
	if (present (sval)) then
	call var_list_append_string_s &
	(var_list, var_str (name), var_str (sval), &
	locked, verbose, intrinsic, user, description)
	else
	call var_list_append_string_s &
	(var_list, var_str (name), &
	locked=locked, verbose=verbose, intrinsic=intrinsic, &
	user=user, description=description)
	end if
	end subroutine var_list_append_string_c

	@ %def var_list_append_log
	@ %def var_list_append_int
	@ %def var_list_append_real
	@ %def var_list_append_cmplx
	@ %def var_list_append_subevt
	@ %def var_list_append_pdg_array
	@ %def var_list_append_string
	<<Variables: public>>=
	public :: var_list_append_log_ptr
	public :: var_list_append_int_ptr
	public :: var_list_append_real_ptr
	public :: var_list_append_cmplx_ptr
	public :: var_list_append_pdg_array_ptr
	public :: var_list_append_subevt_ptr
	public :: var_list_append_string_ptr
	<<Variables: var list: TBP>>=
	procedure :: append_log_ptr => var_list_append_log_ptr
	procedure :: append_int_ptr => var_list_append_int_ptr
	procedure :: append_real_ptr => var_list_append_real_ptr
	procedure :: append_cmplx_ptr => var_list_append_cmplx_ptr
	procedure :: append_pdg_array_ptr => var_list_append_pdg_array_ptr
	procedure :: append_subevt_ptr => var_list_append_subevt_ptr
	procedure :: append_string_ptr => var_list_append_string_ptr
	<<Variables: procedures>>=
	subroutine var_list_append_log_ptr &
	(var_list, name, lval, is_known, locked, verbose, intrinsic, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	logical, intent(in), target :: lval
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: locked, verbose, intrinsic
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_log_ptr (var, name, lval, is_known, intrinsic)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_log_ptr

	subroutine var_list_append_int_ptr &
	(var_list, name, ival, is_known, locked, verbose, intrinsic, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	integer, intent(in), target :: ival
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: locked, verbose, intrinsic
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_int_ptr (var, name, ival, is_known, intrinsic)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_int_ptr

	subroutine var_list_append_real_ptr &
	(var_list, name, rval, is_known, locked, verbose, intrinsic, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	real(default), intent(in), target :: rval
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: locked, verbose, intrinsic
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_real_ptr (var, name, rval, is_known, intrinsic)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_real_ptr

	subroutine var_list_append_cmplx_ptr &
	(var_list, name, cval, is_known, locked, verbose, intrinsic, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	complex(default), intent(in), target :: cval
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: locked, verbose, intrinsic
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_cmplx_ptr (var, name, cval, is_known, intrinsic)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_cmplx_ptr

	subroutine var_list_append_pdg_array_ptr &
	(var_list, name, aval, is_known, locked, verbose, intrinsic, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in), target :: aval
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: locked, verbose, intrinsic
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_pdg_array_ptr (var, name, aval, is_known, intrinsic)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_pdg_array_ptr

	subroutine var_list_append_subevt_ptr &
	(var_list, name, pval, is_known, locked, verbose, intrinsic, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in), target :: pval
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: locked, verbose, intrinsic
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_subevt_ptr (var, name, pval, is_known, intrinsic)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_subevt_ptr

	subroutine var_list_append_string_ptr &
	(var_list, name, sval, is_known, locked, verbose, intrinsic, description)
	class(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	type(string_t), intent(in), target :: sval
	logical, intent(in), target :: is_known
	logical, intent(in), optional :: locked, verbose, intrinsic
	type(string_t), intent(in), optional :: description
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_string_ptr (var, name, sval, is_known, intrinsic)
	if (present (description)) call var_entry_set_description (var, description)
	if (present (locked)) call var_entry_lock (var, locked)
	call var_list_append (var_list, var, verbose)
	end subroutine var_list_append_string_ptr

	@ %def var_list_append_log_ptr
	@ %def var_list_append_int_ptr
	@ %def var_list_append_real_ptr
	@ %def var_list_append_cmplx_ptr
	@ %def var_list_append_pdg_array_ptr
	@ %def var_list_append_subevt_ptr
	@
	\subsubsection{Finalizer}
	Finalize, delete the list entry by entry. The link itself is kept
	intact. Follow link and delete recursively only if requested
	explicitly.
	<<Variables: var list: TBP>>=
	procedure :: final => var_list_final
	<<Variables: procedures>>=
	recursive subroutine var_list_final (vars, follow_link)
	class(var_list_t), intent(inout) :: vars
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	vars%last => null ()
	do while (associated (vars%first))
	var => vars%first
	vars%first => var%next
	call var_entry_final (var)
	deallocate (var)
	end do
	if (present (follow_link)) then
	if (follow_link) then
	if (associated (vars%next)) then
	call vars%next%final (follow_link)
	deallocate (vars%next)
	end if
	end if
	end if
	end subroutine var_list_final

	@ %def var_list_final
	@
	\subsubsection{Output}
	Show variable list with precise control over options. E.g.,
	show only variables of a certain type.

	Many options, thus not an ordinary [[write]] method.
	<<Variables: public>>=
	public :: var_list_write
	<<Variables: var list: TBP>>=
	procedure :: write => var_list_write
	<<Variables: procedures>>=
	recursive subroutine var_list_write &
	(var_list, unit, follow_link, only_type, prefix, model_name, &
	intrinsic, pacified, descriptions, ascii_output)
	class(var_list_t), intent(in), target :: var_list
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: follow_link
	integer, intent(in), optional :: only_type
	character(*), intent(in), optional :: prefix
	type(string_t), intent(in), optional :: model_name
	logical, intent(in), optional :: intrinsic
	logical, intent(in), optional :: pacified
	logical, intent(in), optional :: descriptions
	logical, intent(in), optional :: ascii_output
	type(var_entry_t), pointer :: var
	integer :: u, length
	logical :: write_this, write_next
	u = given_output_unit (unit); if (u < 0) return
	if (present (prefix)) length = len (prefix)
	var => var_list%first
	if (associated (var)) then
	do while (associated (var))
	if (present (only_type)) then
	write_this = only_type == var%type
	else
	write_this = .true.
	end if
	if (write_this .and. present (prefix)) then
	if (prefix /= extract (var%name, 1, length)) &
	write_this = .false.
	end if
	if (write_this) then
	call var_entry_write &
	(var, unit, model_name=model_name, &
	intrinsic=intrinsic, pacified=pacified, &
	descriptions=descriptions, ascii_output=ascii_output)
	end if
	var => var%next
	end do
	end if
	if (present (follow_link)) then
	write_next = follow_link .and. associated (var_list%next)
	else
	write_next = associated (var_list%next)
	end if
	if (write_next) then
	call var_list_write (var_list%next, &
	unit, follow_link, only_type, prefix, model_name, &
	intrinsic, pacified)
	end if
	end subroutine var_list_write

	@ %def var_list_write
	@ Write only a certain variable.
	<<Variables: public>>=
	public :: var_list_write_var
	<<Variables: var list: TBP>>=
	procedure :: write_var => var_list_write_var
	<<Variables: procedures>>=
	recursive subroutine var_list_write_var &
	(var_list, name, unit, type, follow_link, &
	model_name, pacified, defined, descriptions, ascii_output)
	class(var_list_t), intent(in), target :: var_list
	type(string_t), intent(in) :: name
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: type
	logical, intent(in), optional :: follow_link
	type(string_t), intent(in), optional :: model_name
	logical, intent(in), optional :: pacified
	logical, intent(in), optional :: defined
	logical, intent(in), optional :: descriptions
	logical, intent(in), optional :: ascii_output
	type(var_entry_t), pointer :: var
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	var => var_list_get_var_ptr &
	(var_list, name, type, follow_link=follow_link, defined=defined)
	if (associated (var)) then
	call var_entry_write &
	(var, unit, model_name = model_name, &
	pacified = pacified, &
	descriptions=descriptions, ascii_output=ascii_output)
	else
	write (u, "(A)") char (name) // " = [undefined]"
	end if
	end subroutine var_list_write_var

	@ %def var_list_write_var
	@
	\subsection{Tools}
	Return a pointer to the variable list linked to by the current one.
	<<Variables: procedures>>=
	function var_list_get_next_ptr (var_list) result (next_ptr)
	type(var_list_t), pointer :: next_ptr
	type(var_list_t), intent(in) :: var_list
	next_ptr => var_list%next
	end function var_list_get_next_ptr

	@ %def var_list_get_next_ptr
	@ Used by [[eval_trees]]:
	Return a pointer to the variable with the requested name. If no such
	name exists, return a null pointer. In that case, try the next list
	if present, unless [[follow_link]] is unset. If [[defined]] is set, ignore
	entries that exist but are undefined.
	<<Variables: public>>=
	public :: var_list_get_var_ptr
	<<Variables: procedures>>=
	recursive function var_list_get_var_ptr &
	(var_list, name, type, follow_link, defined) result (var)
	type(var_entry_t), pointer :: var
	type(var_list_t), intent(in), target :: var_list
	type(string_t), intent(in) :: name
	integer, intent(in), optional :: type
	logical, intent(in), optional :: follow_link, defined
	logical :: ignore_undef, search_next
	ignore_undef = .true.; if (present (defined)) ignore_undef = .not. defined
	var => var_list%first
	if (present (type)) then
	do while (associated (var))
	if (var%type == type) then
	if (var%name == name) then
	if (ignore_undef .or. var%is_defined) return
	end if
	end if
	var => var%next
	end do
	else
	do while (associated (var))
	if (var%name == name) then
	if (ignore_undef .or. var%is_defined) return
	end if
	var => var%next
	end do
	end if
	search_next = associated (var_list%next)
	if (present (follow_link)) &
	search_next = search_next .and. follow_link
	if (search_next) &
	var => var_list_get_var_ptr &
	(var_list%next, name, type, defined=defined)
	end function var_list_get_var_ptr

	@ %def var_list_get_var_ptr
	@ Return the variable type
	<<Variables: var list: TBP>>=
	procedure :: get_type => var_list_get_type
	<<Variables: procedures>>=
	function var_list_get_type (var_list, name, follow_link) result (type)
	class(var_list_t), intent(in), target :: var_list
	type(string_t), intent(in) :: name
	logical, intent(in), optional :: follow_link
	integer :: type
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, follow_link=follow_link)
	if (associated (var)) then
	type = var%type
	else
	type = V_NONE
	end if
	end function var_list_get_type

	@ %def var_list_get_type
	@ Return true if the variable exists in the current list.
	<<Variables: var list: TBP>>=
	procedure :: contains => var_list_exists
	<<Variables: procedures>>=
	function var_list_exists (vars, name, follow_link) result (lval)
	logical :: lval
	type(string_t), intent(in) :: name
	class(var_list_t), intent(in) :: vars
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
	lval = associated (var)
	end function var_list_exists

	@ %def var_list_exists
	@ Return true if the variable is declared as intrinsic. (This is not a
	property of the abstract [[vars_t]] type, and therefore the method is
	not inherited.)
	<<Variables: var list: TBP>>=
	procedure :: is_intrinsic => var_list_is_intrinsic
	<<Variables: procedures>>=
	function var_list_is_intrinsic (vars, name, follow_link) result (lval)
	logical :: lval
	type(string_t), intent(in) :: name
	class(var_list_t), intent(in) :: vars
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
	if (associated (var)) then
	lval = var%is_intrinsic
	else
	lval = .false.
	end if
	end function var_list_is_intrinsic

	@ %def var_list_is_intrinsic
	@ Return true if the value is known.
	<<Variables: var list: TBP>>=
	procedure :: is_known => var_list_is_known
	<<Variables: procedures>>=
	function var_list_is_known (vars, name, follow_link) result (lval)
	logical :: lval
	type(string_t), intent(in) :: name
	class(var_list_t), intent(in) :: vars
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
	if (associated (var)) then
	lval = var%is_known
	else
	lval = .false.
	end if
	end function var_list_is_known

	@ %def var_list_is_known
	@ Return true if the value is locked. (This is not a
	property of the abstract [[vars_t]] type, and therefore the method is
	not inherited.)
	<<Variables: var list: TBP>>=
	procedure :: is_locked => var_list_is_locked
	<<Variables: procedures>>=
	function var_list_is_locked (vars, name, follow_link) result (lval)
	logical :: lval
	type(string_t), intent(in) :: name
	class(var_list_t), intent(in) :: vars
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
	if (associated (var)) then
	lval = var_entry_is_locked (var)
	else
	lval = .false.
	end if
	end function var_list_is_locked

	@ %def var_list_is_locked
	@ Return several properties at once.
	<<Variables: var list: TBP>>=
	procedure :: get_var_properties => var_list_get_var_properties
	<<Variables: procedures>>=
	subroutine var_list_get_var_properties (vars, name, req_type, follow_link, &
	type, is_defined, is_known, is_locked)
	class(var_list_t), intent(in) :: vars
	type(string_t), intent(in) :: name
	integer, intent(in), optional :: req_type
	logical, intent(in), optional :: follow_link
	integer, intent(out), optional :: type
	logical, intent(out), optional :: is_defined, is_known, is_locked
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr &
	(vars, name, type=req_type, follow_link=follow_link)
	if (associated (var)) then
	if (present (type)) type = var_entry_get_type (var)
	if (present (is_defined)) is_defined = var_entry_is_defined (var)
	if (present (is_known)) is_known = var_entry_is_known (var)
	if (present (is_locked)) is_locked = var_entry_is_locked (var)
	else
	if (present (type)) type = V_NONE
	if (present (is_defined)) is_defined = .false.
	if (present (is_known)) is_known = .false.
	if (present (is_locked)) is_locked = .false.
	end if
	end subroutine var_list_get_var_properties

	@ %def var_list_get_var_properties
	@ Return the value, assuming that the type is correct. We consider only
	variable entries that have been [[defined]].

	For convenience, allow both variable and fixed-length (literal) strings.
	<<Variables: var list: TBP>>=
	procedure :: get_lval => var_list_get_lval
	procedure :: get_ival => var_list_get_ival
	procedure :: get_rval => var_list_get_rval
	procedure :: get_cval => var_list_get_cval
	procedure :: get_pval => var_list_get_pval
	procedure :: get_aval => var_list_get_aval
	procedure :: get_sval => var_list_get_sval
	<<Variables: procedures>>=
	function var_list_get_lval (vars, name, follow_link) result (lval)
	logical :: lval
	type(string_t), intent(in) :: name
	class(var_list_t), intent(in) :: vars
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr &
	(vars, name, V_LOG, follow_link, defined=.true.)
	if (associated (var)) then
	if (var_has_value (var)) then
	lval = var%lval
	else
	lval = .false.
	end if
	else
	lval = .false.
	end if
	end function var_list_get_lval

	function var_list_get_ival (vars, name, follow_link) result (ival)
	integer :: ival
	type(string_t), intent(in) :: name
	class(var_list_t), intent(in) :: vars
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr &
	(vars, name, V_INT, follow_link, defined=.true.)
	if (associated (var)) then
	if (var_has_value (var)) then
	ival = var%ival
	else
	ival = 0
	end if
	else
	ival = 0
	end if
	end function var_list_get_ival

	function var_list_get_rval (vars, name, follow_link) result (rval)
	real(default) :: rval
	type(string_t), intent(in) :: name
	class(var_list_t), intent(in) :: vars
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr &
	(vars, name, V_REAL, follow_link, defined=.true.)
	if (associated (var)) then
	if (var_has_value (var)) then
	rval = var%rval
	else
	rval = 0
	end if
	else
	rval = 0
	end if
	end function var_list_get_rval

	function var_list_get_cval (vars, name, follow_link) result (cval)
	complex(default) :: cval
	type(string_t), intent(in) :: name
	class(var_list_t), intent(in) :: vars
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr &
	(vars, name, V_CMPLX, follow_link, defined=.true.)
	if (associated (var)) then
	if (var_has_value (var)) then
	cval = var%cval
	else
	cval = 0
	end if
	else
	cval = 0
	end if
	end function var_list_get_cval

	function var_list_get_aval (vars, name, follow_link) result (aval)
	type(pdg_array_t) :: aval
	type(string_t), intent(in) :: name
	class(var_list_t), intent(in) :: vars
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr &
	(vars, name, V_PDG, follow_link, defined=.true.)
	if (associated (var)) then
	if (var_has_value (var)) then
	aval = var%aval
	end if
	end if
	end function var_list_get_aval

	function var_list_get_pval (vars, name, follow_link) result (pval)
	type(subevt_t) :: pval
	type(string_t), intent(in) :: name
	class(var_list_t), intent(in) :: vars
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr &
	(vars, name, V_SEV, follow_link, defined=.true.)
	if (associated (var)) then
	if (var_has_value (var)) then
	pval = var%pval
	end if
	end if
	end function var_list_get_pval

	function var_list_get_sval (vars, name, follow_link) result (sval)
	type(string_t) :: sval
	type(string_t), intent(in) :: name
	class(var_list_t), intent(in) :: vars
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr &
	(vars, name, V_STR, follow_link, defined=.true.)
	if (associated (var)) then
	if (var_has_value (var)) then
	sval = var%sval
	else
	sval = ""
	end if
	else
	sval = ""
	end if
	end function var_list_get_sval

	@ %def var_list_get_lval
	@ %def var_list_get_ival
	@ %def var_list_get_rval
	@ %def var_list_get_cval
	@ %def var_list_get_pval
	@ %def var_list_get_aval
	@ %def var_list_get_sval
	@ Check for a valid value, given a pointer. Issue error messages if invalid.
	<<Variables: procedures>>=
	function var_has_value (var) result (valid)
	logical :: valid
	type(var_entry_t), pointer :: var
	if (associated (var)) then
	if (var%is_known) then
	valid = .true.
	else
	call msg_error ("The value of variable '" // char (var%name) &
	// "' is unknown but must be known at this point.")
	valid = .false.
	end if
	else
	call msg_error ("Variable '" // char (var%name) &
	// "' is undefined but must have a known value at this point.")
	valid = .false.
	end if
	end function var_has_value

	@ %def var_has_value
	@ Return pointers instead of values, including a pointer to the
	[[known]] entry.
	<<Variables: var list: TBP>>=
	procedure :: get_lptr => var_list_get_lptr
	procedure :: get_iptr => var_list_get_iptr
	procedure :: get_rptr => var_list_get_rptr
	procedure :: get_cptr => var_list_get_cptr
	procedure :: get_aptr => var_list_get_aptr
	procedure :: get_pptr => var_list_get_pptr
	procedure :: get_sptr => var_list_get_sptr
	<<Variables: procedures>>=
	subroutine var_list_get_lptr (var_list, name, lptr, known)
	class(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: name
	logical, pointer, intent(out) :: lptr
	logical, pointer, intent(out), optional :: known
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_LOG)
	if (associated (var)) then
	lptr => var_entry_get_lval_ptr (var)
	if (present (known)) known => var_entry_get_known_ptr (var)
	else
	lptr => null ()
	if (present (known)) known => null ()
	end if
	end subroutine var_list_get_lptr

	subroutine var_list_get_iptr (var_list, name, iptr, known)
	class(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: name
	integer, pointer, intent(out) :: iptr
	logical, pointer, intent(out), optional :: known
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_INT)
	if (associated (var)) then
	iptr => var_entry_get_ival_ptr (var)
	if (present (known)) known => var_entry_get_known_ptr (var)
	else
	iptr => null ()
	if (present (known)) known => null ()
	end if
	end subroutine var_list_get_iptr

	subroutine var_list_get_rptr (var_list, name, rptr, known)
	class(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: name
	real(default), pointer, intent(out) :: rptr
	logical, pointer, intent(out), optional :: known
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_REAL)
	if (associated (var)) then
	rptr => var_entry_get_rval_ptr (var)
	if (present (known)) known => var_entry_get_known_ptr (var)
	else
	rptr => null ()
	if (present (known)) known => null ()
	end if
	end subroutine var_list_get_rptr

	subroutine var_list_get_cptr (var_list, name, cptr, known)
	class(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: name
	complex(default), pointer, intent(out) :: cptr
	logical, pointer, intent(out), optional :: known
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_CMPLX)
	if (associated (var)) then
	cptr => var_entry_get_cval_ptr (var)
	if (present (known)) known => var_entry_get_known_ptr (var)
	else
	cptr => null ()
	if (present (known)) known => null ()
	end if
	end subroutine var_list_get_cptr

	subroutine var_list_get_aptr (var_list, name, aptr, known)
	class(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: name
	type(pdg_array_t), pointer, intent(out) :: aptr
	logical, pointer, intent(out), optional :: known
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_PDG)
	if (associated (var)) then
	aptr => var_entry_get_aval_ptr (var)
	if (present (known)) known => var_entry_get_known_ptr (var)
	else
	aptr => null ()
	if (present (known)) known => null ()
	end if
	end subroutine var_list_get_aptr

	subroutine var_list_get_pptr (var_list, name, pptr, known)
	class(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: name
	type(subevt_t), pointer, intent(out) :: pptr
	logical, pointer, intent(out), optional :: known
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_SEV)
	if (associated (var)) then
	pptr => var_entry_get_pval_ptr (var)
	if (present (known)) known => var_entry_get_known_ptr (var)
	else
	pptr => null ()
	if (present (known)) known => null ()
	end if
	end subroutine var_list_get_pptr

	subroutine var_list_get_sptr (var_list, name, sptr, known)
	class(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: name
	type(string_t), pointer, intent(out) :: sptr
	logical, pointer, intent(out), optional :: known
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_STR)
	if (associated (var)) then
	sptr => var_entry_get_sval_ptr (var)
	if (present (known)) known => var_entry_get_known_ptr (var)
	else
	sptr => null ()
	if (present (known)) known => null ()
	end if
	end subroutine var_list_get_sptr

	@ %def var_list_get_lptr
	@ %def var_list_get_iptr
	@ %def var_list_get_rptr
	@ %def var_list_get_cptr
	@ %def var_list_get_aptr
	@ %def var_list_get_pptr
	@ %def var_list_get_sptr
	@
	This bunch of methods handles the procedure-pointer cases.
	<<Variables: var list: TBP>>=
	procedure :: get_obs1_iptr => var_list_get_obs1_iptr
	procedure :: get_obs2_iptr => var_list_get_obs2_iptr
	procedure :: get_obs1_rptr => var_list_get_obs1_rptr
	procedure :: get_obs2_rptr => var_list_get_obs2_rptr
	<<Variables: procedures>>=
	subroutine var_list_get_obs1_iptr (var_list, name, obs1_iptr, p1)
	class(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: name
	procedure(obs_unary_int), pointer, intent(out) :: obs1_iptr
	type(prt_t), pointer, intent(out) :: p1
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_OBS1_INT)
	if (associated (var)) then
	call var_entry_assign_obs1_int_ptr (obs1_iptr, var)
	p1 => var_entry_get_prt1_ptr (var)
	else
	obs1_iptr => null ()
	p1 => null ()
	end if
	end subroutine var_list_get_obs1_iptr

	subroutine var_list_get_obs2_iptr (var_list, name, obs2_iptr, p1, p2)
	class(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: name
	procedure(obs_binary_int), pointer, intent(out) :: obs2_iptr
	type(prt_t), pointer, intent(out) :: p1, p2
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_OBS2_INT)
	if (associated (var)) then
	call var_entry_assign_obs2_int_ptr (obs2_iptr, var)
	p1 => var_entry_get_prt1_ptr (var)
	p2 => var_entry_get_prt2_ptr (var)
	else
	obs2_iptr => null ()
	p1 => null ()
	p2 => null ()
	end if
	end subroutine var_list_get_obs2_iptr

	subroutine var_list_get_obs1_rptr (var_list, name, obs1_rptr, p1)
	class(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: name
	procedure(obs_unary_real), pointer, intent(out) :: obs1_rptr
	type(prt_t), pointer, intent(out) :: p1
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_OBS1_REAL)
	if (associated (var)) then
	call var_entry_assign_obs1_real_ptr (obs1_rptr, var)
	p1 => var_entry_get_prt1_ptr (var)
	else
	obs1_rptr => null ()
	p1 => null ()
	end if
	end subroutine var_list_get_obs1_rptr

	subroutine var_list_get_obs2_rptr (var_list, name, obs2_rptr, p1, p2)
	class(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: name
	procedure(obs_binary_real), pointer, intent(out) :: obs2_rptr
	type(prt_t), pointer, intent(out) :: p1, p2
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_OBS2_REAL)
	if (associated (var)) then
	call var_entry_assign_obs2_real_ptr (obs2_rptr, var)
	p1 => var_entry_get_prt1_ptr (var)
	p2 => var_entry_get_prt2_ptr (var)
	else
	obs2_rptr => null ()
	p1 => null ()
	p2 => null ()
	end if
	end subroutine var_list_get_obs2_rptr

	@ %def var_list_get_obs1_iptr
	@ %def var_list_get_obs2_iptr
	@ %def var_list_get_obs1_rptr
	@ %def var_list_get_obs2_rptr
	@
	\subsection{Process Result Variables}
	These variables are associated to process (integration) runs and their
	results. Their names contain brackets (so they look like function
	evaluations), therefore we need to special-case them.
	<<Variables: public>>=
	public :: var_list_set_procvar_int
	public :: var_list_set_procvar_real
	<<Variables: procedures>>=
	subroutine var_list_set_procvar_int (var_list, proc_id, name, ival)
	type(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: proc_id
	type(string_t), intent(in) :: name
	integer, intent(in), optional :: ival
	type(string_t) :: var_name
	type(var_entry_t), pointer :: var
	var_name = name // "(" // proc_id // ")"
	var => var_list_get_var_ptr (var_list, var_name)
	if (.not. associated (var)) then
	call var_list%append_int (var_name, ival, intrinsic=.true.)
	else if (present (ival)) then
	call var_list%set_int (var_name, ival, is_known=.true.)
	end if
	end subroutine var_list_set_procvar_int

	subroutine var_list_set_procvar_real (var_list, proc_id, name, rval)
	type(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: proc_id
	type(string_t), intent(in) :: name
	real(default), intent(in), optional :: rval
	type(string_t) :: var_name
	type(var_entry_t), pointer :: var
	var_name = name // "(" // proc_id // ")"
	var => var_list_get_var_ptr (var_list, var_name)
	if (.not. associated (var)) then
	call var_list%append_real (var_name, rval, intrinsic=.true.)
	else if (present (rval)) then
	call var_list%set_real (var_name, rval, is_known=.true.)
	end if
	end subroutine var_list_set_procvar_real

	@ %def var_list_set_procvar_int
	@ %def var_list_set_procvar_real
	@
	\subsection{Observable initialization}
	Observables are formally treated as variables, which however are
	evaluated each time the observable is used. The arguments (pointers)
	to evaluate and the function are part of the variable-list entry.
	<<Variables: public>>=
	public :: var_list_append_obs1_iptr
	public :: var_list_append_obs2_iptr
	public :: var_list_append_obs1_rptr
	public :: var_list_append_obs2_rptr
	<<Variables: procedures>>=
	subroutine var_list_append_obs1_iptr (var_list, name, obs1_iptr, p1)
	type(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	procedure(obs_unary_int) :: obs1_iptr
	type(prt_t), intent(in), target :: p1
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_obs (var, name, V_OBS1_INT, p1)
	var%obs1_int => obs1_iptr
	call var_list_append (var_list, var)
	end subroutine var_list_append_obs1_iptr

	subroutine var_list_append_obs2_iptr (var_list, name, obs2_iptr, p1, p2)
	type(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	procedure(obs_binary_int) :: obs2_iptr
	type(prt_t), intent(in), target :: p1, p2
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_obs (var, name, V_OBS2_INT, p1, p2)
	var%obs2_int => obs2_iptr
	call var_list_append (var_list, var)
	end subroutine var_list_append_obs2_iptr

	subroutine var_list_append_obs1_rptr (var_list, name, obs1_rptr, p1)
	type(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	procedure(obs_unary_real) :: obs1_rptr
	type(prt_t), intent(in), target :: p1
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_obs (var, name, V_OBS1_REAL, p1)
	var%obs1_real => obs1_rptr
	call var_list_append (var_list, var)
	end subroutine var_list_append_obs1_rptr

	subroutine var_list_append_obs2_rptr (var_list, name, obs2_rptr, p1, p2)
	type(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	procedure(obs_binary_real) :: obs2_rptr
	type(prt_t), intent(in), target :: p1, p2
	type(var_entry_t), pointer :: var
	allocate (var)
	call var_entry_init_obs (var, name, V_OBS2_REAL, p1, p2)
	var%obs2_real => obs2_rptr
	call var_list_append (var_list, var)
	end subroutine var_list_append_obs2_rptr

	@ %def var_list_append_obs1_iptr
	@ %def var_list_append_obs2_iptr
	@ %def var_list_append_obs1_rptr
	@ %def var_list_append_obs2_rptr
	@ User observables: no pointer needs to be stored.
	<<Variables: public>>=
	public :: var_list_append_uobs_int
	public :: var_list_append_uobs_real
	<<Variables: procedures>>=
	subroutine var_list_append_uobs_int (var_list, name, p1, p2)
	type(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	type(prt_t), intent(in), target :: p1
	type(prt_t), intent(in), target, optional :: p2
	type(var_entry_t), pointer :: var
	allocate (var)
	if (present (p2)) then
	call var_entry_init_obs (var, name, V_UOBS2_INT, p1, p2)
	else
	call var_entry_init_obs (var, name, V_UOBS1_INT, p1)
	end if
	call var_list_append (var_list, var)
	end subroutine var_list_append_uobs_int

	subroutine var_list_append_uobs_real (var_list, name, p1, p2)
	type(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: name
	type(prt_t), intent(in), target :: p1
	type(prt_t), intent(in), target, optional :: p2
	type(var_entry_t), pointer :: var
	allocate (var)
	if (present (p2)) then
	call var_entry_init_obs (var, name, V_UOBS2_REAL, p1, p2)
	else
	call var_entry_init_obs (var, name, V_UOBS1_REAL, p1)
	end if
	call var_list_append (var_list, var)
	end subroutine var_list_append_uobs_real

	@ %def var_list_append_uobs_int
	@ %def var_list_append_uobs_real
	@
	\subsection{API for variable lists}
	Set a new value. If the variable holds a pointer, this pointer is
	followed, e.g., a model parameter is actually set. If [[ignore]] is
	set, do nothing if the variable does not exist. If [[verbose]] is
	set, echo the new value.

	Clear a variable (all variables), i.e., undefine the value.
	<<Variables: var list: TBP>>=
	procedure :: unset => var_list_clear
	<<Variables: procedures>>=
	subroutine var_list_clear (vars, name, follow_link)
	class(var_list_t), intent(inout) :: vars
	type(string_t), intent(in) :: name
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
	if (associated (var)) then
	call var_entry_clear (var)
	end if
	end subroutine var_list_clear

	@ %def var_list_clear
	@
	Setting the value, concise specific versions (implementing deferred TBP):
	<<Variables: var list: TBP>>=
	procedure :: set_ival => var_list_set_ival
	procedure :: set_rval => var_list_set_rval
	procedure :: set_cval => var_list_set_cval
	procedure :: set_lval => var_list_set_lval
	procedure :: set_sval => var_list_set_sval
	<<Variables: procedures>>=
	subroutine var_list_set_ival (vars, name, ival, follow_link)
	class(var_list_t), intent(inout) :: vars
	type(string_t), intent(in) :: name
	integer, intent(in) :: ival
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
	if (associated (var)) then
	call var_entry_set_int (var, ival, is_known=.true.)
	end if
	end subroutine var_list_set_ival

	subroutine var_list_set_rval (vars, name, rval, follow_link)
	class(var_list_t), intent(inout) :: vars
	type(string_t), intent(in) :: name
	real(default), intent(in) :: rval
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
	if (associated (var)) then
	call var_entry_set_real (var, rval, is_known=.true.)
	end if
	end subroutine var_list_set_rval

	subroutine var_list_set_cval (vars, name, cval, follow_link)
	class(var_list_t), intent(inout) :: vars
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: cval
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
	if (associated (var)) then
	call var_entry_set_cmplx (var, cval, is_known=.true.)
	end if
	end subroutine var_list_set_cval

	subroutine var_list_set_lval (vars, name, lval, follow_link)
	class(var_list_t), intent(inout) :: vars
	type(string_t), intent(in) :: name
	logical, intent(in) :: lval
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
	if (associated (var)) then
	call var_entry_set_log (var, lval, is_known=.true.)
	end if
	end subroutine var_list_set_lval

	subroutine var_list_set_sval (vars, name, sval, follow_link)
	class(var_list_t), intent(inout) :: vars
	type(string_t), intent(in) :: name
	type(string_t), intent(in) :: sval
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (vars, name, follow_link=follow_link)
	if (associated (var)) then
	call var_entry_set_string (var, sval, is_known=.true.)
	end if
	end subroutine var_list_set_sval

	@ %def var_list_set_ival
	@ %def var_list_set_rval
	@ %def var_list_set_cval
	@ %def var_list_set_lval
	@ %def var_list_set_sval
	@
	Setting the value, verbose specific versions (as subroutines):
	<<Variables: var list: TBP>>=
	procedure :: set_log => var_list_set_log
	procedure :: set_int => var_list_set_int
	procedure :: set_real => var_list_set_real
	procedure :: set_cmplx => var_list_set_cmplx
	procedure :: set_subevt => var_list_set_subevt
	procedure :: set_pdg_array => var_list_set_pdg_array
	procedure :: set_string => var_list_set_string
	<<Variables: procedures>>=
	subroutine var_list_set_log &
	(var_list, name, lval, is_known, ignore, force, verbose, model_name)
	class(var_list_t), intent(inout), target :: var_list
	type(string_t), intent(in) :: name
	logical, intent(in) :: lval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: ignore, force, verbose
	type(string_t), intent(in), optional :: model_name
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_LOG)
	if (associated (var)) then
	if (.not. var_entry_is_locked (var, force)) then
	select case (var%type)
	case (V_LOG)
	call var_entry_set_log (var, lval, is_known, verbose, model_name)
	case default
	call var_mismatch_error (name)
	end select
	else
	call var_locked_error (name)
	end if
	else
	call var_missing_error (name, ignore)
	end if
	end subroutine var_list_set_log

	subroutine var_list_set_int &
	(var_list, name, ival, is_known, ignore, force, verbose, model_name)
	class(var_list_t), intent(inout), target :: var_list
	type(string_t), intent(in) :: name
	integer, intent(in) :: ival
	logical, intent(in) :: is_known
	logical, intent(in), optional :: ignore, force, verbose
	type(string_t), intent(in), optional :: model_name
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_INT)
	if (associated (var)) then
	if (.not. var_entry_is_locked (var, force)) then
	select case (var%type)
	case (V_INT)
	call var_entry_set_int (var, ival, is_known, verbose, model_name)
	case default
	call var_mismatch_error (name)
	end select
	else
	call var_locked_error (name)
	end if
	else
	call var_missing_error (name, ignore)
	end if
	end subroutine var_list_set_int

	subroutine var_list_set_real &
	(var_list, name, rval, is_known, ignore, force, &
	verbose, model_name, pacified)
	class(var_list_t), intent(inout), target :: var_list
	type(string_t), intent(in) :: name
	real(default), intent(in) :: rval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: ignore, force, verbose, pacified
	type(string_t), intent(in), optional :: model_name
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_REAL)
	if (associated (var)) then
	if (.not. var_entry_is_locked (var, force)) then
	select case (var%type)
	case (V_REAL)
	call var_entry_set_real &
	(var, rval, is_known, verbose, model_name, pacified)
	case default
	call var_mismatch_error (name)
	end select
	else
	call var_locked_error (name)
	end if
	else
	call var_missing_error (name, ignore)
	end if
	end subroutine var_list_set_real

	subroutine var_list_set_cmplx &
	(var_list, name, cval, is_known, ignore, force, &
	verbose, model_name, pacified)
	class(var_list_t), intent(inout), target :: var_list
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: cval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: ignore, force, verbose, pacified
	type(string_t), intent(in), optional :: model_name
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_CMPLX)
	if (associated (var)) then
	if (.not. var_entry_is_locked (var, force)) then
	select case (var%type)
	case (V_CMPLX)
	call var_entry_set_cmplx &
	(var, cval, is_known, verbose, model_name, pacified)
	case default
	call var_mismatch_error (name)
	end select
	else
	call var_locked_error (name)
	end if
	else
	call var_missing_error (name, ignore)
	end if
	end subroutine var_list_set_cmplx

	subroutine var_list_set_pdg_array &
	(var_list, name, aval, is_known, ignore, force, verbose, model_name)
	class(var_list_t), intent(inout), target :: var_list
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in) :: aval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: ignore, force, verbose
	type(string_t), intent(in), optional :: model_name
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_PDG)
	if (associated (var)) then
	if (.not. var_entry_is_locked (var, force)) then
	select case (var%type)
	case (V_PDG)
	call var_entry_set_pdg_array &
	(var, aval, is_known, verbose, model_name)
	case default
	call var_mismatch_error (name)
	end select
	else
	call var_locked_error (name)
	end if
	else
	call var_missing_error (name, ignore)
	end if
	end subroutine var_list_set_pdg_array

	subroutine var_list_set_subevt &
	(var_list, name, pval, is_known, ignore, force, verbose, model_name)
	class(var_list_t), intent(inout), target :: var_list
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in) :: pval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: ignore, force, verbose
	type(string_t), intent(in), optional :: model_name
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_SEV)
	if (associated (var)) then
	if (.not. var_entry_is_locked (var, force)) then
	select case (var%type)
	case (V_SEV)
	call var_entry_set_subevt &
	(var, pval, is_known, verbose, model_name)
	case default
	call var_mismatch_error (name)
	end select
	else
	call var_locked_error (name)
	end if
	else
	call var_missing_error (name, ignore)
	end if
	end subroutine var_list_set_subevt

	subroutine var_list_set_string &
	(var_list, name, sval, is_known, ignore, force, verbose, model_name)
	class(var_list_t), intent(inout), target :: var_list
	type(string_t), intent(in) :: name
	type(string_t), intent(in) :: sval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: ignore, force, verbose
	type(string_t), intent(in), optional :: model_name
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name, V_STR)
	if (associated (var)) then
	if (.not. var_entry_is_locked (var, force)) then
	select case (var%type)
	case (V_STR)
	call var_entry_set_string &
	(var, sval, is_known, verbose, model_name)
	case default
	call var_mismatch_error (name)
	end select
	else
	call var_locked_error (name)
	end if
	else
	call var_missing_error (name, ignore)
	end if
	end subroutine var_list_set_string

	subroutine var_mismatch_error (name)
	type(string_t), intent(in) :: name
	call msg_fatal ("Type mismatch for variable '" // char (name) // "'")
	end subroutine var_mismatch_error

	subroutine var_locked_error (name)
	type(string_t), intent(in) :: name
	call msg_error ("Variable '" // char (name) // "' is not user-definable")
	end subroutine var_locked_error

	subroutine var_missing_error (name, ignore)
	type(string_t), intent(in) :: name
	logical, intent(in), optional :: ignore
	logical :: error
	if (present (ignore)) then
	error = .not. ignore
	else
	error = .true.
	end if
	if (error) then
	call msg_fatal ("Variable '" // char (name) // "' has not been declared")
	end if
	end subroutine var_missing_error

	@ %def var_list_set_log
	@ %def var_list_set_int
	@ %def var_list_set_real
	@ %def var_list_set_cmplx
	@ %def var_list_set_subevt
	@ %def var_list_set_pdg_array
	@ %def var_list_set_string
	@ %def var_mismatch_error
	@ %def var_missing_error
	@
	Import values for the current variable list from another list.
	<<Variables: public>>=
	public :: var_list_import
	<<Variables: var list: TBP>>=
	procedure :: import => var_list_import
	<<Variables: procedures>>=
	subroutine var_list_import (var_list, src_list)
	class(var_list_t), intent(inout) :: var_list
	type(var_list_t), intent(in) :: src_list
	type(var_entry_t), pointer :: var, src
	var => var_list%first
	do while (associated (var))
	src => var_list_get_var_ptr (src_list, var%name)
	if (associated (src)) then
	call var_entry_copy_value (var, src)
	end if
	var => var%next
	end do
	end subroutine var_list_import

	@ %def var_list_import
	@ Mark all entries in the current variable list as undefined. This is done
	when a local variable list is discarded. If the local list is used again (by
	a loop), the entries will be re-initialized.
	<<Variables: public>>=
	public :: var_list_undefine
	<<Variables: var list: TBP>>=
	procedure :: undefine => var_list_undefine
	<<Variables: procedures>>=
	recursive subroutine var_list_undefine (var_list, follow_link)
	class(var_list_t), intent(inout) :: var_list
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var
	logical :: rec
	rec = .true.; if (present (follow_link)) rec = follow_link
	var => var_list%first
	do while (associated (var))
	call var_entry_undefine (var)
	var => var%next
	end do
	if (rec .and. associated (var_list%next)) then
	call var_list_undefine (var_list%next, follow_link=follow_link)
	end if
	end subroutine var_list_undefine

	@ %def var_list_undefine
	@ Make a deep copy of a variable list.
	<<Variables: public>>=
	public :: var_list_init_snapshot
	<<Variables: var list: TBP>>=
	procedure :: init_snapshot => var_list_init_snapshot
	<<Variables: procedures>>=
	recursive subroutine var_list_init_snapshot (var_list, vars_in, follow_link)
	class(var_list_t), intent(out) :: var_list
	type(var_list_t), intent(in) :: vars_in
	logical, intent(in), optional :: follow_link
	type(var_entry_t), pointer :: var, var_in
	type(var_list_t), pointer :: var_list_next
	logical :: rec
	rec = .true.; if (present (follow_link)) rec = follow_link
	var_in => vars_in%first
	do while (associated (var_in))
	allocate (var)
	call var_entry_init_copy (var, var_in)
	call var_entry_copy_value (var, var_in)
	call var_list_append (var_list, var)
	var_in => var_in%next
	end do
	if (rec .and. associated (vars_in%next)) then
	allocate (var_list_next)
	call var_list_init_snapshot (var_list_next, vars_in%next)
	call var_list%link (var_list_next)
	end if
	end subroutine var_list_init_snapshot

	@ %def var_list_init_snapshot
	@ Check if a user variable can be set. The [[new]] flag is set if the user
	variable has an explicit declaration. If an error occurs, return [[V_NONE]]
	as variable type.

	Also determine the actual type of generic numerical variables, which enter the
	procedure with type [[V_NONE]].
	<<Variables: public>>=
	public :: var_list_check_user_var
	<<Variables: var list: TBP>>=
	procedure :: check_user_var => var_list_check_user_var
	<<Variables: procedures>>=
	subroutine var_list_check_user_var (var_list, name, type, new)
	class(var_list_t), intent(in), target :: var_list
	type(string_t), intent(in) :: name
	integer, intent(inout) :: type
	logical, intent(in) :: new
	type(var_entry_t), pointer :: var
	var => var_list_get_var_ptr (var_list, name)
	if (associated (var)) then
	if (type == V_NONE) then
	type = var_entry_get_type (var)
	end if
	if (var_entry_is_locked (var)) then
	call msg_fatal ("Variable '" // char (name) &
	// "' is not user-definable")
	type = V_NONE
	return
	else if (new) then
	if (var_entry_is_intrinsic (var)) then
	call msg_fatal ("Intrinsic variable '" &
	// char (name) // "' redeclared")
	type = V_NONE
	return
	end if
	if (var_entry_get_type (var) /= type) then
	call msg_fatal ("Variable '" // char (name) // "' " &
	// "redeclared with different type")
	type = V_NONE
	return
	end if
	end if
	end if
	end subroutine var_list_check_user_var

	@ %def var_list_check_user_var
	@
	\subsection{Default values for global var list}

	<<Variables: var list: TBP>>=
	procedure :: init_defaults => var_list_init_defaults
	<<Variables: procedures>>=
	subroutine var_list_init_defaults (var_list, seed, paths)
	class(var_list_t), intent(out) :: var_list
	integer, intent(in) :: seed
	type(paths_t), intent(in), optional :: paths
	call var_list%set_beams_defaults (paths)
	call var_list%set_core_defaults (seed)
	call var_list%set_integration_defaults ()
	call var_list%set_phase_space_defaults ()
	call var_list%set_gamelan_defaults ()
	call var_list%set_clustering_defaults ()
	call var_list%set_eio_defaults ()
	call var_list%set_shower_defaults ()
	call var_list%set_hadronization_defaults ()
	call var_list%set_tauola_defaults ()
	call var_list%set_mlm_matching_defaults ()
	call var_list%set_powheg_matching_defaults ()
	call var_list%append_log (var_str ("?ckkw_matching"), .false., &
	intrinsic=.true., description=var_str ('Master flag that switches ' // &
	'on the CKKW(-L) (LO) matching between hard scattering matrix ' // &
	'elements and QCD parton showers. Note that this is not yet ' // &
	'(completely) implemented in \whizard. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...})'))
	call var_list%set_openmp_defaults ()
	call var_list%set_mpi_defaults ()
	call var_list%set_nlo_defaults ()
	end subroutine var_list_init_defaults

	@ %def var_list_init_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_beams_defaults => var_list_set_beams_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_beams_defaults (var_list, paths)
	type(paths_t), intent(in), optional :: paths
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_real (var_str ("sqrts"), &
	intrinsic=.true., &
	description=var_str ('Real variable in order to set the center-of-mass ' // &
	'energy for the collisions (collider energy $\sqrt{s}$, not ' // &
	'hard interaction energy $\sqrt{\hat{s}}$): \ttt{sqrts = {\em ' // &
	'<num>} [ {\em <phys\_unit>} ]}. The physical unit can be one ' // &
	'of the following \ttt{eV}, \ttt{keV}, \ttt{MeV}, \ttt{GeV}, ' // &
	'and \ttt{TeV}. If absent, \whizard\ takes \ttt{GeV} as its ' // &
	'standard unit. Note that this variable is absolutely mandatory ' // &
	'for integration and simulation of scattering processes.'))
	call var_list%append_real (var_str ("luminosity"), 0._default, &
	intrinsic=.true., &
	description=var_str ('This specifier \ttt{luminosity = {\em ' // &
	'<num>}} sets the integrated luminosity (in inverse femtobarns, ' // &
	'fb${}^{-1}$) for the event generation of the processes in the ' // &
	'\sindarin\ input files. Note that WHIZARD itself chooses the ' // &
	'number from the \ttt{luminosity} or from the \ttt{n\_events} ' // &
	'specifier, whichever would give the larger number of events. ' // &
	'As this depends on the cross section under consideration, it ' // &
	'might be different for different processes in the process list. ' // &
	'(cf. \ttt{n\_events}, \ttt{\$sample}, \ttt{sample\_format}, \ttt{?unweighted})'))
	call var_list%append_log (var_str ("?sf_trace"), .false., &
	intrinsic=.true., &
	description=var_str ('Debug flag that writes out detailed information ' // &
	'about the structure function setup into the file \ttt{{\em ' // &
	'<proc\_name>}\_sftrace.dat}. This file name can be changed ' // &
	'with ($\to$) \ttt{\$sf\_trace\_file}.'))
	call var_list%append_string (var_str ("$sf_trace_file"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('\ttt{\$sf\_trace\_file = "{\em <file\_name>}"} ' // &
	'allows to change the detailed structure function information ' // &
	'switched on by the debug flag ($\to$) \ttt{?sf\_trace} into ' // &
	'a different file \ttt{{\em <file\_name>}} than the default ' // &
	'\ttt{{\em <proc\_name>}\_sftrace.dat}.'))
	call var_list%append_log (var_str ("?sf_allow_s_mapping"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that determines whether special mappings ' // &
	'for processes with structure functions and $s$-channel resonances ' // &
	'are applied, e.g. Drell-Yan at hadron colliders, or $Z$ production ' // &
	'at linear colliders with beamstrahlung and ISR.'))
	if (present (paths)) then
	call var_list%append_string (var_str ("$lhapdf_dir"), paths%lhapdfdir, &
	intrinsic=.true., &
	description=var_str ('String variable that tells the path ' // &
	'where the \lhapdf\ library and PDF sets can be found. When ' // &
	'the library has been correctly recognized during configuration, ' // &
	'this is automatically set by \whizard. (cf. also \ttt{lhapdf}, ' // &
	'\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // &
	'\ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})'))
	else
	call var_list%append_string (var_str ("$lhapdf_dir"), var_str(""), &
	intrinsic=.true., &
	description=var_str ('String variable that tells the path ' // &
	'where the \lhapdf\ library and PDF sets can be found. When ' // &
	'the library has been correctly recognized during configuration, ' // &
	'this is automatically set by \whizard. (cf. also \ttt{lhapdf}, ' // &
	'\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // &
	'\ttt{lhapdf\_member}, \ttt{lhapdf\_photon\_scheme})'))
	end if
	call var_list%append_string (var_str ("$lhapdf_file"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('This string variable \ttt{\$lhapdf\_file ' // &
	'= "{\em <pdf\_set>}"} allows to specify the PDF set \ttt{{\em ' // &
	'<pdf\_set>}} from the external \lhapdf\ library. It must match ' // &
	'the exact name of the PDF set from the \lhapdf\ library. The ' // &
	'default is empty, and the default set from \lhapdf\ is taken. ' // &
	'Only one argument is possible, the PDF set must be identical ' // &
	'for both beams, unless there are fundamentally different beam ' // &
	'particles like proton and photon. (cf. also \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // &
	'\ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_photon\_scheme}, ' // &
	'\ttt{lhapdf\_member})'))
	call var_list%append_string (var_str ("$lhapdf_photon_file"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('String variable \ttt{\$lhapdf\_photon\_file ' // &
	'= "{\em <pdf\_set>}"} analagous to ($\to$) \ttt{\$lhapdf\_file} ' // &
	'for photon PDF structure functions from the external \lhapdf\ ' // &
	'library. The name must exactly match the one of the set from ' // &
	'\lhapdf. (cf. \ttt{beams}, \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // &
	'\ttt{\$lhapdf\_file}, \ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member}, ' // &
	'\ttt{lhapdf\_photon\_scheme})'))
	call var_list%append_int (var_str ("lhapdf_member"), 0, &
	intrinsic=.true., &
	description=var_str ('Integer variable that specifies the number ' // &
	'of the corresponding PDF set chosen via the command ($\to$) ' // &
	'\ttt{\$lhapdf\_file} or ($\to$) \ttt{\$lhapdf\_photon\_file} ' // &
	'from the external \lhapdf\ library. E.g. error PDF sets can ' // &
	'be chosen by this. (cf. also \ttt{lhapdf}, \ttt{\$lhapdf\_dir}, ' // &
	'\ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, \ttt{\$lhapdf\_photon\_file}, ' // &
	'\ttt{lhapdf\_photon\_scheme})'))
	call var_list%append_int (var_str ("lhapdf_photon_scheme"), 0, &
	intrinsic=.true., &
	description=var_str ('Integer parameter that controls the different ' // &
	'available schemes for photon PDFs inside the external \lhapdf\ ' // &
	'library. For more details see the \lhapdf\ manual. (cf. also ' // &
	'\ttt{lhapdf}, \ttt{\$lhapdf\_dir}, \ttt{\$lhapdf\_file}, \ttt{lhapdf\_photon}, ' // &
	'\ttt{\$lhapdf\_photon\_file}, \ttt{lhapdf\_member})'))
	call var_list%append_string (var_str ("$pdf_builtin_set"), var_str ("CTEQ6L"), &
	intrinsic=.true., &
	description=var_str ("For \whizard's internal PDF structure functions " // &
	'for hadron colliders, this string variable allows to set the ' // &
	'particular PDF set. (cf. also \ttt{pdf\_builtin}, \ttt{pdf\_builtin\_photon})'))
	call var_list%append_log (var_str ("?hoppet_b_matching"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that switches on the matching between ' // &
	'4- and 5-flavor schemes for hadron collider $b$-parton initiated ' // &
	'processes. Works either with builtin PDFs or with the external ' // &
	'\lhapdf\ interface. Needs the external \ttt{HOPPET} library ' // &
	'to be linked. (cf. \ttt{beams}, \ttt{pdf\_builtin}, \ttt{lhapdf})'))
	call var_list%append_real (var_str ("isr_alpha"), 0._default, &
	intrinsic=.true., &
	description=var_str ('For lepton collider initial-state QED ' // &
	'radiation (ISR), this real parameter sets the value of $\alpha_{em}$ ' // &
	'used in the structure function. If not set, it is taken from ' // &
	'the parameter set of the physics model in use (cf. also \ttt{isr}, ' // &
	'\ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order}, \ttt{?isr\_recoil}, ' // &
	'\ttt{?isr\_keep\_energy})'))
	call var_list%append_real (var_str ("isr_q_max"), 0._default, &
	intrinsic=.true., &
	description=var_str ('This real parameter allows to set the ' // &
	'scale of the initial-state QED radiation (ISR) structure function. ' // &
	'If not set, it is taken internally to be $\sqrt{s}$. (cf. ' // &
	'also \ttt{isr}, \ttt{isr\_alpha}, \ttt{isr\_mass}, \ttt{isr\_order}, ' // &
	'\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})'))
	call var_list%append_real (var_str ("isr_mass"), 0._default, &
	intrinsic=.true., &
	description=var_str ('This real parameter allows to set by hand ' // &
	'the mass of the incoming particle for lepton collider initial-state ' // &
	'QED radiation (ISR). If not set, the mass for the initial beam ' // &
	'particle is taken from the model in use. (cf. also \ttt{isr}, ' // &
	'\ttt{isr\_q\_max}, \ttt{isr\_alpha}, \ttt{isr\_order}, \ttt{?isr\_recoil}, ' // &
	'\ttt{?isr\_keep\_energy})'))
	call var_list%append_int (var_str ("isr_order"), 3, &
	intrinsic=.true., &
	description=var_str ('For lepton collider initial-state QED ' // &
	'radiation (ISR), this integer parameter allows to set the order ' // &
	'up to which hard-collinear radiation is taken into account. ' // &
	'Default is the highest available, namely third order. (cf. ' // &
	'also \ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_alpha}, ' // &
	'\ttt{?isr\_recoil}, \ttt{?isr\_keep\_energy})'))
	call var_list%append_log (var_str ("?isr_recoil"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag to switch on recoil, i.e. a non-vanishing ' // &
	'$p_T$-kick for the lepton collider initial-state QED radiation ' // &
	'(ISR). (cf. also \ttt{isr}, \ttt{isr}, \ttt{isr\_alpha}, \ttt{isr\_mass}, ' // &
	'\ttt{isr\_order}, \ttt{isr\_q\_max})'))
	call var_list%append_log (var_str ("?isr_keep_energy"), .false., &
	intrinsic=.true., &
	description=var_str ('As the splitting kinematics for the ISR ' // &
	'structure function violates Lorentz invariance when the recoil ' // &
	'is switched on, this flag forces energy conservation when set ' // &
	'to true, otherwise violating energy conservation. (cf. also ' // &
	'\ttt{isr}, \ttt{isr\_q\_max}, \ttt{isr\_mass}, \ttt{isr\_order}, ' // &
	'\ttt{?isr\_recoil}, \ttt{?isr\_alpha})'))
	call var_list%append_log (var_str ("?isr_handler"), .false., &
	intrinsic=.true., &
	description=var_str ('Activate ISR ' // &
	'handler for event generation (no effect on integration). ' // &
	'Requires \ttt{isr\_recoil = false}'))
	call var_list%append_string (var_str ("$isr_handler_mode"), &
	var_str ("trivial"), &
	intrinsic=.true., &
	description=var_str ('Operation mode for the ISR ' // &
	'event handler. Allowed values: \ttt{trivial} (no effect), ' // &
	'\ttt{recoil} (recoil kinematics with two photons)'))
	call var_list%append_real (var_str ("epa_alpha"), 0._default, &
	intrinsic=.true., &
	description=var_str ('For the equivalent photon approximation ' // &
	'(EPA), this real parameter sets the value of $\alpha_{em}$ ' // &
	'used in the structure function. If not set, it is taken from ' // &
	'the parameter set of the physics model in use (cf. also \ttt{epa}, ' // &
	'\ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_e\_max}, \ttt{epa\_q\_min}, ' // &
	'\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
	call var_list%append_real (var_str ("epa_x_min"), 0._default, &
	intrinsic=.true., &
	description=var_str ('Real parameter that sets the lower cutoff ' // &
	'for the energy fraction in the splitting for the equivalent-photon ' // &
	'approximation (EPA). This parameter has to be set by the user ' // &
	'to a non-zero value smaller than one. (cf. also \ttt{epa}, ' // &
	'\ttt{epa\_e\_max}, \ttt{epa\_mass}, \ttt{epa\_alpha}, \ttt{epa\_q\_min}, ' // &
	'\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
	call var_list%append_real (var_str ("epa_q_min"), 0._default, &
	intrinsic=.true., &
	description=var_str ('In the equivalent-photon approximation ' // &
	'(EPA), this real parameters sets the minimal value for the ' // &
	'transferred momentum. Either this parameter or the mass of ' // &
	'the beam particle has to be non-zero. (cf. also \ttt{epa}, ' // &
	'\ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, \ttt{epa\_q\_max}, ' // &
	'\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
	call var_list%append_real (var_str ("epa_q_max"), 0._default, &
	intrinsic=.true., &
	description=var_str ('This real parameter allows to set the ' // &
	'upper energy cutoff for the equivalent-photon approximation ' // &
	'(EPA). If not set, \whizard\ simply takes the collider energy, ' // &
	'$\sqrt{s}$. (cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, ' // &
	'\ttt{epa\_alpha}, \ttt{epa\_q\_min}, \ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
	call var_list%append_real (var_str ("epa_mass"), 0._default, &
	intrinsic=.true., &
	description=var_str ('This real parameter allows to set by hand ' // &
	'the mass of the incoming particle for the equivalent-photon ' // &
	'approximation (EPA). If not set, the mass for the initial beam ' // &
	'particle is taken from the model in use. (cf. also \ttt{epa}, ' // &
	'\ttt{epa\_x\_min}, \ttt{epa\_e\_max}, \ttt{epa\_alpha}, \ttt{epa\_q\_min}, ' // &
	'\ttt{?epa\_recoil}, \ttt{?epa\_keep\_energy})'))
	call var_list%append_log (var_str ("?epa_recoil"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag to switch on recoil, i.e. a non-vanishing ' // &
	'$p_T$-kick for the equivalent-photon approximation (EPA). ' // &
	'(cf. also \ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, ' // &
	'\ttt{epa\_e\_max}, \ttt{epa\_q\_min}, \ttt{?epa\_keep\_energy})'))
	call var_list%append_log (var_str ("?epa_keep_energy"), .false., &
	intrinsic=.true., &
	description=var_str ('As the splitting kinematics for the EPA ' // &
	'structure function violates Lorentz invariance when the recoil ' // &
	'is switched on, this flag forces energy conservation when set ' // &
	'to true, otherwise violating energy conservation. (cf. also ' // &
	'\ttt{epa}, \ttt{epa\_x\_min}, \ttt{epa\_mass}, \ttt{epa\_alpha}, ' // &
	'\ttt{epa\_q\_min}, \ttt{?epa\_recoil})'))
	call var_list%append_log (var_str ("?epa_handler"), .false., &
	intrinsic=.true., &
	description=var_str ('Activate EPA ' // &
	'handler for event generation (no effect on integration). ' // &
	'Requires \ttt{epa\_recoil = false}'))
	call var_list%append_string (var_str ("$epa_handler_mode"), &
	var_str ("trivial"), &
	intrinsic=.true., &
	description=var_str ('Operation mode for the EPA ' // &
	'event handler. Allowed values: \ttt{trivial} (no effect), ' // &
	'\ttt{recoil} (recoil kinematics with two beams)'))
	call var_list%append_real (var_str ("ewa_x_min"), 0._default, &
	intrinsic=.true., &
	description=var_str ('Real parameter that sets the lower cutoff ' // &
	'for the energy fraction in the splitting for the equivalent ' // &
	'$W$ approximation (EWA). This parameter has to be set by the ' // &
	'user to a non-zero value smaller than one. (cf. also \ttt{ewa}, ' // &
	'\ttt{ewa\_pt\_max}, \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy}, ' // &
	'\ttt{?ewa\_recoil})'))
	call var_list%append_real (var_str ("ewa_pt_max"), 0._default, &
	intrinsic=.true., &
	description=var_str ('This real parameter allows to set the ' // &
	'upper $p_T$ cutoff for the equivalent $W$ approximation (EWA). ' // &
	'If not set, \whizard\ simply takes the collider energy, $\sqrt{s}$. ' // &
	'(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy}, ' // &
	'\ttt{?ewa\_recoil})'))
	call var_list%append_real (var_str ("ewa_mass"), 0._default, &
	intrinsic=.true., &
	description=var_str ('This real parameter allows to set by hand ' // &
	'the mass of the incoming particle for the equivalent $W$ approximation ' // &
	'(EWA). If not set, the mass for the initial beam particle is ' // &
	'taken from the model in use. (cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, ' // &
	'\ttt{ewa\_pt\_max}, \ttt{?ewa\_keep\_energy}, \ttt{?ewa\_recoil})'))
	call var_list%append_log (var_str ("?ewa_recoil"), .false., &
	intrinsic=.true., &
	description=var_str ('For the equivalent $W$ approximation (EWA), ' // &
	'this flag switches on recoil, i.e. non-collinear splitting. ' // &
	'(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max}, ' // &
	'\ttt{ewa\_mass}, \ttt{?ewa\_keep\_energy})'))
	call var_list%append_log (var_str ("?ewa_keep_energy"), .false., &
	intrinsic=.true., &
	description=var_str ('As the splitting kinematics for the equivalent ' // &
	'$W$ approximation (EWA) violates Lorentz invariance when the ' // &
	'recoil is switched on, this flag forces energy conservation ' // &
	'when set to true, otherwise violating energy conservation. ' // &
	'(cf. also \ttt{ewa}, \ttt{ewa\_x\_min}, \ttt{ewa\_pt\_max}, ' // &
	'\ttt{ewa\_mass}, \ttt{?ewa\_recoil})'))
	call var_list%append_log (var_str ("?circe1_photon1"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag to tell \whizard\ to use the photon ' // &
	'of the \circeone\ beamstrahlung structure function as initiator ' // &
	'for the hard scattering process in the first beam. (cf. also ' // &
	'\ttt{circe1}, \ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, ' // &
	'\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
	'\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
	'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // &
	'\ttt{?circe1\_with\_radiation})'))
	call var_list%append_log (var_str ("?circe1_photon2"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag to tell \whizard\ to use the photon ' // &
	'of the \circeone\ beamstrahlung structure function as initiator ' // &
	'for the hard scattering process in the second beam. (cf. also ' // &
	'\ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{circe1\_sqrts}, ' // &
	'\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
	'\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
	'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, ' // &
	'\newline\ttt{?circe1\_with\_radiation})'))
	call var_list%append_real (var_str ("circe1_sqrts"), &
	intrinsic=.true., &
	description=var_str ('Real parameter that allows to set the ' // &
	'value of the collider energy for the lepton collider beamstrahlung ' // &
	'structure function \circeone. If not set, $\sqrt{s}$ is taken. ' // &
	'(cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{?circe1\_photon2}, ' // &
	'\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
	'\newline \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
	'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // &
	'\ttt{?circe1\_with\_radiation})'))
	call var_list%append_log (var_str ("?circe1_generate"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that determines whether the \circeone\ ' // &
	'structure function for lepton collider beamstrahlung uses the ' // &
	'generator mode for the spectrum, or a pre-defined (semi-)analytical ' // &
	'parameterization. Default is the generator mode. (cf. also ' // &
	'\ttt{circe1}, \ttt{?circe1\_photon1}, \newline \ttt{?circe1\_photon2}, ' // &
	'\ttt{circe1\_sqrts}, \ttt{?circe1\_map}, \ttt{circe1\_mapping\_slope}, ' // &
	'\ttt{circe1\_eps}, \newline \ttt{circe1\_ver}, \ttt{circe1\_rev}, ' // &
	'\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
	call var_list%append_log (var_str ("?circe1_map"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that determines whether the \circeone\ ' // &
	'structure function for lepton collider beamstrahlung uses special ' // &
	'mappings for $s$-channel resonances. (cf. also \ttt{circe1}, ' // &
	'\ttt{?circe1\_photon1}, \newline \ttt{?circe1\_photon2}, ' // &
	'\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // &
	'\ttt{circe1\_mapping\_slope}, \ttt{circe1\_eps}, \newline ' // &
	'\ttt{circe1\_ver}, \ttt{circe1\_rev}, \ttt{\$circe1\_acc}, ' // &
	'\ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
	call var_list%append_real (var_str ("circe1_mapping_slope"), 2._default, &
	intrinsic=.true., &
	description=var_str ('Real parameter that allows to vary the ' // &
	'slope of the mapping function for the \circeone\ structure ' // &
	'function for lepton collider beamstrahlung from the default ' // &
	'value \ttt{2.}. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, ' // &
	'\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // &
	'\ttt{?circe1\_map}, \ttt{circe1\_eps}, \ttt{circe1\_ver}, ' // &
	'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline' // &
	'\ttt{?circe1\_with\_radiation})'))
	call var_list%append_real (var_str ("circe1_eps"), 1e-5_default, &
	intrinsic=.true., &
	description=var_str ('Real parameter, that takes care of the ' // &
	'mapping of the peak in the lepton collider beamstrahlung structure ' // &
	'function spectrum of \circeone. (cf. also \ttt{circe1}, \ttt{?circe1\_photons}, ' // &
	'\ttt{?circe1\_photon2}, \ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, ' // &
	'\ttt{?circe1\_map}, \ttt{circe1\_eps}, \newline ' // &
	'\ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, \ttt{circe1\_rev}, ' // &
	'\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \newline\ttt{?circe1\_with\_radiation})'))
	call var_list%append_int (var_str ("circe1_ver"), 0, intrinsic=.true., &
	description=var_str ('Integer parameter that sets the internal ' // &
	'versioning number of the \circeone\ structure function for lepton-collider ' // &
	'beamstrahlung. It has to be set by the user explicitly, it takes ' // &
	'values from one to ten. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, ' // &
	'\ttt{?circe1\_photon2}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
	'\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_sqrts}, ' // &
	'\ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{circe1\_chat}, ' // &
	'\ttt{?circe1\_with\_radiation})'))
	call var_list%append_int (var_str ("circe1_rev"), 0, intrinsic=.true., &
	description=var_str ('Integer parameter that sets the internal ' // &
	'revision number of the \circeone\ structure function for lepton-collider ' // &
	'beamstrahlung. The default \ttt{0} translates always into the ' // &
	'most recent version; older versions have to be accessed through ' // &
	'the explicit revision date. For more details cf.~the \circeone ' // &
	'manual. (cf. also \ttt{circe1}, \ttt{?circe1\_photon1}, \ttt{?circe1\_photon2}, ' // &
	'\ttt{?circe1\_generate}, \ttt{?circe1\_map}, \ttt{circe1\_eps}, ' // &
	'\ttt{circe1\_mapping\_slope}, \ttt{circe1\_sqrts}, \ttt{circe1\_ver}, ' // &
	'\ttt{\$circe1\_acc}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
	call var_list%append_string (var_str ("$circe1_acc"), var_str ("SBAND"), &
	intrinsic=.true., &
	description=var_str ('String variable that specifies the accelerator ' // &
	'type for the \circeone\ structure function for lepton-collider ' // &
	'beamstrahlung. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // &
	'\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
	'\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
	'\newline \ttt{circe1\_rev}, \ttt{circe1\_chat}, \ttt{?circe1\_with\_radiation})'))
	call var_list%append_int (var_str ("circe1_chat"), 0, intrinsic=.true., &
	description=var_str ('Chattiness of the \circeone\ structure ' // &
	'function for lepton-collider beamstrahlung. The higher the integer ' // &
	'value, the more information will be given out by the \circeone\ ' // &
	'package. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // &
	'\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
	'\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
	'\newline \ttt{circe1\_rev}, \ttt{\$circe1\_acc}, \ttt{?circe1\_with\_radiation})'))
	call var_list%append_log (var_str ("?circe1_with_radiation"), .false., &
	intrinsic=.true., &
	description=var_str ('This logical decides whether the additional photon ' // &
	'or electron ("beam remnant") will be considered in the event record or ' // &
	'not. (\ttt{?circe1\_photons}, \ttt{?circe1\_photon2}, ' // &
	'\ttt{circe1\_sqrts}, \ttt{?circe1\_generate}, \ttt{?circe1\_map}, ' // &
	'\ttt{circe1\_eps}, \ttt{circe1\_mapping\_slope}, \ttt{circe1\_ver}, ' // &
	'\newline \ttt{circe1\_rev}, \ttt{\$circe1\_acc})'))
	call var_list%append_log (var_str ("?circe2_polarized"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag whether the photon spectra from the ' // &
	'\circetwo\ structure function for lepton colliders should be ' // &
	'treated polarized. (cf. also \ttt{circe2}, \ttt{\$circe2\_file}, ' // &
	'\ttt{\$circe2\_design})'))
	call var_list%append_string (var_str ("$circe2_file"), &
	intrinsic=.true., &
	description=var_str ('String variable by which the corresponding ' // &
	'photon collider spectrum for the \circetwo\ structure function ' // &
	'can be selected. (cf. also \ttt{circe2}, \ttt{?circe2\_polarized}, ' // &
	'\ttt{\$circe2\_design})'))
	call var_list%append_string (var_str ("$circe2_design"), var_str ("*"), &
	intrinsic=.true., &
	description=var_str ('String variable that sets the collider ' // &
	'design for the \circetwo\ structure function for photon collider ' // &
	'spectra. (cf. also \ttt{circe2}, \ttt{\$circe2\_file}, \ttt{?circe2\_polarized})'))
	call var_list%append_real (var_str ("gaussian_spread1"), 0._default, &
	intrinsic=.true., &
	description=var_str ('Parameter that sets the energy spread ' // &
	'($\sigma$ value) of the first beam for a Gaussian spectrum. ' // &
	'(cf. \ttt{gaussian})'))
	call var_list%append_real (var_str ("gaussian_spread2"), 0._default, &
	intrinsic=.true., &
	description=var_str ('Ditto, for the second beam.'))
	call var_list%append_string (var_str ("$beam_events_file"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows to set the ' // &
	"name of the external file from which a beamstrahlung's spectrum " // &
	'for lepton colliders as pairs of energy fractions is read in. ' // &
	'(cf. also \ttt{beam\_events}, \ttt{?beam\_events\_warn\_eof})'))
	call var_list%append_log (var_str ("?beam_events_warn_eof"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that tells \whizard\ to ' // &
	'issue a warning when in a simulation the end of an external ' // &
	"file for beamstrahlung's spectra for lepton colliders are reached, " // &
	'and energy fractions from the beginning of the file are reused. ' // &
	'(cf. also \ttt{beam\_events}, \ttt{\$beam\_events\_file})'))
	call var_list%append_log (var_str ("?energy_scan_normalize"), .false., &
	intrinsic=.true., &
	description=var_str ('Normalization flag for the energy scan ' // &
	'structure function: if set the total cross section is normalized ' // &
	'to unity. (cf. also \ttt{energy\_scan})'))
	end subroutine var_list_set_beams_defaults

	@ %def var_list_set_beams_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_core_defaults => var_list_set_core_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_core_defaults (var_list, seed)
	class(var_list_t), intent(inout) :: var_list
	integer, intent(in) :: seed
	logical, target, save :: known = .true. !!! ??????
	real(default), parameter :: real_specimen = 1.
	call var_list_append_log_ptr &
	(var_list, var_str ("?logging"), logging, known, &
	intrinsic=.true., &
	description=var_str ('This logical -- when set to \ttt{false} ' // &
	'-- suppresses writing out a logfile (default: \ttt{whizard.log}) ' // &
	'for the whole \whizard\ run, or when \whizard\ is run with the ' // &
	'\ttt{--no-logging} option, to suppress parts of the logging ' // &
	'when setting it to \ttt{true} again at a later part of the ' // &
	'\sindarin\ input file. Mainly for debugging purposes. ' // &
	'(cf. also \ttt{?openmp\_logging}, \ttt{?mpi\_logging})'))
	call var_list%append_string (var_str ("$job_id"), &
	intrinsic=.true., &
	description=var_str ('Arbitrary string that can be used for ' // &
	'creating unique names. The variable is initialized with the ' // &
	'value of the \ttt{job\_id} option on startup. (cf. also ' // &
	'\ttt{\$compile\_workspace}, \ttt{\$run\_id})'))
	call var_list%append_string (var_str ("$compile_workspace"), &
	intrinsic=.true., &
	description=var_str ('If set, create process source code ' // &
	'and process-driver library code in a subdirectory with this ' // &
	'name. If non-existent, the directory will be created. (cf. ' // &
	'also \ttt{\$job\_id}, \ttt{\$run\_id}, \ttt{\$integrate\_workspace})'))
	call var_list%append_int (var_str ("seed"), seed, &
	intrinsic=.true., &
	description=var_str ('Integer variable \ttt{seed = {\em <num>}} ' // &
	'that allows to set a specific random seed \ttt{num}. If not ' // &
	'set, \whizard\ takes the time from the system clock to determine ' // &
	'the random seed.'))
	call var_list%append_string (var_str ("$model_name"), &
	intrinsic=.true., &
	description=var_str ('This variable makes the locally used physics ' // &
	'model available as a string, e.g. as \ttt{show (\$model\_name)}. ' // &
	'However, the user is not able to change the current model by ' // &
	'setting this variable to a different string. (cf. also \ttt{model}, ' // &
	'\ttt{\$library\_name}, \ttt{printf}, \ttt{show})'))
	call var_list%append_int (var_str ("process_num_id"), &
	intrinsic=.true., &
	description=var_str ('Using the integer \ttt{process\_num\_id ' // &
	'= {\em <int\_var>}} one can set a numerical identifier for processes ' // &
	'within a process library. This can be set either just before ' // &
	'the corresponding \ttt{process} definition or as an optional ' // &
	'local argument of the latter. (cf. also \ttt{process})'))
	call var_list%append_string (var_str ("$method"), var_str ("omega"), &
	intrinsic=.true., &
	description=var_str ('This string variable specifies the method ' // &
	'for the matrix elements to be used in the evaluation. The default ' // &
	"is the intrinsic \oMega\ matrix element generator " // &
	'(\ttt{"omega"}), other options are: \ttt{"ovm"}, \ttt{"unit\_test"}, ' // &
	'\ttt{"template\_unity"}, \ttt{"threshold"}. For processes defined ' // &
	'\ttt{"template"}, with \ttt{nlo\_calculation = ...}, please refer to ' // &
	'\ttt{\$born\_me\_method}, \ttt{\$real\_tree\_me\_method}, ' // &
	'\ttt{\$loop\_me\_method} and \ttt{\$correlation\_me\_method}.'))
	call var_list%append_log (var_str ("?report_progress"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag for the \oMega\ matrix element generator ' // &
	'whether to print out status messages about progress during ' // &
	'matrix element generation. (cf. also \ttt{\$method}, \ttt{\$omega\_flags})'))
	call var_list%append_log (var_str ("?me_verbose"), .false., &
	description=var_str ("Flag determining whether " // &
	"the makefile command for generating and compiling the \oMega\ matrix " // &
	"element code is silent or verbose. Default is silent."))
	call var_list%append_string (var_str ("$restrictions"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('This is an optional argument for process ' // &
	'definitions for the matrix element method \ttt{"omega"}. Using ' // &
	'the following construction, it defines a string variable, \ttt{process ' // &
	'\newline {\em <process\_name>} = {\em <particle1>}, {\em <particle2>} ' // &
	'=> {\em <particle3>}, {\em <particle4>}, ... \{ \$restrictions ' // &
	'= "{\em <restriction\_def>}" \}}. The string argument \ttt{{\em ' // &
	'<restriction\_def>}} is directly transferred during the code ' // &
	'generation to the ME generator \oMega. It has to be of the form ' // &
	'\ttt{n1 + n2 + ... \url{~} {\em <particle (list)>}}, where ' // &
	'\ttt{n1} and so on are the numbers of the particles above in ' // &
	'the process definition. The tilde specifies a certain intermediate ' // &
	'state to be equal to the particle(s) in \ttt{particle (list)}. ' // &
	'An example is \ttt{process eemm\_z = e1, E1 => e2, E2 ' // &
	'\{ \$restrictions = "1+2 \url{~} Z" \} } restricts the code ' // &
	'to be generated for the process $e^- e^+ \to \mu^- \mu^+$ to ' // &
	'the $s$-channel $Z$-boson exchange. For more details see Sec.~\ref{sec:omega_me} ' // &
	'(cf. also \ttt{process})'))
	call var_list%append_log (var_str ("?omega_write_phs_output"), .false., &
	intrinsic=.true., &
	description=var_str ('This flag decides whether a the phase-space ' // &
	'output is produced by the \oMega\ matrix element generator. This ' // &
	'output is written to file(s) and contains the Feynman diagrams ' // &
	'which belong to the process(es) under consideration. The file is ' // &
	'mandatory whenever the variable \ttt{\$phs\_method} has the value ' // &
	'\ttt{fast\_wood}, i.e. if the phase-space file is provided by ' // &
	'cascades2.'))
	call var_list%append_string (var_str ("$omega_flags"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('String variable that allows to pass flags ' // &
	'to the \oMega\ matrix element generator. Normally, \whizard\ ' // &
	'takes care of all flags automatically. Note that for restrictions ' // &
	'of intermediate states, there is a special string variable: ' // &
	'(cf. $\to$) \ttt{\$restrictions}.'))
	call var_list%append_log (var_str ("?read_color_factors"), .true., &
	intrinsic=.true., &
	description=var_str ('This flag decides whether to read QCD ' // &
	'color factors from the matrix element provided by each method, ' // &
	'or to try and calculate the color factors in \whizard\ internally.'))
	!!! JRR: WK please check (#529)
	! call var_list_append_string &
	! (var_list, var_str ("$user_procs_cut"), var_str (""), &
	! intrinsic=.true.)
	! call var_list_append_string &
	! (var_list, var_str ("$user_procs_event_shape"), var_str (""), &
	! intrinsic=.true.)
	! call var_list_append_string &
	! (var_list, var_str ("$user_procs_obs1"), var_str (""), &
	! intrinsic=.true.)
	! call var_list_append_string &
	! (var_list, var_str ("$user_procs_obs2"), var_str (""), &
	! intrinsic=.true.)
	! call var_list_append_string &
	! (var_list, var_str ("$user_procs_sf"), var_str (""), &
	! intrinsic=.true.)
	call var_list%append_log (var_str ("?slha_read_input"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag which decides whether \whizard\ reads ' // &
	'in the SM and parameter information from the \ttt{SMINPUTS} ' // &
	'and \ttt{MINPAR} common blocks of the SUSY Les Houches Accord ' // &
	'files. (cf. also \ttt{read\_slha}, \ttt{write\_slha}, \ttt{?slha\_read\_spectrum}, ' // &
	'\ttt{?slha\_read\_decays})'))
	call var_list%append_log (var_str ("?slha_read_spectrum"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag which decides whether \whizard\ reads ' // &
	'in the whole spectrum and mixing angle information from the ' // &
	'common blocks of the SUSY Les Houches Accord files. (cf. also ' // &
	'\ttt{read\_slha}, \ttt{write\_slha}, \ttt{?slha\_read\_decays}, ' // &
	'\ttt{?slha\_read\_input})'))
	call var_list%append_log (var_str ("?slha_read_decays"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag which decides whether \whizard\ reads ' // &
	'in the widths and branching ratios from the \ttt{DCINFO} common ' // &
	'block of the SUSY Les Houches Accord files. (cf. also \ttt{read\_slha}, ' // &
	'\ttt{write\_slha}, \ttt{?slha\_read\_spectrum}, \ttt{?slha\_read\_input})'))
	call var_list%append_string (var_str ("$library_name"), &
	intrinsic=.true., &
	description=var_str ('Similar to \ttt{\$model\_name}, this string ' // &
	'variable is used solely to access the name of the active process ' // &
	'library, e.g. in \ttt{printf} statements. (cf. \ttt{compile}, ' // &
	'\ttt{library}, \ttt{printf}, \ttt{show}, \ttt{\$model\_name})'))
	call var_list%append_log (var_str ("?alphas_is_fixed"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that tells \whizard\ to use a non-running ' // &
	'$\alpha_s$. Note that this has to be set explicitly to $\ttt{false}$ ' // &
	'if the user wants to use one of the running $\alpha_s$ options. ' // &
	'(cf. also \ttt{alphas\_order}, \ttt{?alphas\_from\_lhapdf}, ' // &
	'\ttt{?alphas\_from\_pdf\_builtin}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, ' // &
	'\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
	call var_list%append_log (var_str ("?alphas_from_lhapdf"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that tells \whizard\ to use a running ' // &
	'$\alpha_s$ from the \lhapdf\ library (which has to be correctly ' // &
	'linked). Note that \ttt{?alphas\_is\_fixed} has to be set ' // &
	'explicitly to $\ttt{false}$. (cf. also \ttt{alphas\_order}, ' // &
	'\ttt{?alphas\_is\_fixed}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
	'\ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, \ttt{?alphas\_from\_lambda\_qcd}, ' // &
	'\ttt{lambda\_qcd})'))
	call var_list%append_log (var_str ("?alphas_from_pdf_builtin"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that tells \whizard\ to use a running ' // &
	'$\alpha_s$ from the internal PDFs. Note that in that case \ttt{?alphas\_is\_fixed} ' // &
	'has to be set explicitly to $\ttt{false}$. (cf. also ' // &
	'\ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, ' // &
	'\ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, \newline \ttt{?alphas\_from\_lambda\_qcd}, ' // &
	'\ttt{lambda\_qcd})'))
	call var_list%append_int (var_str ("alphas_order"), 0, &
	intrinsic=.true., &
	description=var_str ('Integer parameter that sets the order ' // &
	'of the internal evolution for running $\alpha_s$ in \whizard: ' // &
	'the default, \ttt{0}, is LO running, \ttt{1} is NLO, \ttt{2} ' // &
	'is NNLO. (cf. also \ttt{alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, ' // &
	'\ttt{?alphas\_from\_pdf\_builtin}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_mz}, ' // &
	'\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
	call var_list%append_int (var_str ("alphas_nf"), 5, &
	intrinsic=.true., &
	description=var_str ('Integer parameter that sets the number ' // &
	'of active quark flavors for the internal evolution for running ' // &
	'$\alpha_s$ in \whizard: the default is \ttt{5}. (cf. also ' // &
	'\ttt{alphas\_is\_fixed}, \ttt{?alphas\_from\_lhapdf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
	'\ttt{alphas\_order}, \ttt{?alphas\_from\_mz}, \newline ' // &
	'\ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
	call var_list%append_log (var_str ("?alphas_from_mz"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that tells \whizard\ to use its internal ' // &
	'running $\alpha_s$ from $\alpha_s(M_Z)$. Note that in that ' // &
	'case \ttt{?alphas\_is\_fixed} has to be set explicitly to ' // &
	'$\ttt{false}$. (cf. also \ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, ' // &
	'\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
	'\newline \ttt{?alphas\_from\_lambda\_qcd}, \ttt{lambda\_qcd})'))
	call var_list%append_log (var_str ("?alphas_from_lambda_qcd"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that tells \whizard\ to use its internal ' // &
	'running $\alpha_s$ from $\alpha_s(\Lambda_{QCD})$. Note that ' // &
	'in that case \ttt{?alphas\_is\_fixed} has to be set explicitly ' // &
	'to $\ttt{false}$. (cf. also \ttt{alphas\_order}, \ttt{?alphas\_is\_fixed}, ' // &
	'\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, \ttt{?alphas\_from\_pdf\_builtin}, ' // &
	'\newline \ttt{?alphas\_from\_mz}, \ttt{lambda\_qcd})'))
	call var_list%append_real (var_str ("lambda_qcd"), 200.e-3_default, &
	intrinsic=.true., &
	description=var_str ('Real parameter that sets the value for ' // &
	'$\Lambda_{QCD}$ used in the internal evolution for running ' // &
	'$\alpha_s$ in \whizard. (cf. also \ttt{alphas\_is\_fixed}, ' // &
	'\ttt{?alphas\_from\_lhapdf}, \ttt{alphas\_nf}, ' // &
	'\newline \ttt{?alphas\_from\_pdf\_builtin}, ' // &
	'\ttt{?alphas\_from\_mz}, \ttt{?alphas\_from\_lambda\_qcd}, ' // &
	'\ttt{alphas\_order})'))
	call var_list%append_log (var_str ("?fatal_beam_decay"), .true., &
	intrinsic=.true., &
	description=var_str ('Logical variable that let the user decide ' // &
	'whether the possibility of a beam decay is treated as a fatal ' // &
	'error or only as a warning. An example is a process $b t \to ' // &
	'X$, where the bottom quark as an inital state particle appears ' // &
	'as a possible decay product of the second incoming particle, ' // &
	'the top quark. This might trigger inconsistencies or instabilities ' // &
	'in the phase space set-up.'))
	call var_list%append_log (var_str ("?helicity_selection_active"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether \whizard\ uses ' // &
	'a numerical selection rule for vanishing helicities: if active, ' // &
	'then, if a certain helicity combination yields an absolute ' // &
	'(\oMega) matrix element smaller than a certain threshold ($\to$ ' // &
	'\ttt{helicity\_selection\_threshold}) more often than a certain ' // &
	'cutoff ($\to$ \ttt{helicity\_selection\_cutoff}), it will be dropped.'))
	call var_list%append_real (var_str ("helicity_selection_threshold"), &
	1E10_default, &
	intrinsic=.true., &
	description=var_str ('Real parameter that gives the threshold ' // &
	'for the absolute value of a certain helicity combination of ' // &
	'an (\oMega) amplitude. If a certain number ($\to$ ' // &
	'\ttt{helicity\_selection\_cutoff}) of calls stays below this ' // &
	'threshold, that combination will be dropped from then on. (cf. ' // &
	'also \ttt{?helicity\_selection\_active})'))
	call var_list%append_int (var_str ("helicity_selection_cutoff"), 1000, &
	intrinsic=.true., &
	description=var_str ('Integer parameter that gives the number ' // &
	"a certain helicity combination of an (\oMega) amplitude has " // &
	'to be below a certain threshold ($\to$ \ttt{helicity\_selection\_threshold}) ' // &
	'in order to be dropped from then on. (cf. also \ttt{?helicity\_selection\_active})'))
	call var_list%append_string (var_str ("$rng_method"), var_str ("tao"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows to set the ' // &
	'method for the random number generation. Default is Donald ' // &
	"Knuth' RNG method \ttt{TAO}."))
	call var_list%append_log (var_str ("?vis_diags"), .false., &
	intrinsic=.true., &
	description=var_str ('Logical variable that allows to give out ' // &
	"a Postscript or PDF file for the Feynman diagrams for a \oMega\ " // &
	'process. (cf. \ttt{?vis\_diags\_color}).'))
	call var_list%append_log (var_str ("?vis_diags_color"), .false., &
	intrinsic=.true., &
	description=var_str ('Same as \ttt{?vis\_diags}, but switches ' // &
	'on color flow instead of Feynman diagram generation. (cf. \ttt{?vis\_diags}).'))
	call var_list%append_log (var_str ("?check_event_file"), .true., &
	intrinsic=.true., &
	description=var_str ('Setting this to false turns off all sanity ' // &
	'checks when reading a raw event file with previously generated ' // &
	'events. Use this at your own risk; the program may return ' // &
	'wrong results or crash if data do not match. (cf. also \ttt{?check\_grid\_file}, ' // &
	'\ttt{?check\_phs\_file})'))
	call var_list%append_string (var_str ("$event_file_version"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('String variable that allows to set the ' // &
	'format version of the \whizard\ internal binary event format.'))
	call var_list%append_int (var_str ("n_events"), 0, &
	intrinsic=.true., &
	description=var_str ('This specifier \ttt{n\_events = {\em <num>}} ' // &
	'sets the number of events for the event generation of the processes ' // &
	'in the \sindarin\ input files. Note that WHIZARD itself chooses ' // &
	'the number from the \ttt{n\_events} or from the \ttt{luminosity} ' // &
	'specifier, whichever would give the larger number of events. ' // &
	'As this depends on the cross section under consideration, it ' // &
	'might be different for different processes in the process list. ' // &
	'(cf. \ttt{luminosity}, \ttt{\$sample}, \ttt{sample\_format}, ' // &
	'\ttt{?unweighted}, \ttt{event\_index\_offset})'))
	call var_list%append_int (var_str ("event_index_offset"), 0, &
	intrinsic=.true., &
	description=var_str ('The value ' // &
	'\ttt{event\_index\_offset = {\em <num>}} ' // &
	'initializes the event counter for a subsequent ' // &
	'event sample. By default (value 0), the first event ' // &
	'gets index value 1, incrementing by one for each generated event ' // &
	'within a sample. The event counter is initialized again ' // &
	'for each new sample (i.e., \ttt{integrate} command). ' // &
	'If events are read from file, and the ' // &
	'event file format supports event numbering, the event numbers ' // &
	'will be taken from file instead, and the value of ' // &
	'\ttt{event\_index\_offset} has no effect. ' // &
	'(cf. \ttt{luminosity}, \ttt{\$sample}, \ttt{sample\_format}, ' // &
	'\ttt{?unweighted}, \ttt{n\_events})'))
	call var_list%append_log (var_str ("?unweighted"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that distinguishes between unweighted ' // &
	'and weighted event generation. (cf. also \ttt{simulate}, \ttt{n\_events}, ' // &
	'\ttt{luminosity}, \ttt{event\_index\_offset})'))
	call var_list%append_real (var_str ("safety_factor"), 1._default, &
	intrinsic=.true., &
	description=var_str ('This real variable \ttt{safety\_factor ' // &
	'= {\em <num>}} reduces the acceptance probability for unweighting. ' // &
	'If greater than one, excess events become less likely, but ' // &
	'the reweighting efficiency also drops. (cf. \ttt{simulate}, \ttt{?unweighted})'))
	call var_list%append_log (var_str ("?negative_weights"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that tells \whizard\ to allow negative ' // &
	'weights in integration and simulation. (cf. also \ttt{simulate}, ' // &
	'\ttt{?unweighted})'))
	call var_list%append_log (var_str ("?resonance_history"), .false., &
	intrinsic=.true., &
	description=var_str ( &
	'The logical variable \texttt{?resonance\_history ' // &
	'= true/false} specifies whether during a simulation pass, ' // &
	'the event generator should try to reconstruct intermediate ' // &
	'resonances. If activated, appropriate resonant subprocess ' // &
	'matrix element code will be automatically generated. '))
	call var_list%append_real (var_str ("resonance_on_shell_limit"), &
	4._default, &
	intrinsic=.true., &
	description=var_str ( &
	'The real variable \texttt{resonance\_on\_shell\_limit ' // &
	'= {\em <num>}} specifies the maximum relative distance from a ' // &
	'resonance peak, such that the kinematical configuration ' // &
	'can still be considered on-shell. This is relevant only if ' // &
	'\texttt{?resonance\_history = true}.'))
	call var_list%append_real (var_str ("resonance_on_shell_turnoff"), &
	0._default, &
	intrinsic=.true., &
	description=var_str ( &
	'The real variable \texttt{resonance\_on\_shell\_turnoff ' // &
	'= {\em <num>}}, if positive, ' // &
	'controls the smooth transition from resonance-like ' // &
	'to background-like events. The relative strength of a ' // &
	'resonance is reduced by a Gaussian with width given by this ' // &
	'variable. In any case, events are treated as background-like ' // &
	'when the off-shellness is greater than ' // &
	'\texttt{resonance\_on\_shell\_limit}. All of this applies ' // &
	'only if \texttt{?resonance\_history = true}.'))
	call var_list%append_real (var_str ("resonance_background_factor"), &
	1._default, &
	intrinsic=.true., &
	description=var_str ( &
	'The real variable \texttt{resonance\_background\_factor} ' // &
	'controls resonance insertion if a resonance ' // &
	'history applies to a particular event. In determining '// &
	'whether event kinematics qualifies as resonant or non-resonant, ' //&
	'the non-resonant probability is multiplied by this factor ' // &
	'Setting the factor to zero removes the background ' // &
	'configuration as long as the kinematics qualifies as on-shell ' // &
	'as qualified by \texttt{resonance\_on\_shell\_limit}.'))
	call var_list%append_log (var_str ("?keep_beams"), .false., &
	intrinsic=.true., &
	description=var_str ('The logical variable \ttt{?keep\_beams ' // &
	'= true/false} specifies whether beam particles and beam remnants ' // &
	'are included when writing event files. For example, in order ' // &
	'to read Les Houches accord event files into \pythia, no beam ' // &
	'particles are allowed.'))
	call var_list%append_log (var_str ("?keep_remnants"), .true., &
	intrinsic=.true., &
	description=var_str ('The logical variable \ttt{?keep\_beams ' // &
	'= true/false} is respected only if \ttt{?keep\_beams} is set. ' // &
	'If \ttt{true}, beam remnants are tagged as outgoing particles ' // &
	'if they have been neither showered nor hadronized, i.e., have ' // &
	'no children. If \ttt{false}, beam remnants are also included ' // &
	'in the event record, but tagged as unphysical. Note that for ' // &
	'ISR and/or beamstrahlung spectra, the radiated photons are ' // &
	'considered as beam remnants.'))
	call var_list%append_log (var_str ("?recover_beams"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether the beam particles ' // &
	'should be reconstructed when reading event/rescanning files ' // &
	'into \whizard. (cf. \ttt{rescan}, \ttt{?update\_event}, \ttt{?update\_sqme}, ' // &
	'\newline \ttt{?update\_weight})'))
	call var_list%append_log (var_str ("?update_event"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether the events in ' // &
	'an event file should be rebuilt from the hard process when ' // &
	'reading event/rescanning files into \whizard. (cf. \ttt{rescan}, ' // &
	'\ttt{?recover\_beams}, \ttt{?update\_sqme}, \ttt{?update\_weight})'))
	call var_list%append_log (var_str ("?update_sqme"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whehter the squared ' // &
	'matrix element in an event file should be updated/recalculated ' // &
	'when reading event/rescanning files into \whizard. (cf. \ttt{rescan}, ' // &
	'\newline \ttt{?recover\_beams}, \ttt{?update\_event}, \ttt{?update\_weight})'))
	call var_list%append_log (var_str ("?update_weight"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether the weights ' // &
	'in an event file should be updated/recalculated when reading ' // &
	'event/rescanning files into \whizard. (cf. \ttt{rescan}, \ttt{?recover\_beams}, ' // &
	'\newline \ttt{?update\_event}, \ttt{?update\_sqme})'))
	call var_list%append_log (var_str ("?use_alphas_from_file"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether the current ' // &
	'$\alpha_s$ definition should be used when recalculating matrix ' // &
	'elements for events read from file, or the value that is stored ' // &
	'in the file for that event. (cf. \ttt{rescan}, \ttt{?update\_sqme}, ' // &
	'\ttt{?use\_scale\_from\_file})'))
	call var_list%append_log (var_str ("?use_scale_from_file"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether the current ' // &
	'energy-scale expression should be used when recalculating matrix ' // &
	'elements for events read from file, or the value that is stored ' // &
	'in the file for that event. (cf. \ttt{rescan}, \ttt{?update\_sqme}, ' // &
	'\ttt{?use\_alphas\_from\_file})'))
	call var_list%append_log (var_str ("?allow_decays"), .true., &
	intrinsic=.true., &
	description=var_str ('Master flag to switch on cascade decays ' // &
	'for final state particles as an event transform. As a default, ' // &
	'it is switched on. (cf. also \ttt{?auto\_decays}, ' // &
	'\ttt{auto\_decays\_multiplicity}, \ttt{?auto\_decays\_radiative}, ' // &
	'\ttt{?decay\_rest\_frame})'))
	call var_list%append_log (var_str ("?auto_decays"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag, particularly as optional argument of the ($\to$) ' // &
	'\ttt{unstable} command, that tells \whizard\ to automatically ' // &
	'determine the decays of that particle up to the final state ' // &
	'multplicity ($\to$) \ttt{auto\_decays\_multiplicity}. Depending ' // &
	'on the flag ($\to$) \ttt{?auto\_decays\_radiative}, radiative ' // &
	'decays will be taken into account or not. (cf. also \ttt{unstable}, ' // &
	'\ttt{?isotropic\_decay}, \ttt{?diagonal\_decay})'))
	call var_list%append_int (var_str ("auto_decays_multiplicity"), 2, &
	intrinsic=.true., &
	description=var_str ('Integer parameter, that sets -- ' // &
	'for the ($\to$) \ttt{?auto\_decays} option to let \whizard\ ' // &
	'automatically determine the decays of a particle set as ($\to$) ' // &
	'\ttt{unstable} -- the maximal final state multiplicity that ' // &
	'is taken into account. The default is \ttt{2}. The flag \ttt{?auto\_decays\_radiative} ' // &
	'decides whether radiative decays are taken into account. (cf.\ ' // &
	'also \ttt{unstable}, \ttt{?auto\_decays})'))
	call var_list%append_log (var_str ("?auto_decays_radiative"), .false., &
	intrinsic=.true., &
	description=var_str ("If \whizard's automatic detection " // &
	'of decay channels are switched on ($\to$ \ttt{?auto\_decays} ' // &
	'for the ($\to$) \ttt{unstable} command, this flags decides ' // &
	'whether radiative decays (e.g. containing additional photon(s)/gluon(s)) ' // &
	'are taken into account or not. (cf. also \ttt{unstable}, \ttt{auto\_decays\_multiplicity})'))
	call var_list%append_log (var_str ("?decay_rest_frame"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that allows to force a particle decay ' // &
	'to be simulated in its rest frame. This simplifies the calculation ' // &
	'for decays as stand-alone processes, but makes the process ' // &
	'unsuitable for use in a decay chain.'))
	call var_list%append_log (var_str ("?isotropic_decay"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that -- in case of using factorized ' // &
	'production and decays using the ($\to$) \ttt{unstable} command ' // &
	'-- tells \whizard\ to switch off spin correlations completely ' // &
	'(isotropic decay). (cf. also \ttt{unstable}, \ttt{?auto\_decays}, ' // &
	'\ttt{decay\_helicity}, \ttt{?diagonal\_decay})'))
	call var_list%append_log (var_str ("?diagonal_decay"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that -- in case of using factorized ' // &
	'production and decays using the ($\to$) \ttt{unstable} command ' // &
	'-- tells \whizard\ instead of full spin correlations to take ' // &
	'only the diagonal entries in the spin-density matrix (i.e. ' // &
	'classical spin correlations). (cf. also \ttt{unstable}, \ttt{?auto\_decays}, ' // &
	'\ttt{decay\_helicity}, \ttt{?isotropic\_decay})'))
	call var_list%append_int (var_str ("decay_helicity"), &
	intrinsic=.true., &
	description=var_str ('If this parameter is given an integer ' // &
	'value, any particle decay triggered by a subsequent \ttt{unstable} ' // &
	'declaration will receive a projection on the given helicity ' // &
	'state for the unstable particle. (cf. also \ttt{unstable}, ' // &
	'\ttt{?isotropic\_decay}, \ttt{?diagonal\_decay}. The latter ' // &
	'parameters, if true, take precdence over any \ttt{?decay\_helicity} setting.)'))
	call var_list%append_log (var_str ("?polarized_events"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that allows to select certain helicity ' // &
	'combinations in final state particles in the event files, ' // &
	'and perform analysis on polarized event samples. (cf. also ' // &
	'\ttt{simulate}, \ttt{polarized}, \ttt{unpolarized})'))
	call var_list%append_string (var_str ("$polarization_mode"), &
	var_str ("helicity"), &
	intrinsic=.true., &
	description=var_str ('String variable that specifies the mode in ' // &
	'which the polarization of particles is handled when polarized events ' // &
	'are written out. Possible options are \ttt{"ignore"}, \ttt{"helicity"}, ' // &
	'\ttt{"factorized"}, and \ttt{"correlated"}. For more details cf. the ' // &
	'detailed section.'))
	call var_list%append_log (var_str ("?colorize_subevt"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that enables color-index tracking ' // &
	'in the subevent (\ttt{subevt}) objects that are used for ' // &
	'internal event analysis.'))
	call var_list%append_real (var_str ("tolerance"), 0._default, &
	intrinsic=.true., &
	description=var_str ('Real variable that defines the absolute ' // &
	'tolerance with which the (logical) function \ttt{expect} accepts ' // &
	'equality or inequality: \ttt{tolerance = {\em <num>}}. This ' // &
	'can e.g. be used for cross-section tests and backwards compatibility ' // &
	'checks. (cf. also \ttt{expect})'))
	call var_list%append_int (var_str ("checkpoint"), 0, &
	intrinsic = .true., &
	description=var_str ('Setting this integer variable to a positive ' // &
	'integer $n$ instructs simulate to print out a progress summary ' // &
	'every $n$ events.'))
	call var_list%append_int (var_str ("event_callback_interval"), 0, &
	intrinsic = .true., &
	description=var_str ('Setting this integer variable to a positive ' // &
	'integer $n$ instructs simulate to print out a progress summary ' // &
	'every $n$ events.'))
	call var_list%append_log (var_str ("?pacify"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that allows to suppress numerical ' // &
	'noise and give screen and log file output with a lower number ' // &
	'of significant digits. Mainly for debugging purposes. (cf. also ' // &
	'\ttt{?sample\_pacify})'))
	call var_list%append_string (var_str ("$out_file"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('This character variable allows to specify ' // &
	'the name of the data file to which the histogram and plot data ' // &
	'are written (cf. also \ttt{write\_analysis}, \ttt{open\_out}, ' // &
	'\ttt{close\_out})'))
	call var_list%append_log (var_str ("?out_advance"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that sets advancing in the \ttt{printf} ' // &
	'output commands, i.e. continuous printing with no line feed ' // &
	'etc. (cf. also \ttt{printf})'))
	!!! JRR: WK please check (#542)
	! call var_list%append_log (var_str ("?out_custom"), .false., &
	! intrinsic=.true.)
	! call var_list%append_string (var_str ("$out_comment"), var_str ("# "), &
	! intrinsic=.true.)
	! call var_list%append_log (var_str ("?out_header"), .true., &
	! intrinsic=.true.)
	! call var_list%append_log (var_str ("?out_yerr"), .true., &
	! intrinsic=.true.)
	! call var_list%append_log (var_str ("?out_xerr"), .true., &
	! intrinsic=.true.)
	call var_list%append_int (var_str ("real_range"), &
	range (real_specimen), intrinsic = .true., locked = .true., &
	description=var_str ('This integer gives the decimal exponent ' // &
	'range of the numeric model for the real float type in use. It cannot ' // &
	'be set by the user. (cf. also \ttt{real\_precision}, ' // &
	'\ttt{real\_epsilon}, \ttt{real\_tiny}).'))
	call var_list%append_int (var_str ("real_precision"), &
	precision (real_specimen), intrinsic = .true., locked = .true., &
	description=var_str ('This integer gives the precision of ' // &
	'the numeric model for the real float type in use. It cannot ' // &
	'be set by the user. (cf. also \ttt{real\_range}, ' // &
	'\ttt{real\_epsilon}, \ttt{real\_tiny}).'))
	call var_list%append_real (var_str ("real_epsilon"), &
	epsilon (real_specimen), intrinsic = .true., locked = .true., &
	description=var_str ('This gives the smallest number $E$ ' // &
	'of the same kind as the float type for which $1 + E > 1$. ' // &
	'It cannot be set by the user. (cf. also \ttt{real\_range}, ' // &
	'\ttt{real\_tiny}, \ttt{real\_precision}).'))
	call var_list%append_real (var_str ("real_tiny"), &
	tiny (real_specimen), intrinsic = .true., locked = .true., &
	description=var_str ('This gives the smallest positive (non-zero) ' // &
	'number in the numeric model for the real float type in use. ' // &
	'It cannot be set by the user. (cf. also \ttt{real\_range}, ' // &
	'\ttt{real\_epsilon}, \ttt{real\_precision}).'))
	end subroutine var_list_set_core_defaults

	@ %def var_list_set_core_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_integration_defaults => var_list_set_integration_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_integration_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_string (var_str ("$integration_method"), var_str ("vamp"), &
	intrinsic=.true., &
	description=var_str ('This string variable specifies the method ' // &
	'for performing the multi-dimensional phase-space integration. ' // &
	'The default is the \vamp\ algorithm (\ttt{"vamp"}), other options ' // &
	'are via the numerical midpoint rule (\ttt{"midpoint"}) or an ' // &
	'alternate \vamptwo\ implementation that is MPI-parallelizable ' // &
	'(\ttt{"vamp2"}).'))
	call var_list%append_int (var_str ("threshold_calls"), 10, &
	intrinsic=.true., &
	description=var_str ('This integer variable gives a limit for ' // &
	'the number of calls in a given channel which acts as a lower ' // &
	'threshold for the channel weight. If the number of calls in ' // &
	'that channel falls below this threshold, the weight is not ' // &
	'lowered further but kept at this threshold. (cf. also ' // &
	'\ttt{channel\_weights\_power})'))
	call var_list%append_int (var_str ("min_calls_per_channel"), 10, &
	intrinsic=.true., &
	description=var_str ('Integer parameter that modifies the settings ' // &
	"of the \vamp\ integrator's grid parameters. It sets the minimal " // &
	'number every channel must be called. If the number of calls ' // &
	'from the iterations is too small, \whizard\ will automatically ' // &
	'increase the number of calls. (cf. \ttt{iterations}, \ttt{min\_calls\_per\_bin}, ' // &
	'\ttt{min\_bins}, \ttt{max\_bins})'))
	call var_list%append_int (var_str ("min_calls_per_bin"), 10, &
	intrinsic=.true., &
	description=var_str ('Integer parameter that modifies the settings ' // &
	"of the \vamp\ integrator's grid parameters. It sets the minimal " // &
	'number every bin in an integration dimension must be called. ' // &
	'If the number of calls from the iterations is too small, \whizard\ ' // &
	'will automatically increase the number of calls. (cf. \ttt{iterations}, ' // &
	'\ttt{min\_calls\_per\_channel}, \ttt{min\_bins}, \ttt{max\_bins})'))
	call var_list%append_int (var_str ("min_bins"), 3, &
	intrinsic=.true., &
	description=var_str ('Integer parameter that modifies the settings ' // &
	"of the \vamp\ integrator's grid parameters. It sets the minimal " // &
	'number of bins per integration dimension. (cf. \ttt{iterations}, ' // &
	'\ttt{max\_bins}, \ttt{min\_calls\_per\_channel}, \ttt{min\_calls\_per\_bin})'))
	call var_list%append_int (var_str ("max_bins"), 20, &
	intrinsic=.true., &
	description=var_str ('Integer parameter that modifies the settings ' // &
	"of the \vamp\ integrator's grid parameters. It sets the maximal " // &
	'number of bins per integration dimension. (cf. \ttt{iterations}, ' // &
	'\ttt{min\_bins}, \ttt{min\_calls\_per\_channel}, \ttt{min\_calls\_per\_bin})'))
	call var_list%append_log (var_str ("?stratified"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that switches between stratified ' // &
	'and importance sampling for the \vamp\ integration method.'))
	call var_list%append_log (var_str ("?use_vamp_equivalences"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether equivalence ' // &
	'relations (symmetries) between different integration channels ' // &
	'are used by the \vamp\ integrator.'))
	call var_list%append_log (var_str ("?vamp_verbose"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that sets the chattiness of the \vamp\ ' // &
	'integrator. If set, not only errors, but also all warnings and ' // &
	'messages will be written out (not the default). (cf. also \newline ' // &
	'\ttt{?vamp\_history\_global}, \ttt{?vamp\_history\_global\_verbose}, ' // &
	'\ttt{?vamp\_history\_channels}, \newline \ttt{?vamp\_history\_channels\_verbose})'))
	call var_list%append_log (var_str ("?vamp_history_global"), &
	.true., intrinsic=.true., &
	description=var_str ('Flag that decides whether the global history ' // &
	'of the grid adaptation of the \vamp\ integrator are written ' // &
	'into the process logfiles. (cf. also \ttt{?vamp\_history\_global\_verbose}, ' // &
	'\ttt{?vamp\_history\_channels}, \ttt{?vamp\_history\_channels\_verbose}, ' // &
	'\ttt{?vamp\_verbose})'))
	call var_list%append_log (var_str ("?vamp_history_global_verbose"), &
	.false., intrinsic=.true., &
	description=var_str ('Flag that decides whether the global history ' // &
	'of the grid adaptation of the \vamp\ integrator are written ' // &
	'into the process logfiles in an extended version. Only for debugging ' // &
	'purposes. (cf. also \ttt{?vamp\_history\_global}, \ttt{?vamp\_history\_channels}, ' // &
	'\ttt{?vamp\_verbose}, \ttt{?vamp\_history\_channels\_verbose})'))
	call var_list%append_log (var_str ("?vamp_history_channels"), &
	.false., intrinsic=.true., &
	description=var_str ('Flag that decides whether the history of ' // &
	'the grid adaptation of the \vamp\ integrator for every single ' // &
	'channel are written into the process logfiles. Only for debugging ' // &
	'purposes. (cf. also \ttt{?vamp\_history\_global\_verbose}, ' // &
	'\ttt{?vamp\_history\_global}, \ttt{?vamp\_verbose}, \newline ' // &
	'\ttt{?vamp\_history\_channels\_verbose})'))
	call var_list%append_log (var_str ("?vamp_history_channels_verbose"), &
	.false., intrinsic=.true., &
	description=var_str ('Flag that decides whether the history of ' // &
	'the grid adaptation of the \vamp\ integrator for every single ' // &
	'channel are written into the process logfiles in an extended ' // &
	'version. Only for debugging purposes. (cf. also \ttt{?vamp\_history\_global}, ' // &
	'\ttt{?vamp\_history\_channels}, \ttt{?vamp\_verbose}, \ttt{?vamp\_history\_global\_verbose})'))
	call var_list%append_string (var_str ("$run_id"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('String variable \ttt{\$run\_id = "{\em ' // &
	'<id>}"} that allows to set a special ID for a particular process ' // &
	'run, e.g. in a scan. The run ID is then attached to the process ' // &
	'log file: \newline \ttt{{\em <proc\_name>}\_{\em <proc\_comp>}.{\em ' // &
	'<id>}.log}, the \vamp\ grid file: \newline \ttt{{\em <proc\_name>}\_{\em ' // &
	'<proc\_comp>}.{\em <id>}.vg}, and the phase space file: \newline ' // &
	'\ttt{{\em <proc\_name>}\_{\em <proc\_comp>}.{\em <id>}.phs}. ' // &
	'The run ID string distinguishes among several runs for the ' // &
	'same process. It identifies process instances with respect ' // &
	'to adapted integration grids and similar run-specific data. ' // &
	'The run ID is kept when copying processes for creating instances, ' // &
	'however, so it does not distinguish event samples. (cf.\ also ' // &
	'\ttt{\$job\_id}, \ttt{\$compile\_workspace}'))
	call var_list%append_int (var_str ("n_calls_test"), 0, &
	intrinsic=.true., &
	description=var_str ('Integer variable that allows to set a ' // &
	'certain number of matrix element sampling test calls without ' // &
	'actually integrating the process under consideration. (cf. ' // &
	'\ttt{integrate})'))
	call var_list%append_log (var_str ("?integration_timer"), .true., &
	intrinsic=.true., &
	description=var_str ('This flag switches the integration timer ' // &
	'on and off, that gives the estimate for the duration of the ' // &
	'generation of 10,000 unweighted events for each integrated ' // &
	'process.'))
	call var_list%append_log (var_str ("?check_grid_file"), .true., &
	intrinsic=.true., &
	description=var_str ('Setting this to false turns off all sanity ' // &
	'checks when reading a grid file with previous integration data. ' // &
	'Use this at your own risk; the program may return wrong results ' // &
	'or crash if data do not match. (cf. also \ttt{?check\_event\_file}, \ttt{?check\_phs\_file}) '))
	call var_list%append_real (var_str ("accuracy_goal"), 0._default, &
	intrinsic=.true., &
	description=var_str ('Real parameter that allows the user to ' // &
	'set a minimal accuracy that should be achieved in the Monte-Carlo ' // &
	'integration of a certain process. If that goal is reached, ' // &
	'grid and weight adapation stop, and this result is used for ' // &
	'simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // &
	'\ttt{error\_goal}, \ttt{relative\_error\_goal}, ' // &
	'\ttt{error\_threshold})'))
	call var_list%append_real (var_str ("error_goal"), 0._default, &
	intrinsic=.true., &
	description=var_str ('Real parameter that allows the user to ' // &
	'set a minimal absolute error that should be achieved in the ' // &
	'Monte-Carlo integration of a certain process. If that goal ' // &
	'is reached, grid and weight adapation stop, and this result ' // &
	'is used for simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // &
	'\ttt{accuracy\_goal}, \ttt{relative\_error\_goal}, \ttt{error\_threshold})'))
	call var_list%append_real (var_str ("relative_error_goal"), 0._default, &
	intrinsic=.true., &
	description=var_str ('Real parameter that allows the user to ' // &
	'set a minimal relative error that should be achieved in the ' // &
	'Monte-Carlo integration of a certain process. If that goal ' // &
	'is reached, grid and weight adaptation stop, and this result ' // &
	'is used for simulation. (cf. also \ttt{integrate}, \ttt{iterations}, ' // &
	'\ttt{accuracy\_goal}, \ttt{error\_goal}, \ttt{error\_threshold})'))
	call var_list%append_int (var_str ("integration_results_verbosity"), 1, &
	intrinsic=.true., &
	description=var_str ('Integer parameter for the verbosity of ' // &
	'the integration results in the process-specific logfile.'))
	call var_list%append_real (var_str ("error_threshold"), &
	0._default, intrinsic=.true., &
	description=var_str ('The real parameter \ttt{error\_threshold ' // &
	'= {\em <num>}} declares that any error value (in absolute numbers) ' // &
	'smaller than \ttt{{\em <num>}} is to be considered zero. The ' // &
	'units are \ttt{fb} for scatterings and \ttt{GeV} for decays. ' // &
	'(cf. also \ttt{integrate}, \ttt{iterations}, \ttt{accuracy\_goal}, ' // &
	'\ttt{error\_goal}, \ttt{relative\_error\_goal})'))
	call var_list%append_real (var_str ("channel_weights_power"), 0.25_default, &
	intrinsic=.true., &
	description=var_str ('Real parameter that allows to vary the ' // &
	'exponent of the channel weights for the \vamp\ integrator.'))
	call var_list%append_string (var_str ("$integrate_workspace"), &
	intrinsic=.true., &
	description=var_str ('Character string that tells \whizard\ ' // &
	'the subdirectory where to find the run-specific phase-space ' // &
	'configuration and the \vamp\ and \vamptwo\ grid files. ' // &
	'If undefined (as per default), \whizard\ creates them and ' // &
	'searches for them in the ' // &
	'current directory. (cf. also \ttt{\$job\_id}, ' // &
	'\ttt{\$run\_id}, \ttt{\$compile\_workspace})'))
	end subroutine var_list_set_integration_defaults

	@ %def var_list_set_integration_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_phase_space_defaults => var_list_set_phase_space_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_phase_space_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_string (var_str ("$phs_method"), var_str ("default"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows to choose ' // &
	'the phase-space parameterization method. The default is the ' // &
	'\ttt{"wood"} method that takes into account electroweak/BSM ' // &
	'resonances. Note that this might not be the best choice for ' // &
	'(pure) QCD amplitudes. (cf. also \ttt{\$phs\_file})'))
	call var_list%append_log (var_str ("?vis_channels"), .false., &
	intrinsic=.true., &
	description=var_str ('Optional logical argument for the \ttt{integrate} ' // &
	'command that demands \whizard\ to generate a PDF or postscript ' // &
	'output showing the classification of the found phase space ' // &
	'channels (if the phase space method \ttt{wood} has been used) ' // &
	'according to their properties: \ttt{integrate (foo) \{ iterations=3:10000 ' // &
	'?vis\_channels = true \}}. The default is \ttt{false}. (cf. ' // &
	'also \ttt{integrate}, \ttt{?vis\_history})'))
	call var_list%append_log (var_str ("?check_phs_file"), .true., &
	intrinsic=.true., &
	description=var_str ('Setting this to false turns off all sanity ' // &
	'checks when reading a previously generated phase-space configuration ' // &
	'file. Use this at your own risk; the program may return wrong ' // &
	'results or crash if data do not match. (cf. also \ttt{?check\_event\_file}, ' // &
	'\ttt{?check\_grid\_file})'))
	call var_list%append_string (var_str ("$phs_file"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('This string variable allows the user to ' // &
	'set an individual file name for the phase space parameterization ' // &
	'for a particular process: \ttt{\$phs\_file = "{\em <file\_name>}"}. ' // &
	'If not set, the default is \ttt{{\em <proc\_name>}\_{\em <proc\_comp>}.{\em ' // &
	'<run\_id>}.phs}. (cf. also \ttt{\$phs\_method})'))
	call var_list%append_log (var_str ("?phs_only"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag (particularly as optional argument ' // &
	'of the $\to$ \ttt{integrate} command) that allows to only generate ' // &
	'the phase space file, but not perform the integration. (cf. ' // &
	'also \ttt{\$phs\_method}, \ttt{\$phs\_file})'))
	call var_list%append_real (var_str ("phs_threshold_s"), 50._default, &
	intrinsic=.true., &
	description=var_str ('For the phase space method \ttt{wood}, ' // &
	'this real parameter sets the threshold below which particles ' // &
	'are assumed to be massless in the $s$-channel like kinematic ' // &
	'regions. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_off\_shell}, ' // &
	'\ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, ' // &
	'\newline \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // &
	'\ttt{?phs\_step\_mapping\_exp}, \newline \ttt{?phs\_s\_mapping})'))
	call var_list%append_real (var_str ("phs_threshold_t"), 100._default, &
	intrinsic=.true., &
	description=var_str ('For the phase space method \ttt{wood}, ' // &
	'this real parameter sets the threshold below which particles ' // &
	'are assumed to be massless in the $t$-channel like kinematic ' // &
	'regions. (cf. also \ttt{phs\_threshold\_s}, \ttt{phs\_off\_shell}, ' // &
	'\ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, ' // &
	'\newline \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // &
	'\ttt{?phs\_step\_mapping\_exp}, \newline \ttt{?phs\_s\_mapping})'))
	call var_list%append_int (var_str ("phs_off_shell"), 2, &
	intrinsic=.true., &
	description=var_str ('Integer parameter that sets the number ' // &
	'of off-shell (not $t$-channel-like, non-resonant) lines that ' // &
	'are taken into account to find a valid phase-space setup in ' // &
	'the \ttt{wood} phase-space method. (cf. also \ttt{phs\_threshold\_t}, ' // &
	'\ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, \ttt{phs\_e\_scale}, ' // &
	'\ttt{phs\_m\_scale}, \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // &
	'\ttt{?phs\_step\_mapping}, \newline \ttt{?phs\_step\_mapping\_exp}, ' // &
	'\ttt{?phs\_s\_mapping})'))
	call var_list%append_int (var_str ("phs_t_channel"), 6, &
	intrinsic=.true., &
	description=var_str ('Integer parameter that sets the number ' // &
	'of $t$-channel propagators in multi-peripheral diagrams that ' // &
	'are taken into account to find a valid phase-space setup in ' // &
	'the \ttt{wood} phase-space method. (cf. also \ttt{phs\_threshold\_t}, ' // &
	'\ttt{phs\_threshold\_s}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // &
	'\ttt{phs\_m\_scale}, \ttt{phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // &
	'\ttt{?phs\_step\_mapping}, \newline \ttt{?phs\_step\_mapping\_exp}, ' // &
	'\ttt{?phs\_s\_mapping})'))
	call var_list%append_real (var_str ("phs_e_scale"), 10._default, &
	intrinsic=.true., &
	description=var_str ('Real parameter that sets the energy scale ' // &
	'that acts as a cutoff for parameterizing radiation-like kinematics ' // &
	'in the \ttt{wood} phase space method. \whizard\ takes the maximum ' // &
	'of this value and the width of the propagating particle as ' // &
	'a cutoff. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
	'\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_m\_scale}, ' // &
	'\ttt{phs\_q\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // &
	'\ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})'))
	call var_list%append_real (var_str ("phs_m_scale"), 10._default, &
	intrinsic=.true., &
	description=var_str ('Real parameter that sets the mass scale ' // &
	'that acts as a cutoff for parameterizing collinear and infrared ' // &
	'kinematics in the \ttt{wood} phase space method. \whizard\ ' // &
	'takes the maximum of this value and the mass of the propagating ' // &
	'particle as a cutoff. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
	'\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // &
	'\ttt{phs\_q\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_step\_mapping}, ' // &
	'\ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})'))
	call var_list%append_real (var_str ("phs_q_scale"), 10._default, &
	intrinsic=.true., &
	description=var_str ('Real parameter that sets the momentum ' // &
	'transfer scale that acts as a cutoff for parameterizing $t$- ' // &
	'and $u$-channel like kinematics in the \ttt{wood} phase space ' // &
	'method. \whizard\ takes the maximum of this value and the mass ' // &
	'of the propagating particle as a cutoff. (cf. also \ttt{phs\_threshold\_t}, ' // &
	'\ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, ' // &
	'\ttt{phs\_e\_scale}, \ttt{phs\_m\_scale}, \ttt{?phs\_keep\_resonant}, ' // &
	'\ttt{?phs\_step\_mapping}, \ttt{?phs\_step\_mapping\_exp}, ' // &
	'\newline \ttt{?phs\_s\_mapping})'))
	call var_list%append_log (var_str ("?phs_keep_nonresonant"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether the \ttt{wood} ' // &
	'phase space method takes into account also non-resonant contributions. ' // &
	'(cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
	'\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_m\_scale}, ' // &
	'\ttt{phs\_q\_scale}, \ttt{phs\_e\_scale}, \ttt{?phs\_step\_mapping}, ' // &
	'\newline \ttt{?phs\_step\_mapping\_exp}, \ttt{?phs\_s\_mapping})'))
	call var_list%append_log (var_str ("?phs_step_mapping"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that switches on (or off) a particular ' // &
	'phase space mapping for resonances, where the mass and width ' // &
	'of the resonance are explicitly set as channel cutoffs. (cf. ' // &
	'also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, \ttt{phs\_t\_channel}, ' // &
	'\ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, \newline \ttt{phs\_m\_scale}, ' // &
	'\ttt{?phs\_keep\_resonant}, \ttt{?phs\_q\_scale}, \ttt{?phs\_step\_mapping\_exp}, ' // &
	'\newline \ttt{?phs\_s\_mapping})'))
	call var_list%append_log (var_str ("?phs_step_mapping_exp"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that switches on (or off) a particular ' // &
	'phase space mapping for resonances, where the mass and width ' // &
	'of the resonance are explicitly set as channel cutoffs. This ' // &
	'is an exponential mapping in contrast to ($\to$) \ttt{?phs\_step\_mapping}. ' // &
	'(cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
	'\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // &
	'\ttt{phs\_m\_scale}, \newline \ttt{?phs\_q\_scale}, \ttt{?phs\_keep\_resonant}, ' // &
	'\ttt{?phs\_step\_mapping}, \ttt{?phs\_s\_mapping})'))
	call var_list%append_log (var_str ("?phs_s_mapping"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that allows special mapping for $s$-channel ' // &
	'resonances. (cf. also \ttt{phs\_threshold\_t}, \ttt{phs\_threshold\_s}, ' // &
	'\ttt{phs\_t\_channel}, \ttt{phs\_off\_shell}, \ttt{phs\_e\_scale}, ' // &
	'\ttt{phs\_m\_scale}, \newline \ttt{?phs\_keep\_resonant}, \ttt{?phs\_q\_scale}, ' // &
	'\ttt{?phs\_step\_mapping}, \ttt{?phs\_step\_mapping\_exp})'))
	call var_list%append_log (var_str ("?vis_history"), .false., &
	intrinsic=.true., &
	description=var_str ('Optional logical argument for the \ttt{integrate} ' // &
	'command that demands \whizard\ to generate a PDF or postscript ' // &
	'output showing the adaptation history of the Monte-Carlo integration ' // &
	'of the process under consideration. (cf. also \ttt{integrate}, ' // &
	'\ttt{?vis\_channels})'))
	end subroutine var_list_set_phase_space_defaults

	@ %def var_list_set_phase_space_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_gamelan_defaults => var_list_set_gamelan_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_gamelan_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_int (&
	var_str ("n_bins"), 20, &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: integer value that sets the number of bins in histograms. ' // &
	'(cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // &
	'\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // &
	'\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{?y\_log}, ' // &
	'\ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, ' // &
	'\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // &
	'\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
	'\newline \ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
	'\ttt{\$symbol})'))
	call var_list%append_log (&
	var_str ("?normalize_bins"), .false., &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: flag that determines whether the weights shall be normalized ' // &
	'to the bin width or not. (cf. also \ttt{n\_bins}, \ttt{\$obs\_label}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
	'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
	'\ttt{y\_max}, \ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // &
	'\newline \ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \newline ' // &
	'\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
	'\ttt{\$err\_options})'))
	call var_list%append_string (var_str ("$obs_label"), var_str (""), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: this is a string variable \ttt{\$obs\_label = "{\em ' // &
	'<LaTeX\_Code>}"} that allows to attach a label to a plotted ' // &
	'or histogrammed observable. (cf. also \ttt{n\_bins}, \ttt{?normalize\_bins}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
	'\ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
	'\ttt{graph\_height\_mm}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
	'\ttt{y\_max}, \ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // &
	'\ttt{?draw\_histogram}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
	'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
	call var_list%append_string (var_str ("$obs_unit"), var_str (""), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: this is a string variable \ttt{\$obs\_unit = "{\em ' // &
	'<LaTeX\_Code>}"} that allows to attach a \LaTeX\ physical unit ' // &
	'to a plotted or histogrammed observable. (cf. also \ttt{n\_bins}, ' // &
	'\ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
	'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, ' // &
	'\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{x\_min}, ' // &
	'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // &
	'\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \ttt{?draw\_curve}, ' // &
	'\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
	'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
	call var_list%append_string (var_str ("$title"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('This string variable sets the title of ' // &
	'a plot in a \whizard\ analysis setup, e.g. a histogram or an ' // &
	'observable. The syntax is \ttt{\$title = "{\em <your title>}"}. ' // &
	'This title appears as a section header in the analysis file, ' // &
	'but not in the screen output of the analysis. (cf. also \ttt{n\_bins}, ' // &
	'\ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$description}, ' // &
	'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, \ttt{?x\_log}, ' // &
	'\ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, \ttt{x\_min}, ' // &
	'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // &
	'\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \newline \ttt{?draw\_curve}, ' // &
	'\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
	'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
	call var_list%append_string (var_str ("$description"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('String variable that allows to specify ' // &
	'a description text for the analysis, \ttt{\$description = "{\em ' // &
	'<LaTeX analysis descr.>}"}. This line appears below the title ' // &
	'of a corresponding analysis, on top of the respective plot. ' // &
	'(cf. also \ttt{analysis}, \ttt{n\_bins}, \ttt{?normalize\_bins}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{?y\_log}, ' // &
	'\ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \ttt{?draw\_histogram}, ' // &
	'\ttt{?fill\_curve}, \ttt{?draw\_piecewise}, \ttt{?draw\_curve}, ' // &
	'\ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
	'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
	call var_list%append_string (var_str ("$x_label"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('String variable, \ttt{\$x\_label = "{\em ' // &
	'<LaTeX code>}"}, that sets the $x$ axis label in a plot or ' // &
	'histogram in a \whizard\ analysis. (cf. also \ttt{analysis}, ' // &
	'\ttt{n\_bins}, \ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{\$y\_label}, ' // &
	'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // &
	'\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // &
	'\ttt{?draw\_histogram}, \ttt{?fill\_curve}, \newline \ttt{?draw\_piecewise}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
	'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
	call var_list%append_string (var_str ("$y_label"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('String variable, \ttt{\$y\_label = "{\em ' // &
	'<LaTeX\_code>}"}, that sets the $y$ axis label in a plot or ' // &
	'histogram in a \whizard\ analysis. (cf. also \ttt{analysis}, ' // &
	'\ttt{n\_bins}, \ttt{?normalize\_bins}, \ttt{\$obs\_unit}, \ttt{?y\_log}, ' // &
	'\ttt{?x\_log}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // &
	'\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, ' // &
	'\ttt{?draw\_histogram}, \ttt{?fill\_curve}, \newline \ttt{?draw\_piecewise}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{\$symbol}, \ttt{?draw\_symbols}, ' // &
	'\newline \ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options})'))
	call var_list%append_int (var_str ("graph_width_mm"), 130, &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: integer value that sets the width of a graph or histogram ' // &
	'in millimeters. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
	'\ttt{\$y\_label}, \ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, ' // &
	'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, \ttt{?draw\_base}, ' // &
	'\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
	'\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // &
	'\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_int (var_str ("graph_height_mm"), 90, &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: integer value that sets the height of a graph or histogram ' // &
	'in millimeters. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
	'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, ' // &
	'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, \ttt{?draw\_base}, ' // &
	'\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
	'\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // &
	'\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_log (var_str ("?y_log"), .false., &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: flag that makes the $y$ axis logarithmic. (cf. also ' // &
	'\ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // &
	'\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // &
	'\ttt{graph\_height\_mm}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, ' // &
	'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // &
	'\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // &
	'\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
	'\ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
	'\ttt{\$symbol})'))
	call var_list%append_log (var_str ("?x_log"), .false., &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: flag that makes the $x$ axis logarithmic. (cf. also ' // &
	'\ttt{?normalize\_bins}, \ttt{\$obs\_label}, \ttt{\$obs\_unit}, ' // &
	'\ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, \ttt{\$y\_label}, ' // &
	'\ttt{graph\_height\_mm}, \ttt{graph\_width\_mm}, \ttt{?y\_log}, ' // &
	'\ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline ' // &
	'\ttt{\$gmlcode\_bg}, \ttt{\$gmlcode\_fg}, \ttt{?draw\_histogram}, ' // &
	'\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \newline \ttt{?fill\_curve}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
	'\ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
	'\ttt{\$symbol})'))
	call var_list%append_real (var_str ("x_min"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: real parameter that sets the lower limit of the $x$ ' // &
	'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // &
	'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
	'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
	'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // &
	'\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
	'\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
	'\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_real (var_str ("x_max"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: real parameter that sets the upper limit of the $x$ ' // &
	'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // &
	'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
	'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
	'\ttt{x\_min}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // &
	'\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
	'\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
	'\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_real (var_str ("y_min"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: real parameter that sets the lower limit of the $y$ ' // &
	'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // &
	'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
	'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
	'\ttt{x\_max}, \ttt{y\_max}, \ttt{x\_min}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // &
	'\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
	'\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
	'\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_real (var_str ("y_max"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: real parameter that sets the upper limit of the $y$ ' // &
	'axis plotting or histogram interval. (cf. also \ttt{?normalize\_bins}, ' // &
	'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
	'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \newline \ttt{?x\_log}, \ttt{graph\_width\_mm}, ' // &
	'\ttt{x\_max}, \ttt{x\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{\$gmlcode\_fg}, \ttt{?draw\_base}, \newline \ttt{?draw\_histogram}, ' // &
	'\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_curve}, ' // &
	'\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
	'\ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_string (var_str ("$gmlcode_bg"), var_str (""), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: string variable that allows to define a background ' // &
	'for plots and histograms (i.e. it is overwritten by the plot/histogram), ' // &
	'e.g. a grid: \ttt{\$gmlcode\_bg = "standardgrid.lr(5);"}. For ' // &
	'more details, see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // &
	'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
	'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
	'\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
	'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // &
	'\ttt{?draw\_histogram}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
	'\newline \ttt{?fill\_curve}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // &
	'\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, ' // &
	'\ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_string (var_str ("$gmlcode_fg"), var_str (""), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: string variable that allows to define a foreground ' // &
	'for plots and histograms (i.e. it overwrites the plot/histogram), ' // &
	'e.g. a grid: \ttt{\$gmlcode\_bg = "standardgrid.lr(5);"}. For ' // &
	'more details, see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // &
	'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
	'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
	'\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
	'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{?draw\_histogram}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
	'\newline \ttt{?fill\_curve}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // &
	'\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \newline \ttt{\$draw\_options}, ' // &
	'\ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_log (var_str ("?draw_histogram"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: flag that tells \whizard\ to either plot data as a ' // &
	'histogram or as a continuous line (if $\to$ \ttt{?draw\_curve} ' // &
	'is set \ttt{true}). (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
	'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
	'\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
	'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
	'\ttt{\$symbol})'))
	call var_list%append_log (var_str ("?draw_base"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: flag that tells \whizard\ to insert a \ttt{base} statement ' // &
	'in the analysis code to calculate the plot data from a data ' // &
	'set. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
	'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
	'\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
	'\ttt{\$symbol}, \newline \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // &
	'\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
	'\newline \ttt{\$err\_options})'))
	call var_list%append_log (var_str ("?draw_piecewise"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: flag that tells \whizard\ to data from a data set piecewise, ' // &
	'i.e. histogram style. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
	'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, ' // &
	'\ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_base}, \ttt{?fill\_curve}, ' // &
	'\ttt{\$symbol}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // &
	'\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
	'\ttt{\$err\_options})'))
	call var_list%append_log (var_str ("?fill_curve"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: flag that tells \whizard\ to fill data curves (e.g. ' // &
	'as a histogram). The style can be set with $\to$ \ttt{\$fill\_options ' // &
	'= "{\em <LaTeX\_code>}"}. (cf. also \ttt{?normalize\_bins}, ' // &
	'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
	'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
	'\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
	'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, ' // &
	'\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // &
	'\ttt{?draw\_symbols}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
	'\ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_log (var_str ("?draw_curve"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: flag that tells \whizard\ to either plot data as a ' // &
	'continuous line or as a histogram (if $\to$ \ttt{?draw\_histogram} ' // &
	'is set \ttt{true}). (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
	'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
	'\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
	'\ttt{?draw\_histogram}, \ttt{?draw\_errors}, \ttt{?draw\_symbols}, ' // &
	'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \ttt{\$err\_options}, ' // &
	'\ttt{\$symbol})'))
	call var_list%append_log (var_str ("?draw_errors"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: flag that determines whether error bars should be drawn ' // &
	'or not. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
	'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
	'\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // &
	'\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
	'\newline \ttt{\$draw\_options}, \ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_log (var_str ("?draw_symbols"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: flag that determines whether particular symbols (specified ' // &
	'by $\to$ \ttt{\$symbol = "{\em <LaTeX\_code>}"}) should be ' // &
	'used for plotting data points (cf. also \ttt{?normalize\_bins}, ' // &
	'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
	'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
	'\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
	'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // &
	'\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
	'\ttt{?fill\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_curve}, ' // &
	'\ttt{?draw\_errors}, \ttt{\$fill\_options}, \ttt{\$draw\_options}, ' // &
	'\newline \ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_string (var_str ("$fill_options"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: \ttt{\$fill\_options = "{\em <LaTeX\_code>}"} is a ' // &
	'string variable that allows to set fill options when plotting ' // &
	'data as filled curves with the $\to$ \ttt{?fill\_curve} flag. ' // &
	'For more details see the \gamelan\ manual. (cf. also \ttt{?normalize\_bins}, ' // &
	'\ttt{\$obs\_label}, \ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, ' // &
	'\ttt{\$x\_label}, \ttt{\$y\_label}, \ttt{graph\_width\_mm}, ' // &
	'\ttt{graph\_height\_mm}, \ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, ' // &
	'\ttt{x\_max}, \ttt{y\_min}, \ttt{y\_max}, \ttt{\$gmlcode\_fg}, ' // &
	'\ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, \ttt{?draw\_piecewise}, ' // &
	'\ttt{?draw\_curve}, \ttt{?draw\_histogram}, \ttt{?draw\_errors}, ' // &
	'\newline \ttt{?draw\_symbols}, \ttt{?fill\_curve}, \ttt{\$draw\_options}, ' // &
	'\ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_string (var_str ("$draw_options"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: \ttt{\$draw\_options = "{\em <LaTeX\_code>}"} is a ' // &
	'string variable that allows to set specific drawing options ' // &
	'for plots and histograms. For more details see the \gamelan\ ' // &
	'manual. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
	'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
	'\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // &
	'\newline \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // &
	'\ttt{?draw\_errors}, \ttt{?draw\_symbols}, \newline \ttt{\$fill\_options}, ' // &
	'\ttt{?draw\_histogram}, \ttt{\$err\_options}, \ttt{\$symbol})'))
	call var_list%append_string (var_str ("$err_options"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: \ttt{\$err\_options = "{\em <LaTeX\_code>}"} is a string ' // &
	'variable that allows to set specific drawing options for errors ' // &
	'in plots and histograms. For more details see the \gamelan\ ' // &
	'manual. (cf. also \ttt{?normalize\_bins}, \ttt{\$obs\_label}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
	'\ttt{\$y\_label}, \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
	'\ttt{y\_max}, \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, \ttt{?draw\_base}, ' // &
	'\ttt{?draw\_piecewise}, \ttt{?fill\_curve}, \ttt{?draw\_histogram}, ' // &
	'\ttt{?draw\_errors}, \newline \ttt{?draw\_symbols}, \ttt{\$fill\_options}, ' // &
	'\ttt{?draw\_histogram}, \ttt{\$draw\_options}, \ttt{\$symbol})'))
	call var_list%append_string (var_str ("$symbol"), &
	intrinsic=.true., &
	description=var_str ("Settings for \whizard's internal graphics " // &
	'output: \ttt{\$symbol = "{\em <LaTeX\_code>}"} is a string ' // &
	'variable for the symbols that should be used for plotting data ' // &
	'points. (cf. also \ttt{\$obs\_label}, \ttt{?normalize\_bins}, ' // &
	'\ttt{\$obs\_unit}, \ttt{\$title}, \ttt{\$description}, \ttt{\$x\_label}, ' // &
	'\ttt{\$y\_label}, \newline \ttt{graph\_width\_mm}, \ttt{graph\_height\_mm}, ' // &
	'\ttt{?y\_log}, \ttt{?x\_log}, \ttt{x\_min}, \ttt{x\_max}, \ttt{y\_min}, ' // &
	'\ttt{y\_max}, \newline \ttt{\$gmlcode\_fg}, \ttt{\$gmlcode\_bg}, ' // &
	'\ttt{?draw\_base}, \ttt{?draw\_piecewise}, \ttt{?fill\_curve}, ' // &
	'\newline \ttt{?draw\_histogram}, \ttt{?draw\_curve}, \ttt{?draw\_errors}, ' // &
	'\ttt{\$fill\_options}, \ttt{\$draw\_options}, \newline \ttt{\$err\_options}, ' // &
	'\ttt{?draw\_symbols})'))
	call var_list%append_log (&
	var_str ("?analysis_file_only"), .false., &
	intrinsic=.true., &
	description=var_str ('Allows to specify that only \LaTeX\ files ' // &
	"for \whizard's graphical analysis are written out, but not processed. " // &
	'(cf. \ttt{compile\_analysis}, \ttt{write\_analysis})'))
	end subroutine var_list_set_gamelan_defaults

	@ %def var_list_set_gamelan_defaults
	@ FastJet parameters and friends
	<<Variables: var list: TBP>>=
	procedure :: set_clustering_defaults => var_list_set_clustering_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_clustering_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_int (&
	var_str ("kt_algorithm"), &
	kt_algorithm, &
	intrinsic = .true., locked = .true., &
	description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
	'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
	'subevent function. At the moment only available for the ' // &
	'interfaced external \fastjet\ package. (cf. also ' // &
	'\ttt{cambridge\_[for\_passive\_]algorithm}, ' // &
	'\ttt{plugin\_algorithm}, ' // &
	'\newline\ttt{genkt\_[for\_passive\_]algorithm}, ' // &
	'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r})'))
	call var_list%append_int (&
	var_str ("cambridge_algorithm"), &
	cambridge_algorithm, intrinsic = .true., locked = .true., &
	description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
	'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
	'subevent function. At the moment only available for the interfaced ' // &
	'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
	'\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // &
	'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
	'\ttt{jet\_r})'))
	call var_list%append_int (&
	var_str ("antikt_algorithm"), &
	antikt_algorithm, &
	intrinsic = .true., locked = .true., &
	description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
	'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
	'subevent function. At the moment only available for the interfaced ' // &
	'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
	'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // &
	'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
	'\ttt{jet\_r})'))
	call var_list%append_int (&
	var_str ("genkt_algorithm"), &
	genkt_algorithm, &
	intrinsic = .true., locked = .true., &
	description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
	'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
	'subevent function. At the moment only available for the interfaced ' // &
	'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
	'\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // &
	'\ttt{genkt\_for\_passive\_algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
	'\ttt{jet\_r})'))
	call var_list%append_int (&
	var_str ("cambridge_for_passive_algorithm"), &
	cambridge_for_passive_algorithm, &
	intrinsic = .true., locked = .true., &
	description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
	'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
	'subevent function. At the moment only available for the interfaced ' // &
	'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
	'\ttt{cambridge\_algorithm}, \ttt{plugin\_algorithm}, \newline ' // &
	'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
	'\ttt{jet\_r})'))
	call var_list%append_int (&
	var_str ("genkt_for_passive_algorithm"), &
	genkt_for_passive_algorithm, &
	intrinsic = .true., locked = .true., &
	description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
	'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
	'subevent function. At the moment only available for the interfaced ' // &
	'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
	'\ttt{cambridge\_for\_passive\_algorithm}, \ttt{plugin\_algorithm}, ' // &
	'\ttt{genkt\_algorithm}, \ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r})'))
	call var_list%append_int (&
	var_str ("ee_kt_algorithm"), &
	ee_kt_algorithm, &
	intrinsic = .true., locked = .true., &
	description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
	'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
	'subevent function. At the moment only available for the interfaced ' // &
	'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
	'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // &
	'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_genkt\_algorithm}, ' // &
	'\ttt{jet\_r})'))
	call var_list%append_int (&
	var_str ("ee_genkt_algorithm"), &
	ee_genkt_algorithm, &
	intrinsic = .true., locked = .true., &
	description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
	'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
	'subevent function. At the moment only available for the interfaced ' // &
	'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
	'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{plugin\_algorithm}, ' // &
	'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_kt\_algorithm}, ' // &
	'\ttt{jet\_r})'))
	call var_list%append_int (&
	var_str ("plugin_algorithm"), &
	plugin_algorithm, &
	intrinsic = .true., locked = .true., &
	description=var_str ('Specifies a jet algorithm for the ($\to$) ' // &
	'\ttt{jet\_algorithm} command, used in the ($\to$) \ttt{cluster} ' // &
	'subevent function. At the moment only available for the interfaced ' // &
	'external \fastjet\ package. (cf. also \ttt{kt\_algorithm}, ' // &
	'\ttt{cambridge\_for\_passive\_algorithm}, \newline ' // &
	'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
	'\ttt{jet\_r})'))
	call var_list%append_int (&
	var_str ("undefined_jet_algorithm"), &
	undefined_jet_algorithm, &
	intrinsic = .true., locked = .true., &
	description=var_str ('This is just a place holder for any kind of jet ' // &
	'jet algorithm that is not further specified. (cf. also \ttt{kt\_algorithm}, ' // &
	'\ttt{cambridge\_for\_passive\_algorithm}, \newline ' // &
	'\ttt{genkt\_[for\_passive\_]algorithm}, \ttt{ee\_[gen]kt\_algorithm}, ' // &
	'\ttt{jet\_r}, \ttt{plugin\_algorithm})'))
	call var_list%append_int (&
	var_str ("jet_algorithm"), undefined_jet_algorithm, &
	intrinsic = .true., &
	description=var_str ('Variable that allows to set the type of ' // &
	'jet algorithm when using the external \fastjet\ library. It ' // &
	'accepts one of the following algorithms: ($\to$) \ttt{kt\_algorithm}, ' // &
	'\newline ($\to$) \ttt{cambridge\_[for\_passive\_]algorithm}, ' // &
	'($\to$) \ttt{antikt\_algorithm}, ($\to$) \ttt{plugin\_algorithm}, ' // &
	'($\to$) \ttt{genkt\_[for\_passive\_]algorithm}, ($\to$) ' // &
	'\ttt{ee\_[gen]kt\_algorithm}). (cf. also \ttt{cluster}, ' // &
	'\ttt{jet\_p}, \ttt{jet\_r}, \ttt{jet\_ycut})'))
	call var_list%append_real (&
	var_str ("jet_r"), 0._default, &
	intrinsic = .true., &
	description=var_str ('Value for the distance measure $R$ used in ' // &
	'the (non-Cambridge) algorithms that are available via the interface ' // &
	'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // &
	'\ttt{jet\_algorithm}, \ttt{kt\_algorithm}, ' // &
	'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
	'\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
	'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_ycut})'))
	call var_list%append_real (&
	var_str ("jet_p"), 0._default, &
	intrinsic = .true., &
	description=var_str ('Value for the exponent of the distance measure $R$ in ' // &
	'the generalized $k_T$ algorithms that are available via the interface ' // &
	'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // &
	'\ttt{jet\_algorithm}, \ttt{kt\_algorithm}, ' // &
	'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
	'\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
	'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_r}, \newline\ttt{jet\_ycut})'))
	call var_list%append_real (&
	var_str ("jet_ycut"), 0._default, &
	intrinsic = .true., &
	description=var_str ('Value for the $y$ separation measure used in ' // &
	'the Cambridge-Aachen algorithms that are available via the interface ' // &
	'to the \fastjet\ package. (cf. also \ttt{cluster}, \ttt{combine}, ' // &
	'\ttt{kt\_algorithm}, \ttt{jet\_algorithm}, ' // &
	'\ttt{cambridge\_[for\_passive\_]algorithm}, \ttt{antikt\_algorithm}, ' // &
	'\newline \ttt{plugin\_algorithm}, \ttt{genkt\_[for\_passive\_]algorithm}, ' // &
	'\ttt{ee\_[gen]kt\_algorithm}, \ttt{jet\_p}, \newline\ttt{jet\_r})'))
	call var_list%append_log (&
	var_str ("?keep_flavors_when_clustering"), .false., &
	intrinsic = .true., &
	description=var_str ('The logical variable \ttt{?keep\_flavors\_when\_clustering ' // &
	'= true/false} specifies whether the flavor of a jet should be ' // &
	'kept during \ttt{cluster} when a jet consists of one quark and ' // &
	'zero or more gluons. Especially useful for cuts on b-tagged ' // &
	'jets (cf. also \ttt{cluster}).'))
	end subroutine var_list_set_clustering_defaults

	@ %def var_list_set_clustering_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_eio_defaults => var_list_set_eio_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_eio_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_string (var_str ("$sample"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('String variable to set the (base) name ' // &
	'of the event output format, e.g. \ttt{\$sample = "foo"} will ' // &
	'result in an intrinsic binary format event file \ttt{foo.evx}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{simulate}, \ttt{hepevt}, ' // &
	'\ttt{ascii}, \ttt{athena}, \ttt{debug}, \ttt{long}, \ttt{short}, ' // &
	'\ttt{hepmc}, \ttt{lhef}, \ttt{lha}, \ttt{stdhep}, \ttt{stdhep\_up}, ' // &
	'\ttt{\$sample\_normalization}, \ttt{?sample\_pacify}, \ttt{sample\_max\_tries})'))
	call var_list%append_string (var_str ("$sample_normalization"), var_str ("auto"),&
	intrinsic=.true., &
	description=var_str ('String variable that allows to set the ' // &
	'normalization of generated events. There are four options: ' // &
	'option \ttt{"1"} (events normalized to one), \ttt{"1/n"} (sum ' // &
	'of all events in a sample normalized to one), \ttt{"sigma"} ' // &
	'(events normalized to the cross section of the process), and ' // &
	'\ttt{"sigma/n"} (sum of all events normalized to the cross ' // &
	'section). The default is \ttt{"auto"} where unweighted events ' // &
	'are normalized to one, and weighted ones to the cross section. ' // &
	'(cf. also \ttt{simulate}, \ttt{\$sample}, \ttt{sample\_format}, ' // &
	'\ttt{?sample\_pacify}, \ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt}, ' // &
	'\ttt{sample\_split\_n\_kbytes})'))
	call var_list%append_log (var_str ("?sample_pacify"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag, mainly for debugging purposes: suppresses ' // &
	'numerical noise in the output of a simulation. (cf. also \ttt{simulate}, ' // &
	'\ttt{\$sample}, \ttt{sample\_format}, \ttt{\$sample\_normalization}, ' // &
	'\ttt{sample\_max\_tries}, \ttt{sample\_split\_n\_evt}, ' // &
	'\ttt{sample\_split\_n\_kbytes})'))
	call var_list%append_log (var_str ("?sample_select"), .true., &
	intrinsic=.true., &
	description=var_str ('Logical that determines whether a selection should ' // &
	'be applied to the output event format or not. If set to \ttt{false} a ' // &
	'selection is only considered for the evaluation of observables. (cf. ' // &
	'\ttt{select}, \ttt{selection}, \ttt{analysis})'))
	call var_list%append_int (var_str ("sample_max_tries"), 10000, &
	intrinsic = .true., &
	description=var_str ('Integer variable that sets the maximal ' // &
	'number of tries for generating a single event. The event might ' // &
	'be vetoed because of a very low unweighting efficiency, errors ' // &
	'in the event transforms like decays, shower, matching, hadronization ' // &
	'etc. (cf. also \ttt{simulate}, \ttt{\$sample}, \ttt{sample\_format}, ' // &
	'\ttt{?sample\_pacify}, \ttt{\$sample\_normalization}, ' // &
	'\ttt{sample\_split\_n\_evt}, \newline\ttt{sample\_split\_n\_kbytes})'))
	call var_list%append_int (var_str ("sample_split_n_evt"), 0, &
	intrinsic = .true., &
	description=var_str ('When generating events, this integer parameter ' // &
	'\ttt{sample\_split\_n\_evt = {\em <num>}} gives the number \ttt{{\em ' // &
	'<num>}} of breakpoints in the event files, i.e. it splits the ' // &
	'event files into \ttt{{\em <num>} + 1} parts. The parts are ' // &
	'denoted by \ttt{{\em <proc\_name>}.{\em <split\_index>}.{\em ' // &
	'<evt\_extension>}}. Here, \ttt{{\em <split\_index>}} is an integer ' // &
	'running from \ttt{0} to \ttt{{\em <num>}}. The start can be ' // &
	'reset by ($\to$) \ttt{sample\_split\_index}. (cf. also \ttt{simulate}, ' // &
	'\ttt{\$sample}, \ttt{sample\_format}, \ttt{sample\_max\_tries}, ' // &
	'\ttt{\$sample\_normalization}, \ttt{?sample\_pacify}, ' // &
	'\ttt{sample\_split\_n\_kbytes})'))
	call var_list%append_int (var_str ("sample_split_n_kbytes"), 0, &
	intrinsic = .true., &
	description=var_str ('When generating events, this integer parameter ' // &
	'\ttt{sample\_split\_n\_kbytes = {\em <num>}} limits the file ' // &
	'size of event files. Whenever an event file has exceeded this ' // &
	'size, counted in kilobytes, the following events will be written ' // &
	'to a new file. The naming conventions are the same as for ' // &
	'\ttt{sample\_split\_n\_evt}. (cf. also \ttt{simulate}, \ttt{\$sample}, ' // &
	'\ttt{sample\_format}, \ttt{sample\_max\_tries}, \ttt{\$sample\_normalization}, ' // &
	'\ttt{?sample\_pacify})'))
	call var_list%append_int (var_str ("sample_split_index"), 0, &
	intrinsic = .true., &
	description=var_str ('Integer number that gives the starting ' // &
	'index \ttt{sample\_split\_index = {\em <split\_index>}} for ' // &
	'the numbering of event samples \ttt{{\em <proc\_name>}.{\em ' // &
	'<split\_index>}.{\em <evt\_extension>}} split by the \ttt{sample\_split\_n\_evt ' // &
	'= {\em <num>}}. The index runs from \ttt{{\em <split\_index>}} ' // &
	'to \newline \ttt{{\em <split\_index>} + {\em <num>}}. (cf. also \ttt{simulate}, ' // &
	'\ttt{\$sample}, \ttt{sample\_format}, \newline\ttt{\$sample\_normalization}, ' // &
	'\ttt{sample\_max\_tries}, \ttt{?sample\_pacify})'))
	call var_list%append_string (var_str ("$rescan_input_format"), var_str ("raw"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows to set the ' // &
	'event format of the event file that is to be rescanned by the ' // &
	'($\to$) \ttt{rescan} command.'))
	call var_list%append_log (var_str ("?read_raw"), .true., &
	intrinsic=.true., &
	description=var_str ('This flag demands \whizard\ to (try to) ' // &
	'read events (from the internal binary format) first before ' // &
	'generating new ones. (cf. \ttt{simulate}, \ttt{?write\_raw}, ' // &
	'\ttt{\$sample}, \ttt{sample\_format})'))
	call var_list%append_log (var_str ("?write_raw"), .true., &
	intrinsic=.true., &
	description=var_str ("Flag to write out events in \whizard's " // &
	'internal binary format. (cf. \ttt{simulate}, \ttt{?read\_raw}, ' // &
	'\ttt{sample\_format}, \ttt{\$sample})'))
	call var_list%append_string (var_str ("$extension_raw"), var_str ("evx"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_raw ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	"to which events in \whizard's internal format are written. If " // &
	'not set, the default file name and suffix is \ttt{{\em <process\_name>}.evx}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
	call var_list%append_string (var_str ("$extension_default"), var_str ("evt"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_default ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in a the standard \whizard\ verbose ASCII format ' // &
	'are written. If not set, the default file name and suffix is ' // &
	'\ttt{{\em <process\_name>}.evt}. (cf. also \ttt{sample\_format}, ' // &
	'\ttt{\$sample})'))
	call var_list%append_string (var_str ("$debug_extension"), var_str ("debug"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$debug\_extension ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in a long verbose format with debugging information ' // &
	'are written. If not set, the default file name and suffix is ' // &
	'\ttt{{\em <process\_name>}.debug}. (cf. also \ttt{sample\_format}, ' // &
	'\ttt{\$sample}, \ttt{?debug\_process}, \ttt{?debug\_transforms}, ' // &
	'\ttt{?debug\_decay}, \ttt{?debug\_verbose})'))
	call var_list%append_log (var_str ("?debug_process"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether process information ' // &
	'will be displayed in the ASCII debug event format ($\to$) \ttt{debug}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{\$debug\_extension}, ' // &
	'\ttt{?debug\_decay}, \ttt{?debug\_transforms}, \ttt{?debug\_verbose})'))
	call var_list%append_log (var_str ("?debug_transforms"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether information ' // &
	'about event transforms will be displayed in the ASCII debug ' // &
	'event format ($\to$) \ttt{debug}. (cf. also \ttt{sample\_format}, ' // &
	'\ttt{\$sample}, \ttt{?debug\_decay}, \ttt{\$debug\_extension}, ' // &
	'\ttt{?debug\_process}, \ttt{?debug\_verbose})'))
	call var_list%append_log (var_str ("?debug_decay"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether decay information ' // &
	'will be displayed in the ASCII debug event format ($\to$) \ttt{debug}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{\$debug\_extension}, ' // &
	'\ttt{?debug\_process}, \ttt{?debug\_transforms}, \ttt{?debug\_verbose})'))
	call var_list%append_log (var_str ("?debug_verbose"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether extensive verbose ' // &
	'information will be included in the ASCII debug event format ' // &
	'($\to$) \ttt{debug}. (cf. also \ttt{sample\_format}, \ttt{\$sample}, ' // &
	'\ttt{\$debug\_extension}, \ttt{?debug\_decay}, \ttt{?debug\_transforms}, ' // &
	'\ttt{?debug\_process})'))
	call var_list%append_string (var_str ("$dump_extension"), var_str ("pset.dat"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$dump\_extension ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	"to which events in \whizard's internal particle set format " // &
	'are written. If not set, the default file name and suffix is ' // &
	'\ttt{{\em <process\_name>}.pset.dat}. (cf. also \ttt{sample\_format}, ' // &
	'\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // &
	'\ttt{?dump\_screen}, \ttt{?dump\_summary}, \ttt{?dump\_weights})'))
	call var_list%append_log (var_str ("?dump_compressed"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that, if set to \ttt{true}, issues ' // &
	'a very compressed and clear version of the \ttt{dump} ($\to$) ' // &
	'event format. (cf. also \ttt{sample\_format}, ' // &
	'\ttt{\$sample}, \ttt{dump}, \ttt{\$dump\_extension}, ' // &
	'\ttt{?dump\_screen}, \ttt{?dump\_summary}, \ttt{?dump\_weights})'))
	call var_list%append_log (var_str ("?dump_weights"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that, if set to \ttt{true}, includes ' // &
	'cross sections, weights and excess in the \ttt{dump} ($\to$) ' // &
	'event format. (cf. also \ttt{sample\_format}, ' // &
	'\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // &
	'\ttt{\$dump\_extension}, \ttt{?dump\_screen}, \ttt{?dump\_summary})'))
	call var_list%append_log (var_str ("?dump_summary"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that, if set to \ttt{true}, includes ' // &
	'a summary with momentum sums for incoming and outgoing particles ' // &
	'as well as for beam remnants in the \ttt{dump} ($\to$) ' // &
	'event format. (cf. also \ttt{sample\_format}, ' // &
	'\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // &
	'\ttt{\$dump\_extension}, \ttt{?dump\_screen}, \ttt{?dump\_weights})'))
	call var_list%append_log (var_str ("?dump_screen"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that, if set to \ttt{true}, outputs ' // &
	'events for the \ttt{dump} ($\to$) event format on screen ' // &
	' instead of to a file. (cf. also \ttt{sample\_format}, ' // &
	'\ttt{\$sample}, \ttt{dump}, \ttt{?dump\_compressed}, ' // &
	'\ttt{\$dump\_extension}, \ttt{?dump\_summary}, \ttt{?dump\_weights})'))
	call var_list%append_log (var_str ("?hepevt_ensure_order"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag to ensure that the particle set confirms ' // &
	'the HEPEVT standard. This involves some copying and reordering ' // &
	'to guarantee that mothers and daughters are always next to ' // &
	'each other. Usually this is not necessary.'))
	call var_list%append_string (var_str ("$extension_hepevt"), var_str ("hepevt"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_hepevt ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the \whizard\ version 1 style HEPEVT ASCII ' // &
	'format are written. If not set, the default file name and suffix ' // &
	'is \ttt{{\em <process\_name>}.hepevt}. (cf. also \ttt{sample\_format}, ' // &
	'\ttt{\$sample})'))
	call var_list%append_string (var_str ("$extension_ascii_short"), &
	var_str ("short.evt"), intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_ascii\_short ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the so called short variant of the \whizard\ ' // &
	'version 1 style HEPEVT ASCII format are written. If not set, ' // &
	'the default file name and suffix is \ttt{{\em <process\_name>}.short.evt}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
	call var_list%append_string (var_str ("$extension_ascii_long"), &
	var_str ("long.evt"), intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_ascii\_long ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the so called long variant of the \whizard\ ' // &
	'version 1 style HEPEVT ASCII format are written. If not set, ' // &
	'the default file name and suffix is \ttt{{\em <process\_name>}.long.evt}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
	call var_list%append_string (var_str ("$extension_athena"), &
	var_str ("athena.evt"), intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_athena ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the ATHENA file format are written. If not ' // &
	'set, the default file name and suffix is \ttt{{\em <process\_name>}.athena.evt}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
	call var_list%append_string (var_str ("$extension_mokka"), &
	var_str ("mokka.evt"), intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_mokka ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the MOKKA format are written. If not set, ' // &
	'the default file name and suffix is \ttt{{\em <process\_name>}.mokka.evt}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
	call var_list%append_string (var_str ("$lhef_version"), var_str ("2.0"), &
	intrinsic = .true., &
	description=var_str ('Specifier for the Les Houches Accord (LHEF) ' // &
	'event format files with XML headers to discriminate among different ' // &
	'versions of this format. (cf. also \ttt{\$sample}, \ttt{sample\_format}, ' // &
	'\ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // &
	'\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_ref}, ' // &
	'\ttt{?lhef\_write\_sqme\_alt})'))
	call var_list%append_string (var_str ("$lhef_extension"), var_str ("lhe"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$lhef\_extension ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the LHEF format are written. If not set, ' // &
	'the default file name and suffix is \ttt{{\em <process\_name>}.lhe}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample}, \ttt{lhef}, ' // &
	'\ttt{\$lhef\_extension}, \ttt{\$lhef\_version}, \ttt{?lhef\_write\_sqme\_prc}, ' // &
	'\ttt{?lhef\_write\_sqme\_ref}, \ttt{?lhef\_write\_sqme\_alt})'))
	call var_list%append_log (var_str ("?lhef_write_sqme_prc"), .true., &
	intrinsic = .true., &
	description=var_str ('Flag that decides whether in the ($\to$) ' // &
	'\ttt{lhef} event format the weights of the squared matrix element ' // &
	'of the corresponding process shall be written in the LHE file. ' // &
	'(cf. also \ttt{\$sample}, \ttt{sample\_format}, \ttt{lhef}, ' // &
	'\ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, \ttt{?lhef\_write\_sqme\_ref}, ' // &
	'\newline \ttt{?lhef\_write\_sqme\_alt})'))
	call var_list%append_log (var_str ("?lhef_write_sqme_ref"), .false., &
	intrinsic = .true., &
	description=var_str ('Flag that decides whether in the ($\to$) ' // &
	'\ttt{lhef} event format reference weights of the squared matrix ' // &
	'element shall be written in the LHE file. (cf. also \ttt{\$sample}, ' // &
	'\ttt{sample\_format}, \ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // &
	'\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_alt})'))
	call var_list%append_log (var_str ("?lhef_write_sqme_alt"), .true., &
	intrinsic = .true., &
	description=var_str ('Flag that decides whether in the ($\to$) ' // &
	'\ttt{lhef} event format alternative weights of the squared matrix ' // &
	'element shall be written in the LHE file. (cf. also \ttt{\$sample}, ' // &
	'\ttt{sample\_format}, \ttt{lhef}, \ttt{\$lhef\_extension}, \ttt{\$lhef\_extension}, ' // &
	'\ttt{?lhef\_write\_sqme\_prc}, \ttt{?lhef\_write\_sqme\_ref})'))
	call var_list%append_string (var_str ("$extension_lha"), var_str ("lha"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_lha ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the (deprecated) LHA format are written. ' // &
	'If not set, the default file name and suffix is \ttt{{\em <process\_name>}.lha}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
	call var_list%append_string (var_str ("$extension_hepmc"), var_str ("hepmc"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_hepmc ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the HepMC format are written. If not set, ' // &
	'the default file name and suffix is \ttt{{\em <process\_name>}.hepmc}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
	call var_list%append_log (var_str ("?hepmc_output_cross_section"), .false., &
	intrinsic = .true., &
	description=var_str ('Flag for the HepMC event format that allows ' // &
	'to write out the cross section (and error) from the integration ' // &
	'together with each HepMC event. This can be used by programs ' // &
	'like Rivet to scale histograms according to the cross section. ' // &
	'(cf. also \ttt{hepmc})'))
	call var_list%append_string (var_str ("$extension_lcio"), var_str ("slcio"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_lcio ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the LCIO format are written. If not set, ' // &
	'the default file name and suffix is \ttt{{\em <process\_name>}.slcio}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
	call var_list%append_string (var_str ("$extension_stdhep"), var_str ("hep"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_stdhep ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the StdHEP format via the HEPEVT common ' // &
	'block are written. If not set, the default file name and suffix ' // &
	'is \ttt{{\em <process\_name>}.hep}. (cf. also \ttt{sample\_format}, ' // &
	'\ttt{\$sample})'))
	call var_list%append_string (var_str ("$extension_stdhep_up"), &
	var_str ("up.hep"), intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_stdhep\_up ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the StdHEP format via the HEPRUP/HEPEUP ' // &
	'common blocks are written. \ttt{{\em <process\_name>}.up.hep} ' // &
	'is the default file name and suffix, if this variable not set. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
	call var_list%append_string (var_str ("$extension_stdhep_ev4"), &
	var_str ("ev4.hep"), intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_stdhep\_ev4 ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the StdHEP format via the HEPEVT/HEPEV4 ' // &
	'common blocks are written. \ttt{{\em <process\_name>}.up.hep} ' // &
	'is the default file name and suffix, if this variable not set. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
	call var_list%append_string (var_str ("$extension_hepevt_verb"), &
	var_str ("hepevt.verb"), intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_hepevt\_verb ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the \whizard\ version 1 style extended or ' // &
	'verbose HEPEVT ASCII format are written. If not set, the default ' // &
	'file name and suffix is \ttt{{\em <process\_name>}.hepevt.verb}. ' // &
	'(cf. also \ttt{sample\_format}, \ttt{\$sample})'))
	call var_list%append_string (var_str ("$extension_lha_verb"), &
	var_str ("lha.verb"), intrinsic=.true., &
	description=var_str ('String variable that allows via \ttt{\$extension\_lha\_verb ' // &
	'= "{\em <suffix>}"} to specify the suffix for the file \ttt{name.suffix} ' // &
	'to which events in the (deprecated) extended or verbose LHA ' // &
	'format are written. If not set, the default file name and suffix ' // &
	'is \ttt{{\em <process\_name>}.lha.verb}. (cf. also \ttt{sample\_format}, ' // &
	'\ttt{\$sample})'))
	end subroutine var_list_set_eio_defaults

	@ %def var_list_set_eio_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_shower_defaults => var_list_set_shower_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_shower_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_log (var_str ("?allow_shower"), .true., &
	intrinsic=.true., &
	description=var_str ('Master flag to switch on (initial and ' // &
	'final state) parton shower, matching/merging as an event ' // &
	'transform. As a default, it is switched on. (cf. also \ttt{?ps\_ ' // &
	'....}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_log (var_str ("?ps_fsr_active"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that switches final-state QCD radiation ' // &
	'(FSR) on. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // &
	'\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_log (var_str ("?ps_isr_active"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag that switches initial-state QCD ' // &
	'radiation (ISR) on. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
	'...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_log (var_str ("?ps_taudec_active"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag to switch on $\tau$ decays, at ' // &
	'the moment only via the included external package \ttt{TAUOLA} ' // &
	'and \ttt{PHOTOS}. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
	'...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_log (var_str ("?muli_active"), .false., &
	intrinsic=.true., &
	description=var_str ("Master flag that switches on \whizard's " // &
	'module for multiple interaction with interleaved QCD parton ' // &
	'showers for hadron colliders. Note that this feature is still ' // &
	'experimental. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
	'...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...})'))
	call var_list%append_string (var_str ("$shower_method"), var_str ("WHIZARD"), &
	intrinsic=.true., &
	description=var_str ('String variable that allows to specify ' // &
	'which parton shower is being used, the default, \ttt{"WHIZARD"}, ' // &
	'is one of the in-house showers of \whizard. Other possibilities ' // &
	'at the moment are only \ttt{"PYTHIA6"}.'))
	call var_list%append_log (var_str ("?shower_verbose"), .false., &
	intrinsic=.true., &
	description=var_str ('Flag to switch on verbose messages when ' // &
	'using shower and/or hadronization. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...},'))
	call var_list%append_string (var_str ("$ps_PYTHIA_PYGIVE"), var_str (""), &
	intrinsic=.true., &
	description=var_str ('String variable that allows to pass options ' // &
	'for tunes etc. to the attached \pythia\ parton shower or hadronization, ' // &
	'e.g.: \ttt{\$ps\_PYTHIA\_PYGIVE = "MSTJ(41)=1"}. (cf. also ' // &
	'\newline \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
	'...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	+ call var_list%append_string (var_str ("$ps_PYTHIA8_config"), var_str (""), &
	+ intrinsic=.true., &
	+ description=var_str ('String variable that allows to pass options ' // &
	+ 'for tunes etc. to the attached \pythia\ttt{8} parton shower or hadronization, ' // &
	+ 'e.g.: \ttt{\$ps\_PYTHIA8\_config = "PartonLevel:MPI = off"}. (cf. also ' // &
	+ '\newline \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
	+ '...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	+ call var_list%append_string (var_str ("$ps_PYTHIA8_config_file"), var_str (""), &
	+ intrinsic=.true., &
	+ description=var_str ('String variable that allows to pass a filename to a ' // &
	+ '\pythia\ttt{8} configuration file.'))
	call var_list%append_real (&
	var_str ("ps_mass_cutoff"), 1._default, intrinsic = .true., &
	description=var_str ('Real value that sets the QCD parton shower ' // &
	'lower cutoff scale, where hadronization sets in. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (&
	var_str ("ps_fsr_lambda"), 0.29_default, intrinsic = .true., &
	description=var_str ('By this real parameter, the value of $\Lambda_{QCD}$ ' // &
	'used in running $\alpha_s$ for time-like showers is set (except ' // &
	'for showers in the decay of a resonance). (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (&
	var_str ("ps_isr_lambda"), 0.29_default, intrinsic = .true., &
	description=var_str ('By this real parameter, the value of $\Lambda_{QCD}$ ' // &
	'used in running $\alpha_s$ for space-like showers is set. (cf. ' // &
	'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
	'\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_int (&
	var_str ("ps_max_n_flavors"), 5, intrinsic = .true., &
	description=var_str ('This integer parameter sets the maxmimum ' // &
	'number of flavors that can be produced in a QCD shower $g\to ' // &
	'q\bar q$. It is also used as the maximal number of active flavors ' // &
	'for the running of $\alpha_s$ in the shower (with a minimum ' // &
	'of 3). (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
	'...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_log (var_str ("?ps_isr_alphas_running"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether a running ' // &
	'$\alpha_s$ is taken in space-like QCD parton showers. (cf. ' // &
	'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
	'\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_log (var_str ("?ps_fsr_alphas_running"), .true., &
	intrinsic=.true., &
	description=var_str ('Flag that decides whether a running ' // &
	'$\alpha_s$ is taken in time-like QCD parton showers. (cf. ' // &
	'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
	'\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str ("ps_fixed_alphas"), &
	0._default, intrinsic = .true., &
	description=var_str ('This real parameter sets the value of $\alpha_s$ ' // &
	'if it is (cf. $\to$ \ttt{?ps\_isr\_alphas\_running}, \newline ' // &
	'\ttt{?ps\_fsr\_alphas\_running}) not running in initial and/or ' // &
	'final-state QCD showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
	'...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_log (var_str ("?ps_isr_pt_ordered"), .false., &
	intrinsic=.true., &
	description=var_str ('By this flag, it can be switched between ' // &
	'the analytic QCD ISR shower (\ttt{false}, default) and the ' // &
	'$p_T$ ISR QCD shower (\ttt{true}). (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_log (var_str ("?ps_isr_angular_ordered"), .true., &
	intrinsic=.true., &
	description=var_str ('If switched one, this flag forces opening ' // &
	'angles of emitted partons in the QCD ISR shower to be strictly ' // &
	'ordered, i.e. increasing towards the hard interaction. (cf. ' // &
	'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
	'\ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("ps_isr_primordial_kt_width"), 0._default, intrinsic = .true., &
	description=var_str ('This real parameter sets the width $\sigma ' // &
	'= \braket{k_T^2}$ for the Gaussian primordial $k_T$ distribution ' // &
	'inside the hadron, given by: $\exp[-k_T^2/\sigma^2] k_T dk_T$. ' // &
	'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
	'...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("ps_isr_primordial_kt_cutoff"), 5._default, intrinsic = .true., &
	description=var_str ('Real parameter that sets the upper cutoff ' // &
	'for the primordial $k_T$ distribution inside a hadron. (cf. ' // &
	'also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, ' // &
	'\ttt{?hadronization\_active}, \ttt{?mlm\_ ...})'))
	call var_list%append_real (var_str &
	("ps_isr_z_cutoff"), 0.999_default, intrinsic = .true., &
	description=var_str ('This real parameter allows to set the upper ' // &
	'cutoff on the splitting variable $z$ in space-like QCD parton ' // &
	'showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // &
	'\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("ps_isr_minenergy"), 1._default, intrinsic = .true., &
	description=var_str ('By this real parameter, the minimal effective ' // &
	'energy (in the c.m. frame) of a time-like or on-shell-emitted ' // &
	'parton in a space-like QCD shower is set. For a hard subprocess ' // &
	'that is not in the rest frame, this number is roughly reduced ' // &
	'by a boost factor $1/\gamma$ to the rest frame of the hard scattering ' // &
	'process. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // &
	'\ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("ps_isr_tscalefactor"), 1._default, intrinsic = .true., &
	description=var_str ('The $Q^2$ scale of the hard scattering ' // &
	'process is multiplied by this real factor to define the maximum ' // &
	'parton virtuality allowed in time-like QCD showers. This does ' // &
	'only apply to $t$- and $u$-channels, while for $s$-channel resonances ' // &
	'the maximum virtuality is set by $m^2$. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_log (var_str &
	("?ps_isr_only_onshell_emitted_partons"), .false., intrinsic=.true., &
	description=var_str ('This flag if set true sets all emitted ' // &
	'partons off space-like showers on-shell, i.e. it would not allow ' // &
	'associated time-like showers. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?hadronization\_active})'))
	end subroutine var_list_set_shower_defaults

	@ %def var_list_set_shower_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_hadronization_defaults => var_list_set_hadronization_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_hadronization_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_log &
	(var_str ("?allow_hadronization"), .true., intrinsic=.true., &
	description=var_str ('Master flag to switch on hadronization ' // &
	'as an event transform. As a default, it is switched on. (cf. ' // &
	'also \ttt{?ps\_ ....}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, ' // &
	'\ttt{?hadronization\_active})'))
	call var_list%append_log &
	(var_str ("?hadronization_active"), .false., intrinsic=.true., &
	description=var_str ('Master flag to switch hadronization (through ' // &
	'the attached \pythia\ package) on or off. As a default, it is ' // &
	'off. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
	'...}, \ttt{?mlm\_ ...})'))
	call var_list%append_string &
	(var_str ("$hadronization_method"), var_str ("PYTHIA6"), intrinsic = .true., &
	description=var_str ("Determines whether \whizard's own " // &
	"hadronization or the (internally included) \pythiasix\ should be used."))
	call var_list%append_real &
	(var_str ("hadron_enhanced_fraction"), 0.01_default, intrinsic = .true., &
	description=var_str ('Fraction of Lund strings that break with enhanced ' // &
	'width. [not yet active]'))
	call var_list%append_real &
	(var_str ("hadron_enhanced_width"), 2.0_default, intrinsic = .true., &
	description=var_str ('Enhancement factor for the width of breaking ' // &
	'Lund strings. [not yet active]'))
	end subroutine var_list_set_hadronization_defaults

	@ %def var_list_set_hadronization_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_tauola_defaults => var_list_set_tauola_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_tauola_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_log (&
	var_str ("?ps_tauola_photos"), .false., intrinsic=.true., &
	description=var_str ('Flag to switch on \ttt{PHOTOS} for photon ' // &
	'showering inside the \ttt{TAUOLA} package. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
	call var_list%append_log (&
	var_str ("?ps_tauola_transverse"), .false., intrinsic=.true., &
	description=var_str ('Flag to switch transverse $\tau$ polarization ' // &
	'on or off for Higgs decays into $\tau$ leptons. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
	call var_list%append_log (&
	var_str ("?ps_tauola_dec_rad_cor"), .true., intrinsic=.true., &
	description=var_str ('Flag to switch radiative corrections for ' // &
	'$\tau$ decays in \ttt{TAUOLA} on or off. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
	call var_list%append_int (&
	var_str ("ps_tauola_dec_mode1"), 0, intrinsic = .true., &
	description=var_str ('Integer code to request a specific $\tau$ ' // &
	'decay within \ttt{TAUOLA} for the decaying $\tau$, and -- ' // &
	'in correlated decays -- for the second $\tau$. For more information ' // &
	'cf. the comments in the code or the \ttt{TAUOLA} manual. ' // &
	'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
	'...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
	call var_list%append_int (&
	var_str ("ps_tauola_dec_mode2"), 0, intrinsic = .true., &
	description=var_str ('Integer code to request a specific $\tau$ ' // &
	'decay within \ttt{TAUOLA} for the decaying $\tau$, and -- ' // &
	'in correlated decays -- for the second $\tau$. For more information ' // &
	'cf. the comments in the code or the \ttt{TAUOLA} manual. ' // &
	'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
	'...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
	call var_list%append_real (&
	var_str ("ps_tauola_mh"), 125._default, intrinsic = .true., &
	description=var_str ('Real option to set the Higgs mass for Higgs ' // &
	'decays into $\tau$ leptons in the interface to \ttt{TAUOLA}. ' // &
	'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
	'...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
	call var_list%append_real (&
	var_str ("ps_tauola_mix_angle"), 90._default, intrinsic = .true., &
	description=var_str ('Option to set the mixing angle between ' // &
	'scalar and pseudoscalar Higgs bosons for Higgs decays into $\tau$ ' // &
	'leptons in the interface to \ttt{TAUOLA}. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
	call var_list%append_log (&
	var_str ("?ps_tauola_pol_vector"), .false., intrinsic = .true., &
	description=var_str ('Flag to decide whether for transverse $\tau$ ' // &
	'polarization, polarization information should be taken from ' // &
	'\ttt{TAUOLA} or not. The default is just based on random numbers. ' // &
	'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
	'...}, \ttt{?mlm\_ ...}, \ttt{?ps\_taudec\_active})'))
	end subroutine var_list_set_tauola_defaults

	@ %def var_list_set_tauola_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_mlm_matching_defaults => var_list_set_mlm_matching_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_mlm_matching_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_log (var_str ("?mlm_matching"), .false., &
	intrinsic=.true., &
	description=var_str ('Master flag to switch on MLM (LO) jet ' // &
	'matching between hard matrix elements and the QCD parton ' // &
	'shower. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, ' // &
	'\ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("mlm_Qcut_ME"), 0._default, intrinsic = .true., &
	description=var_str ('Real parameter that in the MLM jet matching ' // &
	'between hard matrix elements and QCD parton shower sets a possible ' // &
	'virtuality cut on jets from the hard matrix element. (cf. also ' // &
	'\ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ' // &
	'...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("mlm_Qcut_PS"), 0._default, intrinsic = .true., &
	description=var_str ('Real parameter that in the MLM jet matching ' // &
	'between hard matrix elements and QCD parton shower sets a possible ' // &
	'virtuality cut on jets from the parton shower. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("mlm_ptmin"), 0._default, intrinsic = .true., &
	description=var_str ('This real parameter sets a minimal $p_T$ ' // &
	'that enters the $y_{cut}$ jet clustering measure in the MLM ' // &
	'jet matching between hard matrix elements and QCD parton showers. ' // &
	'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
	'...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("mlm_etamax"), 0._default, intrinsic = .true., &
	description=var_str ('This real parameter sets a maximal pseudorapidity ' // &
	'that enters the MLM jet matching between hard matrix elements ' // &
	'and QCD parton showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
	'...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("mlm_Rmin"), 0._default, intrinsic = .true., &
	description=var_str ('Real parameter that sets a minimal $R$ ' // &
	'distance value that enters the $y_{cut}$ jet clustering measure ' // &
	'in the MLM jet matching between hard matrix elements and QCD ' // &
	'parton showers. (cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ' // &
	'...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("mlm_Emin"), 0._default, intrinsic = .true., &
	description=var_str ('Real parameter that sets a minimal energy ' // &
	'$E_{min}$ value as an infrared cutoff in the MLM jet matching ' // &
	'between hard matrix elements and QCD parton showers. (cf. also ' // &
	'\ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ' // &
	'...}, \ttt{?hadronization\_active})'))
	call var_list%append_int (var_str &
	("mlm_nmaxMEjets"), 0, intrinsic = .true., &
	description=var_str ('This integer sets the maximal number of ' // &
	'jets that are available from hard matrix elements in the MLM ' // &
	'jet matching between hard matrix elements and QCD parton shower. ' // &
	'(cf. also \ttt{?allow\_shower}, \ttt{?ps\_ ...}, \ttt{\$ps\_ ' // &
	'...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("mlm_ETclusfactor"), 0.2_default, intrinsic = .true., &
	description=var_str ('This real parameter is a factor that enters ' // &
	'the calculation of the $y_{cut}$ measure for jet clustering ' // &
	'after the parton shower in the MLM jet matching between hard ' // &
	'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("mlm_ETclusminE"), 5._default, intrinsic = .true., &
	description=var_str ('This real parameter is a minimal energy ' // &
	'that enters the calculation of the $y_{cut}$ measure for jet ' // &
	'clustering after the parton shower in the MLM jet matching between ' // &
	'hard matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("mlm_etaclusfactor"), 1._default, intrinsic = .true., &
	description=var_str ('This real parameter is a factor that enters ' // &
	'the calculation of the $y_{cut}$ measure for jet clustering ' // &
	'after the parton shower in the MLM jet matching between hard ' // &
	'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("mlm_Rclusfactor"), 1._default, intrinsic = .true., &
	description=var_str ('This real parameter is a factor that enters ' // &
	'the calculation of the $y_{cut}$ measure for jet clustering ' // &
	'after the parton shower in the MLM jet matching between hard ' // &
	'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))
	call var_list%append_real (var_str &
	("mlm_Eclusfactor"), 1._default, intrinsic = .true., &
	description=var_str ('This real parameter is a factor that enters ' // &
	'the calculation of the $y_{cut}$ measure for jet clustering ' // &
	'after the parton shower in the MLM jet matching between hard ' // &
	'matrix elements and QCD parton showers. (cf. also \ttt{?allow\_shower}, ' // &
	'\ttt{?ps\_ ...}, \ttt{\$ps\_ ...}, \ttt{mlm\_ ...}, \ttt{?hadronization\_active})'))

	end subroutine var_list_set_mlm_matching_defaults

	@ %def var_list_set_mlm_matching_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_powheg_matching_defaults => &
	var_list_set_powheg_matching_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_powheg_matching_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_log (var_str ("?powheg_matching"), &
	.false., intrinsic = .true., &
	description=var_str ('Activates Powheg matching. Needs to be ' // &
	'combined with the \ttt{?combined\_nlo\_integration}-method.'))
	call var_list%append_log (var_str ("?powheg_use_singular_jacobian"), &
	.false., intrinsic = .true., &
	description=var_str ('This allows to give a different ' // &
	'normalization of the Jacobian, resulting in an alternative ' // &
	'POWHEG damping in the singular regions.'))
	call var_list%append_int (var_str ("powheg_grid_size_xi"), &
	5, intrinsic = .true., &
	description=var_str ('Number of $\xi$ points in the POWHEG grid.'))
	call var_list%append_int (var_str ("powheg_grid_size_y"), &
	5, intrinsic = .true., &
	description=var_str ('Number of $y$ points in the POWHEG grid.'))
	call var_list%append_int (var_str ("powheg_grid_sampling_points"), &
	500000, intrinsic = .true., &
	description=var_str ('Number of calls used to initialize the ' // &
	'POWHEG grid.'))
	call var_list%append_real (var_str ("powheg_pt_min"), &
	1._default, intrinsic = .true., &
	description=var_str ('Lower $p_T$-cut-off for the POWHEG ' // &
	'hardest emission.'))
	call var_list%append_real (var_str ("powheg_lambda"), &
	LAMBDA_QCD_REF, intrinsic = .true., &
	description=var_str ('Reference scale of the $\alpha_s$ evolution ' // &
	'in the POWHEG matching algorithm.'))
	call var_list%append_log (var_str ("?powheg_rebuild_grids"), &
	.false., intrinsic = .true., &
	description=var_str ('If set to \ttt{true}, the existing POWHEG ' // &
	'grid is discarded and a new one is generated.'))
	call var_list%append_log (var_str ("?powheg_test_sudakov"), &
	.false., intrinsic = .true., &
	description=var_str ('Performs an internal consistency check ' // &
	'on the POWHEG event generation.'))
	call var_list%append_log (var_str ("?powheg_disable_sudakov"), &
	.false., intrinsic = .true., &
	description=var_str ('This flag allows to set the Sudakov form ' // &
	'factor to one. This effectively results in a version of ' // &
	'the matrix-element method (MEM) at NLO.'))
	end subroutine var_list_set_powheg_matching_defaults

	@ %def var_list_set_powheg_matching_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_openmp_defaults => var_list_set_openmp_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_openmp_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_log (var_str ("?omega_openmp"), &
	openmp_is_active (), &
	intrinsic=.true., &
	description=var_str ('Flag to switch on or off OpenMP multi-threading ' // &
	"for \oMega\ matrix elements. (cf. also \ttt{\$method}, \ttt{\$omega\_flag})"))
	call var_list%append_log (var_str ("?openmp_is_active"), &
	openmp_is_active (), &
	locked=.true., intrinsic=.true., &
	description=var_str ('Flag to switch on or off OpenMP multi-threading ' // &
	'for \whizard. (cf. also \ttt{?openmp\_logging}, \ttt{openmp\_num\_threads}, ' // &
	'\ttt{openmp\_num\_threads\_default}, \ttt{?omega\_openmp})'))
	call var_list%append_int (var_str ("openmp_num_threads_default"), &
	openmp_get_default_max_threads (), &
	locked=.true., intrinsic=.true., &
	description=var_str ('Integer parameter that shows the number ' // &
	'of default OpenMP threads for multi-threading. Note that this ' // &
	'parameter can only be accessed, but not reset by the user. (cf. ' // &
	'also \ttt{?openmp\_logging}, \ttt{openmp\_num\_threads}, \ttt{?omega\_openmp})'))
	call var_list%append_int (var_str ("openmp_num_threads"), &
	openmp_get_max_threads (), &
	intrinsic=.true., &
	description=var_str ('Integer parameter that sets the number ' // &
	'of OpenMP threads for multi-threading. (cf. also \ttt{?openmp\_logging}, ' // &
	'\ttt{openmp\_num\_threads\_default}, \ttt{?omega\_openmp})'))
	call var_list%append_log (var_str ("?openmp_logging"), &
	.true., intrinsic=.true., &
	description=var_str ('This logical -- when set to \ttt{false} ' // &
	'-- suppresses writing out messages about OpenMP parallelization ' // &
	'(number of used threads etc.) on screen and into the logfile ' // &
	'(default name \ttt{whizard.log}) for the whole \whizard\ run. ' // &
	'Mainly for debugging purposes. (cf. also \ttt{?logging}, ' // &
	'\ttt{?mpi\_logging})'))
	end subroutine var_list_set_openmp_defaults

	@ %def var_list_set_openmp_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_mpi_defaults => var_list_set_mpi_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_mpi_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_log (var_str ("?mpi_logging"), &
	.false., intrinsic=.true., &
	description=var_str('This logical -- when set to \ttt{false} ' // &
	'-- suppresses writing out messages about MPI parallelization ' // &
	'(number of used workers etc.) on screen and into the logfile ' // &
	'(default name \ttt{whizard.log}) for the whole \whizard\ run. ' // &
	'Mainly for debugging purposes. (cf. also \ttt{?logging}, ' // &
	'\ttt{?openmp\_logging})'))
	end subroutine var_list_set_mpi_defaults

	@ %def var_list_set_mpi_defaults
	@
	<<Variables: var list: TBP>>=
	procedure :: set_nlo_defaults => var_list_set_nlo_defaults
	<<Variables: procedures>>=
	subroutine var_list_set_nlo_defaults (var_list)
	class(var_list_t), intent(inout) :: var_list
	call var_list%append_string (var_str ("$born_me_method"), &
	var_str (""), intrinsic = .true., &
	description=var_str ("This string variable specifies the method " // &
	"for the matrix elements to be used in the evaluation of the " // &
	"Born part of the NLO computation. The default is the empty string, " // &
	"i.e. the \ttt{\$method} being the intrinsic \oMega\ matrix element " // &
	'generator (\ttt{"omega"}), other options ' // &
	'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, ' // &
	'\ttt{"template\_unity"}, \ttt{"threshold"}, \ttt{"gosam"}, ' // &
	'\ttt{"openloops"}. Note that this option is inoperative if ' // &
	'no NLO calculation is specified in the process definition. ' // &
	'If you want ot use different matrix element methods in a LO ' // &
	'computation, use the usual \ttt{method} command. (cf. also ' // &
	'\ttt{\$correlation\_me\_method}, ' // &
	'\ttt{\$dglap\_me\_method}, \ttt{\$loop\_me\_method} and ' // &
	'\ttt{\$real\_tree\_me\_method}.)'))
	call var_list%append_string (var_str ("$loop_me_method"), &
	var_str (""), intrinsic = .true., &
	description=var_str ('This string variable specifies the method ' // &
	'for the matrix elements to be used in the evaluation of the ' // &
	'virtual part of the NLO computation. The default is the empty string,' // &
	'i.e. the same as \ttt{\$method}. Working options are: ' // &
	'\ttt{"threshold"}, \ttt{"openloops"}, \ttt{"recola"}, \ttt{gosam}. ' // &
	'(cf. also \ttt{\$real\_tree\_me\_method}, \ttt{\$correlation\_me\_method} ' // &
	'and \ttt{\$born\_me\_method}.)'))
	call var_list%append_string (var_str ("$correlation_me_method"), &
	var_str (""), intrinsic = .true., &
	description=var_str ('This string variable specifies ' // &
	'the method for the matrix elements to be used in the evaluation ' // &
	'of the color (and helicity) correlated part of the NLO computation. ' // &
	"The default is the same as the \ttt{\$method}, i.e. the intrinsic " // &
	"\oMega\ matrix element generator " // &
	'(\ttt{"omega"}), other options are: \ttt{"ovm"}, \ttt{"unit\_test"}, ' // &
	'\ttt{"template"}, \ttt{"template\_unity"}, \ttt{"threshold"}, ' // &
	'\ttt{"gosam"}, \ttt{"openloops"}. (cf. also ' // &
	'\ttt{\$born\_me\_method}, \ttt{\$dglap\_me\_method}, ' // &
	'\ttt{\$loop\_me\_method} and \newline' // &
	'\ttt{\$real\_tree\_me\_method}.)'))
	call var_list%append_string (var_str ("$real_tree_me_method"), &
	var_str (""), intrinsic = .true., &
	description=var_str ('This string variable specifies the method ' // &
	'for the matrix elements to be used in the evaluation of the ' // &
	'real part of the NLO computation. The default is the same as ' // &
	'the \ttt{\$method}, i.e. the intrinsic ' // &
	"\oMega\ matrix element generator " // &
	'(\ttt{"omega"}), other options ' // &
	'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, \ttt{"template\_unity"}, ' // &
	'\ttt{"threshold"}, \ttt{"gosam"}, \ttt{"openloops"}. (cf. also ' // &
	'\ttt{\$born\_me\_method}, \ttt{\$correlation\_me\_method}, ' // &
	'\ttt{\$dglap\_me\_method} and \ttt{\$loop\_me\_method}.)'))
	call var_list%append_string (var_str ("$dglap_me_method"), &
	var_str (""), intrinsic = .true., &
	description=var_str ('This string variable specifies the method ' // &
	'for the matrix elements to be used in the evaluation of the ' // &
	'DGLAP remnants of the NLO computation. The default is the same as ' // &
	"\ttt{\$method}, i.e. the \oMega\ matrix element generator " // &
	'(\ttt{"omega"}), other options ' // &
	'are: \ttt{"ovm"}, \ttt{"unit\_test"}, \ttt{"template"}, \ttt{"template\_unity"}, ' // &
	'\ttt{"threshold"}, \ttt{"gosam"}, \ttt{"openloops"}. (cf. also \newline' // &
	'\ttt{\$born\_me\_method}, \ttt{\$correlation\_me\_method}, ' // &
	'\ttt{\$loop\_me\_method} and \ttt{\$real\_tree\_me\_method}.)'))
	call var_list%append_log (&
	var_str ("?test_soft_limit"), .false., intrinsic = .true., &
	description=var_str ('Sets the fixed values $\tilde{\xi} = 0.0001$ ' // &
	'and $y = 0.5$ as radiation variables. This way, only soft, ' // &
	'but non-collinear phase space points are generated, which allows ' // &
	'for testing subtraction in this region.'))
	call var_list%append_log (&
	var_str ("?test_coll_limit"), .false., intrinsic = .true., &
	description=var_str ('Sets the fixed values $\tilde{\xi} = 0.5$ ' // &
	'and $y = 0.999$ as radiation variables. This way, only collinear, ' // &
	'but non-soft phase space points are generated, which allows ' // &
	'for testing subtraction in this region. Can be combined with ' // &
	'\ttt{?test\_soft\_limit} to probe soft-collinear regions.'))
	call var_list%append_log (&
	var_str ("?test_anti_coll_limit"), .false., intrinsic = .true., &
	description=var_str ('Sets the fixed values $\tilde{\xi} = 0.5$ ' // &
	'and $y = -0.999$ as radiation variables. This way, only anti-collinear, ' // &
	'but non-soft phase space points are generated, which allows ' // &
	'for testing subtraction in this region. Can be combined with ' // &
	'\ttt{?test\_soft\_limit} to probe soft-collinear regions.'))
	call var_list%append_string (var_str ("$select_alpha_regions"), &
	var_str (""), intrinsic = .true., &
	description=var_str ('Fixes the $\alpha_r$ in the real ' // &
	' subtraction component. Allows for testing in one individual ' // &
	'singular region.'))
	call var_list%append_string (var_str ("$virtual_selection"), &
	var_str ("Full"), intrinsic = .true., &
	description=var_str ('String variable to select either the full ' // &
	'or only parts of the virtual components of an NLO calculation. ' // &
	'Possible modes are \ttt{"Full"}, \ttt{"OLP"} and ' // &
	'\ttt{"Subtraction."}. Mainly for debugging purposes.'))
	call var_list%append_log (var_str ("?virtual_collinear_resonance_aware"), &
	.true., intrinsic = .true., &
	description=var_str ('This flag allows to switch between two ' // &
	'different implementations of the collinear subtraction in the ' // &
	'resonance-aware FKS setup.'))
	call var_list%append_real (&
	var_str ("blha_top_yukawa"), -1._default, intrinsic = .true., &
	description=var_str ('If this value is set, the given value will ' // &
	'be used as the top Yukawa coupling instead of the top mass. ' // &
	'Note that having different values for $y_t$ and $m_t$ must be ' // &
	'supported by your OLP-library and yield errors if this is not the case.'))
	call var_list%append_string (var_str ("$blha_ew_scheme"), &
	var_str ("alpha_qed"), intrinsic = .true., &
	description=var_str ('String variable that transfers the electroweak ' // &
	'renormalization scheme via BLHA to the one-loop provider. Possible ' // &
	'values are \ttt{GF} or \ttt{Gmu} for the $G_\mu$ scheme, ' // &
	'\ttt{alpha\_qed}, \ttt{alpha\_mz} and \ttt{alpha\_0} or ' // &
	'\ttt{alpha\_thompson} for different schemes with $\alpha$ as input.'))
	call var_list%append_int (var_str ("openloops_verbosity"), 1, &
	intrinsic = .true., &
	description=var_str ('Decides how much \openloops output is printed. ' // &
	'Can have values 0, 1 and 2, where 2 is the highest verbosity level.'))
	call var_list%append_log (var_str ("?openloops_use_cms"), &
	.true., intrinsic = .true., &
	description=var_str ('Activates the complex mass scheme in ' // &
	'\openloops. (cf. also ' // &
	'\ttt{openloos\_verbosity}, \ttt{\$method}, ' // &
	'\ttt{?openloops\_switch\_off\_muon\_yukawa}, ' // &
	'\ttt{openloops\_stability\_log}, \newline' // &
	'\ttt{\$openloops\_extra\_cmd})'))
	call var_list%append_int (var_str ("openloops_phs_tolerance"), 7, &
	intrinsic = .true., &
	description=var_str ('This integer parameter gives via ' // &
	'\ttt{openloops\_phs\_tolerance = <n>} the relative numerical ' // &
	'tolerance $10^{-n}$ for the momentum conservation of the ' // &
	'external particles within \openloops. (cf. also ' // &
	'\ttt{openloos\_verbosity}, \ttt{\$method}, ' // &
	'\ttt{?openloops\_switch\_off\_muon\_yukawa}, ' // &
	'\newline\ttt{openloops\_stability\_log}, ' // &
	'\ttt{\$openloops\_extra\_cmd})'))
	call var_list%append_int (var_str ("openloops_stability_log"), 0, &
	intrinsic = .true., &
	description=var_str ('Creates the directory \ttt{stability\_log} ' // &
	'containing information about the performance of the \openloops ' // &
	'matrix elements. Possible values are 0 (No output), 1 (On ' // &
	'\ttt{finish()}-call), 2 (Adaptive) and 3 (Always).'))
	call var_list%append_log (var_str ("?openloops_switch_off_muon_yukawa"), &
	.false., intrinsic = .true., &
	description=var_str ('Sets the Yukawa coupling of muons for ' // &
	'\openloops\ to zero. (cf. also ' // &
	'\ttt{openloos\_verbosity}, \ttt{\$method}, ' // &
	'\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // &
	'\ttt{\$openloops\_extra\_cmd})'))
	call var_list%append_string (var_str ("$openloops_extra_cmd"), &
	var_str (""), intrinsic = .true., &
	description=var_str ('String variable to transfer customized ' // &
	'special commands to \openloops. The three supported examples ' // &
	'\ttt{\$openloops\_extra\_command = "extra approx top/stop/not"} ' // &
	'are for selection of subdiagrams in top production. (cf. also ' // &
	'\ttt{\$method}, \ttt{openloos\_verbosity}, ' // &
	'\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // &
	'\ttt{?openloops\_switch\_off\_muon\_yukawa})'))
	call var_list%append_log (var_str ("?openloops_use_collier"), &
	.true., intrinsic = .true., &
	description=var_str ('Use \collier\ as the reduction method of ' // &
	'\openloops. Otherwise, \ttt{CutTools} will be used. (cf. also ' // &
	'\ttt{\$method}, \ttt{openloos\_verbosity}, ' // &
	'\ttt{?openloops\_use\_cms}, \ttt{openloops\_stability\_log}, ' // &
	'\ttt{?openloops\_switch\_off\_muon\_yukawa})'))
	call var_list%append_log (var_str ("?disable_subtraction"), &
	.false., intrinsic = .true., &
	description=var_str ('Disables the subtraction of soft and collinear ' // &
	'divergences from the real matrix element.'))
	call var_list%append_real (var_str ("fks_dij_exp1"), &
	1._default, intrinsic = .true., &
	description=var_str ('Fine-tuning parameters of the FKS ' // &
	'partition functions. The exact meaning depends on the mapping ' // &
	'implementation. (cf. also \ttt{fks\_dij\_exp2}, ' // &
	'\ttt{\$fks\_mapping\_type}, \ttt{fks\_xi\_min}, \ttt{fks\_y\_max})'))
	call var_list%append_real (var_str ("fks_dij_exp2"), &
	1._default, intrinsic = .true., &
	description=var_str ('Fine-tuning parameters of the FKS ' // &
	'partition functions. The exact meaning depends on the mapping ' // &
	'implementation. (cf. also \ttt{fks\_dij\_exp1}, ' // &
	'\ttt{\$fks\_mapping\_type}, \ttt{fks\_xi\_min}, \ttt{fks\_y\_max})'))
	call var_list%append_real (var_str ("fks_xi_min"), &
	0.0000001_default, intrinsic = .true., &
	description=var_str ('Real parameter for the FKS ' // &
	'phase space that sets the numerical lower value of the $\xi$ ' // &
	'variable. (cf. also \ttt{fks\_dij\_exp1}, ' // &
	'\ttt{fks\_dij\_exp2}, \ttt{\$fks\_mapping\_type}, \ttt{fks\_y\_max})'))
	call var_list%append_real (var_str ("fks_y_max"), &
	1._default, intrinsic = .true., &
	description=var_str ('Real parameter for the FKS ' // &
	'phase space that sets the numerical upper value of the $y$ ' // &
	'variable. (cf. also \ttt{fks\_dij\_exp1}, ' // &
	'\ttt{\$fks\_mapping\_type}, \ttt{fks\_dij\_exp2}, \ttt{fks\_y\_max})'))
	call var_list%append_log (var_str ("?vis_fks_regions"), &
	.false., intrinsic = .true., &
	description=var_str ('Logical variable that, if set to ' // &
	'\ttt{true}, generates \LaTeX\ code and executes it into a PDF ' // &
	' to produce a table of all singular FKS regions and their ' // &
	' flavor structures. The default is \ttt{false}.'))
	call var_list%append_real (var_str ("fks_xi_cut"), &
	1.0_default, intrinsic = .true., &
	description = var_str ('Real paramter for the FKS ' // &
	'phase space that applies a cut to $\xi$ variable with $0 < \xi_{\text{cut}}' // &
	'\leq \xi_{\text{max}}$. The dependence on the parameter vanishs between ' // &
	'real subtraction and integrated subtraction term.'))
	call var_list%append_real (var_str ("fks_delta_zero"), &
	2._default, intrinsic = .true., &
	description = var_str ('Real paramter for the FKS ' // &
	'phase space that applies a cut to the $y$ variable with $0 < \delta_0 \leq 2$. ' // &
	'The dependence on the parameter vanishs between real subtraction and integrated' // &
	'subtraction term.'))
	call var_list%append_real (var_str ("fks_delta_i"), &
	2._default, intrinsic = .true., &
	description = var_str ('Real paramter for the FKS ' // &
	'phase space that applies a cut to the $y$ variable with $0 < \delta_{\mathrm{I}} \leq 2$ '// &
	'for initial state singularities only. ' // &
	'The dependence on the parameter vanishs between real subtraction and integrated' // &
	'subtraction term.'))
	call var_list%append_string (var_str ("$fks_mapping_type"), &
	var_str ("default"), intrinsic = .true., &
	description=var_str ('Sets the FKS mapping type. Possible values ' // &
	'are \ttt{"default"} and \ttt{"resonances"}. The latter option ' // &
	'activates the resonance-aware subtraction mode and induces the ' // &
	'generation of a soft mismatch component. (cf. also ' // &
	'\ttt{fks\_dij\_exp1}, \ttt{fks\_dij\_exp2}, \ttt{fks\_xi\_min}, ' // &
	'\ttt{fks\_y\_max})'))
	call var_list%append_string (var_str ("$resonances_exclude_particles"), &
	var_str ("default"), intrinsic = .true., &
	description=var_str ('Accepts a string of particle names. These ' // &
	'particles will be ignored when the resonance histories are generated. ' // &
	'If \ttt{\$fks\_mapping\_type} is not \ttt{"resonances"}, this ' // &
	'option does nothing.'))
	call var_list%append_int (var_str ("alpha_power"), &
	2, intrinsic = .true., &
	description=var_str ('Fixes the electroweak coupling ' // &
	'powers used by BLHA matrix element generators. Setting these ' // &
	'values is necessary for the correct generation of OLP-files. ' // &
	'Having inconsistent values yields to error messages by the corresponding ' // &
	'OLP-providers.'))
	call var_list%append_int (var_str ("alphas_power"), &
	0, intrinsic = .true., &
	description=var_str ('Fixes the strong coupling ' // &
	'powers used by BLHA matrix element generators. Setting these ' // &
	'values is necessary for the correct generation of OLP-files. ' // &
	'Having inconsistent values yields to error messages by the corresponding ' // &
	'OLP-providers.'))
	call var_list%append_log (var_str ("?combined_nlo_integration"), &
	.false., intrinsic = .true., &
	description=var_str ('When this option is set to \ttt{true}, ' // &
	'the NLO integration will not be performed in the separate components, ' // &
	'but instead the sum of all components will be integrated directly. ' // &
	'When fixed-order NLO events are requested, this integration ' // &
	'mode is possible, but not necessary. However, it is necessary ' // &
	'for POWHEG events.'))
	call var_list%append_log (var_str ("?fixed_order_nlo_events"), &
	.false., intrinsic = .true., &
	description=var_str ('Induces the generation of fixed-order ' // &
	'NLO events. Deprecated name: \ttt{?nlo\_fixed\_order}.'))
	call var_list%append_log (var_str ("?check_event_weights_against_xsection"), &
	.false., intrinsic = .true., &
	description=var_str ('Activates an internal recording of event ' // &
	'weights when unweighted events are generated. At the end of ' // &
	'the simulation, the mean value of the weights and its standard ' // &
	'deviation are displayed. This allows to cross-check event generation ' // &
	'and integration, because the value displayed must be equal to ' // &
	'the integration result.'))
	call var_list%append_log (var_str ("?keep_failed_events"), &
	.false., intrinsic = .true., &
	description=var_str ('In the context of weighted event generation, ' // &
	'if set to \ttt{true}, events with failed kinematics will be ' // &
	'written to the event output with an associated weight of zero. ' // &
	'This way, the total cross section can be reconstructed from the event output.'))
	call var_list%append_int (var_str ("gks_multiplicity"), &
	0, intrinsic = .true., &
	description=var_str ('Jet multiplicity for the GKS merging scheme.'))
	call var_list%append_string (var_str ("$gosam_filter_lo"), &
	var_str (""), intrinsic = .true., &
	description=var_str ('The filter string given to \gosam\ in order to ' // &
	'filter out tree-level diagrams. (cf. also \ttt{\$gosam\_filter\_nlo}, ' // &
	'\ttt{\$gosam\_symmetries})'))
	call var_list%append_string (var_str ("$gosam_filter_nlo"), &
	var_str (""), intrinsic = .true., &
	description=var_str ('The same as \ttt{\$gosam\_filter\_lo}, but for ' // &
	'loop matrix elements. (cf. also \ttt{\$gosam\_filter\_nlo}, ' // &
	'\ttt{\$gosam\_symmetries})'))
	call var_list%append_string (var_str ("$gosam_symmetries"), &
	var_str ("family,generation"), intrinsic = .true., &
	description=var_str ('String variable that is transferred to \gosam\ ' // &
	'configuration file to determine whether certain helicity configurations ' // &
	'are considered to be equal. Possible values are \ttt{flavour}, ' // &
	'\ttt{family} etc. For more info see the \gosam\ manual.'))
	call var_list%append_int (var_str ("form_threads"), &
	2, intrinsic = .true., &
	description=var_str ('The number of threads used by \gosam when ' // &
	'matrix elements are evaluated using \ttt{FORM}'))
	call var_list%append_int (var_str ("form_workspace"), &
	1000, intrinsic = .true., &
	description=var_str ('The size of the workspace \gosam requires ' // &
	'from \ttt{FORM}. Inside \ttt{FORM}, it corresponds to the heap ' // &
	'size used by the algebra processor.'))
	call var_list%append_string (var_str ("$gosam_fc"), &
	var_str (""), intrinsic = .true., &
	description=var_str ('The Fortran compiler used by \gosam.'))
	call var_list%append_real (&
	var_str ("mult_call_real"), 1._default, &
	intrinsic = .true., &
	description=var_str ('(Real-valued) multiplier for the number ' // &
	'of calls used in the integration of the real subtraction ' // &
	'NLO component. This way, a higher accuracy can be achieved for ' // &
	'the real component, while simultaneously avoiding redundant ' // &
	'integration calls for the other components. (cf. also ' // &
	'\ttt{mult\_call\_dglap}, \ttt{mult\_call\_virt})'))
	call var_list%append_real (&
	var_str ("mult_call_virt"), 1._default, &
	intrinsic = .true., &
	description=var_str ('(Real-valued) multiplier for the number ' // &
	'of calls used in the integration of the virtual NLO ' // &
	'component. This way, a higher accuracy can be achieved for ' // &
	'this component, while simultaneously avoiding redundant ' // &
	'integration calls for the other components. (cf. also ' // &
	'\ttt{mult\_call\_dglap}, \ttt{mult\_call\_real})'))
	call var_list%append_real (&
	var_str ("mult_call_dglap"), 1._default, &
	intrinsic = .true., &
	description=var_str ('(Real-valued) multiplier for the number ' // &
	'of calls used in the integration of the DGLAP remnant NLO ' // &
	'component. This way, a higher accuracy can be achieved for ' // &
	'this component, while simultaneously avoiding redundant ' // &
	'integration calls for the other components. (cf. also ' // &
	'\ttt{mult\_call\_real}, \ttt{mult\_call\_virt})'))
	call var_list%append_string (var_str ("$dalitz_plot"), &
	var_str (''), intrinsic = .true., &
	description=var_str ('This string variable has two purposes: ' // &
	'when different from the empty string, it switches on generation ' // &
	'of the Dalitz plot file (ASCII tables) for the real emitters. ' // &
	'The string variable itself provides the file name.'))
	call var_list%append_string (var_str ("$nlo_correction_type"), &
	var_str ("QCD"), intrinsic = .true., &
	description=var_str ('String variable which sets the NLO correction ' // &
	'type via \ttt{nlo\_correction\_type = "{\em <type>}"} to either ' // &
	'\ttt{"QCD"} or \ttt{"QED"}, or to both with \ttt{\em{<type>}} ' // &
	'set to \ttt{"Full"}.'))
	call var_list%append_string (var_str ("$exclude_gauge_splittings"), &
	var_str ("c:b:t:e2:e3"), intrinsic = .true., &
	description=var_str ('String variable that allows via ' // &
	'\ttt{\$exclude\_gauge\_splittings = "{\em <prt1>:<prt2>:\dots}"} ' // &
	'to exclude fermion flavors from gluon/photon splitting into ' // &
	'fermion pairs beyond LO. For example \ttt{\$exclude\_gauge\_splittings ' // &
	'= "c:s:b:t"} would lead to \ttt{gl => u U} and \ttt{gl => d ' // &
	'D} as possible splittings in QCD. It is important to keep in ' // &
	'mind that only the particles listed in the string are excluded! ' // &
	'In QED this string would additionally allow for all splittings into ' // &
	'lepton pairs \ttt{A => l L}. Therefore, once set the variable ' // &
	'acts as a replacement of the default value, not as an addition! ' // &
	'Note: \ttt{"\em <prt>"} can be both particle or antiparticle. It ' // &
	'will always exclude the corresponding fermion pair. An empty ' // &
	'string allows for all fermion flavors to take part in the splitting! ' // &
	'Also, particles included in an \ttt{alias} are not excluded by ' // &
	'\ttt{\$exclude\_gauge\_splittings}!'))
	call var_list%append_log (var_str ("?nlo_use_born_scale"), &
	.true., intrinsic = .true., &
	description=var_str ('Flag that decides whether a scale expression ' // &
	'defined for the Born component of an NLO process shall be applied ' // &
	'to all other components as well or not. ' // &
	'(cf. also \ttt{?nlo\_cut\_all\_sqmes})'))
	call var_list%append_log (var_str ("?nlo_cut_all_sqmes"), &
	.true., intrinsic = .true., &
	description=var_str ('Flag that decides whether in the case that ' // &
	'some NLO component does not pass a cut, all other components ' // &
	'shall be discarded for that phase space point as well or not. ' // &
	'(cf. also \ttt{?nlo\_use\_born\_scale})'))
	call var_list%append_log (var_str ("?nlo_use_real_partition"), &
	.false., intrinsic = .true., &
	description=var_str (' If set to \ttt{true}, the real matrix ' // &
	'element is split into a finite and a singular part using a ' // &
	'partition function $f$, such that $\mathcal{R} ' // &
	'= [1-f(p_T^2)]\mathcal{R} + f(p_T^2)\mathcal{R} = ' // &
	'\mathcal{R}_{\text{fin}} ' // &
	'+ \mathcal{R}_{\text{sing}}$. The emission ' // &
	'generation is then performed using $\mathcal{R}_{\text{sing}}$, ' // &
	'whereas $\mathcal{R}_{\text{fin}}$ is treated separately. ' // &
	'(cf. also \ttt{real\_partition\_scale})'))
	call var_list%append_real (var_str ("real_partition_scale"), &
	10._default, intrinsic = .true., &
	description=var_str ('This real variable sets the invariant mass ' // &
	'of the FKS pair used as a separator between the singular and the ' // &
	'finite part of the real subtraction terms in an NLO calculation, ' // &
	'e.g. in $e^+e^- \to ' // &
	't\bar tj$. (cf. also \ttt{?nlo\_use\_real\_partition})'))
	end subroutine var_list_set_nlo_defaults

	@ %def var_list_set_nlo_defaults
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Observables}

	In this module we define concrete variables and operators (observables)
	that we want to support in expressions.
	<<[[observables.f90]]>>=
	<<File header>>

	module observables

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use diagnostics
	use lorentz
	use subevents
	use variables

	<<Standard module head>>

	<<Observables: public>>

	contains

	<<Observables: procedures>>

	end module observables
	@ %def observables
	@
	\subsection{Process-specific variables}
	We allow the user to set a numeric process ID for each declared process.
	<<Observables: public>>=
	public :: var_list_init_num_id
	<<Observables: procedures>>=
	subroutine var_list_init_num_id (var_list, proc_id, num_id)
	type(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: proc_id
	integer, intent(in), optional :: num_id
	call var_list_set_procvar_int (var_list, proc_id, &
	var_str ("num_id"), num_id)
	end subroutine var_list_init_num_id

	@ %def var_list_init_num_id
	@
	Integration results are stored in special variables. They are
	initialized by this subroutine. The values may or may not already
	known.

	Note: the values which are accessible are those that are unique for a
	process with multiple MCI records. The rest has been discarded.
	<<Observables: public>>=
	public :: var_list_init_process_results
	<<Observables: procedures>>=
	subroutine var_list_init_process_results (var_list, proc_id, &
	n_calls, integral, error, accuracy, chi2, efficiency)
	type(var_list_t), intent(inout) :: var_list
	type(string_t), intent(in) :: proc_id
	integer, intent(in), optional :: n_calls
	real(default), intent(in), optional :: integral, error, accuracy
	real(default), intent(in), optional :: chi2, efficiency
	call var_list_set_procvar_real (var_list, proc_id, &
	var_str ("integral"), integral)
	call var_list_set_procvar_real (var_list, proc_id, &
	var_str ("error"), error)
	end subroutine var_list_init_process_results

	@ %def var_list_init_process_results
	@
	\subsection{Observables as Pseudo-Variables}
	Unary and binary observables are different. Most unary observables
	can be equally well evaluated for particle pairs. Binary observables
	cannot be evaluated for single particles.
	<<Observables: public>>=
	public :: var_list_set_observables_unary
	public :: var_list_set_observables_binary
	<<Observables: procedures>>=
	subroutine var_list_set_observables_unary (var_list, prt1)
	type(var_list_t), intent(inout) :: var_list
	type(prt_t), intent(in), target :: prt1
	call var_list_append_obs1_iptr &
	(var_list, var_str ("PDG"), obs_pdg1, prt1)
	call var_list_append_obs1_iptr &
	(var_list, var_str ("Hel"), obs_helicity1, prt1)
	call var_list_append_obs1_iptr &
	(var_list, var_str ("Ncol"), obs_n_col1, prt1)
	call var_list_append_obs1_iptr &
	(var_list, var_str ("Nacl"), obs_n_acl1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("M"), obs_signed_mass1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("M2"), obs_mass_squared1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("E"), obs_energy1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("Px"), obs_px1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("Py"), obs_py1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("Pz"), obs_pz1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("P"), obs_p1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("Pl"), obs_pl1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("Pt"), obs_pt1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("Theta"), obs_theta1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("Phi"), obs_phi1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("Rap"), obs_rap1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("Eta"), obs_eta1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("Theta_star"), obs_theta_star1, prt1)
	call var_list_append_obs1_rptr &
	(var_list, var_str ("Dist"), obs_dist1, prt1)
	call var_list_append_uobs_real &
	(var_list, var_str ("_User_obs_real"), prt1)
	call var_list_append_uobs_int &
	(var_list, var_str ("_User_obs_int"), prt1)
	end subroutine var_list_set_observables_unary

	subroutine var_list_set_observables_binary (var_list, prt1, prt2)
	type(var_list_t), intent(inout) :: var_list
	type(prt_t), intent(in), target :: prt1
	type(prt_t), intent(in), optional, target :: prt2
	call var_list_append_obs2_iptr &
	(var_list, var_str ("PDG"), obs_pdg2, prt1, prt2)
	call var_list_append_obs2_iptr &
	(var_list, var_str ("Hel"), obs_helicity2, prt1, prt2)
	call var_list_append_obs2_iptr &
	(var_list, var_str ("Ncol"), obs_n_col2, prt1, prt2)
	call var_list_append_obs2_iptr &
	(var_list, var_str ("Nacl"), obs_n_acl2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("M"), obs_signed_mass2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("M2"), obs_mass_squared2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("E"), obs_energy2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("Px"), obs_px2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("Py"), obs_py2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("Pz"), obs_pz2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("P"), obs_p2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("Pl"), obs_pl2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("Pt"), obs_pt2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("Theta"), obs_theta2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("Phi"), obs_phi2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("Rap"), obs_rap2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("Eta"), obs_eta2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("Theta_star"), obs_theta_star2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("Dist"), obs_dist2, prt1, prt2)
	call var_list_append_obs2_rptr &
	(var_list, var_str ("kT"), obs_ktmeasure, prt1, prt2)
	call var_list_append_uobs_real &
	(var_list, var_str ("_User_obs_real"), prt1, prt2)
	call var_list_append_uobs_int &
	(var_list, var_str ("_User_obs_int"), prt1, prt2)
	end subroutine var_list_set_observables_binary

	@ %def var_list_set_observables_unary var_list_set_observables_binary
	@
	\subsection{Checks}
	<<Observables: public>>=
	public :: var_list_check_observable
	<<Observables: procedures>>=
	subroutine var_list_check_observable (var_list, name, type)
	class(var_list_t), intent(in), target :: var_list
	type(string_t), intent(in) :: name
	integer, intent(inout) :: type
	if (string_is_observable_id (name)) then
	call msg_fatal ("Variable name '" // char (name) &
	// "' is reserved for an observable")
	type = V_NONE
	return
	end if
	end subroutine var_list_check_observable

	@ %def var_list_check_observable
	@
	Check if a variable name is defined as an observable:
	<<Observables: procedures>>=
	function string_is_observable_id (string) result (flag)
	logical :: flag
	type(string_t), intent(in) :: string
	select case (char (string))
	case ("PDG", "Hel", "Ncol", &
	"M", "M2", "E", "Px", "Py", "Pz", "P", "Pl", "Pt", &
	"Theta", "Phi", "Rap", "Eta", "Theta_star", "Dist", "kT")
	flag = .true.
	case default
	flag = .false.
	end select
	end function string_is_observable_id

	@ %def string_is_observable_id
	@ Check for result and process variables.
	<<Observables: public>>=
	public :: var_list_check_result_var
	<<Observables: procedures>>=
	subroutine var_list_check_result_var (var_list, name, type)
	class(var_list_t), intent(in), target :: var_list
	type(string_t), intent(in) :: name
	integer, intent(inout) :: type
	if (string_is_integer_result_var (name)) type = V_INT
	if (.not. var_list%contains (name)) then
	if (string_is_result_var (name)) then
	call msg_fatal ("Result variable '" // char (name) // "' " &
	// "set without prior integration")
	type = V_NONE
	return
	else if (string_is_num_id (name)) then
	call msg_fatal ("Numeric process ID '" // char (name) // "' " &
	// "set without process declaration")
	type = V_NONE
	return
	end if
	end if
	end subroutine var_list_check_result_var

	@ %def var_list_check_result_var
	@
	Check if a variable name is a result variable of integer type:
	<<Observables: procedures>>=
	function string_is_integer_result_var (string) result (flag)
	logical :: flag
	type(string_t), intent(in) :: string
	type(string_t) :: buffer, name, separator
	buffer = string
	call split (buffer, name, "(", separator=separator) ! ")"
	if (separator == "(") then
	select case (char (name))
	case ("num_id", "n_calls")
	flag = .true.
	case default
	flag = .false.
	end select
	else
	flag = .false.
	end if
	end function string_is_integer_result_var

	@ %def string_is_integer_result_var
	@
	Check if a variable name is an integration-result variable:
	<<Observables: procedures>>=
	function string_is_result_var (string) result (flag)
	logical :: flag
	type(string_t), intent(in) :: string
	type(string_t) :: buffer, name, separator
	buffer = string
	call split (buffer, name, "(", separator=separator) ! ")"
	if (separator == "(") then
	select case (char (name))
	case ("integral", "error")
	flag = .true.
	case default
	flag = .false.
	end select
	else
	flag = .false.
	end if
	end function string_is_result_var

	@ %def string_is_result_var
	@
	Check if a variable name is a numeric process ID:
	<<Observables: procedures>>=
	function string_is_num_id (string) result (flag)
	logical :: flag
	type(string_t), intent(in) :: string
	type(string_t) :: buffer, name, separator
	buffer = string
	call split (buffer, name, "(", separator=separator) ! ")"
	if (separator == "(") then
	select case (char (name))
	case ("num_id")
	flag = .true.
	case default
	flag = .false.
	end select
	else
	flag = .false.
	end if
	end function string_is_num_id

	@ %def string_is_num_id
	@
	\subsection{Observables}
	These are analogous to the unary and binary numeric functions listed
	above. An observable takes the [[pval]] component(s) of its one or
	two argument nodes and produces an integer or real value.

	\subsubsection{Integer-valued unary observables}
	The PDG code
	<<Observables: procedures>>=
	integer function obs_pdg1 (prt1) result (pdg)
	type(prt_t), intent(in) :: prt1
	pdg = prt_get_pdg (prt1)
	end function obs_pdg1

	@ %def obs_pdg
	@ The helicity. The return value is meaningful only if the particle
	is polarized, otherwise an invalid value is returned (-9).
	<<Observables: procedures>>=
	integer function obs_helicity1 (prt1) result (h)
	type(prt_t), intent(in) :: prt1
	if (prt_is_polarized (prt1)) then
	h = prt_get_helicity (prt1)
	else
	h = -9
	end if
	end function obs_helicity1

	@ %def obs_helicity1
	@ The number of open color (anticolor) lines. The return value is meaningful
	only if the particle is colorized (i.e., the subevent has been given color
	information), otherwise the function returns zero.
	<<Observables: procedures>>=
	integer function obs_n_col1 (prt1) result (n)
	type(prt_t), intent(in) :: prt1
	if (prt_is_colorized (prt1)) then
	n = prt_get_n_col (prt1)
	else
	n = 0
	end if
	end function obs_n_col1

	integer function obs_n_acl1 (prt1) result (n)
	type(prt_t), intent(in) :: prt1
	if (prt_is_colorized (prt1)) then
	n = prt_get_n_acl (prt1)
	else
	n = 0
	end if
	end function obs_n_acl1

	@ %def obs_n_col1
	@ %def obs_n_acl1
	@
	\subsubsection{Real-valued unary observables}
	The invariant mass squared, obtained from the separately stored value.
	<<Observables: procedures>>=
	real(default) function obs_mass_squared1 (prt1) result (p2)
	type(prt_t), intent(in) :: prt1
	p2 = prt_get_msq (prt1)
	end function obs_mass_squared1

	@ %def obs_mass_squared1
	@ The signed invariant mass, which is the signed square root of the
	previous observable.
	<<Observables: procedures>>=
	real(default) function obs_signed_mass1 (prt1) result (m)
	type(prt_t), intent(in) :: prt1
	real(default) :: msq
	msq = prt_get_msq (prt1)
	m = sign (sqrt (abs (msq)), msq)
	end function obs_signed_mass1

	@ %def obs_signed_mass1
	@ The particle energy
	<<Observables: procedures>>=
	real(default) function obs_energy1 (prt1) result (e)
	type(prt_t), intent(in) :: prt1
	e = energy (prt_get_momentum (prt1))
	end function obs_energy1

	@ %def obs_energy1
	@ Particle momentum (components)
	<<Observables: procedures>>=
	real(default) function obs_px1 (prt1) result (p)
	type(prt_t), intent(in) :: prt1
	p = vector4_get_component (prt_get_momentum (prt1), 1)
	end function obs_px1

	real(default) function obs_py1 (prt1) result (p)
	type(prt_t), intent(in) :: prt1
	p = vector4_get_component (prt_get_momentum (prt1), 2)
	end function obs_py1

	real(default) function obs_pz1 (prt1) result (p)
	type(prt_t), intent(in) :: prt1
	p = vector4_get_component (prt_get_momentum (prt1), 3)
	end function obs_pz1

	real(default) function obs_p1 (prt1) result (p)
	type(prt_t), intent(in) :: prt1
	p = space_part_norm (prt_get_momentum (prt1))
	end function obs_p1

	real(default) function obs_pl1 (prt1) result (p)
	type(prt_t), intent(in) :: prt1
	p = longitudinal_part (prt_get_momentum (prt1))
	end function obs_pl1

	real(default) function obs_pt1 (prt1) result (p)
	type(prt_t), intent(in) :: prt1
	p = transverse_part (prt_get_momentum (prt1))
	end function obs_pt1

	@ %def obs_px1 obs_py1 obs_pz1
	@ %def obs_p1 obs_pl1 obs_pt1
	@ Polar and azimuthal angle (lab frame).
	<<Observables: procedures>>=
	real(default) function obs_theta1 (prt1) result (p)
	type(prt_t), intent(in) :: prt1
	p = polar_angle (prt_get_momentum (prt1))
	end function obs_theta1

	real(default) function obs_phi1 (prt1) result (p)
	type(prt_t), intent(in) :: prt1
	p = azimuthal_angle (prt_get_momentum (prt1))
	end function obs_phi1

	@ %def obs_theta1 obs_phi1
	@ Rapidity and pseudorapidity
	<<Observables: procedures>>=
	real(default) function obs_rap1 (prt1) result (p)
	type(prt_t), intent(in) :: prt1
	p = rapidity (prt_get_momentum (prt1))
	end function obs_rap1

	real(default) function obs_eta1 (prt1) result (p)
	type(prt_t), intent(in) :: prt1
	p = pseudorapidity (prt_get_momentum (prt1))
	end function obs_eta1

	@ %def obs_rap1 obs_eta1
	@ Meaningless: Polar angle in the rest frame of the two arguments
	combined.
	<<Observables: procedures>>=
	real(default) function obs_theta_star1 (prt1) result (dist)
	type(prt_t), intent(in) :: prt1
	call msg_fatal (" 'Theta_star' is undefined as unary observable")
	dist = 0
	end function obs_theta_star1

	@ %def obs_theta_star1
	@ [Obsolete] Meaningless: Polar angle in the rest frame of the 2nd argument.
	<<XXX Observables: procedures>>=
	real(default) function obs_theta_rf1 (prt1) result (dist)
	type(prt_t), intent(in) :: prt1
	call msg_fatal (" 'Theta_RF' is undefined as unary observable")
	dist = 0
	end function obs_theta_rf1

	@ %def obs_theta_rf1
	@ Meaningless: Distance on the $\eta$-$\phi$ cylinder.
	<<Observables: procedures>>=
	real(default) function obs_dist1 (prt1) result (dist)
	type(prt_t), intent(in) :: prt1
	call msg_fatal (" 'Dist' is undefined as unary observable")
	dist = 0
	end function obs_dist1

	@ %def obs_dist1
	@
	\subsubsection{Integer-valued binary observables}
	These observables are meaningless as binary functions.
	<<Observables: procedures>>=
	integer function obs_pdg2 (prt1, prt2) result (pdg)
	type(prt_t), intent(in) :: prt1, prt2
	call msg_fatal (" PDG_Code is undefined as binary observable")
	pdg = 0
	end function obs_pdg2

	integer function obs_helicity2 (prt1, prt2) result (h)
	type(prt_t), intent(in) :: prt1, prt2
	call msg_fatal (" Helicity is undefined as binary observable")
	h = 0
	end function obs_helicity2

	integer function obs_n_col2 (prt1, prt2) result (n)
	type(prt_t), intent(in) :: prt1, prt2
	call msg_fatal (" Ncol is undefined as binary observable")
	n = 0
	end function obs_n_col2

	integer function obs_n_acl2 (prt1, prt2) result (n)
	type(prt_t), intent(in) :: prt1, prt2
	call msg_fatal (" Nacl is undefined as binary observable")
	n = 0
	end function obs_n_acl2

	@ %def obs_pdg2
	@ %def obs_helicity2
	@ %def obs_n_col2
	@ %def obs_n_acl2
	@
	\subsubsection{Real-valued binary observables}
	The invariant mass squared, obtained from the separately stored value.
	<<Observables: procedures>>=
	real(default) function obs_mass_squared2 (prt1, prt2) result (p2)
	type(prt_t), intent(in) :: prt1, prt2
	type(prt_t) :: prt
	call prt_init_combine (prt, prt1, prt2)
	p2 = prt_get_msq (prt)
	end function obs_mass_squared2

	@ %def obs_mass_squared2
	@ The signed invariant mass, which is the signed square root of the
	previous observable.
	<<Observables: procedures>>=
	real(default) function obs_signed_mass2 (prt1, prt2) result (m)
	type(prt_t), intent(in) :: prt1, prt2
	type(prt_t) :: prt
	real(default) :: msq
	call prt_init_combine (prt, prt1, prt2)
	msq = prt_get_msq (prt)
	m = sign (sqrt (abs (msq)), msq)
	end function obs_signed_mass2

	@ %def obs_signed_mass2
	@ The particle energy
	<<Observables: procedures>>=
	real(default) function obs_energy2 (prt1, prt2) result (e)
	type(prt_t), intent(in) :: prt1, prt2
	type(prt_t) :: prt
	call prt_init_combine (prt, prt1, prt2)
	e = energy (prt_get_momentum (prt))
	end function obs_energy2

	@ %def obs_energy2
	@ Particle momentum (components)
	<<Observables: procedures>>=
	real(default) function obs_px2 (prt1, prt2) result (p)
	type(prt_t), intent(in) :: prt1, prt2
	type(prt_t) :: prt
	call prt_init_combine (prt, prt1, prt2)
	p = vector4_get_component (prt_get_momentum (prt), 1)
	end function obs_px2

	real(default) function obs_py2 (prt1, prt2) result (p)
	type(prt_t), intent(in) :: prt1, prt2
	type(prt_t) :: prt
	call prt_init_combine (prt, prt1, prt2)
	p = vector4_get_component (prt_get_momentum (prt), 2)
	end function obs_py2

	real(default) function obs_pz2 (prt1, prt2) result (p)
	type(prt_t), intent(in) :: prt1, prt2
	type(prt_t) :: prt
	call prt_init_combine (prt, prt1, prt2)
	p = vector4_get_component (prt_get_momentum (prt), 3)
	end function obs_pz2

	real(default) function obs_p2 (prt1, prt2) result (p)
	type(prt_t), intent(in) :: prt1, prt2
	type(prt_t) :: prt
	call prt_init_combine (prt, prt1, prt2)
	p = space_part_norm (prt_get_momentum (prt))
	end function obs_p2

	real(default) function obs_pl2 (prt1, prt2) result (p)
	type(prt_t), intent(in) :: prt1, prt2
	type(prt_t) :: prt
	call prt_init_combine (prt, prt1, prt2)
	p = longitudinal_part (prt_get_momentum (prt))
	end function obs_pl2

	real(default) function obs_pt2 (prt1, prt2) result (p)
	type(prt_t), intent(in) :: prt1, prt2
	type(prt_t) :: prt
	call prt_init_combine (prt, prt1, prt2)
	p = transverse_part (prt_get_momentum (prt))
	end function obs_pt2

	@ %def obs_px2 obs_py2 obs_pz2
	@ %def obs_p2 obs_pl2 obs_pt2
	@ Enclosed angle and azimuthal distance (lab frame).
	<<Observables: procedures>>=
	real(default) function obs_theta2 (prt1, prt2) result (p)
	type(prt_t), intent(in) :: prt1, prt2
	p = enclosed_angle (prt_get_momentum (prt1), prt_get_momentum (prt2))
	end function obs_theta2

	real(default) function obs_phi2 (prt1, prt2) result (p)
	type(prt_t), intent(in) :: prt1, prt2
	type(prt_t) :: prt
	call prt_init_combine (prt, prt1, prt2)
	p = azimuthal_distance (prt_get_momentum (prt1), prt_get_momentum (prt2))
	end function obs_phi2

	@ %def obs_theta2 obs_phi2
	@ Rapidity and pseudorapidity distance
	<<Observables: procedures>>=
	real(default) function obs_rap2 (prt1, prt2) result (p)
	type(prt_t), intent(in) :: prt1, prt2
	p = rapidity_distance &
	(prt_get_momentum (prt1), prt_get_momentum (prt2))
	end function obs_rap2

	real(default) function obs_eta2 (prt1, prt2) result (p)
	type(prt_t), intent(in) :: prt1, prt2
	type(prt_t) :: prt
	call prt_init_combine (prt, prt1, prt2)
	p = pseudorapidity_distance &
	(prt_get_momentum (prt1), prt_get_momentum (prt2))
	end function obs_eta2

	@ %def obs_rap2 obs_eta2
	@ [This doesn't work! The principle of no common particle for momentum
	combination prohibits us from combining a decay particle with the momentum
	of its parent.] Polar angle in the rest frame of the 2nd argument.
	<<XXX Observables: procedures>>=
	real(default) function obs_theta_rf2 (prt1, prt2) result (theta)
	type(prt_t), intent(in) :: prt1, prt2
	theta = enclosed_angle_rest_frame &
	(prt_get_momentum (prt1), prt_get_momentum (prt2))
	end function obs_theta_rf2

	@ %def obs_theta_rf2
	@ Polar angle of the first particle in the rest frame of the two particles
	combined.
	<<Observables: procedures>>=
	real(default) function obs_theta_star2 (prt1, prt2) result (theta)
	type(prt_t), intent(in) :: prt1, prt2
	theta = enclosed_angle_rest_frame &
	(prt_get_momentum (prt1), &
	prt_get_momentum (prt1) + prt_get_momentum (prt2))
	end function obs_theta_star2

	@ %def obs_theta_star2
	@ Distance on the $\eta$-$\phi$ cylinder.
	<<Observables: procedures>>=
	real(default) function obs_dist2 (prt1, prt2) result (dist)
	type(prt_t), intent(in) :: prt1, prt2
	dist = eta_phi_distance &
	(prt_get_momentum (prt1), prt_get_momentum (prt2))
	end function obs_dist2

	@ %def obs_dist2
	@ Durham kT measure.
	<<Observables: procedures>>=
	real(default) function obs_ktmeasure (prt1, prt2) result (kt)
	type(prt_t), intent(in) :: prt1, prt2
	real (default) :: q2, e1, e2
	! Normalized scale to one for now! (#67)
	q2 = 1
	e1 = energy (prt_get_momentum (prt1))
	e2 = energy (prt_get_momentum (prt2))
	kt = (2/q2) * min(e12,e22) * &
	(1 - enclosed_angle_ct(prt_get_momentum (prt1), &
	prt_get_momentum (prt2)))
	end function obs_ktmeasure

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

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

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

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

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

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

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

	module su_algebra

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

	<<Standard module head>>

	<<su algebra: public>>

	contains

	<<su algebra: procedures>>

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

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

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

	@ %def helicity_value
	@ Inverse: return the index that corresponds to a certain
	helicity value in the chosen representation.
	<<su algebra: public>>=
	public :: helicity_index
	<<su algebra: procedures>>=
	function helicity_index (s, h) result (i)
	integer, intent(in) :: s, h
	integer :: i
	integer, dimension(0:0), parameter :: hi1 = [1]
	integer, dimension(-1:1), parameter :: hi2 = [2, 0, 1]
	integer, dimension(-1:1), parameter :: hi3 = [3, 2, 1]
	integer, dimension(-2:2), parameter :: hi4 = [4, 3, 0, 2, 1]
	integer, dimension(-2:2), parameter :: hi5 = [5, 4, 3, 2, 1]
	select case (s)
	case (SCALAR)
	i = hi1(h)
	case (SPINOR)
	i = hi2(h)
	case (VECTOR)
	i = hi3(h)
	case (VECTORSPINOR)
	i = hi4(h)
	case (TENSOR)
	i = hi5(h)
	end select
	end function helicity_index

	@ %def helicity_index
	@
	\subsection{Generator Basis: Cartan Generators}
	For each supported spin type, we return specific properties of the
	set of generators via inquiry functions. This is equivalent to using
	explicit representations of the generators.

	For easy access, the properties are hard-coded and selected via case
	expressions.

	Return true if the generator \#[[i]] is in the Cartan subalgebra,
	i.e., a diagonal matrix for spin type [[s]].
	<<su algebra: public>>=
	public :: is_cartan_generator
	<<su algebra: procedures>>=
	elemental function is_cartan_generator (s, i) result (cartan)
	logical :: cartan
	integer, intent(in) :: s, i
	select case (s)
	case (SCALAR)
	case (SPINOR)
	select case (i)
	case (3); cartan = .true.
	case default
	cartan = .false.
	end select
	case (VECTOR)
	select case (i)
	case (3,8); cartan = .true.
	case default
	cartan = .false.
	end select
	case (VECTORSPINOR)
	select case (i)
	case (3,6,15); cartan = .true.
	case default
	cartan = .false.
	end select
	case (TENSOR)
	select case (i)
	case (3,6,15,24); cartan = .true.
	case default
	cartan = .false.
	end select
	case default
	cartan = .false.
	end select
	end function is_cartan_generator

	@ %def is_cartan_generator
	@ Return the index of Cartan generator \#[[k]] in the chosen
	representation. This has to conform to [[cartan]] above.
	<<su algebra: public>>=
	public :: cartan_index
	<<su algebra: procedures>>=
	elemental function cartan_index (s, k) result (ci)
	integer :: ci
	integer, intent(in) :: s, k
	integer, dimension(1), parameter :: ci2 = [3]
	integer, dimension(2), parameter :: ci3 = [3,8]
	integer, dimension(3), parameter :: ci4 = [3,6,15]
	integer, dimension(4), parameter :: ci5 = [3,6,15,24]
	select case (s)
	case (SPINOR)
	ci = ci2(k)
	case (VECTOR)
	ci = ci3(k)
	case (VECTORSPINOR)
	ci = ci4(k)
	case (TENSOR)
	ci = ci5(k)
	case default
	ci = 0
	end select
	end function cartan_index

	@ %def cartan_index
	@ The element \#[[k]] of the result vector [[a]] is equal to the
	$(h,h)$ diagonal entry of the generator matrix $T^k$. That is,
	evaluating this for all allowed values of [[h]], we recover the set of
	Cartan generator matrices.
	<<su algebra: public>>=
	public :: cartan_element
	<<su algebra: procedures>>=
	function cartan_element (s, h) result (a)
	real(default), dimension(:), allocatable :: a
	integer, intent(in) :: s, h
	real(default), parameter :: sqrt2 = sqrt (2._default)
	real(default), parameter :: sqrt3 = sqrt (3._default)
	real(default), parameter :: sqrt10 = sqrt (10._default)
	allocate (a (algebra_dimension (s)), source = 0._default)
	select case (s)
	case (SCALAR)
	case (SPINOR)
	select case (h)
	case (1)
	a(3) = 1._default / 2
	case (-1)
	a(3) = -1._default / 2
	end select
	case (VECTOR)
	select case (h)
	case (1)
	a(3) = 1._default / 2
	a(8) = 1._default / (2 * sqrt3)
	case (-1)
	a(3) = -1._default / 2
	a(8) = 1._default / (2 * sqrt3)
	case (0)
	a(8) = -1._default / sqrt3
	end select
	case (VECTORSPINOR)
	select case (h)
	case (2)
	a(3) = 1._default / 2
	a(15) = 1._default / (2 * sqrt2)
	case (-2)
	a(3) = -1._default / 2
	a(15) = 1._default / (2 * sqrt2)
	case (1)
	a(6) = 1._default / 2
	a(15) = -1._default / (2 * sqrt2)
	case (-1)
	a(6) = -1._default / 2
	a(15) = -1._default / (2 * sqrt2)
	end select
	case (TENSOR)
	select case (h)
	case (2)
	a(3) = 1._default / 2
	a(15) = 1._default / (2 * sqrt2)
	a(24) = 1._default / (2 * sqrt10)
	case (-2)
	a(3) = -1._default / 2
	a(15) = 1._default / (2 * sqrt2)
	a(24) = 1._default / (2 * sqrt10)
	case (1)
	a(6) = 1._default / 2
	a(15) = -1._default / (2 * sqrt2)
	a(24) = 1._default / (2 * sqrt10)
	case (-1)
	a(6) = -1._default / 2
	a(15) = -1._default / (2 * sqrt2)
	a(24) = 1._default / (2 * sqrt10)
	case (0)
	a(24) = -4._default / (2 * sqrt10)
	end select
	end select
	end function cartan_element

	@ %def cartan_element
	@ Given an array of diagonal matrix elements [[rd]] of a generator,
	compute the array [[a]] of basis coefficients. The array must be
	ordered as defined by [[helicity_value]], i.e., highest weight first.
	The calculation is organized such that the trace of the generator,
	i.e., the sum of [[rd]] values, drops out. The result array [[a]] has
	coefficients for all basis generators, but only Cartan generators can
	get a nonzero coefficient.
	<<su algebra: public>>=
	public :: cartan_coeff
	<<su algebra: procedures>>=
	function cartan_coeff (s, rd) result (a)
	real(default), dimension(:), allocatable :: a
	integer, intent(in) :: s
	real(default), dimension(:), intent(in) :: rd
	real(default), parameter :: sqrt2 = sqrt (2._default)
	real(default), parameter :: sqrt3 = sqrt (3._default)
	real(default), parameter :: sqrt10 = sqrt (10._default)
	integer :: n
	n = algebra_dimension (s)
	allocate (a (n), source = 0._default)
	select case (s)
	case (SPINOR)
	a(3) = rd(1) - rd(2)
	case (VECTOR)
	a(3) = rd(1) - rd(3)
	a(8) = (rd(1) - 2 * rd(2) + rd(3)) / sqrt3
	case (VECTORSPINOR)
	a(3) = rd(1) - rd(4)
	a(6) = rd(2) - rd(3)
	a(15) = (rd(1) - rd(2) - rd(3) + rd(4)) / sqrt2
	case (TENSOR)
	a(3) = rd(1) - rd(5)
	a(6) = rd(2) - rd(4)
	a(15) = (rd(1) - rd(2) - rd(4) + rd(5)) / sqrt2
	a(24) = (rd(1) + rd(2) - 4 * rd(3) + rd(4) + rd(5)) / sqrt10
	end select
	end function cartan_coeff

	@ %def cartan_coeff
	@
	\subsection{Roots (Off-Diagonal Generators)}
	Return the appropriate generator index for a given off-diagonal helicity
	combination. We require $h_1>h_2$. We return the index of the
	appropriate real-valued generator if [[r]] is true, else the
	complex-valued one.

	This is separate from the [[cartan_coeff]] function above. The reason
	is that the off-diagonal generators have only a single nonzero matrix
	element, so there is a one-to-one correspondence of helicity and index.
	<<su algebra: public>>=
	public :: root_index
	<<su algebra: procedures>>=
	function root_index (s, h1, h2, r) result (ai)
	integer :: ai
	integer, intent(in) :: s, h1, h2
	logical :: r
	ai = 0
	select case (s)
	case (SCALAR)
	case (SPINOR)
	select case (h1)
	case (1)
	select case (h2)
	case (-1); ai = 1
	end select
	end select
	case (VECTOR)
	select case (h1)
	case (1)
	select case (h2)
	case (-1); ai = 1
	case (0); ai = 4
	end select
	case (0)
	select case (h2)
	case (-1); ai = 6
	end select
	end select
	case (VECTORSPINOR)
	select case (h1)
	case (2)
	select case (h2)
	case (-2); ai = 1
	case (1); ai = 7
	case (-1); ai = 11
	end select
	case (1)
	select case (h2)
	case (-1); ai = 4
	case (-2); ai = 13
	end select
	case (-1)
	select case (h2)
	case (-2); ai = 9
	end select
	end select
	case (TENSOR)
	select case (h1)
	case (2)
	select case (h2)
	case (-2); ai = 1
	case (1); ai = 7
	case (-1); ai = 11
	case (0); ai = 16
	end select
	case (1)
	select case (h2)
	case (-1); ai = 4
	case (-2); ai = 13
	case (0); ai = 20
	end select
	case (-1)
	select case (h2)
	case (-2); ai = 9
	end select
	case (0)
	select case (h2)
	case (-2); ai = 18
	case (-1); ai = 22
	end select
	end select
	end select
	if (ai /= 0 .and. .not. r) ai = ai + 1
	end function root_index

	@ %def root_index
	@ Inverse: return the helicity values ($h_2>h_1$) for an off-diagonal
	generator. The flag [[r]] tells whether this is a real or diagonal
	generator. The others are Cartan generators.
	<<su algebra: public>>=
	public :: root_helicity
	<<su algebra: procedures>>=
	subroutine root_helicity (s, i, h1, h2, r)
	integer, intent(in) :: s, i
	integer, intent(out) :: h1, h2
	logical, intent(out) :: r
	h1 = 0
	h2 = 0
	r = .false.
	select case (s)
	case (SCALAR)
	case (SPINOR)
	select case (i)
	case ( 1, 2); h1 = 1; h2 = -1; r = i == 1
	end select
	case (VECTOR)
	select case (i)
	case ( 1, 2); h1 = 1; h2 = -1; r = i == 1
	case ( 4, 5); h1 = 1; h2 = 0; r = i == 4
	case ( 6, 7); h1 = 0; h2 = -1; r = i == 6
	end select
	case (VECTORSPINOR)
	select case (i)
	case ( 1, 2); h1 = 2; h2 = -2; r = i == 1
	case ( 4, 5); h1 = 1; h2 = -1; r = i == 4
	case ( 7, 8); h1 = 2; h2 = 1; r = i == 7
	case ( 9,10); h1 = -1; h2 = -2; r = i == 9
	case (11,12); h1 = 2; h2 = -1; r = i ==11
	case (13,14); h1 = 1; h2 = -2; r = i ==13
	end select
	case (TENSOR)
	select case (i)
	case ( 1, 2); h1 = 2; h2 = -2; r = i == 1
	case ( 4, 5); h1 = 1; h2 = -1; r = i == 4
	case ( 7, 8); h1 = 2; h2 = 1; r = i == 7
	case ( 9,10); h1 = -1; h2 = -2; r = i == 9
	case (11,12); h1 = 2; h2 = -1; r = i ==11
	case (13,14); h1 = 1; h2 = -2; r = i ==13
	case (16,17); h1 = 2; h2 = 0; r = i ==16
	case (18,19); h1 = 0; h2 = -2; r = i ==18
	case (20,21); h1 = 1; h2 = 0; r = i ==20
	case (22,23); h1 = 0; h2 = -1; r = i ==22
	end select
	end select
	end subroutine root_helicity

	@ %def root_helicity
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[su_algebra_ut.f90]]>>=
	<<File header>>

	module su_algebra_ut
	use unit_tests
	use su_algebra_uti

	<<Standard module head>>

	<<su algebra: public test>>

	contains

	<<su algebra: test driver>>

	end module su_algebra_ut
	@ %def su_algebra_ut
	@
	<<[[su_algebra_uti.f90]]>>=
	<<File header>>

	module su_algebra_uti

	<<Use kinds>>
	use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
	use su_algebra

	<<Standard module head>>

	<<su algebra: test declarations>>

	contains

	<<su algebra: tests>>

	end module su_algebra_uti
	@ %def su_algebra_ut
	@ API: driver for the unit tests below.
	<<su algebra: public test>>=
	public :: su_algebra_test
	<<su algebra: test driver>>=
	subroutine su_algebra_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<su algebra: execute tests>>
	end subroutine su_algebra_test

	@ %def su_algebra_test
	@
	\subsubsection{Generator Ordering}
	Show the position of Cartan generators in the sequence of basis generators.
	<<su algebra: execute tests>>=
	call test (su_algebra_1, "su_algebra_1", &
	"generator ordering", &
	u, results)
	<<su algebra: test declarations>>=
	public :: su_algebra_1
	<<su algebra: tests>>=
	subroutine su_algebra_1 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: su_algebra_1"
	write (u, "(A)") "* Purpose: test su(N) algebra implementation"
	write (u, "(A)")

	write (u, "(A)") "* su(N) generators: &
	&list and mark Cartan subalgebra"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call cartan_check (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call cartan_check (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call cartan_check (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call cartan_check (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call cartan_check (TENSOR)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: su_algebra_1"

	contains

	subroutine cartan_check (s)
	integer, intent(in) :: s
	integer :: i
	write (u, *)
	do i = 1, algebra_dimension (s)
	write (u, "(1x,L1)", advance="no") is_cartan_generator (s, i)
	end do
	write (u, *)

	end subroutine cartan_check

	end subroutine su_algebra_1

	@ %def su_algebra_1
	@
	\subsubsection{Cartan Generator Basis}
	Show the explicit matrix representation for all Cartan generators and
	check their traces and Killing products.

	Also test helicity index mappings.
	<<su algebra: execute tests>>=
	call test (su_algebra_2, "su_algebra_2", &
	"Cartan generator representation", &
	u, results)
	<<su algebra: test declarations>>=
	public :: su_algebra_2
	<<su algebra: tests>>=
	subroutine su_algebra_2 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: su_algebra_2"
	write (u, "(A)") "* Purpose: test su(N) algebra implementation"
	write (u, "(A)")

	write (u, "(A)") "* diagonal su(N) generators: &
	&show explicit representation"
	write (u, "(A)") "* and check trace and Killing form"

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call cartan_show (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call cartan_show (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call cartan_show (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call cartan_show (TENSOR)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: su_algebra_2"

	contains

	subroutine cartan_show (s)
	integer, intent(in) :: s
	real(default), dimension(:,:), allocatable :: rd
	integer, dimension(:), allocatable :: ci
	integer :: n, d, h, i, j, k, l

	n = algebra_dimension (s)
	d = fundamental_dimension (s)

	write (u, *)
	write (u, "(A2,5X)", advance="no") "h:"
	do i = 1, d
	j = helicity_index (s, helicity_value (s, i))
	write (u, "(1x,I2,5X)", advance="no") helicity_value (s, j)
	end do
	write (u, "(8X)", advance="no")
	write (u, "(1X,A)") "tr"

	allocate (rd (n,d), source = 0._default)
	do i = 1, d
	h = helicity_value (s, i)
	rd(:,i) = cartan_element (s, h)
	end do

	allocate (ci (d-1), source = 0)
	do k = 1, d-1
	ci(k) = cartan_index (s, k)
	end do

	write (u, *)
	do k = 1, d-1
	write (u, "('T',I2,':',1X)", advance="no") ci(k)
	do i = 1, d
	write (u, 1, advance="no") rd(ci(k),i)
	end do
	write (u, "(8X)", advance="no")
	write (u, 1) sum (rd(ci(k),:))
	end do

	write (u, *)
	write (u, "(6X)", advance="no")
	do k = 1, d-1
	write (u, "(2X,'T',I2,3X)", advance="no") ci(k)
	end do
	write (u, *)

	do k = 1, d-1
	write (u, "('T',I2,2X)", advance="no") ci(k)
	do l = 1, d-1
	write (u, 1, advance="no") dot_product (rd(ci(k),:), rd(ci(l),:))
	end do
	write (u, *)
	end do

	1 format (1x,F7.4)

	end subroutine cartan_show

	end subroutine su_algebra_2

	@ %def su_algebra_2
	@
	\subsubsection{Bloch Representation: Cartan Generators}
	Transform from Bloch vectors to matrix and back, considering Cartan
	generators only.
	<<su algebra: execute tests>>=
	call test (su_algebra_3, "su_algebra_3", &
	"Cartan generator mapping", &
	u, results)
	<<su algebra: test declarations>>=
	public :: su_algebra_3
	<<su algebra: tests>>=
	subroutine su_algebra_3 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: su_algebra_3"
	write (u, "(A)") "* Purpose: test su(N) algebra implementation"
	write (u, "(A)")

	write (u, "(A)") "* diagonal su(N) generators: &
	&transform to matrix and back"

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call cartan_expand (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call cartan_expand (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call cartan_expand (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call cartan_expand (TENSOR)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: su_algebra_3"

	contains

	subroutine cartan_expand (s)
	integer, intent(in) :: s
	real(default), dimension(:,:), allocatable :: rd
	integer, dimension(:), allocatable :: ci
	real(default), dimension(:), allocatable :: a
	logical, dimension(:), allocatable :: mask
	integer :: n, d, h, i, k, l

	n = algebra_dimension (s)
	d = fundamental_dimension (s)

	allocate (rd (n,d), source = 0._default)
	do i = 1, d
	h = helicity_value (s, i)
	rd(:,i) = cartan_element (s, h)
	end do

	allocate (ci (d-1), source = 0)
	do k = 1, d-1
	ci(k) = cartan_index (s, k)
	end do

	allocate (a (n))

	write (u, *)
	do k = 1, d-1
	a(:) = cartan_coeff (s, rd(ci(k),:))
	write (u, "('T',I2,':',1X)", advance="no") ci(k)
	do i = 1, n
	if (is_cartan_generator (s, i)) then
	write (u, 1, advance="no") a(i)
	else if (a(i) /= 0) then
	! this should not happen (nonzero non-Cartan entry)
	write (u, "(1X,':',I2,':',3X)", advance="no") i
	end if
	end do
	write (u, *)
	end do

	1 format (1X,F7.4)

	end subroutine cartan_expand

	end subroutine su_algebra_3

	@ %def su_algebra_3
	@
	\subsubsection{Bloch Representation: Roots}
	List the mapping between helicity transitions and (real) off-diagonal
	generators.
	<<su algebra: execute tests>>=
	call test (su_algebra_4, "su_algebra_4", &
	"Root-helicity mapping", &
	u, results)
	<<su algebra: test declarations>>=
	public :: su_algebra_4
	<<su algebra: tests>>=
	subroutine su_algebra_4 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: su_algebra_4"
	write (u, "(A)") "* Purpose: test su(N) algebra implementation"
	write (u, "(A)")

	write (u, "(A)") "* off-diagonal su(N) generators: &
	&mapping from/to helicity pair"

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call root_expand (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call root_expand (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call root_expand (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call root_expand (TENSOR)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: su_algebra_4"

	contains

	subroutine root_expand (s)
	integer, intent(in) :: s
	integer :: n, d, i, j, h1, h2
	logical :: r

	n = algebra_dimension (s)

	write (u, *)
	do i = 1, n
	if (is_cartan_generator (s, i)) cycle
	call root_helicity (s, i, h1, h2, r)
	j = root_index (s, h1, h2, r)
	write (u, "('T',I2,':')", advance="no") j
	write (u, "(2(1x,I2))", advance="no") h1, h2
	if (r) then
	write (u, *)
	else
	write (u, "('*')")
	end if
	end do

	end subroutine root_expand

	end subroutine su_algebra_4

	@ %def su_algebra_4
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Bloch Representation}
	Particle polarization is determined by a particular quantum state
	which has just helicity information. Physically, this is the spin
	density matrix $\rho$, where we do not restrict ourselves to pure
	states.

	We adopt the phase convention for a spin-1/2 particle that
	\begin{equation}
	\rho = \tfrac12(1 + \vec\alpha\cdot\vec\sigma)
	\end{equation}
	with the polarization axis $\vec\alpha$. For a particle with
	arbitrary spin $s$, and thus $N=2s+1$ spin states, we extend the above
	definition to generalized Bloch form
	\begin{equation}
	\rho = \frac1N\left(1 + \sqrt{2N(N-1)}\alpha^aT^a\right)
	\end{equation}
	where the $T^a$ ($a=1,\ldots N^2-1$) are a basis of $su(N)$ algebra
	generators. These $N\times N$ matrices are hermitean, traceless, and
	orthogonal via
	\begin{equation}
	\mathop{\rm Tr}T^aT^b = \frac12 \delta^{ab}
	\end{equation}
	In the spin-1/2 case, this reduces to the above (standard Bloch)
	representation since $T^a = \sigma^a/2$, $a=1,2,3$. For the spin-1
	case, we could use $T^a = \lambda^a/2$ with the Gell-Mann matrices,
	\begin{equation}
	\rho = \frac13\left(1 + \sqrt{3}\alpha^a\lambda^a\right),
	\end{equation}
	The normalization is chosen that $\|alpha\|\leq 1$ for allowed density
	matrix, where $\|\alpha\|=1$ is a necessary, but not sufficient,
	condition for a pure state.

	We need a specific choice of basis for a well-defined component
	representation. The matrix elements of $T^a$ are
	ordered as $m=\ell,\ell-1,\ldots -\ell$, i.e., from highest down to
	lowest weight, for both row and column.

	We list first the generators of the $su(2)$ subalgebras which leave
	$\|m\|$ invariant ($\|m\|\neq 0$):
	\begin{equation}
	T^{b+1,b+2,b+3} \equiv \sigma^{1,2,3}
	\end{equation}
	acting on the respective subspace $\|m\|=\ell,\ell-1,\ldots$ for
	$b=0,1,\ldots$. This defines generators $T^a$ for $a=1,\ldots 3N/2$
	($\ldots 3(N-1)/2$) for $N$ even (odd), respectively.

	The following generators successively extend this to $su(4)$, $su(6)$,
	\ldots until $su(N)$ by adding first the missing off-diagonal and then
	diagonal generators. The phase conventions are analogous.

	(It should be possible to code these conventions for generic spin, but
	in the current implementation we restrict ourselves to $s\leq 2$, i.e.,
	$N\leq 5$.)

	Particle polarization is determined by a particular quantum state
	which has just helicity information. Physically, this is the spin
	density matrix $\rho$, where we do not restrict ourselves to pure
	states.

	We adopt the phase convention for a spin-1/2 particle that
	\begin{equation}
	\rho = \tfrac12(1 + \vec\alpha\cdot\vec\sigma)
	\end{equation}
	with the polarization axis $\vec\alpha$. For a particle with
	arbitrary spin $s$, and thus $N=2s+1$ spin states, we extend the above
	definition to generalized Bloch form
	\begin{equation}
	\rho = \frac1N\left(1 + \sqrt{2N(N-1)}\alpha^aT^a\right)
	\end{equation}
	where the $T^a$ ($a=1,\ldots N^2-1$) are a basis of $su(N)$ algebra
	generators. These $N\times N$ matrices are hermitean, traceless, and
	orthogonal via
	\begin{equation}
	\mathop{\rm Tr}T^aT^b = \frac12 \delta^{ab}
	\end{equation}
	In the spin-1/2 case, this reduces to the above (standard Bloch)
	representation since $T^a = \sigma^a/2$, $a=1,2,3$. For the spin-1
	case, we could use $T^a = \lambda^a/2$ with the Gell-Mann matrices,
	\begin{equation}
	\rho = \frac13\left(1 + \sqrt{3}\alpha^a\lambda^a\right),
	\end{equation}
	The normalization is chosen that $\|alpha\|\leq 1$ for allowed density
	matrix, where $\|\alpha\|=1$ is a necessary, but not sufficient,
	condition for a pure state.
	<<[[bloch_vectors.f90]]>>=
	<<File header>>

	module bloch_vectors

	<<Use kinds>>
	use physics_defs, only: UNKNOWN, SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
	use su_algebra

	<<Standard module head>>

	<<Bloch vectors: public>>

	<<Bloch vectors: types>>

	contains

	<<Bloch vectors: procedures>>

	end module bloch_vectors
	@ %def bloch_vectors
	@
	\subsection{Preliminaries}
	The normalization factor $\sqrt{2N(N-1)}/N$ that enters the Bloch
	representation.
	<<Bloch vectors: procedures>>=
	function bloch_factor (s) result (f)
	real(default) :: f
	integer, intent(in) :: s
	select case (s)
	case (SCALAR)
	f = 0
	case (SPINOR)
	f = 1
	case (VECTOR)
	f = 2 * sqrt (3._default) / 3
	case (VECTORSPINOR)
	f = 2 * sqrt (6._default) / 4
	case (TENSOR)
	f = 2 * sqrt (10._default) / 5
	case default
	f = 0
	end select
	end function bloch_factor

	@ %def bloch_factor
	@
	\subsection{The basic polarization type}
	The basic polarization object holds just the entries of the Bloch
	vector as an allocatable array.

	Bloch is active whenever the coefficient array is allocated.
	For convenience, we store the spin type ($2s$) and the multiplicity
	($N$) together with the coefficient array ($\alpha$). We have to allow for
	the massless case where $s$ is arbitrary $>0$ but $N=2$, and
	furthermore the chiral massless case where $N=1$. In the latter case,
	the array remains deallocated but the chirality is set to $\pm 1$.

	In the Bloch vector implementation, we do not distinguish between
	particle and antiparticle. If the distinction applies, it must be
	made by the caller when transforming between density matrix and Bloch vector.
	<<Bloch vectors: public>>=
	public :: bloch_vector_t
	<<Bloch vectors: types>>=
	type :: bloch_vector_t
	private
	integer :: spin_type = UNKNOWN
	real(default), dimension(:), allocatable :: a
	contains
	<<Bloch vectors: bloch vector: TBP>>
	end type bloch_vector_t

	@ %def bloch_vector_t
	@
	\subsection{Direct Access}
	This basic initializer just sets the spin type, leaving the Bloch vector
	unallocated. The object therefore does not support nonzero polarization.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: init_unpolarized => bloch_vector_init_unpolarized
	<<Bloch vectors: procedures>>=
	subroutine bloch_vector_init_unpolarized (pol, spin_type)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	pol%spin_type = spin_type
	end subroutine bloch_vector_init_unpolarized

	@ %def bloch_vector_init_unpolarized
	@ The standard initializer allocates the Bloch vector and initializes
	with zeros, so we can define a polarization later. We make sure that
	this works only for the supported spin type. Initializing with
	[[UNKNOWN]] spin type resets the Bloch vector to undefined, i.e.,
	unpolarized state.
	<<Bloch vectors: bloch vector: TBP>>=
	generic :: init => bloch_vector_init
	procedure, private :: bloch_vector_init
	<<Bloch vectors: procedures>>=
	subroutine bloch_vector_init (pol, spin_type)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	pol%spin_type = spin_type
	select case (spin_type)
	case (SCALAR,SPINOR,VECTOR,VECTORSPINOR,TENSOR)
	allocate (pol%a (algebra_dimension (spin_type)), source = 0._default)
	end select
	end subroutine bloch_vector_init

	@ %def bloch_vector_init
	@
	Fill the Bloch vector from an array, no change of normalization. No
	initialization and no check, we assume that the shapes do match.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: from_array => bloch_vector_from_array
	<<Bloch vectors: procedures>>=
	subroutine bloch_vector_from_array (pol, a)
	class(bloch_vector_t), intent(inout) :: pol
	real(default), dimension(:), allocatable, intent(in) :: a
	pol%a(:) = a
	end subroutine bloch_vector_from_array

	@ %def bloch_vector_from_array
	@
	Transform to an array of reals, i.e., extract the Bloch vector as-is.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: to_array => bloch_vector_to_array
	<<Bloch vectors: procedures>>=
	subroutine bloch_vector_to_array (pol, a)
	class(bloch_vector_t), intent(in) :: pol
	real(default), dimension(:), allocatable, intent(out) :: a
	if (pol%is_defined ()) allocate (a (size (pol%a)), source = pol%a)
	end subroutine bloch_vector_to_array

	@ %def bloch_vector_to_array
	@
	\subsection{Raw I/O}
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: write_raw => bloch_vector_write_raw
	procedure :: read_raw => bloch_vector_read_raw
	<<Bloch vectors: procedures>>=
	subroutine bloch_vector_write_raw (pol, u)
	class(bloch_vector_t), intent(in) :: pol
	integer, intent(in) :: u
	write (u) pol%spin_type
	write (u) allocated (pol%a)
	if (allocated (pol%a)) then
	write (u) pol%a
	end if
	end subroutine bloch_vector_write_raw

	subroutine bloch_vector_read_raw (pol, u, iostat)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: u
	integer, intent(out) :: iostat
	integer :: s
	logical :: polarized
	read (u, iostat=iostat) s
	read (u, iostat=iostat) polarized
	if (iostat /= 0) return
	if (polarized) then
	call pol%init (s)
	read (u, iostat=iostat) pol%a
	else
	call pol%init_unpolarized (s)
	end if
	end subroutine bloch_vector_read_raw

	@ %def bloch_vector_write_raw
	@ %def bloch_vector_read_raw
	@
	\subsection{Properties}
	Re-export algebra functions that depend on the spin type. These
	functions do not depend on the Bloch vector being allocated.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: get_n_states
	procedure :: get_length
	procedure :: hel_index => bv_helicity_index
	procedure :: hel_value => bv_helicity_value
	procedure :: bloch_factor => bv_factor
	<<Bloch vectors: procedures>>=
	function get_n_states (pol) result (n)
	class(bloch_vector_t), intent(in) :: pol
	integer :: n
	n = fundamental_dimension (pol%spin_type)
	end function get_n_states

	function get_length (pol) result (n)
	class(bloch_vector_t), intent(in) :: pol
	integer :: n
	n = algebra_dimension (pol%spin_type)
	end function get_length

	function bv_helicity_index (pol, h) result (i)
	class(bloch_vector_t), intent(in) :: pol
	integer, intent(in) :: h
	integer :: i
	i = helicity_index (pol%spin_type, h)
	end function bv_helicity_index

	function bv_helicity_value (pol, i) result (h)
	class(bloch_vector_t), intent(in) :: pol
	integer, intent(in) :: i
	integer :: h
	h = helicity_value (pol%spin_type, i)
	end function bv_helicity_value

	function bv_factor (pol) result (f)
	class(bloch_vector_t), intent(in) :: pol
	real(default) :: f
	f = bloch_factor (pol%spin_type)
	end function bv_factor

	@ %def get_n_states
	@ %def helicity_index
	@ %def helicity_value
	@ If the Bloch vector object is defined, the spin type is anything else but
	[[UNKNOWN]]. This allows us the provide the representation-specific
	functions above.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: is_defined => bloch_vector_is_defined
	<<Bloch vectors: procedures>>=
	function bloch_vector_is_defined (pol) result (flag)
	class(bloch_vector_t), intent(in) :: pol
	logical :: flag
	flag = pol%spin_type /= UNKNOWN
	end function bloch_vector_is_defined

	@ %def bloch_vector_is_defined
	@ If the Bloch vector object is (technically) polarized, it is
	defined, and the vector coefficient array has been allocated.
	However, the vector value may be zero.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: is_polarized => bloch_vector_is_polarized
	<<Bloch vectors: procedures>>=
	function bloch_vector_is_polarized (pol) result (flag)
	class(bloch_vector_t), intent(in) :: pol
	logical :: flag
	flag = allocated (pol%a)
	end function bloch_vector_is_polarized

	@ %def bloch_vector_is_polarized
	@ Return true if the polarization is diagonal, i.e., all entries in
	the density matrix are on the diagonal. This is equivalent to
	requiring that only Cartan generator coefficients are nonzero in the
	Bloch vector.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: is_diagonal => bloch_vector_is_diagonal
	<<Bloch vectors: procedures>>=
	function bloch_vector_is_diagonal (pol) result (diagonal)
	class(bloch_vector_t), intent(in) :: pol
	logical :: diagonal
	integer :: s, i
	s = pol%spin_type
	diagonal = .true.
	if (pol%is_polarized ()) then
	do i = 1, size (pol%a)
	if (is_cartan_generator (s, i)) cycle
	if (pol%a(i) /= 0) then
	diagonal = .false.
	return
	end if
	end do
	end if
	end function bloch_vector_is_diagonal

	@ %def bloch_vector_is_diagonal
	@
	Return the Euclidean norm of the Bloch vector. This is equal to the
	Killing form value of the corresponding algebra generator. We assume
	that the polarization object has been initialized.

	For a pure state, the norm is unity. All other allowed states have a
	norm less than unity. (For $s\geq 1$, this is a necessary but not
	sufficient condition.)
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: get_norm => bloch_vector_get_norm
	<<Bloch vectors: procedures>>=
	function bloch_vector_get_norm (pol) result (norm)
	class(bloch_vector_t), intent(in) :: pol
	real(default) :: norm
	select case (pol%spin_type)
	case (SPINOR,VECTOR,VECTORSPINOR,TENSOR)
	norm = sqrt (dot_product (pol%a, pol%a))
	case default
	norm = 1
	end select
	end function bloch_vector_get_norm

	@ %def bloch_vector_get_norm
	@
	\subsection{Diagonal density matrix}
	This initializer takes a diagonal density matrix, represented by a
	real-valued array. We assume that the trace is unity, and that the
	array has the correct shape for the given [[spin_type]].

	The [[bloch_factor]] renormalization is necessary such that a pure
	state maps to a Bloch vector with unit norm.
	<<Bloch vectors: bloch vector: TBP>>=
	generic :: init => bloch_vector_init_diagonal
	procedure, private :: bloch_vector_init_diagonal
	<<Bloch vectors: procedures>>=
	subroutine bloch_vector_init_diagonal (pol, spin_type, rd)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	real(default), dimension(:), intent(in) :: rd
	call pol%init (spin_type)
	call pol%set (rd)
	end subroutine bloch_vector_init_diagonal

	@ %def bloch_vector_init_diagonal
	@ Set a Bloch vector, given a diagonal density matrix as a real array.
	The Bloch vector must be initialized with correct characteristics.
	<<Bloch vectors: bloch vector: TBP>>=
	generic :: set => bloch_vector_set_diagonal
	procedure, private :: bloch_vector_set_diagonal
	<<Bloch vectors: procedures>>=
	subroutine bloch_vector_set_diagonal (pol, rd)
	class(bloch_vector_t), intent(inout) :: pol
	real(default), dimension(:), intent(in) :: rd
	integer :: s
	s = pol%spin_type
	select case (s)
	case (SCALAR,SPINOR,VECTOR,VECTORSPINOR,TENSOR)
	pol%a(:) = cartan_coeff (s, rd) / bloch_factor (s)
	end select
	end subroutine bloch_vector_set_diagonal

	@ %def bloch_vector_set_diagonal
	@
	@
	\subsection{Massless density matrix}
	This is a specific variant which initializes an equipartition for
	the maximum helicity, corresponding to an unpolarized massless particle.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: init_max_weight => bloch_vector_init_max_weight
	<<Bloch vectors: procedures>>=
	subroutine bloch_vector_init_max_weight (pol, spin_type)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	call pol%init (spin_type)
	select case (spin_type)
	case (VECTOR)
	call pol%set ([0.5_default, 0._default, 0.5_default])
	case (VECTORSPINOR)
	call pol%set ([0.5_default, 0._default, 0._default, 0.5_default])
	case (TENSOR)
	call pol%set ([0.5_default, 0._default, 0._default, 0._default, 0.5_default])
	end select
	end subroutine bloch_vector_init_max_weight

	@ %def bloch_vector_init_max_weight
	@ Initialize the maximum-weight submatrix with a three-component Bloch
	vector. This is not as trivial as it seems because we need the above
	initialization for the generalized Bloch in order to remove the lower
	weights from the density matrix.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: init_vector => bloch_vector_init_vector
	procedure :: to_vector => bloch_vector_to_vector
	<<Bloch vectors: procedures>>=
	subroutine bloch_vector_init_vector (pol, s, a)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: s
	real(default), dimension(3), intent(in) :: a
	call pol%init_max_weight (s)
	select case (s)
	case (SPINOR, VECTOR, VECTORSPINOR, TENSOR)
	pol%a(1:3) = a / bloch_factor (s)
	end select
	end subroutine bloch_vector_init_vector

	subroutine bloch_vector_to_vector (pol, a)
	class(bloch_vector_t), intent(in) :: pol
	real(default), dimension(3), intent(out) :: a
	integer :: s
	s = pol%spin_type
	select case (s)
	case (SPINOR, VECTOR, VECTORSPINOR, TENSOR)
	a = pol%a(1:3) * bloch_factor (s)
	case default
	a = 0
	end select
	end subroutine bloch_vector_to_vector

	@ %def bloch_vector_init_vector
	@ %def bloch_vector_to_vector
	@
	\subsection{Arbitrary density matrix}
	Initialize the Bloch vector from a density matrix. We assume that the
	density is valid. In particular, the shape should match, the matrix
	should be hermitian, and the trace should be unity.

	We first fill the diagonal, then add the off-diagonal parts.
	<<Bloch vectors: bloch vector: TBP>>=
	generic :: init => bloch_vector_init_matrix
	procedure, private :: bloch_vector_init_matrix
	<<Bloch vectors: procedures>>=
	subroutine bloch_vector_init_matrix (pol, spin_type, r)
	class(bloch_vector_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	complex(default), dimension(:,:), intent(in) :: r
	select case (spin_type)
	case (SCALAR,SPINOR,VECTOR,VECTORSPINOR,TENSOR)
	call pol%init (spin_type)
	call pol%set (r)
	case default
	call pol%init (UNKNOWN)
	end select
	end subroutine bloch_vector_init_matrix

	@ %def bloch_vector_init_matrix
	@ Set a Bloch vector, given an arbitrary density matrix as a real
	array. The Bloch vector must be initialized with correct
	characteristics.
	<<Bloch vectors: bloch vector: TBP>>=
	generic :: set => bloch_vector_set_matrix
	procedure, private :: bloch_vector_set_matrix
	<<Bloch vectors: procedures>>=
	subroutine bloch_vector_set_matrix (pol, r)
	class(bloch_vector_t), intent(inout) :: pol
	complex(default), dimension(:,:), intent(in) :: r
	real(default), dimension(:), allocatable :: rd
	integer :: s, d, i, j, h1, h2, ir, ii
	s = pol%spin_type
	select case (s)
	case (SCALAR,SPINOR,VECTOR,VECTORSPINOR,TENSOR)
	d = fundamental_dimension (s)
	allocate (rd (d))
	do i = 1, d
	rd(i) = r(i,i)
	end do
	call pol%set (rd)
	do i = 1, d
	h1 = helicity_value (s, i)
	do j = i+1, d
	h2 = helicity_value (s, j)
	ir = root_index (s, h1, h2, .true.)
	ii = root_index (s, h1, h2, .false.)
	pol%a(ir) = real (r(j,i) + r(i,j)) / bloch_factor (s)
	pol%a(ii) = aimag (r(j,i) - r(i,j)) / bloch_factor (s)
	end do
	end do
	end select
	end subroutine bloch_vector_set_matrix

	@ %def bloch_vector_set_matrix
	@ Allocate and fill the density matrix [[r]] (with the index ordering as
	defined in [[su_algebra]]) that corresponds to a given Bloch vector.

	If the optional [[only_max_weight]] is set, the resulting matrix has
	entries only for $\pm h_\text{max}$, as appropriate for a massless
	particle (for spin $\geq 1$). Note that we always add the unit
	matrix, as this is part of the Bloch-vector definition.
	<<Bloch vectors: bloch vector: TBP>>=
	procedure :: to_matrix => bloch_vector_to_matrix
	<<Bloch vectors: procedures>>=
	subroutine bloch_vector_to_matrix (pol, r, only_max_weight)
	class(bloch_vector_t), intent(in) :: pol
	complex(default), dimension(:,:), intent(out), allocatable :: r
	logical, intent(in), optional :: only_max_weight
	integer :: d, s, h0, ng, ai, h, h1, h2, i, j
	logical :: is_real, only_max
	complex(default) :: val
	if (.not. pol%is_polarized ()) return
	s = pol%spin_type
	only_max = .false.
	select case (s)
	case (VECTOR, VECTORSPINOR, TENSOR)
	if (present (only_max_weight)) only_max = only_max_weight
	end select
	if (only_max) then
	ng = 2
	h0 = helicity_value (s, 1)
	else
	ng = algebra_dimension (s)
	h0 = 0
	end if
	d = fundamental_dimension (s)
	allocate (r (d, d), source = (0._default, 0._default))
	do i = 1, d
	h = helicity_value (s, i)
	if (abs (h) < h0) cycle
	r(i,i) = 1._default / d &
	+ dot_product (cartan_element (s, h), pol%a) * bloch_factor (s)
	end do
	do ai = 1, ng
	if (is_cartan_generator (s, ai)) cycle
	call root_helicity (s, ai, h1, h2, is_real)
	i = helicity_index (s, h1)
	j = helicity_index (s, h2)
	if (is_real) then
	val = cmplx (pol%a(ai) / 2 * bloch_factor (s), 0._default, &
	kind=default)
	r(i,j) = r(i,j) + val
	r(j,i) = r(j,i) + val
	else
	val = cmplx (0._default, pol%a(ai) / 2 * bloch_factor (s), &
	kind=default)
	r(i,j) = r(i,j) - val
	r(j,i) = r(j,i) + val
	end if
	end do
	end subroutine bloch_vector_to_matrix

	@ %def bloch_vector_to_matrix
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[bloch_vectors_ut.f90]]>>=
	<<File header>>

	module bloch_vectors_ut
	use unit_tests
	use bloch_vectors_uti

	<<Standard module head>>

	<<Bloch vectors: public test>>

	contains

	<<Bloch vectors: test driver>>

	end module bloch_vectors_ut
	@ %def bloch_vectors_ut
	@
	<<[[bloch_vectors_uti.f90]]>>=
	<<File header>>

	module bloch_vectors_uti

	<<Use kinds>>
	use physics_defs, only: UNKNOWN, SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
	use su_algebra, only: algebra_dimension, fundamental_dimension, helicity_value

	use bloch_vectors

	<<Standard module head>>

	<<Bloch vectors: test declarations>>

	contains

	<<Bloch vectors: tests>>

	end module bloch_vectors_uti
	@ %def bloch_vectors_ut
	@ API: driver for the unit tests below.
	<<Bloch vectors: public test>>=
	public :: bloch_vectors_test
	<<Bloch vectors: test driver>>=
	subroutine bloch_vectors_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Bloch vectors: execute tests>>
	end subroutine bloch_vectors_test

	@ %def bloch_vectors_test
	@
	\subsubsection{Initialization}
	Initialize the Bloch vector for any spin type. First as unpolarized
	(no array), then as polarized but with zero polarization.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_1, "bloch_vectors_1", &
	"initialization", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_1
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_1 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_1"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Initialization (unpolarized)"

	write (u, "(A)")
	write (u, "(A)") "* unknown"
	call bloch_init (UNKNOWN)

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_init (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_init (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_init (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_init (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_init (TENSOR)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: bloch_vectors_1"

	contains

	subroutine bloch_init (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	real(default), dimension(:), allocatable :: a
	integer :: i
	write (u, *)
	write (u, "(1X,L1,L1)", advance="no") &
	pol%is_defined (), pol%is_polarized ()
	call pol%init_unpolarized (s)
	write (u, "(1X,L1,L1)", advance="no") &
	pol%is_defined (), pol%is_polarized ()
	call pol%init (s)
	write (u, "(1X,L1,L1)", advance="no") &
	pol%is_defined (), pol%is_polarized ()
	write (u, *)
	call pol%to_array (a)
	if (allocated (a)) then
	write (u, "(*(F7.4))") a
	a(:) = [(real (mod (i, 10), kind=default), i = 1, size (a))]
	call pol%from_array (a)
	call pol%to_array (a)
	write (u, "(*(F7.4))") a
	else
	write (u, *)
	write (u, *)
	end if
	end subroutine bloch_init

	end subroutine bloch_vectors_1

	@ %def bloch_vectors_1
	@
	\subsubsection{Pure state (diagonal)}
	Initialize the Bloch vector with a pure state of definite helicity and
	check the normalization.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_2, "bloch_vectors_2", &
	"pure state (diagonal)", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_2
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_2 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_2"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Initialization (polarized, diagonal): &
	&display vector and norm"
	write (u, "(A)") "* transform back"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_diagonal (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_diagonal (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_diagonal (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_diagonal (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_diagonal (TENSOR)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: bloch_vectors_2"

	contains

	subroutine bloch_diagonal (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	real(default), dimension(:), allocatable :: a
	real(default), dimension(:), allocatable :: rd
	complex(default), dimension(:,:), allocatable :: r
	integer :: i, j, d
	real(default) :: rj
	real, parameter :: tolerance = 1.E-14_default
	d = fundamental_dimension (s)
	do i = 1, d
	allocate (rd (d), source = 0._default)
	rd(i) = 1
	call pol%init (s, rd)
	call pol%to_array (a)
	write (u, *)
	write (u, "(A,1X,I2)") "h:", helicity_value (s, i)
	write (u, 1, advance="no") a
	write (u, "(1X,L1)") pol%is_diagonal ()
	write (u, 1) pol%get_norm ()
	call pol%to_matrix (r)
	do j = 1, d
	rj = real (r(j,j))
	if (abs (rj) < tolerance) rj = 0
	write (u, 1, advance="no") rj
	end do
	write (u, "(1X,L1)") matrix_is_diagonal (r)
	deallocate (a, rd, r)
	end do
	1 format (99(1X,F7.4,:))
	end subroutine bloch_diagonal

	function matrix_is_diagonal (r) result (diagonal)
	complex(default), dimension(:,:), intent(in) :: r
	logical :: diagonal
	integer :: i, j
	diagonal = .true.
	do j = 1, size (r, 2)
	do i = 1, size (r, 1)
	if (i == j) cycle
	if (r(i,j) /= 0) then
	diagonal = .false.
	return
	end if
	end do
	end do
	end function matrix_is_diagonal

	end subroutine bloch_vectors_2

	@ %def bloch_vectors_2
	@
	\subsubsection{Pure state (arbitrary)}
	Initialize the Bloch vector with an arbitrarily chosen pure state,
	check the normalization, and transform back to the density matrix.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_3, "bloch_vectors_3", &
	"pure state (arbitrary)", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_3
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_3 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_3"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Initialization (pure polarized, arbitrary):"
	write (u, "(A)") "* input matrix, transform, display norm, transform back"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_arbitrary (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_arbitrary (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_arbitrary (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_arbitrary (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_arbitrary (TENSOR)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: bloch_vectors_3"

	contains

	subroutine bloch_arbitrary (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	complex(default), dimension(:,:), allocatable :: r
	integer :: d
	d = fundamental_dimension (s)
	write (u, *)
	call init_matrix (d, r)
	call write_matrix (d, r)
	call pol%init (s, r)
	write (u, *)
	write (u, 2) pol%get_norm (), pol%is_diagonal ()
	write (u, *)
	call pol%to_matrix (r)
	call write_matrix (d, r)
	2 format (1X,F7.4,1X,L1)
	end subroutine bloch_arbitrary

	subroutine init_matrix (d, r)
	integer, intent(in) :: d
	complex(default), dimension(:,:), allocatable, intent(out) :: r
	complex(default), dimension(:), allocatable :: a
	real(default) :: norm
	integer :: i, j
	allocate (a (d))
	norm = 0
	do i = 1, d
	a(i) = cmplx (2i-1, 2i, kind=default)
	norm = norm + conjg (a(i)) * a(i)
	end do
	a = a / sqrt (norm)
	allocate (r (d,d))
	do i = 1, d
	do j = 1, d
	r(i,j) = conjg (a(i)) * a(j)
	end do
	end do
	end subroutine init_matrix

	subroutine write_matrix (d, r)
	integer, intent(in) :: d
	complex(default), dimension(:,:), intent(in) :: r
	integer :: i, j
	do i = 1, d
	do j = 1, d
	write (u, 1, advance="no") r(i,j)
	end do
	write (u, *)
	end do
	1 format (99(1X,'(',F7.4,',',F7.4,')',:))
	end subroutine write_matrix

	end subroutine bloch_vectors_3

	@ %def bloch_vectors_3
	@
	\subsubsection{Raw I/O}
	Check correct input/output in raw format.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_4, "bloch_vectors_4", &
	"raw I/O", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_4
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_4 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_4"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Raw I/O"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_io (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_io (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_io (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_io (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_io (TENSOR)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: bloch_vectors_4"

	contains

	subroutine bloch_io (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	real(default), dimension(:), allocatable :: a
	integer :: n, i, utmp, iostat
	n = algebra_dimension (s)
	allocate (a (n))
	a(:) = [(real (mod (i, 10), kind=default), i = 1, size (a))]
	write (u, *)
	write (u, "(*(F7.4))") a
	call pol%init (s)
	call pol%from_array (a)
	open (newunit = utmp, status = "scratch", action = "readwrite", &
	form = "unformatted")
	call pol%write_raw (utmp)
	rewind (utmp)
	call pol%read_raw (utmp, iostat=iostat)
	close (utmp)
	call pol%to_array (a)
	write (u, "(*(F7.4))") a
	end subroutine bloch_io

	end subroutine bloch_vectors_4

	@ %def bloch_vectors_4
	@
	\subsubsection{Convenience Methods}
	Check some further TBP that are called by the [[polarizations]]
	module.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_5, "bloch_vectors_5", &
	"massless state (unpolarized)", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_5
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_5 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_5"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Massless states: equipartition"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_massless_unpol (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_massless_unpol (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_massless_unpol (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_massless_unpol (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_massless_unpol (TENSOR)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: bloch_vectors_5"

	contains

	subroutine bloch_massless_unpol (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	complex(default), dimension(:,:), allocatable :: r
	real(default), dimension(:), allocatable :: a
	integer :: d
	d = fundamental_dimension (s)
	call pol%init_max_weight (s)
	call pol%to_matrix (r, only_max_weight = .false.)
	write (u, *)
	where (abs (r) < 1.e-14_default) r = 0
	call write_matrix (d, r)
	call pol%to_matrix (r, only_max_weight = .true.)
	write (u, *)
	call write_matrix (d, r)
	end subroutine bloch_massless_unpol

	subroutine write_matrix (d, r)
	integer, intent(in) :: d
	complex(default), dimension(:,:), intent(in) :: r
	integer :: i, j
	do i = 1, d
	do j = 1, d
	write (u, 1, advance="no") r(i,j)
	end do
	write (u, *)
	end do
	1 format (99(1X,'(',F7.4,',',F7.4,')',:))
	end subroutine write_matrix

	end subroutine bloch_vectors_5

	@ %def bloch_vectors_5
	@
	\subsubsection{Massless state (arbitrary)}
	Initialize the Bloch vector with an arbitrarily chosen pure state
	which consists only of highest-weight components. Transform back to
	the density matrix.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_6, "bloch_vectors_6", &
	"massless state (arbitrary)", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_6
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_6 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_6"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Initialization (pure polarized massless, arbitrary):"
	write (u, "(A)") "* input matrix, transform, display norm, transform back"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_massless (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_massless (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_massless (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_massless (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_massless (TENSOR)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: bloch_vectors_6"

	contains

	subroutine bloch_massless (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	complex(default), dimension(:,:), allocatable :: r
	integer :: d
	d = fundamental_dimension (s)
	write (u, *)
	call init_matrix (d, r)
	call write_matrix (d, r)
	call pol%init (s, r)
	write (u, *)
	write (u, 2) pol%get_norm (), pol%is_diagonal ()
	write (u, *)
	call pol%to_matrix (r, only_max_weight = .true.)
	call write_matrix (d, r)
	2 format (1X,F7.4,1X,L1)
	end subroutine bloch_massless

	subroutine init_matrix (d, r)
	integer, intent(in) :: d
	complex(default), dimension(:,:), allocatable, intent(out) :: r
	complex(default), dimension(:), allocatable :: a
	real(default) :: norm
	integer :: i, j
	allocate (a (d), source = (0._default, 0._default))
	norm = 0
	do i = 1, d, max (d-1, 1)
	a(i) = cmplx (2i-1, 2i, kind=default)
	norm = norm + conjg (a(i)) * a(i)
	end do
	a = a / sqrt (norm)
	allocate (r (d,d), source = (0._default, 0._default))
	do i = 1, d, max (d-1, 1)
	do j = 1, d, max (d-1, 1)
	r(i,j) = conjg (a(i)) * a(j)
	end do
	end do
	end subroutine init_matrix

	subroutine write_matrix (d, r)
	integer, intent(in) :: d
	complex(default), dimension(:,:), intent(in) :: r
	integer :: i, j
	do i = 1, d
	do j = 1, d
	write (u, 1, advance="no") r(i,j)
	end do
	write (u, *)
	end do
	1 format (99(1X,'(',F7.4,',',F7.4,')',:))
	end subroutine write_matrix

	end subroutine bloch_vectors_6

	@ %def bloch_vectors_6
	@
	\subsubsection{Massless state (Bloch vector)}
	Initialize the (generalized) Bloch vector with an ordinary
	three-component Bloch vector that applies to the highest-weight part only.
	<<Bloch vectors: execute tests>>=
	call test (bloch_vectors_7, "bloch_vectors_7", &
	"massless state (vector)", &
	u, results)
	<<Bloch vectors: test declarations>>=
	public :: bloch_vectors_7
	<<Bloch vectors: tests>>=
	subroutine bloch_vectors_7 (u)
	integer, intent(in) :: u

	write (u, "(A)") "* Test output: bloch_vectors_7"
	write (u, "(A)") "* Purpose: test Bloch-vector &
	&polarization implementation"
	write (u, "(A)")

	write (u, "(A)") "* Initialization &
	&(pure polarized massless, arbitrary Bloch vector):"
	write (u, "(A)") "* input vector, transform, display norm, &
	&transform back"

	write (u, "(A)")
	write (u, "(A)") "* s = 0"
	call bloch_massless_vector (SCALAR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1/2"
	call bloch_massless_vector (SPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 1"
	call bloch_massless_vector (VECTOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 3/2"
	call bloch_massless_vector (VECTORSPINOR)

	write (u, "(A)")
	write (u, "(A)") "* s = 2"
	call bloch_massless_vector (TENSOR)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: bloch_vectors_7"

	contains

	subroutine bloch_massless_vector (s)
	integer, intent(in) :: s
	type(bloch_vector_t) :: pol
	real(default), dimension(3) :: a
	complex(default), dimension(:,:), allocatable :: r
	write (u, *)
	a = [1._default, 2._default, 4._default]
	a = a / sqrt (sum (a ** 2))
	write (u, 2) a
	call pol%init_vector (s, a)
	write (u, 2) pol%get_norm ()
	call pol%to_vector (a)
	write (u, 2) a
	call pol%to_matrix (r, only_max_weight = .false.)
	write (u, *)
	where (abs (r) < 1.e-14_default) r = 0
	call write_matrix (r)
	call pol%to_matrix (r, only_max_weight = .true.)
	write (u, *)
	call write_matrix (r)
	2 format (99(1X,F7.4,:))
	end subroutine bloch_massless_vector

	subroutine write_matrix (r)
	complex(default), dimension(:,:), intent(in) :: r
	integer :: i, j
	do i = 1, size (r, 1)
	do j = 1, size (r, 2)
	write (u, 1, advance="no") r(i,j)
	end do
	write (u, *)
	end do
	1 format (99(1X,'(',F7.4,',',F7.4,')',:))
	end subroutine write_matrix

	end subroutine bloch_vectors_7

	@ %def bloch_vectors_7
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Polarization}
	Using generalized Bloch vectors and the $su(N)$ algebra (see above)
	for the internal representation, we can define various modes of
	polarization. For
	spin-1/2, and analogously for massless spin-$s$ particles, we introduce
	\begin{enumerate}
	\item Trivial polarization: $\vec\alpha=0$. [This is unpolarized, but
	distinct from the particular undefined polarization matrix which has
	the same meaning.]
	\item Circular polarization: $\vec\alpha$ points in $\pm z$ direction.
	\item Transversal polarization: $\vec\alpha$ points orthogonal to the
	$z$ direction, with a phase $\phi$ that is $0$ for the $x$ axis, and
	$\pi/2=90^\circ$ for the $y$ axis. For antiparticles, the phase
	switches sign, corresponding to complex conjugation.
	\item Axis polarization, where we explicitly give $\vec\alpha$.
	\end{enumerate}
	For higher spin, we retain this definition, but apply it to the two
	components with maximum and minimum weight. In effect, we concentrate
	on the first three entries in the $\alpha^a$ array. For massless
	particles, this is sufficient. For massive particles, we then add the
	possibilities:
	\begin{enumerate}\setcounter{enumi}{4}
	\item Longitudinal polarization: Only the 0-component is set. This is
	possible only for bosons.
	\item Diagonal polarization: Explicitly specify all components in the
	helicity basis. The $su(N)$ representation consists of diagonal
	generators only, the Cartan subalgebra.
	\end{enumerate}
	Obviously, this does not exhaust the possible density matrices for
	higher spin, but it should cover practical applications.
	<<[[polarizations.f90]]>>=
	<<File header>>

	module polarizations

	<<Use kinds>>
	use io_units
	use format_defs, only: FMT_19
	use diagnostics
	use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
	use flavors
	use helicities
	use quantum_numbers
	use state_matrices
	use bloch_vectors

	<<Standard module head>>

	<<Polarizations: public>>

	<<Polarizations: types>>

	<<Polarizations: interfaces>>

	contains

	<<Polarizations: procedures>>

	end module polarizations
	@ %def polarizations
	@
	\subsection{The polarization type}
	Polarization is active whenever the coefficient array is allocated.
	For convenience, we store the spin type ($2s$) and the multiplicity
	($N$) together with the coefficient array ($\alpha$). We have to allow for
	the massless case where $s$ is arbitrary $>0$ but $N=2$, and
	furthermore the chiral massless case where $N=1$. In the latter case,
	the array remains deallocated but the chirality is set to $\pm 1$.

	There is a convention that an antiparticle transforms according to the
	complex conjugate representation. We apply this only when
	transforming from/to polarization defined by a three-vector. For
	antiparticles, the two-component flips sign in that case. When
	transforming from/to a state matrix or [[pmatrix]] representation, we
	do not apply this sign flip.

	TODO: Check these conventions for consistency.
	<<Polarizations: public>>=
	public :: polarization_t
	<<Polarizations: types>>=
	type :: polarization_t
	private
	integer :: spin_type = SCALAR
	integer :: multiplicity = 1
	integer :: chirality = 0
	logical :: anti = .false.
	type(bloch_vector_t) :: bv
	contains
	<<Polarizations: polarization: TBP>>
	end type polarization_t

	@ %def polarization_t
	@
	\subsection{Basic initializer and finalizer}
	We need the particle flavor for determining the allowed helicity
	values. The Bloch vector is left undefined, so this initializer (in
	two versions) creates an unpolarized particle. Exception: a chiral
	particle is always polarized with definite helicity, it doesn't need a
	Bloch vector.

	This is private.
	<<Polarizations: polarization: TBP>>=
	generic, private :: init => polarization_init, polarization_init_flv
	procedure, private :: polarization_init
	procedure, private :: polarization_init_flv
	<<Polarizations: procedures>>=
	subroutine polarization_init (pol, spin_type, multiplicity, &
	anti, left_handed, right_handed)
	class(polarization_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	integer, intent(in) :: multiplicity
	logical, intent(in) :: anti
	logical, intent(in) :: left_handed
	logical, intent(in) :: right_handed
	pol%spin_type = spin_type
	pol%multiplicity = multiplicity
	pol%anti = anti
	select case (pol%multiplicity)
	case (1)
	if (left_handed) then
	pol%chirality = -1
	else if (right_handed) then
	pol%chirality = 1
	end if
	end select
	select case (pol%chirality)
	case (0)
	call pol%bv%init_unpolarized (spin_type)
	end select
	end subroutine polarization_init

	subroutine polarization_init_flv (pol, flv)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	call pol%init ( &
	spin_type = flv%get_spin_type (), &
	multiplicity = flv%get_multiplicity (), &
	anti = flv%is_antiparticle (), &
	left_handed = flv%is_left_handed (), &
	right_handed = flv%is_right_handed ())
	end subroutine polarization_init_flv

	@ %def polarization_init polarization_init_flv
	@ Generic polarization: as before, but create a polarized particle
	(Bloch vector defined) with initial polarization zero.
	<<Polarizations: polarization: TBP>>=
	generic :: init_generic => &
	polarization_init_generic, &
	polarization_init_generic_flv
	procedure, private :: polarization_init_generic
	procedure, private :: polarization_init_generic_flv
	<<Polarizations: procedures>>=
	subroutine polarization_init_generic (pol, spin_type, multiplicity, &
	anti, left_handed, right_handed)
	class(polarization_t), intent(out) :: pol
	integer, intent(in) :: spin_type
	integer, intent(in) :: multiplicity
	logical, intent(in) :: anti
	logical, intent(in) :: left_handed
	logical, intent(in) :: right_handed
	call pol%init (spin_type, multiplicity, &
	anti, left_handed, right_handed)
	select case (pol%chirality)
	case (0)
	if (pol%multiplicity == pol%bv%get_n_states ()) then
	call pol%bv%init (spin_type)
	else
	call pol%bv%init_max_weight (spin_type)
	end if
	end select
	end subroutine polarization_init_generic

	subroutine polarization_init_generic_flv (pol, flv)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	call pol%init_generic ( &
	spin_type = flv%get_spin_type (), &
	multiplicity = flv%get_multiplicity (), &
	anti = flv%is_antiparticle (), &
	left_handed = flv%is_left_handed (), &
	right_handed = flv%is_right_handed ())
	end subroutine polarization_init_generic_flv

	@ %def polarization_init_generic
	@ A finalizer is no longer necessary.

	\subsection{I/O}
	The default setting produces a tabular output of the polarization
	vector entries. Optionally, we can create a state matrix and write
	its contents, emulating the obsolete original implementation.

	If [[all_states]] is true (default), we generate all helity
	combinations regardless of the matrix-element value. Otherwise, skip
	helicities with zero entry, or absolute value less than [[tolerance]],
	if also given.
	<<Polarizations: polarization: TBP>>=
	procedure :: write => polarization_write
	<<Polarizations: procedures>>=
	subroutine polarization_write (pol, unit, state_matrix, all_states, tolerance)
	class(polarization_t), intent(in) :: pol
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: state_matrix, all_states
	real(default), intent(in), optional :: tolerance
	logical :: state_m
	type(state_matrix_t) :: state
	real(default), dimension(:), allocatable :: a
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	state_m = .false.; if (present (state_matrix)) state_m = state_matrix
	if (pol%anti) then
	write (u, "(1x,A,I1,A,I1,A,L1,A)") &
	"Polarization: [spin_type = ", pol%spin_type, &
	", mult = ", pol%multiplicity, ", anti = ", pol%anti, "]"
	else
	write (u, "(1x,A,I1,A,I1,A)") &
	"Polarization: [spin_type = ", pol%spin_type, &
	", mult = ", pol%multiplicity, "]"
	end if
	if (state_m) then
	call pol%to_state (state, all_states, tolerance)
	call state%write (unit=unit)
	call state%final ()
	else if (pol%chirality == 1) then
	write (u, "(1x,A)") "chirality = +"
	else if (pol%chirality == -1) then
	write (u, "(1x,A)") "chirality = -"
	else if (pol%bv%is_polarized ()) then
	call pol%bv%to_array (a)
	do i = 1, size (a)
	write (u, "(1x,I2,':',1x,F10.7)") i, a(i)
	end do
	else
	write (u, "(1x,A)") "[unpolarized]"
	end if
	end subroutine polarization_write

	@ %def polarization_write
	@ Binary I/O.
	<<Polarizations: polarization: TBP>>=
	procedure :: write_raw => polarization_write_raw
	procedure :: read_raw => polarization_read_raw
	<<Polarizations: procedures>>=
	subroutine polarization_write_raw (pol, u)
	class(polarization_t), intent(in) :: pol
	integer, intent(in) :: u
	write (u) pol%spin_type
	write (u) pol%multiplicity
	write (u) pol%chirality
	write (u) pol%anti
	call pol%bv%write_raw (u)
	end subroutine polarization_write_raw

	subroutine polarization_read_raw (pol, u, iostat)
	class(polarization_t), intent(out) :: pol
	integer, intent(in) :: u
	integer, intent(out), optional :: iostat
	read (u, iostat=iostat) pol%spin_type
	read (u, iostat=iostat) pol%multiplicity
	read (u, iostat=iostat) pol%chirality
	read (u, iostat=iostat) pol%anti
	call pol%bv%read_raw (u, iostat)
	end subroutine polarization_read_raw

	@ %def polarization_read_raw
	@
	\subsection{Accessing contents}
	Return true if the particle is technically polarized. The particle
	is either chiral, or its Bloch vector has been defined. The
	function returns true even if the Bloch vector is zero or the particle
	is scalar.
	<<Polarizations: polarization: TBP>>=
	procedure :: is_polarized => polarization_is_polarized
	<<Polarizations: procedures>>=
	function polarization_is_polarized (pol) result (polarized)
	class(polarization_t), intent(in) :: pol
	logical :: polarized
	polarized = pol%chirality /= 0 .or. pol%bv%is_polarized ()
	end function polarization_is_polarized

	@ %def polarization_is_polarized
	@ Return true if the polarization is diagonal, i.e., all entries in
	the density matrix are diagonal. For an unpolarized particle, we also
	return [[.true.]] since the density matrix is proportional to the unit
	matrix.
	<<Polarizations: polarization: TBP>>=
	procedure :: is_diagonal => polarization_is_diagonal
	<<Polarizations: procedures>>=
	function polarization_is_diagonal (pol) result (diagonal)
	class(polarization_t), intent(in) :: pol
	logical :: diagonal
	select case (pol%chirality)
	case (0)
	diagonal = pol%bv%is_diagonal ()
	case default
	diagonal = .true.
	end select
	end function polarization_is_diagonal

	@ %def polarization_is_diagonal
	@
	\subsection{Mapping between polarization and state matrix}
	Create the polarization object that corresponds to a state matrix. The state
	matrix is not necessarily normalized. The result will be either unpolarized,
	or a generalized Bloch vector that we compute in terms of the appropriate spin
	generator basis. To this end, we first construct the complete density
	matrix, then set the Bloch vector with this input.

	For a naturally chiral particle (i.e., neutrino), we do not set the
	polarization vector, it is implied.

	TODO: The state matrix does not support an antiparticle flag.
	Therefore, we cannot account for any sign flip and transform as-is.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_state_matrix => polarization_init_state_matrix
	<<Polarizations: procedures>>=
	subroutine polarization_init_state_matrix (pol, state)
	class(polarization_t), intent(out) :: pol
	type(state_matrix_t), intent(in), target :: state
	type(state_iterator_t) :: it
	type(flavor_t) :: flv
	type(helicity_t) :: hel
	integer :: d, h1, h2, i, j
	complex(default), dimension(:,:), allocatable :: r
	complex(default) :: me
	real(default) :: trace
	call it%init (state)
	flv = it%get_flavor (1)
	hel = it%get_helicity (1)
	if (hel%is_defined ()) then
	call pol%init_generic (flv)
	select case (pol%chirality)
	case (0)
	trace = 0
	d = pol%bv%get_n_states ()
	allocate (r (d, d), source = (0._default, 0._default))
	do while (it%is_valid ())
	hel = it%get_helicity (1)
	call hel%get_indices (h1, h2)
	i = pol%bv%hel_index (h1)
	j = pol%bv%hel_index (h2)
	me = it%get_matrix_element ()
	r(i,j) = me
	if (i == j) trace = trace + real (me)
	call it%advance ()
	end do
	if (trace /= 0) call pol%bv%set (r / trace)
	end select
	else
	call pol%init (flv)
	end if
	end subroutine polarization_init_state_matrix

	@ %def polarization_init_state_matrix
	@ Create the state matrix that corresponds to a given polarization. We make
	use of the polarization iterator as defined below, which should iterate
	according to the canonical helicity ordering.
	<<Polarizations: polarization: TBP>>=
	procedure :: to_state => polarization_to_state_matrix
	<<Polarizations: procedures>>=
	subroutine polarization_to_state_matrix (pol, state, all_states, tolerance)
	class(polarization_t), intent(in), target :: pol
	type(state_matrix_t), intent(out) :: state
	logical, intent(in), optional :: all_states
	real(default), intent(in), optional :: tolerance
	type(polarization_iterator_t) :: it
	type(quantum_numbers_t), dimension(1) :: qn
	complex(default) :: value
	call it%init (pol, all_states, tolerance)
	call state%init (store_values = .true.)
	do while (it%is_valid ())
	value = it%get_value ()
	qn(1) = it%get_quantum_numbers ()
	call state%add_state (qn, value = value)
	call it%advance ()
	end do
	call state%freeze ()
	end subroutine polarization_to_state_matrix

	@ %def polarization_to_state_matrix
	@
	\subsection{Specific initializers}
	Unpolarized particle, no nontrivial entries in the density matrix. This
	is the default initialization mode.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_unpolarized => polarization_init_unpolarized
	<<Polarizations: procedures>>=
	subroutine polarization_init_unpolarized (pol, flv)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	call pol%init (flv)
	end subroutine polarization_init_unpolarized

	@ %def polarization_init_unpolarized
	@ The following three modes are useful mainly for spin-1/2 particle
	and massless particles of any nonzero spin. Only the highest-weight
	components are filled.

	Circular polarization: The density matrix of the two highest-weight
	states is
	\begin{equation*}
	\rho(f) =
	\frac{1-\|f\|}{2}\mathbf{1} +
	\|f\| \times
	\begin{cases}
	\begin{pmatrix} 1 & 0 \\ 0 & 0 \end{pmatrix}, & f > 0; \\[6pt]
	\begin{pmatrix} 0 & 0 \\ 0 & 1 \end{pmatrix}, & f < 0,
	\end{cases}
	\end{equation*}
	In the generalized Bloch representation, this is an entry for the $T^3$
	generator only, regardless of the spin representation.

	A chiral particle is not affected.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_circular => polarization_init_circular
	<<Polarizations: procedures>>=
	subroutine polarization_init_circular (pol, flv, f)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), intent(in) :: f
	call pol%init (flv)
	select case (pol%chirality)
	case (0)
	call pol%bv%init_vector (pol%spin_type, &
	[0._default, 0._default, f])
	end select
	end subroutine polarization_init_circular

	@ %def polarization_init_circular
	@ Transversal polarization is analogous to circular, but we get a
	density matrix
	\begin{equation*}
	\rho(f,\phi) =
	\frac{1-\|f\|}{2}\mathbf{1}
	+ \frac{\|f\|}{2} \begin{pmatrix} 1 & e^{-i\phi} \\ e^{i\phi} & 1
	\end{pmatrix}.
	\end{equation*}
	for the highest-weight subspace. The lower weights are unaffected.
	The phase is $\phi=0$ for the $x$-axis, $\phi=90^\circ$ for the $y$
	axis as polarization vector.

	For an antiparticle, the phase switches sign, and for $f<0$, the
	off-diagonal elements switch sign.

	A chiral particle is not affected.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_transversal => polarization_init_transversal
	<<Polarizations: procedures>>=
	subroutine polarization_init_transversal (pol, flv, phi, f)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), intent(in) :: phi, f
	call pol%init (flv)
	select case (pol%chirality)
	case (0)
	if (pol%anti) then
	call pol%bv%init_vector (pol%spin_type, &
	[f * cos (phi), f * sin (phi), 0._default])
	else
	call pol%bv%init_vector (pol%spin_type, &
	[f * cos (phi),-f * sin (phi), 0._default])
	end if
	end select
	end subroutine polarization_init_transversal

	@ %def polarization_init_transversal
	@ For axis polarization, we again set only the entries with maximum weight,
	which for spin $1/2$ means
	\begin{equation*}
	\rho(f,\phi) =
	\frac{1}{2} \begin{pmatrix}
	1 + \alpha_3 & \alpha_1 - i\alpha_2 \\
	\alpha_1 + i\alpha_2 & 1 - \alpha_3
	\end{pmatrix}.
	\end{equation*}
	For an antiparticle, the imaginary part proportional to $\alpha_2$ switches
	sign (complex conjugate). A chiral particle is not affected.

	In the generalized Bloch representation, this translates into coefficients for
	$T^{1,2,3}$, all others stay zero.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_axis => polarization_init_axis
	<<Polarizations: procedures>>=
	subroutine polarization_init_axis (pol, flv, alpha)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), dimension(3), intent(in) :: alpha
	call pol%init (flv)
	select case (pol%chirality)
	case (0)
	if (pol%anti) then
	call pol%bv%init_vector (pol%spin_type, &
	[alpha(1), alpha(2), alpha(3)])
	else
	call pol%bv%init_vector (pol%spin_type, &
	[alpha(1),-alpha(2), alpha(3)])
	end if
	end select
	end subroutine polarization_init_axis

	@ %def polarization_init_axis
	@ This version specifies the polarization axis in terms of $r$
	(polarization degree) and $\theta,\phi$ (polar and azimuthal angles).

	If one of the angles is a nonzero multiple of $\pi$, roundoff errors
	typically will result in tiny contributions to unwanted components.
	Therefore, include a catch for small numbers.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_angles => polarization_init_angles
	<<Polarizations: procedures>>=
	subroutine polarization_init_angles (pol, flv, r, theta, phi)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), intent(in) :: r, theta, phi
	real(default), dimension(3) :: alpha
	real(default), parameter :: eps = 10 * epsilon (1._default)

	alpha(1) = r * sin (theta) * cos (phi)
	alpha(2) = r * sin (theta) * sin (phi)
	alpha(3) = r * cos (theta)
	where (abs (alpha) < eps) alpha = 0
	call pol%init_axis (flv, alpha)
	end subroutine polarization_init_angles

	@ %def polarization_init_angles
	@ Longitudinal polarization is defined only for massive bosons. Only
	the zero component is filled. Otherwise, unpolarized.

	In the generalized Bloch representation, the zero component corresponds to a
	linear combination of all diagonal (Cartan) generators.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_longitudinal => polarization_init_longitudinal
	<<Polarizations: procedures>>=
	subroutine polarization_init_longitudinal (pol, flv, f)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), intent(in) :: f
	real(default), dimension(:), allocatable :: rd
	integer :: s, d
	s = flv%get_spin_type ()
	select case (s)
	case (VECTOR, TENSOR)
	call pol%init_generic (flv)
	if (pol%bv%is_polarized ()) then
	d = pol%bv%get_n_states ()
	allocate (rd (d), source = 0._default)
	rd(pol%bv%hel_index (0)) = f
	call pol%bv%set (rd)
	end if
	case default
	call pol%init_unpolarized (flv)
	end select
	end subroutine polarization_init_longitudinal

	@ %def polarization_init_longitudinal
	@ This is diagonal polarization: we specify all components explicitly.
	[[rd]] is the array of diagonal elements of the density matrix. We
	assume that the length of [[rd]] is equal to the particle
	multiplicity.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_diagonal => polarization_init_diagonal
	<<Polarizations: procedures>>=
	subroutine polarization_init_diagonal (pol, flv, rd)
	class(polarization_t), intent(out) :: pol
	type(flavor_t), intent(in) :: flv
	real(default), dimension(:), intent(in) :: rd
	real(default) :: trace
	call pol%init_generic (flv)
	if (pol%bv%is_polarized ()) then
	trace = sum (rd)
	if (trace /= 0) call pol%bv%set (rd / trace)
	end if
	end subroutine polarization_init_diagonal

	@ %def polarization_init_diagonal
	@
	\subsection{Operations}
	Combine polarization states by computing the outer product of the
	state matrices.
	<<Polarizations: public>>=
	public :: combine_polarization_states
	<<Polarizations: procedures>>=
	subroutine combine_polarization_states (pol, state)
	type(polarization_t), dimension(:), intent(in), target :: pol
	type(state_matrix_t), intent(out) :: state
	type(state_matrix_t), dimension(size(pol)), target :: pol_state
	integer :: i
	do i = 1, size (pol)
	call pol(i)%to_state (pol_state(i))
	end do
	call outer_multiply (pol_state, state)
	do i = 1, size (pol)
	call pol_state(i)%final ()
	end do
	end subroutine combine_polarization_states

	@ %def combine_polarization_states
	@ Transform a polarization density matrix into a polarization vector. This is
	possible without information loss only for spin-1/2 and for massless
	particles. To get a unique answer in all cases, we consider only the
	components with highest weight. Obviously, this loses the longitudinal
	component of a massive vector, for instance. The norm of the returned axis is
	the polarization fraction for the highest-weight subspace. For a scalar
	particle, we return a zero vector. The same result applies if the
	highest-weight component vanishes.

	This is the inverse operation of [[polarization_init_axis]] above,
	where the polarization fraction is set to unity.

	For an antiparticle, the [[alpha(2)]] coefficient flips sign.
	<<Polarizations: polarization: TBP>>=
	procedure :: get_axis => polarization_get_axis
	<<Polarizations: procedures>>=
	function polarization_get_axis (pol) result (alpha)
	class(polarization_t), intent(in), target :: pol
	real(default), dimension(3) :: alpha
	select case (pol%chirality)
	case (0)
	call pol%bv%to_vector (alpha)
	if (.not. pol%anti) alpha(2) = - alpha(2)
	case (-1)
	alpha = [0._default, 0._default, -1._default]
	case (1)
	alpha = [0._default, 0._default, 1._default]
	end select
	end function polarization_get_axis

	@ %def polarization_get_axis
	@ This function returns polarization degree and polar and azimuthal
	angles ($\theta,\phi$) of the polarization axis. The same restrictions apply
	as above.

	Since we call the [[get_axis]] method, the phase flips sign for an
	antiparticle.
	<<Polarizations: polarization: TBP>>=
	procedure :: to_angles => polarization_to_angles
	<<Polarizations: procedures>>=
	subroutine polarization_to_angles (pol, r, theta, phi)
	class(polarization_t), intent(in) :: pol
	real(default), intent(out) :: r, theta, phi
	real(default), dimension(3) :: alpha
	real(default) :: norm, r12
	alpha = pol%get_axis ()
	norm = sum (alpha**2)
	r = sqrt (norm)
	if (norm > 0) then
	r12 = sqrt (alpha(1)2 + alpha(2)2)
	theta = atan2 (r12, alpha(3))
	if (any (alpha(1:2) /= 0)) then
	phi = atan2 (alpha(2), alpha(1))
	else
	phi = 0
	end if
	else
	theta = 0
	phi = 0
	end if
	end subroutine polarization_to_angles

	@ %def polarization_to_angles
	@
	\subsection{Polarization Iterator}
	The iterator acts like a state matrix iterator, i.e., it points to one
	helicity combination at a time and can return the corresponding helicity
	object and matrix-element value.

	Since the polarization is stored as a Bloch vector, we recover the
	whole density matrix explicitly upon initialization, store it inside
	the iterator object, and then just return its elements one at a time.

	For an unpolarized particle, the iterator returns a single state with
	undefined helicity. The value is the value of any diagonal density
	matrix element, $1/n$ where $n$ is the multiplicity.
	<<Polarizations: public>>=
	public :: polarization_iterator_t
	<<Polarizations: types>>=
	type :: polarization_iterator_t
	private
	type(polarization_t), pointer :: pol => null ()
	logical :: polarized = .false.
	integer :: h1 = 0
	integer :: h2 = 0
	integer :: i = 0
	integer :: j = 0
	complex(default), dimension(:,:), allocatable :: r
	complex(default) :: value = 1._default
	real(default) :: tolerance = -1._default
	logical :: valid = .false.
	contains
	<<Polarizations: polarization iterator: TBP>>
	end type polarization_iterator_t

	@ %def polarization_iterator_t
	@ Output for debugging purposes only, therefore no format for real/complex.
	<<Polarizations: polarization iterator: TBP>>=
	procedure :: write => polarization_iterator_write
	<<Polarizations: procedures>>=
	subroutine polarization_iterator_write (it, unit)
	class(polarization_iterator_t), intent(in) :: it
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1X,A)") "Polarization iterator:"
	write (u, "(3X,A,L1)") "assigned = ", associated (it%pol)
	write (u, "(3X,A,L1)") "valid = ", it%valid
	if (it%valid) then
	write (u, "(3X,A,2(1X,I2))") "i, j = ", it%i, it%j
	write (u, "(3X,A,2(1X,I2))") "h1, h2 = ", it%h1, it%h2
	write (u, "(3X,A)", advance="no") "value = "
	write (u, *) it%value
	if (allocated (it%r)) then
	do i = 1, size (it%r, 2)
	write (u, *) it%r(i,:)
	end do
	end if
	end if
	end subroutine polarization_iterator_write

	@ %def polarization_iterator_write
	@ Initialize, i.e., (virtually) point to the first helicity state
	supported by the polarization object. If the density matrix is
	nontrivial, we calculate it here.

	Following the older state-matrix
	conventions, the iterator sequence starts at the lowest helicity
	value. In the current internal representation, this corresponds to
	the highest index value.

	If the current matrix-element value is zero, advance the iterator.
	Advancing will stop at a nonzero value or if the iterator becomes
	invalid.

	If [[tolerance]] is given, any state matrix entry less or equal will
	be treated as zero, causing the iterator to skip an entry. By
	default, the value is negative, so no entry is skipped.
	<<Polarizations: polarization iterator: TBP>>=
	procedure :: init => polarization_iterator_init
	<<Polarizations: procedures>>=
	subroutine polarization_iterator_init (it, pol, all_states, tolerance)
	class(polarization_iterator_t), intent(out) :: it
	type(polarization_t), intent(in), target :: pol
	logical, intent(in), optional :: all_states
	real(default), intent(in), optional :: tolerance
	integer :: d
	logical :: only_max_weight
	it%pol => pol
	if (present (all_states)) then
	if (.not. all_states) then
	if (present (tolerance)) then
	it%tolerance = tolerance
	else
	it%tolerance = 0
	end if
	end if
	end if
	select case (pol%chirality)
	case (0)
	d = pol%bv%get_n_states ()
	only_max_weight = pol%multiplicity < d
	it%polarized = pol%bv%is_polarized ()
	if (it%polarized) then
	it%i = d
	it%j = it%i
	it%h1 = pol%bv%hel_value (it%i)
	it%h2 = it%h1
	call pol%bv%to_matrix (it%r, only_max_weight)
	it%value = it%r(it%i, it%j)
	else
	it%value = 1._default / d
	end if
	it%valid = .true.
	case (1,-1)
	it%polarized = .true.
	select case (pol%spin_type)
	case (SPINOR)
	it%h1 = pol%chirality
	case (VECTORSPINOR)
	it%h1 = 2 * pol%chirality
	end select
	it%h2 = it%h1
	it%valid = .true.
	end select
	if (it%valid .and. abs (it%value) <= it%tolerance) call it%advance ()
	end subroutine polarization_iterator_init

	@ %def polarization_iterator_init
	@ Advance to the next valid helicity state. Repeat if the returned value is
	zero.

	For an unpolarized object, we iterate through the diagonal helicity
	states with a constant value.
	<<Polarizations: polarization iterator: TBP>>=
	procedure :: advance => polarization_iterator_advance
	<<Polarizations: procedures>>=
	recursive subroutine polarization_iterator_advance (it)
	class(polarization_iterator_t), intent(inout) :: it
	if (it%valid) then
	select case (it%pol%chirality)
	case (0)
	if (it%polarized) then
	if (it%j > 1) then
	it%j = it%j - 1
	it%h2 = it%pol%bv%hel_value (it%j)
	it%value = it%r(it%i, it%j)
	else if (it%i > 1) then
	it%j = it%pol%bv%get_n_states ()
	it%h2 = it%pol%bv%hel_value (it%j)
	it%i = it%i - 1
	it%h1 = it%pol%bv%hel_value (it%i)
	it%value = it%r(it%i, it%j)
	else
	it%valid = .false.
	end if
	else
	it%valid = .false.
	end if
	case default
	it%valid = .false.
	end select
	if (it%valid .and. abs (it%value) <= it%tolerance) call it%advance ()
	end if
	end subroutine polarization_iterator_advance

	@ %def polarization_iterator_advance
	@ This is true as long as the iterator points to a valid helicity state.
	<<Polarizations: polarization iterator: TBP>>=
	procedure :: is_valid => polarization_iterator_is_valid
	<<Polarizations: procedures>>=
	function polarization_iterator_is_valid (it) result (is_valid)
	logical :: is_valid
	class(polarization_iterator_t), intent(in) :: it
	is_valid = it%valid
	end function polarization_iterator_is_valid

	@ %def polarization_iterator_is_valid
	@ Return the matrix element value for the helicity that we are currently
	pointing at.
	<<Polarizations: polarization iterator: TBP>>=
	procedure :: get_value => polarization_iterator_get_value
	<<Polarizations: procedures>>=
	function polarization_iterator_get_value (it) result (value)
	complex(default) :: value
	class(polarization_iterator_t), intent(in) :: it
	if (it%valid) then
	value = it%value
	else
	value = 0
	end if
	end function polarization_iterator_get_value

	@ %def polarization_iterator_get_value
	@ Return a quantum number object for the helicity that we are currently
	pointing at. This is a single quantum number object, not an array.

	Note that the [[init]] method of the helicity object has the order reversed.
	<<Polarizations: polarization iterator: TBP>>=
	procedure :: get_quantum_numbers => polarization_iterator_get_quantum_numbers
	<<Polarizations: procedures>>=
	function polarization_iterator_get_quantum_numbers (it) result (qn)
	class(polarization_iterator_t), intent(in) :: it
	type(helicity_t) :: hel
	type(quantum_numbers_t) :: qn
	if (it%polarized) then
	call hel%init (it%h2, it%h1)
	end if
	call qn%init (hel)
	end function polarization_iterator_get_quantum_numbers

	@ %def polarization_iterator_get_quantum_numbers
	@
	\subsection{Sparse Matrix}
	We introduce a simple implementation of a sparse matrix that can represent
	polarization (or similar concepts) for transfer to I/O within the
	program. It consists of an integer array that represents the index
	values, and a complex array that represents the nonvanishing entries. The
	number of nonvanishing entries must be known for initialization, but the
	entries are filled one at a time.

	Here is a base type without the special properties of a spin-density matrix.
	<<Polarizations: public>>=
	public :: smatrix_t
	<<Polarizations: types>>=
	type :: smatrix_t
	private
	integer :: dim = 0
	integer :: n_entry = 0
	integer, dimension(:,:), allocatable :: index
	complex(default), dimension(:), allocatable :: value
	contains
	<<Polarizations: smatrix: TBP>>
	end type smatrix_t

	@ %def smatrix_t
	@ Output.
	<<Polarizations: smatrix: TBP>>=
	procedure :: write => smatrix_write
	<<Polarizations: procedures>>=
	subroutine smatrix_write (object, unit, indent)
	class(smatrix_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	integer :: u, i, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	if (allocated (object%value)) then
	if (size (object%value) > 0) then
	do i = 1, object%n_entry
	write (u, "(1x,A,'@(')", advance="no") repeat (" ", ind)
	write (u, "(SP,9999(I2.1,':',1x))", advance="no") &
	object%index(:,i)
	write (u, "('('," // FMT_19 // ",','," // FMT_19 // &
	",'))')") object%value(i)
	end do
	else
	write (u, "(1x,A)", advance="no") repeat (" ", ind)
	write (u, "(A)") "[empty matrix]"
	end if
	else
	write (u, "(1x,A)", advance="no") repeat (" ", ind)
	write (u, "(A)") "[undefined matrix]"
	end if
	end subroutine smatrix_write

	@ %def smatrix_write
	@ Initialization: allocate arrays to the correct size. We specify both the
	dimension of the matrix (if different from two, this is rather a generic
	tensor) and the number of nonvanishing entries.
	<<Polarizations: smatrix: TBP>>=
	procedure :: init => smatrix_init
	<<Polarizations: procedures>>=
	subroutine smatrix_init (smatrix, dim, n_entry)
	class(smatrix_t), intent(out) :: smatrix
	integer, intent(in) :: dim
	integer, intent(in) :: n_entry
	smatrix%dim = dim
	smatrix%n_entry = n_entry
	allocate (smatrix%index (dim, n_entry))
	allocate (smatrix%value (n_entry))
	end subroutine smatrix_init

	@ %def smatrix_init
	@ Fill: one entry at a time.
	<<Polarizations: smatrix: TBP>>=
	procedure :: set_entry => smatrix_set_entry
	<<Polarizations: procedures>>=
	subroutine smatrix_set_entry (smatrix, i, index, value)
	class(smatrix_t), intent(inout) :: smatrix
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: index
	complex(default), intent(in) :: value
	smatrix%index(:,i) = index
	smatrix%value(i) = value
	end subroutine smatrix_set_entry

	@ %def smatrix_set_entry
	@
	<<Polarizations: smatrix: TBP>>=
	procedure :: exists => smatrix_exists
	<<Polarizations: procedures>>=
	elemental function smatrix_exists (smatrix) result (exist)
	logical :: exist
	class(smatrix_t), intent(in) :: smatrix
	exist = .not. all (smatrix%value == 0)
	end function smatrix_exists

	@ %def smatrix_exists
	@
	\subsection{Polarization Matrix}
	As an extension of the more generic [[smatrix]] type, we implement a proper
	spin-density matrix. After the matrix has been filled, we can fix spin type
	and multiplicity for a particle, check the matrix for consistency, and
	normalize it if necessary.

	TODO: This implementation does not have an antiparticle flag, just
	like the state matrix object. We therefore cannot account for sign
	flips when using this object.

	TODO: The [[pure]] flag is for informational purposes only, and it
	only represents a necessary condition if spin is greater than $1/2$.
	We may either check purity for all spins or drop this.
	<<Polarizations: public>>=
	public :: pmatrix_t
	<<Polarizations: types>>=
	type, extends (smatrix_t) :: pmatrix_t
	private
	integer :: spin_type = 0
	integer :: multiplicity = 0
	logical :: massive = .true.
	integer :: chirality = 0
	real(default) :: degree = 1
	logical :: pure = .false.
	contains
	<<Polarizations: pmatrix: TBP>>
	end type pmatrix_t

	@ %def pmatrix_t
	@ Output, including extra data. (The [[indent]] argument is ignored.)
	<<Polarizations: pmatrix: TBP>>=
	procedure :: write => pmatrix_write
	<<Polarizations: procedures>>=
	subroutine pmatrix_write (object, unit, indent)
	class(pmatrix_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Polarization: spin density matrix"
	write (u, "(3x,A,I0)") "spin type = ", object%spin_type
	write (u, "(3x,A,I0)") "multiplicity = ", object%multiplicity
	write (u, "(3x,A,L1)") "massive = ", object%massive
	write (u, "(3x,A,I0)") "chirality = ", object%chirality
	write (u, "(3x,A,F10.7)") "pol.degree =", object%degree
	write (u, "(3x,A,L1)") "pure state = ", object%pure
	call object%smatrix_t%write (u, 1)
	end subroutine pmatrix_write

	@ %def pmatrix_write
	@ This assignment is trivial, but must be coded explicitly.
	<<Polarizations: pmatrix: TBP>>=
	generic :: assignment(=) => pmatrix_assign_from_smatrix
	procedure, private :: pmatrix_assign_from_smatrix
	<<Polarizations: procedures>>=
	subroutine pmatrix_assign_from_smatrix (pmatrix, smatrix)
	class(pmatrix_t), intent(out) :: pmatrix
	type(smatrix_t), intent(in) :: smatrix
	pmatrix%smatrix_t = smatrix
	end subroutine pmatrix_assign_from_smatrix

	@ %def pmatrix_assign_from_smatrix
	@ Declare spin, multiplicity, and polarization degree. Check whether all
	entries fit, and whether this is a valid matrix.

	The required properties are:
	\begin{enumerate}
	\item all entries apply to the given spin and mass type
	\item the diagonal is real
	\item only the upper of corresponding off-diagonal elements is specified,
	i.e., the row index is less than the column index
	\item the trace is nonnegative and equal to the polarization degree (the
	remainder, proportional to the unit matrix, is understood to be present)
	\item the trace of the matrix square is positive and less or equal
	to the trace of the matrix itself, which is the polarization degree.
	\item If the trace of the matrix square and the trace of the matrix are unity,
	we may have a pure state. (For spin up to $1/2$, this is actually
	sufficient.)
	\end{enumerate}
	<<Polarizations: pmatrix: TBP>>=
	procedure :: normalize => pmatrix_normalize
	<<Polarizations: procedures>>=
	subroutine pmatrix_normalize (pmatrix, flv, degree, tolerance)
	class(pmatrix_t), intent(inout) :: pmatrix
	type(flavor_t), intent(in) :: flv
	real(default), intent(in), optional :: degree
	real(default), intent(in), optional :: tolerance
	integer :: i, hmax
	logical :: fermion, ok
	real(default) :: trace, trace_sq
	real(default) :: tol
	tol = 0; if (present (tolerance)) tol = tolerance
	pmatrix%spin_type = flv%get_spin_type ()
	pmatrix%massive = flv%get_mass () /= 0
	if (.not. pmatrix%massive) then
	if (flv%is_left_handed ()) then
	pmatrix%chirality = -1
	else if (flv%is_right_handed ()) then
	pmatrix%chirality = +1
	end if
	end if
	if (pmatrix%spin_type == SCALAR) then
	pmatrix%multiplicity = 1
	else if (pmatrix%massive) then
	pmatrix%multiplicity = pmatrix%spin_type
	else if (pmatrix%chirality == 0) then
	pmatrix%multiplicity = 2
	else
	pmatrix%multiplicity = 1
	end if
	if (present (degree)) then
	if (degree < 0 .or. degree > 1) &
	call msg_error ("polarization degree must be between 0 and 1")
	pmatrix%degree = degree
	end if
	if (size (pmatrix%index, 1) /= 2) call error ("wrong array rank")
	fermion = mod (pmatrix%spin_type, 2) == 0
	hmax = pmatrix%spin_type / 2
	if (pmatrix%n_entry > 0) then
	if (fermion) then
	if (pmatrix%massive) then
	ok = all (pmatrix%index /= 0) &
	.and. all (abs (pmatrix%index) <= hmax)
	else if (pmatrix%chirality == -1) then
	ok = all (pmatrix%index == -hmax)
	else if (pmatrix%chirality == +1) then
	ok = all (pmatrix%index == +hmax)
	else
	ok = all (abs (pmatrix%index) == hmax)
	end if
	else
	if (pmatrix%massive) then
	ok = all (abs (pmatrix%index) <= hmax)
	else
	ok = all (abs (pmatrix%index) == hmax)
	end if
	end if
	if (.not. ok) call error ("illegal index value")
	else
	pmatrix%degree = 0
	pmatrix%pure = pmatrix%multiplicity == 1
	return
	end if
	trace = 0
	do i = 1, pmatrix%n_entry
	associate (index => pmatrix%index(:,i), value => pmatrix%value(i))
	if (index(1) == index(2)) then
	if (abs (aimag (value)) > tol) call error ("diagonal must be real")
	value = real (value, kind=default)
	trace = trace + value

	else if (any (pmatrix%index(1,:) == index(2) &
	.and. pmatrix%index(2,:) == index(1))) then
	call error ("redundant off-diagonal entry")
	else if (index(2) < index (1)) then
	index = index([2,1])
	value = conjg (value)
	end if
	end associate
	end do
	if (abs (trace) <= tol) call error ("trace must not vanish")
	trace = real (trace, kind=default)
	pmatrix%value = pmatrix%value / trace * pmatrix%degree
	trace_sq = (1 - pmatrix%degree ** 2) / pmatrix%multiplicity
	do i = 1, pmatrix%n_entry
	associate (index => pmatrix%index(:,i), value => pmatrix%value(i))
	if (index(1) == index(2)) then
	trace_sq = trace_sq + abs (value) ** 2
	else
	trace_sq = trace_sq + 2 * abs (value) ** 2
	end if
	end associate
	end do
	if (pmatrix%multiplicity == 1) then
	pmatrix%pure = .true.
	else if (abs (trace_sq - 1) <= tol) then
	pmatrix%pure = .true.
	else if (trace_sq - 1 > tol .or. trace_sq < -tol) then
	print *, "Trace of matrix square = ", trace_sq
	call error ("not permissible as density matrix")
	end if
	contains
	subroutine error (msg)
	character(*), intent(in) :: msg
	call pmatrix%write ()
	call msg_fatal ("Spin density matrix: " // msg)
	end subroutine error
	end subroutine pmatrix_normalize

	@ %def pmatrix_normalize
	@
	A polarized matrix is defined as one with a positive polarization degree, even
	if the actual matrix is trivial.
	<<Polarizations: pmatrix: TBP>>=
	procedure :: is_polarized => pmatrix_is_polarized
	<<Polarizations: procedures>>=
	elemental function pmatrix_is_polarized (pmatrix) result (flag)
	class(pmatrix_t), intent(in) :: pmatrix
	logical :: flag
	flag = pmatrix%degree > 0
	end function pmatrix_is_polarized

	@ %def pmatrix_is_polarized
	@
	Check if there are only diagonal entries.
	<<Polarizations: pmatrix: TBP>>=
	procedure :: is_diagonal => pmatrix_is_diagonal
	<<Polarizations: procedures>>=
	elemental function pmatrix_is_diagonal (pmatrix) result (flag)
	class(pmatrix_t), intent(in) :: pmatrix
	logical :: flag
	flag = all (pmatrix%index(1,:) == pmatrix%index(2,:))
	end function pmatrix_is_diagonal

	@ %def pmatrix_is_diagonal
	@
	Check if there are only diagonal entries.
	<<Polarizations: pmatrix: TBP>>=
	procedure :: get_simple_pol => pmatrix_get_simple_pol
	<<Polarizations: procedures>>=
	elemental function pmatrix_get_simple_pol (pmatrix) result (pol)
	class(pmatrix_t), intent(in) :: pmatrix
	real(default) :: pol
	if (pmatrix%is_polarized ()) then
	select case (size (pmatrix%value))
	case (0)
	pol = 0
	case (1)
	pol = pmatrix%index (1,1) * pmatrix%degree
	case (2)
	pol = 42
	end select
	else
	pol = 0
	end if
	end function pmatrix_get_simple_pol

	@ %def pmatrix_get_simple_pol
	@
	\subsection{Data Transformation}
	Create a [[polarization_t]] object from the contents of a normalized
	[[pmatrix_t]] object. We scan the entries as present in [[pmatrix]] and
	transform them into a density matrix, if necessary. The density
	matrix then initializes the Bloch vector. This is
	analogous to [[polarization_init_state_matrix]].

	There is a subtlety associated with massless particles. Since the
	[[pmatrix]] doesn't contain the full density matrix but just the
	nontrivial part, we have to initialize the polarization object with
	the massless equipartion, which contains nonzero entries for the
	Cartan generators. The [[set]] method therefore should not erase
	those initial contents. This is a constraint for the implementation
	of [[set]], as applied to the Bloch vector.

	TODO: As mentioned above, [[pmatrix_t]] does not support an
	antiparticle flag.
	<<Polarizations: polarization: TBP>>=
	procedure :: init_pmatrix => polarization_init_pmatrix
	<<Polarizations: procedures>>=
	subroutine polarization_init_pmatrix (pol, pmatrix)
	class(polarization_t), intent(out) :: pol
	type(pmatrix_t), intent(in) :: pmatrix
	integer :: d, i, j, k, h1, h2
	complex(default), dimension(:,:), allocatable :: r
	call pol%init_generic ( &
	spin_type = pmatrix%spin_type, &
	multiplicity = pmatrix%multiplicity, &
	anti = .false., & !!! SUFFICIENT?
	left_handed = pmatrix%chirality < 0, &
	right_handed = pmatrix%chirality > 0)
	if (pol%bv%is_polarized ()) then
	d = pol%bv%get_n_states ()
	allocate (r (d, d), source = (0._default, 0._default))
	if (d == pmatrix%multiplicity) then
	do i = 1, d
	r(i,i) = (1 - pmatrix%degree) / d
	end do
	else if (d > pmatrix%multiplicity) then
	r(1,1) = (1 - pmatrix%degree) / 2
	r(d,d) = r(1,1)
	end if
	do k = 1, size (pmatrix%value)
	h1 = pmatrix%index(1,k)
	h2 = pmatrix%index(2,k)
	i = pol%bv%hel_index (h1)
	j = pol%bv%hel_index (h2)
	r(i,j) = r(i,j) + pmatrix%value(k)
	r(j,i) = conjg (r(i,j))
	end do
	call pol%bv%set (r)
	end if
	end subroutine polarization_init_pmatrix

	@ %def polarization_init_pmatrix
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[polarizations_ut.f90]]>>=
	<<File header>>

	module polarizations_ut
	use unit_tests
	use polarizations_uti

	<<Standard module head>>

	<<Polarizations: public test>>

	contains

	<<Polarizations: test driver>>

	end module polarizations_ut
	@ %def polarizations_ut
	@
	<<[[polarizations_uti.f90]]>>=
	<<File header>>

	module polarizations_uti

	<<Use kinds>>
	use flavors
	use model_data

	use polarizations

	<<Standard module head>>

	<<Polarizations: test declarations>>

	contains

	<<Polarizations: tests>>

	end module polarizations_uti
	@ %def polarizations_ut
	@ API: driver for the unit tests below.
	<<Polarizations: public test>>=
	public :: polarizations_test
	<<Polarizations: test driver>>=
	subroutine polarizations_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Polarizations: execute tests>>
	end subroutine polarizations_test

	@ %def polarizations_test
	@
	\subsubsection{Polarization type}
	Checking the setup for polarization.
	<<Polarizations: execute tests>>=
	call test (polarization_1, "polarization_1", &
	"check polarization setup", &
	u, results)
	<<Polarizations: test declarations>>=
	public :: polarization_1
	<<Polarizations: tests>>=
	subroutine polarization_1 (u)
	use os_interface
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(polarization_t) :: pol
	type(flavor_t) :: flv
	real(default), dimension(3) :: alpha
	real(default) :: r, theta, phi
	real(default), parameter :: tolerance = 1.E-14_default

	write (u, "(A)") "* Test output: polarization_1"
	write (u, "(A)") "* Purpose: test polarization setup"
	write (u, "(A)")

	write (u, "(A)") "* Reading model file"
	write (u, "(A)")

	call model%init_sm_test ()

	write (u, "(A)") "* Unpolarized fermion"
	write (u, "(A)")

	call flv%init (1, model)
	call pol%init_unpolarized (flv)
	call pol%write (u, state_matrix = .true.)
	write (u, "(A,L1)") " diagonal =", pol%is_diagonal ()

	write (u, "(A)")
	write (u, "(A)") "* Unpolarized fermion"
	write (u, "(A)")

	call pol%init_circular (flv, 0._default)
	call pol%write (u, state_matrix = .true., all_states = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Transversally polarized fermion, phi=0"
	write (u, "(A)")

	call pol%init_transversal (flv, 0._default, 1._default)
	call pol%write (u, state_matrix = .true.)
	write (u, "(A,L1)") " diagonal =", pol%is_diagonal ()

	write (u, "(A)")
	write (u, "(A)") "* Transversally polarized fermion, phi=0.9, frac=0.8"
	write (u, "(A)")

	call pol%init_transversal (flv, 0.9_default, 0.8_default)
	call pol%write (u, state_matrix = .true.)
	write (u, "(A,L1)") " diagonal =", pol%is_diagonal ()

	write (u, "(A)")
	write (u, "(A)") "* All polarization directions of a fermion"
	write (u, "(A)")

	call pol%init_generic (flv)
	call pol%write (u, state_matrix = .true.)


	call flv%init (21, model)

	write (u, "(A)")
	write (u, "(A)") "* Circularly polarized gluon, frac=0.3"
	write (u, "(A)")

	call pol%init_circular (flv, 0.3_default)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)


	call flv%init (23, model)

	write (u, "(A)")
	write (u, "(A)") "* Circularly polarized massive vector, frac=-0.7"
	write (u, "(A)")

	call pol%init_circular (flv, -0.7_default)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(A)") "* Circularly polarized massive vector"
	write (u, "(A)")

	call pol%init_circular (flv, 1._default)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(A)") "* Longitudinally polarized massive vector, frac=0.4"
	write (u, "(A)")

	call pol%init_longitudinal (flv, 0.4_default)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(A)") "* Longitudinally polarized massive vector"
	write (u, "(A)")

	call pol%init_longitudinal (flv, 1._default)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(A)") "* Diagonally polarized massive vector"
	write (u, "(A)")

	call pol%init_diagonal &
	(flv, [2._default, 1._default, 0._default])
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(A)") "* All polarization directions of a massive vector"
	write (u, "(A)")

	call pol%init_generic (flv)
	call pol%write (u, state_matrix = .true.)
	call flv%init (21, model)

	write (u, "(A)")
	write (u, "(A)") "* Axis polarization (0.2, 0.4, 0.6)"
	write (u, "(A)")

	alpha = [0.2_default, 0.4_default, 0.6_default]
	call pol%init_axis (flv, alpha)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(1X,A)") "Recovered axis:"
	alpha = pol%get_axis ()
	write (u, "(3(1X,F10.7))") alpha

	write (u, "(A)")
	write (u, "(A)") "* Angle polarization (0.5, 0.6, -1)"
	r = 0.5_default
	theta = 0.6_default
	phi = -1._default
	call pol%init_angles (flv, r, theta, phi)
	write (u, "(A)")
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)

	write (u, "(A)")
	write (u, "(1X,A)") "Recovered parameters (r, theta, phi):"
	call pol%to_angles (r, theta, phi)
	write (u, "(3(1x,F10.7))") r, theta, phi

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: polarization_1"

	end subroutine polarization_1

	@ %def polarization_1
	@
	\subsubsection{Sparse-Matrix type}
	Use a sparse density matrix universally as the input for setting up
	polarization.
	<<Polarizations: execute tests>>=
	call test (polarization_2, "polarization_2", &
	"matrix polarization setup", &
	u, results)
	<<Polarizations: test declarations>>=
	public :: polarization_2
	<<Polarizations: tests>>=
	subroutine polarization_2 (u)
	use os_interface
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t) :: flv
	type(polarization_t) :: pol
	real(default), dimension(3) :: alpha
	type(pmatrix_t) :: pmatrix
	real(default), parameter :: tolerance = 1e-8_default

	write (u, "(A)") "* Test output: polarization_2"
	write (u, "(A)") "* Purpose: matrix polarization setup"
	write (u, "(A)")

	write (u, "(A)") "* Reading model file"
	write (u, "(A)")

	call model%init_sm_test ()

	write (u, "(A)") "* Unpolarized fermion"
	write (u, "(A)")

	call flv%init (1, model)
	call pmatrix%init (2, 0)
	call pmatrix%normalize (flv, 0._default, tolerance)
	call pmatrix%write (u)
	write (u, *)
	write (u, "(1x,A,L1)") "polarized = ", pmatrix%is_polarized ()
	write (u, "(1x,A,L1)") "diagonal = ", pmatrix%is_diagonal ()
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Transversally polarized fermion, phi=0"
	write (u, "(A)")

	call pmatrix%init (2, 3)
	call pmatrix%set_entry (1, [-1,-1], (1._default, 0._default))
	call pmatrix%set_entry (2, [+1,+1], (1._default, 0._default))
	call pmatrix%set_entry (3, [-1,+1], (1._default, 0._default))
	call pmatrix%normalize (flv, 1._default, tolerance)
	call pmatrix%write (u)
	write (u, *)
	write (u, "(1x,A,L1)") "polarized = ", pmatrix%is_polarized ()
	write (u, "(1x,A,L1)") "diagonal = ", pmatrix%is_diagonal ()
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Transversally polarized fermion, phi=0.9, frac=0.8"
	write (u, "(A)")

	call pmatrix%init (2, 3)
	call pmatrix%set_entry (1, [-1,-1], (1._default, 0._default))
	call pmatrix%set_entry (2, [+1,+1], (1._default, 0._default))
	call pmatrix%set_entry (3, [-1,+1], exp ((0._default, -0.9_default)))
	call pmatrix%normalize (flv, 0.8_default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true.)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Left-handed massive fermion, frac=1"
	write (u, "(A)")

	call flv%init (11, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [-1,-1], (1._default, 0._default))
	call pmatrix%normalize (flv, 1._default, tolerance)
	call pmatrix%write (u)
	write (u, *)
	write (u, "(1x,A,L1)") "polarized = ", pmatrix%is_polarized ()
	write (u, "(1x,A,L1)") "diagonal = ", pmatrix%is_diagonal ()
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Left-handed massive fermion, frac=0.8"
	write (u, "(A)")

	call flv%init (11, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [-1,-1], (1._default, 0._default))
	call pmatrix%normalize (flv, 0.8_default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Left-handed massless fermion"
	write (u, "(A)")

	call flv%init (12, model)
	call pmatrix%init (2, 0)
	call pmatrix%normalize (flv, 1._default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true.)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Right-handed massless fermion, frac=0.5"
	write (u, "(A)")

	call flv%init (-12, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [1,1], (1._default, 0._default))
	call pmatrix%normalize (flv, 0.5_default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true.)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Circularly polarized gluon, frac=0.3"
	write (u, "(A)")

	call flv%init (21, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [1,1], (1._default, 0._default))
	call pmatrix%normalize (flv, 0.3_default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Circularly polarized massive vector, frac=0.7"
	write (u, "(A)")

	call flv%init (23, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [1,1], (1._default, 0._default))
	call pmatrix%normalize (flv, 0.7_default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Circularly polarized massive vector"
	write (u, "(A)")

	call flv%init (23, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [1,1], (1._default, 0._default))
	call pmatrix%normalize (flv, 1._default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Longitudinally polarized massive vector, frac=0.4"
	write (u, "(A)")

	call flv%init (23, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [0,0], (1._default, 0._default))
	call pmatrix%normalize (flv, 0.4_default, tolerance)
	call pmatrix%write (u)
	write (u, *)
	write (u, "(1x,A,L1)") "polarized = ", pmatrix%is_polarized ()
	write (u, "(1x,A,L1)") "diagonal = ", pmatrix%is_diagonal ()
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Longitudinally polarized massive vector"
	write (u, "(A)")

	call flv%init (23, model)
	call pmatrix%init (2, 1)
	call pmatrix%set_entry (1, [0,0], (1._default, 0._default))
	call pmatrix%normalize (flv, 1._default, tolerance)
	call pmatrix%write (u)
	write (u, *)
	write (u, "(1x,A,L1)") "polarized = ", pmatrix%is_polarized ()
	write (u, "(1x,A,L1)") "diagonal = ", pmatrix%is_diagonal ()
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true., &
	all_states = .false., tolerance = tolerance)
	! call pol%final ()

	write (u, "(A)")
	write (u, "(A)") "* Axis polarization (0.2, 0.4, 0.6)"
	write (u, "(A)")

	call flv%init (11, model)
	alpha = [0.2_default, 0.4_default, 0.6_default]
	alpha = alpha / sqrt (sum (alpha**2))
	call pmatrix%init (2, 3)
	call pmatrix%set_entry (1, [-1,-1], cmplx (1 - alpha(3), kind=default))
	call pmatrix%set_entry (2, [1,-1], &
	cmplx (alpha(1),-alpha(2), kind=default))
	call pmatrix%set_entry (3, [1,1], cmplx (1 + alpha(3), kind=default))
	call pmatrix%normalize (flv, 1._default, tolerance)
	call pmatrix%write (u)
	write (u, *)

	call pol%init_pmatrix (pmatrix)
	call pol%write (u, state_matrix = .true.)
	! call pol%final ()

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: polarization_2"

	end subroutine polarization_2

	@ %def polarization_2
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Particles}
	This module defines the [[particle_t]] object type, and the methods
	and operations that deal with it.
	<<[[particles.f90]]>>=
	<<File header>>

	module particles

	<<Use kinds with double>>
	<<Use strings>>
	use io_units
	use format_utils, only: write_compressed_integer_array, write_separator
	use format_utils, only: pac_fmt
	use format_defs, only: FMT_16, FMT_19
	use numeric_utils
	use diagnostics
	use lorentz
	use model_data
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use state_matrices
	use interactions
	use subevents
	use polarizations
	use pdg_arrays, only: is_quark, is_gluon

	<<Standard module head>>

	<<Particles: public>>

	<<Particles: parameters>>

	<<Particles: types>>

	<<Particles: interfaces>>

	contains

	<<Particles: procedures>>

	end module particles
	@ %def particles
	@
	\subsection{The particle type}
	\subsubsection{Particle status codes}
	The overall status codes (incoming/outgoing etc.) are inherited from
	the module [[subevents]].

	Polarization status:
	<<Particles: parameters>>=
	integer, parameter, public :: PRT_UNPOLARIZED = 0
	integer, parameter, public :: PRT_DEFINITE_HELICITY = 1
	integer, parameter, public :: PRT_GENERIC_POLARIZATION = 2

	@ %def PRT_UNPOLARIZED PRT_DEFINITE_HELICITY PRT_GENERIC_POLARIZATION
	@
	\subsubsection{Definition}
	The quantum numbers are flavor (from which invariant particle
	properties can be derived), color, and polarization. The particle may
	be unpolarized. In this case, [[hel]] and [[pol]] are unspecified.
	If it has a definite helicity, the [[hel]] component is defined. If
	it has a generic polarization, the [[pol]] component is defined. For
	each particle we store the four-momentum and the invariant mass
	squared, i.e., the squared norm of the four-momentum. There is also
	an optional list of parent and child particles, for bookkeeping in
	physical events. The [[vertex]] is an optional component that consists of
	a Lorentz 4-vector, denoting the position and time of the vertex
	(displaced vertex/time). [[lifetime]] is an optional component that
	accounts for the finite lifetime $\tau$ of a decaying particle. In
	case there is no magnetic field etc., the true decay vertex of a
	particle in the detector would be $\vec{v}^\prime = \vec{v} + \tau
	\times \vec{p}/p^0$, where $p^0$ and $\vec{p}$ are the energy and
	3-momentum of the particle.

	<<Particles: public>>=
	public :: particle_t
	<<Particles: types>>=
	type :: particle_t
	!private
	integer :: status = PRT_UNDEFINED
	integer :: polarization = PRT_UNPOLARIZED
	type(flavor_t) :: flv
	type(color_t) :: col
	type(helicity_t) :: hel
	type(polarization_t) :: pol
	type(vector4_t) :: p = vector4_null
	real(default) :: p2 = 0
	type(vector4_t), allocatable :: vertex
	real(default), allocatable :: lifetime
	integer, dimension(:), allocatable :: parent
	integer, dimension(:), allocatable :: child
	contains
	<<Particles: particle: TBP>>
	end type particle_t

	@ %def particle_t
	@ Copy a particle. (Deep copy) This excludes the parent-child
	relations.
	<<Particles: particle: TBP>>=
	generic :: init => init_particle
	procedure :: init_particle => particle_init_particle
	<<Particles: procedures>>=
	subroutine particle_init_particle (prt_out, prt_in)
	class(particle_t), intent(out) :: prt_out
	type(particle_t), intent(in) :: prt_in
	prt_out%status = prt_in%status
	prt_out%polarization = prt_in%polarization
	prt_out%flv = prt_in%flv
	prt_out%col = prt_in%col
	prt_out%hel = prt_in%hel
	prt_out%pol = prt_in%pol
	prt_out%p = prt_in%p
	prt_out%p2 = prt_in%p2
	if (allocated (prt_in%vertex)) &
	allocate (prt_out%vertex, source=prt_in%vertex)
	if (allocated (prt_in%lifetime)) &
	allocate (prt_out%lifetime, source=prt_in%lifetime)
	end subroutine particle_init_particle

	@ %def particle_init_particle
	@ Initialize a particle using external information.
	<<Particles: particle: TBP>>=
	generic :: init => init_external
	procedure :: init_external => particle_init_external
	<<Particles: procedures>>=
	subroutine particle_init_external &
	(particle, status, pdg, model, col, anti_col, mom)
	class(particle_t), intent(out) :: particle
	integer, intent(in) :: status, pdg, col, anti_col
	class(model_data_t), pointer, intent(in) :: model
	type(vector4_t), intent(in) :: mom
	type(flavor_t) :: flavor
	type(color_t) :: color
	call flavor%init (pdg, model)
	call particle%set_flavor (flavor)
	call color%init_col_acl (col, anti_col)
	call particle%set_color (color)
	call particle%set_status (status)
	call particle%set_momentum (mom)
	end subroutine particle_init_external

	@ %def particle_init_external
	@ Initialize a particle using a single-particle state matrix which
	determines flavor, color, and polarization. The state matrix must
	have unique flavor and color. The factorization mode determines
	whether the particle is unpolarized, has definite helicity, or generic
	polarization. This mode is translated into the polarization status.
	<<Particles: particle: TBP>>=
	generic :: init => init_state
	procedure :: init_state => particle_init_state
	<<Particles: procedures>>=
	subroutine particle_init_state (prt, state, status, mode)
	class(particle_t), intent(out) :: prt
	type(state_matrix_t), intent(in), target :: state
	integer, intent(in) :: status, mode
	type(state_iterator_t) :: it
	prt%status = status
	call it%init (state)
	prt%flv = it%get_flavor (1)
	if (prt%flv%is_radiated ()) prt%status = PRT_BEAM_REMNANT
	prt%col = it%get_color (1)
	select case (mode)
	case (FM_SELECT_HELICITY)
	prt%hel = it%get_helicity (1)
	if (prt%hel%is_defined ()) then
	prt%polarization = PRT_DEFINITE_HELICITY
	end if
	case (FM_FACTOR_HELICITY)
	call prt%pol%init_state_matrix (state)
	prt%polarization = PRT_GENERIC_POLARIZATION
	end select
	end subroutine particle_init_state

	@ %def particle_init_state
	@ Finalizer.
	<<Particles: particle: TBP>>=
	procedure :: final => particle_final
	<<Particles: procedures>>=
	subroutine particle_final (prt)
	class(particle_t), intent(inout) :: prt
	if (allocated (prt%vertex)) deallocate (prt%vertex)
	if (allocated (prt%lifetime)) deallocate (prt%lifetime)
	end subroutine particle_final

	@ %def particle_final
	@
	\subsubsection{I/O}
	<<Particles: particle: TBP>>=
	procedure :: write => particle_write
	<<Particles: procedures>>=
	subroutine particle_write (prt, unit, testflag, compressed, polarization)
	class(particle_t), intent(in) :: prt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag, compressed, polarization
	logical :: comp, pacified, pol
	integer :: u, h1, h2
	real(default) :: pp2
	character(len=7) :: fmt
	character(len=20) :: buffer
	comp = .false.; if (present (compressed)) comp = compressed
	pacified = .false.; if (present (testflag)) pacified = testflag
	pol = .true.; if (present (polarization)) pol = polarization
	call pac_fmt (fmt, FMT_19, FMT_16, testflag)
	u = given_output_unit (unit); if (u < 0) return
	pp2 = prt%p2
	if (pacified) call pacify (pp2, tolerance = 1E-10_default)
	select case (prt%status)
	case (PRT_UNDEFINED); write (u, "(1x, A)", advance="no") "[-]"
	case (PRT_BEAM); write (u, "(1x, A)", advance="no") "[b]"
	case (PRT_INCOMING); write (u, "(1x, A)", advance="no") "[i]"
	case (PRT_OUTGOING); write (u, "(1x, A)", advance="no") "[o]"
	case (PRT_VIRTUAL); write (u, "(1x, A)", advance="no") "[v]"
	case (PRT_RESONANT); write (u, "(1x, A)", advance="no") "[r]"
	case (PRT_BEAM_REMNANT); write (u, "(1x, A)", advance="no") "[x]"
	end select
	write (u, "(1x)", advance="no")
	if (comp) then
	write (u, "(A7,1X)", advance="no") char (prt%flv%get_name ())
	if (pol) then
	select case (prt%polarization)
	case (PRT_DEFINITE_HELICITY)
	! Integer helicity, assumed diagonal
	call prt%hel%get_indices (h1, h2)
	write (u, "(I2,1X)", advance="no") h1
	case (PRT_GENERIC_POLARIZATION)
	! No space for full density matrix here
	write (u, "(A2,1X)", advance="no") "*"
	case default
	! Blank entry if helicity is undefined
	write (u, "(A2,1X)", advance="no") " "
	end select
	end if
	write (u, "(2(I4,1X))", advance="no") &
	prt%col%get_col (), prt%col%get_acl ()
	call write_compressed_integer_array (buffer, prt%parent)
	write (u, "(A,1X)", advance="no") buffer
	call write_compressed_integer_array (buffer, prt%child)
	write (u, "(A,1X)", advance="no") buffer
	call prt%p%write(u, testflag = testflag, compressed = comp)
	write (u, "(F12.3)") pp2
	else
	call prt%flv%write (unit)
	if (prt%col%is_nonzero ()) then
	call color_write (prt%col, unit)
	end if
	if (pol) then
	select case (prt%polarization)
	case (PRT_DEFINITE_HELICITY)
	call prt%hel%write (unit)
	write (u, *)
	case (PRT_GENERIC_POLARIZATION)
	write (u, *)
	call prt%pol%write (unit, state_matrix = .true.)
	case default
	write (u, *)
	end select
	else
	write (u, *)
	end if
	call prt%p%write (unit, testflag = testflag)
	write (u, "(1x,A,1x," // fmt // ")") "T = ", pp2
	if (allocated (prt%parent)) then
	if (size (prt%parent) /= 0) then
	write (u, "(1x,A,40(1x,I0))") "Parents: ", prt%parent
	end if
	end if
	if (allocated (prt%child)) then
	if (size (prt%child) /= 0) then
	write (u, "(1x,A,40(1x,I0))") "Children:", prt%child
	end if
	end if
	if (allocated (prt%vertex)) then
	write (u, "(1x,A,1x," // fmt // ")") "Vtx t = ", prt%vertex%p(0)
	write (u, "(1x,A,1x," // fmt // ")") "Vtx x = ", prt%vertex%p(1)
	write (u, "(1x,A,1x," // fmt // ")") "Vtx y = ", prt%vertex%p(2)
	write (u, "(1x,A,1x," // fmt // ")") "Vtx z = ", prt%vertex%p(3)
	end if
	if (allocated (prt%lifetime)) then
	write (u, "(1x,A,1x," // fmt // ")") "Lifetime = ", &
	prt%lifetime
	end if
	end if
	end subroutine particle_write

	@ %def particle_write
	@ Binary I/O:
	<<Particles: particle: TBP>>=
	procedure :: write_raw => particle_write_raw
	procedure :: read_raw => particle_read_raw
	<<Particles: procedures>>=
	subroutine particle_write_raw (prt, u)
	class(particle_t), intent(in) :: prt
	integer, intent(in) :: u
	write (u) prt%status, prt%polarization
	call prt%flv%write_raw (u)
	call prt%col%write_raw (u)
	select case (prt%polarization)
	case (PRT_DEFINITE_HELICITY)
	call prt%hel%write_raw (u)
	case (PRT_GENERIC_POLARIZATION)
	call prt%pol%write_raw (u)
	end select
	call vector4_write_raw (prt%p, u)
	write (u) prt%p2
	write (u) allocated (prt%parent)
	if (allocated (prt%parent)) then
	write (u) size (prt%parent)
	write (u) prt%parent
	end if
	write (u) allocated (prt%child)
	if (allocated (prt%child)) then
	write (u) size (prt%child)
	write (u) prt%child
	end if
	write (u) allocated (prt%vertex)
	if (allocated (prt%vertex)) then
	call vector4_write_raw (prt%vertex, u)
	end if
	write (u) allocated (prt%lifetime)
	if (allocated (prt%lifetime)) then
	write (u) prt%lifetime
	end if
	end subroutine particle_write_raw

	subroutine particle_read_raw (prt, u, iostat)
	class(particle_t), intent(out) :: prt
	integer, intent(in) :: u
	integer, intent(out) :: iostat
	logical :: allocated_parent, allocated_child
	logical :: allocated_vertex, allocated_lifetime
	integer :: size_parent, size_child
	read (u, iostat=iostat) prt%status, prt%polarization
	call prt%flv%read_raw (u, iostat=iostat)
	call prt%col%read_raw (u, iostat=iostat)
	select case (prt%polarization)
	case (PRT_DEFINITE_HELICITY)
	call prt%hel%read_raw (u, iostat=iostat)
	case (PRT_GENERIC_POLARIZATION)
	call prt%pol%read_raw (u, iostat=iostat)
	end select
	call vector4_read_raw (prt%p, u, iostat=iostat)
	read (u, iostat=iostat) prt%p2
	read (u, iostat=iostat) allocated_parent
	if (allocated_parent) then
	read (u, iostat=iostat) size_parent
	allocate (prt%parent (size_parent))
	read (u, iostat=iostat) prt%parent
	end if
	read (u, iostat=iostat) allocated_child
	if (allocated_child) then
	read (u, iostat=iostat) size_child
	allocate (prt%child (size_child))
	read (u, iostat=iostat) prt%child
	end if
	read (u, iostat=iostat) allocated_vertex
	if (allocated_vertex) then
	allocate (prt%vertex)
	read (u, iostat=iostat) prt%vertex%p
	end if
	read (u, iostat=iostat) allocated_lifetime
	if (allocated_lifetime) then
	allocate (prt%lifetime)
	read (u, iostat=iostat) prt%lifetime
	end if
	end subroutine particle_read_raw

	@ %def particle_write_raw particle_read_raw
	@
	\subsubsection{Setting contents}
	Reset the status code. Where applicable, set $p^2$ assuming that the
	particle is on-shell.
	<<Particles: particle: TBP>>=
	procedure :: reset_status => particle_reset_status
	<<Particles: procedures>>=
	elemental subroutine particle_reset_status (prt, status)
	class(particle_t), intent(inout) :: prt
	integer, intent(in) :: status
	prt%status = status
	select case (status)
	case (PRT_BEAM, PRT_INCOMING, PRT_OUTGOING)
	prt%p2 = prt%flv%get_mass () ** 2
	end select
	end subroutine particle_reset_status

	@ %def particle_reset_status
	@ The color can be given explicitly.
	<<Particles: particle: TBP>>=
	procedure :: set_color => particle_set_color
	<<Particles: procedures>>=
	elemental subroutine particle_set_color (prt, col)
	class(particle_t), intent(inout) :: prt
	type(color_t), intent(in) :: col
	prt%col = col
	end subroutine particle_set_color

	@ %def particle_set_color
	@ The flavor can be given explicitly.
	<<Particles: particle: TBP>>=
	procedure :: set_flavor => particle_set_flavor
	<<Particles: procedures>>=
	subroutine particle_set_flavor (prt, flv)
	class(particle_t), intent(inout) :: prt
	type(flavor_t), intent(in) :: flv
	prt%flv = flv
	end subroutine particle_set_flavor

	@ %def particle_set_flavor
	@ As can the helicity.
	<<Particles: particle: TBP>>=
	procedure :: set_helicity => particle_set_helicity
	<<Particles: procedures>>=
	subroutine particle_set_helicity (prt, hel)
	class(particle_t), intent(inout) :: prt
	type(helicity_t), intent(in) :: hel
	prt%hel = hel
	end subroutine particle_set_helicity

	@ %def particle_set_helicity
	@ And the polarization.
	<<Particles: particle: TBP>>=
	procedure :: set_pol => particle_set_pol
	<<Particles: procedures>>=
	subroutine particle_set_pol (prt, pol)
	class(particle_t), intent(inout) :: prt
	type(polarization_t), intent(in) :: pol
	prt%pol = pol
	end subroutine particle_set_pol

	@ %def particle_set_pol
	@ Manually set the model for the particle flavor. This is required, e.g., if
	the particle has been read from file.
	<<Particles: particle: TBP>>=
	procedure :: set_model => particle_set_model
	<<Particles: procedures>>=
	subroutine particle_set_model (prt, model)
	class(particle_t), intent(inout) :: prt
	class(model_data_t), intent(in), target :: model
	call prt%flv%set_model (model)
	end subroutine particle_set_model

	@ %def particle_set_model
	@ The momentum is set independent of the quantum numbers.
	<<Particles: particle: TBP>>=
	procedure :: set_momentum => particle_set_momentum
	<<Particles: procedures>>=
	elemental subroutine particle_set_momentum (prt, p, p2, on_shell)
	class(particle_t), intent(inout) :: prt
	type(vector4_t), intent(in) :: p
	real(default), intent(in), optional :: p2
	logical, intent(in), optional :: on_shell
	prt%p = p
	if (present (on_shell)) then
	if (on_shell) then
	if (prt%flv%is_associated ()) then
	prt%p2 = prt%flv%get_mass () ** 2
	return
	end if
	end if
	end if
	if (present (p2)) then
	prt%p2 = p2
	else
	prt%p2 = p ** 2
	end if
	end subroutine particle_set_momentum

	@ %def particle_set_momentum
	@ Set resonance information. This should be done after momentum
	assignment, because we need to know wheter the particle is spacelike
	or timelike. The resonance flag is defined only for virtual
	particles.
	<<Particle: particle: TBP>>=
	procedure :: set_resonance_flag => particle_set_resonance_flag
	<<Particles: procedures>>=
	elemental subroutine particle_set_resonance_flag (prt, resonant)
	class(particle_t), intent(inout) :: prt
	logical, intent(in) :: resonant
	select case (prt%status)
	case (PRT_VIRTUAL)
	if (resonant) prt%status = PRT_RESONANT
	end select
	end subroutine particle_set_resonance_flag

	@ %def particle_set_resonance_flag
	@ Set children and parents information.
	<<Particles: particle: TBP>>=
	procedure :: set_children => particle_set_children
	procedure :: set_parents => particle_set_parents
	<<Particles: procedures>>=
	subroutine particle_set_children (prt, idx)
	class(particle_t), intent(inout) :: prt
	integer, dimension(:), intent(in) :: idx
	if (allocated (prt%child)) deallocate (prt%child)
	allocate (prt%child (count (idx /= 0)))
	prt%child = pack (idx, idx /= 0)
	end subroutine particle_set_children

	subroutine particle_set_parents (prt, idx)
	class(particle_t), intent(inout) :: prt
	integer, dimension(:), intent(in) :: idx
	if (allocated (prt%parent)) deallocate (prt%parent)
	allocate (prt%parent (count (idx /= 0)))
	prt%parent = pack (idx, idx /= 0)
	end subroutine particle_set_parents

	@ %def particle_set_children particle_set_parents
	@
	<<Particles: particle: TBP>>=
	procedure :: add_child => particle_add_child
	<<Particles: procedures>>=
	subroutine particle_add_child (prt, new_child)
	class(particle_t), intent(inout) :: prt
	integer, intent(in) :: new_child
	integer, dimension(:), allocatable :: idx
	integer :: n, i
	n = prt%get_n_children()
	if (n == 0) then
	call prt%set_children ([new_child])
	else
	do i = 1, n
	if (prt%child(i) == new_child) then
	return
	end if
	end do
	allocate (idx (1:n+1))
	idx(1:n) = prt%get_children ()
	idx(n+1) = new_child
	call prt%set_children (idx)
	end if
	end subroutine particle_add_child

	@ %def particle_add_child
	@
	<<Particles: particle: TBP>>=
	procedure :: add_children => particle_add_children
	<<Particles: procedures>>=
	subroutine particle_add_children (prt, new_child)
	class(particle_t), intent(inout) :: prt
	integer, dimension(:), intent(in) :: new_child
	integer, dimension(:), allocatable :: idx
	integer :: n
	n = prt%get_n_children()
	if (n == 0) then
	call prt%set_children (new_child)
	else
	allocate (idx (1:n+size(new_child)))
	idx(1:n) = prt%get_children ()
	idx(n+1:n+size(new_child)) = new_child
	call prt%set_children (idx)
	end if
	end subroutine particle_add_children

	@ %def particle_add_children
	@
	<<Particles: particle: TBP>>=
	procedure :: set_status => particle_set_status
	<<Particles: procedures>>=
	elemental subroutine particle_set_status (prt, status)
	class(particle_t), intent(inout) :: prt
	integer, intent(in) :: status
	prt%status = status
	end subroutine particle_set_status

	@ %def particle_set_status
	@
	<<Particles: particle: TBP>>=
	procedure :: set_polarization => particle_set_polarization
	<<Particles: procedures>>=
	subroutine particle_set_polarization (prt, polarization)
	class(particle_t), intent(inout) :: prt
	integer, intent(in) :: polarization
	prt%polarization = polarization
	end subroutine particle_set_polarization

	@ %def particle_set_polarization
	@
	<<Particles: particle: TBP>>=
	generic :: set_vertex => set_vertex_from_vector3, set_vertex_from_xyz, &
	set_vertex_from_vector4, set_vertex_from_xyzt
	procedure :: set_vertex_from_vector4 => particle_set_vertex_from_vector4
	procedure :: set_vertex_from_vector3 => particle_set_vertex_from_vector3
	procedure :: set_vertex_from_xyzt => particle_set_vertex_from_xyzt
	procedure :: set_vertex_from_xyz => particle_set_vertex_from_xyz
	<<Particles: procedures>>=
	subroutine particle_set_vertex_from_vector4 (prt, vertex)
	class(particle_t), intent(inout) :: prt
	type(vector4_t), intent(in) :: vertex
	if (allocated (prt%vertex)) deallocate (prt%vertex)
	allocate (prt%vertex, source=vertex)
	end subroutine particle_set_vertex_from_vector4

	subroutine particle_set_vertex_from_vector3 (prt, vertex)
	class(particle_t), intent(inout) :: prt
	type(vector3_t), intent(in) :: vertex
	type(vector4_t) :: vtx
	vtx = vector4_moving (0._default, vertex)
	if (allocated (prt%vertex)) deallocate (prt%vertex)
	allocate (prt%vertex, source=vtx)
	end subroutine particle_set_vertex_from_vector3

	subroutine particle_set_vertex_from_xyzt (prt, vx, vy, vz, t)
	class(particle_t), intent(inout) :: prt
	real(default), intent(in) :: vx, vy, vz, t
	type(vector4_t) :: vertex
	if (allocated (prt%vertex)) deallocate (prt%vertex)
	vertex = vector4_moving (t, vector3_moving ([vx, vy, vz]))
	allocate (prt%vertex, source=vertex)
	end subroutine particle_set_vertex_from_xyzt

	subroutine particle_set_vertex_from_xyz (prt, vx, vy, vz)
	class(particle_t), intent(inout) :: prt
	real(default), intent(in) :: vx, vy, vz
	type(vector4_t) :: vertex
	if (allocated (prt%vertex)) deallocate (prt%vertex)
	vertex = vector4_moving (0._default, vector3_moving ([vx, vy, vz]))
	allocate (prt%vertex, source=vertex)
	end subroutine particle_set_vertex_from_xyz

	@ %def particle_set_vertex_from_vector3
	@ %def particle_set_vertex_from_vector4
	@ %def particle_set_vertex_from_xyz
	@ %def particle_set_vertex_from_xyzt
	@ Set the lifetime of a particle.
	<<Particles: particle: TBP>>=
	procedure :: set_lifetime => particle_set_lifetime
	<<Particles: procedures>>=
	elemental subroutine particle_set_lifetime (prt, lifetime)
	class(particle_t), intent(inout) :: prt
	real(default), intent(in) :: lifetime
	if (allocated (prt%lifetime)) deallocate (prt%lifetime)
	allocate (prt%lifetime, source=lifetime)
	end subroutine particle_set_lifetime

	@ %def particle_set_lifetime
	@
	\subsubsection{Accessing contents}
	The status code.
	<<Particles: particle: TBP>>=
	procedure :: get_status => particle_get_status
	<<Particles: procedures>>=
	elemental function particle_get_status (prt) result (status)
	integer :: status
	class(particle_t), intent(in) :: prt
	status = prt%status
	end function particle_get_status

	@ %def particle_get_status
	@ Return true if the status is either [[INCOMING]],
	[[OUTGOING]] or [[RESONANT]]. [[BEAM]] is kept, if
	[[keep_beams]] is set true.
	<<Particles: particle: TBP>>=
	procedure :: is_real => particle_is_real
	<<Particles: procedures>>=
	elemental function particle_is_real (prt, keep_beams) result (flag)
	logical :: flag, kb
	class(particle_t), intent(in) :: prt
	logical, intent(in), optional :: keep_beams
	kb = .false.
	if (present (keep_beams)) kb = keep_beams
	select case (prt%status)
	case (PRT_INCOMING, PRT_OUTGOING, PRT_RESONANT)
	flag = .true.
	case (PRT_BEAM)
	flag = kb
	case default
	flag = .false.
	end select
	end function particle_is_real

	@ %def particle_is_real
	@
	<<Particles: particle: TBP>>=
	procedure :: is_colored => particle_is_colored
	<<Particles: procedures>>=
	elemental function particle_is_colored (particle) result (flag)
	logical :: flag
	class(particle_t), intent(in) :: particle
	flag = particle%col%is_nonzero ()
	end function particle_is_colored

	@ %def particle_is_colored
	@ $[90,100]$ hopefully catches all of them and not too many.
	<<Particles: particle: TBP>>=
	procedure :: is_hadronic_beam_remnant => particle_is_hadronic_beam_remnant
	<<Particles: procedures>>=
	elemental function particle_is_hadronic_beam_remnant (particle) result (flag)
	class(particle_t), intent(in) :: particle
	logical :: flag
	integer :: pdg
	pdg = particle%flv%get_pdg ()
	flag = particle%status == PRT_BEAM_REMNANT .and. &
	abs(pdg) >= 90 .and. abs(pdg) <= 100
	end function particle_is_hadronic_beam_remnant

	@ %def particle_is_hadronic_beam_remnant
	@
	<<Particles: particle: TBP>>=
	procedure :: is_beam_remnant => particle_is_beam_remnant
	<<Particles: procedures>>=
	elemental function particle_is_beam_remnant (particle) result (flag)
	class(particle_t), intent(in) :: particle
	logical :: flag
	flag = particle%status == PRT_BEAM_REMNANT
	end function particle_is_beam_remnant

	@ %def particle_is_beam_remnant
	@ Polarization status.
	<<Particles: particle: TBP>>=
	procedure :: get_polarization_status => particle_get_polarization_status
	<<Particles: procedures>>=
	elemental function particle_get_polarization_status (prt) result (status)
	integer :: status
	class(particle_t), intent(in) :: prt
	status = prt%polarization
	end function particle_get_polarization_status

	@ %def particle_get_polarization_status
	@ Return the PDG code from the flavor component directly.
	<<Particles: particle: TBP>>=
	procedure :: get_pdg => particle_get_pdg
	<<Particles: procedures>>=
	elemental function particle_get_pdg (prt) result (pdg)
	integer :: pdg
	class(particle_t), intent(in) :: prt
	pdg = prt%flv%get_pdg ()
	end function particle_get_pdg

	@ %def particle_get_pdg
	@ Return the color and anticolor quantum numbers.
	<<Particles: particle: TBP>>=
	procedure :: get_color => particle_get_color
	<<Particles: procedures>>=
	pure function particle_get_color (prt) result (col)
	integer, dimension(2) :: col
	class(particle_t), intent(in) :: prt
	col(1) = prt%col%get_col ()
	col(2) = prt%col%get_acl ()
	end function particle_get_color

	@ %def particle_get_color
	@ Return a copy of the polarization density matrix.
	<<Particles: particle: TBP>>=
	procedure :: get_polarization => particle_get_polarization
	<<Particles: procedures>>=
	function particle_get_polarization (prt) result (pol)
	class(particle_t), intent(in) :: prt
	type(polarization_t) :: pol
	pol = prt%pol
	end function particle_get_polarization

	@ %def particle_get_polarization
	@ Return the flavor, color and helicity.
	<<Particles: particle: TBP>>=
	procedure :: get_flv => particle_get_flv
	procedure :: get_col => particle_get_col
	procedure :: get_hel => particle_get_hel
	<<Particles: procedures>>=
	function particle_get_flv (prt) result (flv)
	class(particle_t), intent(in) :: prt
	type(flavor_t) :: flv
	flv = prt%flv
	end function particle_get_flv

	function particle_get_col (prt) result (col)
	class(particle_t), intent(in) :: prt
	type(color_t) :: col
	col = prt%col
	end function particle_get_col

	function particle_get_hel (prt) result (hel)
	class(particle_t), intent(in) :: prt
	type(helicity_t) :: hel
	hel = prt%hel
	end function particle_get_hel

	@ %def particle_get_flv particle_get_col particle_get_hel
	@ Return the helicity (if defined and diagonal).
	<<Particles: particle: TBP>>=
	procedure :: get_helicity => particle_get_helicity
	<<Particles: procedures>>=
	elemental function particle_get_helicity (prt) result (hel)
	integer :: hel
	integer, dimension(2) :: hel_arr
	class(particle_t), intent(in) :: prt
	hel = 0
	if (prt%hel%is_defined () .and. prt%hel%is_diagonal ()) then
	hel_arr = prt%hel%to_pair ()
	hel = hel_arr (1)
	end if
	end function particle_get_helicity

	@ %def particle_get_helicity
	@ Return the number of children/parents
	<<Particles: particle: TBP>>=
	procedure :: get_n_parents => particle_get_n_parents
	procedure :: get_n_children => particle_get_n_children
	<<Particles: procedures>>=
	elemental function particle_get_n_parents (prt) result (n)
	integer :: n
	class(particle_t), intent(in) :: prt
	if (allocated (prt%parent)) then
	n = size (prt%parent)
	else
	n = 0
	end if
	end function particle_get_n_parents

	elemental function particle_get_n_children (prt) result (n)
	integer :: n
	class(particle_t), intent(in) :: prt
	if (allocated (prt%child)) then
	n = size (prt%child)
	else
	n = 0
	end if
	end function particle_get_n_children

	@ %def particle_get_n_parents particle_get_n_children
	@ Return the array of parents/children.
	<<Particles: particle: TBP>>=
	procedure :: get_parents => particle_get_parents
	procedure :: get_children => particle_get_children
	<<Particles: procedures>>=
	function particle_get_parents (prt) result (parent)
	class(particle_t), intent(in) :: prt
	integer, dimension(:), allocatable :: parent
	if (allocated (prt%parent)) then
	allocate (parent (size (prt%parent)))
	parent = prt%parent
	else
	allocate (parent (0))
	end if
	end function particle_get_parents

	function particle_get_children (prt) result (child)
	class(particle_t), intent(in) :: prt
	integer, dimension(:), allocatable :: child
	if (allocated (prt%child)) then
	allocate (child (size (prt%child)))
	child = prt%child
	else
	allocate (child (0))
	end if
	end function particle_get_children

	@ %def particle_get_children
	@
	<<Particles: particle: TBP>>=
	procedure :: has_children => particle_has_children
	<<Particles: procedures>>=
	elemental function particle_has_children (prt) result (has_children)
	logical :: has_children
	class(particle_t), intent(in) :: prt
	has_children = .false.
	if (allocated (prt%child)) then
	has_children = size (prt%child) > 0
	end if
	end function particle_has_children

	@ %def particle_has_children
	@
	<<Particles: particle: TBP>>=
	procedure :: has_parents => particle_has_parents
	<<Particles: procedures>>=
	elemental function particle_has_parents (prt) result (has_parents)
	logical :: has_parents
	class(particle_t), intent(in) :: prt
	has_parents = .false.
	if (allocated (prt%parent)) then
	has_parents = size (prt%parent) > 0
	end if
	end function particle_has_parents

	@ %def particle_has_parents
	@ Return momentum and momentum squared.
	<<Particles: particle: TBP>>=
	procedure :: get_momentum => particle_get_momentum
	procedure :: get_p2 => particle_get_p2
	<<Particles: procedures>>=
	elemental function particle_get_momentum (prt) result (p)
	type(vector4_t) :: p
	class(particle_t), intent(in) :: prt
	p = prt%p
	end function particle_get_momentum

	elemental function particle_get_p2 (prt) result (p2)
	real(default) :: p2
	class(particle_t), intent(in) :: prt
	p2 = prt%p2
	end function particle_get_p2

	@ %def particle_get_momentum particle_get_p2
	@ Return the particle vertex, if allocated.
	<<Particles: particle: TBP>>=
	procedure :: get_vertex => particle_get_vertex
	<<Particles: procedures>>=
	elemental function particle_get_vertex (prt) result (vtx)
	type(vector4_t) :: vtx
	class(particle_t), intent(in) :: prt
	if (allocated (prt%vertex)) then
	vtx = prt%vertex
	else
	vtx = vector4_null
	end if
	end function particle_get_vertex

	@ %def particle_get_vertex
	@ Return the lifetime of a particle.
	<<Particles: particle: TBP>>=
	procedure :: get_lifetime => particle_get_lifetime
	<<Particles: procedures>>=
	elemental function particle_get_lifetime (prt) result (lifetime)
	real(default) :: lifetime
	class(particle_t), intent(in) :: prt
	if (allocated (prt%lifetime)) then
	lifetime = prt%lifetime
	else
	lifetime = 0
	end if
	end function particle_get_lifetime

	@ %def particle_get_lifetime
	@
	<<Particles: particle: TBP>>=
	procedure :: momentum_to_pythia6 => particle_momentum_to_pythia6
	<<Particles: procedures>>=
	pure function particle_momentum_to_pythia6 (prt) result (p)
	real(double), dimension(1:5) :: p
	class(particle_t), intent(in) :: prt
	p = prt%p%to_pythia6 (sqrt (prt%p2))
	end function particle_momentum_to_pythia6

	@ %def particle_momentum_to_pythia6
	@
	\subsection{Particle sets}
	A particle set is what is usually called an event: an array of
	particles. The individual particle entries carry momentum, quantum
	numbers, polarization, and optionally connections. There is (also
	optionally) a correlated state-density matrix that maintains spin
	correlations that are lost in the individual particle entries.

	TODO: consider making this opaque (PRIVATE), might require some additional
	access methods.
	<<Particles: public>>=
	public :: particle_set_t
	<<Particles: types>>=
	type :: particle_set_t
	! private !!!
	integer :: n_beam = 0
	integer :: n_in = 0
	integer :: n_vir = 0
	integer :: n_out = 0
	integer :: n_tot = 0
	integer :: factorization_mode = FM_IGNORE_HELICITY
	type(particle_t), dimension(:), allocatable :: prt
	type(state_matrix_t) :: correlated_state
	contains
	<<Particles: particle set: TBP>>
	end type particle_set_t

	@ %def particle_set_t
	@ A particle set can be initialized from an interaction or from a
	HepMC event record.
	<<Particles: particle set: TBP>>=
	generic :: init => init_interaction
	procedure :: init_interaction => particle_set_init_interaction
	@ When a particle set is initialized from a given interaction, we have
	to determine the branch within the original state matrix that fixes
	the particle quantum numbers. This is done with the appropriate
	probabilities, based on a random number [[x]]. The [[mode]]
	determines whether the individual particles become unpolarized, or
	take a definite (diagonal) helicity, or acquire single-particle
	polarization matrices. The flag [[keep_correlations]] tells whether
	the spin-correlation matrix is to be calculated and stored in addition
	to the particles. The flag [[keep_virtual]] tells whether virtual
	particles should be dropped. Note that if virtual particles are
	dropped, the spin-correlation matrix makes no sense, and parent-child
	relations are not set.

	For a correct disentangling of color and flavor (in the presence of
	helicity), we consider two interactions. [[int]] has no color
	information, and is used to select a flavor state. Consequently, we
	trace over helicities here. [[int_flows]] contains color-flow and
	potentially helicity information, but is useful only after the flavor
	combination has been chosen. So this interaction is used to select
	helicity and color, but restricted to the selected flavor combination.

	[[int]] and [[int_flows]] may be identical if there is only a single
	(or no) color flow. If there is just a single flavor combination,
	[[x(1)]] can be set to zero.

	The current algorithm of evaluator convolution requires that the beam
	particles are assumed outgoing (in the beam interaction) and become
	virtual in all derived interactions. In the particle set they should
	be re-identified as incoming. The optional integer [[n_incoming]]
	can be used to perform this correction.

	The flag [[is_valid]] is false if factorization of the state is not
	possible, in particular if the squared matrix element is zero.
	<<Particles: procedures>>=
	subroutine particle_set_init_interaction &
	(particle_set, is_valid, int, int_flows, mode, x, &
	keep_correlations, keep_virtual, n_incoming, qn_select)
	class(particle_set_t), intent(out) :: particle_set
	logical, intent(out) :: is_valid
	type(interaction_t), intent(in), target :: int, int_flows
	integer, intent(in) :: mode
	real(default), dimension(2), intent(in) :: x
	logical, intent(in) :: keep_correlations, keep_virtual
	integer, intent(in), optional :: n_incoming
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_select
	type(state_matrix_t), dimension(:), allocatable, target :: flavor_state
	type(state_matrix_t), dimension(:), allocatable, target :: single_state
	integer :: n_in, n_vir, n_out, n_tot
	type(quantum_numbers_t), dimension(:,:), allocatable :: qn
	logical :: ok
	integer :: i, j
	if (present (n_incoming)) then
	n_in = n_incoming
	n_vir = int%get_n_vir () - n_incoming
	else
	n_in = int%get_n_in ()
	n_vir = int%get_n_vir ()
	end if
	n_out = int%get_n_out ()
	n_tot = int%get_n_tot ()
	particle_set%n_in = n_in
	particle_set%n_out = n_out
	if (keep_virtual) then
	particle_set%n_vir = n_vir
	particle_set%n_tot = n_tot
	else
	particle_set%n_vir = 0
	particle_set%n_tot = n_in + n_out
	end if
	particle_set%factorization_mode = mode
	allocate (qn (n_tot, 1))
	if (.not. present (qn_select)) then
	call int%factorize &
	(FM_IGNORE_HELICITY, x(1), is_valid, flavor_state)
	do i = 1, n_tot
	qn(i,:) = flavor_state(i)%get_quantum_number (1)
	end do
	else
	do i = 1, n_tot
	qn(i,:) = qn_select(i)
	end do
	end if
	if (keep_correlations .and. keep_virtual) then
	call particle_set%correlated_state%final ()
	call int_flows%factorize (mode, x(2), ok, &
	single_state, particle_set%correlated_state, qn(:,1))
	else
	call int_flows%factorize (mode, x(2), ok, &
	single_state, qn_in=qn(:,1))
	end if
	is_valid = is_valid .and. ok
	allocate (particle_set%prt (particle_set%n_tot))
	j = 1
	do i = 1, n_tot
	if (i <= n_in) then
	call particle_set%prt(j)%init (single_state(i), PRT_INCOMING, mode)
	call particle_set%prt(j)%set_momentum (int%get_momentum (i))
	else if (i <= n_in + n_vir) then
	if (.not. keep_virtual) cycle
	call particle_set%prt(j)%init &
	(single_state(i), PRT_VIRTUAL, mode)
	call particle_set%prt(j)%set_momentum (int%get_momentum (i))
	else
	call particle_set%prt(j)%init (single_state(i), PRT_OUTGOING, mode)
	call particle_set%prt(j)%set_momentum &
	(int%get_momentum (i), on_shell = .true.)
	end if
	if (keep_virtual) then
	call particle_set%prt(j)%set_children &
	(interaction_get_children (int, i))
	call particle_set%prt(j)%set_parents &
	(interaction_get_parents (int, i))
	end if
	j = j + 1
	end do
	if (keep_virtual) then
	call particle_set_resonance_flag &
	(particle_set%prt, int%get_resonance_flags ())
	end if
	if (allocated (flavor_state)) then
	do i = 1, size(flavor_state)
	call flavor_state(i)%final ()
	end do
	end if
	do i = 1, size(single_state)
	call single_state(i)%final ()
	end do
	end subroutine particle_set_init_interaction

	@ %def particle_set_init_interaction
	@ Duplicate generic binding, to make sure that assignment works as it should.
	<<Particles: particle set: TBP>>=
	generic :: assignment(=) => init_particle_set
	generic :: init => init_particle_set
	procedure :: init_particle_set => particle_set_init_particle_set
	<<Particles: procedures>>=
	subroutine particle_set_init_particle_set (pset_out, pset_in)
	class(particle_set_t), intent(out) :: pset_out
	type(particle_set_t), intent(in) :: pset_in
	integer :: i
	pset_out%n_beam = pset_in%n_beam
	pset_out%n_in = pset_in%n_in
	pset_out%n_vir = pset_in%n_vir
	pset_out%n_out = pset_in%n_out
	pset_out%n_tot = pset_in%n_tot
	pset_out%factorization_mode = pset_in%factorization_mode
	if (allocated (pset_in%prt)) then
	allocate (pset_out%prt (size (pset_in%prt)))
	do i = 1, size (pset_in%prt)
	pset_out%prt(i) = pset_in%prt(i)
	end do
	end if
	pset_out%correlated_state = pset_in%correlated_state
	end subroutine particle_set_init_particle_set

	@ %def particle_set_init_particle_set
	@ Manually set the model for the stored particles.
	<<Particles: particle set: TBP>>=
	procedure :: set_model => particle_set_set_model
	<<Particles: procedures>>=
	subroutine particle_set_set_model (particle_set, model)
	class(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	integer :: i
	do i = 1, particle_set%n_tot
	call particle_set%prt(i)%set_model (model)
	end do
	call particle_set%correlated_state%set_model (model)
	end subroutine particle_set_set_model

	@ %def particle_set_set_model
	@ Pointer components are hidden inside the particle polarization, and
	in the correlated state matrix.
	<<Particles: particle set: TBP>>=
	procedure :: final => particle_set_final
	<<Particles: procedures>>=
	subroutine particle_set_final (particle_set)
	class(particle_set_t), intent(inout) :: particle_set
	integer :: i
	if (allocated (particle_set%prt)) then
	do i = 1, size(particle_set%prt)
	call particle_set%prt(i)%final ()
	end do
	deallocate (particle_set%prt)
	end if
	call particle_set%correlated_state%final ()
	end subroutine particle_set_final

	@ %def particle_set_final
	@
	\subsection{Manual build}
	Basic initialization. Just allocate with a given number of beam, incoming,
	virtual, and outgoing particles.
	<<Particles: particle set: TBP>>=
	procedure :: basic_init => particle_set_basic_init
	<<Particles: procedures>>=
	subroutine particle_set_basic_init (particle_set, n_beam, n_in, n_vir, n_out)
	class(particle_set_t), intent(out) :: particle_set
	integer, intent(in) :: n_beam, n_in, n_vir, n_out
	particle_set%n_beam = n_beam
	particle_set%n_in = n_in
	particle_set%n_vir = n_vir
	particle_set%n_out = n_out
	particle_set%n_tot = n_beam + n_in + n_vir + n_out
	allocate (particle_set%prt (particle_set%n_tot))
	end subroutine particle_set_basic_init

	@ %def particle_set_basic_init
	@
	Build a particle set from scratch. This is used for testing
	purposes. The ordering of particles in the result is
	beam-incoming-remnant-virtual-outgoing.

	Parent-child relations:
	\begin{itemize}
	\item
	Beams are parents of incoming and beam remnants. The assignment is
	alternating (first beam, second beam).
	\item
	Incoming are parents of virtual and outgoing, collectively.
	\end{itemize}
	More specific settings, such as resonance histories, cannot be set
	this way.

	Beam-remnant particles are counted as virtual, but have a different
	status code.

	We assume that the [[pdg]] array has the correct size.
	<<Particles: particle set: TBP>>=
	procedure :: init_direct => particle_set_init_direct
	<<Particles: procedures>>=
	subroutine particle_set_init_direct (particle_set, &
	n_beam, n_in, n_rem, n_vir, n_out, pdg, model)
	class(particle_set_t), intent(out) :: particle_set
	integer, intent(in) :: n_beam
	integer, intent(in) :: n_in
	integer, intent(in) :: n_rem
	integer, intent(in) :: n_vir
	integer, intent(in) :: n_out
	integer, dimension(:), intent(in) :: pdg
	class(model_data_t), intent(in), target :: model
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: i, k, n
	call particle_set%basic_init (n_beam, n_in, n_rem+n_vir, n_out)
	n = 0
	call particle_set%prt(n+1:n+n_beam)%reset_status (PRT_BEAM)
	do i = n+1, n+n_beam
	call particle_set%prt(i)%set_children &
	([(k, k=i+n_beam, n+n_beam+n_in+n_rem, 2)])
	end do
	n = n + n_beam
	call particle_set%prt(n+1:n+n_in)%reset_status (PRT_INCOMING)
	do i = n+1, n+n_in
	if (n_beam > 0) then
	call particle_set%prt(i)%set_parents &
	([i-n_beam])
	end if
	call particle_set%prt(i)%set_children &
	([(k, k=n+n_in+n_rem+1, n+n_in+n_rem+n_vir+n_out)])
	end do
	n = n + n_in
	call particle_set%prt(n+1:n+n_rem)%reset_status (PRT_BEAM_REMNANT)
	do i = n+1, n+n_rem
	if (n_beam > 0) then
	call particle_set%prt(i)%set_parents &
	([i-n_in-n_beam])
	end if
	end do
	n = n + n_rem
	call particle_set%prt(n+1:n+n_vir)%reset_status (PRT_VIRTUAL)
	do i = n+1, n+n_vir
	call particle_set%prt(i)%set_parents &
	([(k, k=n-n_rem-n_in+1, n-n_rem)])
	end do
	n = n + n_vir
	call particle_set%prt(n+1:n+n_out)%reset_status (PRT_OUTGOING)
	do i = n+1, n+n_out
	call particle_set%prt(i)%set_parents &
	([(k, k=n-n_vir-n_rem-n_in+1, n-n_vir-n_rem)])
	end do
	allocate (flv (particle_set%n_tot))
	call flv%init (pdg, model)
	do k = n_beam+n_in+1, n_beam+n_in+n_rem
	call flv(k)%tag_radiated ()
	end do
	do i = 1, particle_set%n_tot
	call particle_set%prt(i)%set_flavor (flv(i))
	end do
	end subroutine particle_set_init_direct

	@ %def particle_set_init_direct
	@ Copy a particle set into a new, extended one. Use the mapping array to
	determine the new positions of particles. The new set contains [[n_new]]
	additional entries. Count the new, undefined particles as
	virtual.

	TODO: implement mapping for the state matrix.
	<<Particles: particle set: TBP>>=
	procedure :: transfer => particle_set_transfer
	<<Particles: procedures>>=
	subroutine particle_set_transfer (pset, source, n_new, map)
	class(particle_set_t), intent(out) :: pset
	class(particle_set_t), intent(in) :: source
	integer, intent(in) :: n_new
	integer, dimension(:), intent(in) :: map
	integer :: i
	call pset%basic_init &
	(source%n_beam, source%n_in, source%n_vir + n_new, source%n_out)
	do i = 1, source%n_tot
	call pset%prt(map(i))%reset_status (source%prt(i)%get_status ())
	call pset%prt(map(i))%set_flavor (source%prt(i)%get_flv ())
	call pset%prt(map(i))%set_color (source%prt(i)%get_col ())
	call pset%prt(map(i))%set_parents (map (source%prt(i)%get_parents ()))
	call pset%prt(map(i))%set_children (map (source%prt(i)%get_children ()))
	end do
	end subroutine particle_set_transfer

	@ %def particle_set_transfer
	@ Insert a new particle as an intermediate into a previously empty position.

	Flavor and status are just set. Color is not set (but see below).
	The complicated part is reassigning parent-child relations. The
	inserted particle comes with an array [[child]] of its children which
	are supposed to be existing particles.

	We first scan all particles that come before the new insertion.
	Whenever a particle has children that coincide with the children of
	the new particle, those child entries are removed. (a) If the new
	particle has no parent entry yet, those child entries are replaced by
	the index of the new particle and simultaneously, the particle is
	registered as a parent of the new particle. (b) If the current particle
	already has a parent entry, those child entries are removed.

	When this is done, the new particle is registered as the (only) parent of its
	children.
	<<Particles: particle set: TBP>>=
	procedure :: insert => particle_set_insert
	<<Particles: procedures>>=
	subroutine particle_set_insert (pset, i, status, flv, child)
	class(particle_set_t), intent(inout) :: pset
	integer, intent(in) :: i
	integer, intent(in) :: status
	type(flavor_t), intent(in) :: flv
	integer, dimension(:), intent(in) :: child
	integer, dimension(:), allocatable :: p_child, parent
	integer :: j, k, c, n_parent
	logical :: no_match
	call pset%prt(i)%reset_status (status)
	call pset%prt(i)%set_flavor (flv)
	call pset%prt(i)%set_children (child)
	n_parent = pset%prt(i)%get_n_parents ()
	do j = 1, i - 1
	p_child = pset%prt(j)%get_children ()
	no_match = .true.
	do k = 1, size (p_child)
	if (any (p_child(k) == child)) then
	if (n_parent == 0 .and. no_match) then
	if (.not. allocated (parent)) then
	parent = [j]
	else
	parent = [parent, j]
	end if
	p_child(k) = i
	else
	p_child(k) = 0
	end if
	no_match = .false.
	end if
	end do
	if (.not. no_match) then
	p_child = pack (p_child, p_child /= 0)
	call pset%prt(j)%set_children (p_child)
	end if
	end do
	if (n_parent == 0) then
	call pset%prt(i)%set_parents (parent)
	end if
	do j = 1, size (child)
	c = child(j)
	call pset%prt(c)%set_parents ([i])
	end do
	end subroutine particle_set_insert

	@ %def particle_set_insert
	@ This should be done after completing all insertions: recover color
	assignments for the inserted particles, working backwards from
	children to parents. A single call to the routine recovers the color
	and anticolor line indices for a single particle.
	<<Particles: particle set: TBP>>=
	procedure :: recover_color => particle_set_recover_color
	<<Particles: procedures>>=
	subroutine particle_set_recover_color (pset, i)
	class(particle_set_t), intent(inout) :: pset
	integer, intent(in) :: i
	type(color_t) :: col
	integer, dimension(:), allocatable :: child
	integer :: j
	child = pset%prt(i)%get_children ()
	if (size (child) > 0) then
	col = pset%prt(child(1))%get_col ()
	do j = 2, size (child)
	col = col .fuse. pset%prt(child(j))%get_col ()
	end do
	call pset%prt(i)%set_color (col)
	end if
	end subroutine particle_set_recover_color
	-
	+
	@ %def particle_set_recover_color
	@
	\subsection{Extract/modify contents}
	<<Particles: particle set: TBP>>=
	generic :: get_color => get_color_all
	generic :: get_color => get_color_indices
	procedure :: get_color_all => particle_set_get_color_all
	procedure :: get_color_indices => particle_set_get_color_indices
	<<Particles: procedures>>=
	function particle_set_get_color_all (particle_set) result (col)
	class(particle_set_t), intent(in) :: particle_set
	type(color_t), dimension(:), allocatable :: col
	allocate (col (size (particle_set%prt)))
	col = particle_set%prt%col
	end function particle_set_get_color_all

	@ %def particle_set_get_color_all
	@
	<<Particles: procedures>>=
	function particle_set_get_color_indices (particle_set, indices) result (col)
	type(color_t), dimension(:), allocatable :: col
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in), dimension(:), allocatable :: indices
	integer :: i
	allocate (col (size (indices)))
	do i = 1, size (indices)
	col(i) = particle_set%prt(indices(i))%col
	end do
	end function particle_set_get_color_indices

	@ %def particle_set_get_color_indices
	@ Set a single or all color components. This is a wrapper around the
	corresponding [[particle_t]] method, with the same options. We assume
	that the particle array is allocated.
	<<Particles: particle set: TBP>>=
	generic :: set_color => set_color_single
	generic :: set_color => set_color_indices
	generic :: set_color => set_color_all
	procedure :: set_color_single => particle_set_set_color_single
	procedure :: set_color_indices => particle_set_set_color_indices
	procedure :: set_color_all => particle_set_set_color_all
	<<Particles: procedures>>=
	subroutine particle_set_set_color_single (particle_set, i, col)
	class(particle_set_t), intent(inout) :: particle_set
	integer, intent(in) :: i
	type(color_t), intent(in) :: col
	call particle_set%prt(i)%set_color (col)
	end subroutine particle_set_set_color_single

	subroutine particle_set_set_color_indices (particle_set, indices, col)
	class(particle_set_t), intent(inout) :: particle_set
	integer, dimension(:), intent(in) :: indices
	type(color_t), dimension(:), intent(in) :: col
	integer :: i
	do i = 1, size (indices)
	call particle_set%prt(indices(i))%set_color (col(i))
	end do
	end subroutine particle_set_set_color_indices

	subroutine particle_set_set_color_all (particle_set, col)
	class(particle_set_t), intent(inout) :: particle_set
	type(color_t), dimension(:), intent(in) :: col
	call particle_set%prt%set_color (col)
	end subroutine particle_set_set_color_all

	@ %def particle_set_set_color
	@ Assigning particles manually may result in color mismatches. This is
	checked here for all particles in the set. The color object is
	compared against the color type that belongs to the flavor object.
	The return value is an allocatable array which consists of the particles
	with invalid color assignments. If the array size is zero, all is fine.
	<<Particles: particle set: TBP>>=
	procedure :: find_prt_invalid_color => particle_set_find_prt_invalid_color
	<<Particles: procedures>>=
	subroutine particle_set_find_prt_invalid_color (particle_set, index, prt)
	class(particle_set_t), intent(in) :: particle_set
	integer, dimension(:), allocatable, intent(out) :: index
	type(particle_t), dimension(:), allocatable, intent(out), optional :: prt
	type(flavor_t) :: flv
	type(color_t) :: col
	logical, dimension(:), allocatable :: mask
	integer :: i, n, n_invalid
	n = size (particle_set%prt)
	allocate (mask (n))
	do i = 1, n
	associate (prt => particle_set%prt(i))
	flv = prt%get_flv ()
	col = prt%get_col ()
	mask(i) = flv%get_color_type () /= col%get_type ()
	end associate
	end do
	index = pack ([(i, i = 1, n)], mask)
	if (present (prt)) prt = pack (particle_set%prt, mask)
	end subroutine particle_set_find_prt_invalid_color

	@ %def particle_set_find_prt_invalid_color
	@
	<<Particles: particle set: TBP>>=
	generic :: get_momenta => get_momenta_all
	generic :: get_momenta => get_momenta_indices
	procedure :: get_momenta_all => particle_set_get_momenta_all
	procedure :: get_momenta_indices => particle_set_get_momenta_indices
	<<Particles: procedures>>=
	function particle_set_get_momenta_all (particle_set) result (p)
	class(particle_set_t), intent(in) :: particle_set
	type(vector4_t), dimension(:), allocatable :: p
	allocate (p (size (particle_set%prt)))
	p = particle_set%prt%p
	end function particle_set_get_momenta_all

	@ %def particle_set_get_momenta_all
	@
	<<Particles: procedures>>=
	function particle_set_get_momenta_indices (particle_set, indices) result (p)
	type(vector4_t), dimension(:), allocatable :: p
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in), dimension(:), allocatable :: indices
	integer :: i
	allocate (p (size (indices)))
	do i = 1, size (indices)
	p(i) = particle_set%prt(indices(i))%p
	end do
	end function particle_set_get_momenta_indices

	@ %def particle_set_get_momenta_indices
	@ Replace a single or all momenta. This is a wrapper around the
	corresponding [[particle_t]] method, with the same options. We assume
	that the particle array is allocated.
	<<Particles: particle set: TBP>>=
	generic :: set_momentum => set_momentum_single
	generic :: set_momentum => set_momentum_indices
	generic :: set_momentum => set_momentum_all
	procedure :: set_momentum_single => particle_set_set_momentum_single
	procedure :: set_momentum_indices => particle_set_set_momentum_indices
	procedure :: set_momentum_all => particle_set_set_momentum_all
	<<Particles: procedures>>=
	subroutine particle_set_set_momentum_single &
	(particle_set, i, p, p2, on_shell)
	class(particle_set_t), intent(inout) :: particle_set
	integer, intent(in) :: i
	type(vector4_t), intent(in) :: p
	real(default), intent(in), optional :: p2
	logical, intent(in), optional :: on_shell
	call particle_set%prt(i)%set_momentum (p, p2, on_shell)
	end subroutine particle_set_set_momentum_single

	subroutine particle_set_set_momentum_indices &
	(particle_set, indices, p, p2, on_shell)
	class(particle_set_t), intent(inout) :: particle_set
	integer, dimension(:), intent(in) :: indices
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), dimension(:), intent(in), optional :: p2
	logical, intent(in), optional :: on_shell
	integer :: i
	if (present (p2)) then
	do i = 1, size (indices)
	call particle_set%prt(indices(i))%set_momentum (p(i), p2(i), on_shell)
	end do
	else
	do i = 1, size (indices)
	call particle_set%prt(indices(i))%set_momentum &
	(p(i), on_shell=on_shell)
	end do
	end if
	end subroutine particle_set_set_momentum_indices

	subroutine particle_set_set_momentum_all (particle_set, p, p2, on_shell)
	class(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), dimension(:), intent(in) :: p
	real(default), dimension(:), intent(in), optional :: p2
	logical, intent(in), optional :: on_shell
	call particle_set%prt%set_momentum (p, p2, on_shell)
	end subroutine particle_set_set_momentum_all

	@ %def particle_set_set_momentum
	@ Recover a momentum by recombining from children, assuming that this
	is possible. The reconstructed momentum is not projected on-shell.
	<<Particles: particle set: TBP>>=
	procedure :: recover_momentum => particle_set_recover_momentum
	<<Particles: procedures>>=
	subroutine particle_set_recover_momentum (particle_set, i)
	class(particle_set_t), intent(inout) :: particle_set
	integer, intent(in) :: i
	type(vector4_t), dimension(:), allocatable :: p
	integer, dimension(:), allocatable :: index
	index = particle_set%prt(i)%get_children ()
	p = particle_set%get_momenta (index)
	call particle_set%set_momentum (i, sum (p))
	end subroutine particle_set_recover_momentum

	@ %def particle_set_recover_momentum
	@
	<<Particles: particle set: TBP>>=
	procedure :: replace_incoming_momenta => particle_set_replace_incoming_momenta
	<<Particles: procedures>>=
	subroutine particle_set_replace_incoming_momenta (particle_set, p)
	class(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), intent(in), dimension(:) :: p
	integer :: i, j
	i = 1
	do j = 1, particle_set%get_n_tot ()
	if (particle_set%prt(j)%get_status () == PRT_INCOMING) then
	particle_set%prt(j)%p = p(i)
	i = i + 1
	if (i > particle_set%n_in) exit
	end if
	end do
	end subroutine particle_set_replace_incoming_momenta

	@ %def particle_set_replace_incoming_momenta
	@
	<<Particles: particle set: TBP>>=
	procedure :: replace_outgoing_momenta => particle_set_replace_outgoing_momenta
	<<Particles: procedures>>=
	subroutine particle_set_replace_outgoing_momenta (particle_set, p)
	class(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), intent(in), dimension(:) :: p
	integer :: i, j
	i = particle_set%n_in + 1
	do j = 1, particle_set%n_tot
	if (particle_set%prt(j)%get_status () == PRT_OUTGOING) then
	particle_set%prt(j)%p = p(i)
	i = i + 1
	end if
	end do
	end subroutine particle_set_replace_outgoing_momenta

	@ %def particle_set_replace_outgoing_momenta
	@
	<<Particles: particle set: TBP>>=
	procedure :: get_outgoing_momenta => particle_set_get_outgoing_momenta
	<<Particles: procedures>>=
	function particle_set_get_outgoing_momenta (particle_set) result (p)
	class(particle_set_t), intent(in) :: particle_set
	type(vector4_t), dimension(:), allocatable :: p
	integer :: i, k
	allocate (p (count (particle_set%prt%get_status () == PRT_OUTGOING)))
	k = 0
	do i = 1, size (particle_set%prt)
	if (particle_set%prt(i)%get_status () == PRT_OUTGOING) then
	k = k + 1
	p(k) = particle_set%prt(i)%get_momentum ()
	end if
	end do
	end function particle_set_get_outgoing_momenta

	@ %def particle_set_get_outgoing_momenta
	@
	<<Particles: particle set: TBP>>=
	procedure :: parent_add_child => particle_set_parent_add_child
	<<Particles: procedures>>=
	subroutine particle_set_parent_add_child (particle_set, parent, child)
	class(particle_set_t), intent(inout) :: particle_set
	integer, intent(in) :: parent, child
	call particle_set%prt(child)%set_parents ([parent])
	call particle_set%prt(parent)%add_child (child)
	end subroutine particle_set_parent_add_child

	@ %def particle_set_parent_add_child
	@ Given the [[particle_set]] before radiation, the new momenta
	[[p_radiated]], the [[emitter]] and the [[flv_radiated]] as well as the
	[[model]] and a random number [[r_color]] for chosing a color, we update
	the [[particle_set]].
	<<Particles: particle set: TBP>>=
	procedure :: build_radiation => particle_set_build_radiation
	<<Particles: procedures>>=
	subroutine particle_set_build_radiation (particle_set, p_radiated, &
	emitter, flv_radiated, model, r_color)
	class(particle_set_t), intent(inout) :: particle_set
	type(vector4_t), intent(in), dimension(:) :: p_radiated
	integer, intent(in) :: emitter
	integer, intent(in), dimension(:) :: flv_radiated
	class(model_data_t), intent(in), target :: model
	real(default), intent(in) :: r_color
	type(particle_set_t) :: new_particle_set
	type(particle_t) :: new_particle
	integer :: i
	integer :: pdg_index_emitter, pdg_index_radiation
	integer, dimension(:), allocatable :: parents, children
	type(flavor_t) :: new_flv
	logical, dimension(:), allocatable :: status_mask
	integer, dimension(:), allocatable :: &
	i_in1, i_beam1, i_remnant1, i_virt1, i_out1
	integer, dimension(:), allocatable :: &
	i_in2, i_beam2, i_remnant2, i_virt2, i_out2
	integer :: n_in1, n_beam1, n_remnant1, n_virt1, n_out1
	integer :: n_in2, n_beam2, n_remnant2, n_virt2, n_out2
	integer :: n, n_tot
	integer :: i_emitter

	n = particle_set%get_n_tot ()
	allocate (status_mask (n))
	do i = 1, n
	status_mask(i) = particle_set%prt(i)%get_status () == PRT_INCOMING
	end do
	n_in1 = count (status_mask)
	allocate (i_in1 (n_in1))
	i_in1 = particle_set%get_indices (status_mask)
	do i = 1, n
	status_mask(i) = particle_set%prt(i)%get_status () == PRT_BEAM
	end do
	n_beam1 = count (status_mask)
	allocate (i_beam1 (n_beam1))
	i_beam1 = particle_set%get_indices (status_mask)
	do i = 1, n
	status_mask(i) = particle_set%prt(i)%get_status () == PRT_BEAM_REMNANT
	end do
	n_remnant1 = count (status_mask)
	allocate (i_remnant1 (n_remnant1))
	i_remnant1 = particle_set%get_indices (status_mask)
	do i = 1, n
	status_mask(i) = particle_set%prt(i)%get_status () == PRT_VIRTUAL
	end do
	n_virt1 = count (status_mask)
	allocate (i_virt1 (n_virt1))
	i_virt1 = particle_set%get_indices (status_mask)
	do i = 1, n
	status_mask(i) = particle_set%prt(i)%get_status () == PRT_OUTGOING
	end do
	n_out1 = count (status_mask)
	allocate (i_out1 (n_out1))
	i_out1 = particle_set%get_indices (status_mask)

	n_in2 = n_in1; n_beam2 = n_beam1; n_remnant2 = n_remnant1
	n_virt2 = n_virt1 + n_out1
	n_out2 = n_out1 + 1
	n_tot = n_in2 + n_beam2 + n_remnant2 + n_virt2 + n_out2

	allocate (i_in2 (n_in2), i_beam2 (n_beam2), i_remnant2 (n_remnant2))
	i_in2 = i_in1; i_beam2 = i_beam1; i_remnant2 = i_remnant1

	allocate (i_virt2 (n_virt2))
	i_virt2(1 : n_virt1) = i_virt1
	i_virt2(n_virt1 + 1 : n_virt2) = i_out1

	allocate (i_out2 (n_out2))
	i_out2(1 : n_out1) = i_out1(1 : n_out1) + n_out1
	i_out2(n_out2) = n_tot

	new_particle_set%n_beam = n_beam2
	new_particle_set%n_in = n_in2
	new_particle_set%n_vir = n_virt2
	new_particle_set%n_out = n_out2
	new_particle_set%n_tot = n_tot
	new_particle_set%correlated_state = particle_set%correlated_state
	allocate (new_particle_set%prt (n_tot))
	if (size (i_beam1) > 0) new_particle_set%prt(i_beam2) = particle_set%prt(i_beam1)
	if (size (i_remnant1) > 0) new_particle_set%prt(i_remnant2) = particle_set%prt(i_remnant1)
	do i = 1, n_virt1
	new_particle_set%prt(i_virt2(i)) = particle_set%prt(i_virt1(i))
	end do

	do i = n_virt1 + 1, n_virt2
	new_particle_set%prt(i_virt2(i)) = particle_set%prt(i_out1(i - n_virt1))
	call new_particle_set%prt(i_virt2(i))%reset_status (PRT_VIRTUAL)
	end do

	do i = 1, n_in2
	new_particle_set%prt(i_in2(i)) = particle_set%prt(i_in1(i))
	new_particle_set%prt(i_in2(i))%p = p_radiated (i)
	end do

	do i = 1, n_out2 - 1
	new_particle_set%prt(i_out2(i)) = particle_set%prt(i_out1(i))
	new_particle_set%prt(i_out2(i))%p = p_radiated(i + n_in2)
	call new_particle_set%prt(i_out2(i))%reset_status (PRT_OUTGOING)
	end do

	call new_particle%reset_status (PRT_OUTGOING)
	call new_particle%set_momentum (p_radiated (n_in2 + n_out2))

	!!! Helicity and polarization handling is missing at this point
	!!! Also, no helicities or polarizations yet
	pdg_index_emitter = flv_radiated (emitter)
	pdg_index_radiation = flv_radiated (n_in2 + n_out2)
	call new_flv%init (pdg_index_radiation, model)
	i_emitter = emitter + n_virt2 + n_remnant2 + n_beam2

	call reassign_colors (new_particle, new_particle_set%prt(i_emitter), &
	pdg_index_radiation, pdg_index_emitter, r_color)

	call new_particle%set_flavor (new_flv)
	new_particle_set%prt(n_tot) = new_particle

	allocate (children (n_out2))
	children = i_out2
	do i = n_in2 + n_beam2 + n_remnant2 + n_virt1 + 1, n_in2 + n_beam2 + n_remnant2 + n_virt2
	call new_particle_set%prt(i)%set_children (children)
	end do

	!!! Set proper parents for outgoing particles
	allocate (parents (n_out1))
	parents = i_out1
	do i = n_in2 + n_beam2 + n_remnant2 + n_virt2 + 1, n_tot
	call new_particle_set%prt(i)%set_parents (parents)
	end do
	call particle_set%init (new_particle_set)
	contains

	<<build radiation: set color offset>>
	subroutine reassign_colors (prt_radiated, prt_emitter, i_rad, i_em, r_col)
	type(particle_t), intent(inout) :: prt_radiated, prt_emitter
	integer, intent(in) :: i_rad, i_em
	real(default), intent(in) :: r_col
	type(color_t) :: col_rad, col_em
	if (is_quark (i_em) .and. is_gluon (i_rad)) then
	call reassign_colors_qg (prt_emitter, col_rad, col_em)
	else if (is_gluon (i_em) .and. is_gluon (i_rad)) then
	call reassign_colors_gg (prt_emitter, r_col, col_rad, col_em)
	else if (is_gluon (i_em) .and. is_quark (i_rad)) then
	call reassign_colors_qq (prt_emitter, i_em, col_rad, col_em)
	else
	call msg_fatal ("Invalid splitting")
	end if
	call prt_emitter%set_color (col_em)
	call prt_radiated%set_color (col_rad)
	end subroutine reassign_colors

	subroutine reassign_colors_qg (prt_emitter, col_rad, col_em)
	type(particle_t), intent(in) :: prt_emitter
	type(color_t), intent(out) :: col_rad, col_em
	integer, dimension(2) :: color_rad, color_em
	integer :: i1, i2
	integer :: new_color_index
	logical :: is_anti_quark

	color_em = prt_emitter%get_color ()
	i1 = 1; i2 = 2
	is_anti_quark = color_em(2) /= 0
	if (is_anti_quark) then
	i1 = 2; i2 = 1
	end if
	new_color_index = color_em(i1)+1
	color_rad(i1) = color_em(i1)
	color_rad(i2) = new_color_index
	color_em(i1) = new_color_index
	call col_em%init_col_acl (color_em(1), color_em(2))
	call col_rad%init_col_acl (color_rad(1), color_rad(2))
	end subroutine reassign_colors_qg

	subroutine reassign_colors_gg (prt_emitter, random, col_rad, col_em)
	!!! NOT TESTED YET
	type(particle_t), intent(in) :: prt_emitter
	real(default), intent(in) :: random
	type(color_t), intent(out) :: col_rad, col_em
	integer, dimension(2) :: color_rad, color_em
	integer :: i1, i2
	integer :: new_color_index

	color_em = prt_emitter%get_color ()
	new_color_index = maxval (abs (color_em))
	i1 = 1; i2 = 2
	if (random < 0.5) then
	i1 = 2; i2 = 1
	end if
	color_rad(i1) = new_color_index
	color_rad(i2) = color_em(i2)
	color_em(i2) = new_color_index
	call col_em%init_col_acl (color_em(1), color_em(2))
	call col_rad%init_col_acl (color_rad(1), color_rad(2))
	end subroutine reassign_colors_gg

	subroutine reassign_colors_qq (prt_emitter, pdg_emitter, col_rad, col_em)
	!!! NOT TESTED YET
	type(particle_t), intent(in) :: prt_emitter
	integer, intent(in) :: pdg_emitter
	type(color_t), intent(out) :: col_rad, col_em
	integer, dimension(2) :: color_rad, color_em
	integer :: i1, i2
	logical :: is_anti_quark

	color_em = prt_emitter%get_color ()
	i1 = 1; i2 = 2
	is_anti_quark = pdg_emitter < 0
	if (is_anti_quark) then
	i1 = 2; i1 = 1
	end if
	color_em(i2) = 0
	color_rad(i1) = 0
	color_rad(i2) = color_em(i1)
	call col_em%init_col_acl (color_em(1), color_em(2))
	call col_rad%init_col_acl (color_rad(1), color_rad(2))
	end subroutine reassign_colors_qq
	end subroutine particle_set_build_radiation

	@ %def particle_set_build_radiation
	@ Increments the color indices of all particles by their maximal value to distinguish them
	from the record-keeping Born particles in the LHE-output if the virtual entries are kept.
	<<build radiation: set color offset>>=
	subroutine set_color_offset (particle_set)
	type(particle_set_t), intent(inout) :: particle_set
	integer, dimension(2) :: color
	integer :: i, i_color_max
	type(color_t) :: new_color

	i_color_max = 0
	do i = 1, size (particle_set%prt)
	associate (prt => particle_set%prt(i))
	if (prt%get_status () <= PRT_INCOMING) cycle
	color = prt%get_color ()
	i_color_max = maxval([i_color_max, color(1), color(2)])
	end associate
	end do


	do i = 1, size (particle_set%prt)
	associate (prt => particle_set%prt(i))
	if (prt%get_status () /= PRT_OUTGOING) cycle
	color = prt%get_color ()
	where (color /= 0) color = color + i_color_max
	call new_color%init_col_acl (color(1), color(2))
	call prt%set_color (new_color)
	end associate
	end do
	end subroutine set_color_offset

	@ %def set_color_offset
	@ Output (default format)
	<<Particles: particle set: TBP>>=
	procedure :: write => particle_set_write
	<<Particles: procedures>>=
	subroutine particle_set_write &
	(particle_set, unit, testflag, summary, compressed)
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag, summary, compressed
	logical :: summ, comp, pol
	type(vector4_t) :: sum_vec
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	summ = .false.; if (present (summary)) summ = summary
	comp = .false.; if (present (compressed)) comp = compressed
	pol = particle_set%factorization_mode /= FM_IGNORE_HELICITY
	write (u, "(1x,A)") "Particle set:"
	call write_separator (u)
	if (comp) then
	if (pol) then
	write (u, &
	"((A4,1X),(A6,1X),(A7,1X),(A3),2(A4,1X),2(A20,1X),5(A12,1X))") &
	"Nr", "Status", "Flavor", "Hel", "Col", "ACol", &
	"Parents", "Children", &
	"P(0)", "P(1)", "P(2)", "P(3)", "P^2"
	else
	write (u, &
	"((A4,1X),(A6,1X),(A7,1X),2(A4,1X),2(A20,1X),5(A12,1X))") &
	"Nr", "Status", "Flavor", "Col", "ACol", &
	"Parents", "Children", &
	"P(0)", "P(1)", "P(2)", "P(3)", "P^2"
	end if
	end if
	if (particle_set%n_tot /= 0) then
	do i = 1, particle_set%n_tot
	if (comp) then
	write (u, "(I4,1X,2X)", advance="no") i
	else
	write (u, "(1x,A,1x,I0)", advance="no") "Particle", i
	end if
	call particle_set%prt(i)%write (u, testflag = testflag, &
	compressed = comp, polarization = pol)
	end do
	if (particle_set%correlated_state%is_defined ()) then
	call write_separator (u)
	write (u, *) "Correlated state density matrix:"
	call particle_set%correlated_state%write (u)
	end if
	if (summ) then
	call write_separator (u)
	write (u, "(A)", advance="no") &
	"Sum of incoming momenta: p(0:3) = "
	sum_vec = sum (particle_set%prt%p, &
	mask=particle_set%prt%get_status () == PRT_INCOMING)
	call pacify (sum_vec, tolerance = 1E-3_default)
	call sum_vec%write (u, compressed=.true.)
	write (u, *)
	write (u, "(A)", advance="no") &
	"Sum of beam remnant momenta: p(0:3) = "
	sum_vec = sum (particle_set%prt%p, &
	mask=particle_set%prt%get_status () == PRT_BEAM_REMNANT)
	call pacify (sum_vec, tolerance = 1E-3_default)
	call sum_vec%write (u, compressed=.true.)
	write (u, *)
	write (u, "(A)", advance="no") &
	"Sum of outgoing momenta: p(0:3) = "
	sum_vec = sum (particle_set%prt%p, &
	mask=particle_set%prt%get_status () == PRT_OUTGOING)
	call pacify (sum_vec, tolerance = 1E-3_default)
	call sum_vec%write (u, compressed=.true.)
	write (u, "(A)") ""
	end if
	else
	write (u, "(3x,A)") "[empty]"
	end if
	end subroutine particle_set_write

	@ %def particle_set_write
	@
	\subsection{I/O formats}
	Here, we define input/output of particle sets in various formats.
	This is the right place since particle sets contain most of the event
	information.

	All write/read routines take as first argument the object, as second
	argument the I/O unit which in this case is a mandatory argument.
	Then follow further event data.

	\subsubsection{Internal binary format}
	This format is supposed to contain the complete information, so
	the particle data set can be fully reconstructed. The exception is
	the model part of the particle flavors; this is unassigned for the
	flavor values read from file.
	<<Particles: particle set: TBP>>=
	procedure :: write_raw => particle_set_write_raw
	procedure :: read_raw => particle_set_read_raw
	<<Particles: procedures>>=
	subroutine particle_set_write_raw (particle_set, u)
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in) :: u
	integer :: i
	write (u) &
	particle_set%n_beam, particle_set%n_in, &
	particle_set%n_vir, particle_set%n_out
	write (u) particle_set%factorization_mode
	write (u) particle_set%n_tot
	do i = 1, particle_set%n_tot
	call particle_set%prt(i)%write_raw (u)
	end do
	call particle_set%correlated_state%write_raw (u)
	end subroutine particle_set_write_raw

	subroutine particle_set_read_raw (particle_set, u, iostat)
	class(particle_set_t), intent(out) :: particle_set
	integer, intent(in) :: u
	integer, intent(out) :: iostat
	integer :: i
	read (u, iostat=iostat) &
	particle_set%n_beam, particle_set%n_in, &
	particle_set%n_vir, particle_set%n_out
	read (u, iostat=iostat) particle_set%factorization_mode
	read (u, iostat=iostat) particle_set%n_tot
	allocate (particle_set%prt (particle_set%n_tot))
	do i = 1, size (particle_set%prt)
	call particle_set%prt(i)%read_raw (u, iostat=iostat)
	end do
	call particle_set%correlated_state%read_raw (u, iostat=iostat)
	end subroutine particle_set_read_raw

	@ %def particle_set_write_raw particle_set_read_raw
	@
	\subsubsection{Get contents}
	Find parents/children of a particular particle recursively; the
	search terminates if a parent/child has status [[BEAM]], [[INCOMING]],
	[[OUTGOING]] or [[RESONANT]].
	<<Particles: particle set: TBP>>=
	procedure :: get_real_parents => particle_set_get_real_parents
	procedure :: get_real_children => particle_set_get_real_children
	<<Particles: procedures>>=
	function particle_set_get_real_parents (pset, i, keep_beams) result (parent)
	integer, dimension(:), allocatable :: parent
	class(particle_set_t), intent(in) :: pset
	integer, intent(in) :: i
	logical, intent(in), optional :: keep_beams
	logical, dimension(:), allocatable :: is_real
	logical, dimension(:), allocatable :: is_parent, is_real_parent
	logical :: kb
	integer :: j, k
	kb = .false.
	if (present (keep_beams)) kb = keep_beams
	allocate (is_real (pset%n_tot))
	is_real = pset%prt%is_real (kb)
	allocate (is_parent (pset%n_tot), is_real_parent (pset%n_tot))
	is_real_parent = .false.
	is_parent = .false.
	is_parent(pset%prt(i)%get_parents()) = .true.
	do while (any (is_parent))
	where (is_real .and. is_parent)
	is_real_parent = .true.
	is_parent = .false.
	end where
	mark_next_parent: do j = size (is_parent), 1, -1
	if (is_parent(j)) then
	is_parent(pset%prt(j)%get_parents()) = .true.
	is_parent(j) = .false.
	exit mark_next_parent
	end if
	end do mark_next_parent
	end do
	allocate (parent (count (is_real_parent)))
	j = 0
	do k = 1, size (is_parent)
	if (is_real_parent(k)) then
	j = j + 1
	parent(j) = k
	end if
	end do
	end function particle_set_get_real_parents

	function particle_set_get_real_children (pset, i, keep_beams) result (child)
	integer, dimension(:), allocatable :: child
	class(particle_set_t), intent(in) :: pset
	integer, intent(in) :: i
	logical, dimension(:), allocatable :: is_real
	logical, dimension(:), allocatable :: is_child, is_real_child
	logical, intent(in), optional :: keep_beams
	integer :: j, k
	logical :: kb
	kb = .false.
	if (present (keep_beams)) kb = keep_beams
	allocate (is_real (pset%n_tot))
	is_real = pset%prt%is_real (kb)
	is_real = pset%prt%is_real (kb)
	allocate (is_child (pset%n_tot), is_real_child (pset%n_tot))
	is_real_child = .false.
	is_child = .false.
	is_child(pset%prt(i)%get_children()) = .true.
	do while (any (is_child))
	where (is_real .and. is_child)
	is_real_child = .true.
	is_child = .false.
	end where
	mark_next_child: do j = 1, size (is_child)
	if (is_child(j)) then
	is_child(pset%prt(j)%get_children()) = .true.
	is_child(j) = .false.
	exit mark_next_child
	end if
	end do mark_next_child
	end do
	allocate (child (count (is_real_child)))
	j = 0
	do k = 1, size (is_child)
	if (is_real_child(k)) then
	j = j + 1
	child(j) = k
	end if
	end do
	end function particle_set_get_real_children

	@ %def particle_set_get_real_parents
	@ %def particle_set_get_real_children
	@ Get the [[n_tot]], [[n_in]], and [[n_out]] values out of the
	particle set.
	<<Particles: particle set: TBP>>=
	procedure :: get_n_beam => particle_set_get_n_beam
	procedure :: get_n_in => particle_set_get_n_in
	procedure :: get_n_vir => particle_set_get_n_vir
	procedure :: get_n_out => particle_set_get_n_out
	procedure :: get_n_tot => particle_set_get_n_tot
	procedure :: get_n_remnants => particle_set_get_n_remnants
	<<Particles: procedures>>=
	function particle_set_get_n_beam (pset) result (n_beam)
	class(particle_set_t), intent(in) :: pset
	integer :: n_beam
	n_beam = pset%n_beam
	end function particle_set_get_n_beam

	function particle_set_get_n_in (pset) result (n_in)
	class(particle_set_t), intent(in) :: pset
	integer :: n_in
	n_in = pset%n_in
	end function particle_set_get_n_in

	function particle_set_get_n_vir (pset) result (n_vir)
	class(particle_set_t), intent(in) :: pset
	integer :: n_vir
	n_vir = pset%n_vir
	end function particle_set_get_n_vir

	function particle_set_get_n_out (pset) result (n_out)
	class(particle_set_t), intent(in) :: pset
	integer :: n_out
	n_out = pset%n_out
	end function particle_set_get_n_out

	function particle_set_get_n_tot (pset) result (n_tot)
	class(particle_set_t), intent(in) :: pset
	integer :: n_tot
	n_tot = pset%n_tot
	end function particle_set_get_n_tot

	function particle_set_get_n_remnants (pset) result (n_remn)
	class(particle_set_t), intent(in) :: pset
	integer :: n_remn
	if (allocated (pset%prt)) then
	n_remn = count (pset%prt%get_status () == PRT_BEAM_REMNANT)
	else
	n_remn = 0
	end if
	end function particle_set_get_n_remnants

	@ %def particle_set_get_n_beam
	@ %def particle_set_get_n_in
	@ %def particle_set_get_n_vir
	@ %def particle_set_get_n_out
	@ %def particle_set_get_n_tot
	@ %def particle_set_get_n_remnants
	@ Return a pointer to the particle corresponding to the number
	<<Particles: particle set: TBP>>=
	procedure :: get_particle => particle_set_get_particle
	<<Particles: procedures>>=
	function particle_set_get_particle (pset, index) result (particle)
	class(particle_set_t), intent(in) :: pset
	integer, intent(in) :: index
	type(particle_t) :: particle
	particle = pset%prt(index)
	end function particle_set_get_particle

	@ %def particle_set_get_particle
	@
	<<Particles: particle set: TBP>>=
	procedure :: get_indices => particle_set_get_indices
	<<Particles: procedures>>=
	pure function particle_set_get_indices (pset, mask) result (finals)
	integer, dimension(:), allocatable :: finals
	class(particle_set_t), intent(in) :: pset
	logical, dimension(:), intent(in) :: mask
	integer, dimension(size(mask)) :: indices
	integer :: i
	allocate (finals (count (mask)))
	indices = [(i, i=1, pset%n_tot)]
	finals = pack (indices, mask)
	end function particle_set_get_indices

	@ %def particle_set_get_indices
	@
	<<Particles: particle set: TBP>>=
	procedure :: get_in_and_out_momenta => particle_set_get_in_and_out_momenta
	<<Particles: procedures>>=
	function particle_set_get_in_and_out_momenta (pset) result (phs_point)
	type(phs_point_t) :: phs_point
	class(particle_set_t), intent(in) :: pset
	logical, dimension(:), allocatable :: mask
	integer, dimension(:), allocatable :: indices
	type(vector4_t), dimension(:), allocatable :: p
	allocate (mask (pset%get_n_tot ()))
	allocate (p (size (pset%prt)))
	mask = pset%prt%status == PRT_INCOMING .or. &
	pset%prt%status == PRT_OUTGOING
	allocate (indices (count (mask)))
	indices = pset%get_indices (mask)
	phs_point = pset%get_momenta (indices)
	end function particle_set_get_in_and_out_momenta

	@ %def particle_set_get_in_and_out_momenta
	@
	\subsubsection{Tools}
	Build a new particles array without hadronic remnants but with
	[[n_extra]] additional spots. We also update the mother-daughter
	relations assuming the ordering [[b]], [[i]], [[r]], [[x]], [[o]].
	<<Particles: particle set: TBP>>=
	procedure :: without_hadronic_remnants => &
	particle_set_without_hadronic_remnants
	<<Particles: procedures>>=
	subroutine particle_set_without_hadronic_remnants &
	(particle_set, particles, n_particles, n_extra)
	class(particle_set_t), intent(inout) :: particle_set
	type(particle_t), dimension(:), allocatable, intent(out) :: particles
	integer, intent(out) :: n_particles
	integer, intent(in) :: n_extra
	logical, dimension(:), allocatable :: no_hadronic_remnants, &
	no_hadronic_children
	integer, dimension(:), allocatable :: children, new_children
	integer :: i, j, k, first_remnant
	first_remnant = particle_set%n_tot
	do i = 1, particle_set%n_tot
	if (particle_set%prt(i)%is_hadronic_beam_remnant ()) then
	first_remnant = i
	exit
	end if
	end do
	n_particles = count (.not. particle_set%prt%is_hadronic_beam_remnant ())
	allocate (no_hadronic_remnants (particle_set%n_tot))
	no_hadronic_remnants = .not. particle_set%prt%is_hadronic_beam_remnant ()
	allocate (particles (n_particles + n_extra))
	k = 1
	do i = 1, particle_set%n_tot
	if (no_hadronic_remnants(i)) then
	particles(k) = particle_set%prt(i)
	k = k + 1
	end if
	end do
	if (n_particles /= particle_set%n_tot) then
	do i = 1, n_particles
	select case (particles(i)%get_status ())
	case (PRT_BEAM)
	if (allocated (children)) deallocate (children)
	allocate (children (particles(i)%get_n_children ()))
	children = particles(i)%get_children ()
	if (allocated (no_hadronic_children)) &
	deallocate (no_hadronic_children)
	allocate (no_hadronic_children (particles(i)%get_n_children ()))
	no_hadronic_children = .not. &
	particle_set%prt(children)%is_hadronic_beam_remnant ()
	if (allocated (new_children)) deallocate (new_children)
	allocate (new_children (count (no_hadronic_children)))
	new_children = pack (children, no_hadronic_children)
	call particles(i)%set_children (new_children)
	case (PRT_INCOMING, PRT_RESONANT)
	<<update children after remnant>>
	case (PRT_OUTGOING, PRT_BEAM_REMNANT)
	case default
	end select
	end do
	end if
	end subroutine particle_set_without_hadronic_remnants

	@ %def particle_set_without_hadronic_remnants
	<<update children after remnant>>=
	if (allocated (children)) deallocate (children)
	allocate (children (particles(i)%get_n_children ()))
	children = particles(i)%get_children ()
	do j = 1, size (children)
	if (children(j) > first_remnant) then
	children(j) = children (j) - &
	(particle_set%n_tot - n_particles)
	end if
	end do
	call particles(i)%set_children (children)
	@
	Build a new particles array without remnants but with
	[[n_extra]] additional spots. We also update the mother-daughter
	relations assuming the ordering [[b]], [[i]], [[r]], [[x]], [[o]].
	<<Particles: particle set: TBP>>=
	procedure :: without_remnants => particle_set_without_remnants
	<<Particles: procedures>>=
	subroutine particle_set_without_remnants &
	(particle_set, particles, n_particles, n_extra)
	class(particle_set_t), intent(inout) :: particle_set
	type(particle_t), dimension(:), allocatable, intent(out) :: particles
	integer, intent(in) :: n_extra
	integer, intent(out) :: n_particles
	logical, dimension(:), allocatable :: no_remnants, no_children
	integer, dimension(:), allocatable :: children, new_children
	integer :: i,j, k, first_remnant
	first_remnant = particle_set%n_tot
	do i = 1, particle_set%n_tot
	if (particle_set%prt(i)%is_beam_remnant ()) then
	first_remnant = i
	exit
	end if
	end do
	allocate (no_remnants (particle_set%n_tot))
	no_remnants = .not. (particle_set%prt%is_beam_remnant ())
	n_particles = count (no_remnants)
	allocate (particles (n_particles + n_extra))
	k = 1
	do i = 1, particle_set%n_tot
	if (no_remnants(i)) then
	particles(k) = particle_set%prt(i)
	k = k + 1
	end if
	end do
	if (n_particles /= particle_set%n_tot) then
	do i = 1, n_particles
	select case (particles(i)%get_status ())
	case (PRT_BEAM)
	if (allocated (children)) deallocate (children)
	allocate (children (particles(i)%get_n_children ()))
	children = particles(i)%get_children ()
	if (allocated (no_children)) deallocate (no_children)
	allocate (no_children (particles(i)%get_n_children ()))
	no_children = .not. (particle_set%prt(children)%is_beam_remnant ())
	if (allocated (new_children)) deallocate (new_children)
	allocate (new_children (count (no_children)))
	new_children = pack (children, no_children)
	call particles(i)%set_children (new_children)
	case (PRT_INCOMING, PRT_RESONANT)
	<<update children after remnant>>
	case (PRT_OUTGOING, PRT_BEAM_REMNANT)
	case default
	end select
	end do
	end if
	end subroutine particle_set_without_remnants

	@ %def particle_set_without_remnants
	@
	<<Particles: particle set: TBP>>=
	procedure :: find_particle => particle_set_find_particle
	<<Particles: procedures>>=
	pure function particle_set_find_particle &
	(particle_set, pdg, momentum, abs_smallness, rel_smallness) result (idx)
	integer :: idx
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: momentum
	real(default), intent(in), optional :: abs_smallness, rel_smallness
	integer :: i, j
	logical, dimension(0:3) :: equals
	idx = 0
	do i = 1, size (particle_set%prt)
	if (particle_set%prt(i)%flv%get_pdg () == pdg) then
	!!! Workaround for gfortran 4.8.3 with overloaded elemental function
	do j = 0, 3
	equals(j) = nearly_equal (particle_set%prt(i)%p%p(j), momentum%p(j), &
	abs_smallness, rel_smallness)
	end do
	if (all (equals)) then
	idx = i
	return
	end if
	end if
	end do
	end function particle_set_find_particle

	@ %def particle_set_find_particle
	<<Particles: particle set: TBP>>=
	procedure :: reverse_find_particle => particle_set_reverse_find_particle
	<<Particles: procedures>>=
	pure function particle_set_reverse_find_particle &
	(particle_set, pdg, momentum, abs_smallness, rel_smallness) result (idx)
	integer :: idx
	class(particle_set_t), intent(in) :: particle_set
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: momentum
	real(default), intent(in), optional :: abs_smallness, rel_smallness
	integer :: i
	idx = 0
	do i = size (particle_set%prt), 1, -1
	if (particle_set%prt(i)%flv%get_pdg () == pdg) then
	if (all (nearly_equal (particle_set%prt(i)%p%p, momentum%p, &
	abs_smallness, rel_smallness))) then
	idx = i
	return
	end if
	end if
	end do
	end function particle_set_reverse_find_particle

	@ %def particle_set_reverse_find_particle
	@ This connects broken links of the form
	$\text{something} \to i \to \text{none or} j$ and
	$\text{none} \to j \to \text{something or none}$ where the particles $i$ and $j$
	are \emph{identical}. It also works if $i \to j$, directly, and thus
	removes duplicates. We are removing $j$ and connect the possible
	daughters to $i$.
	<<Particles: particle set: TBP>>=
	procedure :: remove_duplicates => particle_set_remove_duplicates
	<<Particles: procedures>>=
	subroutine particle_set_remove_duplicates (particle_set, smallness)
	class(particle_set_t), intent(inout) :: particle_set
	real(default), intent(in) :: smallness
	integer :: n_removals
	integer, dimension(particle_set%n_tot) :: to_remove
	type(particle_t), dimension(:), allocatable :: particles
	type(vector4_t) :: p_i
	integer, dimension(:), allocatable :: map
	to_remove = 0
	call find_duplicates ()
	n_removals = count (to_remove > 0)
	if (n_removals > 0) then
	call strip_duplicates (particles)
	call particle_set%replace (particles)
	end if

	contains

	<<Particles: remove duplicates: procedures>>

	end subroutine particle_set_remove_duplicates

	@ %def particle_set_remove_duplicates
	@ This doesn't catch all cases. Missing are splittings of the type
	$i \to \text{something and} j$.
	<<Particles: remove duplicates: procedures>>=
	subroutine find_duplicates ()
	integer :: pdg_i, child_i, i, j
	OUTER: do i = 1, particle_set%n_tot
	if (particle_set%prt(i)%status == PRT_OUTGOING .or. &
	particle_set%prt(i)%status == PRT_VIRTUAL .or. &
	particle_set%prt(i)%status == PRT_RESONANT) then
	if (allocated (particle_set%prt(i)%child)) then
	if (size (particle_set%prt(i)%child) > 1) cycle OUTER
	if (size (particle_set%prt(i)%child) == 1) then
	child_i = particle_set%prt(i)%child(1)
	else
	child_i = 0
	end if
	else
	child_i = 0
	end if
	pdg_i = particle_set%prt(i)%flv%get_pdg ()
	p_i = particle_set%prt(i)%p
	do j = i + 1, particle_set%n_tot
	if (pdg_i == particle_set%prt(j)%flv%get_pdg ()) then
	if (all (nearly_equal (particle_set%prt(j)%p%p, p_i%p, &
	abs_smallness = smallness, &
	rel_smallness = 1E4_default * smallness))) then
	if (child_i == 0 .or. j == child_i) then
	to_remove(j) = i
	call msg_debug2 (D_PARTICLES, &
	"Particles: Will remove duplicate of i", i)
	call msg_debug2 (D_PARTICLES, &
	"Particles: j", j)
	end if
	cycle OUTER
	end if
	end if
	end do
	end if
	end do OUTER
	end subroutine find_duplicates

	@
	<<Particles: remove duplicates: procedures>>=
	recursive function get_alive_index (try) result (alive)
	integer :: alive
	integer :: try
	if (map(try) > 0) then
	alive = map(try)
	else
	alive = get_alive_index (to_remove(try))
	end if
	end function get_alive_index

	@
	<<Particles: remove duplicates: procedures>>=
	subroutine strip_duplicates (particles)
	type(particle_t), dimension(:), allocatable, intent(out) :: particles
	integer :: kept, removed, i, j
	integer, dimension(:), allocatable :: old_children
	logical, dimension(:), allocatable :: parent_set
	call msg_debug (D_PARTICLES, "Particles: Removing duplicates")
	call msg_debug (D_PARTICLES, "Particles: n_removals", n_removals)
	if (debug2_active (D_PARTICLES)) then
	call msg_debug2 (D_PARTICLES, "Particles: Given set before removing:")
	call particle_set%write (summary=.true., compressed=.true.)
	end if
	allocate (particles (particle_set%n_tot - n_removals))
	allocate (map (particle_set%n_tot))
	allocate (parent_set (particle_set%n_tot))
	parent_set = .false.
	map = 0
	j = 0
	do i = 1, particle_set%n_tot
	if (to_remove(i) == 0) then
	j = j + 1
	map(i) = j
	call particles(j)%init (particle_set%prt(i))
	end if
	end do
	do i = 1, particle_set%n_tot
	if (map(i) /= 0) then
	if (.not. parent_set(map(i))) then
	call particles(map(i))%set_parents &
	(map (particle_set%prt(i)%get_parents ()))
	end if
	call particles(map(i))%set_children &
	(map (particle_set%prt(i)%get_children ()))
	else
	removed = i
	kept = to_remove(i)
	if (particle_set%prt(removed)%has_children ()) then
	old_children = particle_set%prt(removed)%get_children ()
	do j = 1, size (old_children)
	if (map(old_children(j)) > 0) then
	call particles(map(old_children(j)))%set_parents &
	([get_alive_index (kept)])
	parent_set(map(old_children(j))) = .true.
	call particles(get_alive_index (kept))%add_child &
	(map(old_children(j)))
	end if
	end do
	particles(get_alive_index (kept))%status = PRT_RESONANT
	else
	particles(get_alive_index (kept))%status = PRT_OUTGOING
	end if
	end if
	end do
	end subroutine strip_duplicates

	@ Given a subevent, reset status codes. If the new status is beam,
	incoming, or outgoing, we also make sure that the stored $p^2$ value
	is equal to the on-shell mass squared.
	<<Particles: particle set: TBP>>=
	procedure :: reset_status => particle_set_reset_status
	<<Particles: procedures>>=
	subroutine particle_set_reset_status (particle_set, index, status)
	class(particle_set_t), intent(inout) :: particle_set
	integer, dimension(:), intent(in) :: index
	integer, intent(in) :: status
	integer :: i
	if (allocated (particle_set%prt)) then
	do i = 1, size (index)
	call particle_set%prt(index(i))%reset_status (status)
	end do
	end if
	particle_set%n_beam = &
	count (particle_set%prt%get_status () == PRT_BEAM)
	particle_set%n_in = &
	count (particle_set%prt%get_status () == PRT_INCOMING)
	particle_set%n_out = &
	count (particle_set%prt%get_status () == PRT_OUTGOING)
	particle_set%n_vir = particle_set%n_tot &
	- particle_set%n_beam - particle_set%n_in - particle_set%n_out
	end subroutine particle_set_reset_status

	@ %def particle_set_reset_status
	@ Reduce a particle set to the essential entries. The entries kept
	are those with status [[INCOMING]], [[OUTGOING]] or
	[[RESONANT]]. [[BEAM]] is kept if [[keep_beams]] is true. Other
	entries are skipped. The correlated state matrix, if any, is also
	ignored.
	<<Particles: particle set: TBP>>=
	procedure :: reduce => particle_set_reduce
	<<Particles: procedures>>=
	subroutine particle_set_reduce (pset_in, pset_out, keep_beams)
	class(particle_set_t), intent(in) :: pset_in
	type(particle_set_t), intent(out) :: pset_out
	logical, intent(in), optional :: keep_beams
	integer, dimension(:), allocatable :: status, map
	integer :: i, j
	logical :: kb
	kb = .false.; if (present (keep_beams)) kb = keep_beams
	allocate (status (pset_in%n_tot))
	pset_out%factorization_mode = pset_in%factorization_mode
	status = pset_in%prt%get_status ()
	if (kb) pset_out%n_beam = count (status == PRT_BEAM)
	pset_out%n_in = count (status == PRT_INCOMING)
	pset_out%n_vir = count (status == PRT_RESONANT)
	pset_out%n_out = count (status == PRT_OUTGOING)
	pset_out%n_tot = &
	pset_out%n_beam + pset_out%n_in + pset_out%n_vir + pset_out%n_out
	allocate (pset_out%prt (pset_out%n_tot))
	allocate (map (pset_in%n_tot))
	map = 0
	j = 0
	if (kb) call copy_particles (PRT_BEAM)
	call copy_particles (PRT_INCOMING)
	call copy_particles (PRT_RESONANT)
	call copy_particles (PRT_OUTGOING)
	do i = 1, pset_in%n_tot
	if (map(i) == 0) cycle
	!!! !!! triggers nagfor bug!
	!!! call particle_set_parents (pset_out%prt(map(i)), &
	!!! map (particle_set_get_real_parents (pset_in, i)))
	!!! call particle_set_children (pset_out%prt(map(i)), &
	!!! map (particle_set_get_real_children (pset_in, i)))
	!!! !!! workaround:
	call pset_out%prt(map(i))%set_parents &
	(pset_in%get_real_parents (i, kb))
	call pset_out%prt(map(i))%set_parents &
	(map (pset_out%prt(map(i))%parent))
	call pset_out%prt(map(i))%set_children &
	(pset_in%get_real_children (i, kb))
	call pset_out%prt(map(i))%set_children &
	(map (pset_out%prt(map(i))%child))
	end do
	contains
	subroutine copy_particles (stat)
	integer, intent(in) :: stat
	integer :: i
	do i = 1, pset_in%n_tot
	if (status(i) == stat) then
	j = j + 1
	map(i) = j
	call particle_init_particle (pset_out%prt(j), pset_in%prt(i))
	end if
	end do
	end subroutine copy_particles
	end subroutine particle_set_reduce

	@ %def particles_set_reduce
	@ Remove the beam particles and beam remnants from the particle set if the
	keep beams flag is false. If keep beams is not given, the beam particles
	and the beam remnants are removed.
	The correlated state matrix, if any, is also ignored.
	<<Particles: particle set: TBP>>=
	procedure :: filter_particles => particle_set_filter_particles
	<<Particles: procedures>>=
	subroutine particle_set_filter_particles &
	(pset_in, pset_out, keep_beams, real_parents, keep_virtuals)
	class(particle_set_t), intent(in) :: pset_in
	type(particle_set_t), intent(out) :: pset_out
	logical, intent(in), optional :: keep_beams, real_parents, keep_virtuals
	integer, dimension(:), allocatable :: status, map
	logical, dimension(:), allocatable :: filter
	integer :: i, j
	logical :: kb, rp, kv
	kb = .false.; if (present (keep_beams)) kb = keep_beams
	rp = .false.; if (present (real_parents)) rp = real_parents
	kv = .true.; if (present (keep_virtuals)) kv = keep_virtuals
	call msg_debug (D_PARTICLES, "filter_particles")
	if (debug2_active (D_PARTICLES)) then
	print *, 'keep_beams = ', kb
	print *, 'real_parents = ', rp
	print *, 'keep_virtuals = ', kv
	print *, '>>> pset_in : '
	call pset_in%write(compressed=.true.)
	end if
	call count_and_allocate()
	map = 0
	j = 0
	filter = .false.
	if (.not. kb) filter = status == PRT_BEAM .or. status == PRT_BEAM_REMNANT
	if (.not. kv) filter = filter .or. status == PRT_VIRTUAL
	call copy_particles ()
	do i = 1, pset_in%n_tot
	if (map(i) == 0) cycle
	if (rp) then
	call pset_out%prt(map(i))%set_parents &
	(map (pset_in%get_real_parents (i, kb)))
	call pset_out%prt(map(i))%set_children &
	(map (pset_in%get_real_children (i, kb)))
	else
	call pset_out%prt(map(i))%set_parents &
	(map (pset_in%prt(i)%get_parents ()))
	call pset_out%prt(map(i))%set_children &
	(map (pset_in%prt(i)%get_children ()))
	end if
	end do
	if (debug2_active (D_PARTICLES)) then
	print *, '>>> pset_out : '
	call pset_out%write(compressed=.true.)
	end if
	contains
	<<filter particles: procedures>>
	end subroutine particle_set_filter_particles

	@ %def particles_set_filter_particles
	<<filter particles: procedures>>=
	subroutine copy_particles ()
	integer :: i
	do i = 1, pset_in%n_tot
	if (.not. filter(i)) then
	j = j + 1
	map(i) = j
	call particle_init_particle (pset_out%prt(j), pset_in%prt(i))
	end if
	end do
	end subroutine copy_particles

	<<filter particles: procedures>>=
	subroutine count_and_allocate
	allocate (status (pset_in%n_tot))
	status = particle_get_status (pset_in%prt)
	if (kb) pset_out%n_beam = count (status == PRT_BEAM)
	pset_out%n_in = count (status == PRT_INCOMING)
	if (kb .and. kv) then
	pset_out%n_vir = count (status == PRT_VIRTUAL) + &
	count (status == PRT_RESONANT) + &
	count (status == PRT_BEAM_REMNANT)
	else if (kb .and. .not. kv) then
	pset_out%n_vir = count (status == PRT_RESONANT) + &
	count (status == PRT_BEAM_REMNANT)
	else if (.not. kb .and. kv) then
	pset_out%n_vir = count (status == PRT_VIRTUAL) + &
	count (status == PRT_RESONANT)
	else
	pset_out%n_vir = count (status == PRT_RESONANT)
	end if
	pset_out%n_out = count (status == PRT_OUTGOING)
	pset_out%n_tot = &
	pset_out%n_beam + pset_out%n_in + pset_out%n_vir + pset_out%n_out
	allocate (pset_out%prt (pset_out%n_tot))
	allocate (map (pset_in%n_tot))
	allocate (filter (pset_in%n_tot))
	end subroutine count_and_allocate

	@ Transform a particle set into HEPEVT-compatible form. In this form, for each
	particle, the parents and the children are contiguous in the particle array.
	Usually, this requires to clone some particles.

	We do not know in advance how many particles the canonical form will have.
	To be on the safe side, allocate four times the original size.
	<<Particles: particle set: TBP>>=
	procedure :: to_hepevt_form => particle_set_to_hepevt_form
	<<Particles: procedures>>=
	subroutine particle_set_to_hepevt_form (pset_in, pset_out)
	class(particle_set_t), intent(in) :: pset_in
	type(particle_set_t), intent(out) :: pset_out
	type :: particle_entry_t
	integer :: src = 0
	integer :: status = 0
	integer :: orig = 0
	integer :: copy = 0
	end type particle_entry_t
	type(particle_entry_t), dimension(:), allocatable :: prt
	integer, dimension(:), allocatable :: map1, map2
	integer, dimension(:), allocatable :: parent, child
	integer :: n_tot, n_parents, n_children, i, j, c, n

	n_tot = pset_in%n_tot
	allocate (prt (4 * n_tot))
	allocate (map1(4 * n_tot))
	allocate (map2(4 * n_tot))
	map1 = 0
	map2 = 0
	allocate (child (n_tot))
	allocate (parent (n_tot))
	n = 0
	do i = 1, n_tot
	if (pset_in%prt(i)%get_n_parents () == 0) then
	call append (i)
	end if
	end do
	do i = 1, n_tot
	n_children = pset_in%prt(i)%get_n_children ()
	if (n_children > 0) then
	child(1:n_children) = pset_in%prt(i)%get_children ()
	c = child(1)
	if (map1(c) == 0) then
	n_parents = pset_in%prt(c)%get_n_parents ()
	if (n_parents > 1) then
	parent(1:n_parents) = pset_in%prt(c)%get_parents ()
	if (i == parent(1) .and. &
	any( [(map1(i)+j-1, j=1,n_parents)] /= &
	map1(parent(1:n_parents)))) then
	do j = 1, n_parents
	call append (parent(j))
	end do
	end if
	else if (map1(i) == 0) then
	call append (i)
	end if
	do j = 1, n_children
	call append (child(j))
	end do
	end if
	else if (map1(i) == 0) then
	call append (i)
	end if
	end do
	do i = n, 1, -1
	if (prt(i)%status /= PRT_OUTGOING) then
	do j = 1, i-1
	if (prt(j)%status == PRT_OUTGOING) then
	call append(prt(j)%src)
	end if
	end do
	exit
	end if
	end do
	pset_out%n_beam = count (prt(1:n)%status == PRT_BEAM)
	pset_out%n_in = count (prt(1:n)%status == PRT_INCOMING)
	pset_out%n_vir = count (prt(1:n)%status == PRT_RESONANT)
	pset_out%n_out = count (prt(1:n)%status == PRT_OUTGOING)
	pset_out%n_tot = n
	allocate (pset_out%prt (n))
	do i = 1, n
	call particle_init_particle (pset_out%prt(i), pset_in%prt(prt(i)%src))
	call pset_out%prt(i)%reset_status (prt(i)%status)
	if (prt(i)%orig == 0) then
	call pset_out%prt(i)%set_parents &
	(map2 (pset_in%prt(prt(i)%src)%get_parents ()))
	else
	call pset_out%prt(i)%set_parents ([ prt(i)%orig ])
	end if
	if (prt(i)%copy == 0) then
	call pset_out%prt(i)%set_children &
	(map1 (pset_in%prt(prt(i)%src)%get_children ()))
	else
	call pset_out%prt(i)%set_children ([ prt(i)%copy ])
	end if
	end do
	contains
	subroutine append (i)
	integer, intent(in) :: i
	n = n + 1
	if (n > size (prt)) &
	call msg_bug ("Particle set transform to HEPEVT: insufficient space")
	prt(n)%src = i
	prt(n)%status = pset_in%prt(i)%get_status ()
	if (map1(i) == 0) then
	map1(i) = n
	else
	prt(map2(i))%status = PRT_VIRTUAL
	prt(map2(i))%copy = n
	prt(n)%orig = map2(i)
	end if
	map2(i) = n
	end subroutine append
	end subroutine particle_set_to_hepevt_form

	@ %def particle_set_to_hepevt_form
	@ This procedure aims at reconstructing the momenta of an interaction,
	given a particle set. Since the particle orderings
	<<Particles: particle set: TBP>>=
	procedure :: fill_interaction => particle_set_fill_interaction
	<<Particles: procedures>>=
	subroutine particle_set_fill_interaction &
	(pset, int, n_in, recover_beams, check_match, state_flv)
	class(particle_set_t), intent(in) :: pset
	type(interaction_t), intent(inout) :: int
	integer, intent(in) :: n_in
	logical, intent(in), optional :: recover_beams, check_match
	type(state_flv_content_t), intent(in), optional :: state_flv
	integer, dimension(:), allocatable :: map, pdg
	integer, dimension(:), allocatable :: i_in, i_out, p_in, p_out
	logical, dimension(:), allocatable :: i_set
	integer :: n_out, i, p
	logical :: r_beams, check
	r_beams = .false.; if (present (recover_beams)) r_beams = recover_beams
	check = .true.; if (present (check_match)) check = check_match
	if (check) then
	call find_hard_process_in_int (i_in, i_out)
	call find_hard_process_in_pset (p_in, p_out)
	n_out = size (i_out)
	if (size (i_in) /= n_in) call err_int_n_in
	if (size (p_in) /= n_in) call err_pset_n_in
	if (size (p_out) /= n_out) call err_pset_n_out
	call extract_hard_process_from_pset (pdg)
	call determine_map_for_hard_process (map, state_flv)
	if (.not. r_beams) then
	select case (n_in)
	case (1)
	call recover_parents (p_in(1), map)
	case (2)
	do i = 1, 2
	call recover_parents (p_in(i), map)
	end do
	do p = 1, 2
	call recover_radiation (p, map)
	end do
	end select
	end if
	else
	allocate (map (int%get_n_tot ()))
	map = [(i, i = 1, size (map))]
	r_beams = .false.
	end if
	allocate (i_set (int%get_n_tot ()), source = .false.)
	do p = 1, size (map)
	if (map(p) /= 0) then
	i_set(map(p)) = .true.
	call int%set_momentum &
	(pset%prt(p)%get_momentum (), map(p))
	end if
	end do
	if (r_beams) then
	do i = 1, n_in
	call reconstruct_beam_and_radiation (i, i_set)
	end do
	end if
	if (any (.not. i_set)) call err_map
	contains
	subroutine find_hard_process_in_pset (p_in, p_out)
	integer, dimension(:), allocatable, intent(out) :: p_in, p_out
	integer, dimension(:), allocatable :: p_status, p_idx
	integer :: n_out_p
	integer :: i
	allocate (p_status (pset%n_tot), p_idx (pset%n_tot))
	p_status = pset%prt%get_status ()
	p_idx = [(i, i = 1, pset%n_tot)]
	allocate (p_in (n_in))
	p_in = pack (p_idx, p_status == PRT_INCOMING)
	if (size (p_in) == 0) call err_pset_hard
	i = p_in(1)
	n_out_p = particle_get_n_children (pset%prt(i))
	allocate (p_out (n_out_p))
	p_out = particle_get_children (pset%prt(i))
	end subroutine find_hard_process_in_pset
	subroutine find_hard_process_in_int (i_in, i_out)
	integer, dimension(:), allocatable, intent(out) :: i_in, i_out
	integer :: n_in_i
	integer :: i
	i = int%get_n_tot ()
	n_in_i = interaction_get_n_parents (int, i)
	if (n_in_i /= n_in) call err_int_n_in
	allocate (i_in (n_in))
	i_in = interaction_get_parents (int, i)
	i = i_in(1)
	n_out = interaction_get_n_children (int, i)
	allocate (i_out (n_out))
	i_out = interaction_get_children (int, i)
	end subroutine find_hard_process_in_int
	subroutine extract_hard_process_from_pset (pdg)
	integer, dimension(:), allocatable, intent(out) :: pdg
	integer, dimension(:), allocatable :: pdg_p
	logical, dimension(:), allocatable :: mask_p
	integer :: i
	allocate (pdg_p (pset%n_tot))
	pdg_p = pset%prt%get_pdg ()
	allocate (mask_p (pset%n_tot), source = .false.)
	mask_p (p_in) = .true.
	mask_p (p_out) = .true.
	allocate (pdg (n_in + n_out))
	pdg = pack (pdg_p, mask_p)
	end subroutine extract_hard_process_from_pset
	subroutine determine_map_for_hard_process (map, state_flv)
	integer, dimension(:), allocatable, intent(out) :: map
	type(state_flv_content_t), intent(in), optional :: state_flv
	integer, dimension(:), allocatable :: pdg_i, map_i
	integer :: n_tot
	logical, dimension(:), allocatable :: mask_i, mask_p
	logical :: success
	n_tot = int%get_n_tot ()
	if (present (state_flv)) then
	allocate (mask_i (n_tot), source = .false.)
	mask_i (i_in) = .true.
	mask_i (i_out) = .true.
	allocate (pdg_i (n_tot), map_i (n_tot))
	pdg_i = unpack (pdg, mask_i, 0)
	call state_flv%match (pdg_i, success, map_i)
	allocate (mask_p (pset%n_tot), source = .false.)
	mask_p (p_in) = .true.
	mask_p (p_out) = .true.
	allocate (map (size (mask_p)), &
	source = unpack (pack (map_i, mask_i), mask_p, 0))
	if (.not. success) call err_mismatch
	else
	allocate (map (n_tot), source = 0)
	map(p_in) = i_in
	map(p_out) = i_out
	end if
	end subroutine determine_map_for_hard_process
	recursive subroutine recover_parents (p, map)
	integer, intent(in) :: p
	integer, dimension(:), intent(inout) :: map
	integer :: i, n, n_p, q, k
	integer, dimension(:), allocatable :: i_parents, p_parents
	integer, dimension(1) :: pp
	i = map(p)
	n = interaction_get_n_parents (int, i)
	q = p
	n_p = particle_get_n_parents (pset%prt(q))
	do while (n_p == 1)
	pp = particle_get_parents (pset%prt(q))
	if (pset%prt(pp(1))%get_n_children () > 1) exit
	q = pp(1)
	n_p = pset%prt(q)%get_n_parents ()
	end do
	if (n_p /= n) call err_map
	allocate (i_parents (n), p_parents (n))
	i_parents = interaction_get_parents (int, i)
	p_parents = pset%prt(q)%get_parents ()
	do k = 1, n
	q = p_parents(k)
	if (map(q) == 0) then
	map(q) = i_parents(k)
	call recover_parents (q, map)
	end if
	end do
	end subroutine recover_parents
	recursive subroutine recover_radiation (p, map)
	integer, intent(in) :: p
	integer, dimension(:), intent(inout) :: map
	integer :: i, n, n_p, q, k
	integer, dimension(:), allocatable :: i_children, p_children
	if (particle_get_status (pset%prt(p)) == PRT_INCOMING) return
	i = map(p)
	n = interaction_get_n_children (int, i)
	n_p = pset%prt(p)%get_n_children ()
	if (n_p /= n) call err_map
	allocate (i_children (n), p_children (n))
	i_children = interaction_get_children (int, i)
	p_children = pset%prt(p)%get_children ()
	do k = 1, n
	q = p_children(k)
	if (map(q) == 0) then
	i = i_children(k)
	if (interaction_get_n_children (int, i) == 0) then
	map(q) = i
	else
	select case (n)
	case (2)
	select case (k)
	case (1); map(q) = i_children(2)
	case (2); map(q) = i_children(1)
	end select
	case (4)
	select case (k)
	case (1); map(q) = i_children(3)
	case (2); map(q) = i_children(4)
	case (3); map(q) = i_children(1)
	case (4); map(q) = i_children(2)
	end select
	case default
	call err_radiation
	end select
	end if
	else
	call recover_radiation (q, map)
	end if
	end do
	end subroutine recover_radiation
	subroutine reconstruct_beam_and_radiation (k, i_set)
	integer, intent(in) :: k
	logical, dimension(:), intent(inout) :: i_set
	integer :: k_src, k_in, k_rad
	type(interaction_t), pointer :: int_src
	integer, dimension(2) :: i_child
	call int%find_source (k, int_src, k_src)
	call int%set_momentum (int_src%get_momentum (k_src), k)
	i_set(k) = .true.
	if (n_in == 2) then
	i_child = interaction_get_children (int, k)
	if (interaction_get_n_children (int, i_child(1)) > 0) then
	k_in = i_child(1); k_rad = i_child(2)
	else
	k_in = i_child(2); k_rad = i_child(1)
	end if
	if (.not. i_set(k_in)) call err_beams
	call int%set_momentum &
	(int%get_momentum (k) - int%get_momentum (k_in), k_rad)
	i_set(k_rad) = .true.
	end if
	end subroutine reconstruct_beam_and_radiation
	subroutine err_pset_hard
	call msg_fatal ("Reading particle set: no particles marked as incoming")
	end subroutine err_pset_hard
	subroutine err_int_n_in
	integer :: n
	if (allocated (i_in)) then
	n = size (i_in)
	else
	n = 0
	end if
	write (msg_buffer, "(A,I0,A,I0)") &
	"Filling hard process from particle set: expect ", n_in, &
	" incoming particle(s), found ", n
	call msg_bug
	end subroutine err_int_n_in
	subroutine err_pset_n_in
	write (msg_buffer, "(A,I0,A,I0)") &
	"Reading hard-process particle set: should contain ", n_in, &
	" incoming particle(s), found ", size (p_in)
	call msg_fatal
	end subroutine err_pset_n_in
	subroutine err_pset_n_out
	write (msg_buffer, "(A,I0,A,I0)") &
	"Reading hard-process particle set: should contain ", n_out, &
	" outgoing particle(s), found ", size (p_out)
	call msg_fatal
	end subroutine err_pset_n_out
	subroutine err_mismatch
	call pset%write ()
	call state_flv%write ()
	call msg_fatal ("Reading particle set: Flavor combination " &
	// "does not match requested process")
	end subroutine err_mismatch
	subroutine err_map
	call pset%write ()
	call int%basic_write ()
	call msg_fatal ("Reading hard-process particle set: " &
	// "Incomplete mapping from particle set to interaction")
	end subroutine err_map
	subroutine err_beams
	call pset%write ()
	call int%basic_write ()
	call msg_fatal ("Reading particle set: Beam structure " &
	// "does not match requested process")
	end subroutine err_beams
	subroutine err_radiation
	call int%basic_write ()
	call msg_bug ("Reading particle set: Interaction " &
	// "contains inconsistent radiation pattern.")
	end subroutine err_radiation
	end subroutine particle_set_fill_interaction

	@ %def particle_set_fill_interaction
	@
	This procedure reconstructs an array of vertex indices from the
	parent-child information in the particle entries, according to the
	HepMC scheme. For each particle, we determine which vertex it comes
	from and which vertex it goes to. We return the two arrays and the
	maximum vertex index.

	For each particle in the list, we first check its parents. If for any
	parent the vertex where it goes to is already known, this vertex index
	is assigned as the current 'from' vertex. Otherwise, a new index is
	created, assigned as the current 'from' vertex, and as the 'to' vertex
	for all parents.

	Then, the analogous procedure is done for the children.

	Furthermore, we assign to each vertex the vertex position from the
	parent(s). We check that these vertex positions coincide, and if not
	return a null vector.
	<<Particles: particle set: TBP>>=
	procedure :: assign_vertices => particle_set_assign_vertices
	<<Particles: procedures>>=
	subroutine particle_set_assign_vertices &
	(particle_set, v_from, v_to, n_vertices)
	class(particle_set_t), intent(in) :: particle_set
	integer, dimension(:), intent(out) :: v_from, v_to
	integer, intent(out) :: n_vertices
	integer, dimension(:), allocatable :: parent, child
	integer :: n_parents, n_children, vf, vt
	integer :: i, j, v
	v_from = 0
	v_to = 0
	vf = 0
	vt = 0
	do i = 1, particle_set%n_tot
	n_parents = particle_set%prt(i)%get_n_parents ()
	if (n_parents /= 0) then
	allocate (parent (n_parents))
	parent = particle_set%prt(i)%get_parents ()
	SCAN_PARENTS: do j = 1, size (parent)
	v = v_to(parent(j))
	if (v /= 0) then
	v_from(i) = v; exit SCAN_PARENTS
	end if
	end do SCAN_PARENTS
	if (v_from(i) == 0) then
	vf = vf + 1; v_from(i) = vf
	v_to(parent) = vf
	end if
	deallocate (parent)
	end if
	n_children = particle_set%prt(i)%get_n_children ()
	if (n_children /= 0) then
	allocate (child (n_children))
	child = particle_set%prt(i)%get_children ()
	SCAN_CHILDREN: do j = 1, size (child)
	v = v_from(child(j))
	if (v /= 0) then
	v_to(i) = v; exit SCAN_CHILDREN
	end if
	end do SCAN_CHILDREN
	if (v_to(i) == 0) then
	vt = vt + 1; v_to(i) = vt
	v_from(child) = vt
	end if
	deallocate (child)
	end if
	end do
	n_vertices = max (vf, vt)
	end subroutine particle_set_assign_vertices

	@ %def particle_set_assign_vertices
	@
	\subsection{Expression interface}
	This converts a [[particle_set]] object as defined here to a more
	concise [[subevt]] object that can be used as the event root of an
	expression. In particular, the latter lacks virtual particles, spin
	correlations and parent-child relations.

	We keep beam particles, incoming partons, and outgoing partons.
	Furthermore, we keep radiated particles (a.k.a.\ beam remnants) if
	they have no children in the current particle set, and mark them as
	outgoing particles.

	If [[colorize]] is set and true, mark all particles in the subevent as
	colorized, and set color/anticolor flow indices where they are defined.
	Colorless particles do not get indices but are still marked as colorized, for
	consistency.
	<<Particles: particle set: TBP>>=
	procedure :: to_subevt => particle_set_to_subevt
	<<Particles: procedures>>=
	subroutine particle_set_to_subevt (particle_set, subevt, colorize)
	class(particle_set_t), intent(in) :: particle_set
	type(subevt_t), intent(out) :: subevt
	logical, intent(in), optional :: colorize
	integer :: n_tot, n_beam, n_in, n_out, n_rad
	integer :: i, k, n_active
	integer, dimension(2) :: hel
	logical :: keep
	n_tot = particle_set_get_n_tot (particle_set)
	n_beam = particle_set_get_n_beam (particle_set)
	n_in = particle_set_get_n_in (particle_set)
	n_out = particle_set_get_n_out (particle_set)
	n_rad = particle_set_get_n_remnants (particle_set)
	call subevt_init (subevt, n_beam + n_rad + n_in + n_out)
	k = 0
	do i = 1, n_tot
	associate (prt => particle_set%prt(i))
	keep = .false.
	select case (particle_get_status (prt))
	case (PRT_BEAM)
	k = k + 1
	call subevt_set_beam (subevt, k, &
	particle_get_pdg (prt), &
	particle_get_momentum (prt), &
	particle_get_p2 (prt))
	keep = .true.
	case (PRT_INCOMING)
	k = k + 1
	call subevt_set_incoming (subevt, k, &
	particle_get_pdg (prt), &
	particle_get_momentum (prt), &
	particle_get_p2 (prt))
	keep = .true.
	case (PRT_OUTGOING)
	k = k + 1
	call subevt_set_outgoing (subevt, k, &
	particle_get_pdg (prt), &
	particle_get_momentum (prt), &
	particle_get_p2 (prt))
	keep = .true.
	case (PRT_BEAM_REMNANT)
	if (particle_get_n_children (prt) == 0) then
	k = k + 1
	call subevt_set_outgoing (subevt, k, &
	particle_get_pdg (prt), &
	particle_get_momentum (prt), &
	particle_get_p2 (prt))
	keep = .true.
	end if
	end select
	if (keep) then
	if (prt%polarization == PRT_DEFINITE_HELICITY) then
	if (prt%hel%is_diagonal ()) then
	hel = prt%hel%to_pair ()
	call subevt_polarize (subevt, k, hel(1))
	end if
	end if
	end if
	if (present (colorize)) then
	if (colorize) then
	call subevt_colorize &
	(subevt, i, prt%col%get_col (), prt%col%get_acl ())
	end if
	end if
	end associate
	n_active = k
	end do
	call subevt_reset (subevt, n_active)
	end subroutine particle_set_to_subevt

	@ %def particle_set_to_subevt
	@
	This replaces the [[particle\_set\%prt array]] with a given array of particles
	<<Particles: particle set: TBP>>=
	procedure :: replace => particle_set_replace
	<<Particles: procedures>>=
	subroutine particle_set_replace (particle_set, newprt)
	class(particle_set_t), intent(inout) :: particle_set
	type(particle_t), intent(in), dimension(:), allocatable :: newprt
	if (allocated (particle_set%prt)) deallocate (particle_set%prt)
	allocate (particle_set%prt(size (newprt)))
	particle_set%prt = newprt
	particle_set%n_tot = size (newprt)
	particle_set%n_beam = count (particle_get_status (newprt) == PRT_BEAM)
	particle_set%n_in = count (particle_get_status (newprt) == PRT_INCOMING)
	particle_set%n_out = count (particle_get_status (newprt) == PRT_OUTGOING)
	particle_set%n_vir = particle_set%n_tot &
	- particle_set%n_beam - particle_set%n_in - particle_set%n_out
	end subroutine particle_set_replace

	@ %def particle_set_replace
	@ This routines orders the outgoing particles into clusters of
	colorless particles and such of particles ordered corresponding to the
	indices of the color lines. All outgoing particles in the ordered set
	appear as child of the corresponding outgoing particle in the
	unordered set, including colored beam remnants. We always start
	continue via the anti-color line, such that color flows within each
	Lund string system is always continued from the anticolor of one
	particle to the identical color index of another particle.
	<<Particles: particle set: TBP>>=
	procedure :: order_color_lines => particle_set_order_color_lines
	<<Particles: procedures>>=
	subroutine particle_set_order_color_lines (pset_out, pset_in)
	class(particle_set_t), intent(inout) :: pset_out
	type(particle_set_t), intent(in) :: pset_in
	integer :: i, n, n_col_rem
	n_col_rem = 0
	do i = 1, pset_in%n_tot
	if (pset_in%prt(i)%get_status () == PRT_BEAM_REMNANT .and. &
	any (pset_in%prt(i)%get_color () /= 0)) then
	n_col_rem = n_col_rem + 1
	end if
	end do
	pset_out%n_beam = pset_in%n_beam
	pset_out%n_in = pset_in%n_in
	pset_out%n_vir = pset_in%n_vir + pset_in%n_out + n_col_rem
	pset_out%n_out = pset_in%n_out
	pset_out%n_tot = pset_in%n_tot + pset_in%n_out + n_col_rem
	pset_out%correlated_state = pset_in%correlated_state
	pset_out%factorization_mode = pset_in%factorization_mode
	allocate (pset_out%prt (pset_out%n_tot))
	do i = 1, pset_in%n_tot
	call pset_out%prt(i)%init (pset_in%prt(i))
	call pset_out%prt(i)%set_children (pset_in%prt(i)%child)
	call pset_out%prt(i)%set_parents (pset_in%prt(i)%parent)
	end do
	n = pset_in%n_tot
	do i = 1, pset_in%n_tot
	if (pset_out%prt(i)%get_status () == PRT_OUTGOING .and. &
	all (pset_out%prt(i)%get_color () == 0) .and. &
	.not. pset_out%prt(i)%has_children ()) then
	n = n + 1
	call pset_out%prt(n)%init (pset_out%prt(i))
	call pset_out%prt(i)%reset_status (PRT_VIRTUAL)
	call pset_out%prt(i)%add_child (n)
	call pset_out%prt(i)%set_parents ([i])
	end if
	end do
	if (n_col_rem > 0) then
	do i = 1, n_col_rem
	end do
	end if
	end subroutine particle_set_order_color_lines

	@ %def particle_set_order_color_lines
	@
	Eliminate numerical noise
	<<Particles: public>>=
	public :: pacify
	<<Particles: interfaces>>=
	interface pacify
	module procedure pacify_particle
	module procedure pacify_particle_set
	end interface pacify

	<<Particles: procedures>>=
	subroutine pacify_particle (prt)
	class(particle_t), intent(inout) :: prt
	real(default) :: e
	e = epsilon (1._default) * energy (prt%p)
	call pacify (prt%p, 10 * e)
	call pacify (prt%p2, 1e4 * e)
	end subroutine pacify_particle

	subroutine pacify_particle_set (pset)
	class(particle_set_t), intent(inout) :: pset
	integer :: i
	do i = 1, pset%n_tot
	call pacify (pset%prt(i))
	end do
	end subroutine pacify_particle_set

	@ %def pacify
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[particles_ut.f90]]>>=
	<<File header>>

	module particles_ut
	use unit_tests
	use particles_uti

	<<Standard module head>>

	<<Particles: public test>>

	contains

	<<Particles: test driver>>

	end module particles_ut
	@ %def particles_ut
	@
	<<[[particles_uti.f90]]>>=
	<<File header>>

	module particles_uti

	<<Use kinds>>
	use io_units
	use numeric_utils
	use constants, only: one, tiny_07
	use lorentz
	use flavors
	use colors
	use helicities
	use quantum_numbers
	use state_matrices
	use interactions
	use evaluators
	use model_data
	use subevents

	use particles

	<<Standard module head>>

	<<Particles: test declarations>>

	contains

	<<Particles: tests>>

	<<Particles: test auxiliary>>

	end module particles_uti
	@ %def particles_ut
	@ API: driver for the unit tests below.
	<<Particles: public test>>=
	public :: particles_test
	<<Particles: test driver>>=
	subroutine particles_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Particles: execute tests>>
	end subroutine particles_test

	@ %def particles_test
	@
	Check the basic setup of the [[particle_set_t]] type:
	Set up a chain of production and decay and factorize the result into
	particles. The process is $d\bar d \to Z \to q\bar q$.
	<<Particles: execute tests>>=
	call test (particles_1, "particles_1", &
	"check particle_set routines", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_1
	<<Particles: tests>>=
	subroutine particles_1 (u)
	use os_interface
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(flavor_t), dimension(3) :: flv
	type(color_t), dimension(3) :: col
	type(helicity_t), dimension(3) :: hel
	type(quantum_numbers_t), dimension(3) :: qn
	type(vector4_t), dimension(3) :: p
	type(interaction_t), target :: int1, int2
	type(quantum_numbers_mask_t) :: qn_mask_conn
	type(evaluator_t), target :: eval
	type(interaction_t) :: int
	type(particle_set_t) :: particle_set1, particle_set2
	type(particle_set_t) :: particle_set3, particle_set4
	type(subevt_t) :: subevt
	logical :: ok
	integer :: unit, iostat

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: test particle_set routines"
	write (u, "(A)")

	write (u, "(A)") "* Reading model file"

	call model%init_sm_test ()

	write (u, "(A)")
	write (u, "(A)") "* Initializing production process"

	call int1%basic_init (2, 0, 1, set_relations=.true.)
	call flv%init ([1, -1, 23], model)
	call col%init_col_acl ([0, 0, 0], [0, 0, 0])
	call hel(3)%init (1, 1)
	call qn%init (flv, col, hel)
	call int1%add_state (qn, value=(0.25_default, 0._default))
	call hel(3)%init (1,-1)
	call qn%init (flv, col, hel)
	call int1%add_state (qn, value=(0._default, 0.25_default))
	call hel(3)%init (-1, 1)
	call qn%init (flv, col, hel)
	call int1%add_state (qn, value=(0._default,-0.25_default))
	call hel(3)%init (-1,-1)
	call qn%init (flv, col, hel)
	call int1%add_state (qn, value=(0.25_default, 0._default))
	call hel(3)%init (0, 0)
	call qn%init (flv, col, hel)
	call int1%add_state (qn, value=(0.5_default, 0._default))
	call int1%freeze ()
	p(1) = vector4_moving (45._default, 45._default, 3)
	p(2) = vector4_moving (45._default,-45._default, 3)
	p(3) = p(1) + p(2)
	call int1%set_momenta (p)

	write (u, "(A)")
	write (u, "(A)") "* Setup decay process"

	call int2%basic_init (1, 0, 2, set_relations=.true.)
	call flv%init ([23, 1, -1], model)
	call col%init_col_acl ([0, 501, 0], [0, 0, 501])
	call hel%init ([1, 1, 1], [1, 1, 1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(1._default, 0._default))
	call hel%init ([1, 1, 1], [-1,-1,-1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(0._default, 0.1_default))
	call hel%init ([-1,-1,-1], [1, 1, 1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(0._default,-0.1_default))
	call hel%init ([-1,-1,-1], [-1,-1,-1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(1._default, 0._default))
	call hel%init ([0, 1,-1], [0, 1,-1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(4._default, 0._default))
	call hel%init ([0,-1, 1], [0, 1,-1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(2._default, 0._default))
	call hel%init ([0, 1,-1], [0,-1, 1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(2._default, 0._default))
	call hel%init ([0,-1, 1], [0,-1, 1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(4._default, 0._default))
	call flv%init ([23, 2, -2], model)
	call hel%init ([0, 1,-1], [0, 1,-1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(0.5_default, 0._default))
	call hel%init ([0,-1, 1], [0,-1, 1])
	call qn%init (flv, col, hel)
	call int2%add_state (qn, value=(0.5_default, 0._default))
	call int2%freeze ()
	p(2) = vector4_moving (45._default, 45._default, 2)
	p(3) = vector4_moving (45._default,-45._default, 2)
	call int2%set_momenta (p)
	call int2%set_source_link (1, int1, 3)
	call int1%basic_write (u)
	call int2%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Concatenate production and decay"

	call eval%init_product (int1, int2, qn_mask_conn, &
	connections_are_resonant=.true.)
	call eval%receive_momenta ()
	call eval%evaluate ()
	call eval%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Factorize as subevent (complete, polarized)"
	write (u, "(A)")

	int = eval%interaction_t
	call particle_set1%init &
	(ok, int, int, FM_FACTOR_HELICITY, &
	[0.2_default, 0.2_default], .false., .true.)
	call particle_set1%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Factorize as subevent (in/out only, selected helicity)"
	write (u, "(A)")

	int = eval%interaction_t
	call particle_set2%init &
	(ok, int, int, FM_SELECT_HELICITY, &
	[0.9_default, 0.9_default], .false., .false.)
	call particle_set2%write (u)
	call particle_set2%final ()

	write (u, "(A)")
	write (u, "(A)") "* Factorize as subevent (complete, selected helicity)"
	write (u, "(A)")

	int = eval%interaction_t
	call particle_set2%init &
	(ok, int, int, FM_SELECT_HELICITY, &
	[0.7_default, 0.7_default], .false., .true.)
	call particle_set2%write (u)

	write (u, "(A)")
	write (u, "(A)") &
	"* Factorize (complete, polarized, correlated); write and read again"
	write (u, "(A)")

	int = eval%interaction_t
	call particle_set3%init &
	(ok, int, int, FM_FACTOR_HELICITY, &
	[0.7_default, 0.7_default], .true., .true.)
	call particle_set3%write (u)

	unit = free_unit ()
	open (unit, action="readwrite", form="unformatted", status="scratch")
	call particle_set3%write_raw (unit)
	rewind (unit)
	call particle_set4%read_raw (unit, iostat=iostat)
	call particle_set4%set_model (model)
	close (unit)

	write (u, "(A)")
	write (u, "(A)") "* Result from reading"
	write (u, "(A)")

	call particle_set4%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Transform to a subevt object"
	write (u, "(A)")

	call particle_set4%to_subevt (subevt)
	call subevt_write (subevt, u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call particle_set1%final ()
	call particle_set2%final ()
	call particle_set3%final ()
	call particle_set4%final ()
	call eval%final ()
	call int1%final ()
	call int2%final ()

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: particles_1"

	end subroutine particles_1

	@ %def particles_1
	@
	Reconstruct a hard interaction from a particle set.
	<<Particles: execute tests>>=
	call test (particles_2, "particles_2", &
	"reconstruct hard interaction", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_2
	<<Particles: tests>>=
	subroutine particles_2 (u)

	integer, intent(in) :: u
	type(interaction_t) :: int
	type(state_flv_content_t) :: state_flv
	type(particle_set_t) :: pset
	type(flavor_t), dimension(:), allocatable :: flv
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: i, j

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: reconstruct simple interaction"
	write (u, "(A)")

	write (u, "(A)") "* Set up a 2 -> 3 interaction"
	write (u, "(A)") " + incoming partons marked as virtual"
	write (u, "(A)") " + no quantum numbers"
	write (u, "(A)")

	call reset_interaction_counter ()
	call int%basic_init (0, 2, 3)
	do i = 1, 2
	do j = 3, 5
	call int%relate (i, j)
	end do
	end do

	allocate (qn (5))
	call int%add_state (qn)
	call int%freeze ()

	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set up a flavor-content record"
	write (u, "(A)")

	call state_flv%init (1, &
	mask = [.false., .false., .true., .true., .true.])
	call state_flv%set_entry (1, &
	pdg = [11, 12, 3, 4, 5], &
	map = [1, 2, 3, 4, 5])

	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually create a matching particle set"
	write (u, "(A)")

	pset%n_beam = 0
	pset%n_in = 2
	pset%n_vir = 0
	pset%n_out = 3
	pset%n_tot = 5
	allocate (pset%prt (pset%n_tot))
	do i = 1, 2
	call pset%prt(i)%reset_status (PRT_INCOMING)
	call pset%prt(i)%set_children ([3,4,5])
	end do
	do i = 3, 5
	call pset%prt(i)%reset_status (PRT_OUTGOING)
	call pset%prt(i)%set_parents ([1,2])
	end do
	call pset%prt(1)%set_momentum (vector4_at_rest (1._default))
	call pset%prt(2)%set_momentum (vector4_at_rest (2._default))
	call pset%prt(3)%set_momentum (vector4_at_rest (5._default))
	call pset%prt(4)%set_momentum (vector4_at_rest (4._default))
	call pset%prt(5)%set_momentum (vector4_at_rest (3._default))

	allocate (flv (5))
	call flv%init ([11,12,5,4,3])
	do i = 1, 5
	call pset%prt(i)%set_flavor (flv(i))
	end do

	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill interaction from particle set"
	write (u, "(A)")

	call pset%fill_interaction (int, 2, state_flv=state_flv)
	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call int%final ()
	call pset%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: particles_2"

	end subroutine particles_2

	@ %def particles_2
	@
	Reconstruct an interaction with beam structure, e.g., a hadronic
	interaction, from a particle set.
	<<Particles: execute tests>>=
	call test (particles_3, "particles_3", &
	"reconstruct interaction with beam structure", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_3
	<<Particles: tests>>=
	subroutine particles_3 (u)

	integer, intent(in) :: u
	type(interaction_t) :: int
	type(state_flv_content_t) :: state_flv
	type(particle_set_t) :: pset
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: i, j

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: reconstruct simple interaction"
	write (u, "(A)")

	write (u, "(A)") "* Set up a 2 -> 2 -> 3 interaction with radiation"
	write (u, "(A)") " + no quantum numbers"
	write (u, "(A)")

	call reset_interaction_counter ()
	call int%basic_init (0, 6, 3)
	call int%relate (1, 3)
	call int%relate (1, 4)
	call int%relate (2, 5)
	call int%relate (2, 6)
	do i = 4, 6, 2
	do j = 7, 9
	call int%relate (i, j)
	end do
	end do

	allocate (qn (9))
	call int%add_state (qn)
	call int%freeze ()

	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set up a flavor-content record"
	write (u, "(A)")

	call state_flv%init (1, &
	mask = [.false., .false., .false., .false., .false., .false., &
	.true., .true., .true.])
	call state_flv%set_entry (1, &
	pdg = [2011, 2012, 91, 11, 92, 12, 3, 4, 5], &
	map = [1, 2, 3, 4, 5, 6, 7, 8, 9])

	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually create a matching particle set"
	write (u, "(A)")

	call create_test_particle_set_1 (pset)

	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill interaction from particle set"
	write (u, "(A)")

	call pset%fill_interaction (int, 2, state_flv=state_flv)
	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call int%final ()
	call pset%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: particles_3"

	end subroutine particles_3

	@ %def particles_3
	@
	<<Particles: test auxiliary>>=
	subroutine create_test_particle_set_1 (pset)
	type(particle_set_t), intent(out) :: pset
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: i
	pset%n_beam = 2
	pset%n_in = 2
	pset%n_vir = 2
	pset%n_out = 3
	pset%n_tot = 9

	allocate (pset%prt (pset%n_tot))
	call pset%prt(1)%reset_status (PRT_BEAM)
	call pset%prt(2)%reset_status (PRT_BEAM)
	call pset%prt(3)%reset_status (PRT_INCOMING)
	call pset%prt(4)%reset_status (PRT_INCOMING)
	call pset%prt(5)%reset_status (PRT_BEAM_REMNANT)
	call pset%prt(6)%reset_status (PRT_BEAM_REMNANT)
	call pset%prt(7)%reset_status (PRT_OUTGOING)
	call pset%prt(8)%reset_status (PRT_OUTGOING)
	call pset%prt(9)%reset_status (PRT_OUTGOING)

	call pset%prt(1)%set_children ([3,5])
	call pset%prt(2)%set_children ([4,6])
	call pset%prt(3)%set_children ([7,8,9])
	call pset%prt(4)%set_children ([7,8,9])

	call pset%prt(3)%set_parents ([1])
	call pset%prt(4)%set_parents ([2])
	call pset%prt(5)%set_parents ([1])
	call pset%prt(6)%set_parents ([2])
	call pset%prt(7)%set_parents ([3,4])
	call pset%prt(8)%set_parents ([3,4])
	call pset%prt(9)%set_parents ([3,4])

	call pset%prt(1)%set_momentum (vector4_at_rest (1._default))
	call pset%prt(2)%set_momentum (vector4_at_rest (2._default))
	call pset%prt(3)%set_momentum (vector4_at_rest (4._default))
	call pset%prt(4)%set_momentum (vector4_at_rest (6._default))
	call pset%prt(5)%set_momentum (vector4_at_rest (3._default))
	call pset%prt(6)%set_momentum (vector4_at_rest (5._default))
	call pset%prt(7)%set_momentum (vector4_at_rest (7._default))
	call pset%prt(8)%set_momentum (vector4_at_rest (8._default))
	call pset%prt(9)%set_momentum (vector4_at_rest (9._default))

	allocate (flv (9))
	call flv%init ([2011, 2012, 11, 12, 91, 92, 3, 4, 5])
	do i = 1, 9
	call pset%prt(i)%set_flavor (flv(i))
	end do
	end subroutine create_test_particle_set_1

	@ %def create_test_particle_set_1

	@
	Reconstruct an interaction with beam structure, e.g., a hadronic
	interaction, from a particle set that is missing the beam information.
	<<Particles: execute tests>>=
	call test (particles_4, "particles_4", &
	"reconstruct interaction with missing beams", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_4
	<<Particles: tests>>=
	subroutine particles_4 (u)

	integer, intent(in) :: u
	type(interaction_t) :: int
	type(interaction_t), target :: int_beams
	type(state_flv_content_t) :: state_flv
	type(particle_set_t) :: pset
	type(flavor_t), dimension(:), allocatable :: flv
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: i, j

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: reconstruct beams"
	write (u, "(A)")

	call reset_interaction_counter ()

	write (u, "(A)") "* Set up an interaction that contains beams only"
	write (u, "(A)")

	call int_beams%basic_init (0, 0, 2)
	call int_beams%set_momentum (vector4_at_rest (1._default), 1)
	call int_beams%set_momentum (vector4_at_rest (2._default), 2)
	allocate (qn (2))
	call int_beams%add_state (qn)
	call int_beams%freeze ()

	call int_beams%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Set up a 2 -> 2 -> 3 interaction with radiation"
	write (u, "(A)") " + no quantum numbers"
	write (u, "(A)")

	call int%basic_init (0, 6, 3)
	call int%relate (1, 3)
	call int%relate (1, 4)
	call int%relate (2, 5)
	call int%relate (2, 6)
	do i = 4, 6, 2
	do j = 7, 9
	call int%relate (i, j)
	end do
	end do
	do i = 1, 2
	call int%set_source_link (i, int_beams, i)
	end do

	deallocate (qn)
	allocate (qn (9))
	call int%add_state (qn)
	call int%freeze ()

	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set up a flavor-content record"
	write (u, "(A)")

	call state_flv%init (1, &
	mask = [.false., .false., .false., .false., .false., .false., &
	.true., .true., .true.])
	call state_flv%set_entry (1, &
	pdg = [2011, 2012, 91, 11, 92, 12, 3, 4, 5], &
	map = [1, 2, 3, 4, 5, 6, 7, 8, 9])

	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually create a matching particle set"
	write (u, "(A)")

	pset%n_beam = 0
	pset%n_in = 2
	pset%n_vir = 0
	pset%n_out = 3
	pset%n_tot = 5

	allocate (pset%prt (pset%n_tot))
	call pset%prt(1)%reset_status (PRT_INCOMING)
	call pset%prt(2)%reset_status (PRT_INCOMING)
	call pset%prt(3)%reset_status (PRT_OUTGOING)
	call pset%prt(4)%reset_status (PRT_OUTGOING)
	call pset%prt(5)%reset_status (PRT_OUTGOING)

	call pset%prt(1)%set_children ([3,4,5])
	call pset%prt(2)%set_children ([3,4,5])

	call pset%prt(3)%set_parents ([1,2])
	call pset%prt(4)%set_parents ([1,2])
	call pset%prt(5)%set_parents ([1,2])

	call pset%prt(1)%set_momentum (vector4_at_rest (6._default))
	call pset%prt(2)%set_momentum (vector4_at_rest (6._default))
	call pset%prt(3)%set_momentum (vector4_at_rest (3._default))
	call pset%prt(4)%set_momentum (vector4_at_rest (4._default))
	call pset%prt(5)%set_momentum (vector4_at_rest (5._default))

	allocate (flv (5))
	call flv%init ([11, 12, 3, 4, 5])
	do i = 1, 5
	call pset%prt(i)%set_flavor (flv(i))
	end do

	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill interaction from particle set"
	write (u, "(A)")

	call pset%fill_interaction (int, 2, state_flv=state_flv, &
	recover_beams = .true.)
	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call int%final ()
	call pset%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: particles_4"

	end subroutine particles_4

	@ %def particles_4
	@
	Reconstruct an interaction with beam structure and cloned particles
	(radiated particles repeated in the event record, to maintain some
	canonical ordering).
	<<Particles: execute tests>>=
	call test (particles_5, "particles_5", &
	"reconstruct interaction with beams and duplicate entries", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_5
	<<Particles: tests>>=
	subroutine particles_5 (u)

	integer, intent(in) :: u
	type(interaction_t) :: int
	type(state_flv_content_t) :: state_flv
	type(particle_set_t) :: pset
	type(flavor_t), dimension(:), allocatable :: flv
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: i, j

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: reconstruct event with duplicate entries"
	write (u, "(A)")

	write (u, "(A)") "* Set up a 2 -> 2 -> 3 interaction with radiation"
	write (u, "(A)") " + no quantum numbers"
	write (u, "(A)")

	call reset_interaction_counter ()
	call int%basic_init (0, 6, 3)
	call int%relate (1, 3)
	call int%relate (1, 4)
	call int%relate (2, 5)
	call int%relate (2, 6)
	do i = 4, 6, 2
	do j = 7, 9
	call int%relate (i, j)
	end do
	end do

	allocate (qn (9))
	call int%add_state (qn)
	call int%freeze ()

	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set up a flavor-content record"
	write (u, "(A)")

	call state_flv%init (1, &
	mask = [.false., .false., .false., .false., .false., .false., &
	.true., .true., .true.])
	call state_flv%set_entry (1, &
	pdg = [2011, 2012, 91, 11, 92, 12, 3, 4, 5], &
	map = [1, 2, 3, 4, 5, 6, 7, 8, 9])

	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually create a matching particle set"
	write (u, "(A)")

	pset%n_beam = 2
	pset%n_in = 2
	pset%n_vir = 4
	pset%n_out = 5
	pset%n_tot = 13

	allocate (pset%prt (pset%n_tot))
	call pset%prt(1)%reset_status (PRT_BEAM)
	call pset%prt(2)%reset_status (PRT_BEAM)
	call pset%prt(3)%reset_status (PRT_VIRTUAL)
	call pset%prt(4)%reset_status (PRT_VIRTUAL)
	call pset%prt(5)%reset_status (PRT_VIRTUAL)
	call pset%prt(6)%reset_status (PRT_VIRTUAL)
	call pset%prt(7)%reset_status (PRT_INCOMING)
	call pset%prt(8)%reset_status (PRT_INCOMING)
	call pset%prt( 9)%reset_status (PRT_OUTGOING)
	call pset%prt(10)%reset_status (PRT_OUTGOING)
	call pset%prt(11)%reset_status (PRT_OUTGOING)
	call pset%prt(12)%reset_status (PRT_OUTGOING)
	call pset%prt(13)%reset_status (PRT_OUTGOING)

	call pset%prt(1)%set_children ([3,4])
	call pset%prt(2)%set_children ([5,6])
	call pset%prt(3)%set_children ([ 7])
	call pset%prt(4)%set_children ([ 9])
	call pset%prt(5)%set_children ([ 8])
	call pset%prt(6)%set_children ([10])
	call pset%prt(7)%set_children ([11,12,13])
	call pset%prt(8)%set_children ([11,12,13])

	call pset%prt(3)%set_parents ([1])
	call pset%prt(4)%set_parents ([1])
	call pset%prt(5)%set_parents ([2])
	call pset%prt(6)%set_parents ([2])
	call pset%prt( 7)%set_parents ([3])
	call pset%prt( 8)%set_parents ([5])
	call pset%prt( 9)%set_parents ([4])
	call pset%prt(10)%set_parents ([6])
	call pset%prt(11)%set_parents ([7,8])
	call pset%prt(12)%set_parents ([7,8])
	call pset%prt(13)%set_parents ([7,8])

	call pset%prt(1)%set_momentum (vector4_at_rest (1._default))
	call pset%prt(2)%set_momentum (vector4_at_rest (2._default))
	call pset%prt(3)%set_momentum (vector4_at_rest (4._default))
	call pset%prt(4)%set_momentum (vector4_at_rest (3._default))
	call pset%prt(5)%set_momentum (vector4_at_rest (6._default))
	call pset%prt(6)%set_momentum (vector4_at_rest (5._default))
	call pset%prt(7)%set_momentum (vector4_at_rest (4._default))
	call pset%prt(8)%set_momentum (vector4_at_rest (6._default))
	call pset%prt( 9)%set_momentum (vector4_at_rest (3._default))
	call pset%prt(10)%set_momentum (vector4_at_rest (5._default))
	call pset%prt(11)%set_momentum (vector4_at_rest (7._default))
	call pset%prt(12)%set_momentum (vector4_at_rest (8._default))
	call pset%prt(13)%set_momentum (vector4_at_rest (9._default))

	allocate (flv (13))
	call flv%init ([2011, 2012, 11, 91, 12, 92, 11, 12, 91, 92, 3, 4, 5])
	do i = 1, 13
	call pset%prt(i)%set_flavor (flv(i))
	end do

	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill interaction from particle set"
	write (u, "(A)")

	call pset%fill_interaction (int, 2, state_flv=state_flv)
	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call int%final ()
	call pset%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: particles_5"

	end subroutine particles_5

	@ %def particles_5
	@
	Reconstruct an interaction with pair spectrum, e.g., beamstrahlung from a
	particle set.
	<<Particles: execute tests>>=
	call test (particles_6, "particles_6", &
	"reconstruct interaction with pair spectrum", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_6
	<<Particles: tests>>=
	subroutine particles_6 (u)

	integer, intent(in) :: u
	type(interaction_t) :: int
	type(state_flv_content_t) :: state_flv
	type(particle_set_t) :: pset
	type(flavor_t), dimension(:), allocatable :: flv
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: i, j

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: reconstruct interaction with pair spectrum"
	write (u, "(A)")

	write (u, "(A)") "* Set up a 2 -> 2 -> 3 interaction with radiation"
	write (u, "(A)") " + no quantum numbers"
	write (u, "(A)")

	call reset_interaction_counter ()
	call int%basic_init (0, 6, 3)
	do i = 1, 2
	do j = 3, 6
	call int%relate (i, j)
	end do
	end do
	do i = 5, 6
	do j = 7, 9
	call int%relate (i, j)
	end do
	end do

	allocate (qn (9))
	call int%add_state (qn)
	call int%freeze ()

	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set up a flavor-content record"
	write (u, "(A)")

	call state_flv%init (1, &
	mask = [.false., .false., .false., .false., .false., .false., &
	.true., .true., .true.])
	call state_flv%set_entry (1, &
	pdg = [1011, 1012, 21, 22, 11, 12, 3, 4, 5], &
	map = [1, 2, 3, 4, 5, 6, 7, 8, 9])

	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually create a matching particle set"
	write (u, "(A)")

	pset%n_beam = 2
	pset%n_in = 2
	pset%n_vir = 2
	pset%n_out = 3
	pset%n_tot = 9

	allocate (pset%prt (pset%n_tot))
	call pset%prt(1)%reset_status (PRT_BEAM)
	call pset%prt(2)%reset_status (PRT_BEAM)
	call pset%prt(3)%reset_status (PRT_INCOMING)
	call pset%prt(4)%reset_status (PRT_INCOMING)
	call pset%prt(5)%reset_status (PRT_OUTGOING)
	call pset%prt(6)%reset_status (PRT_OUTGOING)
	call pset%prt(7)%reset_status (PRT_OUTGOING)
	call pset%prt(8)%reset_status (PRT_OUTGOING)
	call pset%prt(9)%reset_status (PRT_OUTGOING)

	call pset%prt(1)%set_children ([3,4,5,6])
	call pset%prt(2)%set_children ([3,4,5,6])
	call pset%prt(3)%set_children ([7,8,9])
	call pset%prt(4)%set_children ([7,8,9])

	call pset%prt(3)%set_parents ([1,2])
	call pset%prt(4)%set_parents ([1,2])
	call pset%prt(5)%set_parents ([1,2])
	call pset%prt(6)%set_parents ([1,2])
	call pset%prt(7)%set_parents ([3,4])
	call pset%prt(8)%set_parents ([3,4])
	call pset%prt(9)%set_parents ([3,4])

	call pset%prt(1)%set_momentum (vector4_at_rest (1._default))
	call pset%prt(2)%set_momentum (vector4_at_rest (2._default))
	call pset%prt(3)%set_momentum (vector4_at_rest (5._default))
	call pset%prt(4)%set_momentum (vector4_at_rest (6._default))
	call pset%prt(5)%set_momentum (vector4_at_rest (3._default))
	call pset%prt(6)%set_momentum (vector4_at_rest (4._default))
	call pset%prt(7)%set_momentum (vector4_at_rest (7._default))
	call pset%prt(8)%set_momentum (vector4_at_rest (8._default))
	call pset%prt(9)%set_momentum (vector4_at_rest (9._default))

	allocate (flv (9))
	call flv%init ([1011, 1012, 11, 12, 21, 22, 3, 4, 5])
	do i = 1, 9
	call pset%prt(i)%set_flavor (flv(i))
	end do

	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill interaction from particle set"
	write (u, "(A)")

	call pset%fill_interaction (int, 2, state_flv=state_flv)
	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call int%final ()
	call pset%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: particles_6"

	end subroutine particles_6

	@ %def particles_6
	@
	Reconstruct a hard decay interaction from a shuffled particle set.
	<<Particles: execute tests>>=
	call test (particles_7, "particles_7", &
	"reconstruct decay interaction with reordering", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_7
	<<Particles: tests>>=
	subroutine particles_7 (u)

	integer, intent(in) :: u
	type(interaction_t) :: int
	type(state_flv_content_t) :: state_flv
	type(particle_set_t) :: pset
	type(flavor_t), dimension(:), allocatable :: flv
	type(quantum_numbers_t), dimension(:), allocatable :: qn
	integer :: i, j

	write (u, "(A)") "* Test output: Particles"
	write (u, "(A)") "* Purpose: reconstruct decay interaction with reordering"
	write (u, "(A)")

	write (u, "(A)") "* Set up a 1 -> 3 interaction"
	write (u, "(A)") " + no quantum numbers"
	write (u, "(A)")

	call reset_interaction_counter ()
	call int%basic_init (0, 1, 3)
	do j = 2, 4
	call int%relate (1, j)
	end do

	allocate (qn (4))
	call int%add_state (qn)
	call int%freeze ()

	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set up a flavor-content record"
	write (u, "(A)") "* assumed interaction: 6 12 5 -11"
	write (u, "(A)")

	call state_flv%init (1, &
	mask = [.false., .true., .true., .true.])
	call state_flv%set_entry (1, &
	pdg = [6, 5, -11, 12], &
	map = [1, 4, 2, 3])

	call state_flv%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually create a matching particle set"
	write (u, "(A)")

	pset%n_beam = 0
	pset%n_in = 1
	pset%n_vir = 0
	pset%n_out = 3
	pset%n_tot = 4
	allocate (pset%prt (pset%n_tot))
	do i = 1, 1
	call pset%prt(i)%reset_status (PRT_INCOMING)
	call pset%prt(i)%set_children ([2,3,4])
	end do
	do i = 2, 4
	call pset%prt(i)%reset_status (PRT_OUTGOING)
	call pset%prt(i)%set_parents ([1])
	end do
	call pset%prt(1)%set_momentum (vector4_at_rest (1._default))
	call pset%prt(2)%set_momentum (vector4_at_rest (3._default))
	call pset%prt(3)%set_momentum (vector4_at_rest (2._default))
	call pset%prt(4)%set_momentum (vector4_at_rest (4._default))

	allocate (flv (4))
	call flv%init ([6,5,12,-11])
	do i = 1, 4
	call pset%prt(i)%set_flavor (flv(i))
	end do

	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill interaction from particle set"
	write (u, "(A)")

	call pset%fill_interaction (int, 1, state_flv=state_flv)
	call int%basic_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call int%final ()
	call pset%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: particles_7"

	end subroutine particles_7

	@ %def particles_7
	@
	<<Particles: execute tests>>=
	call test (particles_8, "particles_8", &
	"Test functions on particle sets", u, results)
	<<Particles: test declarations>>=
	public :: particles_8
	<<Particles: tests>>=
	subroutine particles_8 (u)
	integer, intent(in) :: u
	type(particle_set_t) :: particle_set
	type(particle_t), dimension(:), allocatable :: particles
	integer, allocatable, dimension(:) :: children, parents
	integer :: n_particles, i
	write (u, "(A)") "* Test output: particles_8"
	write (u, "(A)") "* Purpose: Test functions on particle sets"
	write (u, "(A)")

	call create_test_particle_set_1 (particle_set)
	call particle_set%write (u)
	call assert_equal (u, particle_set%n_tot, 9)
	call assert_equal (u, particle_set%n_beam, 2)
	allocate (children (particle_set%prt(3)%get_n_children ()))
	children = particle_set%prt(3)%get_children()
	call assert_equal (u, particle_set%prt(children(1))%get_pdg (), 3)
	call assert_equal (u, size (particle_set%prt(1)%get_children ()), 2)
	call assert_equal (u, size (particle_set%prt(2)%get_children ()), 2)

	call particle_set%without_hadronic_remnants &
	(particles, n_particles, 3)
	call particle_set%replace (particles)
	write (u, "(A)")
	call particle_set%write (u)

	call assert_equal (u, n_particles, 7)
	call assert_equal (u, size(particles), 10)
	call assert_equal (u, particle_set%n_tot, 10)
	call assert_equal (u, particle_set%n_beam, 2)
	do i = 3, 4
	if (allocated (children)) deallocate (children)
	allocate (children (particle_set%prt(i)%get_n_children ()))
	children = particle_set%prt(i)%get_children()
	call assert_equal (u, particle_set%prt(children(1))%get_pdg (), 3)
	call assert_equal (u, particle_set%prt(children(2))%get_pdg (), 4)
	call assert_equal (u, particle_set%prt(children(3))%get_pdg (), 5)
	end do
	do i = 5, 7
	if (allocated (parents)) deallocate (parents)
	allocate (parents (particle_set%prt(i)%get_n_parents ()))
	parents = particle_set%prt(i)%get_parents()
	call assert_equal (u, particle_set%prt(parents(1))%get_pdg (), 11)
	call assert_equal (u, particle_set%prt(parents(2))%get_pdg (), 12)
	end do
	call assert_equal (u, size (particle_set%prt(1)%get_children ()), &
	1, "get children of 1")
	call assert_equal (u, size (particle_set%prt(2)%get_children ()), &
	1, "get children of 2")

	call assert_equal (u, particle_set%find_particle &
	(particle_set%prt(1)%get_pdg (), particle_set%prt(1)%p), &
	1, "find 1st particle")
	call assert_equal (u, particle_set%find_particle &
	(particle_set%prt(2)%get_pdg (), particle_set%prt(2)%p * &
	(one + tiny_07), rel_smallness=1.0E-6_default), &
	2, "find 2nd particle fuzzy")

	write (u, "(A)")
	write (u, "(A)") "* Test output end: particles_8"
	end subroutine particles_8

	@ %def particles_8
	@
	Order color lines into Lund string systems, without colored beam
	remnants first.
	<<Particles: execute tests>>=
	call test (particles_9, "particles_9", &
	"order into Lund strings, uncolored beam remnants", &
	u, results)
	<<Particles: test declarations>>=
	public :: particles_9
	<<Particles: tests>>=
	subroutine particles_9 (u)
	integer, intent(in) :: u
	write (u, "(A)") "* Test output: particles_9"
	write (u, "(A)") "* Purpose: Order into Lund strings, "
	write (u, "(A)") "* uncolored beam remnants"
	write (u, "(A)")
	end subroutine particles_9

	@ %def particles_9



	Index: trunk/src/transforms/transforms.nw
	===================================================================
	--- trunk/src/transforms/transforms.nw (revision 8189)
	+++ trunk/src/transforms/transforms.nw (revision 8190)
	@@ -1,13926 +1,14048 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD event transforms and event API
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Event Implementation}
	\includemodulegraph{transforms}

	With a process object and the associated methods at hand, we can
	generate events for elementary processes and, by subsequent
	transformation, for complete physical processes.

	We have the following modules:
	\begin{description}
	\item[event\_transforms]
	Abstract base type for transforming a physical process with process
	instance and included evaluators, etc., into a new
	object. The following modules extend this base type.
	\item[resonance\_insertion]
	Insert a resonance history into an event record, based on
	kinematical and matrix-element information.
	\item[recoil\_kinematics]
	Common kinematics routines for the ISR and EPA handlers.
	\item[isr\_photon\_handler]
	Transform collinear kinematics, as it results from applying ISR
	radiation, to non-collinear kinematics with a reasonable
	transverse-momentum distribution of the radiated photons, and also
	of the recoiling partonic event.
	\item[epa\_beam\_handler]
	For photon-initiated processes where the effective photon
	approximation is used in integration, to add in beam-particle
	recoil. Analogous to the ISR handler.
	\item[decays]
	Combine the elementary process with elementary decay processes and
	thus transform the elementary event into a decayed event, still at
	the parton level.
	\item[showers]
	Create QED/QCD showers out of the partons that are emitted by
	elementary processes. This should be interleaved with showering of
	radiated particles (structure functions) and multiple interactions.
	\item[hadrons]
	(not implemented yet) Apply hadronization to the partonic events,
	interleaved with hadron decays. (The current setup relies on
	hadronizing partonic events externally.)
	\item[tau\_decays]
	(not implemented yet) Let $\tau$ leptons decay taking full spin
	correlations into account.
	\item[evt\_nlo]
	Handler for fixed-order NLO events.
	\item[events]
	Combine all pieces to generate full events.
	\item[eio\_raw]
	Raw I/O for complete events.
	\end{description}

	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Abstract Event Transforms}
	<<[[event_transforms.f90]]>>=
	<<File header>>

	module event_transforms

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_utils, only: write_separator
	use diagnostics
	use model_data
	use interactions
	use particles
	use subevents
	use rng_base
	use quantum_numbers, only: quantum_numbers_t
	use process, only: process_t
	use instances, only: process_instance_t
	use process_stacks

	<<Standard module head>>

	<<Event transforms: public>>

	<<Event transforms: types>>

	<<Event transforms: interfaces>>

	contains

	<<Event transforms: procedures>>

	end module event_transforms

	@ %def event_transforms
	@
	\subsection{Abstract base type}
	Essentially, all methods are abstract, but some get minimal base
	versions. We know that there will be a random-number generator at top
	level, and that we will relate to an elementary process.

	The model is stored separately. It may contain modified setting that differ
	from the model instance stored in the process object.

	Each event transform contains a particle set that it can fill for
	further use. There is a flag that indicates this.

	We will collect event transforms in a list, therefore we include
	[[previous]] and [[next]] pointers.
	<<Event transforms: public>>=
	public :: evt_t
	<<Event transforms: types>>=
	type, abstract :: evt_t
	type(process_t), pointer :: process => null ()
	type(process_instance_t), pointer :: process_instance => null ()
	class(model_data_t), pointer :: model => null ()
	class(rng_t), allocatable :: rng
	integer :: rejection_count = 0
	logical :: particle_set_exists = .false.
	type(particle_set_t) :: particle_set
	class(evt_t), pointer :: previous => null ()
	class(evt_t), pointer :: next => null ()
	real(default) :: weight = 0._default
	logical :: only_weighted_events = .false.
	contains
	<<Event transforms: evt: TBP>>
	end type evt_t

	@ %def evt_t
	@ Finalizer. In any case, we finalize the r.n.g. The process
	instance is a pointer and should not be finalized here.
	<<Event transforms: evt: TBP>>=
	procedure :: final => evt_final
	procedure :: base_final => evt_final
	<<Event transforms: procedures>>=
	subroutine evt_final (evt)
	class(evt_t), intent(inout) :: evt
	if (allocated (evt%rng)) call evt%rng%final ()
	if (evt%particle_set_exists) &
	call evt%particle_set%final ()
	end subroutine evt_final

	@ %def evt_final
	@ Print out the type of the [[evt]].
	<<Event transforms: evt: TBP>>=
	procedure (evt_write_name), deferred :: write_name
	<<Event transforms: interfaces>>=
	abstract interface
	subroutine evt_write_name (evt, unit)
	import
	class(evt_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	end subroutine evt_write_name
	end interface

	@ %def evt_write_name
	@
	<<Event transforms: evt: TBP>>=
	procedure (evt_write), deferred :: write
	<<Event transforms: interfaces>>=
	abstract interface
	subroutine evt_write (evt, unit, verbose, more_verbose, testflag)
	import
	class(evt_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	end subroutine evt_write
	end interface

	@ %def evt_write
	@ Output. We can print r.n.g. info.
	<<Event transforms: evt: TBP>>=
	procedure :: base_write => evt_base_write
	<<Event transforms: procedures>>=
	subroutine evt_base_write (evt, unit, testflag, show_set)
	class(evt_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag, show_set
	integer :: u
	logical :: show
	u = given_output_unit (unit)
	show = .true.; if (present (show_set)) show = show_set
	if (associated (evt%process)) then
	write (u, "(3x,A,A,A)") "Associated process: '", &
	char (evt%process%get_id ()), "'"
	end if
	if (allocated (evt%rng)) then
	call evt%rng%write (u, 1)
	write (u, "(3x,A,I0)") "Number of tries = ", evt%rejection_count
	end if
	if (show) then
	if (evt%particle_set_exists) then
	call write_separator (u)
	call evt%particle_set%write (u, testflag = testflag)
	end if
	end if
	end subroutine evt_base_write

	@ %def evt_base_write
	@ Connect the transform with a process instance (and thus with the
	associated process). Use this to allocate the master random-number
	generator.

	This is not an initializer; we may initialize the transform by
	implementation-specific methods.
	<<Event transforms: evt: TBP>>=
	procedure :: connect => evt_connect
	procedure :: base_connect => evt_connect
	<<Event transforms: procedures>>=
	subroutine evt_connect (evt, process_instance, model, process_stack)
	class(evt_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	evt%process => process_instance%process
	evt%process_instance => process_instance
	evt%model => model
	call evt%process%make_rng (evt%rng)
	end subroutine evt_connect

	@ %def evt_connect
	@ Reset internal state.
	<<Event transforms: evt: TBP>>=
	procedure :: reset => evt_reset
	procedure :: base_reset => evt_reset
	<<Event transforms: procedures>>=
	subroutine evt_reset (evt)
	class(evt_t), intent(inout) :: evt
	evt%rejection_count = 0
	call evt%particle_set%final ()
	evt%particle_set_exists = .false.
	end subroutine evt_reset

	@ %def evt_reset
	@ Prepare for a new event: reset internal state, if necessary. We
	provide MCI and term index of the parent process.
	<<Event transforms: evt: TBP>>=
	procedure (evt_prepare_new_event), deferred :: prepare_new_event
	<<Event transforms: interfaces>>=
	interface
	subroutine evt_prepare_new_event (evt, i_mci, i_term)
	import
	class(evt_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	end subroutine evt_prepare_new_event
	end interface

	@ %def evt_prepare_new_event
	@ Generate a weighted event, using a valid initiator event in the
	process instance, and the random-number generator. The returned event
	probability should be a number between zero and one that we can use for
	rejection.
	<<Event transforms: evt: TBP>>=
	procedure (evt_generate_weighted), deferred :: generate_weighted
	<<Event transforms: interfaces>>=
	abstract interface
	subroutine evt_generate_weighted (evt, probability)
	import
	class(evt_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	end subroutine evt_generate_weighted
	end interface

	@ %def evt_generate_weighted
	@ The unweighted event generation routine is actually implemented. It
	uses the random-number generator for simple rejection. Of course, the
	implementation may override this and implement a different way of
	generating an unweighted event.
	<<Event transforms: evt: TBP>>=
	procedure :: generate_unweighted => evt_generate_unweighted
	procedure :: base_generate_unweighted => evt_generate_unweighted
	<<Event transforms: procedures>>=
	subroutine evt_generate_unweighted (evt)
	class(evt_t), intent(inout) :: evt
	real(default) :: p, x
	evt%rejection_count = 0
	REJECTION: do
	evt%rejection_count = evt%rejection_count + 1
	call evt%generate_weighted (p)
	if (signal_is_pending ()) return
	call evt%rng%generate (x)
	if (x < p) exit REJECTION
	end do REJECTION
	end subroutine evt_generate_unweighted

	@ %def evt_generate_unweighted
	@ Make a particle set. This should take the most recent evaluator (or
	whatever stores the event), factorize the density matrix if necessary,
	and store as a particle set.

	If applicable, the factorization should make use of the
	[[factorization_mode]] and [[keep_correlations]] settings.

	The values [[r]], if set, should control the factorization in more
	detail, e.g., bypassing the random-number generator.
	<<Event transforms: evt: TBP>>=
	procedure (evt_make_particle_set), deferred :: make_particle_set
	<<Event transforms: interfaces>>=
	interface
	subroutine evt_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	import
	class(evt_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	end subroutine evt_make_particle_set
	end interface

	@ %def evt_make_particle_set
	@ Copy an existing particle set into the event record. This bypasses
	all methods to evaluate the internal state, but may be sufficient for
	further processing.
	<<Event transforms: evt: TBP>>=
	procedure :: set_particle_set => evt_set_particle_set
	<<Event transforms: procedures>>=
	subroutine evt_set_particle_set (evt, particle_set, i_mci, i_term)
	class(evt_t), intent(inout) :: evt
	type(particle_set_t), intent(in) :: particle_set
	integer, intent(in) :: i_term, i_mci
	call evt%prepare_new_event (i_mci, i_term)
	evt%particle_set = particle_set
	evt%particle_set_exists = .true.
	end subroutine evt_set_particle_set

	@ %def evt_set_particle_set
	@ This procedure can help in the previous task, if the particles are
	available in the form of an interaction object. (We need two
	interactions, one with color summed over, and one with the probability
	distributed among flows.)

	We use the two values from the random number generator for factorizing
	the state. For testing purposes, we can provide those numbers explicitly.
	<<Event transforms: evt: TBP>>=
	procedure :: factorize_interactions => evt_factorize_interactions
	<<Event transforms: procedures>>=
	subroutine evt_factorize_interactions &
	(evt, int_matrix, int_flows, factorization_mode, &
	keep_correlations, r, qn_select)
	class(evt_t), intent(inout) :: evt
	type(interaction_t), intent(in), target :: int_matrix, int_flows
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_select
	real(default), dimension(2) :: x
	if (present (r)) then
	if (size (r) == 2) then
	x = r
	else
	call msg_bug ("event factorization: size of r array must be 2")
	end if
	else
	call evt%rng%generate (x)
	end if
	call evt%particle_set%init (evt%particle_set_exists, &
	int_matrix, int_flows, factorization_mode, x, &
	keep_correlations, keep_virtual=.true., qn_select = qn_select)
	evt%particle_set_exists = .true.
	end subroutine evt_factorize_interactions

	@ %def evt_factorize_interactions
	@
	<<Event transforms: public>>=
	public :: make_factorized_particle_set
	<<Event transforms: procedures>>=
	subroutine make_factorized_particle_set (evt, factorization_mode, &
	keep_correlations, r, ii_term, qn_select)
	class(evt_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	integer, intent(in), optional :: ii_term
	type(quantum_numbers_t), dimension(:), intent(in), optional :: qn_select
	integer :: i_term
	type(interaction_t), pointer :: int_matrix, int_flows
	if (evt%process_instance%is_complete_event ()) then
	if (present (ii_term)) then
	i_term = ii_term
	else
	i_term = evt%process_instance%select_i_term ()
	end if
	int_matrix => evt%process_instance%get_matrix_int_ptr (i_term)
	int_flows => evt%process_instance%get_flows_int_ptr (i_term)
	call evt%factorize_interactions (int_matrix, int_flows, &
	factorization_mode, keep_correlations, r, qn_select)
	call evt%tag_incoming ()
	else
	call msg_bug ("Event factorization: event is incomplete")
	end if
	end subroutine make_factorized_particle_set

	@ %def make_factorized_particle_set
	@ Mark the incoming particles as incoming in the particle set. This
	is necessary because in the interaction objects they are usually
	marked as virtual.

	In the inquiry functions we set the term index to one; the indices of
	beams and incoming particles should be identical for all process
	terms.

	We use the initial elementary process for obtaining the indices.
	Thus, we implicitly assume that the beam and incoming indices stay the
	same across event transforms. If this is not true for a transform
	(say, MPI), it should override this method.
	<<Event transforms: evt: TBP>>=
	procedure :: tag_incoming => evt_tag_incoming
	<<Event transforms: procedures>>=
	subroutine evt_tag_incoming (evt)
	class(evt_t), intent(inout) :: evt
	integer :: i_term, n_in
	integer, dimension(:), allocatable :: beam_index, in_index
	n_in = evt%process%get_n_in ()
	i_term = 1
	allocate (beam_index (n_in))
	call evt%process_instance%get_beam_index (i_term, beam_index)
	call evt%particle_set%reset_status (beam_index, PRT_BEAM)
	allocate (in_index (n_in))
	call evt%process_instance%get_in_index (i_term, in_index)
	call evt%particle_set%reset_status (in_index, PRT_INCOMING)
	end subroutine evt_tag_incoming

	@ %def evt_tag_incoming
	@
	\subsection{Implementation: Trivial transform}
	This transform contains just a pointer to process and process
	instance. The [[generate]] methods do nothing.
	<<Event transforms: public>>=
	public :: evt_trivial_t
	<<Event transforms: types>>=
	type, extends (evt_t) :: evt_trivial_t
	contains
	<<Event transforms: evt trivial: TBP>>
	end type evt_trivial_t

	@ %def evt_trivial_t
	@
	<<Event transforms: evt trivial: TBP>>=
	procedure :: write_name => evt_trivial_write_name
	<<Event transforms: procedures>>=
	subroutine evt_trivial_write_name (evt, unit)
	class(evt_trivial_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: trivial (hard process)"
	end subroutine evt_trivial_write_name

	@ %def evt_trivial_write_name
	@ The finalizer is trivial. Some output:
	<<Event transforms: evt trivial: TBP>>=
	procedure :: write => evt_trivial_write
	<<Event transforms: procedures>>=
	subroutine evt_trivial_write (evt, unit, verbose, more_verbose, testflag)
	class(evt_trivial_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u)
	call evt%base_write (u, testflag = testflag)
	end subroutine evt_trivial_write

	@ %def evt_trivial_write
	@ Nothing to do here:
	<<Event transforms: evt trivial: TBP>>=
	procedure :: prepare_new_event => evt_trivial_prepare_new_event
	<<Event transforms: procedures>>=
	subroutine evt_trivial_prepare_new_event (evt, i_mci, i_term)
	class(evt_trivial_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	call evt%reset ()
	end subroutine evt_trivial_prepare_new_event

	@ %def evt_trivial_prepare_new_event
	@ The weighted generator is, surprisingly, trivial.
	<<Event transforms: evt trivial: TBP>>=
	procedure :: generate_weighted => evt_trivial_generate_weighted
	<<Event transforms: procedures>>=
	subroutine evt_trivial_generate_weighted (evt, probability)
	class(evt_trivial_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	probability = 1
	end subroutine evt_trivial_generate_weighted

	@ %def evt_trivial_generate_weighted
	@ This routine makes a particle set, using the associated process
	instance as-is.
	<<Event transforms: evt trivial: TBP>>=
	procedure :: make_particle_set => evt_trivial_make_particle_set
	<<Event transforms: procedures>>=
	subroutine evt_trivial_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_trivial_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	call make_factorized_particle_set (evt, factorization_mode, &
	keep_correlations, r)
	evt%particle_set_exists = .true.
	end subroutine evt_trivial_make_particle_set

	@ %def event_trivial_make_particle_set
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[event_transforms_ut.f90]]>>=
	<<File header>>

	module event_transforms_ut
	use unit_tests
	use event_transforms_uti

	<<Standard module head>>

	<<Event transforms: public test>>

	contains

	<<Event transforms: test driver>>

	end module event_transforms_ut
	@ %def event_transforms_ut
	@
	<<[[event_transforms_uti.f90]]>>=
	<<File header>>

	module event_transforms_uti

	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use os_interface
	use sm_qcd
	use model_data
	use state_matrices, only: FM_IGNORE_HELICITY
	use interactions, only: reset_interaction_counter
	use process_libraries
	use rng_base
	use mci_base
	use mci_midpoint
	use phs_base
	use phs_single
	use prc_core
	use prc_test, only: prc_test_create_library

	use process, only: process_t
	use instances, only: process_instance_t

	use event_transforms

	use rng_base_ut, only: rng_test_factory_t

	<<Standard module head>>

	<<Event transforms: test declarations>>

	contains

	<<Event transforms: tests>>

	end module event_transforms_uti

	@ %def event_transforms_uti
	@ API: driver for the unit tests below.
	<<Event transforms: public test>>=
	public :: event_transforms_test
	<<Event transforms: test driver>>=
	subroutine event_transforms_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Event transforms: execute tests>>
	end subroutine event_transforms_test

	@ %def event_transforms_test
	@
	\subsubsection{Test trivial event transform}
	The trivial transform, as an instance of the abstract transform, does
	nothing but to trigger event generation for an elementary process.
	<<Event transforms: execute tests>>=
	call test (event_transforms_1, "event_transforms_1", &
	"trivial event transform", &
	u, results)
	<<Event transforms: test declarations>>=
	public :: event_transforms_1
	<<Event transforms: tests>>=
	subroutine event_transforms_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(qcd_t) :: qcd
	class(rng_factory_t), allocatable :: rng_factory
	class(model_data_t), pointer :: model
	type(process_library_t), target :: lib
	type(string_t) :: libname, procname1, run_id
	class(mci_t), allocatable :: mci_template
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	class(evt_t), allocatable :: evt
	integer :: factorization_mode
	logical :: keep_correlations

	write (u, "(A)") "* Test output: event_transforms_1"
	write (u, "(A)") "* Purpose: handle trivial transform"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment and parent process"
	write (u, "(A)")

	call os_data_init (os_data)
	allocate (rng_test_factory_t :: rng_factory)

	libname = "event_transforms_1_lib"
	procname1 = "event_transforms_1_p"
	run_id = "event_transforms_1"

	call prc_test_create_library (libname, lib, &
	scattering = .true., procname1 = procname1)
	call reset_interaction_counter ()

	allocate (model)
	call model%init_test ()

	allocate (process)
	call process%init (procname1, run_id, &
	lib, os_data, qcd, rng_factory, model)
	call process%setup_test_cores ()

	allocate (mci_midpoint_t :: mci_template)
	allocate (phs_single_config_t :: phs_config_template)
	call process%init_component &
	(1, .true., mci_template, phs_config_template)

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()
	call process%setup_mci ()
	call process%setup_terms ()

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%integrate (1, n_it=1, n_calls=100)
	call process%final_integration (1)
	call process_instance%final ()
	deallocate (process_instance)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	call process_instance%init_simulation (1)

	write (u, "(A)") "* Initialize trivial event transform"
	write (u, "(A)")

	allocate (evt_trivial_t :: evt)
	model => process%get_model_ptr ()
	call evt%connect (process_instance, model)

	write (u, "(A)") "* Generate event and subsequent transform"
	write (u, "(A)")

	call process_instance%generate_unweighted_event (1)
	call process_instance%evaluate_event_data ()

	call evt%prepare_new_event (1, 1)
	call evt%generate_unweighted ()

	call write_separator (u, 2)
	call evt%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Obtain particle set"
	write (u, "(A)")

	factorization_mode = FM_IGNORE_HELICITY
	keep_correlations = .false.

	call evt%make_particle_set (factorization_mode, keep_correlations)

	call write_separator (u, 2)
	call evt%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt%final ()
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: event_transforms_1"

	end subroutine event_transforms_1

	@ %def event_transforms_1
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Hadronization interface}
	<<[[hadrons.f90]]>>=
	<<File header>>

	module hadrons

	<<Use kinds with double>>
	<<Use strings>>
	- use io_units
	- use format_utils, only: write_separator
	+
	+ use constants
	use diagnostics
	- use sm_qcd
	+ use event_transforms
	+ use format_utils, only: write_separator
	+ use helicities
	+ use hep_common
	+ use io_units
	use lorentz
	- use subevents, only: PRT_OUTGOING
	- use particles
	- use variables
	use model_data
	use models
	- use rng_base
	- use hep_common
	- use event_transforms
	+ use numeric_utils, only: vanishes
	+ use particles
	+ use physics_defs
	+ use process, only: process_t
	+ use instances, only: process_instance_t
	+ use process_stacks
	+ use pythia8
	+ use rng_base, only: rng_t
	use shower_base
	use shower_pythia6
	- use process
	+ use sm_qcd
	+ use subevents
	+ use variables
	+ use whizard_lha

	<<Standard module head>>

	<<Hadrons: public>>

	<<Hadrons: parameters>>

	<<Hadrons: types>>

	<<Hadrons: interfaces>>

	contains

	<<Hadrons: procedures>>

	end module hadrons
	@ %def hadrons
	@
	\subsection{Hadronization implementations}
	<<Hadrons: public>>=
	public :: HADRONS_UNDEFINED, HADRONS_WHIZARD, HADRONS_PYTHIA6, HADRONS_PYTHIA8
	<<Hadrons: parameters>>=
	integer, parameter :: HADRONS_UNDEFINED = 0
	integer, parameter :: HADRONS_WHIZARD = 1
	integer, parameter :: HADRONS_PYTHIA6 = 2
	integer, parameter :: HADRONS_PYTHIA8 = 3
	@ %def HADRONS_UNDEFINED HADRONS_WHIZARD HADRONS_PYTHIA6 HADRONS_PYTHIA8
	@ A dictionary
	<<Hadrons: public>>=
	public :: hadrons_method
	<<Hadrons: interfaces>>=
	interface hadrons_method
	module procedure hadrons_method_of_string
	module procedure hadrons_method_to_string
	end interface
	<<Hadrons: procedures>>=
	elemental function hadrons_method_of_string (string) result (i)
	integer :: i
	type(string_t), intent(in) :: string
	select case (char(string))
	case ("WHIZARD")
	i = HADRONS_WHIZARD
	case ("PYTHIA6")
	i = HADRONS_PYTHIA6
	case ("PYTHIA8")
	i = HADRONS_PYTHIA8
	case default
	i = HADRONS_UNDEFINED
	end select
	end function hadrons_method_of_string

	elemental function hadrons_method_to_string (i) result (string)
	type(string_t) :: string
	integer, intent(in) :: i
	select case (i)
	case (HADRONS_WHIZARD)
	string = "WHIZARD"
	case (HADRONS_PYTHIA6)
	string = "PYTHIA6"
	case (HADRONS_PYTHIA8)
	string = "PYTHIA8"
	case default
	string = "UNDEFINED"
	end select
	end function hadrons_method_to_string

	@ %def hadrons_method
	@
	\subsection{Hadronization settings}
	These are the general settings and parameters for the different shower
	methods.
	<<Hadrons: public>>=
	public :: hadron_settings_t
	<<Hadrons: types>>=
	type :: hadron_settings_t
	logical :: active = .false.
	integer :: method = HADRONS_UNDEFINED
	real(default) :: enhanced_fraction = 0
	real(default) :: enhanced_width = 0
	contains
	<<Hadrons: hadron settings: TBP>>
	end type hadron_settings_t

	@ %def hadron_settings_t
	@ Read in the hadronization settings.
	<<Hadrons: hadron settings: TBP>>=
	procedure :: init => hadron_settings_init
	<<Hadrons: procedures>>=
	subroutine hadron_settings_init (hadron_settings, var_list)
	class(hadron_settings_t), intent(out) :: hadron_settings
	type(var_list_t), intent(in) :: var_list
	hadron_settings%active = &
	var_list%get_lval (var_str ("?hadronization_active"))
	hadron_settings%method = hadrons_method_of_string ( &
	var_list%get_sval (var_str ("$hadronization_method")))
	hadron_settings%enhanced_fraction = &
	var_list%get_rval (var_str ("hadron_enhanced_fraction"))
	hadron_settings%enhanced_width = &
	var_list%get_rval (var_str ("hadron_enhanced_width"))
	end subroutine hadron_settings_init

	@ %def hadron_settings_init
	@
	<<Hadrons: hadron settings: TBP>>=
	procedure :: write => hadron_settings_write
	<<Hadrons: procedures>>=
	subroutine hadron_settings_write (settings, unit)
	class(hadron_settings_t), intent(in) :: settings
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "Hadronization settings:"
	call write_separator (u)
	write (u, "(1x,A)") "Master switches:"
	write (u, "(3x,A,1x,L1)") &
	"active = ", settings%active
	write (u, "(1x,A)") "General settings:"
	if (settings%active) then
	write (u, "(3x,A)") &
	"hadron_method = " // &
	char (hadrons_method_to_string (settings%method))
	else
	write (u, "(3x,A)") " [Hadronization off]"
	end if
	write (u, "(1x,A)") "pT generation parameters"
	write (u, "(3x,A,1x,ES19.12)") &
	"enhanced_fraction = ", settings%enhanced_fraction
	write (u, "(3x,A,1x,ES19.12)") &
	"enhanced_width = ", settings%enhanced_width
	end subroutine hadron_settings_write

	@ %def hadron_settings_write
	@
	\subsection{Abstract Hadronization Type}
	The [[model]] is the fallback model including all hadrons
	<<Hadrons: types>>=
	type, abstract :: hadrons_t
	class(rng_t), allocatable :: rng
	type(shower_settings_t) :: shower_settings
	type(hadron_settings_t) :: hadron_settings
	type(model_t), pointer :: model => null()
	contains
	<<Hadrons: hadrons: TBP>>
	end type hadrons_t

	@ %def hadrons_t
	@
	<<Hadrons: hadrons: TBP>>=
	procedure (hadrons_init), deferred :: init
	<<Hadrons: interfaces>>=
	abstract interface
	subroutine hadrons_init &
	(hadrons, shower_settings, hadron_settings, model_hadrons)
	import
	class(hadrons_t), intent(out) :: hadrons
	type(shower_settings_t), intent(in) :: shower_settings
	type(hadron_settings_t), intent(in) :: hadron_settings
	type(model_t), target, intent(in) :: model_hadrons
	end subroutine hadrons_init
	end interface

	@ %def hadrons_init
	@
	<<Hadrons: hadrons: TBP>>=
	procedure (hadrons_hadronize), deferred :: hadronize
	<<Hadrons: interfaces>>=
	abstract interface
	subroutine hadrons_hadronize (hadrons, particle_set, valid)
	import
	class(hadrons_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	logical, intent(out) :: valid
	end subroutine hadrons_hadronize
	end interface
	@ %def hadrons_hadronize
	@
	<<Hadrons: hadrons: TBP>>=
	procedure (hadrons_make_particle_set), deferred :: make_particle_set
	<<Hadrons: interfaces>>=
	abstract interface
	subroutine hadrons_make_particle_set (hadrons, particle_set, &
	model, valid)
	import
	class(hadrons_t), intent(in) :: hadrons
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	logical, intent(out) :: valid
	end subroutine hadrons_make_particle_set
	end interface

	@ %def hadrons_make_particle_set
	@
	<<Hadrons: hadrons: TBP>>=
	procedure :: import_rng => hadrons_import_rng
	<<Hadrons: procedures>>=
	pure subroutine hadrons_import_rng (hadrons, rng)
	class(hadrons_t), intent(inout) :: hadrons
	class(rng_t), intent(inout), allocatable :: rng
	call move_alloc (from = rng, to = hadrons%rng)
	end subroutine hadrons_import_rng

	@ %def hadrons_import_rng
	@
	\subsection{[[WHIZARD]] Hadronization Type}
	Hadronization can be (incompletely) performed through \whizard's internal
	routine.
	<<Hadrons: public>>=
	public :: hadrons_hadrons_t
	<<Hadrons: types>>=
	type, extends (hadrons_t) :: hadrons_hadrons_t
	contains
	<<Hadrons: hadrons hadrons: TBP>>
	end type hadrons_hadrons_t

	@ %def hadrons_hadrons_t
	@
	<<Hadrons: hadrons hadrons: TBP>>=
	procedure :: init => hadrons_hadrons_init
	<<Hadrons: procedures>>=
	subroutine hadrons_hadrons_init &
	(hadrons, shower_settings, hadron_settings, model_hadrons)
	class(hadrons_hadrons_t), intent(out) :: hadrons
	type(shower_settings_t), intent(in) :: shower_settings
	type(hadron_settings_t), intent(in) :: hadron_settings
	type(model_t), intent(in), target :: model_hadrons
	hadrons%model => model_hadrons
	hadrons%shower_settings = shower_settings
	hadrons%hadron_settings = hadron_settings
	call msg_message &
	("Hadronization: WHIZARD model for hadronization and decays")
	end subroutine hadrons_hadrons_init

	@ %def hadrons_hadrons_init
	@
	<<Hadrons: hadrons hadrons: TBP>>=
	procedure :: hadronize => hadrons_hadrons_hadronize
	<<Hadrons: procedures>>=
	subroutine hadrons_hadrons_hadronize (hadrons, particle_set, valid)
	class(hadrons_hadrons_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	logical, intent(out) :: valid
	integer, dimension(:), allocatable :: cols, acols, octs
	integer :: n
	if (signal_is_pending ()) return
	call msg_debug (D_TRANSFORMS, "hadrons_hadrons_hadronize")
	call particle_set%write (6, compressed=.true.)
	n = particle_set%get_n_tot ()
	allocate (cols (n), acols (n), octs (n))
	call extract_color_systems (particle_set, cols, acols, octs)
	print *, "size(cols) = ", size (cols)
	if (size(cols) > 0) then
	print *, "cols = ", cols
	end if
	print *, "size(acols) = ", size(acols)
	if (size(acols) > 0) then
	print *, "acols = ", acols
	end if
	print *, "size(octs) = ", size(octs)
	if (size (octs) > 0) then
	print *, "octs = ", octs
	end if
	!!! if all arrays are empty, i.e. zero particles found, nothing to do
	end subroutine hadrons_hadrons_hadronize

	@ %def hadrons_hadrons_hadronize
	@ This type contains a flavor selector for the creation of hadrons,
	including parameters for the special handling of baryons.
	<<Hadrons: public>>=
	public :: had_flav_t
	<<Hadrons: types>>=
	type had_flav_t
	end type had_flav_t

	@ %def had_flav_t
	@ This is the type for the ends of Lund strings.
	<<Hadrons: public>>=
	public :: lund_end
	<<Hadrons: types>>=
	type lund_end
	logical :: from_pos
	integer :: i_end
	integer :: i_max
	integer :: id_had
	integer :: i_pos_old
	integer :: i_neg_old
	integer :: i_pos_new
	integer :: i_neg_new
	real(default) :: px_old
	real(default) :: py_old
	real(default) :: px_new
	real(default) :: py_new
	real(default) :: px_had
	real(default) :: py_had
	real(default) :: m_had
	real(default) :: mT2_had
	real(default) :: z_had
	real(default) :: gamma_old
	real(default) :: gamma_new
	real(default) :: x_pos_old
	real(default) :: x_pos_new
	real(default) :: x_pos_had
	real(default) :: x_neg_old
	real(default) :: x_neg_new
	real(default) :: x_neg_had
	type(had_flav_t) :: old_flav
	type(had_flav_t) :: new_flav
	type(vector4_t) :: p_had
	type(vector4_t) :: p_pre
	end type lund_end

	@ %def lund_end
	@ Generator for transverse momentum for the fragmentation.
	<<Hadrons: public>>=
	public :: lund_pt_t
	<<Hadrons: types>>=
	type lund_pt_t
	real(default) :: sigma_min
	real(default) :: sigma_q
	real(default) :: enhanced_frac
	real(default) :: enhanced_width
	real(default) :: sigma_to_had
	class(rng_t), allocatable :: rng
	contains
	<<Hadrons: lund pT: TBP>>
	end type lund_pt_t

	@ %def lund_pt
	<<Hadrons: lund pT: TBP>>=
	procedure :: init => lund_pt_init
	<<Hadrons: procedures>>=
	subroutine lund_pt_init (lund_pt, settings)
	class (lund_pt_t), intent(out) :: lund_pt
	type(hadron_settings_t), intent(in) :: settings
	end subroutine lund_pt_init

	@ %def lund_pt_init
	@
	<<Hadrons: hadrons hadrons: TBP>>=
	procedure :: make_particle_set => hadrons_hadrons_make_particle_set
	<<Hadrons: procedures>>=
	subroutine hadrons_hadrons_make_particle_set &
	(hadrons, particle_set, model, valid)
	class(hadrons_hadrons_t), intent(in) :: hadrons
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	logical, intent(out) :: valid
	if (signal_is_pending ()) return
	valid = .false.
	if (valid) then
	else
	call msg_fatal ("WHIZARD hadronization not yet implemented")
	end if
	end subroutine hadrons_hadrons_make_particle_set

	@ %def hadrons_hadrons_make_particle_set
	@
	<<Hadrons: procedures>>=
	subroutine extract_color_systems (p_set, cols, acols, octs)
	type(particle_set_t), intent(in) :: p_set
	integer, dimension(:), allocatable, intent(out) :: cols, acols, octs
	logical, dimension(:), allocatable :: mask
	integer :: i, n, n_cols, n_acols, n_octs
	n = p_set%get_n_tot ()
	allocate (mask (n))
	do i = 1, n
	mask(i) = p_set%prt(i)%col%get_col () /= 0 .and. &
	p_set%prt(i)%col%get_acl () == 0 .and. &
	p_set%prt(i)%get_status () == PRT_OUTGOING
	end do
	n_cols = count (mask)
	allocate (cols (n_cols))
	cols = p_set%get_indices (mask)
	do i = 1, n
	mask(i) = p_set%prt(i)%col%get_col () == 0 .and. &
	p_set%prt(i)%col%get_acl () /= 0 .and. &
	p_set%prt(i)%get_status () == PRT_OUTGOING
	end do
	n_acols = count (mask)
	allocate (acols (n_acols))
	acols = p_set%get_indices (mask)
	do i = 1, n
	mask(i) = p_set%prt(i)%col%get_col () /= 0 .and. &
	p_set%prt(i)%col%get_acl () /= 0 .and. &
	p_set%prt(i)%get_status () == PRT_OUTGOING
	end do
	n_octs = count (mask)
	allocate (octs (n_octs))
	octs = p_set%get_indices (mask)
	end subroutine extract_color_systems

	@ %def extract_color_systems
	@
	\subsection{[[PYTHIA6]] Hadronization Type}
	Hadronization via [[PYTHIA6]] is at another option for
	hadronization within \whizard.
	<<Hadrons: public>>=
	public :: hadrons_pythia6_t
	<<Hadrons: types>>=
	type, extends (hadrons_t) :: hadrons_pythia6_t
	contains
	<<Hadrons: hadrons pythia6: TBP>>
	end type hadrons_pythia6_t

	@ %def hadrons_pythia6_t
	<<Hadrons: hadrons pythia6: TBP>>=
	procedure :: init => hadrons_pythia6_init
	<<Hadrons: procedures>>=
	subroutine hadrons_pythia6_init &
	(hadrons, shower_settings, hadron_settings, model_hadrons)
	class(hadrons_pythia6_t), intent(out) :: hadrons
	type(shower_settings_t), intent(in) :: shower_settings
	type(hadron_settings_t), intent(in) :: hadron_settings
	type(model_t), intent(in), target :: model_hadrons
	logical :: pygive_not_set_by_shower
	hadrons%model => model_hadrons
	hadrons%shower_settings = shower_settings
	hadrons%hadron_settings = hadron_settings
	pygive_not_set_by_shower = .not. (shower_settings%method == PS_PYTHIA6 &
	.and. (shower_settings%isr_active .or. shower_settings%fsr_active))
	if (pygive_not_set_by_shower) then
	call pythia6_set_verbose (shower_settings%verbose)
	call pythia6_set_config (shower_settings%pythia6_pygive)
	end if
	call msg_message &
	("Hadronization: Using PYTHIA6 interface for hadronization and decays")
	end subroutine hadrons_pythia6_init

	@ %def hadrons_pythia6_init
	@ Assume that the event record is still in the PYTHIA COMMON BLOCKS
	transferred there by the WHIZARD or PYTHIA6 shower routines.
	<<Hadrons: hadrons pythia6: TBP>>=
	procedure :: hadronize => hadrons_pythia6_hadronize
	<<Hadrons: procedures>>=
	subroutine hadrons_pythia6_hadronize (hadrons, particle_set, valid)
	class(hadrons_pythia6_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	logical, intent(out) :: valid
	integer :: N, NPAD, K
	real(double) :: P, V
	common /PYJETS/ N, NPAD, K(4000,5), P(4000,5), V(4000,5)
	save /PYJETS/
	if (signal_is_pending ()) return
	call msg_debug (D_TRANSFORMS, "hadrons_pythia6_hadronize")
	call pygive ("MSTP(111)=1") !!! Switch on hadronization and decays
	call pygive ("MSTJ(1)=1") !!! String fragmentation
	call pygive ("MSTJ(21)=2") !!! String fragmentation keeping resonance momentum
	call pygive ("MSTJ(28)=0") !!! Switch off tau decays
	if (debug_active (D_TRANSFORMS)) then
	call msg_debug (D_TRANSFORMS, "N", N)
	call pylist(2)
	print *, ' line 7 : ', k(7,1:5), p(7,1:5)
	end if
	call pyedit (12)
	call pythia6_set_last_treated_line (N)
	call pyexec ()
	call pyedit (12)
	valid = .true.
	end subroutine hadrons_pythia6_hadronize

	@ %def hadrons_pythia6_hadronize
	@
	<<Hadrons: hadrons pythia6: TBP>>=
	procedure :: make_particle_set => hadrons_pythia6_make_particle_set
	<<Hadrons: procedures>>=
	subroutine hadrons_pythia6_make_particle_set &
	(hadrons, particle_set, model, valid)
	class(hadrons_pythia6_t), intent(in) :: hadrons
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	logical, intent(out) :: valid
	if (signal_is_pending ()) return
	valid = pythia6_handle_errors ()
	if (valid) then
	call pythia6_combine_with_particle_set &
	(particle_set, model, hadrons%model, hadrons%shower_settings)
	end if
	end subroutine hadrons_pythia6_make_particle_set

	@ %def hadrons_pythia6_make_particle_set
	@
	-\subsection{[[Pythia8]] Hadronization Type}
	+\subsection{[[PYTHIA8]] Hadronization}
	+@
	<<Hadrons: public>>=
	public :: hadrons_pythia8_t
	<<Hadrons: types>>=
	- type,extends (hadrons_t) :: hadrons_pythia8_t
	+ type, extends (hadrons_t) :: hadrons_pythia8_t
	+ type(pythia8_t) :: pythia
	+ type(whizard_lha_t) :: lhaup
	+ logical :: user_process_set = .false.
	+ logical :: pythia_initialized = .false., &
	+ lhaup_initialized = .false.
	contains
	<<Hadrons: hadrons pythia8: TBP>>
	end type hadrons_pythia8_t

	@ %def hadrons_pythia8_t
	@
	<<Hadrons: hadrons pythia8: TBP>>=
	procedure :: init => hadrons_pythia8_init
	<<Hadrons: procedures>>=
	subroutine hadrons_pythia8_init &
	(hadrons, shower_settings, hadron_settings, model_hadrons)
	class(hadrons_pythia8_t), intent(out) :: hadrons
	type(shower_settings_t), intent(in) :: shower_settings
	type(hadron_settings_t), intent(in) :: hadron_settings
	type(model_t), intent(in), target :: model_hadrons
	- logical :: options_not_set_by_shower
	+ hadrons%model => model_hadrons
	hadrons%shower_settings = shower_settings
	hadrons%hadron_settings = hadron_settings
	- options_not_set_by_shower = .not. (shower_settings%method == PS_PYTHIA8 &
	- .and. (shower_settings%isr_active .or. shower_settings%fsr_active))
	- if (options_not_set_by_shower) then
	- !call pythia8_set_verbose (settings%verbose)
	- !call pythia8_set_config (settings%pythia8_config)
	- !call pythia8_set_config_file (settings%pythia8_config_file)
	- end if
	call msg_message &
	- ("Using Pythia8 interface for hadronization and decays")
	+ ("Hadronization: Using PYTHIA8 interface for hadronization and decays.")
	+ ! TODO sbrass which verbose?
	+ call hadrons%pythia%init (verbose = shower_settings%verbose)
	+ call hadrons%lhaup%init ()
	end subroutine hadrons_pythia8_init

	@ %def hadrons_pythia8_init
	+@ Transfer hadron settings to [[PYTHIA8]].
	+<<Hadrons: hadrons pythia8: TBP>>=
	+ procedure, private :: transfer_settings => hadrons_pythia8_transfer_settings
	+<<Hadrons: procedures>>=
	+ subroutine hadrons_pythia8_transfer_settings (hadrons)
	+ class(hadrons_pythia8_t), intent(inout), target :: hadrons
	+ real(default) :: r
	+ call msg_debug (D_TRANSFORMS, "hadrons_pythia8_transfer_settings")
	+ call msg_debug2 (D_TRANSFORMS, "pythia_initialized", hadrons%pythia_initialized)
	+ if (hadrons%pythia_initialized) return
	+ call hadrons%pythia%import_rng (hadrons%rng)
	+ call hadrons%pythia%parse_and_set_config (hadrons%shower_settings%pythia8_config)
	+ if (len (hadrons%shower_settings%pythia8_config_file) > 0) &
	+ call hadrons%pythia%read_file (hadrons%shower_settings%pythia8_config_file)
	+ call hadrons%pythia%read_string (var_str ("Beams:frameType = 5"))
	+ call hadrons%pythia%read_string (var_str ("ProcessLevel:all = off"))
	+ if (.not. hadrons%shower_settings%verbose) then
	+ call hadrons%pythia%read_string (var_str ("Print:quiet = on"))
	+ end if
	+ call hadrons%pythia%set_lhaup_ptr (hadrons%lhaup)
	+ call hadrons%pythia%init_pythia ()
	+ hadrons%pythia_initialized = .true.
	+ end subroutine hadrons_pythia8_transfer_settings
	+
	+@ %def hadrons_pythia8_transfer_settings
	+@ Set user process for the LHA interface.
	+<<Hadrons: hadrons pythia8: TBP>>=
	+ procedure, private :: set_user_process => hadrons_pythia8_set_user_process
	+<<Hadrons: procedures>>=
	+ subroutine hadrons_pythia8_set_user_process (hadrons, pset)
	+ class(hadrons_pythia8_t), intent(inout) :: hadrons
	+ type(particle_set_t), intent(in) :: pset
	+ integer, dimension(2) :: beam_pdg
	+ real(default), dimension(2) :: beam_energy
	+ integer, parameter :: process_id = 0, n_processes = 0
	+ call msg_debug (D_TRANSFORMS, "hadrons_pythia8_set_user_process")
	+ beam_pdg = [pset%prt(1)%get_pdg (), pset%prt(2)%get_pdg ()]
	+ beam_energy = [energy(pset%prt(1)%p), energy(pset%prt(2)%p)]
	+ call hadrons%lhaup%set_init (beam_pdg, beam_energy, &
	+ n_processes, unweighted = .false., negative_weights = .false.)
	+ call hadrons%lhaup%set_process_parameters (process_id = process_id, &
	+ cross_section = one, error = one)
	+ end subroutine hadrons_pythia8_set_user_process
	+
	+@ %def hadrons_pythia8_set_user_process
	+@ Import particle set.
	+<<Hadrons: hadrons pythia8: TBP>>=
	+ procedure, private :: import_particle_set => hadrons_pythia8_import_particle_set
	+<<Hadrons: procedures>>=
	+ subroutine hadrons_pythia8_import_particle_set (hadrons, particle_set)
	+ class(hadrons_pythia8_t), target, intent(inout) :: hadrons
	+ type(particle_set_t), intent(in) :: particle_set
	+ type(particle_set_t) :: pset_reduced
	+ integer, parameter :: PROCESS_ID = 1
	+ call msg_debug (D_TRANSFORMS, "hadrons_pythia8_import_particle_set")
	+ if (.not. hadrons%user_process_set) then
	+ call hadrons%set_user_process (particle_set)
	+ hadrons%user_process_set = .true.
	+ end if
	+ call hadrons%lhaup%set_event_process (process_id = PROCESS_ID, scale = -one, &
	+ alpha_qcd = -one, alpha_qed = -one, weight = -one)
	+ call hadrons%lhaup%set_event (process_id = PROCESS_ID, particle_set = particle_set, &
	+ polarization = .true.)
	+ if (debug_active (D_TRANSFORMS)) then
	+ call hadrons%lhaup%list_init ()
	+ end if
	+ end subroutine hadrons_pythia8_import_particle_set
	+
	+@ %def hadrons_pythia8_import_particle_set
	@
	<<Hadrons: hadrons pythia8: TBP>>=
	procedure :: hadronize => hadrons_pythia8_hadronize
	<<Hadrons: procedures>>=
	subroutine hadrons_pythia8_hadronize (hadrons, particle_set, valid)
	class(hadrons_pythia8_t), intent(inout) :: hadrons
	type(particle_set_t), intent(in) :: particle_set
	logical, intent(out) :: valid
	- ! call pythia8_hadronize
	- valid = .true.
	+ if (signal_is_pending ()) return
	+ call hadrons%import_particle_set (particle_set)
	+ if (.not. hadrons%pythia_initialized) &
	+ call hadrons%transfer_settings ()
	+ call hadrons%pythia%next (valid)
	+ if (debug_active (D_TRANSFORMS)) then
	+ call hadrons%pythia%list_event ()
	+ call particle_set%write (summary=.true., compressed=.true.)
	+ end if
	end subroutine hadrons_pythia8_hadronize

	@ %def hadrons_pythia8_hadronize
	@
	<<Hadrons: hadrons pythia8: TBP>>=
	procedure :: make_particle_set => hadrons_pythia8_make_particle_set
	<<Hadrons: procedures>>=
	subroutine hadrons_pythia8_make_particle_set &
	(hadrons, particle_set, model, valid)
	class(hadrons_pythia8_t), intent(in) :: hadrons
	type(particle_set_t), intent(inout) :: particle_set
	class(model_data_t), intent(in), target :: model
	logical, intent(out) :: valid
	- ! call pythia8_combine_particle_set
	+ type(particle_t), dimension(:), allocatable :: beam
	+ call msg_debug (D_TRANSFORMS, "hadrons_pythia8_make_particle_set")
	+ if (signal_is_pending ()) return
	+ associate (settings => hadrons%shower_settings)
	+ if (debug_active (D_TRANSFORMS)) then
	+ call msg_debug (D_TRANSFORMS, 'Combine PYTHIA8 with particle set')
	+ call msg_debug (D_TRANSFORMS, 'Particle set before replacing')
	+ call particle_set%write (summary=.true., compressed=.true.)
	+ call hadrons%pythia%list_event ()
	+ call msg_debug (D_TRANSFORMS, string = "settings%hadron_collision", &
	+ value = settings%hadron_collision)
	+ end if
	+ call hadrons%pythia%get_hadron_particles (&
	+ model, hadrons%model, particle_set, &
	+ helicity = PRT_DEFINITE_HELICITY)
	+ end associate
	+ if (debug_active (D_TRANSFORMS)) then
	+ print *, 'Particle set after replacing'
	+ call particle_set%write (summary=.true., compressed=.true.)
	+ end if
	valid = .true.
	end subroutine hadrons_pythia8_make_particle_set

	@ %def hadrons_pythia8_make_particle_set
	@
	\subsection{Hadronization Event Transform}
	This is the type for the hadronization event transform. It does not
	depend on the specific hadronization implementation of
	[[hadrons_t]].
	<<Hadrons: public>>=
	public :: evt_hadrons_t
	<<Hadrons: types>>=
	type, extends (evt_t) :: evt_hadrons_t
	class(hadrons_t), allocatable :: hadrons
	type(model_t), pointer :: model_hadrons => null()
	type(qcd_t), pointer :: qcd_t => null()
	logical :: is_first_event
	contains
	<<Hadrons: evt hadrons: TBP>>
	end type evt_hadrons_t

	@ %def evt_hadrons_t
	@ Initialize the parameters. The [[model_hadrons]] is supposed to be
	the SM variant that contains all hadrons that may be generated in the
	shower.
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: init => evt_hadrons_init
	<<Hadrons: procedures>>=
	subroutine evt_hadrons_init (evt, model_hadrons)
	class(evt_hadrons_t), intent(out) :: evt
	type(model_t), intent(in), target :: model_hadrons
	evt%model_hadrons => model_hadrons
	evt%is_first_event = .true.
	end subroutine evt_hadrons_init

	@ %def evt_hadrons_init
	@
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: write_name => evt_hadrons_write_name
	<<Hadrons: procedures>>=
	subroutine evt_hadrons_write_name (evt, unit)
	class(evt_hadrons_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: hadronization"
	end subroutine evt_hadrons_write_name

	@ %def evt_hadrons_write_name
	@ Output.
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: write => evt_hadrons_write
	<<Hadrons: procedures>>=
	subroutine evt_hadrons_write (evt, unit, verbose, more_verbose, testflag)
	class(evt_hadrons_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u)
	call evt%base_write (u, testflag = testflag, show_set = .false.)
	if (evt%particle_set_exists) &
	call evt%particle_set%write &
	(u, summary = .true., compressed = .true., testflag = testflag)
	call write_separator (u)
	call evt%hadrons%shower_settings%write (u)
	call write_separator (u)
	call evt%hadrons%hadron_settings%write (u)
	end subroutine evt_hadrons_write

	@ %def evt_hadrons_write
	@
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: first_event => evt_hadrons_first_event
	<<Hadrons: procedures>>=
	subroutine evt_hadrons_first_event (evt)
	class(evt_hadrons_t), intent(inout) :: evt
	call msg_debug (D_TRANSFORMS, "evt_hadrons_first_event")
	associate (settings => evt%hadrons%shower_settings)
	settings%hadron_collision = .false.
	!!! !!! !!! Workaround for PGF90 16.1
	!!! if (all (evt%particle_set%prt(1:2)%flv%get_pdg_abs () <= 39)) then
	if (evt%particle_set%prt(1)%flv%get_pdg_abs () <= 39 .and. &
	evt%particle_set%prt(2)%flv%get_pdg_abs () <= 39) then
	settings%hadron_collision = .false.
	!!! else if (all (evt%particle_set%prt(1:2)%flv%get_pdg_abs () >= 100)) then
	else if (evt%particle_set%prt(1)%flv%get_pdg_abs () >= 100 .and. &
	evt%particle_set%prt(2)%flv%get_pdg_abs () >= 100) then
	settings%hadron_collision = .true.
	else
	call msg_fatal ("evt_hadrons didn't recognize beams setup")
	end if
	call msg_debug (D_TRANSFORMS, "hadron_collision", settings%hadron_collision)
	if (.not. (settings%isr_active .or. settings%fsr_active)) then
	call msg_fatal ("Hadronization without shower is not supported")
	end if
	end associate
	evt%is_first_event = .false.
	end subroutine evt_hadrons_first_event

	@ %def evt_hadrons_first_event
	@ Here we take the particle set from the previous event transform and
	apply the hadronization. The result is stored in the [[evt%hadrons]]
	object. We always return a probability of unity as we don't have the
	analytic weight of the hadronization. Invalid events have to be
	discarded by the caller which is why we mark the particle set as
	invalid.
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: generate_weighted => evt_hadrons_generate_weighted
	<<Hadrons: procedures>>=
	subroutine evt_hadrons_generate_weighted (evt, probability)
	class(evt_hadrons_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	logical :: valid
	if (signal_is_pending ()) return
	evt%particle_set = evt%previous%particle_set
	if (evt%is_first_event) then
	call evt%first_event ()
	end if
	call evt%hadrons%hadronize (evt%particle_set, valid)
	probability = 1
	evt%particle_set_exists = valid
	end subroutine evt_hadrons_generate_weighted

	@ %def evt_hadrons_generate_weighted
	@ The factorization parameters are irrelevant.
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: make_particle_set => evt_hadrons_make_particle_set
	<<Hadrons: procedures>>=
	subroutine evt_hadrons_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_hadrons_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	logical :: valid
	call evt%hadrons%make_particle_set (evt%particle_set, evt%model, valid)
	evt%particle_set_exists = evt%particle_set_exists .and. valid
	end subroutine evt_hadrons_make_particle_set

	@ %def event_hadrons_make_particle_set
	+@ Connect the process with the hadrons object.
	+<<Hadrons: evt hadrons: TBP>>=
	+ procedure :: connect => evt_hadrons_connect
	+<<Hadrons: procedures>>=
	+ subroutine evt_hadrons_connect &
	+ (evt, process_instance, model, process_stack)
	+ class(evt_hadrons_t), intent(inout), target :: evt
	+ type(process_instance_t), intent(in), target :: process_instance
	+ class(model_data_t), intent(in), target :: model
	+ type(process_stack_t), intent(in), optional :: process_stack
	+ call evt%base_connect (process_instance, model, process_stack)
	+ call evt%make_rng (evt%process)
	+ end subroutine evt_hadrons_connect
	+
	+@ %def evt_hadrons_connect
	@ Create RNG instances, spawned by the process object.
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: make_rng => evt_hadrons_make_rng
	<<Hadrons: procedures>>=
	subroutine evt_hadrons_make_rng (evt, process)
	class(evt_hadrons_t), intent(inout) :: evt
	type(process_t), intent(inout) :: process
	class(rng_t), allocatable :: rng
	call process%make_rng (rng)
	call evt%hadrons%import_rng (rng)
	end subroutine evt_hadrons_make_rng

	@ %def evt_hadrons_make_rng
	@
	<<Hadrons: evt hadrons: TBP>>=
	procedure :: prepare_new_event => evt_hadrons_prepare_new_event
	<<Hadrons: procedures>>=
	subroutine evt_hadrons_prepare_new_event (evt, i_mci, i_term)
	class(evt_hadrons_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	call evt%reset ()
	end subroutine evt_hadrons_prepare_new_event

	@ %def evt_hadrons_prepare_new_event
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Resonance Insertion}
	<<[[resonance_insertion.f90]]>>=
	<<File header>>

	module resonance_insertion

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_utils, only: write_separator
	use format_defs, only: FMT_12
	use rng_base, only: rng_t
	use selectors, only: selector_t
	use sm_qcd
	use model_data
	use interactions, only: interaction_t
	use particles, only: particle_t, particle_set_t
	use subevents, only: PRT_RESONANT
	use models
	use resonances, only: resonance_history_set_t
	use resonances, only: resonance_tree_t
	use instances, only: process_instance_ptr_t
	use event_transforms

	<<Standard module head>>

	<<Resonance insertion: public>>

	<<Resonance insertion: types>>

	contains

	<<Resonance insertion: procedures>>

	end module resonance_insertion
	@ %def resonance_insertion
	@
	\subsection{Resonance-Insertion Event Transform}
	This is the type for the event transform that applies resonance insertion.
	The resonance history set describe the resonance histories that we may
	consider. There is a process library with process objects that correspond to
	the resonance histories. Library creation, compilation etc.\ is done outside
	the scope of this module.
	<<Resonance insertion: public>>=
	public :: evt_resonance_t
	<<Resonance insertion: types>>=
	type, extends (evt_t) :: evt_resonance_t
	type(resonance_history_set_t), dimension(:), allocatable :: res_history_set
	integer, dimension(:), allocatable :: index_offset
	integer :: selected_component = 0
	type(string_t) :: libname
	type(string_t), dimension(:), allocatable :: proc_id
	real(default) :: on_shell_limit = 0
	real(default) :: on_shell_turnoff = 0
	real(default) :: background_factor = 1
	logical :: selector_active = .false.
	type(selector_t) :: selector
	integer :: selected_history = 0
	type(process_instance_ptr_t), dimension(:), allocatable :: instance
	contains
	<<Resonance insertion: evt resonance: TBP>>
	end type evt_resonance_t

	@ %def evt_resonance_t
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: write_name => evt_resonance_write_name
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_write_name (evt, unit)
	class(evt_resonance_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: resonance insertion"
	end subroutine evt_resonance_write_name

	@ %def evt_resonance_write_name
	@ Output.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: write => evt_resonance_write
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_write (evt, unit, verbose, more_verbose, testflag)
	class(evt_resonance_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	integer :: u, i
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u, 2)
	write (u, "(1x,A,A,A)") "Process library = '", char (evt%libname), "'"
	if (allocated (evt%res_history_set)) then
	do i = 1, size (evt%res_history_set)
	if (i == evt%selected_component) then
	write (u, "(1x,A,I0,A)") "Component #", i, ": *"
	else
	write (u, "(1x,A,I0,A)") "Component #", i, ":"
	end if
	call evt%res_history_set(i)%write (u, indent=1)
	end do
	end if
	call write_separator (u)
	if (allocated (evt%instance)) then
	write (u, "(1x,A)") "Subprocess instances: allocated"
	else
	write (u, "(1x,A)") "Subprocess instances: not allocated"
	end if
	if (evt%particle_set_exists) then
	if (evt%selected_history > 0) then
	write (u, "(1x,A,I0)") "Selected: resonance history #", &
	evt%selected_history
	else
	write (u, "(1x,A)") "Selected: no resonance history"
	end if
	else
	write (u, "(1x,A)") "Selected: [none]"
	end if
	write (u, "(1x,A,1x," // FMT_12 // ")") &
	"On-shell limit =", evt%on_shell_limit
	write (u, "(1x,A,1x," // FMT_12 // ")") &
	"On-shell turnoff =", evt%on_shell_turnoff
	write (u, "(1x,A,1x," // FMT_12 // ")") &
	"Background factor =", evt%background_factor
	call write_separator (u)
	if (evt%selector_active) then
	write (u, "(2x)", advance="no")
	call evt%selector%write (u, testflag=testflag)
	call write_separator (u)
	end if
	call evt%base_write (u, testflag = testflag, show_set = .false.)
	call write_separator (u)
	if (evt%particle_set_exists) then
	call evt%particle_set%write &
	(u, summary = .true., compressed = .true., testflag = testflag)
	call write_separator (u)
	end if
	end subroutine evt_resonance_write

	@ %def evt_resonance_write
	@
	\subsection{Set contained data}
	Insert the resonance data, in form of a pre-generated resonance
	history set. Accumulate the number of histories for each set, to
	initialize an array of index offsets for lookup.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: set_resonance_data => evt_resonance_set_resonance_data
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_set_resonance_data (evt, res_history_set)
	class(evt_resonance_t), intent(inout) :: evt
	type(resonance_history_set_t), dimension(:), intent(in) :: res_history_set
	integer :: i
	evt%res_history_set = res_history_set
	allocate (evt%index_offset (size (evt%res_history_set)), source = 0)
	do i = 2, size (evt%res_history_set)
	evt%index_offset(i) = &
	evt%index_offset(i-1) + evt%res_history_set(i-1)%get_n_history ()
	end do
	end subroutine evt_resonance_set_resonance_data

	@ %def evt_resonance_set_resonance_data
	@ Set the library that contains the resonant subprocesses.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: set_library => evt_resonance_set_library
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_set_library (evt, libname)
	class(evt_resonance_t), intent(inout) :: evt
	type(string_t), intent(in) :: libname
	evt%libname = libname
	end subroutine evt_resonance_set_library

	@ %def evt_resonance_set_library
	@ Assign pointers to subprocess instances. Once a subprocess has been
	selected, the instance is used for generating the particle set with
	valid quantum-number assignments, ready for resonance insertion.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: set_subprocess_instances &
	=> evt_resonance_set_subprocess_instances
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_set_subprocess_instances (evt, instance)
	class(evt_resonance_t), intent(inout) :: evt
	type(process_instance_ptr_t), dimension(:), intent(in) :: instance
	evt%instance = instance
	end subroutine evt_resonance_set_subprocess_instances

	@ %def evt_resonance_set_subprocess_instances
	@ Set the on-shell limit, the relative distance from a resonance that
	is still considered to be on-shell. The probability for being
	considered on-shell can be reduced by the turnoff parameter below.
	For details, see the [[resonances]] module.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: set_on_shell_limit => evt_resonance_set_on_shell_limit
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_set_on_shell_limit (evt, on_shell_limit)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), intent(in) :: on_shell_limit
	evt%on_shell_limit = on_shell_limit
	end subroutine evt_resonance_set_on_shell_limit

	@ %def evt_resonance_set_on_shell_limit
	@ Set the Gaussian on-shell turnoff parameter, the width of the
	weighting factor for the resonance squared matrix element. If the
	resonance is off shell, this factor reduces the weight of the matrix
	element in the selector, such that the probability for considered
	resonant is reduced. The factor is applied only if the offshellness
	is less than the [[on_shell_limit]] above. For details, see the
	[[resonances]] module.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: set_on_shell_turnoff => evt_resonance_set_on_shell_turnoff
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_set_on_shell_turnoff (evt, on_shell_turnoff)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), intent(in) :: on_shell_turnoff
	evt%on_shell_turnoff = on_shell_turnoff
	end subroutine evt_resonance_set_on_shell_turnoff

	@ %def evt_resonance_set_on_shell_turnoff
	@ Reweight (suppress) the background contribution if there is a resonance
	history that applies. The event will be registered as background if there is
	no applicable resonance history, or if the background configuration has been
	selected based on (reweighted) squared matrix elements.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: set_background_factor => evt_resonance_set_background_factor
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_set_background_factor (evt, background_factor)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), intent(in) :: background_factor
	evt%background_factor = background_factor
	end subroutine evt_resonance_set_background_factor

	@ %def evt_resonance_set_background_factor
	@
	\subsection{Selector}
	Manually import a random-number generator object. This should be
	done only for testing purposes. The standard procedure is to
	[[connect]] a process to an event transform; this will create an
	appropriate [[rng]] from the RNG factory in the process object.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: import_rng => evt_resonance_import_rng
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_import_rng (evt, rng)
	class(evt_resonance_t), intent(inout) :: evt
	class(rng_t), allocatable, intent(inout) :: rng
	call move_alloc (from = rng, to = evt%rng)
	end subroutine evt_resonance_import_rng

	@ %def evt_resonance_import_rng
	@
	We use a standard selector object to choose from the available resonance
	histories. If the selector is inactive, we do not insert resonances.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: write_selector => evt_resonance_write_selector
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_write_selector (evt, unit, testflag)
	class(evt_resonance_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: u
	u = given_output_unit (unit)
	if (evt%selector_active) then
	call evt%selector%write (u, testflag)
	else
	write (u, "(1x,A)") "Selector: [inactive]"
	end if
	end subroutine evt_resonance_write_selector

	@ %def evt_resonance_write_selector
	@
	The selector is initialized with relative weights of
	histories which need not be normalized. Channels with weight zero are
	ignored.

	The [[offset]] will normally be $-1$, so we count from zero, and zero
	is a valid result from the selector. Selecting the zero entry implies
	no resonance insertion. However, this behavior is not hard-coded
	here (without offset, no resonance is not possible as a result).
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: init_selector => evt_resonance_init_selector
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_init_selector (evt, weight, offset)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), dimension(:), intent(in) :: weight
	integer, intent(in), optional :: offset
	if (any (weight > 0)) then
	call evt%selector%init (weight, offset = offset)
	evt%selector_active = .true.
	else
	evt%selector_active = .false.
	end if
	end subroutine evt_resonance_init_selector

	@ %def evt_resonance_init_selector
	@ Return all selector weights, for inspection. Note that the index
	counts from zero.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: get_selector_weights => evt_resonance_get_selector_weights
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_get_selector_weights (evt, weight)
	class(evt_resonance_t), intent(in) :: evt
	real(default), dimension(0:), intent(out) :: weight
	integer :: i
	do i = 0, ubound (weight,1)
	weight(i) = evt%selector%get_weight (i)
	end do
	end subroutine evt_resonance_get_selector_weights

	@ %def evt_resonance_get_selector_weights
	@
	\subsection{Runtime calculations}
	Use the associated master process instance and the subprocess
	instances to distribute the current momentum set, then compute the
	squared matrix elements weights for all subprocesses.

	NOTE: Procedures in this subsection are not covered by unit tests
	in this module, but by unit tests of the [[restricted_subprocesses]]
	module.

	Fill the particle set, so the momentum configuration can be used by
	the subprocess instances. The standard workflow is to copy from the
	previous particle set.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: fill_momenta => evt_resonance_fill_momenta
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_fill_momenta (evt)
	class(evt_resonance_t), intent(inout) :: evt
	integer :: i, n
	if (associated (evt%previous)) then
	evt%particle_set = evt%previous%particle_set
	else if (associated (evt%process_instance)) then
	! this branch only for unit test
	call evt%process_instance%get_trace &
	(evt%particle_set, i_term=1, n_incoming=evt%process%get_n_in ())
	end if
	end subroutine evt_resonance_fill_momenta

	@ %def evt_resonance_fill_momenta
	@
	Return the indices of those subprocesses which can be considered
	on-shell. The result depends on the stored particle set (outgoing
	momenta) and on the on-shell limit value.

	The index [[evt%selected_component]] identifies the particular history set that
	corresponds to the given process component. Recall that process
	components may have different external particles, so they have
	distinct history sets.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: determine_on_shell_histories &
	=> evt_resonance_determine_on_shell_histories
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_determine_on_shell_histories &
	(evt, index_array)
	class(evt_resonance_t), intent(in) :: evt
	integer, dimension(:), allocatable, intent(out) :: index_array
	integer :: i
	i = evt%selected_component
	call evt%res_history_set(i)%determine_on_shell_histories &
	(evt%particle_set%get_outgoing_momenta (), &
	evt%on_shell_limit, &
	index_array)
	end subroutine evt_resonance_determine_on_shell_histories

	@ %def evt_resonance_determine_on_shell_histories
	@ Evaluate selected subprocesses. (In actual operation, the ones that
	have been tagged as on-shell.)

	We assume that the MCI, term, and channel indices for the subprocesses
	can all be set to 1.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: evaluate_subprocess => evt_resonance_evaluate_subprocess
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_evaluate_subprocess (evt, index_array)
	class(evt_resonance_t), intent(inout) :: evt
	integer, dimension(:), intent(in) :: index_array
	integer :: k, i
	if (allocated (evt%instance)) then
	do k = 1, size (index_array)
	i = index_array(k)
	associate (instance => evt%instance(i)%p)
	call instance%choose_mci (1)
	call instance%set_trace (evt%particle_set, 1, check_match=.false.)
	call instance%recover (channel = 1, i_term = 1, &
	update_sqme = .true., recover_phs = .false.)
	end associate
	end do
	end if
	end subroutine evt_resonance_evaluate_subprocess

	@ %def evt_resonance_evaluate_subprocess
	@ Return the current squared matrix-element value of the master
	process, and of the selected resonant subprocesses, respectively.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: get_master_sqme => evt_resonance_get_master_sqme
	procedure :: get_subprocess_sqme => evt_resonance_get_subprocess_sqme
	<<Resonance insertion: procedures>>=
	function evt_resonance_get_master_sqme (evt) result (sqme)
	class(evt_resonance_t), intent(in) :: evt
	real(default) :: sqme
	sqme = evt%process_instance%get_sqme ()
	end function evt_resonance_get_master_sqme

	subroutine evt_resonance_get_subprocess_sqme (evt, sqme, index_array)
	class(evt_resonance_t), intent(in) :: evt
	real(default), dimension(:), intent(out) :: sqme
	integer, dimension(:), intent(in), optional :: index_array
	integer :: k, i
	if (present (index_array)) then
	sqme = 0
	do k = 1, size (index_array)
	call get_sqme (index_array(k))
	end do
	else
	do i = 1, size (evt%instance)
	call get_sqme (i)
	end do
	end if
	contains
	subroutine get_sqme (i)
	integer, intent(in) :: i
	associate (instance => evt%instance(i)%p)
	sqme(i) = instance%get_sqme ()
	end associate
	end subroutine get_sqme
	end subroutine evt_resonance_get_subprocess_sqme

	@ %def evt_resonance_get_master_sqme
	@ %def evt_resonance_get_subprocess_sqme
	@ Apply a turnoff factor for off-shell kinematics to the [[sqme]]
	values. The [[sqme]] array indices are offset from the resonance
	history set entries.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: apply_turnoff_factor => evt_resonance_apply_turnoff_factor
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_apply_turnoff_factor (evt, sqme, index_array)
	class(evt_resonance_t), intent(in) :: evt
	real(default), dimension(:), intent(inout) :: sqme
	integer, dimension(:), intent(in) :: index_array
	integer :: k, i_res, i_prc
	do k = 1, size (index_array)
	i_res = evt%selected_component
	i_prc = index_array(k) + evt%index_offset(i_res)
	sqme(i_prc) = sqme(i_prc) &
	* evt%res_history_set(i_res)%evaluate_gaussian &
	& (evt%particle_set%get_outgoing_momenta (), &
	& evt%on_shell_turnoff, index_array(k))
	end do
	end subroutine evt_resonance_apply_turnoff_factor

	@ %def evt_resonance_apply_turnoff_factor
	@ We use the calculations of resonant matrix elements to determine
	probabilities for all applicable resonance configurations. This method combines
	the steps implemented above.

	First, we determine the selected process component.

	TODO: the version below selects the first component which is found
	active. This make sense only for standard LO process components,
	where exactly one component corresponds to a MCI set.

	For the selected process component, we query the kinematics and
	determine the applicable resonance histories. We collect squared
	matrix elements for those resonance histories and compare them to the
	master-process squared matrix element.

	The result is the probability for each resonance history
	together with the probability for non-resonant background (zeroth
	entry). The latter is defined as the difference between the complete
	process result and the sum of the resonances, ignoring the possibility
	for interference. If the complete process result is actually
	undershooting the sum of resonances, we nevertheless count the
	background with positive probability.

	When looking up the subprocess sqme, we must add the [[index_offset]]
	to the resulting array, since the indices returned by the individual
	history set all count from one, while the subprocess instances that
	belong to process components are collected in one flat array.

	After determining matrix elements and background, we may reduce the
	weight of the matrix elements in the selector by applying a turnoff
	factor.

	The factor [[background_factor]] indicates whether to include the background
	contribution at all, as long as there is a nonvanishing resonance
	contribution. Note that instead of setting background to zero, we just
	multiply it by a very small number. This ensures that indices are assigned
	correctly, and that background will eventually be selected if smooth turnoff
	is chosen.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: compute_probabilities => evt_resonance_compute_probabilities
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_compute_probabilities (evt)
	class(evt_resonance_t), intent(inout) :: evt
	integer, dimension(:), allocatable :: index_array
	real(default) :: sqme_master, sqme_sum, sqme_bg
	real(default), dimension(:), allocatable :: sqme_res
	integer :: n, ic
	if (.not. associated (evt%process_instance)) return
	n = size (evt%instance)
	call evt%select_component (0)
	FIND_ACTIVE_COMPONENT: do ic = 1, evt%process%get_n_components ()
	if (evt%process%component_is_selected (ic)) then
	call evt%select_component (ic)
	exit FIND_ACTIVE_COMPONENT
	end if
	end do FIND_ACTIVE_COMPONENT
	if (evt%selected_component > 0) then
	call evt%determine_on_shell_histories (index_array)
	else
	allocate (index_array (0))
	end if
	call evt%evaluate_subprocess &
	(index_array + evt%index_offset(evt%selected_component))
	allocate (sqme_res (n), source = 0._default)
	call evt%get_subprocess_sqme &
	(sqme_res, index_array + evt%index_offset(evt%selected_component))
	sqme_master = evt%get_master_sqme ()
	sqme_sum = sum (sqme_res)
	sqme_bg = abs (sqme_master - sqme_sum)
	if (evt%on_shell_turnoff > 0) then
	call evt%apply_turnoff_factor (sqme_res, index_array)
	end if
	if (any (sqme_res > 0)) then
	sqme_bg = sqme_bg * evt%background_factor
	end if
	call evt%init_selector ([sqme_bg, sqme_res], offset = -1)
	end subroutine evt_resonance_compute_probabilities

	@ %def evt_resonance_compute_probabilities
	@ Set the selected component (unit tests).
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: select_component => evt_resonance_select_component
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_select_component (evt, i_component)
	class(evt_resonance_t), intent(inout) :: evt
	integer, intent(in) :: i_component
	evt%selected_component = i_component
	end subroutine evt_resonance_select_component

	@ %def evt_resonance_select_component
	@
	\subsection{Sanity check}
	Check the color assignment, which may be wrong for the inserted resonances.
	Delegated to the particle-set component. Return offending particle
	indices and, optionally, particles as arrays.

	This is done in a unit test. The current algorithm, i.e., selecting
	the color assignment from the resonant-subprocess instance, should not
	generate invalid color assignments.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: find_prt_invalid_color => evt_resonance_find_prt_invalid_color
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_find_prt_invalid_color (evt, index, prt)
	class(evt_resonance_t), intent(in) :: evt
	integer, dimension(:), allocatable, intent(out) :: index
	type(particle_t), dimension(:), allocatable, intent(out), optional :: prt
	if (evt%particle_set_exists) then
	call evt%particle_set%find_prt_invalid_color (index, prt)
	else
	allocate (prt (0))
	end if
	end subroutine evt_resonance_find_prt_invalid_color

	@ %def evt_resonance_find_prt_invalid_color
	@
	\subsection{API implementation}
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: prepare_new_event => evt_resonance_prepare_new_event
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_prepare_new_event (evt, i_mci, i_term)
	class(evt_resonance_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	call evt%reset ()
	end subroutine evt_resonance_prepare_new_event

	@ %def evt_resonance_prepare_new_event
	@ Select one of the histories, based on the momentum array from the
	current particle set. Compute the probabilities for all resonant
	subprocesses and initialize the selector accordingly. Then select one
	resonance history, or none.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: generate_weighted => evt_resonance_generate_weighted
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_generate_weighted (evt, probability)
	class(evt_resonance_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	call evt%fill_momenta ()
	call evt%compute_probabilities ()
	call evt%selector%generate (evt%rng, evt%selected_history)
	probability = 1
	end subroutine evt_resonance_generate_weighted

	@ %def evt_resonance_generate_weighted
	@ Here take the current particle set and insert resonance intermediate
	states if applicable. The resonance history has already been chosen
	by the generator above. If no resonance history applies, just retain
	the particle set.

	If a resonance history applies, we factorize the exclusive interaction
	of the selected (resonance-process) process instance. With a
	temporary particle set [[prt_set]] as workspace, we the insert the
	resonances, reinstate parent-child relations and set colors and
	momenta for the resonances. The temporary is then copied back.

	Taking the event data from the resonant subprocess instead of the
	master process, guarantees that all flavor, helicity, and color
	assignments are valid for the selected resonance history. Note that
	the transform may thus choose a quantum-number combination that is
	different from the one chosen by the master process.

	The [[i_term]] value for the selected subprocess instance is always
	1. We support only LO process. For those, the master process may
	have several terms (= components) that correspond to different
	external states. The subprocesses are distinct, each one corresponds
	to a definite master component, and by itself it consists of a single
	component/term.

	However, if the selector chooses resonance history \#0, i.e., no
	resonance, we just copy the particle set from the previous (i.e.,
	trivial) event transform and ignore all subprocess data.
	<<Resonance insertion: evt resonance: TBP>>=
	procedure :: make_particle_set => evt_resonance_make_particle_set
	<<Resonance insertion: procedures>>=
	subroutine evt_resonance_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_resonance_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	type(particle_set_t), target :: prt_set
	type(particle_t), dimension(:), allocatable :: prt
	integer :: n_beam, n_in, n_vir, n_res, n_out, i, i_res, i_term, i_tree
	type(interaction_t), pointer :: int_matrix, int_flows
	integer, dimension(:), allocatable :: map
	type(resonance_tree_t) :: res_tree
	if (associated (evt%previous)) then
	if (evt%previous%particle_set_exists) then
	if (evt%selected_history > 0) then
	if (allocated (evt%instance)) then
	associate (instance => evt%instance(evt%selected_history)%p)
	call instance%evaluate_event_data (weight = 1._default)
	i_term = 1
	int_matrix => instance%get_matrix_int_ptr (i_term)
	int_flows => instance%get_flows_int_ptr (i_term)
	call evt%factorize_interactions (int_matrix, int_flows, &
	factorization_mode, keep_correlations, r)
	call evt%tag_incoming ()
	end associate
	else ! this branch only for unit test
	evt%particle_set = evt%previous%particle_set
	end if
	i_tree = evt%selected_history &
	- evt%index_offset(evt%selected_component)
	call evt%res_history_set(evt%selected_component)%get_tree &
	(i_tree, res_tree)
	n_beam = evt%particle_set%get_n_beam ()
	n_in = evt%particle_set%get_n_in ()
	n_vir = evt%particle_set%get_n_vir ()
	n_out = evt%particle_set%get_n_out ()
	n_res = res_tree%get_n_resonances ()
	allocate (map (n_beam + n_in + n_vir + n_out))
	map(1:n_beam+n_in+n_vir) &
	= [(i, i = 1, n_beam+n_in+n_vir)]
	map(n_beam+n_in+n_vir+1:n_beam+n_in+n_vir+n_out) &
	= [(i + n_res, &
	& i = n_beam+n_in+n_vir+1, &
	& n_beam+n_in+n_vir+n_out)]
	call prt_set%transfer (evt%particle_set, n_res, map)
	do i = 1, n_res
	i_res = n_beam + n_in + n_vir + i
	call prt_set%insert (i_res, &
	PRT_RESONANT, &
	res_tree%get_flv (i), &
	res_tree%get_children (i, &
	& n_beam+n_in+n_vir, n_beam+n_in+n_vir+n_res))
	end do
	do i = n_res, 1, -1
	i_res = n_beam + n_in + n_vir + i
	call prt_set%recover_color (i_res)
	end do
	call prt_set%set_momentum &
	(map(:), evt%particle_set%get_momenta (), on_shell = .true.)
	do i = n_res, 1, -1
	i_res = n_beam + n_in + n_vir + i
	call prt_set%recover_momentum (i_res)
	end do
	call evt%particle_set%final ()
	evt%particle_set = prt_set
	call prt_set%final ()
	evt%particle_set_exists = .true.
	else ! retain particle set, as copied from previous evt
	evt%particle_set_exists = .true.
	end if
	else
	evt%particle_set_exists = .false.
	end if
	else
	evt%particle_set_exists = .false.
	end if
	end subroutine evt_resonance_make_particle_set

	@ %def event_resonance_make_particle_set
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[resonance_insertion_ut.f90]]>>=
	<<File header>>

	module resonance_insertion_ut
	use unit_tests
	use resonance_insertion_uti

	<<Standard module head>>

	<<Resonance insertion: public test>>

	contains

	<<Resonance insertion: test driver>>

	end module resonance_insertion_ut
	@ %def resonance_insertion_ut
	@
	<<[[resonance_insertion_uti.f90]]>>=
	<<File header>>

	module resonance_insertion_uti

	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use os_interface
	use lorentz
	use rng_base, only: rng_t
	use flavors, only: flavor_t
	use colors, only: color_t
	use models, only: syntax_model_file_init, syntax_model_file_final
	use models, only: model_list_t, model_t
	use particles, only: particle_t, particle_set_t

	use resonances, only: resonance_info_t
	use resonances, only: resonance_history_t
	use resonances, only: resonance_history_set_t

	use event_transforms
	use resonance_insertion

	use rng_base_ut, only: rng_test_t

	<<Standard module head>>

	<<Resonance insertion: test declarations>>

	contains

	<<Resonance insertion: tests>>

	end module resonance_insertion_uti

	@ %def resonance_insertion_uti
	@ API: driver for the unit tests below.
	<<Resonance insertion: public test>>=
	public :: resonance_insertion_test
	<<Resonance insertion: test driver>>=
	subroutine resonance_insertion_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Resonance insertion: execute tests>>
	end subroutine resonance_insertion_test

	@ %def resonance_insertion_test
	@
	\subsubsection{Test resonance insertion as event transform}
	Insert a resonance (W boson) into an event with momentum assignment.
	<<Resonance insertion: execute tests>>=
	call test (resonance_insertion_1, "resonance_insertion_1", &
	"simple resonance insertion", &
	u, results)
	<<Resonance insertion: test declarations>>=
	public :: resonance_insertion_1
	<<Resonance insertion: tests>>=
	subroutine resonance_insertion_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	type(flavor_t) :: fw
	type(color_t) :: col
	real(default) :: mw, ew, pw
	type(vector4_t), dimension(5) :: p
	class(rng_t), allocatable :: rng
	real(default) :: probability
	integer, dimension(:), allocatable :: i_invalid
	type(particle_t), dimension(:), allocatable :: prt_invalid
	integer :: i

	write (u, "(A)") "* Test output: resonance_insertion_1"
	write (u, "(A)") "* Purpose: apply simple resonance insertion"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)
	! reset slightly in order to avoid a rounding ambiguity
	call model%set_real (var_str ("mW"), 80.418_default)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 3, &
	pdg = [1, -1, 1, -2, 24], model = model)

	call fw%init (24, model)

	mw = fw%get_mass ()
	ew = 200._default
	pw = sqrt (ew2 - mw2)

	p(1) = vector4_moving (ew, ew, 3)
	p(2) = vector4_moving (ew,-ew, 3)
	p(3) = vector4_moving (ew/2, vector3_moving ([pw/2, mw/2, 0._default]))
	p(4) = vector4_moving (ew/2, vector3_moving ([pw/2,-mw/2, 0._default]))
	p(5) = vector4_moving (ew, vector3_moving ([-pw, 0._default, 0._default]))

	call pset%set_momentum (p, on_shell = .true.)

	call col%init_col_acl (1,0)
	call pset%set_color (1, col)

	call col%init_col_acl (0,1)
	call pset%set_color (2, col)

	call col%init_col_acl (2,0)
	call pset%set_color (3, col)

	call col%init_col_acl (0,2)
	call pset%set_color (4, col)

	call col%init_col_acl (0,0)
	call pset%set_color (5, col)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Prepare resonance history set"
	write (u, "(A)")

	call res_history_set(1)%init ()

	call res_info%init (3, -24, model, 2)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_history_set(1)%freeze ()

	write (u, "(A)") "* Initialize resonance insertion transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	allocate (rng_test_t :: rng)
	call evt_resonance%import_rng (rng)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill resonance insertion transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%init_selector ([1._default])
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (0, .false.)

	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

	write (u, "(A)")
	call evt_resonance%find_prt_invalid_color (i_invalid, prt_invalid)
	write (u, "(A)") "Particles with invalid color:"
	select case (size (prt_invalid))
	case (0)
	write (u, "(2x,A)") "[none]"
	case default
	do i = 1, size (prt_invalid)
	write (u, "(1x,A,1x,I0)", advance="no") "Particle", i_invalid(i)
	call prt_invalid(i)%write (u)
	end do
	end select

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_resonance%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: resonance_insertion_1"

	end subroutine resonance_insertion_1

	@ %def resonance_insertion_1
	@
	\subsubsection{Resonance insertion with color mismatch}
	Same as previous test (but no momenta); resonance insertion should fail
	because of color mismatch: W boson is color-neutral.
	<<Resonance insertion: execute tests>>=
	call test (resonance_insertion_2, "resonance_insertion_2", &
	"resonance color mismatch", &
	u, results)
	<<Resonance insertion: test declarations>>=
	public :: resonance_insertion_2
	<<Resonance insertion: tests>>=
	subroutine resonance_insertion_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	type(color_t) :: col
	class(rng_t), allocatable :: rng
	real(default) :: probability
	type(particle_t), dimension(:), allocatable :: prt_invalid
	integer, dimension(:), allocatable :: i_invalid
	integer :: i

	write (u, "(A)") "* Test output: resonance_insertion_2"
	write (u, "(A)") "* Purpose: resonance insertion with color mismatch"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 3, &
	pdg = [1, -1, 1, -2, 24], model = model)

	call col%init_col_acl (1,0)
	call pset%set_color (1, col)

	call col%init_col_acl (0,2)
	call pset%set_color (2, col)

	call col%init_col_acl (1,0)
	call pset%set_color (3, col)

	call col%init_col_acl (0,2)
	call pset%set_color (4, col)

	call col%init_col_acl (0,0)
	call pset%set_color (5, col)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Prepare resonance history set"
	write (u, "(A)")

	call res_history_set(1)%init ()

	call res_info%init (3, -24, model, 2)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_history_set(1)%freeze ()

	write (u, "(A)") "* Initialize resonance insertion transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	allocate (rng_test_t :: rng)
	call evt_resonance%import_rng (rng)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill resonance insertion transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%init_selector ([1._default])
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (0, .false.)

	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

	write (u, "(A)")
	call evt_resonance%find_prt_invalid_color (i_invalid, prt_invalid)
	write (u, "(A)") "Particles with invalid color:"
	select case (size (prt_invalid))
	case (0)
	write (u, "(2x,A)") "[none]"
	case default
	do i = 1, size (prt_invalid)
	write (u, "(1x,A,1x,I0)", advance="no") "Particle", i_invalid(i)
	call prt_invalid(i)%write (u)
	end do
	end select

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_resonance%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: resonance_insertion_2"

	end subroutine resonance_insertion_2

	@ %def resonance_insertion_2
	@
	\subsubsection{Complex resonance history}
	This is the resonance history $u\bar u \to (t\to W^+ b) + (\bar t\to
	(h \to b\bar b) + (\bar t^\ast \to W^-\bar b))$.
	<<Resonance insertion: execute tests>>=
	call test (resonance_insertion_3, "resonance_insertion_3", &
	"complex resonance history", &
	u, results)
	<<Resonance insertion: test declarations>>=
	public :: resonance_insertion_3
	<<Resonance insertion: tests>>=
	subroutine resonance_insertion_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	type(color_t) :: col
	class(rng_t), allocatable :: rng
	real(default) :: probability
	type(particle_t), dimension(:), allocatable :: prt_invalid
	integer, dimension(:), allocatable :: i_invalid
	integer :: i

	write (u, "(A)") "* Test output: resonance_insertion_3"
	write (u, "(A)") "* Purpose: resonance insertion with color mismatch"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 6, &
	pdg = [2, -2, 24, 5, 5, -5, -24, -5], model = model)

	call col%init_col_acl (1,0)
	call pset%set_color (1, col)

	call col%init_col_acl (0,2)
	call pset%set_color (2, col)

	call col%init_col_acl (0,0)
	call pset%set_color (3, col)

	call col%init_col_acl (1,0)
	call pset%set_color (4, col)

	call col%init_col_acl (3,0)
	call pset%set_color (5, col)

	call col%init_col_acl (0,3)
	call pset%set_color (6, col)

	call col%init_col_acl (0,0)
	call pset%set_color (7, col)

	call col%init_col_acl (0,2)
	call pset%set_color (8, col)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Prepare resonance history set"
	write (u, "(A)")

	call res_history_set(1)%init ()

	call res_info%init (3, 6, model, 6)
	call res_history%add_resonance (res_info)
	call res_info%init (12, 25, model, 6)
	call res_history%add_resonance (res_info)
	call res_info%init (60, -6, model, 6)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_history_set(1)%freeze ()

	write (u, "(A)") "* Initialize resonance insertion transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	allocate (rng_test_t :: rng)
	call evt_resonance%import_rng (rng)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill resonance insertion transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%init_selector ([1._default])
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (0, .false.)

	call evt_resonance%write (u)

	write (u, "(A)")
	call evt_resonance%find_prt_invalid_color (i_invalid, prt_invalid)
	write (u, "(A)") "Particles with invalid color:"
	select case (size (prt_invalid))
	case (0)
	write (u, "(2x,A)") "[none]"
	case default
	do i = 1, size (prt_invalid)
	write (u, "(1x,A,1x,I0)", advance="no") "Particle", i_invalid(i)
	call prt_invalid(i)%write (u)
	end do
	end select

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_resonance%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: resonance_insertion_3"

	end subroutine resonance_insertion_3

	@ %def resonance_insertion_3
	@
	\subsubsection{Resonance history selection}
	Another test with zero momenta: select one of several resonant channels
	using the selector component.
	<<Resonance insertion: execute tests>>=
	call test (resonance_insertion_4, "resonance_insertion_4", &
	"resonance history selection", &
	u, results)
	<<Resonance insertion: test declarations>>=
	public :: resonance_insertion_4
	<<Resonance insertion: tests>>=
	subroutine resonance_insertion_4 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	type(color_t) :: col
	class(rng_t), allocatable :: rng
	real(default) :: probability
	integer :: i

	write (u, "(A)") "* Test output: resonance_insertion_4"
	write (u, "(A)") "* Purpose: resonance history selection"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 4, &
	pdg = [1, -1, 1, -2, -3, 4], model = model)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Prepare resonance history set"
	write (u, "(A)")

	call res_history_set(1)%init ()

	call res_info%init (3, -24, model, 4)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_info%init (12, 24, model, 4)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_info%init (12, 24, model, 4)
	call res_history%add_resonance (res_info)
	call res_info%init (15, 25, model, 4)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_history_set(1)%freeze ()

	write (u, "(A)") "* Initialize resonance insertion transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	allocate (rng_test_t :: rng)
	call evt_resonance%import_rng (rng)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill resonance insertion transform"
	write (u, "(A)")

	do i = 1, 6
	write (u, "(A,1x,I0)") "* Event #", i
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%init_selector ([1._default, 2._default, 1._default])
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (0, .false.)

	call evt_resonance%write (u)
	write (u, "(A)")
	end do

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_resonance%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: resonance_insertion_4"

	end subroutine resonance_insertion_4

	@ %def resonance_insertion_4
	@
	\subsubsection{Resonance history selection}
	Another test with zero momenta: select either a resonant channel or no
	resonance.
	<<Resonance insertion: execute tests>>=
	call test (resonance_insertion_5, "resonance_insertion_5", &
	"resonance history on/off", &
	u, results)
	<<Resonance insertion: test declarations>>=
	public :: resonance_insertion_5
	<<Resonance insertion: tests>>=
	subroutine resonance_insertion_5 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	type(color_t) :: col
	class(rng_t), allocatable :: rng
	real(default) :: probability
	integer :: i

	write (u, "(A)") "* Test output: resonance_insertion_5"
	write (u, "(A)") "* Purpose: resonance history selection including no resonance"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 4, &
	pdg = [1, -1, 1, -2, -3, 4], model = model)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)

	write (u, "(A)") "* Prepare resonance history set"
	write (u, "(A)")

	call res_history_set(1)%init ()

	call res_info%init (3, -24, model, 4)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_history_set(1)%freeze ()

	write (u, "(A)") "* Initialize resonance insertion transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	allocate (rng_test_t :: rng)
	call evt_resonance%import_rng (rng)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)

	write (u, "(A)") "* Fill resonance insertion transform"
	write (u, "(A)")

	do i = 1, 2
	write (u, "(A,1x,I0)") "* Event #", i
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%init_selector ([1._default, 3._default], offset = -1)
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (0, .false.)

	call evt_resonance%write (u)
	write (u, "(A)")
	end do

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_resonance%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: resonance_insertion_5"

	end subroutine resonance_insertion_5

	@ %def resonance_insertion_5
	@
	\subsubsection{Resonance insertion with structured beams}
	Insert a resonance (W boson) into an event with beam and virtual
	particles.
	<<Resonance insertion: execute tests>>=
	call test (resonance_insertion_6, "resonance_insertion_6", &
	"resonance insertion with beam structure", &
	u, results)
	<<Resonance insertion: test declarations>>=
	public :: resonance_insertion_6
	<<Resonance insertion: tests>>=
	subroutine resonance_insertion_6 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(particle_set_t) :: pset
	type(model_t), pointer :: model
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	class(rng_t), allocatable :: rng
	real(default) :: probability

	write (u, "(A)") "* Test output: resonance_insertion_6"
	write (u, "(A)") "* Purpose: resonance insertion with structured beams"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 11, -11, 22, 22, 13, -13], model = model)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Prepare resonance history set"
	write (u, "(A)")

	call res_history_set(1)%init ()

	call res_info%init (3, 23, model, 2)
	call res_history%add_resonance (res_info)
	call res_history_set(1)%enter (res_history)
	call res_history%clear ()

	call res_history_set(1)%freeze ()

	write (u, "(A)") "* Initialize resonance insertion transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	allocate (rng_test_t :: rng)
	call evt_resonance%import_rng (rng)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill resonance insertion transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%init_selector ([1._default])
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (0, .false.)

	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_resonance%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: resonance_insertion_6"

	end subroutine resonance_insertion_6

	@ %def resonance_insertion_6
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Recoil kinematics}
	<<[[recoil_kinematics.f90]]>>=
	<<File header>>

	module recoil_kinematics

	<<Use kinds>>
	use constants, only: twopi
	use lorentz, only: vector4_t
	use lorentz, only: vector4_moving
	use lorentz, only: vector3_moving
	use lorentz, only: transverse_part
	use lorentz, only: lorentz_transformation_t
	use lorentz, only: inverse
	use lorentz, only: boost
	use lorentz, only: transformation
	use lorentz, only: operator(+)
	use lorentz, only: operator(-)
	use lorentz, only: operator(*)
	use lorentz, only: operator(**)

	<<Standard module head>>

	<<Recoil kinematics: public>>

	<<Recoil kinematics: parameters>>

	<<Recoil kinematics: types>>

	contains

	<<Recoil kinematics: procedures>>

	end module recoil_kinematics
	@ %def recoil_kinematics
	@
	\subsection{$\phi$ sampler}
	This is trivial. Generate an azimuthal angle, given a $(0,1)$ RNG parameter.
	<<Recoil kinematics: procedures>>=
	elemental subroutine generate_phi_recoil (r, phi)
	real(default), intent(in) :: r
	real(default), intent(out) :: phi

	phi = r * twopi

	end subroutine generate_phi_recoil

	@ %def generate_phi_recoil
	@
	\subsection{$Q^2$ sampler}
	The dynamics of factorization suggests to generate a flat $Q^2$
	distribution from a (random) number, event by event.

	At the lowest momentum transfer values, the particle (electron) mass
	sets a smooth cutoff. The formula can produce $Q$ values below the
	electron mass, down to zero, but with a power distribution that
	eventually evolves into the expected logarithmic distribution for $Q^2 >
	m^2$.

	We are talking about the absolute value here, so all $Q^2$
	values are positive. For the actual momentum transfer, $q^2=-Q^2$.
	<<Recoil kinematics: public>>=
	public :: generate_q2_recoil
	<<Recoil kinematics: procedures>>=
	elemental subroutine generate_q2_recoil (s, x_bar, q2_max, m2, r, q2)
	real(default), intent(in) :: s
	real(default), intent(in) :: q2_max
	real(default), intent(in) :: x_bar
	real(default), intent(in) :: m2
	real(default), intent(in) :: r
	real(default), intent(out) :: q2

	real(default) :: q2_max_evt

	q2_max_evt = q2_max_event (s, x_bar, q2_max)

	q2 = m2 * (exp (r * log (1 + (q2_max_evt / m2))) - 1)

	end subroutine generate_q2_recoil

	@ %def generate_q_recoil
	@
	The $Q$ distribution is cut off from above by the kinematic limit,
	which depends on the energy that is available for the radiated photon,
	or by a user-defined cutoff -- whichever is less. The kinematic limit
	fits the formulas for recoil momenta (see below), and it also
	implicitly enters the ISR collinear structure function, so the
	normalization of the distribution should be correct.
	<<Recoil kinematics: procedures>>=
	elemental function q2_max_event (s, x_bar, q2_max) result (q2)
	real(default), intent(in) :: s
	real(default), intent(in) :: x_bar
	real(default), intent(in) :: q2_max
	real(default) :: q2

	q2 = min (x_bar * s, q2_max)

	end function q2_max_event

	@ %def q2_max_event
	@
	\subsection{Kinematics functions}
	Given values for energies, $Q_{1,2}^2$, azimuthal angle, compute the
	matching polar angle of the radiating particle. The subroutine
	returns $\sin\theta$ and $\cos\theta$.
	<<Recoil kinematics: procedures>>=
	subroutine polar_angles (s, xb, rho, ee, q2, sin_th, cos_th, ok)
	real(default), intent(in) :: s
	real(default), intent(in) :: xb
	real(default), intent(in) :: rho
	real(default), dimension(2), intent(in) :: ee
	real(default), dimension(2), intent(in) :: q2
	real(default), dimension(2), intent(out) :: sin_th
	real(default), dimension(2), intent(out) :: cos_th
	logical, intent(out) :: ok

	real(default), dimension(2) :: sin2_th_2

	sin2_th_2 = q2 / (ee * rho * xb * s)

	if (all (sin2_th_2 <= 1)) then
	sin_th = 2 * sqrt (sin2_th_2 * (1 - sin2_th_2))
	cos_th = 1 - 2 * sin2_th_2
	ok = .true.
	else
	sin_th = 0
	cos_th = 1
	ok = .false.
	end if

	end subroutine polar_angles

	@ %def polar_angles
	@
	Compute the acollinearity parameter $\lambda$ from azimuthal and polar
	angles. The result is a number between $0$ and $1$.
	<<Recoil kinematics: procedures>>=
	function lambda_factor (sin_th, cos_th, cphi) result (lambda)
	real(default), dimension(2), intent(in) :: sin_th
	real(default), dimension(2), intent(in) :: cos_th
	real(default), intent(in) :: cphi
	real(default) :: lambda

	lambda = (1 - cos_th(1) * cos_th(2) - cphi * sin_th(1) * sin_th(2)) / 2

	end function lambda_factor

	@ %def lambda_factor
	@
	Compute the factor that rescales photon energies, such that the
	radiation angles match the kinematics parameters.

	For small values of $\bar x/\cosh\eta$, we have to use the Taylor
	expansion if we do not want to lose precision. The optional argument
	allows for a unit test that compares exact and approximate.
	<<Recoil kinematics: procedures>>=
	function scale_factor (che, lambda, xb0, approximate) result (rho)
	real(default), intent(in) :: che
	real(default), intent(in) :: lambda
	real(default), intent(in) :: xb0
	logical, intent(in), optional :: approximate
	real(default) :: rho

	real(default), parameter :: &
	e0 = (100 * epsilon (1._default)) ** (0.3_default)
	logical :: approx

	if (present (approximate)) then
	approx = approximate
	else
	approx = (xb0/che) < e0
	end if

	if (approx) then
	rho = 1 - lambda * (xb0/(2che)) (1 + (1-lambda) * (xb0/che))
	else
	rho = (che / ((1-lambda)*xb0)) &
	* (1 - sqrt (1 - 2 * (1-lambda) * (xb0/che) &
	& + (1-lambda) * (xb0 / che)**2))
	end if

	end function scale_factor

	@ %def scale_factor
	@ The code snippet below is not used anywhere, but may be manually
	inserted in a unit test to numerically verify the approximation above.
	<<Recoil kinematics: extra test code>>=
	write (u, "(A)")
	write (u, "(A)") "*** Table: scale factor calculation"
	write (u, "(A)")

	lambda = 0.25_default
	write (u, FMT1) "lambda =", lambda

	che = 4._default
	write (u, FMT1) "che =", che

	write (u, "(A)") " x0 rho(exact) rho(approx) rho(chosen)"
	xb0 = 1._default
	do i = 1, 30
	xb0 = xb0 / 10
	write (u, FMT4) xb0, &
	scale_factor (che, lambda, xb0, approximate=.false.), &
	scale_factor (che, lambda, xb0, approximate=.true.), &
	scale_factor (che, lambda, xb0)
	end do
	@
	Compute the current values for the $x_{1,2}$ parameters, given the
	updated scale factor $\rho$ and the collinear parameters.
	<<Recoil kinematics: procedures>>=
	subroutine scaled_x (rho, ee, xb0, x, xb)
	real(default), intent(in) :: rho
	real(default), dimension(2), intent(in) :: ee
	real(default), intent(in) :: xb0
	real(default), dimension(2), intent(out) :: x
	real(default), dimension(2), intent(out) :: xb

	xb = rho * ee * xb0
	x = 1 - xb

	end subroutine scaled_x

	@ %def scaled_x
	@
	\subsection{Iterative solution of kinematics constraints}
	Find a solution of the kinematics constraints. We know the parameters
	appropriate for collinear kinematics $\sqrt{s}$, $x^c_{1,2}$. We
	have picked values vor the momentum transfer $Q_{1,2}$ and the
	azimuthal angles $\phi_{1,2}$. The solution consists of modified energy
	fractions $x_{1,2}$ and polar angles $\theta_{1,2}$.

	If the computation fails, which can happen for large momentum
	transfer, the flag [[ok]] will indicate this.
	<<Recoil kinematics: public>>=
	public :: solve_recoil
	<<Recoil kinematics: procedures>>=
	subroutine solve_recoil (sqrts, xc, xcb, phi, q2, x, xb, cos_th, sin_th, ok)
	real(default), intent(in) :: sqrts
	real(default), dimension(2), intent(in) :: xc
	real(default), dimension(2), intent(in) :: xcb
	real(default), dimension(2), intent(in) :: phi
	real(default), dimension(2), intent(in) :: q2
	real(default), dimension(2), intent(out) :: x
	real(default), dimension(2), intent(out) :: xb
	real(default), dimension(2), intent(out) :: cos_th
	real(default), dimension(2), intent(out) :: sin_th
	logical, intent(out) :: ok

	real(default) :: s
	real(default), dimension(2) :: ee
	real(default), dimension(2) :: th
	real(default) :: xb0, cphi
	real(default) :: che, lambda
	real(default) :: rho_new, rho, rho_old
	real(default) :: dr_old, dr_new
	real(default), parameter :: dr_limit = 100 * epsilon (1._default)
	integer, parameter :: n_it_max = 20
	integer :: i

	ok = .true.

	s = sqrts**2
	ee = sqrt ([xcb(1)/xcb(2), xcb(2)/xcb(1)])
	che = sum (ee) / 2
	xb0 = sqrt (xcb(1) * xcb(2))
	cphi = cos (phi(1) - phi(2))

	rho_old = 10
	rho = 1
	th = 0
	sin_th = sin (th)
	cos_th = cos (th)
	lambda = lambda_factor (sin_th, cos_th, cphi)
	call scaled_x (rho, ee, xb0, x, xb)

	iterate_loop: do i = 1, n_it_max

	call polar_angles (s, xb0, rho, ee, q2, sin_th, cos_th, ok)
	if (.not. ok) return
	th = atan2 (sin_th, cos_th)

	lambda = lambda_factor (sin_th, cos_th, cphi)
	rho_new = scale_factor (che, lambda, xb0)
	call scaled_x (rho_new, ee, xb0, x, xb)

	dr_old = abs (rho - rho_old)
	dr_new = abs (rho_new - rho)

	rho_old = rho
	rho = rho_new

	if (dr_new < dr_limit .or. dr_new >= dr_old) exit iterate_loop

	end do iterate_loop

	end subroutine solve_recoil

	@ %def solve_recoil
	@
	With all kinematics parameters known, construct actual four-vectors
	for the recoil momenta, the off-shell (spacelike) parton momenta, and
	on-shell projected parton momenta.
	<<Recoil kinematics: public>>=
	public :: recoil_momenta
	<<Recoil kinematics: procedures>>=
	subroutine recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
	real(default), intent(in) :: sqrts
	real(default), dimension(2), intent(in) :: xc
	real(default), dimension(2), intent(in) :: xb
	real(default), dimension(2), intent(in) :: cos_th
	real(default), dimension(2), intent(in) :: sin_th
	real(default), dimension(2), intent(in) :: phi
	type(vector4_t), dimension(2), intent(out) :: km
	type(vector4_t), dimension(2), intent(out) :: qm
	type(vector4_t), dimension(2), intent(out) :: qo

	type(vector4_t), dimension(2) :: pm
	type(lorentz_transformation_t) :: lt
	real(default) :: sqsh

	pm(1) = &
	vector4_moving (sqrts/2, &
	vector3_moving ([0._default, 0._default, sqrts/2]))
	pm(2) = &
	vector4_moving (sqrts/2, &
	vector3_moving ([0._default, 0._default,-sqrts/2]))

	km(1) = xb(1) * (sqrts/2) * vector4_moving ( &
	1._default, &
	vector3_moving ([ &
	& sin_th(1) * cos (phi(1)), &
	& sin_th(1) * sin (phi(1)), &
	& cos_th(1)]) &
	)
	km(2) = xb(2) * (sqrts/2) * vector4_moving ( &
	1._default, &
	vector3_moving ([ &
	& -sin_th(2) * cos (phi(2)), &
	& -sin_th(2) * sin (phi(2)), &
	& -cos_th(2)]) &
	)

	qm(1) = pm(1) - km(1)
	qm(2) = pm(2) - km(2)

	sqsh = sqrt (xc(1)xc(2)) sqrts
	lt = transformation (3, qm(1), qm(2), sqsh)

	qo(1) = lt * vector4_moving (sqsh/2, sqsh/2, 3)
	qo(2) = lt * vector4_moving (sqsh/2,-sqsh/2, 3)

	end subroutine recoil_momenta

	@ %def recoil_momenta
	@
	Compute the Lorentz transformation that we can use to transform any
	outgoing momenta into the new c.m.\ system of the incoming partons.
	Not relying on the previous calculations, we determine the
	transformation that transforms the original collinear partons into
	their c.m.\ system, and then transform this to the new c.m.\ system.
	<<Recoil kinematics: public>>=
	public :: recoil_transformation
	<<Recoil kinematics: procedures>>=
	subroutine recoil_transformation (sqrts, xc, qo, lt)
	real(default), intent(in) :: sqrts
	real(default), dimension(2), intent(in) :: xc
	type(vector4_t), dimension(2), intent(in) :: qo
	type(lorentz_transformation_t), intent(out) :: lt

	real(default) :: sqsh
	type(vector4_t), dimension(2) :: qc
	type(lorentz_transformation_t) :: ltc, lto

	qc(1) = xc(1) * vector4_moving (sqrts/2, sqrts/2, 3)
	qc(2) = xc(2) * vector4_moving (sqrts/2,-sqrts/2, 3)

	sqsh = sqrt (xc(1) * xc(2)) * sqrts
	ltc = transformation (3, qc(1), qc(2), sqsh)
	lto = transformation (3, qo(1), qo(2), sqsh)
	lt = lto * inverse (ltc)

	end subroutine recoil_transformation

	@ %def recoil_transformation
	@
	Compute the Lorentz boost that transforms the c.m.\ frame of the
	momenta into the lab frame where they are given. Also return their
	common invariant mass, $\sqrt{s}$.

	If the initial momenta are not collinear, [[ok]] is set false.
	<<Recoil kinematics: public>>=
	public :: initial_transformation
	<<Recoil kinematics: procedures>>=
	subroutine initial_transformation (p, sqrts, lt, ok)
	type(vector4_t), dimension(2), intent(in) :: p
	real(default), intent(out) :: sqrts
	type(lorentz_transformation_t), intent(out) :: lt
	logical, intent(out) :: ok

	ok = all (transverse_part (p) == 0)

	sqrts = (p(1) + p(2)) ** 1
	lt = boost (p(1) + p(2), sqrts)

	end subroutine initial_transformation

	@ %def initial_transformation
	@
	\subsection{Generate recoil event}
	Combine the above kinematics calculations. First generate azimuthal
	angles and momentum transfer, solve kinematics and compute momenta for
	the radiated photons and the on-shell projected, recoiling partons.

	If [[ok]] is false, the data point has failed and we should repeat the
	procedure for a new set of RNG parameters [[r]].
	<<Recoil kinematics: public>>=
	public :: generate_recoil
	<<Recoil kinematics: procedures>>=
	subroutine generate_recoil (sqrts, q_max, m, xc, xcb, r, km, qm, qo, ok)
	real(default), intent(in) :: sqrts
	real(default), intent(in), dimension(2) :: q_max
	real(default), intent(in), dimension(2) :: m
	real(default), intent(in), dimension(2) :: xc
	real(default), intent(in), dimension(2) :: xcb
	real(default), intent(in), dimension(4) :: r
	type(vector4_t), dimension(2), intent(out) :: km
	type(vector4_t), dimension(2), intent(out) :: qm
	type(vector4_t), dimension(2), intent(out) :: qo
	logical, intent(out) :: ok

	real(default), dimension(2) :: q2
	real(default), dimension(2) :: phi
	real(default), dimension(2) :: x
	real(default), dimension(2) :: xb
	real(default), dimension(2) :: cos_th
	real(default), dimension(2) :: sin_th

	call generate_q2_recoil (sqrts2, xcb, q_max2, m**2, r(1:2), q2)
	call generate_phi_recoil (r(3:4), phi)

	call solve_recoil (sqrts, xc, xcb, phi, q2, x, xb, cos_th, sin_th, ok)
	if (ok) then
	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
	end if

	end subroutine generate_recoil

	@ %def generate_recoil
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[recoil_kinematics_ut.f90]]>>=
	<<File header>>

	module recoil_kinematics_ut
	use unit_tests
	use recoil_kinematics_uti

	<<Standard module head>>

	<<Recoil kinematics: public test>>

	contains

	<<Recoil kinematics: test driver>>

	end module recoil_kinematics_ut
	@ %def recoil_kinematics_ut
	@
	<<[[recoil_kinematics_uti.f90]]>>=
	<<File header>>

	module recoil_kinematics_uti

	<<Use kinds>>
	use constants, only: twopi
	use constants, only: degree
	use lorentz, only: vector4_t
	use lorentz, only: vector4_moving
	use lorentz, only: lorentz_transformation_t
	use lorentz, only: inverse
	use lorentz, only: operator(+)
	use lorentz, only: operator(*)
	use lorentz, only: operator(**)
	use lorentz, only: pacify

	use recoil_kinematics, only: solve_recoil
	use recoil_kinematics, only: recoil_momenta
	use recoil_kinematics, only: recoil_transformation
	use recoil_kinematics, only: initial_transformation
	use recoil_kinematics, only: generate_q2_recoil
	use recoil_kinematics, only: generate_recoil

	<<Standard module head>>

	<<Recoil kinematics: test declarations>>

	contains

	<<Recoil kinematics: tests>>

	end module recoil_kinematics_uti

	@ %def recoil_kinematics_uti
	@ API: driver for the unit tests below.
	<<Recoil kinematics: public test>>=
	public :: recoil_kinematics_test
	<<Recoil kinematics: test driver>>=
	subroutine recoil_kinematics_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Recoil kinematics: execute tests>>
	end subroutine recoil_kinematics_test

	@ %def recoil_kinematics_test
	@
	\subsubsection{Recoil kinematics}
	For a set of input data, solve the kinematics constraints and generate
	momenta accordingly.
	<<Recoil kinematics: execute tests>>=
	call test (recoil_kinematics_1, "recoil_kinematics_1", &
	"iterative solution of non-collinear kinematics", &
	u, results)
	<<Recoil kinematics: test declarations>>=
	public :: recoil_kinematics_1
	<<Recoil kinematics: tests>>=
	subroutine recoil_kinematics_1 (u)
	integer, intent(in) :: u

	real(default) :: sqrts
	real(default), dimension(2) :: xc, xcb
	real(default), dimension(2) :: q
	real(default), dimension(2) :: phi
	real(default), dimension(2) :: cos_th, sin_th
	real(default), dimension(2) :: x
	real(default), dimension(2) :: xb
	type(vector4_t), dimension(2) :: km
	type(vector4_t), dimension(2) :: qm
	type(vector4_t), dimension(2) :: qo
	integer :: i
	logical :: ok

	character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
	character(*), parameter :: FMT2 = "(1x,A,9(1x,F10.5))"
	character(*), parameter :: FMT4 = "(3x,ES8.1,9(1x,ES19.12))"

	write (u, "(A)") "* Test output: recoil_kinematics_1"
	write (u, "(A)") "* Purpose: compute kinematics for various input data"
	write (u, "(A)")

	sqrts = 100
	write (u, FMT1) "sqrts =", sqrts

	write (u, "(A)")
	write (u, "(A)") "*** collinear data set"
	write (u, "(A)")

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.2_default] * twopi
	q = 0

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call show_results

	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** moderate data set"
	write (u, "(A)")

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.2_default] * twopi
	q = [0.2_default, 0.05_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call show_results

	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** semi-soft data set"
	write (u, "(A)")

	xcb= [0.1_default, 0.0001_default]
	xc = 1 - xcb
	phi = [0.1_default, 0.2_default] * twopi
	q = [0.2_default, 0.00001_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call show_results

	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** hard-soft data set"
	write (u, "(A)")

	xcb= [0.1_default, 1.e-30_default]
	xc = 1 - xcb
	phi = [0.1_default, 0.2_default] * twopi
	q = [0.2_default, 1.e-35_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call show_results

	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** hard data set"
	write (u, "(A)")

	xc = [0.2_default, 0.4_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.8_default] * twopi
	q = [0.74_default, 0.3_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call show_results

	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** failing data set"
	write (u, "(A)")

	xc = [0.2_default, 0.4_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.8_default] * twopi
	q = [0.9_default, 0.3_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	if (.not. ok) then
	write (u, "(A)")
	write (u, "(A)") "Failed as expected."
	end if

	write (u, "(A)")
	write (u, "(A)") "* Test output end: recoil_kinematics_1"

	contains

	subroutine show_data
	write (u, FMT1) "sqs_h =", sqrt (xc(1) * xc(2)) * sqrts
	write (u, FMT1) "xc =", xc
	write (u, FMT1) "xcb =", xcb
	write (u, FMT1) "Q =", Q
	write (u, FMT1) "phi/D =", phi / degree
	end subroutine show_data

	subroutine show_results
	write (u, "(A)")
	write (u, "(A)") "Result:"
	write (u, FMT1) "th/D =", atan2 (sin_th, cos_th) / degree
	write (u, FMT1) "x =", x
	write (u, "(A)")
	end subroutine show_results

	subroutine show_momenta
	type(vector4_t) :: qm0, qo0
	real(default), parameter :: tol = 1.e-7_default
	call pacify (km, tol)
	call pacify (qm, tol)
	call pacify (qo, tol)
	write (u, "(A)") "Momenta: k"
	call km(1)%write (u, testflag=.true.)
	call km(2)%write (u, testflag=.true.)
	write (u, FMT1) "k^2 =", abs (km(1)2), abs (km(2)2)
	write (u, "(A)")
	write (u, "(A)") "Momenta: q"
	call qm(1)%write (u, testflag=.true.)
	call qm(2)%write (u, testflag=.true.)
	write (u, "(A)")
	write (u, "(A)") "Momenta: q(os)"
	call qo(1)%write (u, testflag=.true.)
	call qo(2)%write (u, testflag=.true.)
	write (u, "(A)")
	write (u, "(A)") "Check: parton momentum sum: q vs q(os)"
	qm0 = qm(1) + qm(2)
	call qm0%write (u, testflag=.true.)
	qo0 = qo(1) + qo(2)
	call qo0%write (u, testflag=.true.)
	write (u, "(A)")
	write (u, "(A)") "* Check: momentum transfer (off-shell/on-shell)"
	write (u, FMT2) "\|q\| =", abs (qm(1)1), abs (qm(2)1)
	write (u, FMT2) "Q =", q
	write (u, FMT2) "\|qo\|=", abs (qo(1)1), abs (qo(2)1)
	write (u, "(A)")
	write (u, "(A)") "* Check: sqrts, sqrts_hat"
	write (u, FMT1) "\|p\| =", (km(1)+km(2)+qm(1)+qm(2))1, (qm(1)+qm(2))1
	write (u, FMT1) "sqs =", sqrts, sqrt (product (xc)) * sqrts
	write (u, FMT1) "\|po\|=", abs ((km(1)+km(2)+qo(1)+qo(2))1), abs ((qo(1)+qo(2))1)
	end subroutine show_momenta

	end subroutine recoil_kinematics_1

	@ %def recoil_kinematics_1
	@
	\subsubsection{Recoil $Q$ distribution}
	Sample the $Q$ distribution for equidistant bins in the input variable.
	<<Recoil kinematics: execute tests>>=
	call test (recoil_kinematics_2, "recoil_kinematics_2", &
	"Q distribution", &
	u, results)
	<<Recoil kinematics: test declarations>>=
	public :: recoil_kinematics_2
	<<Recoil kinematics: tests>>=
	subroutine recoil_kinematics_2 (u)
	integer, intent(in) :: u

	real(default) :: sqrts
	real(default) :: q_max
	real(default) :: m
	real(default) :: x_bar
	real(default) :: r
	real(default) :: q2, q2_old
	integer :: i
	integer :: n_bin

	character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
	character(*), parameter :: FMT3 = "(2x,9(1x,F10.5))"

	write (u, "(A)") "* Test output: recoil_kinematics_2"
	write (u, "(A)") "* Purpose: compute Q distribution"
	write (u, "(A)")

	n_bin = 20

	write (u, "(A)") "* No Q cutoff, xbar = 1"
	write (u, "(A)")

	sqrts = 100
	q_max = sqrts
	m = 0.511e-3_default
	x_bar = 1._default
	call show_table

	write (u, "(A)")
	write (u, "(A)") "* With Q cutoff, xbar = 1"
	write (u, "(A)")

	q_max = 10
	call show_table

	write (u, "(A)")
	write (u, "(A)") "* No Q cutoff, xbar = 0.01"
	write (u, "(A)")

	q_max = sqrts
	x_bar = 0.01_default
	call show_table

	write (u, "(A)")
	write (u, "(A)") "* Test output end: recoil_kinematics_2"

	contains

	subroutine show_table
	write (u, FMT1) "sqrts =", sqrts
	write (u, FMT1) "q_max =", q_max
	write (u, FMT1) "m =", m
	write (u, FMT1) "x_bar =", x_bar
	write (u, "(A)")
	write (u, "(1x,A)") "Table: r \|Q\| \|Q_i/Q_(i-1)\|"
	q2_old = 0
	do i = 0, n_bin
	r = real (i, default) / n_bin
	call generate_q2_recoil (sqrts2, x_bar, q_max2, m**2, r, q2)
	if (q2_old > 0) then
	write (u, FMT3) r, sqrt (q2), sqrt (q2 / q2_old)
	else
	write (u, FMT3) r, sqrt (q2)
	end if
	q2_old = q2
	end do
	end subroutine show_table

	end subroutine recoil_kinematics_2

	@ %def recoil_kinematics_2
	@
	\subsubsection{Generate recoil event}
	Combine $Q^2$ sampling with momentum generation.
	<<Recoil kinematics: execute tests>>=
	call test (recoil_kinematics_3, "recoil_kinematics_3", &
	"generate recoil event", &
	u, results)
	<<Recoil kinematics: test declarations>>=
	public :: recoil_kinematics_3
	<<Recoil kinematics: tests>>=
	subroutine recoil_kinematics_3 (u)
	integer, intent(in) :: u

	real(default) :: sqrts
	real(default), dimension(2) :: q_max
	real(default), dimension(2) :: m
	real(default), dimension(2) :: xc, xcb
	real(default), dimension(4) :: r
	type(vector4_t), dimension(2) :: km
	type(vector4_t), dimension(2) :: qm
	type(vector4_t), dimension(2) :: qo
	logical :: ok

	character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
	character(*), parameter :: FMT2 = "(1x,A,9(1x,F10.5))"

	write (u, "(A)") "* Test output: recoil_kinematics_3"
	write (u, "(A)") "* Purpose: generate momenta from RNG parameters"
	write (u, "(A)")

	write (u, "(A)") "*** collinear data set"
	write (u, "(A)")

	sqrts = 100
	q_max = sqrts
	m = 0.511e-3_default

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc

	r = [0._default, 0._default, 0._default, 0._default]

	call show_data
	call generate_recoil (sqrts, q_max, m, xc, xcb, r, km, qm, qo, ok)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** moderate data set"
	write (u, "(A)")

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc

	r = [0.8_default, 0.2_default, 0.1_default, 0.2_default]

	call show_data
	call generate_recoil (sqrts, q_max, m, xc, xcb, r, km, qm, qo, ok)
	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "*** failing data set"
	write (u, "(A)")

	xc = [0.2_default, 0.4_default]
	xcb = 1 - xc

	r = [0.9999_default, 0.3_default, 0.1_default, 0.8_default]

	call show_data
	call generate_recoil (sqrts, q_max, m, xc, xcb, r, km, qm, qo, ok)
	if (.not. ok) then
	write (u, "(A)")
	write (u, "(A)") "Failed as expected."
	else
	call show_momenta
	end if

	contains

	subroutine show_data
	write (u, FMT1) "sqrts =", sqrts
	write (u, FMT1) "q_max =", q_max
	write (u, FMT1) "m =", m
	write (u, FMT1) "xc =", xc
	write (u, FMT1) "xcb =", xcb
	write (u, FMT1) "r =", r
	end subroutine show_data

	subroutine show_momenta
	real(default), parameter :: tol = 1.e-7_default
	call pacify (km, tol)
	call pacify (qo, tol)
	write (u, "(A)")
	write (u, "(A)") "* Momenta: k"
	call km(1)%write (u, testflag=.true.)
	call km(2)%write (u, testflag=.true.)
	write (u, FMT1) "k^2 =", abs (km(1)2), abs (km(2)2)
	write (u, "(A)")
	write (u, "(A)") "* Momenta: q(os)"
	call qo(1)%write (u, testflag=.true.)
	call qo(2)%write (u, testflag=.true.)
	write (u, FMT1) "q^2 =", abs (qo(1)2), abs (qo(2)2)
	write (u, "(A)")
	write (u, "(A)") "* Check: momentum transfer (off-shell/on-shell)"
	write (u, FMT2) "Q =", q_check (1), q_check (2)
	write (u, FMT2) "\|q\| =", abs (qm(1)1), abs (qm(2)1)
	write (u, "(A)")
	write (u, "(A)") "* Check: sqrts, sqrts_hat"
	write (u, FMT1) "sqs =", sqrts, sqrt (product (xc)) * sqrts
	write (u, FMT1) "\|po\|=", abs ((km(1)+km(2)+qo(1)+qo(2))1), abs ((qo(1)+qo(2))1)
	end subroutine show_momenta

	function q_check (i) result (q)
	integer, intent(in) :: i
	real(default) :: q
	real(default) :: q2
	call generate_q2_recoil (sqrts2, xcb(i), q_max(i)2, m(i)**2, r(i), q2)
	q = sqrt (q2)
	end function q_check

	end subroutine recoil_kinematics_3

	@ %def recoil_kinematics_3
	@
	\subsubsection{Transformation after recoil}
	Given a solution to recoil kinematics, compute the Lorentz
	transformation that transforms the old collinear parton momenta into
	the new parton momenta.
	<<Recoil kinematics: execute tests>>=
	call test (recoil_kinematics_4, "recoil_kinematics_4", &
	"reference frame", &
	u, results)
	<<Recoil kinematics: test declarations>>=
	public :: recoil_kinematics_4
	<<Recoil kinematics: tests>>=
	subroutine recoil_kinematics_4 (u)
	integer, intent(in) :: u

	real(default) :: sqrts
	real(default), dimension(2) :: xc, xcb
	real(default), dimension(2) :: q
	real(default), dimension(2) :: phi
	real(default), dimension(2) :: cos_th, sin_th
	real(default), dimension(2) :: x
	real(default), dimension(2) :: xb
	type(vector4_t), dimension(2) :: km
	type(vector4_t), dimension(2) :: qm
	type(vector4_t), dimension(2) :: qo
	type(lorentz_transformation_t) :: lt
	logical :: ok

	character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
	character(*), parameter :: FMT2 = "(1x,A,9(1x,F10.5))"

	write (u, "(A)") "* Test output: recoil_kinematics_4"
	write (u, "(A)") "* Purpose: check Lorentz transformation for recoil"
	write (u, "(A)")

	sqrts = 100
	write (u, FMT1) "sqrts =", sqrts


	write (u, "(A)")
	write (u, "(A)") "*** collinear data set"
	write (u, "(A)")

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.2_default] * twopi
	q = 0

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
	call recoil_transformation (sqrts, xc, qo, lt)
	call show_transformation

	write (u, "(A)")
	write (u, "(A)") "*** moderate data set"
	write (u, "(A)")

	xc = [0.6_default, 0.9_default]
	xcb = 1 - xc
	phi = [0.1_default, 0.2_default] * twopi
	q = [0.2_default, 0.05_default] * sqrts

	call show_data
	call solve_recoil (sqrts, xc, xcb, phi, q**2, x, xb, cos_th, sin_th, ok)
	call recoil_momenta (sqrts, xc, xb, cos_th, sin_th, phi, km, qm, qo)
	call recoil_transformation (sqrts, xc, qo, lt)
	call show_transformation

	write (u, "(A)")
	write (u, "(A)") "* Test output end: recoil_kinematics_4"

	contains

	subroutine show_data
	write (u, FMT1) "sqs_h =", sqrt (xc(1) * xc(2)) * sqrts
	write (u, FMT1) "xc =", xc
	write (u, FMT1) "xcb =", xcb
	write (u, FMT1) "Q =", Q
	write (u, FMT1) "phi/D =", phi / degree
	end subroutine show_data

	subroutine show_transformation
	type(vector4_t), dimension(2) :: qc
	type(vector4_t), dimension(2) :: qct
	real(default), parameter :: tol = 1.e-7_default
	qc(1) = xc(1) * vector4_moving (sqrts/2, sqrts/2, 3)
	qc(2) = xc(2) * vector4_moving (sqrts/2,-sqrts/2, 3)
	qct = lt * qc
	call pacify (qct, tol)
	write (u, "(A)")
	write (u, "(A)") "Momenta: q(os)"
	call qo(1)%write (u, testflag=.true.)
	call qo(2)%write (u, testflag=.true.)
	write (u, "(A)")
	write (u, "(A)") "Momenta: LT * qc"
	call qct(1)%write (u, testflag=.true.)
	call qct(2)%write (u, testflag=.true.)
	end subroutine show_transformation

	end subroutine recoil_kinematics_4

	@ %def recoil_kinematics_4
	@
	\subsubsection{Transformation before recoil}
	Given a pair of incoming `beam' partons (i.e., before ISR splitting),
	compute the transformation that transforms their common c.m.\ frame
	into the lab frame.
	<<Recoil kinematics: execute tests>>=
	call test (recoil_kinematics_5, "recoil_kinematics_5", &
	"initial reference frame", &
	u, results)
	<<Recoil kinematics: test declarations>>=
	public :: recoil_kinematics_5
	<<Recoil kinematics: tests>>=
	subroutine recoil_kinematics_5 (u)
	integer, intent(in) :: u

	real(default) :: sqrts
	real(default) :: sqrtsi
	real(default), dimension(2) :: x
	type(vector4_t), dimension(2) :: p
	type(vector4_t), dimension(2) :: pi
	type(vector4_t), dimension(2) :: p0
	type(lorentz_transformation_t) :: lt
	logical :: ok

	character(*), parameter :: FMT1 = "(1x,A,9(1x,F15.10))"
	character(*), parameter :: FMT2 = "(1x,A,9(1x,F10.5))"

	write (u, "(A)") "* Test output: recoil_kinematics_5"
	write (u, "(A)") "* Purpose: determine initial Lorentz transformation"
	write (u, "(A)")

	sqrts = 100
	write (u, FMT1) "sqrts =", sqrts

	x = [0.6_default, 0.9_default]

	p(1) = x(1) * vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = x(2) * vector4_moving (sqrts/2,-sqrts/2, 3)

	call show_data
	call initial_transformation (p, sqrtsi, lt, ok)

	pi(1) = vector4_moving (sqrtsi/2, sqrtsi/2, 3)
	pi(2) = vector4_moving (sqrtsi/2,-sqrtsi/2, 3)

	p0 = inverse (lt) * p

	call show_momenta

	write (u, "(A)")
	write (u, "(A)") "* Test output end: recoil_kinematics_5"

	contains

	subroutine show_data
	write (u, FMT1) "sqrts =", sqrts
	write (u, FMT1) "x =", x
	end subroutine show_data


	subroutine show_momenta
	real(default), parameter :: tol = 1.e-7_default
	write (u, "(A)")
	write (u, "(A)") "* Momenta: p_in(c.m.)"
	call pi(1)%write (u, testflag=.true.)
	call pi(2)%write (u, testflag=.true.)
	write (u, "(A)")
	write (u, "(A)") "* Momenta: inv(LT) * p_in(lab)"
	call p0(1)%write (u, testflag=.true.)
	call p0(2)%write (u, testflag=.true.)
	end subroutine show_momenta

	end subroutine recoil_kinematics_5

	@ %def recoil_kinematics_5
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Transverse momentum for the ISR and EPA approximations}

	The ISR and EPA handler takes an event with a single radiated collinear
	particle (photon for ISR, beam particle for EPA) for each beam, respectively,
	and inserts transverse momentum for both. The four-particle kinematics allows
	us to generate $Q^2$ and azimuthal angles independently, without violating
	energy-momentum conservation. The $Q^2$ distribution is logarithmic, as
	required by the effective particle approximation, and reflected in the
	inclusive ISR/EPA structure functions. We also conserve the invariant mass of
	the partonic systm after radiation. The total transverse-momentum kick is
	applied in form of a Lorentz transformation to the elementary process, both
	in- and out-particles. In fact, the incoming partons (beam particle for ISR,
	photon for EPA) which would be virtual space-like in the exact kinematics
	configuration, are replaced by on-shell incoming partons, such that energy,
	momentum, and invariant mass $\sqrt{\hat s}$ are conserved.

	Regarding kinematics, we treat all particles as massless. The beam-particle
	mass only appears as the parameter [[isr_mass]] or [[epa_mass]], respectively,
	and cuts off the logarithmic distribution. The upper cutoff is [[isr_q_max]]
	([[epa_q_max]]), which defaults to the available energy $\sqrt{s}$.

	The only differences between ISR and EPA, in this context, are the particle
	types, and an extra $\bar x$ factor in the lower cutoff for EPA, see below.
	<<[[isr_epa_handler.f90]]>>=
	<<File header>>

	module isr_epa_handler

	<<Use kinds>>
	<<Use strings>>
	use diagnostics, only: msg_fatal
	use diagnostics, only: msg_bug
	use io_units
	use format_defs, only: FMT_12, FMT_19
	use format_utils, only: write_separator
	use format_utils, only: pac_fmt
	use physics_defs, only: PHOTON
	use lorentz, only: vector4_t
	use lorentz, only: energy
	use lorentz, only: lorentz_transformation_t
	use lorentz, only: identity
	use lorentz, only: inverse
	use lorentz, only: operator(*)
	use sm_qcd
	use flavors, only: flavor_t
	use particles, only: particle_t
	use model_data
	use models
	use rng_base, only: rng_t
	use event_transforms
	use recoil_kinematics, only: initial_transformation
	use recoil_kinematics, only: generate_recoil
	use recoil_kinematics, only: recoil_transformation

	<<Standard module head>>

	<<ISR/EPA handler: public>>

	<<ISR/EPA handler: parameters>>

	<<ISR/EPA handler: types>>

	contains

	<<ISR/EPA handler: procedures>>

	end module isr_epa_handler
	@ %def isr_epa_handler
	@
	\subsection{Event transform type}
	Convention: [[beam]] are the incoming partons before ISR -- not
	necessarily the actual beams, need not be in c.m.\ frame. [[radiated]]
	are the radiated particles (photon for ISR), and [[parton]] are the
	remainders which
	initiate the elementary process. These particles are copied verbatim
	from the event record, and must be collinear.

	The kinematical parameters are [[sqrts]] = invariant mass of the
	[[beam]] particles, [[q_max]] and [[m]] determining the $Q^2$
	distribution, and [[xc]]/[[xcb]] as the energy fraction (complement)
	of the partons, relative to the beams.

	Transformations: [[lti]] is the Lorentz transformation that would
	boosts [[pi]] (c.m. frame) back to the original [[beam]] momenta (lab
	frame). [[lto]] is the recoil transformation, transforming the partons
	after ISR from the collinear frame to the recoiling frame. [[lt]] is
	the combination of both, which is to be applied to all particles after
	the hard interaction.

	Momenta: [[pi]] are the beams transformed to their common c.m.\ frame.
	[[ki]] and [[qi]] are the photon/parton
	momenta in the [[pi]] c.m.\ frame. [[km]] and [[qm]] are the
	photon/parton momenta with the $Q$ distribution applied, and finally
	[[qo]] are the partons [[qm]] projected on-shell.
	<<ISR/EPA handler: public>>=
	public :: evt_isr_epa_t
	<<ISR/EPA handler: types>>=
	type, extends (evt_t) :: evt_isr_epa_t
	private
	integer :: mode = ISR_TRIVIAL_COLLINEAR
	logical :: isr_active = .false.
	logical :: epa_active = .false.
	real(default) :: isr_q_max = 0
	real(default) :: epa_q_max = 0
	real(default) :: isr_mass = 0
	real(default) :: epa_mass = 0
	real(default) :: sqrts = 0
	integer, dimension(2) :: rad_mode = BEAM_RAD_NONE
	real(default), dimension(2) :: q_max = 0
	real(default), dimension(2) :: m = 0
	real(default), dimension(2) :: xc = 0
	real(default), dimension(2) :: xcb = 0
	type(lorentz_transformation_t) :: lti = identity
	type(lorentz_transformation_t) :: lto = identity
	type(lorentz_transformation_t) :: lt = identity
	integer, dimension(2) :: i_beam = 0
	type(particle_t), dimension(2) :: beam
	type(vector4_t), dimension(2) :: pi
	integer, dimension(2) :: i_radiated = 0
	type(particle_t), dimension(2) :: radiated
	type(vector4_t), dimension(2) :: ki
	type(vector4_t), dimension(2) :: km
	integer, dimension(2) :: i_parton = 0
	type(particle_t), dimension(2) :: parton
	type(vector4_t), dimension(2) :: qi
	type(vector4_t), dimension(2) :: qm
	type(vector4_t), dimension(2) :: qo
	contains
	<<ISR/EPA handler: evt isr: TBP>>
	end type evt_isr_epa_t

	@ %def evt_isr_epa_t
	@
	\subsection{ISR/EPA distinction}
	<<ISR/EPA handler: parameters>>=
	integer, parameter, public :: BEAM_RAD_NONE = 0
	integer, parameter, public :: BEAM_RAD_ISR = 1
	integer, parameter, public :: BEAM_RAD_EPA = 2

	@ %def BEAM_RAD_NONE
	@ %def BEAM_RAD_ISR
	@ %def BEAM_RAD_EPA
	<<ISR/EPA handler: procedures>>=
	function rad_mode_string (mode) result (string)
	type(string_t) :: string
	integer, intent(in) :: mode
	select case (mode)
	case (BEAM_RAD_NONE); string = "---"
	case (BEAM_RAD_ISR); string = "ISR"
	case (BEAM_RAD_EPA); string = "EPA"
	case default; string = "???"
	end select
	end function rad_mode_string

	@ %def rad_mode_string
	@
	\subsection{Photon insertion modes}
	<<ISR/EPA handler: parameters>>=
	integer, parameter, public :: ISR_TRIVIAL_COLLINEAR = 0
	integer, parameter, public :: ISR_PAIR_RECOIL = 1

	@ %def ISR_TRIVIAL_COLLINEAR ISR_PAIR_RECOIL
	@
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: get_mode_string => evt_isr_epa_get_mode_string
	<<ISR/EPA handler: procedures>>=
	function evt_isr_epa_get_mode_string (evt) result (string)
	type(string_t) :: string
	class(evt_isr_epa_t), intent(in) :: evt
	select case (evt%mode)
	case (ISR_TRIVIAL_COLLINEAR)
	string = "trivial, collinear"
	case (ISR_PAIR_RECOIL)
	string = "pair recoil"
	case default
	string = "[undefined]"
	end select
	end function evt_isr_epa_get_mode_string

	@ %def evt_isr_epa_get_mode_string
	@ Set the numerical mode ID from a user-level string representation.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: set_mode_string => evt_isr_epa_set_mode_string
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_set_mode_string (evt, string)
	class(evt_isr_epa_t), intent(inout) :: evt
	type(string_t), intent(in) :: string
	select case (char (string))
	case ("trivial")
	evt%mode = ISR_TRIVIAL_COLLINEAR
	case ("recoil")
	evt%mode = ISR_PAIR_RECOIL
	case default
	call msg_fatal ("ISR handler: mode '" // char (string) &
	// "' is undefined")
	end select
	end subroutine evt_isr_epa_set_mode_string

	@ %def evt_isr_epa_set_mode_string
	@
	\subsection{Output}
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: write_name => evt_isr_epa_write_name
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_write_name (evt, unit)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: ISR/EPA handler"
	end subroutine evt_isr_epa_write_name

	@ %def evt_isr_epa_write_name
	@ The overall recoil-handling mode.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: write_mode => evt_isr_epa_write_mode
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_write_mode (evt, unit)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A,1x,I0,':',1x,A)") "Insertion mode =", evt%mode, &
	char (evt%get_mode_string ())
	end subroutine evt_isr_epa_write_mode

	@ %def evt_isr_epa_write_mode
	@ The input data for ISR and EPA, respectively.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: write_input => evt_isr_epa_write_input
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_write_input (evt, unit, testflag)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	character(len=7) :: fmt
	integer :: u
	u = given_output_unit (unit)
	call pac_fmt (fmt, FMT_19, FMT_12, testflag)
	if (evt%isr_active) then
	write (u, "(3x,A,1x," // fmt // ")") "ISR: Q_max =", evt%isr_q_max
	write (u, "(3x,A,1x," // fmt // ")") " m =", evt%isr_mass
	else
	write (u, "(3x,A)") "ISR: [inactive]"
	end if
	if (evt%epa_active) then
	write (u, "(3x,A,1x," // fmt // ")") "EPA: Q_max =", evt%epa_q_max
	write (u, "(3x,A,1x," // fmt // ")") " m =", evt%epa_mass
	else
	write (u, "(3x,A)") "EPA: [inactive]"
	end if
	end subroutine evt_isr_epa_write_input

	@ %def evt_isr_epa_write_input
	@ The trivial mode does not depend on any data, since it does nothing
	to the event.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: write_data => evt_isr_epa_write_data
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_write_data (evt, unit, testflag)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	character(len=7), parameter :: FMTL_19 = "A3,16x"
	character(len=7), parameter :: FMTL_12 = "A3,9x"
	character(len=7) :: fmt, fmtl
	integer :: u
	u = given_output_unit (unit)
	call pac_fmt (fmt, FMT_19, FMT_12, testflag)
	call pac_fmt (fmtl, FMTL_19, FMTL_12, testflag)
	select case (evt%mode)
	case (ISR_PAIR_RECOIL)
	write (u, "(1x,A)") "Event:"
	write (u, "(3x,A,2(1x," // fmtl // "))") &
	"mode = ", &
	char (rad_mode_string (evt%rad_mode(1))), &
	char (rad_mode_string (evt%rad_mode(2)))
	write (u, "(3x,A,2(1x," // fmt // "))") "Q_max =", evt%q_max
	write (u, "(3x,A,2(1x," // fmt // "))") "m =", evt%m
	write (u, "(3x,A,2(1x," // fmt // "))") "x =", evt%xc
	write (u, "(3x,A,2(1x," // fmt // "))") "xb =", evt%xcb
	write (u, "(3x,A,1x," // fmt // ")") "sqrts =", evt%sqrts
	call write_separator (u)
	write (u, "(A)") "Lorentz boost (partons before radiation &
	&c.m. -> lab) ="
	call evt%lti%write (u, testflag)
	write (u, "(A)") "Lorentz transformation (collinear partons &
	&-> partons with recoil in c.m.) ="
	call evt%lto%write (u, testflag)
	write (u, "(A)") "Combined transformation (partons &
	&-> partons with recoil in lab frame) ="
	call evt%lt%write (u, testflag)
	end select
	end subroutine evt_isr_epa_write_data

	@ %def evt_isr_epa_write_data
	@ Output method.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: write => evt_isr_epa_write
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_write (evt, unit, verbose, more_verbose, testflag)
	class(evt_isr_epa_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	logical :: show_mass
	integer :: u, i
	u = given_output_unit (unit)
	if (present (testflag)) then
	show_mass = .not. testflag
	else
	show_mass = .true.
	end if
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u, 2)
	call evt%write_mode (u)
	call evt%write_input (u, testflag=testflag)
	call evt%write_data (u, testflag=testflag)
	call write_separator (u)
	call evt%base_write (u, testflag = testflag, show_set = .false.)
	if (all (evt%i_beam > 0)) then
	call write_separator (u)
	write (u, "(A,2(1x,I0))") "Partons before radiation:", evt%i_beam
	do i = 1, 2
	call evt%beam(i)%write (u, testflag=testflag)
	end do
	call write_separator (u)
	write (u, "(A)") "... boosted to c.m.:"
	do i = 1, 2
	call evt%pi(i)%write (u, show_mass=show_mass, testflag=testflag)
	end do
	end if
	if (all (evt%i_radiated > 0)) then
	call write_separator (u)
	write (u, "(A,2(1x,I0))") "Radiated particles, collinear:", &
	evt%i_radiated
	do i = 1, 2
	call evt%radiated(i)%write (u, testflag=testflag)
	end do
	call write_separator (u)
	write (u, "(A)") "... boosted to c.m.:"
	do i = 1, 2
	call evt%ki(i)%write (u, show_mass=show_mass, testflag=testflag)
	end do
	call write_separator (u)
	write (u, "(A)") "... with kT:"
	do i = 1, 2
	call evt%km(i)%write (u, show_mass=show_mass, testflag=testflag)
	end do
	end if
	if (all (evt%i_parton > 0)) then
	call write_separator (u)
	write (u, "(A,2(1x,I0))") "Partons after radiation, collinear:", &
	evt%i_parton
	do i = 1, 2
	call evt%parton(i)%write (u, testflag=testflag)
	end do
	call write_separator (u)
	write (u, "(A)") "... boosted to c.m.:"
	do i = 1, 2
	call evt%qi(i)%write (u, show_mass=show_mass, testflag=testflag)
	end do
	call write_separator (u)
	write (u, "(A)") "... with qT, off-shell:"
	do i = 1, 2
	call evt%qm(i)%write (u, show_mass=show_mass, testflag=testflag)
	end do
	call write_separator (u)
	write (u, "(A)") "... projected on-shell:"
	do i = 1, 2
	call evt%qo(i)%write (u, show_mass=show_mass, testflag=testflag)
	end do
	call write_separator (u)
	end if
	if (evt%particle_set_exists) &
	call evt%particle_set%write &
	(u, summary = .true., compressed = .true., testflag = testflag)
	call write_separator (u)
	end subroutine evt_isr_epa_write

	@ %def evt_isr_epa_write
	@
	\subsection{Initialization}
	Manually import a random-number generator object. This should be
	done only for testing purposes. The standard procedure is to
	[[connect]] a process to an event transform; this will create an
	appropriate [[rng]] from the RNG factory in the process object.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: import_rng => evt_isr_epa_import_rng
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_import_rng (evt, rng)
	class(evt_isr_epa_t), intent(inout) :: evt
	class(rng_t), allocatable, intent(inout) :: rng
	call move_alloc (from = rng, to = evt%rng)
	end subroutine evt_isr_epa_import_rng

	@ %def evt_isr_epa_import_rng
	@ Set constant kinematics limits and initialize for ISR. Note that [[sqrts]]
	is used only as the fallback value for [[q_max]]. The actual [[sqrts]] value
	for the transform object is inferred from the incoming particles, event by
	event.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: set_data_isr => evt_isr_epa_set_data_isr
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_set_data_isr (evt, sqrts, q_max, m)
	class(evt_isr_epa_t), intent(inout) :: evt
	real(default), intent(in) :: sqrts
	real(default), intent(in) :: q_max
	real(default), intent(in) :: m
	if (sqrts <= 0) then
	call msg_fatal ("ISR handler: sqrts value must be positive")
	end if
	if (q_max <= 0 .or. q_max > sqrts) then
	evt%isr_q_max = sqrts
	else
	evt%isr_q_max = q_max
	end if
	if (m > 0) then
	evt%isr_mass = m
	else
	call msg_fatal ("ISR handler: ISR_mass value must be positive")
	end if
	evt%isr_active = .true.
	end subroutine evt_isr_epa_set_data_isr

	@ %def evt_isr_epa_set_data_isr
	@ Set constant kinematics limits and initialize for EPA. Note that [[sqrts]] is
	used only as the fallback value for [[q_max]]. The actual [[sqrts]]
	value for the transform object is inferred from the incoming
	particles, event by event.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: set_data_epa => evt_isr_epa_set_data_epa
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_set_data_epa (evt, sqrts, q_max, m)
	class(evt_isr_epa_t), intent(inout) :: evt
	real(default), intent(in) :: sqrts
	real(default), intent(in) :: q_max
	real(default), intent(in) :: m
	if (sqrts <= 0) then
	call msg_fatal ("EPA handler: sqrts value must be positive")
	end if
	if (q_max <= 0 .or. q_max > sqrts) then
	evt%epa_q_max = sqrts
	else
	evt%epa_q_max = q_max
	end if
	if (m > 0) then
	evt%epa_mass = m
	else
	call msg_fatal ("EPA handler: EPA_mass value must be positive")
	end if
	evt%epa_active = .true.
	end subroutine evt_isr_epa_set_data_epa

	@ %def evt_isr_epa_set_data_epa
	@
	\subsection{Fetch event data}
	Identify the radiated particles and the recoil momenta in the
	particle set. Without much sophistication, start from the end and
	find particles with the ``remnant'' status. Their parents should point to
	the recoiling parton. If successful, set the particle indices in the
	[[evt]] object, for further processing.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure, private :: identify_radiated
	<<ISR/EPA handler: procedures>>=
	subroutine identify_radiated (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer :: i, k
	k = 2
	FIND_LAST_RADIATED: do i = evt%particle_set%get_n_tot (), 1, -1
	associate (prt => evt%particle_set%prt(i))
	if (prt%is_beam_remnant ()) then
	evt%i_radiated(k) = i
	evt%radiated(k) = prt
	k = k - 1
	if (k == 0) exit FIND_LAST_RADIATED
	end if
	end associate
	end do FIND_LAST_RADIATED
	if (k /= 0) call err_count
	contains
	subroutine err_count
	call evt%particle_set%write ()
	call msg_fatal ("ISR/EPA handler: &
	&event does not contain two radiated particles")
	end subroutine err_count
	end subroutine identify_radiated

	@ %def identify_radiated
	@ When the radiated particles are known, we can fetch their parent
	particles and ask for the other child, the incoming parton.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure, private :: identify_partons
	<<ISR/EPA handler: procedures>>=
	subroutine identify_partons (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer, dimension(:), allocatable :: parent, child
	integer :: i, j
	if (all (evt%i_radiated > 0)) then
	do i = 1, 2
	parent = evt%radiated(i)%get_parents ()
	if (size (parent) /= 1) call err_mismatch
	evt%i_beam(i) = parent(1)
	evt%beam(i) = evt%particle_set%prt(parent(1))
	associate (prt => evt%beam(i))
	child = prt%get_children ()
	if (size (child) /= 2) call err_mismatch
	do j = 1, 2
	if (child(j) /= evt%i_radiated(i)) then
	evt%i_parton(i) = child(j)
	evt%parton(i) = evt%particle_set%prt(child(j))
	end if
	end do
	end associate
	end do
	end if
	contains
	subroutine err_mismatch
	call evt%particle_set%write ()
	call msg_bug ("ISR/EPA handler: mismatch in parent-child relations")
	end subroutine err_mismatch
	end subroutine identify_partons

	@ %def identify_partons
	@ Check whether the radiated particle is a photon, or the incoming
	parton is a photon. Then set the ISR/EPA switch appropriately, for
	each beam.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: check_radiation => evt_isr_epa_check_radiation
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_check_radiation (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	type(flavor_t) :: flv
	integer :: i
	do i = 1, 2
	flv = evt%radiated(i)%get_flv ()
	if (flv%get_pdg () == PHOTON) then
	if (evt%isr_active) then
	evt%rad_mode(i) = BEAM_RAD_ISR
	else
	call err_isr_init
	end if
	else
	flv = evt%parton(i)%get_flv ()
	if (flv%get_pdg () == PHOTON) then
	if (evt%epa_active) then
	evt%rad_mode(i) = BEAM_RAD_EPA
	else
	call err_epa_init
	end if
	else
	call err_no_photon
	end if
	end if
	end do
	contains
	subroutine err_isr_init
	call evt%particle_set%write ()
	call msg_fatal ("ISR/EPA handler: &
	&event contains radiated photon, but ISR is not initialized")
	end subroutine err_isr_init
	subroutine err_epa_init
	call evt%particle_set%write ()
	call msg_fatal ("ISR/EPA handler: &
	&event contains incoming photon, but EPA is not initialized")
	end subroutine err_epa_init
	subroutine err_no_photon
	call evt%particle_set%write ()
	call msg_fatal ("ISR/EPA handler: &
	&event does not appear to be ISR or EPA - missing photon")
	end subroutine err_no_photon
	end subroutine evt_isr_epa_check_radiation

	@ %def evt_isr_epa_check_radiation
	@ Internally set the appropriate parameters (ISR/EPA) for the two
	beams in the recoil mode.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: set_recoil_parameters => evt_isr_epa_set_recoil_parameters
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_set_recoil_parameters (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer :: i
	do i = 1, 2
	select case (evt%rad_mode(i))
	case (BEAM_RAD_ISR)
	evt%q_max(i) = evt%isr_q_max
	evt%m(i) = evt%isr_mass
	case (BEAM_RAD_EPA)
	evt%q_max(i) = evt%epa_q_max
	evt%m(i) = evt%epa_mass
	end select
	end do
	end subroutine evt_isr_epa_set_recoil_parameters

	@ %def evt_isr_epa_set_recoil_parameters
	@ Boost the particles that participate in ISR to their proper
	c.m.\ frame, copying the momenta to [[pi]], [[ki]], [[qi]]. Also
	assign [[sqrts]] properly.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure, private :: boost_to_cm
	<<ISR/EPA handler: procedures>>=
	subroutine boost_to_cm (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	type(vector4_t), dimension(2) :: p
	type(vector4_t), dimension(2) :: k
	type(vector4_t), dimension(2) :: q
	logical :: ok
	p = evt%beam%get_momentum ()
	k = evt%radiated%get_momentum ()
	q = evt%parton%get_momentum ()
	call initial_transformation (p, evt%sqrts, evt%lti, ok)
	if (.not. ok) call err_non_collinear
	evt%pi = inverse (evt%lti) * p
	evt%ki = inverse (evt%lti) * k
	evt%qi = inverse (evt%lti) * q
	contains
	subroutine err_non_collinear
	call evt%particle_set%write ()
	call msg_fatal ("ISR/EPA handler: &
	&partons before radiation are not collinear")
	end subroutine err_non_collinear
	end subroutine boost_to_cm

	@ %def boost_to_cm
	@ We can infer the $x$ and $\bar x$ values of the event by looking at
	the energy fractions of the radiated particles and incoming partons,
	respectively, relative to their
	parents. Of course, we must assume that they are all collinear, and
	that energy is conserved.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure, private :: infer_x
	<<ISR/EPA handler: procedures>>=
	subroutine infer_x (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	real(default) :: E_parent, E_radiated, E_parton
	integer :: i
	if (all (evt%i_radiated > 0)) then
	do i = 1, 2
	E_parent = energy (evt%pi(i))
	E_radiated = energy (evt%ki(i))
	E_parton = energy (evt%qi(i))
	if (E_parent > 0) then
	evt%xc(i) = E_parton / E_parent
	evt%xcb(i)= E_radiated / E_parent
	else
	call err_energy
	end if
	end do
	end if
	contains
	subroutine err_energy
	call evt%particle_set%write ()
	call msg_bug ("ISR/EPA handler: non-positive energy in splitting")
	end subroutine err_energy
	end subroutine infer_x

	@ %def infer_x
	@
	\subsection{Two-parton recoil}
	For transforming partons into recoil momenta, we make use of the
	routines in the [[recoil_kinematics]] module. In addition to the
	collinear momenta, we use the $x$ energy fractions, and four numbers
	from the RNG.

	There is one subtle difference w.r.t.\ ISR case: the EPA mass
	parameter is multiplied by the energy fraction $x$, separately for
	each beam. This is the effective lower $Q$ cutoff.

	For certain kinematics, close to the $Q_\text{max}$ endpoint, this may
	fail, and [[ok]] is set to false. In that case, we should generate
	new recoil momenta for the same event. This is handled by the generic
	unweighting procedure.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure, private :: generate_recoil => evt_generate_recoil
	<<ISR/EPA handler: procedures>>=
	subroutine evt_generate_recoil (evt, ok)
	class(evt_isr_epa_t), intent(inout) :: evt
	logical, intent(out) :: ok
	real(default), dimension(4) :: r
	real(default), dimension(2) :: m
	integer :: i
	call evt%rng%generate (r)
	do i = 1, 2
	select case (evt%rad_mode(i))
	case (BEAM_RAD_ISR); m(i) = evt%m(i)
	case (BEAM_RAD_EPA); m(i) = evt%xc(i) * evt%m(i)
	case default; m(i) = 0
	end select
	end do
	call generate_recoil (evt%sqrts, evt%q_max, m, evt%xc, evt%xcb, r, &
	evt%km, evt%qm, evt%qo, ok)
	end subroutine evt_generate_recoil

	@ %def evt_generate_recoil
	@ Replace the collinear radiated (incoming) parton momenta by the
	momenta that we
	have generated, respectively. Recall that the recoil has been applied
	in the c.m.\ system of the partons before ISR, so we apply the stored
	Lorentz transformation to boost them to the lab frame.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure, private :: replace_radiated
	procedure, private :: replace_partons
	<<ISR/EPA handler: procedures>>=
	subroutine replace_radiated (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer :: i
	do i = 1, 2
	associate (prt => evt%particle_set%prt(evt%i_radiated(i)))
	call prt%set_momentum (evt%lti * evt%km(i))
	end associate
	end do
	end subroutine replace_radiated

	subroutine replace_partons (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer :: i
	do i = 1, 2
	associate (prt => evt%particle_set%prt(evt%i_parton(i)))
	call prt%set_momentum (evt%lti * evt%qo(i))
	end associate
	end do
	end subroutine replace_partons

	@ %def replace_radiated
	@ %def replace_partons
	@
	\subsection{Transform the event}
	Knowing the new incoming partons for the elementary process, we can
	make use of another procedure in [[recoil_kinematics]] to determine
	the Lorentz transformation that transforms the collinear frame into
	the frame with transverse momentum. We apply this transformation,
	recursively, to all particles that originate from those incoming
	partons in the original particle set.

	We have to allow for the pre-ISR partons being not in their common
	c.m.\ frame. Taking into account non-commutativity, we actually have
	to first transform the outgoing particles to that c.m.\ frame, then
	apply the recoil transformation, then boost back to the lab frame.

	The [[mask]] keep track of particles that we transform, just in case
	the parent-child tree is multiply connected.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: transform_outgoing => evt_transform_outgoing
	<<ISR/EPA handler: procedures>>=
	subroutine evt_transform_outgoing (evt)
	class(evt_isr_epa_t), intent(inout) :: evt
	logical, dimension(:), allocatable :: mask
	call recoil_transformation (evt%sqrts, evt%xc, evt%qo, evt%lto)
	evt%lt = evt%lti * evt%lto * inverse (evt%lti)
	allocate (mask (evt%particle_set%get_n_tot ()), source=.false.)
	call transform_children (evt%i_parton(1))
	contains
	recursive subroutine transform_children (i)
	integer, intent(in) :: i
	integer :: j, n_child, c
	integer, dimension(:), allocatable :: child
	child = evt%particle_set%prt(i)%get_children ()
	do j = 1, size (child)
	c = child(j)
	if (.not. mask(c)) then
	associate (prt => evt%particle_set%prt(c))
	call prt%set_momentum (evt%lt * prt%get_momentum ())
	mask(c) = .true.
	call transform_children (c)
	end associate
	end if
	end do
	end subroutine transform_children
	end subroutine evt_transform_outgoing

	@ %def evt_transform_outgoing
	@
	\subsection{Implemented methods}
	Here we take the particle set from the previous event transform and
	copy it, then generate the transverse momentum for the radiated
	particles and for
	the incoming partons. If this fails (rarely, for large $p_T$),
	return zero for the probability, to trigger another try.

	NOTE: The boost for the initial partonic system, if not in the
	c.m.\ frame, has not been implemented yet.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: generate_weighted => &
	evt_isr_epa_generate_weighted
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_generate_weighted (evt, probability)
	class(evt_isr_epa_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	logical :: valid
	call evt%particle_set%final ()
	evt%particle_set = evt%previous%particle_set
	evt%particle_set_exists = .true.
	select case (evt%mode)
	case (ISR_TRIVIAL_COLLINEAR)
	probability = 1
	valid = .true.
	case (ISR_PAIR_RECOIL)
	call evt%identify_radiated ()
	call evt%identify_partons ()
	call evt%check_radiation ()
	call evt%set_recoil_parameters ()
	call evt%boost_to_cm ()
	call evt%infer_x ()
	call evt%generate_recoil (valid)
	if (valid) then
	probability = 1
	else
	probability = 0
	end if
	case default
	call msg_bug ("ISR/EPA handler: generate weighted: unsupported mode")
	end select
	evt%particle_set_exists = .false.
	end subroutine evt_isr_epa_generate_weighted

	@ %def evt_isr_epa_generate_weighted
	@ Insert the generated radiated particles and incoming partons with
	$p_T$ in their respective places.

	The factorization parameters are irrelevant.
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: make_particle_set => &
	evt_isr_epa_make_particle_set
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	select case (evt%mode)
	case (ISR_TRIVIAL_COLLINEAR)
	case (ISR_PAIR_RECOIL)
	call evt%replace_radiated ()
	call evt%replace_partons ()
	call evt%transform_outgoing ()
	case default
	call msg_bug ("ISR/EPA handler: make particle set: unsupported mode")
	end select
	evt%particle_set_exists = .true.
	end subroutine evt_isr_epa_make_particle_set

	@ %def event_isr_epa_handler_make_particle_set
	@
	<<ISR/EPA handler: evt isr: TBP>>=
	procedure :: prepare_new_event => &
	evt_isr_epa_prepare_new_event
	<<ISR/EPA handler: procedures>>=
	subroutine evt_isr_epa_prepare_new_event (evt, i_mci, i_term)
	class(evt_isr_epa_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	call evt%reset ()
	end subroutine evt_isr_epa_prepare_new_event

	@ %def evt_isr_epa_prepare_new_event
	@
	\subsection{Unit tests: ISR}
	Test module, followed by the corresponding implementation module.

	This test module differs from most of the other test modules, since it
	contains two test subroutines: one for ISR and one for EPA below.
	<<[[isr_epa_handler_ut.f90]]>>=
	<<File header>>

	module isr_epa_handler_ut
	use unit_tests
	use isr_epa_handler_uti

	<<Standard module head>>

	<<ISR/EPA handler: public test>>

	contains

	<<ISR/EPA handler: test driver>>

	end module isr_epa_handler_ut
	@ %def isr_epa_handler_ut
	@
	<<[[isr_epa_handler_uti.f90]]>>=
	<<File header>>

	module isr_epa_handler_uti

	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use os_interface
	use lorentz, only: vector4_t, vector4_moving, operator(*)
	use rng_base, only: rng_t
	use models, only: syntax_model_file_init, syntax_model_file_final
	use models, only: model_list_t, model_t
	use particles, only: particle_set_t

	use event_transforms
	use isr_epa_handler, only: evt_isr_epa_t

	use rng_base_ut, only: rng_test_t

	<<Standard module head>>

	<<ISR/EPA handler: test declarations>>

	contains

	<<ISR/EPA handler: tests>>

	end module isr_epa_handler_uti

	@ %def isr_epa_handler_uti
	@ API: driver for the unit tests below.
	<<ISR/EPA handler: public test>>=
	public :: isr_handler_test
	<<ISR/EPA handler: test driver>>=
	subroutine isr_handler_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<ISR/EPA handler: execute ISR tests>>
	end subroutine isr_handler_test

	@ %def isr_handler_test
	@
	\subsubsection{Trivial case}
	Handle photons resulting from ISR radiation. This test is for the
	trivial case where the event is kept collinear.
	<<ISR/EPA handler: execute ISR tests>>=
	call test (isr_handler_1, "isr_handler_1", &
	"collinear case, no modification", &
	u, results)
	<<ISR/EPA handler: test declarations>>=
	public :: isr_handler_1
	<<ISR/EPA handler: tests>>=
	subroutine isr_handler_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(evt_trivial_t), target :: evt_trivial
	type(evt_isr_epa_t), target :: evt_isr_epa
	type(vector4_t), dimension(8) :: p
	real(default) :: sqrts
	real(default), dimension(2) :: x, xb
	real(default) :: probability

	write (u, "(A)") "* Test output: isr_handler_1"
	write (u, "(A)") "* Purpose: apply photon handler trivially (no-op)"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 11, -11, 22, 22, 13, -13], model = model)

	sqrts = 100._default
	x = [0.6_default, 0.9_default]
	xb= 1 - x

	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	p(3:4) = x * p(1:2)
	p(5:6) = xb * p(1:2)
	p(7:8) = p(3:4)

	call pset%set_momentum (p, on_shell = .false.)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Initialize ISR handler transform"
	write (u, "(A)")

	evt_trivial%next => evt_isr_epa
	evt_isr_epa%previous => evt_trivial

	call evt_isr_epa%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill ISR handler transform"
	write (u, "(A)")

	call evt_isr_epa%prepare_new_event (1, 1)
	call evt_isr_epa%generate_weighted (probability)
	call evt_isr_epa%make_particle_set (0, .false.)

	call evt_isr_epa%write (u)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_isr_epa%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: isr_handler_1"

	end subroutine isr_handler_1

	@ %def isr_handler_1
	@
	\subsubsection{Photon pair with recoil}
	Handle photons resulting from ISR radiation. This test invokes the
	two-photon recoil mechanism. Both photons acquire transverse
	momentum, the parton momenta recoil, such that total energy-momentum
	is conserved, and all outgoing photons and partons are on-shell
	(massless).
	<<ISR/EPA handler: execute ISR tests>>=
	call test (isr_handler_2, "isr_handler_2", &
	"two-photon recoil", &
	u, results)
	<<ISR/EPA handler: test declarations>>=
	public :: isr_handler_2
	<<ISR/EPA handler: tests>>=
	subroutine isr_handler_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(evt_trivial_t), target :: evt_trivial
	type(evt_isr_epa_t), target :: evt_isr_epa
	type(vector4_t), dimension(8) :: p
	real(default) :: sqrts
	real(default), dimension(2) :: x, xb
	class(rng_t), allocatable :: rng
	real(default) :: probability

	write (u, "(A)") "* Test output: isr_handler_2"
	write (u, "(A)") "* Purpose: apply photon handler with two-photon recoil"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 11, -11, 22, 22, 13, -13], model = model)

	sqrts = 100._default
	x = [0.6_default, 0.9_default]
	xb= 1 - x

	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	p(3:4) = x * p(1:2)
	p(5:6) = xb * p(1:2)
	p(7:8) = p(3:4)

	call pset%set_momentum (p, on_shell = .false.)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Initialize ISR handler transform"
	write (u, "(A)")

	evt_trivial%next => evt_isr_epa
	evt_isr_epa%previous => evt_trivial

	call evt_isr_epa%set_mode_string (var_str ("recoil"))
	call evt_isr_epa%set_data_isr ( &
	sqrts = sqrts, &
	q_max = sqrts, &
	m = 511.e-3_default &
	)

	allocate (rng_test_t :: rng)
	call rng%init (3) ! default would produce pi for azimuthal angle
	call evt_isr_epa%import_rng (rng)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Fill ISR handler transform"
	write (u, "(A)")

	call evt_isr_epa%prepare_new_event (1, 1)
	call evt_isr_epa%generate_weighted (probability)
	call evt_isr_epa%make_particle_set (0, .false.)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_isr_epa%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: isr_handler_2"

	end subroutine isr_handler_2

	@ %def isr_handler_2
	@
	\subsubsection{Boosted beams}
	Handle photons resulting from ISR radiation. This test invokes the
	two-photon recoil mechanism, in the case that the partons before ISR
	are not in their c.m.\ frame (but collinear).
	<<ISR/EPA handler: execute ISR tests>>=
	call test (isr_handler_3, "isr_handler_3", &
	"two-photon recoil with boost", &
	u, results)
	<<ISR/EPA handler: test declarations>>=
	public :: isr_handler_3
	<<ISR/EPA handler: tests>>=
	subroutine isr_handler_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(evt_trivial_t), target :: evt_trivial
	type(evt_isr_epa_t), target :: evt_isr_epa
	type(vector4_t), dimension(8) :: p
	real(default) :: sqrts
	real(default), dimension(2) :: x0
	real(default), dimension(2) :: x, xb
	class(rng_t), allocatable :: rng
	real(default) :: probability

	write (u, "(A)") "* Test output: isr_handler_3"
	write (u, "(A)") "* Purpose: apply photon handler for boosted beams &
	&and two-photon recoil"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 11, -11, 22, 22, 13, -13], model = model)

	write (u, "(A)") "* Event data"
	write (u, "(A)")

	sqrts = 100._default
	write (u, "(A,2(1x,F12.7))") "sqrts =", sqrts

	x0 = [0.9_default, 0.4_default]
	write (u, "(A,2(1x,F12.7))") "x0 =", x0

	write (u, "(A)")
	write (u, "(A,2(1x,F12.7))") "sqs_hat =", sqrts * sqrt (product (x0))

	x = [0.6_default, 0.9_default]
	xb= 1 - x
	write (u, "(A,2(1x,F12.7))") "x =", x

	write (u, "(A)")
	write (u, "(A,2(1x,F12.7))") "x0 * x =", x0 * x

	p(1) = x0(1) * vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = x0(2) * vector4_moving (sqrts/2,-sqrts/2, 3)
	p(3:4) = x * p(1:2)
	p(5:6) = xb * p(1:2)
	p(7:8) = p(3:4)

	call pset%set_momentum (p, on_shell = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Initialize ISR handler transform"
	write (u, "(A)")

	evt_trivial%next => evt_isr_epa
	evt_isr_epa%previous => evt_trivial

	call evt_isr_epa%set_mode_string (var_str ("recoil"))
	call evt_isr_epa%set_data_isr ( &
	sqrts = sqrts, &
	q_max = sqrts, &
	m = 511.e-3_default &
	)

	allocate (rng_test_t :: rng)
	call rng%init (3) ! default would produce pi for azimuthal angle
	call evt_isr_epa%import_rng (rng)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Fill ISR handler transform"
	write (u, "(A)")

	call evt_isr_epa%prepare_new_event (1, 1)
	call evt_isr_epa%generate_weighted (probability)
	call evt_isr_epa%make_particle_set (0, .false.)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_isr_epa%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: isr_handler_3"

	end subroutine isr_handler_3

	@ %def isr_handler_3
	@
	\subsection{Unit tests: EPA}
	API: Extra driver for the unit tests below.
	<<ISR/EPA handler: public test>>=
	public :: epa_handler_test
	<<ISR/EPA handler: test driver>>=
	subroutine epa_handler_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<ISR/EPA handler: execute EPA tests>>
	end subroutine epa_handler_test

	@ %def epa_handler_test
	@
	\subsubsection{Trivial case}
	Handle events resulting from the EPA approximation. This test is for the
	trivial case where the event is kept collinear.
	<<ISR/EPA handler: execute EPA tests>>=
	call test (epa_handler_1, "epa_handler_1", &
	"collinear case, no modification", &
	u, results)
	<<ISR/EPA handler: test declarations>>=
	public :: epa_handler_1
	<<ISR/EPA handler: tests>>=
	subroutine epa_handler_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(evt_trivial_t), target :: evt_trivial
	type(evt_isr_epa_t), target :: evt_isr_epa
	type(vector4_t), dimension(8) :: p
	real(default) :: sqrts
	real(default), dimension(2) :: x, xb
	real(default) :: probability

	write (u, "(A)") "* Test output: epa_handler_1"
	write (u, "(A)") "* Purpose: apply beam handler trivially (no-op)"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct &
	(n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 22, 22, 11, -11, 13, -13], &
	model = model)

	sqrts = 100._default
	x = [0.6_default, 0.9_default]
	xb= 1 - x

	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	p(3:4) = x * p(1:2)
	p(5:6) = xb * p(1:2)
	p(7:8) = p(3:4)

	call pset%set_momentum (p, on_shell = .false.)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Initialize EPA handler transform"
	write (u, "(A)")

	evt_trivial%next => evt_isr_epa
	evt_isr_epa%previous => evt_trivial

	call evt_isr_epa%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill EPA handler transform"
	write (u, "(A)")

	call evt_isr_epa%prepare_new_event (1, 1)
	call evt_isr_epa%generate_weighted (probability)
	call evt_isr_epa%make_particle_set (0, .false.)

	call evt_isr_epa%write (u)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_isr_epa%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: epa_handler_1"

	end subroutine epa_handler_1

	@ %def epa_handler_1
	@
	\subsubsection{Beam pair with recoil}
	Handle beams resulting from the EPA approximation. This test invokes the
	two-beam recoil mechanism. Both beam remnants acquire transverse
	momentum, the photon momenta recoil, such that total energy-momentum
	is conserved, and all outgoing beam remnants and photons are on-shell
	(massless).
	<<ISR/EPA handler: execute EPA tests>>=
	call test (epa_handler_2, "epa_handler_2", &
	"two-beam recoil", &
	u, results)
	<<ISR/EPA handler: test declarations>>=
	public :: epa_handler_2
	<<ISR/EPA handler: tests>>=
	subroutine epa_handler_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(evt_trivial_t), target :: evt_trivial
	type(evt_isr_epa_t), target :: evt_isr_epa
	type(vector4_t), dimension(8) :: p
	real(default) :: sqrts
	real(default), dimension(2) :: x, xb
	class(rng_t), allocatable :: rng
	real(default) :: probability

	write (u, "(A)") "* Test output: epa_handler_2"
	write (u, "(A)") "* Purpose: apply beam handler with two-beam recoil"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 22, 22, 11, -11, 13, -13], model = model)

	sqrts = 100._default
	x = [0.6_default, 0.9_default]
	xb= 1 - x

	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	p(3:4) = x * p(1:2)
	p(5:6) = xb * p(1:2)
	p(7:8) = p(3:4)

	call pset%set_momentum (p, on_shell = .false.)

	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Initialize EPA handler transform"
	write (u, "(A)")

	evt_trivial%next => evt_isr_epa
	evt_isr_epa%previous => evt_trivial

	call evt_isr_epa%set_mode_string (var_str ("recoil"))
	call evt_isr_epa%set_data_epa ( &
	sqrts = sqrts, &
	q_max = sqrts, &
	m = 511.e-3_default &
	)

	allocate (rng_test_t :: rng)
	call rng%init (3) ! default would produce pi for azimuthal angle
	call evt_isr_epa%import_rng (rng)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Fill EPA handler transform"
	write (u, "(A)")

	call evt_isr_epa%prepare_new_event (1, 1)
	call evt_isr_epa%generate_weighted (probability)
	call evt_isr_epa%make_particle_set (0, .false.)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_isr_epa%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: epa_handler_2"

	end subroutine epa_handler_2

	@ %def epa_handler_2
	@
	\subsubsection{Boosted beams}
	Handle radiated beam remnants resulting from EPA radiation. This test
	invokes the two-beam recoil mechanism, in the case that the partons
	before EPA are not in their c.m.\ frame (but collinear).
	<<ISR/EPA handler: execute EPA tests>>=
	call test (epa_handler_3, "epa_handler_3", &
	"two-beam recoil with boost", &
	u, results)
	<<ISR/EPA handler: test declarations>>=
	public :: epa_handler_3
	<<ISR/EPA handler: tests>>=
	subroutine epa_handler_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(particle_set_t) :: pset
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(evt_trivial_t), target :: evt_trivial
	type(evt_isr_epa_t), target :: evt_isr_epa
	type(vector4_t), dimension(8) :: p
	real(default) :: sqrts
	real(default), dimension(2) :: x0
	real(default), dimension(2) :: x, xb
	class(rng_t), allocatable :: rng
	real(default) :: probability

	write (u, "(A)") "* Test output: epa_handler_3"
	write (u, "(A)") "* Purpose: apply beam handler for boosted beams &
	&and two-beam recoil"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM"), var_str ("SM.mdl"), &
	os_data, model)

	write (u, "(A)") "* Initialize particle set"
	write (u, "(A)")

	call pset%init_direct (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
	pdg = [11, -11, 22, 22, 11, -11, 13, -13], model = model)

	write (u, "(A)") "* Event data"
	write (u, "(A)")

	sqrts = 100._default
	write (u, "(A,2(1x,F12.7))") "sqrts =", sqrts

	x0 = [0.9_default, 0.4_default]
	write (u, "(A,2(1x,F12.7))") "x0 =", x0

	write (u, "(A)")
	write (u, "(A,2(1x,F12.7))") "sqs_hat =", sqrts * sqrt (product (x0))

	x = [0.6_default, 0.9_default]
	xb= 1 - x
	write (u, "(A,2(1x,F12.7))") "x =", x

	write (u, "(A)")
	write (u, "(A,2(1x,F12.7))") "x0 * x =", x0 * x

	p(1) = x0(1) * vector4_moving (sqrts/2, sqrts/2, 3)
	p(2) = x0(2) * vector4_moving (sqrts/2,-sqrts/2, 3)
	p(3:4) = x * p(1:2)
	p(5:6) = xb * p(1:2)
	p(7:8) = p(3:4)

	call pset%set_momentum (p, on_shell = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Fill trivial event transform"
	write (u, "(A)")

	call evt_trivial%reset ()
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)
	call write_separator (u, 2)

	write (u, "(A)")
	write (u, "(A)") "* Initialize EPA handler transform"
	write (u, "(A)")

	evt_trivial%next => evt_isr_epa
	evt_isr_epa%previous => evt_trivial

	call evt_isr_epa%set_mode_string (var_str ("recoil"))
	call evt_isr_epa%set_data_epa ( &
	sqrts = sqrts, &
	q_max = sqrts, &
	m = 511.e-3_default &
	)

	allocate (rng_test_t :: rng)
	call rng%init (3) ! default would produce pi for azimuthal angle
	call evt_isr_epa%import_rng (rng)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Fill EPA handler transform"
	write (u, "(A)")

	call evt_isr_epa%prepare_new_event (1, 1)
	call evt_isr_epa%generate_weighted (probability)
	call evt_isr_epa%make_particle_set (0, .false.)

	call evt_isr_epa%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A,1x,F8.5)") "Event probability =", probability

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_isr_epa%final ()
	call evt_trivial%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: epa_handler_3"

	end subroutine epa_handler_3

	@ %def epa_handler_3
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Decays}
	<<[[decays.f90]]>>=
	<<File header>>

	module decays

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_utils, only: write_indent, write_separator
	use format_defs, only: FMT_15
	use numeric_utils
	use diagnostics
	use flavors
	use helicities
	use quantum_numbers
	use interactions
	use evaluators
	use variables, only: var_list_t
	use model_data
	use rng_base
	use selectors
	use parton_states
	use process, only: process_t
	use instances, only: process_instance_t, pacify
	use process_stacks
	use event_transforms

	<<Standard module head>>

	<<Decays: public>>

	<<Decays: types>>

	<<Decays: interfaces>>

	contains

	<<Decays: procedures>>

	end module decays

	@ %def decays
	@
	\subsection{Final-State Particle Configuration}
	A final-state particle may be either stable or unstable. Here is an
	empty abstract type as the parent of both, with holds just the flavor
	information.
	<<Decays: types>>=
	type, abstract :: any_config_t
	private
	contains
	<<Decays: any config: TBP>>
	end type any_config_t

	@ %def any_config_t
	@ Finalizer, depends on the implementation.
	<<Decays: any config: TBP>>=
	procedure (any_config_final), deferred :: final
	<<Decays: interfaces>>=
	interface
	subroutine any_config_final (object)
	import
	class(any_config_t), intent(inout) :: object
	end subroutine any_config_final
	end interface

	@ %def any_config_final
	@ The output is also deferred:
	<<Decays: any config: TBP>>=
	procedure (any_config_write), deferred :: write
	<<Decays: interfaces>>=
	interface
	subroutine any_config_write (object, unit, indent, verbose)
	import
	class(any_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	end subroutine any_config_write
	end interface

	@ %def any_config_write
	@ This is a container for a stable or unstable particle configurator.
	We need this wrapper for preparing arrays that mix stable and unstable
	particles.
	<<Decays: types>>=
	type :: particle_config_t
	private
	class(any_config_t), allocatable :: c
	end type particle_config_t

	@ %def particle_config_t
	@
	\subsection{Final-State Particle}
	In theory, for the particle instance we only need to consider the
	unstable case. However, it is more straightforward to treat
	configuration and instance on the same footing, and to introduce a
	wrapper for particle objects as above. This also works
	around a compiler bug in gfortran.
	<<Decays: types>>=
	type, abstract :: any_t
	private
	contains
	<<Decays: any: TBP>>
	end type any_t

	@ %def any_t
	@ Finalizer, depends on the implementation.
	<<Decays: any: TBP>>=
	procedure (any_final), deferred :: final
	<<Decays: interfaces>>=
	interface
	subroutine any_final (object)
	import
	class(any_t), intent(inout) :: object
	end subroutine any_final
	end interface

	@ %def any_final
	@ The output is also deferred:
	<<Decays: any: TBP>>=
	procedure (any_write), deferred :: write
	<<Decays: interfaces>>=
	interface
	subroutine any_write (object, unit, indent)
	import
	class(any_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	end subroutine any_write
	end interface

	@ %def any_write
	@ This is a container for a stable or unstable outgoing particle.
	We need this wrapper for preparing arrays that mix stable and unstable
	particles.
	<<Decays: types>>=
	type :: particle_out_t
	private
	class(any_t), allocatable :: c
	end type particle_out_t

	@ %def particle_config_t
	@
	\subsection{Decay Term Configuration}
	A decay term is a distinct final state, corresponding to a process
	term. Each decay process may give rise to several terms with,
	possibly, differing flavor content.
	<<Decays: types>>=
	type :: decay_term_config_t
	private
	type(particle_config_t), dimension(:), allocatable :: prt
	contains
	<<Decays: decay term config: TBP>>
	end type decay_term_config_t

	@ %def decay_term_config_t
	@ Finalizer, recursive.
	<<Decays: decay term config: TBP>>=
	procedure :: final => decay_term_config_final
	<<Decays: procedures>>=
	recursive subroutine decay_term_config_final (object)
	class(decay_term_config_t), intent(inout) :: object
	integer :: i
	if (allocated (object%prt)) then
	do i = 1, size (object%prt)
	if (allocated (object%prt(i)%c)) call object%prt(i)%c%final ()
	end do
	end if
	end subroutine decay_term_config_final

	@ %def decay_term_config_final
	@ Output, with optional indentation
	<<Decays: decay term config: TBP>>=
	procedure :: write => decay_term_config_write
	<<Decays: procedures>>=
	recursive subroutine decay_term_config_write (object, unit, indent, verbose)
	class(decay_term_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	integer :: i, j, u, ind
	logical :: verb
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	verb = .true.; if (present (verbose)) verb = verbose
	call write_indent (u, ind)
	write (u, "(1x,A)", advance="no") "Final state:"
	do i = 1, size (object%prt)
	select type (prt_config => object%prt(i)%c)
	type is (stable_config_t)
	write (u, "(1x,A)", advance="no") &
	char (prt_config%flv(1)%get_name ())
	do j = 2, size (prt_config%flv)
	write (u, "(':',A)", advance="no") &
	char (prt_config%flv(j)%get_name ())
	end do
	type is (unstable_config_t)
	write (u, "(1x,A)", advance="no") &
	char (prt_config%flv%get_name ())
	end select
	end do
	write (u, *)
	if (verb) then
	do i = 1, size (object%prt)
	call object%prt(i)%c%write (u, ind)
	end do
	end if
	end subroutine decay_term_config_write

	@ %def decay_term_config_write
	@ Initialize, given a set of flavors. For each flavor, we must indicate
	whether the particle is stable. The second index of the flavor array runs
	over alternatives for each decay product; alternatives are allowed only if the
	decay product is itself stable.
	<<Decays: decay term config: TBP>>=
	procedure :: init => decay_term_config_init
	<<Decays: procedures>>=
	recursive subroutine decay_term_config_init &
	(term, flv, stable, model, process_stack, var_list)
	class(decay_term_config_t), intent(out) :: term
	type(flavor_t), dimension(:,:), intent(in) :: flv
	logical, dimension(:), intent(in) :: stable
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(var_list_t), intent(in), optional :: var_list
	type(string_t), dimension(:), allocatable :: decay
	integer :: i
	allocate (term%prt (size (flv, 1)))
	do i = 1, size (flv, 1)
	associate (prt => term%prt(i))
	if (stable(i)) then
	allocate (stable_config_t :: prt%c)
	else
	allocate (unstable_config_t :: prt%c)
	end if
	select type (prt_config => prt%c)
	type is (stable_config_t)
	call prt_config%init (flv(i,:))
	type is (unstable_config_t)
	if (all (flv(i,:) == flv(i,1))) then
	call prt_config%init (flv(i,1))
	call flv(i,1)%get_decays (decay)
	call prt_config%init_decays &
	(decay, model, process_stack, var_list)
	else
	call prt_config%write ()
	call msg_fatal ("Decay configuration: &
	&unstable product must be unique")
	end if
	end select
	end associate
	end do
	end subroutine decay_term_config_init

	@ %def decay_term_config_init
	@ Recursively compute widths and branching ratios for all unstable particles.
	<<Decays: decay term config: TBP>>=
	procedure :: compute => decay_term_config_compute
	<<Decays: procedures>>=
	recursive subroutine decay_term_config_compute (term)
	class(decay_term_config_t), intent(inout) :: term
	integer :: i
	do i = 1, size (term%prt)
	select type (unstable_config => term%prt(i)%c)
	type is (unstable_config_t)
	call unstable_config%compute ()
	end select
	end do
	end subroutine decay_term_config_compute

	@ %def decay_term_config_compute
	@
	\subsection{Decay Term}
	A decay term instance is selected when we generate an event for the associated
	process instance. When evaluated, it triggers further decays down the chain.

	Only unstable products are allocated as child particles.
	<<Decays: types>>=
	type :: decay_term_t
	private
	type(decay_term_config_t), pointer :: config => null ()
	type(particle_out_t), dimension(:), allocatable :: particle_out
	contains
	<<Decays: decay term: TBP>>
	end type decay_term_t

	@ %def decay_term_t
	@ Finalizer.
	<<Decays: decay term: TBP>>=
	procedure :: final => decay_term_final
	<<Decays: procedures>>=
	recursive subroutine decay_term_final (object)
	class(decay_term_t), intent(inout) :: object
	integer :: i
	if (allocated (object%particle_out)) then
	do i = 1, size (object%particle_out)
	call object%particle_out(i)%c%final ()
	end do
	end if
	end subroutine decay_term_final

	@ %def decay_term_final
	@ Output.
	<<Decays: decay term: TBP>>=
	procedure :: write => decay_term_write
	<<Decays: procedures>>=
	recursive subroutine decay_term_write (object, unit, indent)
	class(decay_term_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	integer :: i, u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call object%config%write (u, ind, verbose = .false.)
	do i = 1, size (object%particle_out)
	call object%particle_out(i)%c%write (u, ind)
	end do
	end subroutine decay_term_write

	@ %def decay_term_write
	@ Recursively write the embedded process instances.
	<<Decays: decay term: TBP>>=
	procedure :: write_process_instances => decay_term_write_process_instances
	<<Decays: procedures>>=
	recursive subroutine decay_term_write_process_instances (term, unit, verbose)
	class(decay_term_t), intent(in) :: term
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	call unstable%write_process_instances (unit, verbose)
	end select
	end do
	end subroutine decay_term_write_process_instances

	@ %def decay_term_write_process_instances
	@ Initialization, using the configuration object. We allocate
	particle objects in parallel to the particle configuration objects
	which we use to initialize them, one at a time.
	<<Decays: decay term: TBP>>=
	procedure :: init => decay_term_init
	<<Decays: procedures>>=
	recursive subroutine decay_term_init (term, config)
	class(decay_term_t), intent(out) :: term
	type(decay_term_config_t), intent(in), target :: config
	integer :: i
	term%config => config
	allocate (term%particle_out (size (config%prt)))
	do i = 1, size (config%prt)
	select type (prt_config => config%prt(i)%c)
	type is (stable_config_t)
	allocate (stable_t :: term%particle_out(i)%c)
	select type (stable => term%particle_out(i)%c)
	type is (stable_t)
	call stable%init (prt_config)
	end select
	type is (unstable_config_t)
	allocate (unstable_t :: term%particle_out(i)%c)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	call unstable%init (prt_config)
	end select
	end select
	end do
	end subroutine decay_term_init

	@ %def decay_term_init
	@ Implement a RNG instance, spawned by the process object.
	<<Decays: decay term: TBP>>=
	procedure :: make_rng => decay_term_make_rng
	<<Decays: procedures>>=
	subroutine decay_term_make_rng (term, process)
	class(decay_term_t), intent(inout) :: term
	type(process_t), intent(inout) :: process
	class(rng_t), allocatable :: rng
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	call process%make_rng (rng)
	call unstable%import_rng (rng)
	end select
	end do
	end subroutine decay_term_make_rng

	@ %def decay_term_make_rng
	@ Link the interactions for unstable decay products to the
	interaction of the parent process.
	<<Decays: decay term: TBP>>=
	procedure :: link_interactions => decay_term_link_interactions
	<<Decays: procedures>>=
	recursive subroutine decay_term_link_interactions (term, trace)
	class(decay_term_t), intent(inout) :: term
	type(interaction_t), intent(in), target :: trace
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	call unstable%link_interactions (i, trace)
	end select
	end do
	end subroutine decay_term_link_interactions

	@ %def decay_term_link_interactions
	@ Recursively generate a decay chain, for each of the unstable
	particles in the final state.
	<<Decays: decay term: TBP>>=
	procedure :: select_chain => decay_term_select_chain
	<<Decays: procedures>>=
	recursive subroutine decay_term_select_chain (term)
	class(decay_term_t), intent(inout) :: term
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	call unstable%select_chain ()
	end select
	end do
	end subroutine decay_term_select_chain

	@ %def decay_term_select_chain
	@ Recursively generate a decay event, for each of the unstable
	particles in the final state.
	<<Decays: decay term: TBP>>=
	procedure :: generate => decay_term_generate
	<<Decays: procedures>>=
	recursive subroutine decay_term_generate (term)
	class(decay_term_t), intent(inout) :: term
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	call unstable%generate ()
	end select
	end do
	end subroutine decay_term_generate

	@ %def decay_term_generate
	@
	\subsection{Decay Root Configuration}
	At the root of a decay chain, there is a parent process. The decay root
	stores a pointer to the parent process and the set of decay configurations.
	<<Decays: public>>=
	public :: decay_root_config_t
	<<Decays: types>>=
	type :: decay_root_config_t
	private
	type(string_t) :: process_id
	type(process_t), pointer :: process => null ()
	class(model_data_t), pointer :: model => null ()
	type(decay_term_config_t), dimension(:), allocatable :: term_config
	contains
	<<Decays: decay root config: TBP>>
	end type decay_root_config_t

	@ %def decay_root_config_t
	@ The finalizer is recursive since there may be cascade decays.
	<<Decays: decay root config: TBP>>=
	procedure :: final => decay_root_config_final
	<<Decays: procedures>>=
	recursive subroutine decay_root_config_final (object)
	class(decay_root_config_t), intent(inout) :: object
	integer :: i
	if (allocated (object%term_config)) then
	do i = 1, size (object%term_config)
	call object%term_config(i)%final ()
	end do
	end if
	end subroutine decay_root_config_final

	@ %def decay_root_config_final
	@ The output routine is also recursive, and it contains an adjustable
	indentation.
	<<Decays: decay root config: TBP>>=
	procedure :: write => decay_root_config_write
	procedure :: write_header => decay_root_config_write_header
	procedure :: write_terms => decay_root_config_write_terms
	<<Decays: procedures>>=
	recursive subroutine decay_root_config_write (object, unit, indent, verbose)
	class(decay_root_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, ind)
	write (u, "(1x,A)") "Final-state decay tree:"
	call object%write_header (unit, indent)
	call object%write_terms (unit, indent, verbose)
	end subroutine decay_root_config_write

	subroutine decay_root_config_write_header (object, unit, indent)
	class(decay_root_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, ind)
	if (associated (object%process)) then
	write (u, 3) "process ID =", char (object%process_id), "*"
	else
	write (u, 3) "process ID =", char (object%process_id)
	end if
	3 format (3x,A,2(1x,A))
	end subroutine decay_root_config_write_header

	recursive subroutine decay_root_config_write_terms &
	(object, unit, indent, verbose)
	class(decay_root_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	integer :: i, u, ind
	logical :: verb
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	verb = .true.; if (present (verbose)) verb = verbose
	if (verb .and. allocated (object%term_config)) then
	do i = 1, size (object%term_config)
	call object%term_config(i)%write (u, ind + 1)
	end do
	end if
	end subroutine decay_root_config_write_terms

	@ %def decay_root_config_write
	@ Initialize for a named process and (optionally) a pre-determined
	number of terms.
	<<Decays: decay root config: TBP>>=
	procedure :: init => decay_root_config_init
	<<Decays: procedures>>=
	subroutine decay_root_config_init (decay, model, process_id, n_terms)
	class(decay_root_config_t), intent(out) :: decay
	class(model_data_t), intent(in), target :: model
	type(string_t), intent(in) :: process_id
	integer, intent(in), optional :: n_terms
	decay%model => model
	decay%process_id = process_id
	if (present (n_terms)) then
	allocate (decay%term_config (n_terms))
	end if
	end subroutine decay_root_config_init

	@ %def decay_root_config_init
	@ Declare a decay term, given an array of flavors.
	<<Decays: decay root config: TBP>>=
	procedure :: init_term => decay_root_config_init_term
	<<Decays: procedures>>=
	recursive subroutine decay_root_config_init_term &
	(decay, i, flv, stable, model, process_stack, var_list)
	class(decay_root_config_t), intent(inout) :: decay
	integer, intent(in) :: i
	type(flavor_t), dimension(:,:), intent(in) :: flv
	logical, dimension(:), intent(in) :: stable
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(var_list_t), intent(in), optional, target :: var_list
	call decay%term_config(i)%init (flv, stable, model, process_stack, var_list)
	end subroutine decay_root_config_init_term

	@ %def decay_root_config_init_term
	@ Connect the decay root configuration with a process object (which should
	represent the parent process). This includes initialization, therefore
	intent(out).

	The flavor state is retrieved from the process term object. However, we have
	to be careful: the flavor object points to the model instance that is stored
	in the process object. This model instance may not contain the current
	setting for unstable particles and decay. Therefore, we assign the model
	directly.

	If the [[process_instance]] argument is provided, we use this for the
	flavor state. This applies to the decay root only, where the process
	can be entangled with a beam setup, and the latter contains beam
	remnants as further outgoing particles. These must be included in the
	set of outgoing flavors, since the decay application is also done on
	the connected state.

	Infer stability from the particle properties, using the first row in the set
	of flavor states. For unstable particles, we look for decays,
	recursively, available from the process stack (if present).

	For the unstable particles, we have to check whether their masses
	match between the production and the decay. Fortunately, both
	versions are available for comparison.

	The optional [[var_list]] argument may override integral/error
	values for decay processes.
	<<Decays: decay root config: TBP>>=
	procedure :: connect => decay_root_config_connect
	<<Decays: procedures>>=
	recursive subroutine decay_root_config_connect &
	(decay, process, model, process_stack, process_instance, var_list)
	class(decay_root_config_t), intent(out) :: decay
	type(process_t), intent(in), target :: process
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(process_instance_t), intent(in), optional, target :: process_instance
	type(var_list_t), intent(in), optional, target :: var_list
	type(connected_state_t), pointer :: connected_state
	type(interaction_t), pointer :: int
	type(flavor_t), dimension(:,:), allocatable :: flv
	logical, dimension(:), allocatable :: stable
	real(default), dimension(:), allocatable :: m_prod, m_dec
	integer :: i
	call decay%init (model, process%get_id (), process%get_n_terms ())
	do i = 1, size (decay%term_config)
	if (present (process_instance)) then
	connected_state => process_instance%get_connected_state_ptr (i)
	int => connected_state%get_matrix_int_ptr ()
	call interaction_get_flv_out (int, flv)
	else
	call process%get_term_flv_out (i, flv)
	end if
	allocate (m_prod (size (flv(:,1)%get_mass ())))
	m_prod = flv(:,1)%get_mass ()
	call flv%set_model (model)
	allocate (m_dec (size (flv(:,1)%get_mass ())))
	m_dec = flv(:,1)%get_mass ()
	allocate (stable (size (flv, 1)))
	stable = flv(:,1)%is_stable ()
	call check_masses ()
	call decay%init_term (i, flv, stable, model, process_stack, var_list)
	deallocate (flv, stable, m_prod, m_dec)
	end do
	decay%process => process
	contains
	subroutine check_masses ()
	integer :: i
	logical :: ok
	ok = .true.
	do i = 1, size (m_prod)
	if (.not. stable(i)) then
	if (.not. nearly_equal (m_prod(i), m_dec(i))) then
	write (msg_buffer, "(A,A,A)") "particle '", &
	char (flv(i,1)%get_name ()), "':"
	call msg_message
	write (msg_buffer, &
	"(2x,A,1x," // FMT_15 // ",3x,A,1x," // FMT_15 // ")") &
	"m_prod =", m_prod(i), "m_dec =", m_dec(i)
	call msg_message
	ok = .false.
	end if
	end if
	end do
	if (.not. ok) call msg_fatal &
	("Particle mass mismatch between production and decay")
	end subroutine check_masses
	end subroutine decay_root_config_connect

	@ %def decay_root_config_connect
	@ Recursively compute widths, errors, and branching ratios.
	<<Decays: decay root config: TBP>>=
	procedure :: compute => decay_root_config_compute
	<<Decays: procedures>>=
	recursive subroutine decay_root_config_compute (decay)
	class(decay_root_config_t), intent(inout) :: decay
	integer :: i
	do i = 1, size (decay%term_config)
	call decay%term_config(i)%compute ()
	end do
	end subroutine decay_root_config_compute

	@ %def decay_root_config_compute
	@
	\subsection{Decay Root Instance}
	This is the common parent type for decay and decay root. The process instance
	points to the parent process. The model pointer is separate because particle
	settings may be updated w.r.t.\ the parent process object.
	<<Decays: types>>=
	type, abstract :: decay_gen_t
	private
	type(decay_term_t), dimension(:), allocatable :: term
	type(process_instance_t), pointer :: process_instance => null ()
	integer :: selected_mci = 0
	integer :: selected_term = 0
	contains
	<<Decays: decay gen: TBP>>
	end type decay_gen_t

	@ %def decay_gen_t
	@
	The decay root represents the parent process. When an event is generated, the
	generator selects the term to which the decay chain applies (if possible).

	The process instance is just a pointer.
	<<Decays: public>>=
	public :: decay_root_t
	<<Decays: types>>=
	type, extends (decay_gen_t) :: decay_root_t
	private
	type(decay_root_config_t), pointer :: config => null ()
	contains
	<<Decays: decay root: TBP>>
	end type decay_root_t

	@ %def decay_root_t
	@ The finalizer has to recursively finalize the terms, but we can skip the
	process instance which is not explicitly allocated.
	<<Decays: decay gen: TBP>>=
	procedure :: base_final => decay_gen_final
	<<Decays: procedures>>=
	recursive subroutine decay_gen_final (object)
	class(decay_gen_t), intent(inout) :: object
	integer :: i
	if (allocated (object%term)) then
	do i = 1, size (object%term)
	call object%term(i)%final ()
	end do
	end if
	end subroutine decay_gen_final

	@ %def decay_gen_final
	@ No extra finalization for the decay root.
	<<Decays: decay root: TBP>>=
	procedure :: final => decay_root_final
	<<Decays: procedures>>=
	subroutine decay_root_final (object)
	class(decay_root_t), intent(inout) :: object
	call object%base_final ()
	end subroutine decay_root_final

	@ %def decay_gen_final
	@ Output.
	<<Decays: decay root: TBP>>=
	procedure :: write => decay_root_write
	<<Decays: procedures>>=
	subroutine decay_root_write (object, unit)
	class(decay_root_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%config)) then
	call object%config%write (unit, verbose = .false.)
	else
	write (u, "(1x,A)") "Final-state decay tree: [not configured]"
	end if
	if (object%selected_mci > 0) then
	write (u, "(3x,A,I0)") "Selected MCI = ", object%selected_mci
	else
	write (u, "(3x,A)") "Selected MCI = [undefined]"
	end if
	if (object%selected_term > 0) then
	write (u, "(3x,A,I0)") "Selected term = ", object%selected_term
	call object%term(object%selected_term)%write (u, 1)
	else
	write (u, "(3x,A)") "Selected term = [undefined]"
	end if
	end subroutine decay_root_write

	@ %def decay_root_write
	@ Write the process instances, recursively.
	<<Decays: decay gen: TBP>>=
	procedure :: write_process_instances => decay_gen_write_process_instances
	<<Decays: procedures>>=
	recursive subroutine decay_gen_write_process_instances (decay, unit, verbose)
	class(decay_gen_t), intent(in) :: decay
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical :: verb
	verb = .true.; if (present (verbose)) verb = verbose
	if (associated (decay%process_instance)) then
	if (verb) then
	call decay%process_instance%write (unit)
	else
	call decay%process_instance%write_header (unit)
	end if
	end if
	if (decay%selected_term > 0) then
	call decay%term(decay%selected_term)%write_process_instances (unit, verb)
	end if
	end subroutine decay_gen_write_process_instances

	@ %def decay_gen_write_process_instances
	@ Generic initializer. All can be done recursively.
	<<Decays: decay gen: TBP>>=
	procedure :: base_init => decay_gen_init
	<<Decays: procedures>>=
	recursive subroutine decay_gen_init (decay, term_config)
	class(decay_gen_t), intent(out) :: decay
	type(decay_term_config_t), dimension(:), intent(in), target :: term_config
	integer :: i
	allocate (decay%term (size (term_config)))
	do i = 1, size (decay%term)
	call decay%term(i)%init (term_config(i))
	end do
	end subroutine decay_gen_init

	@ %def decay_gen_init
	@ Specific initializer. We assign the configuration object, which should
	correspond to a completely initialized decay configuration tree. We
	also connect to an existing process instance. Then, we recursively
	link the child interactions to the parent process.
	<<Decays: decay root: TBP>>=
	procedure :: init => decay_root_init
	<<Decays: procedures>>=
	subroutine decay_root_init (decay_root, config, process_instance)
	class(decay_root_t), intent(out) :: decay_root
	type(decay_root_config_t), intent(in), target :: config
	type(process_instance_t), intent(in), target :: process_instance
	call decay_root%base_init (config%term_config)
	decay_root%config => config
	decay_root%process_instance => process_instance
	call decay_root%make_term_rng (config%process)
	call decay_root%link_term_interactions ()
	end subroutine decay_root_init

	@ %def decay_root_init
	@ Explicitly set/get mci and term indices. (Used in unit test.)
	<<Decays: decay gen: TBP>>=
	procedure :: set_mci => decay_gen_set_mci
	procedure :: set_term => decay_gen_set_term
	procedure :: get_mci => decay_gen_get_mci
	procedure :: get_term => decay_gen_get_term
	<<Decays: procedures>>=
	subroutine decay_gen_set_mci (decay, i)
	class(decay_gen_t), intent(inout) :: decay
	integer, intent(in) :: i
	decay%selected_mci = i
	end subroutine decay_gen_set_mci

	subroutine decay_gen_set_term (decay, i)
	class(decay_gen_t), intent(inout) :: decay
	integer, intent(in) :: i
	decay%selected_term = i
	end subroutine decay_gen_set_term

	function decay_gen_get_mci (decay) result (i)
	class(decay_gen_t), intent(inout) :: decay
	integer :: i
	i = decay%selected_mci
	end function decay_gen_get_mci

	function decay_gen_get_term (decay) result (i)
	class(decay_gen_t), intent(inout) :: decay
	integer :: i
	i = decay%selected_term
	end function decay_gen_get_term

	@ %def decay_gen_set_mci
	@ %def decay_gen_set_term
	@ %def decay_gen_get_mci
	@ %def decay_gen_get_term
	@ Implement random-number generators for unstable decay selection in
	all terms. This is not recursive.

	We also make use of the fact that [[process]] is a pointer; the (state
	of the RNG factory inside the) target process will be modified by the
	rng-spawning method, but not the pointer.
	<<Decays: decay gen: TBP>>=
	procedure :: make_term_rng => decay_gen_make_term_rng
	<<Decays: procedures>>=
	subroutine decay_gen_make_term_rng (decay, process)
	class(decay_gen_t), intent(inout) :: decay
	type(process_t), intent(in), pointer :: process
	integer :: i
	do i = 1, size (decay%term)
	call decay%term(i)%make_rng (process)
	end do
	end subroutine decay_gen_make_term_rng

	@ %def decay_gen_make_term_rng
	@ Recursively link interactions of the enclosed decay terms to the
	corresponding terms in the current process instance.

	Note: A bug in nagfor requires the extra [[i_term]] variable.
	<<Decays: decay gen: TBP>>=
	procedure :: link_term_interactions => decay_gen_link_term_interactions
	<<Decays: procedures>>=
	recursive subroutine decay_gen_link_term_interactions (decay)
	class(decay_gen_t), intent(inout) :: decay
	integer :: i, i_term
	type(interaction_t), pointer :: trace
	associate (instance => decay%process_instance)
	do i = 1, size (decay%term)
	i_term = i
	trace => instance%get_trace_int_ptr (i_term)
	call decay%term(i_term)%link_interactions (trace)
	end do
	end associate
	end subroutine decay_gen_link_term_interactions

	@ %def decay_gen_link_term_interactions
	@ Select a decay chain: decay modes and process components.
	<<Decays: decay root: TBP>>=
	procedure :: select_chain => decay_root_select_chain
	<<Decays: procedures>>=
	subroutine decay_root_select_chain (decay_root)
	class(decay_root_t), intent(inout) :: decay_root
	if (decay_root%selected_term > 0) then
	call decay_root%term(decay_root%selected_term)%select_chain ()
	else
	call msg_bug ("Decays: no term selected for parent process")
	end if
	end subroutine decay_root_select_chain

	@ %def decay_root_select_chain
	@ Generate a decay tree, i.e., for the selected term in the parent
	process, recursively generate a decay event for all unstable
	particles.

	Factor out the trace of the connected state of the parent process.
	This trace should not be taken into account for unweighting the decay
	chain, since it was already used for unweighting the parent event, or
	it determines the overall event weight.
	<<Decays: decay root: TBP>>=
	procedure :: generate => decay_root_generate
	<<Decays: procedures>>=
	subroutine decay_root_generate (decay_root)
	class(decay_root_t), intent(inout) :: decay_root
	type(connected_state_t), pointer :: connected_state
	if (decay_root%selected_term > 0) then
	connected_state => decay_root%process_instance%get_connected_state_ptr &
	(decay_root%selected_term)
	call connected_state%normalize_matrix_by_trace ()
	call decay_root%term(decay_root%selected_term)%generate ()
	else
	call msg_bug ("Decays: no term selected for parent process")
	end if
	end subroutine decay_root_generate

	@ %def decay_root_generate
	@
	\subsection{Decay Configuration}
	A decay configuration describes a distinct decay mode of a particle. Each
	decay mode may include several terms, which correspond to the terms in the
	associated process. In addition to the base type, the decay configuration
	object contains the integral of the parent process and the selector for the
	MCI group inside this process.

	The flavor component should be identical to the flavor component of the parent
	particle ([[unstable]] object).
	<<Decays: types>>=
	type, extends (decay_root_config_t) :: decay_config_t
	private
	type(flavor_t) :: flv
	real(default) :: weight = 0
	real(default) :: integral = 0
	real(default) :: abs_error = 0
	real(default) :: rel_error = 0
	type(selector_t) :: mci_selector
	contains
	<<Decays: decay config: TBP>>
	end type decay_config_t

	@ %def decay_config_t
	@ The output routine extends the decay-root writer by listing numerical
	component values.
	<<Decays: decay config: TBP>>=
	procedure :: write => decay_config_write
	<<Decays: procedures>>=
	recursive subroutine decay_config_write (object, unit, indent, verbose)
	class(decay_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, ind)
	write (u, "(1x,A)") "Decay:"
	call object%write_header (unit, indent)
	call write_indent (u, ind)
	write (u, 2) "branching ratio =", object%weight * 100
	call write_indent (u, ind)
	write (u, 1) "partial width =", object%integral
	call write_indent (u, ind)
	write (u, 1) "error (abs) =", object%abs_error
	call write_indent (u, ind)
	write (u, 1) "error (rel) =", object%rel_error
	1 format (3x,A,ES19.12)
	2 format (3x,A,F11.6,1x,'%')
	call object%write_terms (unit, indent, verbose)
	end subroutine decay_config_write

	@ %def decay_config_write
	@ Connect a decay configuration with a process object (which should
	represent the decay). This includes initialization, therefore
	intent(out). We first connect the process itself, then do initializations
	that are specific for this decay.

	Infer stability from the particle properties, using the first row in the set
	of flavor states. Once we can deal with predetermined decay chains, they
	should be used instead.

	If there is an optional [[var_list]], check if the stored values for
	the decay partial width and error have been overridden there.
	<<Decays: decay config: TBP>>=
	procedure :: connect => decay_config_connect
	<<Decays: procedures>>=
	recursive subroutine decay_config_connect &
	(decay, process, model, process_stack, process_instance, var_list)
	class(decay_config_t), intent(out) :: decay
	type(process_t), intent(in), target :: process
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(process_instance_t), intent(in), optional, target :: process_instance
	type(var_list_t), intent(in), optional, target :: var_list
	real(default), dimension(:), allocatable :: integral_mci
	type(string_t) :: process_id
	integer :: i, n_mci
	call decay%decay_root_config_t%connect &
	(process, model, process_stack, var_list=var_list)
	process_id = process%get_id ()
	if (process%cm_frame ()) then
	call msg_fatal ("Decay process " // char (process_id) &
	// ": unusable because rest frame is fixed.")
	end if
	decay%integral = process%get_integral ()
	decay%abs_error = process%get_error ()
	if (present (var_list)) then
	call update (decay%integral, "integral(" // process_id // ")")
	call update (decay%abs_error, "error(" // process_id // ")")
	end if
	n_mci = process%get_n_mci ()
	allocate (integral_mci (n_mci))
	do i = 1, n_mci
	integral_mci(i) = process%get_integral_mci (i)
	end do
	call decay%mci_selector%init (integral_mci)
	contains
	subroutine update (var, var_name)
	real(default), intent(inout) :: var
	type(string_t), intent(in) :: var_name
	if (var_list%contains (var_name)) then
	var = var_list%get_rval (var_name)
	end if
	end subroutine update
	end subroutine decay_config_connect

	@ %def decay_config_connect
	@ Set the flavor entry, which repeats the flavor of the parent unstable
	particle.
	<<Decays: decay config: TBP>>=
	procedure :: set_flv => decay_config_set_flv
	<<Decays: procedures>>=
	subroutine decay_config_set_flv (decay, flv)
	class(decay_config_t), intent(inout) :: decay
	type(flavor_t), intent(in) :: flv
	decay%flv = flv
	end subroutine decay_config_set_flv

	@ %def decay_config_set_flv
	@ Compute embedded branchings and the relative error. This method does not
	apply to the decay root.
	<<Decays: decay config: TBP>>=
	procedure :: compute => decay_config_compute
	<<Decays: procedures>>=
	recursive subroutine decay_config_compute (decay)
	class(decay_config_t), intent(inout) :: decay
	call decay%decay_root_config_t%compute ()
	if (.not. vanishes (decay%integral)) then
	decay%rel_error = decay%abs_error / decay%integral
	else
	decay%rel_error = 0
	end if
	end subroutine decay_config_compute

	@ %def decay_config_compute
	@
	\subsection{Decay Instance}
	The decay contains a collection of terms. One of them is selected when the
	decay is evaluated. This is similar to the decay root, but we implement it
	independently.

	The process instance object is allocated via a pointer, so it automatically
	behaves as a target.
	<<Decays: types>>=
	type, extends (decay_gen_t) :: decay_t
	private
	type(decay_config_t), pointer :: config => null ()
	class(rng_t), allocatable :: rng
	contains
	<<Decays: decay: TBP>>
	end type decay_t

	@ %def decay_t
	@ The finalizer is recursive.
	<<Decays: decay: TBP>>=
	procedure :: final => decay_final
	<<Decays: procedures>>=
	recursive subroutine decay_final (object)
	class(decay_t), intent(inout) :: object
	integer :: i
	call object%base_final ()
	do i = 1, object%config%process%get_n_mci ()
	call object%process_instance%final_simulation (i)
	end do
	call object%process_instance%final ()
	deallocate (object%process_instance)
	end subroutine decay_final

	@ %def decay_final
	@ Output.
	<<Decays: decay: TBP>>=
	procedure :: write => decay_write
	<<Decays: procedures>>=
	recursive subroutine decay_write (object, unit, indent, recursive)
	class(decay_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent, recursive
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call object%config%write (unit, indent, verbose = .false.)
	if (allocated (object%rng)) then
	call object%rng%write (u, ind + 1)
	end if
	call write_indent (u, ind)
	if (object%selected_mci > 0) then
	write (u, "(3x,A,I0)") "Selected MCI = ", object%selected_mci
	else
	write (u, "(3x,A)") "Selected MCI = [undefined]"
	end if
	call write_indent (u, ind)
	if (object%selected_term > 0) then
	write (u, "(3x,A,I0)") "Selected term = ", object%selected_term
	call object%term(object%selected_term)%write (u, ind + 1)
	else
	write (u, "(3x,A)") "Selected term = [undefined]"
	end if
	end subroutine decay_write

	@ %def decay_write
	@ Initializer. Base initialization is done recursively. Then, we
	prepare the current process instance and allocate a random-number
	generator for term selection. For all unstable particles, we also
	allocate a r.n.g. as spawned by the current process.
	<<Decays: decay: TBP>>=
	procedure :: init => decay_init
	<<Decays: procedures>>=
	recursive subroutine decay_init (decay, config)
	class(decay_t), intent(out) :: decay
	type(decay_config_t), intent(in), target :: config
	integer :: i
	call decay%base_init (config%term_config)
	decay%config => config
	allocate (decay%process_instance)
	call decay%process_instance%init (decay%config%process)
	call decay%process_instance%setup_event_data (decay%config%model)
	do i = 1, decay%config%process%get_n_mci ()
	call decay%process_instance%init_simulation (i)
	end do
	call decay%config%process%make_rng (decay%rng)
	call decay%make_term_rng (decay%config%process)
	end subroutine decay_init

	@ %def decay_init
	@ Link interactions to the parent process. [[i_prt]] is the index of
	the current outgoing particle in the parent interaction, for which we
	take the trace evaluator. We link it to the beam particle in the beam
	interaction of the decay process instance. Then, repeat the procedure
	for the outgoing particles.
	<<Decays: decay: TBP>>=
	procedure :: link_interactions => decay_link_interactions
	<<Decays: procedures>>=
	recursive subroutine decay_link_interactions (decay, i_prt, trace)
	class(decay_t), intent(inout) :: decay
	integer, intent(in) :: i_prt
	type(interaction_t), intent(in), target :: trace
	type(interaction_t), pointer :: beam_int
	integer :: n_in, n_vir
	beam_int => decay%process_instance%get_beam_int_ptr ()
	n_in = trace%get_n_in ()
	n_vir = trace%get_n_vir ()
	call beam_int%set_source_link (1, trace, &
	n_in + n_vir + i_prt)
	call decay%link_term_interactions ()
	end subroutine decay_link_interactions

	@ %def decay_link_interactions
	@ Determine a decay chain. For each unstable particle we select one
	of the possible decay modes, and for each decay process we select one
	of the possible decay MCI components, calling the random-number
	generators. We do not generate momenta, yet.
	<<Decays: decay: TBP>>=
	procedure :: select_chain => decay_select_chain
	<<Decays: procedures>>=
	recursive subroutine decay_select_chain (decay)
	class(decay_t), intent(inout) :: decay
	real(default) :: x
	integer :: i
	call decay%rng%generate (x)
	decay%selected_mci = decay%config%mci_selector%select (x)
	call decay%process_instance%choose_mci (decay%selected_mci)
	decay%selected_term = decay%process_instance%select_i_term ()
	do i = 1, size (decay%term)
	call decay%term(i)%select_chain ()
	end do
	end subroutine decay_select_chain

	@ %def decay_select_chain
	@ Generate a decay. We first receive the beam momenta from the parent
	process (assuming that this is properly linked), then call the
	associated process object for a new event.

	Factor out the trace of the helicity density matrix of the isolated
	state (the one that will be used for the decay chain). The trace is
	taken into account for unweighting the individual decay event and
	should therefore be ignored for unweighting the correlated decay
	chain afterwards.
	<<Decays: decay: TBP>>=
	procedure :: generate => decay_generate
	<<Decays: procedures>>=
	recursive subroutine decay_generate (decay)
	class(decay_t), intent(inout) :: decay
	type(isolated_state_t), pointer :: isolated_state
	integer :: i
	call decay%process_instance%receive_beam_momenta ()
	call decay%process_instance%generate_unweighted_event (decay%selected_mci)
	if (signal_is_pending ()) return
	call decay%process_instance%evaluate_event_data ()
	isolated_state => &
	decay%process_instance%get_isolated_state_ptr (decay%selected_term)
	call isolated_state%normalize_matrix_by_trace ()
	do i = 1, size (decay%term)
	call decay%term(i)%generate ()
	if (signal_is_pending ()) return
	end do
	end subroutine decay_generate

	@ %def decay_generate
	@
	\subsection{Stable Particles}
	This is a stable particle. The flavor can be ambiguous (e.g., partons).
	<<Decays: types>>=
	type, extends (any_config_t) :: stable_config_t
	private
	type(flavor_t), dimension(:), allocatable :: flv
	contains
	<<Decays: stable config: TBP>>
	end type stable_config_t

	@ %def stable_config_t
	@ The finalizer is empty:
	<<Decays: stable config: TBP>>=
	procedure :: final => stable_config_final
	<<Decays: procedures>>=
	subroutine stable_config_final (object)
	class(stable_config_t), intent(inout) :: object
	end subroutine stable_config_final

	@ %def stable_config_final
	@ Output.
	<<Decays: stable config: TBP>>=
	procedure :: write => stable_config_write
	<<Decays: procedures>>=
	recursive subroutine stable_config_write (object, unit, indent, verbose)
	class(stable_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	integer :: u, i, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call write_indent (u, ind)
	write (u, "(1x,'+',1x,A)", advance = "no") "Stable:"
	write (u, "(1x,A)", advance = "no") char (object%flv(1)%get_name ())
	do i = 2, size (object%flv)
	write (u, "(':',A)", advance = "no") &
	char (object%flv(i)%get_name ())
	end do
	write (u, *)
	end subroutine stable_config_write

	@ %def stable_config_write
	@ Initializer. We are presented with an array of flavors, but there may be
	double entries which we remove, so we store only the distinct flavors.
	<<Decays: stable config: TBP>>=
	procedure :: init => stable_config_init
	<<Decays: procedures>>=
	subroutine stable_config_init (config, flv)
	class(stable_config_t), intent(out) :: config
	type(flavor_t), dimension(:), intent(in) :: flv
	integer, dimension (size (flv)) :: pdg
	logical, dimension (size (flv)) :: mask
	integer :: i
	pdg = flv%get_pdg ()
	mask(1) = .true.
	forall (i = 2 : size (pdg))
	mask(i) = all (pdg(i) /= pdg(1:i-1))
	end forall
	allocate (config%flv (count (mask)))
	config%flv = pack (flv, mask)
	end subroutine stable_config_init

	@ %def stable_config_init
	@ Here is the corresponding object instance. Except for the pointer
	to the configuration, there is no content.
	<<Decays: types>>=
	type, extends (any_t) :: stable_t
	private
	type(stable_config_t), pointer :: config => null ()
	contains
	<<Decays: stable: TBP>>
	end type stable_t

	@ %def stable_t
	@ The finalizer does nothing.
	<<Decays: stable: TBP>>=
	procedure :: final => stable_final
	<<Decays: procedures>>=
	subroutine stable_final (object)
	class(stable_t), intent(inout) :: object
	end subroutine stable_final

	@ %def stable_final
	@ We can delegate output to the configuration object.
	<<Decays: stable: TBP>>=
	procedure :: write => stable_write
	<<Decays: procedures>>=
	subroutine stable_write (object, unit, indent)
	class(stable_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	call object%config%write (unit, indent)
	end subroutine stable_write

	@ %def stable_write
	@ Initializer: just assign the configuration.
	<<Decays: stable: TBP>>=
	procedure :: init => stable_init
	<<Decays: procedures>>=
	subroutine stable_init (stable, config)
	class(stable_t), intent(out) :: stable
	type(stable_config_t), intent(in), target :: config
	stable%config => config
	end subroutine stable_init

	@ %def stable_init
	@
	\subsection{Unstable Particles}
	A branching configuration enables us to select among distinct decay
	modes of a particle. We store the particle flavor (with its implicit
	link to a model), an array of decay configurations, and a selector object.

	The total width, absolute and relative error are stored as
	[[integral]], [[abs_error]], and [[rel_error]], respectively.

	The flavor must be unique in this case.
	<<Decays: public>>=
	public :: unstable_config_t
	<<Decays: types>>=
	type, extends (any_config_t) :: unstable_config_t
	private
	type(flavor_t) :: flv
	real(default) :: integral = 0
	real(default) :: abs_error = 0
	real(default) :: rel_error = 0
	type(selector_t) :: selector
	type(decay_config_t), dimension(:), allocatable :: decay_config
	contains
	<<Decays: unstable config: TBP>>
	end type unstable_config_t

	@ %def unstable_config_t
	@ Finalizer. The branching configuration can be a recursive structure.
	<<Decays: unstable config: TBP>>=
	procedure :: final => unstable_config_final
	<<Decays: procedures>>=
	recursive subroutine unstable_config_final (object)
	class(unstable_config_t), intent(inout) :: object
	integer :: i
	if (allocated (object%decay_config)) then
	do i = 1, size (object%decay_config)
	call object%decay_config(i)%final ()
	end do
	end if
	end subroutine unstable_config_final

	@ %def unstable_config_final
	@ Output. Since this may be recursive, we include indentation.
	<<Decays: unstable config: TBP>>=
	procedure :: write => unstable_config_write
	<<Decays: procedures>>=
	recursive subroutine unstable_config_write (object, unit, indent, verbose)
	class(unstable_config_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	logical, intent(in), optional :: verbose
	integer :: u, i, ind
	logical :: verb
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	verb = .true.; if (present (verbose)) verb = verbose
	call write_indent (u, ind)
	write (u, "(1x,'+',1x,A,1x,A)") "Unstable:", &
	char (object%flv%get_name ())
	call write_indent (u, ind)
	write (u, 1) "total width =", object%integral
	call write_indent (u, ind)
	write (u, 1) "error (abs) =", object%abs_error
	call write_indent (u, ind)
	write (u, 1) "error (rel) =", object%rel_error
	1 format (5x,A,ES19.12)
	if (verb .and. allocated (object%decay_config)) then
	do i = 1, size (object%decay_config)
	call object%decay_config(i)%write (u, ind + 1)
	end do
	end if
	end subroutine unstable_config_write

	@ %def unstable_config_write
	@ Initializer. For the unstable particle, the flavor is unique.
	<<Decays: unstable config: TBP>>=
	procedure :: init => unstable_config_init
	<<Decays: procedures>>=
	subroutine unstable_config_init (unstable, flv, set_decays, model)
	class(unstable_config_t), intent(out) :: unstable
	type(flavor_t), intent(in) :: flv
	logical, intent(in), optional :: set_decays
	class(model_data_t), intent(in), optional, target :: model
	type(string_t), dimension(:), allocatable :: decay
	unstable%flv = flv
	if (present (set_decays)) then
	call unstable%flv%get_decays (decay)
	call unstable%init_decays (decay, model)
	end if
	end subroutine unstable_config_init

	@ %def unstable_config_init
	@ Further initialization: determine the number of decay modes. We can assume
	that the flavor of the particle has been set already.

	If the process stack is given, we can delve recursively into actually
	assigning decay processes. Otherwise, we just initialize with decay
	process names.
	<<Decays: unstable config: TBP>>=
	procedure :: init_decays => unstable_config_init_decays
	<<Decays: procedures>>=
	recursive subroutine unstable_config_init_decays &
	(unstable, decay_id, model, process_stack, var_list)
	class(unstable_config_t), intent(inout) :: unstable
	type(string_t), dimension(:), intent(in) :: decay_id
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(var_list_t), intent(in), optional :: var_list
	integer :: i
	allocate (unstable%decay_config (size (decay_id)))
	do i = 1, size (decay_id)
	associate (decay => unstable%decay_config(i))
	if (present (process_stack)) then
	call decay%connect (process_stack%get_process_ptr (decay_id(i)), &
	model, process_stack, var_list=var_list)
	else
	call decay%init (model, decay_id(i))
	end if
	call decay%set_flv (unstable%flv)
	end associate
	end do
	end subroutine unstable_config_init_decays

	@ %def unstable_config_init
	@ Explicitly connect a specific decay with a process. This is used only in
	unit tests.
	<<Decays: unstable config: TBP>>=
	procedure :: connect_decay => unstable_config_connect_decay
	<<Decays: procedures>>=
	subroutine unstable_config_connect_decay (unstable, i, process, model)
	class(unstable_config_t), intent(inout) :: unstable
	integer, intent(in) :: i
	type(process_t), intent(in), target :: process
	class(model_data_t), intent(in), target :: model
	associate (decay => unstable%decay_config(i))
	call decay%connect (process, model)
	end associate
	end subroutine unstable_config_connect_decay

	@ %def unstable_config_connect_decay
	@ Compute the total width and branching ratios, initializing the decay
	selector.
	<<Decays: unstable config: TBP>>=
	procedure :: compute => unstable_config_compute
	<<Decays: procedures>>=
	recursive subroutine unstable_config_compute (unstable)
	class(unstable_config_t), intent(inout) :: unstable
	integer :: i
	do i = 1, size (unstable%decay_config)
	call unstable%decay_config(i)%compute ()
	end do
	unstable%integral = sum (unstable%decay_config%integral)
	if (unstable%integral <= 0) then
	call unstable%write ()
	call msg_fatal ("Decay configuration: computed total width is zero")
	end if
	unstable%abs_error = sqrt (sum (unstable%decay_config%abs_error ** 2))
	unstable%rel_error = unstable%abs_error / unstable%integral
	call unstable%selector%init (unstable%decay_config%integral)
	do i = 1, size (unstable%decay_config)
	unstable%decay_config(i)%weight &
	= unstable%selector%get_weight (i)
	end do
	end subroutine unstable_config_compute

	@ %def unstable_config_compute
	@
	Now we define the instance of an unstable particle.
	<<Decays: public>>=
	public :: unstable_t
	<<Decays: types>>=
	type, extends (any_t) :: unstable_t
	private
	type(unstable_config_t), pointer :: config => null ()
	class(rng_t), allocatable :: rng
	integer :: selected_decay = 0
	type(decay_t), dimension(:), allocatable :: decay
	contains
	<<Decays: unstable: TBP>>
	end type unstable_t

	@ %def unstable_t
	@ Recursive finalizer.
	<<Decays: unstable: TBP>>=
	procedure :: final => unstable_final
	<<Decays: procedures>>=
	recursive subroutine unstable_final (object)
	class(unstable_t), intent(inout) :: object
	integer :: i
	if (allocated (object%decay)) then
	do i = 1, size (object%decay)
	call object%decay(i)%final ()
	end do
	end if
	end subroutine unstable_final

	@ %def unstable_final
	@ Output.
	<<Decays: unstable: TBP>>=
	procedure :: write => unstable_write
	<<Decays: procedures>>=
	recursive subroutine unstable_write (object, unit, indent)
	class(unstable_t), intent(in) :: object
	integer, intent(in), optional :: unit, indent
	integer :: u, ind
	u = given_output_unit (unit)
	ind = 0; if (present (indent)) ind = indent
	call object%config%write (u, ind, verbose=.false.)
	if (allocated (object%rng)) then
	call object%rng%write (u, ind + 2)
	end if
	call write_indent (u, ind)
	if (object%selected_decay > 0) then
	write (u, "(5x,A,I0)") "Sel. decay = ", object%selected_decay
	call object%decay(object%selected_decay)%write (u, ind + 1)
	else
	write (u, "(5x,A)") "Sel. decay = [undefined]"
	end if
	end subroutine unstable_write

	@ %def unstable_write
	@ Write the embedded process instances.
	<<Decays: unstable: TBP>>=
	procedure :: write_process_instances => unstable_write_process_instances
	<<Decays: procedures>>=
	recursive subroutine unstable_write_process_instances &
	(unstable, unit, verbose)
	class(unstable_t), intent(in) :: unstable
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	if (unstable%selected_decay > 0) then
	call unstable%decay(unstable%selected_decay)% &
	write_process_instances (unit, verbose)
	end if
	end subroutine unstable_write_process_instances

	@ %def unstable_write_process_instances
	@ Initialization, using the configuration object.
	<<Decays: unstable: TBP>>=
	procedure :: init => unstable_init
	<<Decays: procedures>>=
	recursive subroutine unstable_init (unstable, config)
	class(unstable_t), intent(out) :: unstable
	type(unstable_config_t), intent(in), target :: config
	integer :: i
	unstable%config => config
	allocate (unstable%decay (size (config%decay_config)))
	do i = 1, size (config%decay_config)
	call unstable%decay(i)%init (config%decay_config(i))
	end do
	end subroutine unstable_init

	@ %def unstable_init
	@ Recursively link interactions to the parent process. [[i_prt]] is
	the index of the current outgoing particle in the parent interaction.
	<<Decays: unstable: TBP>>=
	procedure :: link_interactions => unstable_link_interactions
	<<Decays: procedures>>=
	recursive subroutine unstable_link_interactions (unstable, i_prt, trace)
	class(unstable_t), intent(inout) :: unstable
	integer, intent(in) :: i_prt
	type(interaction_t), intent(in), target :: trace
	integer :: i
	do i = 1, size (unstable%decay)
	call unstable%decay(i)%link_interactions (i_prt, trace)
	end do
	end subroutine unstable_link_interactions

	@ %def unstable_link_interactions
	@ Import the random-number generator state.
	<<Decays: unstable: TBP>>=
	procedure :: import_rng => unstable_import_rng
	<<Decays: procedures>>=
	subroutine unstable_import_rng (unstable, rng)
	class(unstable_t), intent(inout) :: unstable
	class(rng_t), intent(inout), allocatable :: rng
	call move_alloc (from = rng, to = unstable%rng)
	end subroutine unstable_import_rng

	@ %def unstable_import_rng
	@ Generate a decay chain. First select a decay mode, then call the
	[[select_chain]] method of the selected mode.
	<<Decays: unstable: TBP>>=
	procedure :: select_chain => unstable_select_chain
	<<Decays: procedures>>=
	recursive subroutine unstable_select_chain (unstable)
	class(unstable_t), intent(inout) :: unstable
	real(default) :: x
	call unstable%rng%generate (x)
	unstable%selected_decay = unstable%config%selector%select (x)
	call unstable%decay(unstable%selected_decay)%select_chain ()
	end subroutine unstable_select_chain

	@ %def unstable_select_chain
	@ Generate a decay event.
	<<Decays: unstable: TBP>>=
	procedure :: generate => unstable_generate
	<<Decays: procedures>>=
	recursive subroutine unstable_generate (unstable)
	class(unstable_t), intent(inout) :: unstable
	call unstable%decay(unstable%selected_decay)%generate ()
	end subroutine unstable_generate

	@ %def unstable_generate
	@
	\subsection{Decay Chain}
	While the decay configuration tree and the decay tree are static
	entities (during a simulation run), the decay chain is dynamically
	generated for each event. The reason is that with the possibility of
	several decay modes for each particle, and several terms for each
	process, the total number of distinct decay chains is not under control.

	Each entry in the decay chain is a connected parton state. The origin
	of the chain is a connected state in the parent process (not part of
	the chain itself). For each decay, mode and term chosen, we convolute
	this with the isolated (!) state of the current decay, to generate a
	new connected state. We accumulate this chain by recursively
	traversing the allocated decay tree. Whenever a particle decays, it
	becomes virtual and is replaced by its decay product, while all other
	particles stay in the parton state as spectators.

	Technically, we implement the decay chain as a stack structure and
	include information from the associated decay object for easier
	debugging. This is a decay chain entry:
	<<Decays: types>>=
	type, extends (connected_state_t) :: decay_chain_entry_t
	private
	integer :: index = 0
	type(decay_config_t), pointer :: config => null ()
	integer :: selected_mci = 0
	integer :: selected_term = 0
	type(decay_chain_entry_t), pointer :: previous => null ()
	end type decay_chain_entry_t

	@ %def decay_chain_entry_t
	@ This is the complete chain; we need just a pointer to the last
	entry. We also include a pointer to the master process instance,
	which serves as the seed for the decay chain.

	The evaluator [[correlated_trace]] traces over all quantum numbers
	for the final spin-correlated (but color-summed) evaluator of the
	decay chain. This allows us to compute the probability for a momentum
	configuration, given that all individual density matrices (of the
	initial process and the subsequent decays) have been normalized to one.

	Note: This trace is summed over color, so color is treated exactly
	when computing spin correlations. However, we do not keep
	non-diagonal color correlations. When an event is accepted, we
	compute probabilities for all color states and can choose one of them.
	<<Decays: public>>=
	public :: decay_chain_t
	<<Decays: types>>=
	type :: decay_chain_t
	private
	type(process_instance_t), pointer :: process_instance => null ()
	integer :: selected_term = 0
	type(evaluator_t) :: correlated_trace
	type(decay_chain_entry_t), pointer :: last => null ()
	contains
	<<Decays: decay chain: TBP>>
	end type decay_chain_t

	@ %def decay_chain_t
	@ The finalizer recursively deletes and deallocates the entries.
	<<Decays: decay chain: TBP>>=
	procedure :: final => decay_chain_final
	<<Decays: procedures>>=
	subroutine decay_chain_final (object)
	class(decay_chain_t), intent(inout) :: object
	type(decay_chain_entry_t), pointer :: entry
	do while (associated (object%last))
	entry => object%last
	object%last => entry%previous
	call entry%final ()
	deallocate (entry)
	end do
	call object%correlated_trace%final ()
	end subroutine decay_chain_final

	@ %def decay_chain_final
	@ Doing output recursively allows us to display the chain in
	chronological order.
	<<Decays: decay chain: TBP>>=
	procedure :: write => decay_chain_write
	<<Decays: procedures>>=
	subroutine decay_chain_write (object, unit)
	class(decay_chain_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	write (u, "(1x,A)") "Decay chain:"
	call write_entries (object%last)
	call write_separator (u, 2)
	write (u, "(1x,A)") "Evaluator (correlated trace of the decay chain):"
	call write_separator (u)
	call object%correlated_trace%write (u)
	call write_separator (u, 2)
	contains
	recursive subroutine write_entries (entry)
	type(decay_chain_entry_t), intent(in), pointer :: entry
	if (associated (entry)) then
	call write_entries (entry%previous)
	call write_separator (u, 2)
	write (u, "(1x,A,I0)") "Decay #", entry%index
	call entry%config%write_header (u)
	write (u, "(3x,A,I0)") "Selected MCI = ", entry%selected_mci
	write (u, "(3x,A,I0)") "Selected term = ", entry%selected_term
	call entry%config%term_config(entry%selected_term)%write (u, indent=1)
	call entry%write (u)
	end if
	end subroutine write_entries
	end subroutine decay_chain_write

	@ %def decay_chain_write
	@
	Build a decay chain, recursively following the selected decays and
	terms in a decay tree. Before start, we finalize the chain, deleting
	any previous contents.
	<<Decays: decay chain: TBP>>=
	procedure :: build => decay_chain_build
	<<Decays: procedures>>=
	subroutine decay_chain_build (chain, decay_root)
	class(decay_chain_t), intent(inout), target :: chain
	type(decay_root_t), intent(in) :: decay_root
	type(quantum_numbers_mask_t), dimension(:), allocatable :: qn_mask
	type(interaction_t), pointer :: int_last_decay
	call chain%final ()
	if (decay_root%selected_term > 0) then
	chain%process_instance => decay_root%process_instance
	chain%selected_term = decay_root%selected_term
	call chain%build_term_entries (decay_root%term(decay_root%selected_term))
	end if
	int_last_decay => chain%last%get_matrix_int_ptr ()
	allocate (qn_mask (int_last_decay%get_n_tot ()))
	call qn_mask%init (mask_f = .true., mask_c = .true., mask_h = .true.)
	call chain%correlated_trace%init_qn_sum (int_last_decay, qn_mask)
	end subroutine decay_chain_build

	@ %def decay_chain_build
	@ Build the entries that correspond to a decay term. We have to scan
	all unstable particles.
	<<Decays: decay chain: TBP>>=
	procedure :: build_term_entries => decay_chain_build_term_entries
	<<Decays: procedures>>=
	recursive subroutine decay_chain_build_term_entries (chain, term)
	class(decay_chain_t), intent(inout) :: chain
	type(decay_term_t), intent(in) :: term
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t)
	if (unstable%selected_decay > 0) then
	call chain%build_decay_entries &
	(unstable%decay(unstable%selected_decay))
	end if
	end select
	end do
	end subroutine decay_chain_build_term_entries

	@ %def decay_chain_build_term_entries
	@ Build the entries that correspond to a specific decay. The
	decay term should have been determined, so we allocate a decay chain
	entry and fill it, then proceed to child decays.

	For the first entry, we convolute the connected state of the parent process
	instance with the isolated state of the current
	decay (which does not contain an extra beam entry for the parent).
	For subsequent entries, we take the previous entry as first factor.

	In principle, each chain entry (as a parton state) is capable of
	holding a subevent object and associated expressions. We currently do
	not make use of that feature.

	Before generating the decays, factor out the trace of the helicity
	density matrix of the parent parton state. This trace has
	been used for unweighting the original event (unweighted case) or it
	determines the overall weight, so it should not be taken into account
	in the decay chain generation.
	<<Decays: decay chain: TBP>>=
	procedure :: build_decay_entries => decay_chain_build_decay_entries
	<<Decays: procedures>>=
	recursive subroutine decay_chain_build_decay_entries (chain, decay)
	class(decay_chain_t), intent(inout) :: chain
	type(decay_t), intent(in) :: decay
	type(decay_chain_entry_t), pointer :: entry
	type(connected_state_t), pointer :: previous_state
	type(isolated_state_t), pointer :: current_decay
	type(helicity_t) :: hel
	type(quantum_numbers_t) :: qn_filter_conn
	allocate (entry)
	if (associated (chain%last)) then
	entry%previous => chain%last
	entry%index = entry%previous%index + 1
	previous_state => entry%previous%connected_state_t
	else
	entry%index = 1
	previous_state => &
	chain%process_instance%get_connected_state_ptr (chain%selected_term)
	end if
	entry%config => decay%config
	entry%selected_mci = decay%selected_mci
	entry%selected_term = decay%selected_term
	current_decay => decay%process_instance%get_isolated_state_ptr &
	(decay%selected_term)
	call entry%setup_connected_trace &
	(current_decay, previous_state%get_trace_int_ptr (), resonant=.true.)
	if (entry%config%flv%has_decay_helicity ()) then
	call hel%init (entry%config%flv%get_decay_helicity ())
	call qn_filter_conn%init (hel)
	call entry%setup_connected_matrix &
	(current_decay, previous_state%get_matrix_int_ptr (), &
	resonant=.true., qn_filter_conn = qn_filter_conn)
	call entry%setup_connected_flows &
	(current_decay, previous_state%get_flows_int_ptr (), &
	resonant=.true., qn_filter_conn = qn_filter_conn)
	else
	call entry%setup_connected_matrix &
	(current_decay, previous_state%get_matrix_int_ptr (), &
	resonant=.true.)
	call entry%setup_connected_flows &
	(current_decay, previous_state%get_flows_int_ptr (), &
	resonant=.true.)
	end if
	chain%last => entry
	call chain%build_term_entries (decay%term(decay%selected_term))
	end subroutine decay_chain_build_decay_entries

	@ %def decay_chain_build_decay_entries
	@ Recursively fill the decay chain with momenta and evaluate the
	matrix elements. Since all evaluators should have correct source
	entries at this point, momenta are automatically retrieved from the
	appropriate process instance.


	Like we did above for the parent process, factor out the trace for
	each subsequent decay (the helicity density matrix in the isolated
	state, which is taken for the convolution).
	<<Decays: decay chain: TBP>>=
	procedure :: evaluate => decay_chain_evaluate
	<<Decays: procedures>>=
	subroutine decay_chain_evaluate (chain)
	class(decay_chain_t), intent(inout) :: chain
	call evaluate (chain%last)
	call chain%correlated_trace%receive_momenta ()
	call chain%correlated_trace%evaluate ()
	contains
	recursive subroutine evaluate (entry)
	type(decay_chain_entry_t), intent(inout), pointer :: entry
	if (associated (entry)) then
	call evaluate (entry%previous)
	call entry%receive_kinematics ()
	call entry%evaluate_trace ()
	call entry%evaluate_event_data ()
	end if
	end subroutine evaluate
	end subroutine decay_chain_evaluate

	@ %def decay_chain_evaluate
	@ Return the probability of a decay chain. This is given as the trace
	of the density matrix with intermediate helicity correlations,
	normalized by the product of the uncorrelated density matrix traces. This
	works only if an event has been evaluated and the [[correlated_trace]]
	evaluator is filled. By definition, this evaluator has only one
	matrix element, and this must be real.
	<<Decays: decay chain: TBP>>=
	procedure :: get_probability => decay_chain_get_probability
	<<Decays: procedures>>=
	function decay_chain_get_probability (chain) result (x)
	class(decay_chain_t), intent(in) :: chain
	real(default) :: x
	x = real (chain%correlated_trace%get_matrix_element (1))
	end function decay_chain_get_probability

	@ %def decay_chain_get_probability
	@
	\subsection{Decay as Event Transform}
	The [[evt_decay]] object combines decay configuration, decay tree, and
	chain in a single object, as an implementation of the [[evt]] (event
	transform) abstract type.

	The [[var_list]] may be a pointer to the user variable list, which
	could contain overridden parameters for the decay processes.
	<<Decays: public>>=
	public :: evt_decay_t
	<<Decays: types>>=
	type, extends (evt_t) :: evt_decay_t
	private
	type(decay_root_config_t) :: decay_root_config
	type(decay_root_t) :: decay_root
	type(decay_chain_t) :: decay_chain
	type(var_list_t), pointer :: var_list => null ()
	contains
	<<Decays: evt decay: TBP>>
	end type evt_decay_t

	@ %def evt_decay_t
	@
	<<Decays: evt decay: TBP>>=
	procedure :: write_name => evt_decay_write_name
	<<Decays: procedures>>=
	subroutine evt_decay_write_name (evt, unit)
	class(evt_decay_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: partonic decays"
	end subroutine evt_decay_write_name

	@ %def evt_decay_write_name
	@ Output. We display the currently selected decay tree, which
	includes configuration data, and the decay chain, i.e., the evaluators.
	<<Decays: evt decay: TBP>>=
	procedure :: write => evt_decay_write
	<<Decays: procedures>>=
	subroutine evt_decay_write (evt, unit, verbose, more_verbose, testflag)
	class(evt_decay_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	logical :: verb, verb2
	integer :: u
	u = given_output_unit (unit)
	verb = .true.; if (present (verbose)) verb = verbose
	verb2 = .false.; if (present (more_verbose)) verb2 = more_verbose
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u, 2)
	call evt%base_write (u, testflag = testflag)
	if (associated (evt%var_list)) then
	call write_separator (u)
	write (u, "(1x,A)") "Variable list for simulation: &
	&[associated, not shown]"
	end if
	if (verb) then
	call write_separator (u)
	call evt%decay_root%write (u)
	if (verb2) then
	call evt%decay_chain%write (u)
	call evt%decay_root%write_process_instances (u, verb)
	end if
	else
	call write_separator (u, 2)
	end if
	end subroutine evt_decay_write

	@ %def evt_decay_write
	@ Set the pointer to a user variable list.
	<<Decays: evt decay: TBP>>=
	procedure :: set_var_list => evt_decay_set_var_list
	<<Decays: procedures>>=
	subroutine evt_decay_set_var_list (evt, var_list)
	class(evt_decay_t), intent(inout) :: evt
	type(var_list_t), intent(in), target :: var_list
	evt%var_list => var_list
	end subroutine evt_decay_set_var_list

	@ %def evt_decay_set_var_list
	@ Connect with a process instance and process. This initializes the
	decay configuration. The process stack is used to look for process
	objects that implement daughter decays.

	When all processes are assigned, configure the decay tree instance, using the
	decay tree configuration. First obtain the branching ratios, then allocate
	the decay tree. This is done once for all events.
	<<Decays: evt decay: TBP>>=
	procedure :: connect => evt_decay_connect
	<<Decays: procedures>>=
	subroutine evt_decay_connect (evt, process_instance, model, process_stack)
	class(evt_decay_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	call evt%base_connect (process_instance, model)
	if (associated (evt%var_list)) then
	call evt%decay_root_config%connect (process_instance%process, &
	model, process_stack, process_instance, evt%var_list)
	else
	call evt%decay_root_config%connect (process_instance%process, &
	model, process_stack, process_instance)
	end if
	call evt%decay_root_config%compute ()
	call evt%decay_root%init (evt%decay_root_config, evt%process_instance)
	end subroutine evt_decay_connect

	@ %def evt_decay_connect
	@ Prepare a new event: Select a decay chain and build the corresponding chain
	object.
	<<Decays: evt decay: TBP>>=
	procedure :: prepare_new_event => evt_decay_prepare_new_event
	<<Decays: procedures>>=
	subroutine evt_decay_prepare_new_event (evt, i_mci, i_term)
	class(evt_decay_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	call evt%reset ()
	evt%decay_root%selected_mci = i_mci
	evt%decay_root%selected_term = i_term
	call evt%decay_root%select_chain ()
	call evt%decay_chain%build (evt%decay_root)
	end subroutine evt_decay_prepare_new_event

	@ %def evt_decay_prepare_new_event
	@ Generate a weighted event and assign the resulting weight
	(probability). We use a chain initialized by the preceding
	subroutine, fill it with momenta and evaluate.
	<<Decays: evt decay: TBP>>=
	procedure :: generate_weighted => evt_decay_generate_weighted
	<<Decays: procedures>>=
	subroutine evt_decay_generate_weighted (evt, probability)
	class(evt_decay_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	call evt%decay_root%generate ()
	if (signal_is_pending ()) return
	call evt%decay_chain%evaluate ()
	probability = evt%decay_chain%get_probability ()
	end subroutine evt_decay_generate_weighted

	@ %def evt_decay_generate_weighted
	@ To create a usable event, we have to transform the interaction into a
	particle set; this requires factorization for the correlated density matrix,
	according to the factorization mode.
	<<Decays: evt decay: TBP>>=
	procedure :: make_particle_set => evt_decay_make_particle_set
	<<Decays: procedures>>=
	subroutine evt_decay_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_decay_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	type(interaction_t), pointer :: int_matrix, int_flows
	type(decay_chain_entry_t), pointer :: last_entry
	last_entry => evt%decay_chain%last
	int_matrix => last_entry%get_matrix_int_ptr ()
	int_flows => last_entry%get_flows_int_ptr ()
	call evt%factorize_interactions (int_matrix, int_flows, &
	factorization_mode, keep_correlations, r)
	call evt%tag_incoming ()
	end subroutine evt_decay_make_particle_set

	@ %def event_decay_make_particle_set
	@
	\subsubsection{Auxiliary}
	Eliminate numerical noise for the associated process instances.
	<<Decays: public>>=
	public :: pacify
	<<Decays: interfaces>>=
	interface pacify
	module procedure pacify_decay
	module procedure pacify_decay_gen
	module procedure pacify_term
	module procedure pacify_unstable
	end interface pacify
	<<Decays: procedures>>=
	subroutine pacify_decay (evt)
	class(evt_decay_t), intent(inout) :: evt
	call pacify_decay_gen (evt%decay_root)
	end subroutine pacify_decay

	recursive subroutine pacify_decay_gen (decay)
	class(decay_gen_t), intent(inout) :: decay
	if (associated (decay%process_instance)) then
	call pacify (decay%process_instance)
	end if
	if (decay%selected_term > 0) then
	call pacify_term (decay%term(decay%selected_term))
	end if
	end subroutine pacify_decay_gen

	recursive subroutine pacify_term (term)
	class(decay_term_t), intent(inout) :: term
	integer :: i
	do i = 1, size (term%particle_out)
	select type (unstable => term%particle_out(i)%c)
	type is (unstable_t); call pacify_unstable (unstable)
	end select
	end do
	end subroutine pacify_term

	recursive subroutine pacify_unstable (unstable)
	class(unstable_t), intent(inout) :: unstable
	if (unstable%selected_decay > 0) then
	call pacify_decay_gen (unstable%decay(unstable%selected_decay))
	end if
	end subroutine pacify_unstable

	@ %def pacify
	@ Prepare specific configurations for use in unit tests.
	<<Decays: unstable config: TBP>>=
	procedure :: init_test_case1
	procedure :: init_test_case2
	<<Decays: procedures>>=
	subroutine init_test_case1 (unstable, i, flv, integral, relerr, model)
	class(unstable_config_t), intent(inout) :: unstable
	integer, intent(in) :: i
	type(flavor_t), dimension(:,:), intent(in) :: flv
	real(default), intent(in) :: integral
	real(default), intent(in) :: relerr
	class(model_data_t), intent(in), target :: model
	associate (decay => unstable%decay_config(i))
	allocate (decay%term_config (1))
	call decay%init_term (1, flv, stable = [.true., .true.], model=model)
	decay%integral = integral
	decay%abs_error = integral * relerr
	end associate
	end subroutine init_test_case1

	subroutine init_test_case2 (unstable, flv1, flv21, flv22, model)
	class(unstable_config_t), intent(inout) :: unstable
	type(flavor_t), dimension(:,:), intent(in) :: flv1, flv21, flv22
	class(model_data_t), intent(in), target :: model
	associate (decay => unstable%decay_config(1))
	decay%integral = 1.e-3_default
	decay%abs_error = decay%integral * .01_default

	allocate (decay%term_config (1))
	call decay%init_term (1, flv1, stable = [.false., .true.], model=model)

	select type (w => decay%term_config(1)%prt(1)%c)
	type is (unstable_config_t)

	associate (w_decay => w%decay_config(1))
	w_decay%integral = 2._default
	allocate (w_decay%term_config (1))
	call w_decay%init_term (1, flv21, stable = [.true., .true.], &
	model=model)
	end associate
	associate (w_decay => w%decay_config(2))
	w_decay%integral = 1._default
	allocate (w_decay%term_config (1))
	call w_decay%init_term (1, flv22, stable = [.true., .true.], &
	model=model)
	end associate
	call w%compute ()

	end select
	end associate
	end subroutine init_test_case2

	@ %def init_test_case1
	@ %def init_test_case2
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[decays_ut.f90]]>>=
	<<File header>>

	module decays_ut
	use unit_tests
	use decays_uti

	<<Standard module head>>

	<<Decays: public test>>

	<<Decays: public test auxiliary>>

	contains

	<<Decays: test driver>>

	end module decays_ut
	@ %def decays_ut
	@
	<<[[decays_uti.f90]]>>=
	<<File header>>

	module decays_uti

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use sm_qcd
	use model_data
	use state_matrices, only: FM_IGNORE_HELICITY
	use interactions, only: reset_interaction_counter
	use flavors
	use process_libraries
	use rng_base
	use mci_base
	use mci_midpoint
	use phs_base
	use phs_single
	use prc_core
	use prc_test, only: prc_test_create_library
	use process, only: process_t
	use instances, only: process_instance_t
	use process_stacks

	use decays

	use rng_base_ut, only: rng_test_t, rng_test_factory_t

	<<Standard module head>>

	<<Decays: public test auxiliary>>

	<<Decays: test declarations>>

	contains

	<<Decays: tests>>

	<<Decays: test auxiliary>>

	end module decays_uti

	@ %def decays_uti
	@ API: driver for the unit tests below.
	<<Decays: public test>>=
	public :: decays_test
	<<Decays: test driver>>=
	subroutine decays_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Decays: execute tests>>
	end subroutine decays_test

	@ %def decays_test
	@
	\subsubsection{Testbed}
	As a variation of the [[prepare_test_process]] routine used elsewhere, we
	define here a routine that creates two processes (scattering $ss\to ss$ and
	decay $s\to f\bar f$), compiles and integrates them and prepares for event
	generation.
	<<Decays: public test auxiliary>>=
	public :: prepare_testbed
	<<Decays: test auxiliary>>=
	subroutine prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering, decay, decay_rest_frame)
	type(process_library_t), intent(out), target :: lib
	type(process_stack_t), intent(out) :: process_stack
	type(string_t), intent(in) :: prefix
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: scattering, decay
	logical, intent(in), optional :: decay_rest_frame

	type(model_data_t), target :: model
	class(model_data_t), pointer :: model_copy
	type(string_t) :: libname, procname1, procname2, run_id
	type(qcd_t) :: qcd
	class(rng_factory_t), allocatable :: rng_factory
	type(process_entry_t), pointer :: process
	type(process_instance_t), allocatable, target :: process_instance
	class(mci_t), allocatable :: mci_template
	class(phs_config_t), allocatable :: phs_config_template
	type(field_data_t), pointer :: field_data
	real(default) :: sqrts

	libname = prefix // "_lib"
	procname1 = prefix // "_p"
	procname2 = prefix // "_d"
	run_id = prefix

	call model%init_test ()
	call model%set_par (var_str ("ff"), 0.4_default)
	call model%set_par (var_str ("mf"), &
	model%get_real (var_str ("ff")) * model%get_real (var_str ("ms")))

	if (scattering .and. decay) then
	field_data => model%get_field_ptr (25)
	call field_data%set (p_is_stable = .false.)
	end if

	call prc_test_create_library (libname, lib, &
	scattering = .true., decay = .true., &
	procname1 = procname1, procname2 = procname2)

	call reset_interaction_counter ()

	allocate (mci_midpoint_t :: mci_template)
	allocate (phs_single_config_t :: phs_config_template)

	if (scattering) then

	allocate (rng_test_factory_t :: rng_factory)
	allocate (model_copy)
	call model_copy%init (model%get_name (), &
	model%get_n_real (), &
	model%get_n_complex (), &
	model%get_n_field (), &
	model%get_n_vtx ())
	call model_copy%copy_from (model)

	allocate (process)
	call process%init (procname1, &
	run_id, lib, os_data, qcd, rng_factory, model_copy)
	call process%setup_test_cores ()
	call process%init_component &
	(1, .true., mci_template, phs_config_template)
	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()
	call process%setup_mci ()
	call process%setup_terms ()

	allocate (process_instance)
	call process_instance%init (process%process_t)
	call process_instance%integrate (1, n_it = 1, n_calls = 100)
	call process%final_integration (1)
	call process_instance%final ()
	deallocate (process_instance)

	call process%prepare_simulation (1)
	call process_stack%push (process)
	end if

	if (decay) then
	allocate (rng_test_factory_t :: rng_factory)
	allocate (model_copy)
	call model_copy%init (model%get_name (), &
	model%get_n_real (), &
	model%get_n_complex (), &
	model%get_n_field (), &
	model%get_n_vtx ())
	call model_copy%copy_from (model)

	allocate (process)
	call process%init (procname2, &
	run_id, lib, os_data, qcd, rng_factory, model_copy)
	call process%setup_test_cores ()
	call process%init_component &
	(1, .true., mci_template, phs_config_template)
	if (present (decay_rest_frame)) then
	call process%setup_beams_decay (rest_frame = decay_rest_frame, i_core = 1)
	else
	call process%setup_beams_decay (rest_frame = .not. scattering, i_core = 1)
	end if
	call process%configure_phs ()
	call process%setup_mci ()
	call process%setup_terms ()

	allocate (process_instance)
	call process_instance%init (process%process_t)
	call process_instance%integrate (1, n_it=1, n_calls=100)
	call process%final_integration (1)
	call process_instance%final ()
	deallocate (process_instance)

	call process%prepare_simulation (1)
	call process_stack%push (process)
	end if

	call model%final ()

	end subroutine prepare_testbed

	@ %def prepare_testbed
	@
	\subsubsection{Simple decay configuration}
	We define a branching configuration with two decay modes. We set the
	integral values by hand, so we do not need to evaluate processes, yet.
	<<Decays: execute tests>>=
	call test (decays_1, "decays_1", &
	"branching and decay configuration", &
	u, results)
	<<Decays: test declarations>>=
	public :: decays_1
	<<Decays: tests>>=
	subroutine decays_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(flavor_t) :: flv_h
	type(flavor_t), dimension(2,1) :: flv_hbb, flv_hgg
	type(unstable_config_t), allocatable :: unstable

	write (u, "(A)") "* Test output: decays_1"
	write (u, "(A)") "* Purpose: Set up branching and decay configuration"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call os_data_init (os_data)
	call model%init_sm_test ()

	call flv_h%init (25, model)
	call flv_hbb(:,1)%init ([5, -5], model)
	call flv_hgg(:,1)%init ([22, 22], model)

	write (u, "(A)") "* Set up branching and decay"
	write (u, "(A)")

	allocate (unstable)
	call unstable%init (flv_h)
	call unstable%init_decays ([var_str ("h_bb"), var_str ("h_gg")], model)

	call unstable%init_test_case1 &
	(1, flv_hbb, 1.234e-3_default, .02_default, model)

	call unstable%init_test_case1 &
	(2, flv_hgg, 3.085e-4_default, .08_default, model)

	call unstable%compute ()
	call unstable%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call unstable%final ()
	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: decays_1"

	end subroutine decays_1

	@ %def decays_1
	@
	\subsubsection{Cascade decay configuration}
	We define a branching configuration with one decay, which is followed
	by another branching.
	<<Decays: execute tests>>=
	call test (decays_2, "decays_2", &
	"cascade decay configuration", &
	u, results)
	<<Decays: test declarations>>=
	public :: decays_2
	<<Decays: tests>>=
	subroutine decays_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(model_data_t), target :: model
	type(flavor_t) :: flv_h, flv_wp, flv_wm
	type(flavor_t), dimension(2,1) :: flv_hww, flv_wud, flv_wen
	type(unstable_config_t), allocatable :: unstable

	write (u, "(A)") "* Test output: decays_2"
	write (u, "(A)") "* Purpose: Set up cascade branching"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call os_data_init (os_data)
	call model%init_sm_test ()

	call model%set_unstable (25, [var_str ("h_ww")])
	call model%set_unstable (24, [var_str ("w_ud"), var_str ("w_en")])

	call flv_h%init (25, model)
	call flv_hww(:,1)%init ([24, -24], model)
	call flv_wp%init (24, model)
	call flv_wm%init (-24, model)
	call flv_wud(:,1)%init ([2, -1], model)
	call flv_wen(:,1)%init ([-11, 12], model)


	write (u, "(A)") "* Set up branching and decay"
	write (u, "(A)")

	allocate (unstable)
	call unstable%init (flv_h, set_decays=.true., model=model)

	call unstable%init_test_case2 (flv_hww, flv_wud, flv_wen, model)

	call unstable%compute ()
	call unstable%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call unstable%final ()
	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: decays_2"

	end subroutine decays_2

	@ %def decays_2
	@
	\subsubsection{Decay and Process Object}
	We define a branching configuration with one decay and connect this
	with an actual process object.
	<<Decays: execute tests>>=
	call test (decays_3, "decays_3", &
	"associate process", &
	u, results)
	<<Decays: test declarations>>=
	public :: decays_3
	<<Decays: tests>>=
	subroutine decays_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(process_library_t), target :: lib
	type(string_t) :: prefix
	type(string_t) :: procname2
	type(process_stack_t) :: process_stack
	type(process_t), pointer :: process
	type(unstable_config_t), allocatable :: unstable
	type(flavor_t) :: flv

	write (u, "(A)") "* Test output: decays_3"
	write (u, "(A)") "* Purpose: Connect a decay configuration &
	&with a process"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment and integrate process"
	write (u, "(A)")

	call os_data_init (os_data)

	prefix = "decays_3"
	call prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering=.false., decay=.true., decay_rest_frame=.false.)

	procname2 = prefix // "_d"
	process => process_stack%get_process_ptr (procname2)
	model => process%get_model_ptr ()
	call process%write (.false., u)

	write (u, "(A)")
	write (u, "(A)") "* Set up branching and decay"
	write (u, "(A)")

	call flv%init (25, model)

	allocate (unstable)
	call unstable%init (flv)
	call unstable%init_decays ([procname2], model)

	write (u, "(A)") "* Connect decay with process object"
	write (u, "(A)")

	call unstable%connect_decay (1, process, model)

	call unstable%compute ()
	call unstable%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call unstable%final ()
	call process_stack%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: decays_3"

	end subroutine decays_3

	@ %def decays_3
	@
	\subsubsection{Decay and Process Object}
	Building upon the previous test, we set up a decay instance and generate a
	decay event.
	<<Decays: execute tests>>=
	call test (decays_4, "decays_4", &
	"decay instance", &
	u, results)
	<<Decays: test declarations>>=
	public :: decays_4
	<<Decays: tests>>=
	subroutine decays_4 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(process_library_t), target :: lib
	type(string_t) :: prefix, procname2
	class(rng_t), allocatable :: rng
	type(process_stack_t) :: process_stack
	type(process_t), pointer :: process
	type(unstable_config_t), allocatable, target :: unstable
	type(flavor_t) :: flv
	type(unstable_t), allocatable :: instance

	write (u, "(A)") "* Test output: decays_4"
	write (u, "(A)") "* Purpose: Create a decay process and evaluate &
	&an instance"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment, process, &
	&and decay configuration"
	write (u, "(A)")

	call os_data_init (os_data)

	prefix = "decays_4"
	call prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering=.false., decay=.true., decay_rest_frame = .false.)

	procname2 = prefix // "_d"
	process => process_stack%get_process_ptr (procname2)
	model => process%get_model_ptr ()

	call flv%init (25, model)

	allocate (unstable)
	call unstable%init (flv)
	call unstable%init_decays ([procname2], model)

	call model%set_unstable (25, [procname2])

	call unstable%connect_decay (1, process, model)

	call unstable%compute ()

	allocate (rng_test_t :: rng)

	allocate (instance)
	call instance%init (unstable)
	call instance%import_rng (rng)

	call instance%select_chain ()
	call instance%generate ()
	call instance%write (u)

	write (u, *)
	call instance%write_process_instances (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call instance%final ()
	call process_stack%final ()
	call unstable%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: decays_4"

	end subroutine decays_4

	@ %def decays_4
	@
	\subsubsection{Decay with Parent Process}
	We define a scattering process $ss\to ss$ and subsequent decays $s\to f\bar
	f$.
	<<Decays: execute tests>>=
	call test (decays_5, "decays_5", &
	"parent process and decay", &
	u, results)
	<<Decays: test declarations>>=
	public :: decays_5
	<<Decays: tests>>=
	subroutine decays_5 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(process_library_t), target :: lib
	type(string_t) :: prefix, procname1, procname2
	type(process_stack_t) :: process_stack
	type(process_t), pointer :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(decay_root_config_t), target :: decay_root_config
	type(decay_root_t) :: decay_root
	type(decay_chain_t) :: decay_chain

	write (u, "(A)") "* Test output: decays_5"
	write (u, "(A)") "* Purpose: Handle a process with subsequent decays"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment and parent process"
	write (u, "(A)")

	call os_data_init (os_data)

	prefix = "decays_5"
	procname1 = prefix // "_p"
	procname2 = prefix // "_d"
	call prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering=.true., decay=.true.)

	write (u, "(A)") "* Initialize decay process"
	write (u, "(A)")

	process => process_stack%get_process_ptr (procname1)
	model => process%get_model_ptr ()
	call model%set_unstable (25, [procname2])

	write (u, "(A)") "* Initialize decay tree configuration"
	write (u, "(A)")

	call decay_root_config%connect (process, model, process_stack)
	call decay_root_config%compute ()
	call decay_root_config%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize decay tree"

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	call process_instance%init_simulation (1)

	call decay_root%init (decay_root_config, process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Select decay chain"
	write (u, "(A)")

	call decay_root%set_mci (1)
	!!! Not yet implemented; there is only one term anyway:
	! call process_instance%select_i_term (decay_root%selected_term)
	call decay_root%set_term (1)
	call decay_root%select_chain ()

	call decay_chain%build (decay_root)

	call decay_root%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate event"
	write (u, "(A)")

	call process_instance%generate_unweighted_event (decay_root%get_mci ())
	call process_instance%evaluate_event_data ()

	call decay_root%generate ()

	call pacify (decay_root)

	write (u, "(A)") "* Process instances"
	write (u, "(A)")

	call decay_root%write_process_instances (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate decay chain"
	write (u, "(A)")

	call decay_chain%evaluate ()
	call decay_chain%write (u)

	write (u, *)
	write (u, "(A,ES19.12)") "chain probability =", &
	decay_chain%get_probability ()

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call decay_chain%final ()
	call decay_root%final ()
	call decay_root_config%final ()
	call process_instance%final ()
	deallocate (process_instance)

	call process%final ()
	call process_stack%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: decays_5"

	end subroutine decays_5

	@ %def decays_5
	@
	\subsubsection{Decay as Event Transform}
	Again, we define a scattering process $ss\to ss$ and subsequent decays
	$s\to f\bar f$.
	<<Decays: execute tests>>=
	call test (decays_6, "decays_6", &
	"evt_decay object", &
	u, results)
	<<Decays: test declarations>>=
	public :: decays_6
	<<Decays: tests>>=
	subroutine decays_6 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(process_library_t), target :: lib
	type(string_t) :: prefix, procname1, procname2
	type(process_stack_t) :: process_stack
	type(process_t), pointer :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(evt_decay_t), target :: evt_decay
	integer :: factorization_mode
	logical :: keep_correlations

	write (u, "(A)") "* Test output: decays_6"
	write (u, "(A)") "* Purpose: Handle a process with subsequent decays"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment and parent process"
	write (u, "(A)")

	call os_data_init (os_data)

	prefix = "decays_6"
	procname1 = prefix // "_p"
	procname2 = prefix // "_d"
	call prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering=.true., decay=.true.)

	write (u, "(A)") "* Initialize decay process"

	process => process_stack%get_process_ptr (procname1)
	model => process%get_model_ptr ()
	call model%set_unstable (25, [procname2])

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	call process_instance%init_simulation (1)

	write (u, "(A)")
	write (u, "(A)") "* Initialize decay object"

	call evt_decay%connect (process_instance, model, process_stack)

	write (u, "(A)")
	write (u, "(A)") "* Generate scattering event"

	call process_instance%generate_unweighted_event (1)
	call process_instance%evaluate_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Select decay chain and generate event"
	write (u, "(A)")

	call evt_decay%prepare_new_event (1, 1)
	call evt_decay%generate_unweighted ()

	factorization_mode = FM_IGNORE_HELICITY
	keep_correlations = .false.
	call evt_decay%make_particle_set (factorization_mode, keep_correlations)

	call evt_decay%write (u, verbose = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_decay%final ()
	call process_instance%final ()
	deallocate (process_instance)

	call process_stack%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: decays_6"

	end subroutine decays_6

	@ %def decays_6
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Tau decays}
	<<[[tau_decays.f90]]>>=
	<<File header>>

	module tau_decays

	<<Use kinds>>
	use io_units
	use format_utils, only: write_separator
	use sm_qcd
	use model_data
	use models
	use event_transforms

	<<Standard module head>>

	<<Tau decays: public>>

	<<Tau decays: types>>

	contains

	<<Tau decays: procedures>>

	end module tau_decays
	@ %def tau_decays
	\subsection{Tau Decays Event Transform}
	This is the type for the tau decay event transform.
	<<Tau decays: public>>=
	public :: evt_tau_decays_t
	<<Tau decays: types>>=
	type, extends (evt_t) :: evt_tau_decays_t
	type(model_t), pointer :: model_hadrons => null()
	type(qcd_t), pointer :: qcd_t => null()
	contains
	<<Tau decays: evt tau decays: TBP>>
	end type evt_tau_decays_t

	@ %def evt_tau_decays_t
	<<Tau decays: evt tau decays: TBP>>=
	procedure :: write_name => evt_tau_decays_write_name
	<<Tau decays: procedures>>=
	subroutine evt_tau_decays_write_name (evt, unit)
	class(evt_tau_decays_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: tau decays"
	end subroutine evt_tau_decays_write_name

	@ %def evt_tau_decays_write_name
	@ Output.
	<<Tau decays: evt tau decays: TBP>>=
	procedure :: write => evt_tau_decays_write
	<<Tau decays: procedures>>=
	subroutine evt_tau_decays_write (evt, unit, verbose, more_verbose, testflag)
	class(evt_tau_decays_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u)
	call evt%base_write (u, testflag = testflag, show_set = .false.)
	if (evt%particle_set_exists) &
	call evt%particle_set%write &
	(u, summary = .true., compressed = .true., testflag = testflag)
	call write_separator (u)
	end subroutine evt_tau_decays_write

	@ %def evt_tau_decays_write
	@ Here we take the particle set from the previous event transform and
	apply the tau decays. What probability should be given back, the
	product of branching ratios of the corresponding tau decays?
	<<Tau decays: evt tau decays: TBP>>=
	procedure :: generate_weighted => evt_tau_decays_generate_weighted
	<<Tau decays: procedures>>=
	subroutine evt_tau_decays_generate_weighted (evt, probability)
	class(evt_tau_decays_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	logical :: valid
	evt%particle_set = evt%previous%particle_set
	!!! To be checked or expanded
	probability = 1
	valid = .true.
	evt%particle_set_exists = valid
	end subroutine evt_tau_decays_generate_weighted

	@ %def evt_tau_decays_generate_weighted
	@ The factorization parameters are irrelevant.
	<<Tau decays: evt tau decays: TBP>>=
	procedure :: make_particle_set => evt_tau_decays_make_particle_set
	<<Tau decays: procedures>>=
	subroutine evt_tau_decays_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_tau_decays_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	logical :: valid
	!!! to be checked and expanded
	valid = .true.
	evt%particle_set_exists = evt%particle_set_exists .and. valid
	end subroutine evt_tau_decays_make_particle_set

	@ %def event_tau_decays_make_particle_set
	@
	<<Tau decays: evt tau decays: TBP>>=
	procedure :: prepare_new_event => evt_tau_decays_prepare_new_event
	<<Tau decays: procedures>>=
	subroutine evt_tau_decays_prepare_new_event (evt, i_mci, i_term)
	class(evt_tau_decays_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	call evt%reset ()
	end subroutine evt_tau_decays_prepare_new_event

	@ %def evt_tau_decays_prepare_new_event
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Shower}
	We might use matrix elements of LO and NLO to increase the accuracy of
	the shower in the sense of matching as well as merging.
	<<[[shower.f90]]>>=
	<<File header>>

	module shower

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_utils, only: write_separator
	use system_defs, only: LF
	use os_interface
	use diagnostics
	use lorentz
	use pdf
	use subevents, only: PRT_BEAM_REMNANT, PRT_INCOMING, PRT_OUTGOING

	use shower_base
	use matching_base
	use powheg_matching, only: powheg_matching_t

	use sm_qcd
	use model_data
	use rng_base

	use event_transforms
	use models
	use hep_common
	use process, only: process_t
	use instances, only: process_instance_t
	use process_stacks

	<<Standard module head>>

	<<Shower: public>>

	<<Shower: parameters>>

	<<Shower: types>>

	contains

	<<Shower: procedures>>

	end module shower
	@ %def shower
	@
	\subsection{Configuration Parameters}
	[[POWHEG_TESTING]] allows to disable the parton shower for validation
	and testing of the POWHEG procedure.
	<<Shower: parameters>>=
	logical, parameter :: POWHEG_TESTING = .false.

	@ %def POWHEG_TESTING
	@
	\subsection{Event Transform}
	The event transforms can do more than mere showering. Especially, it
	may reweight showered events to fixed-order matrix elements. The
	[[model_hadrons]] is supposed to be the SM variant that contains all
	hadrons that can be generated in the shower.
	<<Shower: public>>=
	public :: evt_shower_t
	<<Shower: types>>=
	type, extends (evt_t) :: evt_shower_t
	class(shower_base_t), allocatable :: shower
	class(matching_t), allocatable :: matching
	type(model_t), pointer :: model_hadrons => null ()
	type(qcd_t), pointer :: qcd => null()
	type(pdf_data_t) :: pdf_data
	type(os_data_t) :: os_data
	logical :: is_first_event
	contains
	<<Shower: evt shower: TBP>>
	end type evt_shower_t

	@ %def evt_shower_t
	@
	<<Shower: evt shower: TBP>>=
	procedure :: write_name => evt_shower_write_name
	<<Shower: procedures>>=
	subroutine evt_shower_write_name (evt, unit)
	class(evt_shower_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: shower"
	end subroutine evt_shower_write_name

	@ %def evt_shower_write_name
	@ Output.
	<<Shower: evt shower: TBP>>=
	procedure :: write => evt_shower_write
	<<Shower: procedures>>=
	subroutine evt_shower_write (evt, unit, verbose, more_verbose, testflag)
	class(evt_shower_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	call evt%write_name (u)
	call write_separator (u)
	call evt%base_write (u, testflag = testflag, show_set = .false.)
	if (evt%particle_set_exists) call evt%particle_set%write &
	(u, summary = .true., compressed = .true., testflag = testflag)
	call write_separator (u)
	call evt%shower%settings%write (u)
	end subroutine evt_shower_write

	@ %def evt_shower_write
	<<Shower: evt shower: TBP>>=
	procedure :: connect => evt_shower_connect
	<<Shower: procedures>>=
	subroutine evt_shower_connect &
	(evt, process_instance, model, process_stack)
	class(evt_shower_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	call evt%base_connect (process_instance, model, process_stack)
	call evt%make_rng (evt%process)
	if (allocated (evt%matching)) then
	call evt%matching%connect (process_instance, model, evt%shower)
	end if
	end subroutine evt_shower_connect

	@ %def evt_shower_connect
	@ Initialize the event transformation. This will be executed once
	during dispatching. The [[model_hadrons]] is supposed to be the SM
	variant that contains all hadrons that may be generated in the
	shower.
	<<Shower: evt shower: TBP>>=
	procedure :: init => evt_shower_init
	<<Shower: procedures>>=
	subroutine evt_shower_init (evt, model_hadrons, os_data)
	class(evt_shower_t), intent(out) :: evt
	type(model_t), intent(in), target :: model_hadrons
	type(os_data_t), intent(in) :: os_data
	evt%os_data = os_data
	evt%model_hadrons => model_hadrons
	evt%is_first_event = .true.
	end subroutine evt_shower_init

	@ %def evt_shower_init
	@ Create RNG instances, spawned by the process object.
	<<Shower: evt shower: TBP>>=
	procedure :: make_rng => evt_shower_make_rng
	<<Shower: procedures>>=
	subroutine evt_shower_make_rng (evt, process)
	class(evt_shower_t), intent(inout) :: evt
	type(process_t), intent(inout) :: process
	class(rng_t), allocatable :: rng
	call process%make_rng (rng)
	call evt%shower%import_rng (rng)
	if (allocated (evt%matching)) then
	call process%make_rng (rng)
	call evt%matching%import_rng (rng)
	end if
	end subroutine evt_shower_make_rng

	@ %def evt_shower_make_rng
	@ Things we want to do for a new event before the whole event
	transformation chain is evaluated.
	<<Shower: evt shower: TBP>>=
	procedure :: prepare_new_event => evt_shower_prepare_new_event
	<<Shower: procedures>>=
	subroutine evt_shower_prepare_new_event (evt, i_mci, i_term)
	class(evt_shower_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	+ real(default) :: fac_scale, alpha_s
	+ fac_scale = evt%process_instance%get_fac_scale (i_term)
	+ alpha_s = evt%process_instance%get_alpha_s (i_term)
	call evt%reset ()
	- call evt%shower%prepare_new_event ()
	+ call evt%shower%prepare_new_event (fac_scale, alpha_s)
	end subroutine evt_shower_prepare_new_event

	@ %def evt_shower_prepare_new_event
	@
	<<Shower: evt shower: TBP>>=
	procedure :: first_event => evt_shower_first_event
	<<Shower: procedures>>=
	subroutine evt_shower_first_event (evt)
	class(evt_shower_t), intent(inout) :: evt
	double precision :: pdftest
	call msg_debug (D_TRANSFORMS, "evt_shower_first_event")
	associate (settings => evt%shower%settings)
	settings%hadron_collision = .false.
	!!! !!! !!! Workaround for PGF90 v16.1
	!!! if (all (evt%particle_set%prt(1:2)%flv%get_pdg_abs () <= 39)) then
	if (evt%particle_set%prt(1)%flv%get_pdg_abs () <= 39 .and. &
	evt%particle_set%prt(2)%flv%get_pdg_abs () <= 39) then
	settings%hadron_collision = .false.
	!!! else if (all (evt%particle_set%prt(1:2)%flv%get_pdg_abs () >= 100)) then
	else if (evt%particle_set%prt(1)%flv%get_pdg_abs () >= 100 .and. &
	evt%particle_set%prt(2)%flv%get_pdg_abs () >= 100) then
	settings%hadron_collision = .true.
	else
	call msg_fatal ("evt_shower didn't recognize beams setup")
	end if
	call msg_debug (D_TRANSFORMS, "hadron_collision", settings%hadron_collision)
	if (allocated (evt%matching)) then
	evt%matching%is_hadron_collision = settings%hadron_collision
	call evt%matching%first_event ()
	end if
	if (.not. settings%hadron_collision .and. settings%isr_active) then
	call msg_fatal ("?ps_isr_active is only intended for hadron-collisions")
	end if
	if (evt%pdf_data%type == STRF_LHAPDF5) then
	if (settings%isr_active .and. settings%hadron_collision) then
	call GetQ2max (0, pdftest)
	if (pdftest < epsilon (pdftest)) then
	call msg_bug ("ISR QCD shower enabled, but LHAPDF not " // &
	"initialized," // LF // " aborting simulation")
	return
	end if
	end if
	else if (evt%pdf_data%type == STRF_PDF_BUILTIN .and. &
	settings%method == PS_PYTHIA6) then
	call msg_fatal ("Builtin PDFs cannot be used for PYTHIA showers," &
	// LF // " aborting simulation")
	return
	end if
	end associate
	evt%is_first_event = .false.
	end subroutine evt_shower_first_event

	@ %def evt_shower_first_event
	@ Here we take the particle set from the previous event transform
	(assuming that there is always one) and apply the shower algorithm. The
	result is stored in the event transform of the current object. We
	always return a probability of unity as we don't have the analytic
	weight of the combination of shower, MLM matching and hadronization. A
	subdivision into multiple event transformations is under construction.
	Invalid or vetoed events have to be discarded by the caller which is why
	we mark the particle set as invalid. This procedure directly takes the
	(MLM) matching into account.
	<<Shower: evt shower: TBP>>=
	procedure :: generate_weighted => evt_shower_generate_weighted
	<<Shower: procedures>>=
	subroutine evt_shower_generate_weighted (evt, probability)
	class(evt_shower_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	logical :: valid, vetoed
	- integer :: i_term
	- real(default) :: fac_scale
	call msg_debug (D_TRANSFORMS, "evt_shower_generate_weighted")
	if (signal_is_pending ()) return
	- i_term = 1
	evt%particle_set = evt%previous%particle_set
	valid = .true.; vetoed = .false.
	- fac_scale = evt%process_instance%get_fac_scale (i_term)
	if (evt%is_first_event) call evt%first_event ()
	- call evt%shower%import_particle_set &
	- (evt%particle_set, evt%os_data, fac_scale)
	+ call evt%shower%import_particle_set (evt%particle_set)
	if (allocated (evt%matching)) then
	call evt%matching%before_shower (evt%particle_set, vetoed)
	if (msg_level(D_TRANSFORMS) >= DEBUG) then
	call msg_debug (D_TRANSFORMS, "Matching before generate emissions")
	call evt%matching%write ()
	end if
	end if
	if (.not. (vetoed .or. POWHEG_TESTING)) then
	if (evt%shower%settings%method == PS_PYTHIA6 .or. &
	evt%shower%settings%hadronization_active) then
	call assure_heprup (evt%particle_set)
	end if
	call evt%shower%generate_emissions (valid)
	end if
	probability = 1
	evt%particle_set_exists = valid .and. .not. vetoed
	end subroutine evt_shower_generate_weighted

	@ %def evt_shower_generate_weighted
	@ Here, we fill the particle set with the partons from the shower.
	The factorization parameters are irrelevant.
	We make a sanity check that the initial energy lands either in the
	outgoing particles or add to the beam remnant.
	<<Shower: evt shower: TBP>>=
	procedure :: make_particle_set => evt_shower_make_particle_set
	<<Shower: procedures>>=
	subroutine evt_shower_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_shower_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	type(vector4_t) :: sum_vec_in, sum_vec_out, sum_vec_beamrem, &
	sum_vec_beamrem_before
	logical :: vetoed, sane
	if (evt%particle_set_exists) then
	vetoed = .false.
	sum_vec_beamrem_before = sum (evt%particle_set%prt%p, &
	mask=evt%particle_set%prt%get_status () == PRT_BEAM_REMNANT)
	call evt%shower%make_particle_set (evt%particle_set, &
	evt%model, evt%model_hadrons)
	if (allocated (evt%matching)) then
	call evt%matching%after_shower (evt%particle_set, vetoed)
	end if
	if (debug_active (D_TRANSFORMS)) then
	call msg_debug (D_TRANSFORMS, &
	"Shower: obtained particle set after shower + matching")
	call evt%particle_set%write (summary = .true., compressed = .true.)
	end if
	sum_vec_in = sum (evt%particle_set%prt%p, &
	mask=evt%particle_set%prt%get_status () == PRT_INCOMING)
	sum_vec_out = sum (evt%particle_set%prt%p, &
	mask=evt%particle_set%prt%get_status () == PRT_OUTGOING)
	sum_vec_beamrem = sum (evt%particle_set%prt%p, &
	mask=evt%particle_set%prt%get_status () == PRT_BEAM_REMNANT)
	sum_vec_beamrem = sum_vec_beamrem - sum_vec_beamrem_before
	sane = abs(sum_vec_out%p(0) - sum_vec_in%p(0)) < &
	sum_vec_in%p(0) / 10 .or. &
	abs((sum_vec_out%p(0) + sum_vec_beamrem%p(0)) - sum_vec_in%p(0)) < &
	sum_vec_in%p(0) / 10
	sane = .true.
	evt%particle_set_exists = .not. vetoed .and. sane
	end if
	end subroutine evt_shower_make_particle_set

	@ %def event_shower_make_particle_set
	@
	<<Shower: evt shower: TBP>>=
	procedure :: contains_powheg_matching => evt_shower_contains_powheg_matching
	<<Shower: procedures>>=
	function evt_shower_contains_powheg_matching (evt) result (val)
	logical :: val
	class(evt_shower_t), intent(in) :: evt
	val = .false.
	if (allocated (evt%matching)) &
	val = evt%matching%get_method () == "POWHEG"
	end function evt_shower_contains_powheg_matching

	@ %def evt_shower_contains_powheg_matching
	@
	<<Shower: evt shower: TBP>>=
	procedure :: disable_powheg_matching => evt_shower_disable_powheg_matching
	<<Shower: procedures>>=
	subroutine evt_shower_disable_powheg_matching (evt)
	class(evt_shower_t), intent(inout) :: evt
	select type (matching => evt%matching)
	type is (powheg_matching_t)
	matching%active = .false.
	class default
	call msg_fatal ("Trying to disable powheg but no powheg matching is allocated!")
	end select
	end subroutine evt_shower_disable_powheg_matching

	@ %def evt_shower_disable_powheg_matching
	@
	<<Shower: evt shower: TBP>>=
	procedure :: enable_powheg_matching => evt_shower_enable_powheg_matching
	<<Shower: procedures>>=
	subroutine evt_shower_enable_powheg_matching (evt)
	class(evt_shower_t), intent(inout) :: evt
	select type (matching => evt%matching)
	type is (powheg_matching_t)
	matching%active = .true.
	class default
	call msg_fatal ("Trying to enable powheg but no powheg matching is allocated!")
	end select
	end subroutine evt_shower_enable_powheg_matching

	@ %def evt_shower_enable_powheg_matching
	@
	<<Shower: evt shower: TBP>>=
	procedure :: final => evt_shower_final
	<<Shower: procedures>>=
	subroutine evt_shower_final (evt)
	class(evt_shower_t), intent(inout) :: evt
	call evt%base_final ()
	if (allocated (evt%matching)) call evt%matching%final ()
	end subroutine evt_shower_final

	@ %def evt_shower_final
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[shower_ut.f90]]>>=
	<<File header>>

	module shower_ut
	use unit_tests
	use shower_uti

	<<Standard module head>>

	<<Shower: public test>>

	contains

	<<Shower: test driver>>

	end module shower_ut
	@ %def shower_ut
	@
	<<[[shower_uti.f90]]>>=
	<<File header>>

	module shower_uti

	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use os_interface
	use sm_qcd
	use physics_defs, only: BORN
	use model_data
	use state_matrices, only: FM_IGNORE_HELICITY
	use process_libraries
	use rng_base
	use rng_tao
	use mci_base
	use mci_midpoint
	use phs_base
	use phs_single
	use prc_core
	use prc_omega
	use variables
	use models
	use event_transforms
	use tauola_interface !NODEP!

	use process, only: process_t
	use instances, only: process_instance_t

	use pdf
	use shower_base
	use shower_core

	use shower

	<<Standard module head>>

	<<Shower: test declarations>>

	contains

	<<Shower: tests>>

	end module shower_uti

	@ %def shower_uti
	@ API: driver for the unit tests below.
	<<Shower: public test>>=
	public :: shower_test
	<<Shower: test driver>>=
	subroutine shower_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Shower: execute tests>>
	end subroutine shower_test

	@ %def shower_test
	@
	\subsubsection{Testbed}
	This sequence sets up a two-jet process, ready for generating events.
	<<Shower: tests>>=
	<<setup testbed>>
	@
	<<setup testbed>>=
	subroutine setup_testbed &
	(prefix, os_data, lib, model_list, process, process_instance)
	type(string_t), intent(in) :: prefix
	type(os_data_t), intent(out) :: os_data
	type(process_library_t), intent(out), target :: lib
	type(model_list_t), intent(out) :: model_list
	class(model_data_t), pointer :: model
	type(model_t), pointer :: model_tmp
	type(process_t), target, intent(out) :: process
	type(process_instance_t), target, intent(out) :: process_instance
	type(var_list_t), pointer :: model_vars
	type(string_t) :: model_name, libname, procname, run_id
	type(process_def_entry_t), pointer :: entry
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(qcd_t) :: qcd
	class(rng_factory_t), allocatable :: rng_factory
	class(prc_core_t), allocatable :: core_template
	class(mci_t), allocatable :: mci_template
	class(phs_config_t), allocatable :: phs_config_template
	real(default) :: sqrts

	model_name = "SM"
	libname = prefix // "_lib"
	procname = prefix // "p"
	run_id = "1"

	call os_data_init (os_data)
	allocate (rng_tao_factory_t :: rng_factory)
	allocate (model_tmp)
	call model_list%read_model (model_name, model_name // ".mdl", &
	os_data, model_tmp)
	model_vars => model_tmp%get_var_list_ptr ()
	call model_vars%set_real (var_str ("me"), 0._default, &
	is_known = .true.)
	model => model_tmp

	call lib%init (libname)

	allocate (prt_in (2), source = [var_str ("e-"), var_str ("e+")])
	allocate (prt_out (2), source = [var_str ("d"), var_str ("dbar")])

	allocate (entry)
	call entry%init (procname, model, n_in = 2, n_components = 1)
	call omega_make_process_component (entry, 1, &
	model_name, prt_in, prt_out, &
	report_progress=.true.)
	call lib%append (entry)

	call lib%configure (os_data)
	call lib%write_makefile (os_data, force = .true., verbose = .false.)
	call lib%clean (os_data, distclean = .false.)
	call lib%write_driver (force = .true.)
	call lib%load (os_data)

	call process%init (procname, run_id, lib, os_data, &
	qcd, rng_factory, model)

	allocate (prc_omega_t :: core_template)
	allocate (mci_midpoint_t :: mci_template)
	allocate (phs_single_config_t :: phs_config_template)

	model => process%get_model_ptr ()

	select type (core_template)
	type is (prc_omega_t)
	call core_template%set_parameters (model = model)
	end select
	call process%core_manager_register (BORN, 1, var_str ("omega"))
	call process%allocate_cm_arrays (1)
	call process%allocate_core (1, core_template)
	call process%init_cores ()
	call process%init_component &
	(1, .true., mci_template, phs_config_template)

	sqrts = 1000
	call process%setup_beams_sqrts (sqrts, i_core = 1)
	call process%configure_phs ()
	call process%setup_mci ()
	call process%setup_terms ()

	call process_instance%init (process)
	call process_instance%integrate (1, 1, 1000)
	call process%final_integration (1)

	call process_instance%setup_event_data (i_core = 1)
	call process_instance%init_simulation (1)
	call process_instance%generate_weighted_event (1)
	call process_instance%evaluate_event_data ()

	end subroutine setup_testbed

	@ %def setup_testbed
	@
	\subsubsection{Trivial Test}
	We generate a two-jet event and shower it using default settings, i.e.
	in disabled mode.
	<<Shower: execute tests>>=
	call test (shower_1, "shower_1", &
	"disabled shower", &
	u, results)
	<<Shower: test declarations>>=
	public :: shower_1
	<<Shower: tests>>=
	subroutine shower_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(process_library_t), target :: lib
	type(model_list_t) :: model_list
	class(model_data_t), pointer :: model
	type(model_t), pointer :: model_hadrons
	type(process_t), target :: process
	type(process_instance_t), target :: process_instance
	type(pdf_data_t) :: pdf_data
	integer :: factorization_mode
	logical :: keep_correlations
	class(evt_t), allocatable, target :: evt_trivial
	class(evt_t), allocatable, target :: evt_shower
	type(shower_settings_t) :: settings
	type(taudec_settings_t) :: taudec_settings

	write (u, "(A)") "* Test output: shower_1"
	write (u, "(A)") "* Purpose: Two-jet event with disabled shower"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"), &
	os_data, model_hadrons)
	call setup_testbed (var_str ("shower_1"), &
	os_data, lib, model_list, process, process_instance)

	write (u, "(A)") "* Set up trivial transform"
	write (u, "(A)")

	allocate (evt_trivial_t :: evt_trivial)
	model => process%get_model_ptr ()
	call evt_trivial%connect (process_instance, model)
	call evt_trivial%prepare_new_event (1, 1)
	call evt_trivial%generate_unweighted ()

	factorization_mode = FM_IGNORE_HELICITY
	keep_correlations = .false.
	call evt_trivial%make_particle_set (factorization_mode, keep_correlations)

	select type (evt_trivial)
	type is (evt_trivial_t)
	call evt_trivial%write (u)
	call write_separator (u, 2)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Set up shower event transform"
	write (u, "(A)")

	allocate (evt_shower_t :: evt_shower)
	select type (evt_shower)
	type is (evt_shower_t)
	call evt_shower%init (model_hadrons, os_data)
	allocate (shower_t :: evt_shower%shower)
	- call evt_shower%shower%init (settings, taudec_settings, pdf_data)
	+ call evt_shower%shower%init (settings, taudec_settings, pdf_data, os_data)
	call evt_shower%connect (process_instance, model)
	end select

	evt_trivial%next => evt_shower
	evt_shower%previous => evt_trivial

	call evt_shower%prepare_new_event (1, 1)
	call evt_shower%generate_unweighted ()
	call evt_shower%make_particle_set (factorization_mode, keep_correlations)

	select type (evt_shower)
	type is (evt_shower_t)
	call evt_shower%write (u)
	call write_separator (u, 2)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_shower%final ()
	call evt_trivial%final ()
	call process_instance%final ()
	call process%final ()
	call lib%final ()
	call model_hadrons%final ()
	deallocate (model_hadrons)
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: shower_1"

	end subroutine shower_1

	@ %def shower_1
	@
	\subsubsection{FSR Shower}
	We generate a two-jet event and shower it with the Whizard FSR shower.
	<<Shower: execute tests>>=
	call test (shower_2, "shower_2", &
	"final-state shower", &
	u, results)
	<<Shower: test declarations>>=
	public :: shower_2
	<<Shower: tests>>=
	subroutine shower_2 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(process_library_t), target :: lib
	type(model_list_t) :: model_list
	type(model_t), pointer :: model_hadrons
	class(model_data_t), pointer :: model
	type(process_t), target :: process
	type(process_instance_t), target :: process_instance
	integer :: factorization_mode
	logical :: keep_correlations
	type(pdf_data_t) :: pdf_data
	class(evt_t), allocatable, target :: evt_trivial
	class(evt_t), allocatable, target :: evt_shower
	type(shower_settings_t) :: settings
	type(taudec_settings_t) :: taudec_settings

	write (u, "(A)") "* Test output: shower_2"
	write (u, "(A)") "* Purpose: Two-jet event with FSR shower"
	write (u, "(A)")

	write (u, "(A)") "* Initialize environment"
	write (u, "(A)")

	call syntax_model_file_init ()
	call os_data_init (os_data)
	call model_list%read_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"), &
	os_data, model_hadrons)
	call setup_testbed (var_str ("shower_2"), &
	os_data, lib, model_list, process, process_instance)
	model => process%get_model_ptr ()

	write (u, "(A)") "* Set up trivial transform"
	write (u, "(A)")

	allocate (evt_trivial_t :: evt_trivial)
	call evt_trivial%connect (process_instance, model)
	call evt_trivial%prepare_new_event (1, 1)
	call evt_trivial%generate_unweighted ()

	factorization_mode = FM_IGNORE_HELICITY
	keep_correlations = .false.
	call evt_trivial%make_particle_set (factorization_mode, keep_correlations)

	select type (evt_trivial)
	type is (evt_trivial_t)
	call evt_trivial%write (u)
	call write_separator (u, 2)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Set up shower event transform"
	write (u, "(A)")

	settings%fsr_active = .true.

	allocate (evt_shower_t :: evt_shower)
	select type (evt_shower)
	type is (evt_shower_t)
	call evt_shower%init (model_hadrons, os_data)
	allocate (shower_t :: evt_shower%shower)
	- call evt_shower%shower%init (settings, taudec_settings, pdf_data)
	+ call evt_shower%shower%init (settings, taudec_settings, pdf_data, os_data)
	call evt_shower%connect (process_instance, model)
	end select

	evt_trivial%next => evt_shower
	evt_shower%previous => evt_trivial

	call evt_shower%prepare_new_event (1, 1)
	call evt_shower%generate_unweighted ()
	call evt_shower%make_particle_set (factorization_mode, keep_correlations)

	select type (evt_shower)
	type is (evt_shower_t)
	call evt_shower%write (u, testflag = .true.)
	call write_separator (u, 2)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call evt_shower%final ()
	call evt_trivial%final ()
	call process_instance%final ()
	call process%final ()
	call lib%final ()
	call model_hadrons%final ()
	deallocate (model_hadrons)
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: shower_2"

	end subroutine shower_2

	@ %def shower_2
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Fixed Order NLO Events}
	This section deals with the generation of weighted event samples which
	take into account next-to-leading order corrections. An approach
	generating unweighted events is not possible here, because negative
	weights might occur due to subtraction. Note that the events produced
	this way are not physical in the sense that they will not keep
	NLO-accuracy when interfaced to a parton shower. They are rather
	useful for theoretical consistency checks and a fast estimate of
	NLO effects.\\
	We generate NLO events in the following way: First, the integration
	is carried out using the complete divergence-subtracted NLO matrix
	element. In the subsequent simulation, $N$-particle kinematics
	are generated using $\mathcal{B}+\mathcal{V}+\mathcal{C}$ as weight.
	After that, the program loops over all singular regions and for each
	of them generates an event with $N+1$-particle kinematics.
	The weight for those events corresponds to the real matrix
	element $\mathcal{R}^\alpha$ evaluated at the $\alpha$-region's
	emitter's phase space point, multiplied with $S_\alpha$.
	This procedure is implemented using the [[evt_nlo]] transform.

	<<[[evt_nlo.f90]]>>=
	<<File header>>

	module evt_nlo

	<<Use kinds>>
	<<Use strings>>
	use io_units, only: given_output_unit
	use constants
	use lorentz
	use diagnostics
	use physics_defs, only: NLO_REAL
	use sm_qcd
	use model_data
	use particles
	use instances, only: process_instance_t
	! TODO (cw-2016-09-16): Ideally, only pcm_base
	use pcm, only: pcm_nlo_t, pcm_instance_nlo_t
	use process_stacks
	use event_transforms

	use phs_fks, only: phs_fks_t, phs_fks_generator_t
	use phs_fks, only: phs_identifier_t, phs_point_set_t
	use resonances, only: resonance_contributors_t
	use fks_regions, only: region_data_t

	<<Standard module head>>

	<<Evt Nlo: public>>

	<<Evt Nlo: public parameters>>

	<<Evt Nlo: types>>

	contains

	<<Evt Nlo: procedures>>

	end module evt_nlo

	@ %def evt_nlo
	@
	<<Evt Nlo: types>>=
	type :: nlo_event_deps_t
	logical :: cm_frame = .true.
	type(phs_point_set_t) :: p_born_cms
	type(phs_point_set_t) :: p_born_lab
	type(phs_point_set_t) :: p_real_cms
	type(phs_point_set_t) :: p_real_lab
	type(resonance_contributors_t), dimension(:), allocatable :: contributors
	type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers
	integer, dimension(:), allocatable :: alr_to_i_con
	integer :: n_phs = 0
	end type nlo_event_deps_t

	@ %def nlo_event_deps_t
	@ This event transformation is for the generation of fixed-order NLO events. It
	takes an event with Born kinematics and creates $N_\alpha + 1$ modified weighted events.
	The first one has Born kinematics and its weight is the sum of Born, Real and subtraction
	matrix elements. The other $N_\alpha$ events have a weight which is equal to the real matrix
	element, evaluated with the phase space corresponding to the emitter of the $\alpha$-region.
	All NLO event objects share the same event transformation. For this reason, we save the
	particle set of the current $\alpha$-region in the array [[particle_set_radiated]]. Otherwise
	it would be unretrievable if the usual particle set of the event object was used.@
	<<Evt Nlo: public parameters>>=
	integer, parameter, public :: EVT_NLO_UNDEFINED = 0
	integer, parameter, public :: EVT_NLO_SEPARATE_BORNLIKE = 1
	integer, parameter, public :: EVT_NLO_SEPARATE_REAL = 2
	integer, parameter, public :: EVT_NLO_COMBINED = 3
	<<Evt Nlo: public>>=
	public :: evt_nlo_t
	<<Evt Nlo: types>>=
	type, extends (evt_t) :: evt_nlo_t
	type(phs_fks_generator_t) :: phs_fks_generator
	real(default) :: sqme_rad = zero
	integer :: i_evaluation = 0
	integer :: weight_multiplier = 1
	type(particle_set_t), dimension(:), allocatable :: particle_set_radiated
	type(qcd_t), pointer :: qcd => null ()
	type(nlo_event_deps_t) :: event_deps
	integer :: mode = EVT_NLO_UNDEFINED
	integer, dimension(:), allocatable :: &
	i_evaluation_to_i_phs, i_evaluation_to_emitter, &
	i_evaluation_to_i_term
	logical :: keep_failed_events = .false.
	integer :: selected_i_flv = 0
	contains
	<<Evt Nlo: evt nlo: TBP>>
	end type evt_nlo_t

	@ %def evt_nlo_t
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: write_name => evt_nlo_write_name
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_write_name (evt, unit)
	class(evt_nlo_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Event transform: NLO"
	end subroutine evt_nlo_write_name

	@ %def evt_nlo_write_name
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: write => evt_nlo_write
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_write (evt, unit, verbose, more_verbose, testflag)
	class(evt_nlo_t), intent(in) :: evt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose, more_verbose, testflag
	end subroutine evt_nlo_write

	@ %def evt_nlo_write
	@ Connects the event transform to the process. Here also the phase space
	is set up by making [[real_kinematics]] point to the corresponding
	object in the [[pcm_instance]].
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: connect => evt_nlo_connect
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_connect (evt, process_instance, model, process_stack)
	class(evt_nlo_t), intent(inout), target :: evt
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	call msg_debug (D_TRANSFORMS, "evt_nlo_connect")
	call evt%base_connect (process_instance, model, process_stack)
	select type (pcm => process_instance%pcm)
	class is (pcm_instance_nlo_t)
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	call config%setup_phs_generator (pcm, evt%phs_fks_generator, &
	process_instance%get_sqrts ())
	call evt%set_i_evaluation_mappings (config%region_data, &
	pcm%real_kinematics%alr_to_i_phs)
	end select
	end select
	call evt%set_mode (process_instance)
	call evt%setup_general_event_kinematics (process_instance)
	if (evt%mode > EVT_NLO_SEPARATE_BORNLIKE) &
	call evt%setup_real_event_kinematics (process_instance)
	call msg_debug2 (D_TRANSFORMS, "evt_nlo_connect: success")
	end subroutine evt_nlo_connect

	@ %def evt_nlo_connect
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: set_i_evaluation_mappings => evt_nlo_set_i_evaluation_mappings
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_set_i_evaluation_mappings (evt, reg_data, alr_to_i_phs)
	class(evt_nlo_t), intent(inout) :: evt
	type(region_data_t), intent(in) :: reg_data
	integer, intent(in), dimension(:) :: alr_to_i_phs
	integer :: n_phs, alr
	integer :: i_evaluation, i_phs, emitter
	logical :: checked
	type :: registered_triple_t
	integer, dimension(2) :: phs_em
	type(registered_triple_t), pointer :: next => null ()
	end type registered_triple_t
	type(registered_triple_t), allocatable, target :: check_list
	i_evaluation = 1
	n_phs = reg_data%n_phs
	evt%weight_multiplier = n_phs + 1
	allocate (evt%i_evaluation_to_i_phs (n_phs), source = 0)
	allocate (evt%i_evaluation_to_emitter (n_phs), source = -1)
	allocate (evt%i_evaluation_to_i_term (0 : n_phs), source = 0)
	do alr = 1, reg_data%n_regions
	i_phs = alr_to_i_phs (alr)
	emitter = reg_data%regions(alr)%emitter
	call search_check_list (checked)
	if (.not. checked) then
	evt%i_evaluation_to_i_phs (i_evaluation) = i_phs
	evt%i_evaluation_to_emitter (i_evaluation) = emitter
	i_evaluation = i_evaluation + 1
	end if
	end do
	call fill_i_evaluation_to_i_term ()
	if (.not. (all (evt%i_evaluation_to_i_phs > 0) &
	.and. all (evt%i_evaluation_to_emitter > -1))) then
	call msg_fatal ("evt_nlo: Inconsistent mappings!")
	else
	if (debug2_active (D_TRANSFORMS)) then
	print *, 'evt_nlo Mappings, i_evaluation -> '
	print *, 'i_phs: ', evt%i_evaluation_to_i_phs
	print *, 'emitter: ', evt%i_evaluation_to_emitter
	end if
	end if
	contains
	subroutine fill_i_evaluation_to_i_term ()
	integer :: i_term, i_evaluation, term_emitter
	!!! First find subtraction component
	i_evaluation = 1
	do i_term = 1, evt%process%get_n_terms ()
	if (evt%process_instance%term(i_term)%nlo_type /= NLO_REAL) cycle
	term_emitter = evt%process_instance%term(i_term)%k_term%emitter
	if (term_emitter < 0) then
	evt%i_evaluation_to_i_term (0) = i_term
	else if (evt%i_evaluation_to_emitter(i_evaluation) == term_emitter) then
	evt%i_evaluation_to_i_term (i_evaluation) = i_term
	i_evaluation = i_evaluation + 1
	end if
	end do
	end subroutine fill_i_evaluation_to_i_term

	subroutine search_check_list (found)
	logical, intent(out) :: found
	type(registered_triple_t), pointer :: current_triple => null ()
	if (allocated (check_list)) then
	current_triple => check_list
	do
	if (all (current_triple%phs_em == [i_phs, emitter])) then
	found = .true.
	exit
	end if
	if (.not. associated (current_triple%next)) then
	allocate (current_triple%next)
	current_triple%next%phs_em = [i_phs, emitter]
	found = .false.
	exit
	else
	current_triple => current_triple%next
	end if
	end do
	else
	allocate (check_list)
	check_list%phs_em = [i_phs, emitter]
	found = .false.
	end if
	end subroutine search_check_list
	end subroutine evt_nlo_set_i_evaluation_mappings

	@ %def evt_nlo_set_i_evaluation_mappings
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: get_i_phs => evt_nlo_get_i_phs
	<<Evt Nlo: procedures>>=
	function evt_nlo_get_i_phs (evt) result (i_phs)
	integer :: i_phs
	class(evt_nlo_t), intent(in) :: evt
	i_phs = evt%i_evaluation_to_i_phs (evt%i_evaluation)
	end function evt_nlo_get_i_phs

	@ %def evt_nlo_get_i_phs
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: get_emitter => evt_nlo_get_emitter
	<<Evt Nlo: procedures>>=
	function evt_nlo_get_emitter (evt) result (emitter)
	integer :: emitter
	class(evt_nlo_t), intent(in) :: evt
	emitter = evt%i_evaluation_to_emitter (evt%i_evaluation)
	end function evt_nlo_get_emitter

	@ %def evt_nlo_get_emitter
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: get_i_term => evt_nlo_get_i_term
	<<Evt Nlo: procedures>>=
	function evt_nlo_get_i_term (evt) result (i_term)
	integer :: i_term
	class(evt_nlo_t), intent(in) :: evt
	if (evt%mode >= EVT_NLO_SEPARATE_REAL) then
	i_term = evt%i_evaluation_to_i_term (evt%i_evaluation)
	else
	i_term = evt%process_instance%get_first_active_i_term ()
	end if
	end function evt_nlo_get_i_term

	@ %def evt_nlo_get_i_term
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: copy_previous_particle_set => evt_nlo_copy_previous_particle_set
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_copy_previous_particle_set (evt)
	class(evt_nlo_t), intent(inout) :: evt
	if (associated (evt%previous)) then
	evt%particle_set = evt%previous%particle_set
	else
	call msg_fatal ("evt_nlo requires one preceeding evt_trivial!")
	end if
	end subroutine evt_nlo_copy_previous_particle_set

	@ %def evt_nlo_copy_previous_particle_set
	@ The event transform has a variable which counts the number of times it
	has already been called for one generation point. If [[i_evaluation]] is
	zero, this means that [[evt_nlo_generate]] is called for the first time,
	so that the generation of an $N$-particle event is required. In all
	other cases, emission events are generated.\\
	Note that for the first event, the computed weights are added to
	[[probability]], which at this point is equal to $\mathcal{B} +
	\mathcal{V}$, whereas for all other runs [[probability]] is replaced.
	To keep $<\sum{w_i}>=N\times\sigma$ as it is for weighted LO
	events, we have to multiply by $N_{\rm{phs}} + 1$ since the cross section
	is distributed over the real and Born subevents.
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: generate_weighted => evt_nlo_generate_weighted
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_generate_weighted (evt, probability)
	class(evt_nlo_t), intent(inout) :: evt
	real(default), intent(inout) :: probability
	real(default) :: weight
	call print_debug_info ()
	if (evt%mode > EVT_NLO_SEPARATE_BORNLIKE) then
	if (evt%i_evaluation == 0) then
	call evt%reset_phs_identifiers ()
	call evt%evaluate_real_kinematics ()
	weight = evt%compute_subtraction_weights ()
	if (evt%mode == EVT_NLO_SEPARATE_REAL) then
	probability = weight
	else
	probability = probability + weight
	end if
	else
	call evt%compute_real ()
	probability = evt%sqme_rad
	end if
	call msg_debug2 (D_TRANSFORMS, "event weight multiplier:", evt%weight_multiplier)
	probability = probability * evt%weight_multiplier
	end if
	call msg_debug (D_TRANSFORMS, "probability (after)", probability)
	evt%particle_set_exists = .true.
	contains
	function status_code_to_string (mode) result (smode)
	type(string_t) :: smode
	integer, intent(in) :: mode
	select case (mode)
	case (EVT_NLO_UNDEFINED)
	smode = var_str ("Undefined")
	case (EVT_NLO_SEPARATE_BORNLIKE)
	smode = var_str ("Born-like")
	case (EVT_NLO_SEPARATE_REAL)
	smode = var_str ("Real")
	case (EVT_NLO_COMBINED)
	smode = var_str ("Combined")
	end select
	end function status_code_to_string

	subroutine print_debug_info ()
	call msg_debug (D_TRANSFORMS, "evt_nlo_generate_weighted")
	call msg_debug (D_TRANSFORMS, char ("mode: " // status_code_to_string (evt%mode)))
	call msg_debug (D_TRANSFORMS, "probability (before)", probability)
	call msg_debug (D_TRANSFORMS, "evt%i_evaluation", evt%i_evaluation)
	if (debug2_active (D_TRANSFORMS)) then
	if (evt%mode > EVT_NLO_SEPARATE_BORNLIKE) then
	if (evt%i_evaluation == 0) then
	print *, 'Evaluate subtraction component'
	else
	print *, 'Evaluate radiation component'
	end if
	end if
	end if
	end subroutine print_debug_info
	end subroutine evt_nlo_generate_weighted

	@ %def evt_nlo_generate_weighted
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: reset_phs_identifiers => evt_nlo_reset_phs_identifiers
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_reset_phs_identifiers (evt)
	class(evt_nlo_t), intent(inout) :: evt
	evt%event_deps%phs_identifiers%evaluated = .false.
	end subroutine evt_nlo_reset_phs_identifiers

	@ %def evt_nlo_reset_phs_identifiers
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: make_particle_set => evt_nlo_make_particle_set
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_make_particle_set &
	(evt, factorization_mode, keep_correlations, r)
	class(evt_nlo_t), intent(inout) :: evt
	integer, intent(in) :: factorization_mode
	logical, intent(in) :: keep_correlations
	real(default), dimension(:), intent(in), optional :: r
	if (evt%mode >= EVT_NLO_SEPARATE_BORNLIKE) then
	select type (config => evt%process_instance%pcm%config)
	type is (pcm_nlo_t)
	if (evt%i_evaluation > 0) then
	call make_factorized_particle_set (evt, factorization_mode, &
	keep_correlations, r, evt%get_i_term (), &
	config%qn_real(:, evt%selected_i_flv))
	else
	call make_factorized_particle_set (evt, factorization_mode, &
	keep_correlations, r, evt%get_i_term (), &
	config%qn_born(:, evt%selected_i_flv))
	end if
	end select
	else
	call make_factorized_particle_set (evt, factorization_mode, &
	keep_correlations, r)
	end if
	end subroutine evt_nlo_make_particle_set

	@ %def evt_nlo_make_particle_set
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: keep_and_boost_born_particle_set => &
	evt_nlo_keep_and_boost_born_particle_set
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_keep_and_boost_born_particle_set (evt, i_event)
	class(evt_nlo_t), intent(inout) :: evt
	integer, intent(in) :: i_event
	evt%particle_set_radiated(i_event) = evt%particle_set
	if (evt%event_deps%cm_frame) then
	evt%event_deps%p_born_cms%phs_point(1) = &
	evt%particle_set%get_in_and_out_momenta ()
	evt%event_deps%p_born_lab%phs_point(1) = &
	evt%boost_to_lab (evt%event_deps%p_born_cms%phs_point(1))
	call evt%particle_set_radiated(i_event)%replace_incoming_momenta &
	(evt%event_deps%p_born_lab%phs_point(1)%p)
	call evt%particle_set_radiated(i_event)%replace_outgoing_momenta &
	(evt%event_deps%p_born_lab%phs_point(1)%p)
	end if
	end subroutine evt_nlo_keep_and_boost_born_particle_set

	@ %def evt_nlo_keep_and_boost_born_particle_set
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: evaluate_real_kinematics => evt_nlo_evaluate_real_kinematics
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_evaluate_real_kinematics (evt)
	class(evt_nlo_t), intent(inout) :: evt
	integer :: alr, i_phs, i_con, emitter
	real(default), dimension(3) :: x_rad
	logical :: use_contributors
	integer :: i_term

	select type (pcm => evt%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	x_rad = pcm%real_kinematics%x_rad
	associate (event_deps => evt%event_deps)
	i_term = evt%get_i_term ()
	event_deps%p_born_lab%phs_point(1) = &
	evt%process_instance%term(i_term)%connected%matrix%get_momenta ()
	event_deps%p_born_cms%phs_point(1) &
	= evt%boost_to_cms (event_deps%p_born_lab%phs_point(1))
	call evt%phs_fks_generator%set_sqrts_hat &
	(event_deps%p_born_cms%get_energy (1, 1))
	use_contributors = allocated (event_deps%contributors)
	do alr = 1, pcm%get_n_regions ()
	i_phs = pcm%real_kinematics%alr_to_i_phs(alr)
	if (event_deps%phs_identifiers(i_phs)%evaluated) cycle
	emitter = event_deps%phs_identifiers(i_phs)%emitter
	associate (generator => evt%phs_fks_generator)
	!!! TODO: (cw-2016-12-30): Replace by n_in
	if (emitter <= 2) then
	call generator%prepare_generation (x_rad, i_phs, emitter, &
	event_deps%p_born_cms%phs_point(1)%p, event_deps%phs_identifiers)
	call generator%generate_isr (i_phs, &
	event_deps%p_born_lab%phs_point(1)%p, &
	event_deps%p_real_lab%phs_point(i_phs)%p)
	event_deps%p_real_cms%phs_point(i_phs) &
	= evt%boost_to_cms (event_deps%p_real_lab%phs_point(i_phs))
	else
	if (use_contributors) then
	i_con = event_deps%alr_to_i_con(alr)
	call generator%prepare_generation (x_rad, i_phs, emitter, &
	event_deps%p_born_cms%phs_point(1)%p, &
	event_deps%phs_identifiers, event_deps%contributors, i_con)
	call generator%generate_fsr (emitter, i_phs, i_con, &
	event_deps%p_born_cms%phs_point(1)%p, &
	event_deps%p_real_cms%phs_point(i_phs)%p)
	else
	call generator%prepare_generation (x_rad, i_phs, emitter, &
	event_deps%p_born_cms%phs_point(1)%p, event_deps%phs_identifiers)
	call generator%generate_fsr (emitter, i_phs, &
	event_deps%p_born_cms%phs_point(1)%p, &
	event_deps%p_real_cms%phs_point(i_phs)%p)
	end if
	event_deps%p_real_lab%phs_point(i_phs) &
	= evt%boost_to_lab (event_deps%p_real_cms%phs_point(i_phs))
	end if
	end associate
	call pcm%set_momenta (event_deps%p_born_lab%phs_point(1)%p, &
	event_deps%p_real_lab%phs_point(i_phs)%p, i_phs)
	call pcm%set_momenta (event_deps%p_born_cms%phs_point(1)%p, &
	event_deps%p_real_cms%phs_point(i_phs)%p, i_phs, cms = .true.)
	event_deps%phs_identifiers(i_phs)%evaluated = .true.
	end do
	end associate
	end select
	end subroutine evt_nlo_evaluate_real_kinematics

	@ %def evt_nlo_evaluate_real_kinematics
	@ This routine calls the evaluation of the singular regions only for the
	subtraction terms.
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: compute_subtraction_weights => evt_nlo_compute_subtraction_weights
	<<Evt Nlo: procedures>>=
	function evt_nlo_compute_subtraction_weights (evt) result (weight)
	class(evt_nlo_t), intent(inout) :: evt
	real(default) :: weight
	integer :: i_phs, i_term
	call msg_debug (D_TRANSFORMS, "evt_nlo_compute_subtraction_weights")
	weight = zero
	select type (pcm => evt%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	associate (event_deps => evt%event_deps)
	i_phs = 1; i_term = evt%i_evaluation_to_i_term(0)
	call evt%process_instance%compute_sqme_rad (i_term, i_phs, .true.)
	weight = weight + evt%process_instance%get_sqme (i_term)
	end associate
	end select
	end function evt_nlo_compute_subtraction_weights

	@ %def evt_nlo_compute_subtraction_weights
	@ This routine calls the evaluation of the singular regions only for
	emission matrix elements.
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: compute_real => evt_nlo_compute_real
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_compute_real (evt)
	class(evt_nlo_t), intent(inout) :: evt
	integer :: i_phs, i_term
	call msg_debug (D_TRANSFORMS, "evt_nlo_compute_real")
	i_phs = evt%get_i_phs ()
	i_term = evt%i_evaluation_to_i_term (evt%i_evaluation)
	select type (pcm => evt%process_instance%pcm)
	class is (pcm_instance_nlo_t)
	associate (event_deps => evt%event_deps)
	call evt%process_instance%compute_sqme_rad (i_term, i_phs, .false.)
	evt%sqme_rad = evt%process_instance%get_sqme (i_term)
	end associate
	end select
	end subroutine evt_nlo_compute_real

	@ %def evt_nlo_compute_real
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: boost_to_cms => evt_nlo_boost_to_cms
	<<Evt Nlo: procedures>>=
	function evt_nlo_boost_to_cms (evt, p_lab) result (p_cms)
	type(phs_point_t), intent(in) :: p_lab
	class(evt_nlo_t), intent(in) :: evt
	type(phs_point_t) :: p_cms
	type(lorentz_transformation_t) :: lt_lab_to_cms
	integer :: i_boost
	if (evt%event_deps%cm_frame) then
	lt_lab_to_cms = identity
	else
	if (evt%mode == EVT_NLO_COMBINED) then
	i_boost = 1
	else
	i_boost = evt%process_instance%select_i_term ()
	end if
	lt_lab_to_cms = evt%process_instance%get_boost_to_cms (i_boost)
	end if
	p_cms = lt_lab_to_cms * p_lab
	end function evt_nlo_boost_to_cms

	@ %def evt_nlo_boost_to_cms
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: boost_to_lab => evt_nlo_boost_to_lab
	<<Evt Nlo: procedures>>=
	function evt_nlo_boost_to_lab (evt, p_cms) result (p_lab)
	type(phs_point_t) :: p_lab
	class(evt_nlo_t), intent(in) :: evt
	type(phs_point_t), intent(in) :: p_cms
	type(lorentz_transformation_t) :: lt_cms_to_lab
	integer :: i_boost
	if (.not. evt%event_deps%cm_frame) then
	lt_cms_to_lab = identity
	else
	if (evt%mode == EVT_NLO_COMBINED) then
	i_boost = 1
	else
	i_boost = evt%process_instance%select_i_term ()
	end if
	lt_cms_to_lab = evt%process_instance%get_boost_to_lab (i_boost)
	end if
	p_lab = lt_cms_to_lab * p_cms
	end function evt_nlo_boost_to_lab

	@ %def evt_nlo_boost_to_lab
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: setup_general_event_kinematics => evt_nlo_setup_general_event_kinematics
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_setup_general_event_kinematics (evt, process_instance)
	class(evt_nlo_t), intent(inout) :: evt
	type(process_instance_t), intent(in) :: process_instance
	integer :: n_born
	associate (event_deps => evt%event_deps)
	event_deps%cm_frame = process_instance%is_cm_frame (1)
	select type (pcm => process_instance%pcm)
	type is (pcm_instance_nlo_t)
	n_born = pcm%get_n_born ()
	end select
	call event_deps%p_born_cms%init (n_born, 1)
	call event_deps%p_born_lab%init (n_born, 1)
	end associate
	end subroutine evt_nlo_setup_general_event_kinematics

	@ %def evt_nlo_setup_general_event_kinematics
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: setup_real_event_kinematics => evt_nlo_setup_real_event_kinematics
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_setup_real_event_kinematics (evt, process_instance)
	class(evt_nlo_t), intent(inout) :: evt
	type(process_instance_t), intent(in) :: process_instance
	integer :: n_real, n_phs
	integer :: i_real
	associate (event_deps => evt%event_deps)
	select type (pcm => process_instance%pcm)
	class is (pcm_instance_nlo_t)
	n_real = pcm%get_n_real ()
	end select
	i_real = evt%process%get_first_real_term ()
	select type (phs => process_instance%term(i_real)%k_term%phs)
	type is (phs_fks_t)
	event_deps%phs_identifiers = phs%phs_identifiers
	end select
	n_phs = size (event_deps%phs_identifiers)
	call event_deps%p_real_cms%init (n_real, n_phs)
	call event_deps%p_real_lab%init (n_real, n_phs)
	select type (pcm => process_instance%pcm)
	type is (pcm_instance_nlo_t)
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	if (allocated (config%region_data%alr_contributors)) then
	allocate (event_deps%contributors (size (config%region_data%alr_contributors)))
	event_deps%contributors = config%region_data%alr_contributors
	end if
	if (allocated (config%region_data%alr_to_i_contributor)) then
	allocate (event_deps%alr_to_i_con &
	(size (config%region_data%alr_to_i_contributor)))
	event_deps%alr_to_i_con = config%region_data%alr_to_i_contributor
	end if
	end select
	end select
	end associate
	end subroutine evt_nlo_setup_real_event_kinematics

	@ %def evt_nlo_setup_real_event_kinematics
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: set_mode => evt_nlo_set_mode
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_set_mode (evt, process_instance)
	class(evt_nlo_t), intent(inout) :: evt
	type(process_instance_t), intent(in) :: process_instance
	integer :: i_real
	select type (pcm => process_instance%pcm)
	type is (pcm_instance_nlo_t)
	select type (config => pcm%config)
	type is (pcm_nlo_t)
	if (config%settings%combined_integration) then
	evt%mode = EVT_NLO_COMBINED
	else
	i_real = evt%process%get_first_real_component ()
	if (i_real == evt%process%extract_active_component_mci ()) then
	evt%mode = EVT_NLO_SEPARATE_REAL
	else
	evt%mode = EVT_NLO_SEPARATE_BORNLIKE
	end if
	end if
	end select
	end select
	end subroutine evt_nlo_set_mode

	@ %def evt_nlo_set_mode
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: is_valid_event => evt_nlo_is_valid_event
	<<Evt Nlo: procedures>>=
	function evt_nlo_is_valid_event (evt, i_term) result (valid)
	logical :: valid
	class(evt_nlo_t), intent(in) :: evt
	integer, intent(in) :: i_term
	valid = evt%process_instance%term(i_term)%passed
	end function evt_nlo_is_valid_event

	@ %def evt_nlo_is_valid_event
	@
	<<Evt Nlo: evt nlo: TBP>>=
	procedure :: prepare_new_event => evt_nlo_prepare_new_event
	<<Evt Nlo: procedures>>=
	subroutine evt_nlo_prepare_new_event (evt, i_mci, i_term)
	class(evt_nlo_t), intent(inout) :: evt
	integer, intent(in) :: i_mci, i_term
	real(default) :: s, x
	real(default) :: sqme_total
	real(default), dimension(:), allocatable :: sqme_flv
	integer :: i
	call evt%reset ()
	if (evt%i_evaluation > 0) return
	call evt%rng%generate (x)
	sqme_total = zero
	allocate (sqme_flv (evt%process_instance%term(1)%config%data%n_flv))
	sqme_flv = zero
	do i = 1, size (evt%process_instance%term)
	associate (term => evt%process_instance%term(i))
	sqme_total = sqme_total + real (sum ( &
	term%connected%matrix%get_matrix_element ()))
	sqme_flv = sqme_flv + real (term%connected%matrix%get_matrix_element ())
	end associate
	end do
	!!! Need absolute values to take into account negative weights
	x = x * abs (sqme_total)
	s = zero
	do i = 1, size (sqme_flv)
	s = s + abs (sqme_flv (i))
	if (s > x) then
	evt%selected_i_flv = i
	exit
	end if
	end do
	if (debug2_active (D_TRANSFORMS)) then
	call msg_print_color ("Selected i_flv: ", COL_GREEN)
	print *, evt%selected_i_flv
	end if
	end subroutine evt_nlo_prepare_new_event

	@ %def evt_nlo_prepare_new_event
	@
	\section{Complete Events}

	This module combines hard processes with decay chains, shower, and
	hadronization (not implemented yet) to complete events. It also
	manages the input and output of event records in various formats.
	<<[[events.f90]]>>=
	<<File header>>

	module events

	<<Use kinds>>
	<<Use strings>>
	use constants, only: one
	use io_units
	use format_utils, only: pac_fmt, write_separator
	use format_defs, only: FMT_12, FMT_19
	use numeric_utils
	use diagnostics
	use variables
	use expr_base
	use model_data
	use state_matrices, only: FM_IGNORE_HELICITY, &
	FM_SELECT_HELICITY, FM_FACTOR_HELICITY, FM_CORRELATED_HELICITY
	use particles
	use subevt_expr
	use rng_base
	use process, only: process_t
	use instances, only: process_instance_t
	use pcm, only: pcm_instance_nlo_t
	use process_stacks
	use event_base
	use event_transforms
	use decays
	use evt_nlo

	<<Standard module head>>

	<<Events: public>>

	<<Events: types>>

	<<Events: interfaces>>

	contains

	<<Events: procedures>>

	end module events
	@ %def events
	@
	\subsection{Event configuration}
	The parameters govern the transformation of an event to a particle set.

	The [[safety_factor]] reduces the acceptance probability for
	unweighting. If greater than one, excess events become less likely,
	but the reweighting efficiency also drops.

	The [[sigma]] and [[n]] values, if nontrivial, allow for reweighting
	the events according to the requested [[norm_mode]].

	Various [[parse_node_t]] objects are taken from the SINDARIN input.
	They encode expressions that apply to the current event. The
	workspaces for evaluating those expressions are set up in the
	[[event_expr_t]] objects. Note that these are really pointers,
	so the actual nodes are not stored inside the event object.
	<<Events: types>>=
	type :: event_config_t
	logical :: unweighted = .false.
	integer :: norm_mode = NORM_UNDEFINED
	integer :: factorization_mode = FM_IGNORE_HELICITY
	logical :: keep_correlations = .false.
	logical :: colorize_subevt = .false.
	real(default) :: sigma = 1
	integer :: n = 1
	real(default) :: safety_factor = 1
	class(expr_factory_t), allocatable :: ef_selection
	class(expr_factory_t), allocatable :: ef_reweight
	class(expr_factory_t), allocatable :: ef_analysis
	contains
	<<Events: event config: TBP>>
	end type event_config_t

	@ %def event_config_t
	@ Output.
	<<Events: event config: TBP>>=
	procedure :: write => event_config_write
	<<Events: procedures>>=
	subroutine event_config_write (object, unit, show_expressions)
	class(event_config_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_expressions
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A,L1)") "Unweighted = ", object%unweighted
	write (u, "(3x,A,A)") "Normalization = ", &
	char (event_normalization_string (object%norm_mode))
	write (u, "(3x,A)", advance="no") "Helicity handling = "
	select case (object%factorization_mode)
	case (FM_IGNORE_HELICITY)
	write (u, "(A)") "drop"
	case (FM_SELECT_HELICITY)
	write (u, "(A)") "select"
	case (FM_FACTOR_HELICITY)
	write (u, "(A)") "factorize"
	end select
	write (u, "(3x,A,L1)") "Keep correlations = ", object%keep_correlations
	if (object%colorize_subevt) then
	write (u, "(3x,A,L1)") "Colorize subevent = ", object%colorize_subevt
	end if
	if (.not. nearly_equal (object%safety_factor, one)) then
	write (u, "(3x,A," // FMT_12 // ")") &
	"Safety factor = ", object%safety_factor
	end if
	if (present (show_expressions)) then
	if (show_expressions) then
	if (allocated (object%ef_selection)) then
	call write_separator (u)
	write (u, "(3x,A)") "Event selection expression:"
	call object%ef_selection%write (u)
	end if
	if (allocated (object%ef_reweight)) then
	call write_separator (u)
	write (u, "(3x,A)") "Event reweighting expression:"
	call object%ef_reweight%write (u)
	end if
	if (allocated (object%ef_analysis)) then
	call write_separator (u)
	write (u, "(3x,A)") "Analysis expression:"
	call object%ef_analysis%write (u)
	end if
	end if
	end if
	end subroutine event_config_write

	@ %def event_config_write
	@
	\subsection{The event type}
	This is the concrete implementation of the [[generic_event_t]] core
	that is defined above in the [[event_base]] module. The core manages
	the main (dressed) particle set pointer and the current values for
	weights and sqme. The implementation adds configuration data,
	expressions, process references, and event transforms.

	Each event refers to a single elementary process. This process may be
	dressed by a shower, a decay chain etc. We maintain pointers to a
	process instance.

	A list of event transforms (class [[evt_t]]) transform the connected
	interactions of the process instance into the final particle set. In
	this list, the first transform is always the trivial one, which just
	factorizes the process instance. Subsequent transforms may apply
	decays, etc. The [[particle_set]] pointer identifies the particle set
	that we want to be analyzed and returned by the event, usually the
	last one.

	Squared matrix element and weight values: when reading events from
	file, the [[ref]] value is the number in the file, while the [[prc]]
	value is the number that we calculate from the momenta in the file,
	possibly with different parameters. When generating events the first
	time, or if we do not recalculate, the numbers should coincide.
	Furthermore, the array of [[alt]] values is copied from an array of
	alternative event records. These values should represent calculated
	values.

	The [[sqme]] and [[weight]] values mirror corresponding values in the
	[[expr]] subobject. The idea is that when generating or reading
	events, the event record is filled first, then the [[expr]] object
	acquires copies. These copies are used for writing events and as targets
	for pointer variables in the analysis expression.

	All data that involve user-provided expressions (selection, reweighting,
	analysis) are handled by the [[expr]] subobject. In particular, evaluating
	the event-selection expression sets the [[passed]] flag. Furthermore,
	the [[expr]] subobject collects data that can be used in the analysis
	and should be written to file, including copies of [[sqme]] and [[weight]].
	<<Events: public>>=
	public :: event_t
	<<Events: types>>=
	type, extends (generic_event_t) :: event_t
	type(event_config_t) :: config
	type(process_t), pointer :: process => null ()
	type(process_instance_t), pointer :: instance => null ()
	class(rng_t), allocatable :: rng
	integer :: selected_i_mci = 0
	integer :: selected_i_term = 0
	integer :: selected_channel = 0
	logical :: is_complete = .false.
	class(evt_t), pointer :: transform_first => null ()
	class(evt_t), pointer :: transform_last => null ()
	type(event_expr_t) :: expr
	logical :: selection_evaluated = .false.
	logical :: passed = .false.
	real(default), allocatable :: alpha_qcd_forced
	real(default), allocatable :: scale_forced
	real(default) :: reweight = 1
	logical :: analysis_flag = .false.
	integer :: i_event = 0
	contains
	<<Events: event: TBP>>
	end type event_t

	@ %def event_t
	@
	<<Events: event: TBP>>=
	procedure :: clone => event_clone
	<<Events: procedures>>=
	subroutine event_clone (event, event_new)
	class(event_t), intent(in), target :: event
	class(event_t), intent(out), target:: event_new
	type(string_t) :: id
	integer :: num_id
	event_new%config = event%config
	event_new%process => event%process
	event_new%instance => event%instance
	if (allocated (event%rng)) &
	allocate(event_new%rng, source=event%rng)
	event_new%selected_i_mci = event%selected_i_mci
	event_new%selected_i_term = event%selected_i_term
	event_new%selected_channel = event%selected_channel
	event_new%is_complete = event%is_complete
	event_new%transform_first => event%transform_first
	event_new%transform_last => event%transform_last
	event_new%selection_evaluated = event%selection_evaluated
	event_new%passed = event%passed
	if (allocated (event%alpha_qcd_forced)) &
	allocate(event_new%alpha_qcd_forced, source=event%alpha_qcd_forced)
	if (allocated (event%scale_forced)) &
	allocate(event_new%scale_forced, source=event%scale_forced)
	event_new%reweight = event%reweight
	event_new%analysis_flag = event%analysis_flag
	event_new%i_event = event%i_event
	id = event_new%process%get_id ()
	if (id /= "") call event_new%expr%set_process_id (id)
	num_id = event_new%process%get_num_id ()
	if (num_id /= 0) call event_new%expr%set_process_num_id (num_id)
	call event_new%expr%setup_vars (event_new%process%get_sqrts ())
	call event_new%expr%link_var_list (event_new%process%get_var_list_ptr ())
	end subroutine event_clone

	@ %def event_clone
	@ Finalizer: the list of event transforms is deleted iteratively.
	<<Events: event: TBP>>=
	procedure :: final => event_final
	<<Events: procedures>>=
	subroutine event_final (object)
	class(event_t), intent(inout) :: object
	class(evt_t), pointer :: evt
	if (allocated (object%rng)) call object%rng%final ()
	call object%expr%final ()
	do while (associated (object%transform_first))
	evt => object%transform_first
	object%transform_first => evt%next
	call evt%final ()
	deallocate (evt)
	end do
	end subroutine event_final

	@ %def event_final
	@ Output.

	The event index is written in the header, it should coincide with the
	[[event_index]] variable that can be used in selection and analysis.

	Particle set: this is a pointer to one of the event transforms, so it
	should suffice to print the latter.
	<<Events: event: TBP>>=
	procedure :: write => event_write
	<<Events: procedures>>=
	subroutine event_write (object, unit, show_process, show_transforms, &
	show_decay, verbose, testflag)
	class(event_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_process, show_transforms, show_decay
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: testflag
	logical :: prc, trans, dec, verb
	class(evt_t), pointer :: evt
	character(len=7) :: fmt
	integer :: u, i
	call pac_fmt (fmt, FMT_19, FMT_12, testflag)
	u = given_output_unit (unit)
	prc = .true.; if (present (show_process)) prc = show_process
	trans = .true.; if (present (show_transforms)) trans = show_transforms
	dec = .true.; if (present (show_decay)) dec = show_decay
	verb = .false.; if (present (verbose)) verb = verbose
	call write_separator (u, 2)
	write (u, "(1x,A)", advance="no") "Event"
	if (object%has_index ()) then
	write (u, "(1x,'#',I0)", advance="no") object%get_index ()
	end if
	if (object%is_complete) then
	write (u, *)
	else
	write (u, "(1x,A)") "[incomplete]"
	end if
	call write_separator (u)
	call object%config%write (u)
	if (object%sqme_ref_is_known () .or. object%weight_ref_is_known ()) then
	call write_separator (u)
	end if
	if (object%sqme_ref_is_known ()) then
	write (u, "(3x,A," // fmt // ")") &
	"Squared matrix el. (ref) = ", object%get_sqme_ref ()
	if (object%sqme_alt_is_known ()) then
	do i = 1, object%get_n_alt ()
	write (u, "(5x,A," // fmt // ",1x,I0)") &
	"alternate sqme = ", object%get_sqme_alt(i), i
	end do
	end if
	end if
	if (object%sqme_prc_is_known ()) &
	write (u, "(3x,A," // fmt // ")") &
	"Squared matrix el. (prc) = ", object%get_sqme_prc ()

	if (object%weight_ref_is_known ()) then
	write (u, "(3x,A," // fmt // ")") &
	"Event weight (ref) = ", object%get_weight_ref ()
	if (object%weight_alt_is_known ()) then
	do i = 1, object%get_n_alt ()
	write (u, "(5x,A," // fmt // ",1x,I0)") &
	"alternate weight = ", object%get_weight_alt(i), i
	end do
	end if
	end if
	if (object%weight_prc_is_known ()) &
	write (u, "(3x,A," // fmt // ")") &
	"Event weight (prc) = ", object%get_weight_prc ()

	if (object%selected_i_mci /= 0) then
	call write_separator (u)
	write (u, "(3x,A,I0)") "Selected MCI group = ", object%selected_i_mci
	write (u, "(3x,A,I0)") "Selected term = ", object%selected_i_term
	write (u, "(3x,A,I0)") "Selected channel = ", object%selected_channel
	end if
	if (object%selection_evaluated) then
	call write_separator (u)
	write (u, "(3x,A,L1)") "Passed selection = ", object%passed
	if (object%passed) then
	write (u, "(3x,A," // fmt // ")") &
	"Reweighting factor = ", object%reweight
	write (u, "(3x,A,L1)") &
	"Analysis flag = ", object%analysis_flag
	end if
	end if
	if (associated (object%instance)) then
	if (prc) then
	if (verb) then
	call object%instance%write (u, testflag)
	else
	call object%instance%write_header (u)
	end if
	end if
	if (trans) then
	evt => object%transform_first
	do while (associated (evt))
	select type (evt)
	type is (evt_decay_t)
	call evt%write (u, verbose = dec, more_verbose = verb, &
	testflag = testflag)
	class default
	call evt%write (u, verbose = verb, testflag = testflag)
	end select
	call write_separator (u, 2)
	evt => evt%next
	end do
	else
	call write_separator (u, 2)
	end if
	if (object%expr%subevt_filled) then
	call object%expr%write (u, pacified = testflag)
	call write_separator (u, 2)
	end if
	else
	call write_separator (u, 2)
	write (u, "(1x,A)") "Process instance: [undefined]"
	call write_separator (u, 2)
	end if
	end subroutine event_write

	@ %def event_write
	@
	\subsection{Initialization}
	Initialize: set configuration parameters, using a variable list. We
	do not call this [[init]], because this method name will be used by a type
	extension.

	The default normalization is [[NORM_SIGMA]], since the default
	generation mode is weighted.

	For unweighted events, we may want to a apply a safety factor to event
	rejection. (By default, this factor is unity and can be ignored.)

	We also allocate the trivial event transform, which is always the
	first one.
	<<Events: event: TBP>>=
	procedure :: basic_init => event_init
	<<Events: procedures>>=
	subroutine event_init (event, var_list, n_alt)
	class(event_t), intent(out) :: event
	type(var_list_t), intent(in), optional :: var_list
	integer, intent(in), optional :: n_alt
	type(string_t) :: norm_string, mode_string
	logical :: polarized_events
	if (present (n_alt)) then
	call event%base_init (n_alt)
	call event%expr%init (n_alt)
	else
	call event%base_init (0)
	end if
	if (present (var_list)) then
	event%config%unweighted = var_list%get_lval (&
	var_str ("?unweighted"))
	norm_string = var_list%get_sval (&
	var_str ("$sample_normalization"))
	event%config%norm_mode = &
	event_normalization_mode (norm_string, event%config%unweighted)
	polarized_events = &
	var_list%get_lval (var_str ("?polarized_events"))
	if (polarized_events) then
	mode_string = &
	var_list%get_sval (var_str ("$polarization_mode"))
	select case (char (mode_string))
	case ("ignore")
	event%config%factorization_mode = FM_IGNORE_HELICITY
	case ("helicity")
	event%config%factorization_mode = FM_SELECT_HELICITY
	case ("factorized")
	event%config%factorization_mode = FM_FACTOR_HELICITY
	case ("correlated")
	event%config%factorization_mode = FM_CORRELATED_HELICITY
	case default
	call msg_fatal ("Polarization mode " &
	// char (mode_string) // " is undefined")
	end select
	else
	event%config%factorization_mode = FM_IGNORE_HELICITY
	end if
	event%config%colorize_subevt = &
	var_list%get_lval (var_str ("?colorize_subevt"))
	if (event%config%unweighted) then
	event%config%safety_factor = var_list%get_rval (&
	var_str ("safety_factor"))
	end if
	else
	event%config%norm_mode = NORM_SIGMA
	end if
	allocate (evt_trivial_t :: event%transform_first)
	event%transform_last => event%transform_first
	end subroutine event_init

	@ %def event_init
	@ Set the [[sigma]] and [[n]] values in the configuration record that
	determine non-standard event normalizations. If these numbers are not
	set explicitly, the default value for both is unity, and event
	renormalization has no effect.
	<<Events: event: TBP>>=
	procedure :: set_sigma => event_set_sigma
	procedure :: set_n => event_set_n
	<<Events: procedures>>=
	elemental subroutine event_set_sigma (event, sigma)
	class(event_t), intent(inout) :: event
	real(default), intent(in) :: sigma
	event%config%sigma = sigma
	end subroutine event_set_sigma

	elemental subroutine event_set_n (event, n)
	class(event_t), intent(inout) :: event
	integer, intent(in) :: n
	event%config%n = n
	end subroutine event_set_n

	@ %def event_set_n
	@ Append an event transform (decays, etc.). The transform is not yet
	connected to a process. The transform is then considered to belong to
	the event object, and will be finalized together with it. The
	original pointer is removed.

	We can assume that the trivial transform is already present in the
	event object, at least.
	<<Events: event: TBP>>=
	procedure :: import_transform => event_import_transform
	<<Events: procedures>>=
	subroutine event_import_transform (event, evt)
	class(event_t), intent(inout) :: event
	class(evt_t), intent(inout), pointer :: evt
	event%transform_last%next => evt
	evt%previous => event%transform_last
	event%transform_last => evt
	evt => null ()
	end subroutine event_import_transform

	@ %def event_import_transform
	@
	We link the event to an existing process instance. This
	includes the variable list, which is linked to the process variable
	list. Note that this is not necessarily identical to the variable
	list used for event initialization.

	The variable list will contain pointers to [[event]] subobjects, therefore the
	[[target]] attribute.

	Once we have a process connected, we can use it to obtain an event
	generator instance.

	The model and process stack may be needed by event transforms. The
	current model setting may be different from the model in the process
	(regarding unstable particles, etc.). The process stack can be used
	for assigning extra processes that we need for the event transforms.
	<<Events: event: TBP>>=
	procedure :: connect => event_connect
	<<Events: procedures>>=
	subroutine event_connect (event, process_instance, model, process_stack)
	class(event_t), intent(inout), target :: event
	type(process_instance_t), intent(in), target :: process_instance
	class(model_data_t), intent(in), target :: model
	type(process_stack_t), intent(in), optional :: process_stack
	type(string_t) :: id
	integer :: num_id
	class(evt_t), pointer :: evt
	event%process => process_instance%process
	event%instance => process_instance
	id = event%process%get_id ()
	if (id /= "") call event%expr%set_process_id (id)
	num_id = event%process%get_num_id ()
	if (num_id /= 0) call event%expr%set_process_num_id (num_id)
	call event%expr%setup_vars (event%process%get_sqrts ())
	call event%expr%link_var_list (event%process%get_var_list_ptr ())
	call event%process%make_rng (event%rng)
	evt => event%transform_first
	do while (associated (evt))
	call evt%connect (process_instance, model, process_stack)
	evt => evt%next
	end do
	end subroutine event_connect

	@ %def event_connect
	@ Set the parse nodes for the associated expressions, individually. The
	parse-node pointers may be null.
	<<Events: event: TBP>>=
	procedure :: set_selection => event_set_selection
	procedure :: set_reweight => event_set_reweight
	procedure :: set_analysis => event_set_analysis
	<<Events: procedures>>=
	subroutine event_set_selection (event, ef_selection)
	class(event_t), intent(inout) :: event
	class(expr_factory_t), intent(in) :: ef_selection
	allocate (event%config%ef_selection, source = ef_selection)
	end subroutine event_set_selection

	subroutine event_set_reweight (event, ef_reweight)
	class(event_t), intent(inout) :: event
	class(expr_factory_t), intent(in) :: ef_reweight
	allocate (event%config%ef_reweight, source = ef_reweight)
	end subroutine event_set_reweight

	subroutine event_set_analysis (event, ef_analysis)
	class(event_t), intent(inout) :: event
	class(expr_factory_t), intent(in) :: ef_analysis
	allocate (event%config%ef_analysis, source = ef_analysis)
	end subroutine event_set_analysis

	@ %def event_set_selection
	@ %def event_set_reweight
	@ %def event_set_analysis
	@ Create evaluation trees from the parse trees. The [[target]] attribute is
	required because the expressions contain pointers to event subobjects.
	<<Events: event: TBP>>=
	procedure :: setup_expressions => event_setup_expressions
	<<Events: procedures>>=
	subroutine event_setup_expressions (event)
	class(event_t), intent(inout), target :: event
	call event%expr%setup_selection (event%config%ef_selection)
	call event%expr%setup_analysis (event%config%ef_analysis)
	call event%expr%setup_reweight (event%config%ef_reweight)
	call event%expr%colorize (event%config%colorize_subevt)
	end subroutine event_setup_expressions

	@ %def event_setup_expressions
	@
	\subsection{Evaluation}
	To fill the [[particle_set]], i.e., the event record proper, we have
	to apply all event transforms in order. The last transform should
	fill its associated particle set, factorizing the state matrix
	according to the current settings. There are several parameters
	in the event configuration that control this.

	We always fill the particle set for the first transform (the hard
	process) and the last transform, if different from the first (the
	fully dressed process).

	Each event transform is an event generator of its own. We choose to
	generate an \emph{unweighted} event for each of them, even if the master
	event is assumed to be weighted. Thus, the overall event weight is
	the one of the hard process only. (There may be more options in future
	extensions.)

	We can generate the two random numbers that the factorization needs.
	For testing purpose, we allow for providing them explicitly, as an option.
	<<Events: event: TBP>>=
	procedure :: evaluate_transforms => event_evaluate_transforms
	<<Events: procedures>>=
	subroutine event_evaluate_transforms (event, r)
	class(event_t), intent(inout) :: event
	real(default), dimension(:), intent(in), optional :: r
	class(evt_t), pointer :: evt
	real(default) :: sigma_over_sqme
	integer :: i_term
	logical :: failed_but_keep
	failed_but_keep = .false.
	call msg_debug (D_TRANSFORMS, "event_evaluate_transforms")
	call event%discard_particle_set ()
	call event%check ()
	if (event%instance%is_complete_event ()) then
	i_term = event%instance%select_i_term ()
	event%selected_i_term = i_term
	evt => event%transform_first
	do while (associated (evt))
	call evt%prepare_new_event &
	(event%selected_i_mci, event%selected_i_term)
	evt => evt%next
	end do
	evt => event%transform_first
	call msg_debug (D_TRANSFORMS, "Before event transformations")
	call msg_debug (D_TRANSFORMS, "event%weight_prc", event%weight_prc)
	call msg_debug (D_TRANSFORMS, "event%sqme_prc", event%sqme_prc)
	do while (associated (evt))
	call print_transform_name_if_debug ()
	if (evt%only_weighted_events) then
	select type (evt)
	type is (evt_nlo_t)
	failed_but_keep = .not. evt%is_valid_event (i_term) .and. evt%keep_failed_events
	if (.not. evt%is_valid_event (i_term) .and. .not. failed_but_keep) &
	return
	end select
	if (abs (event%weight_prc) > 0._default) then
	sigma_over_sqme = event%weight_prc / event%sqme_prc
	call evt%generate_weighted (event%sqme_prc)
	event%weight_prc = sigma_over_sqme * event%sqme_prc
	else
	if (.not. failed_but_keep) exit
	end if
	else
	call evt%generate_unweighted ()
	end if
	if (signal_is_pending ()) return
	call evt%make_particle_set (event%config%factorization_mode, &
	event%config%keep_correlations)
	if (signal_is_pending ()) return
	if (.not. evt%particle_set_exists) exit
	evt => evt%next
	end do
	evt => event%transform_last
	if ((associated (evt) .and. evt%particle_set_exists) .or. failed_but_keep) then
	if (event%is_nlo ()) then
	select type (evt)
	type is (evt_nlo_t)
	if (evt%i_evaluation > 0) then
	evt%particle_set_radiated (event%i_event + 1) = evt%particle_set
	else
	call evt%keep_and_boost_born_particle_set (event%i_event + 1)
	end if
	evt%i_evaluation = evt%i_evaluation + 1
	call event%link_particle_set &
	(evt%particle_set_radiated(event%i_event + 1))
	end select
	else
	call event%link_particle_set (evt%particle_set)
	end if
	end if
	call msg_debug (D_TRANSFORMS, "After event transformations")
	call msg_debug (D_TRANSFORMS, "event%weight_prc", event%weight_prc)
	call msg_debug (D_TRANSFORMS, "event%sqme_prc", event%sqme_prc)
	call msg_debug (D_TRANSFORMS, "evt%particle_set_exists", evt%particle_set_exists)
	end if
	contains
	subroutine print_transform_name_if_debug ()
	if (debug_active (D_TRANSFORMS)) then
	print *, 'Current event transform: '
	call evt%write_name ()
	end if
	end subroutine print_transform_name_if_debug
	end subroutine event_evaluate_transforms

	@ %def event_evaluate_transforms
	@ Set / increment the event index for the current event. There is no
	condition for this to happen. The event index is actually stored in
	the subevent expression, because this allows us to access it in
	subevent expressions as a variable.
	<<Events: event: TBP>>=
	procedure :: set_index => event_set_index
	procedure :: increment_index => event_increment_index
	<<Events: procedures>>=
	subroutine event_set_index (event, index)
	class(event_t), intent(inout) :: event
	integer, intent(in) :: index
	call event%expr%set_event_index (index)
	end subroutine event_set_index

	subroutine event_increment_index (event, offset)
	class(event_t), intent(inout) :: event
	integer, intent(in), optional :: offset
	call event%expr%increment_event_index (offset)
	end subroutine event_increment_index

	@ %def event_set_index
	@ %def event_increment_index
	@
	Evaluate the event-related expressions, given a valid
	[[particle_set]]. If [[update_sqme]] is set, we use the process
	instance for the [[sqme_prc]] value. The [[sqme_ref]] value is
	always taken from the event record.

	Note: without the explicit [[particle_set]] pointer, some gfortran 4.8
	version corrupts its memory.
	<<Events: event: TBP>>=
	procedure :: evaluate_expressions => event_evaluate_expressions
	<<Events: procedures>>=
	subroutine event_evaluate_expressions (event)
	class(event_t), intent(inout) :: event
	type(particle_set_t), pointer :: particle_set
	if (event%has_valid_particle_set ()) then
	particle_set => event%get_particle_set_ptr ()
	call event%expr%fill_subevt (particle_set)
	end if
	if (event%weight_ref_is_known ()) then
	call event%expr%set (weight_ref = event%get_weight_ref ())
	end if
	if (event%weight_prc_is_known ()) then
	call event%expr%set (weight_prc = event%get_weight_prc ())
	end if
	if (event%excess_prc_is_known ()) then
	call event%expr%set (excess_prc = event%get_excess_prc ())
	end if
	if (event%sqme_ref_is_known ()) then
	call event%expr%set (sqme_ref = event%get_sqme_ref ())
	end if
	if (event%sqme_prc_is_known ()) then
	call event%expr%set (sqme_prc = event%get_sqme_prc ())
	end if
	if (event%has_valid_particle_set ()) then
	call event%expr%evaluate &
	(event%passed, event%reweight, event%analysis_flag)
	event%selection_evaluated = .true.
	end if
	end subroutine event_evaluate_expressions

	@ %def event_evaluate_expressions
	@ Report the result of the [[selection]] evaluation.
	<<Events: event: TBP>>=
	procedure :: passed_selection => event_passed_selection
	<<Events: procedures>>=
	function event_passed_selection (event) result (flag)
	class(event_t), intent(in) :: event
	logical :: flag
	flag = event%passed
	end function event_passed_selection

	@ %def event_passed_selection
	@ Set alternate sqme and weight arrays. This should be merged with
	the previous routine, if the expressions are allowed to refer to these
	values.
	<<Events: event: TBP>>=
	procedure :: store_alt_values => event_store_alt_values
	<<Events: procedures>>=
	subroutine event_store_alt_values (event)
	class(event_t), intent(inout) :: event
	if (event%weight_alt_is_known ()) then
	call event%expr%set (weight_alt = event%get_weight_alt ())
	end if
	if (event%sqme_alt_is_known ()) then
	call event%expr%set (sqme_alt = event%get_sqme_alt ())
	end if
	end subroutine event_store_alt_values

	@ %def event_store_alt_values
	@
	<<Events: event: TBP>>=
	procedure :: is_nlo => event_is_nlo
	<<Events: procedures>>=
	function event_is_nlo (event) result (is_nlo)
	logical :: is_nlo
	class(event_t), intent(in) :: event
	if (associated (event%instance)) then
	select type (pcm => event%instance%pcm)
	type is (pcm_instance_nlo_t)
	is_nlo = pcm%is_fixed_order_nlo_events ()
	class default
	is_nlo = .false.
	end select
	else
	is_nlo = .false.
	end if
	end function event_is_nlo

	@ %def event_is_nlo
	@
	\subsection{Reset to empty state}
	Applying this, current event contents are marked as incomplete but
	are not deleted. In particular, the initialization is kept. The
	event index is also kept, this can be reset separately.
	<<Events: event: TBP>>=
	procedure :: reset_contents => event_reset_contents
	procedure :: reset_index => event_reset_index
	<<Events: procedures>>=
	subroutine event_reset_contents (event)
	class(event_t), intent(inout) :: event
	class(evt_t), pointer :: evt
	call event%base_reset_contents ()
	event%selected_i_mci = 0
	event%selected_i_term = 0
	event%selected_channel = 0
	event%is_complete = .false.
	call event%expr%reset_contents ()
	event%selection_evaluated = .false.
	event%passed = .false.
	event%analysis_flag = .false.
	if (associated (event%instance)) then
	call event%instance%reset (reset_mci = .true.)
	end if
	if (allocated (event%alpha_qcd_forced)) deallocate (event%alpha_qcd_forced)
	if (allocated (event%scale_forced)) deallocate (event%scale_forced)
	evt => event%transform_first
	do while (associated (evt))
	call evt%reset ()
	evt => evt%next
	end do
	end subroutine event_reset_contents

	subroutine event_reset_index (event)
	class(event_t), intent(inout) :: event
	call event%expr%reset_event_index ()
	end subroutine event_reset_index

	@ %def event_reset_contents
	@ %def event_reset_index
	@
	\subsection{Squared Matrix Element and Weight}
	Transfer the result of the process instance calculation to the
	event record header.
	<<Events: event: TBP>>=
	procedure :: import_instance_results => event_import_instance_results
	<<Events: procedures>>=
	subroutine event_import_instance_results (event)
	class(event_t), intent(inout) :: event
	if (associated (event%instance)) then
	if (event%instance%has_evaluated_trace ()) then
	call event%set ( &
	sqme_prc = event%instance%get_sqme (), &
	weight_prc = event%instance%get_weight (), &
	excess_prc = event%instance%get_excess () &
	)
	end if
	end if
	end subroutine event_import_instance_results

	@ %def event_import_instance_results
	@ Duplicate the instance result / the reference result in the event
	record.
	<<Events: event: TBP>>=
	procedure :: accept_sqme_ref => event_accept_sqme_ref
	procedure :: accept_sqme_prc => event_accept_sqme_prc
	procedure :: accept_weight_ref => event_accept_weight_ref
	procedure :: accept_weight_prc => event_accept_weight_prc
	<<Events: procedures>>=
	subroutine event_accept_sqme_ref (event)
	class(event_t), intent(inout) :: event
	if (event%sqme_ref_is_known ()) then
	call event%set (sqme_prc = event%get_sqme_ref ())
	end if
	end subroutine event_accept_sqme_ref

	subroutine event_accept_sqme_prc (event)
	class(event_t), intent(inout) :: event
	if (event%sqme_prc_is_known ()) then
	call event%set (sqme_ref = event%get_sqme_prc ())
	end if
	end subroutine event_accept_sqme_prc

	subroutine event_accept_weight_ref (event)
	class(event_t), intent(inout) :: event
	if (event%weight_ref_is_known ()) then
	call event%set (weight_prc = event%get_weight_ref ())
	end if
	end subroutine event_accept_weight_ref

	subroutine event_accept_weight_prc (event)
	class(event_t), intent(inout) :: event
	if (event%weight_prc_is_known ()) then
	call event%set (weight_ref = event%get_weight_prc ())
	end if
	end subroutine event_accept_weight_prc

	@ %def event_accept_sqme_ref
	@ %def event_accept_sqme_prc
	@ %def event_accept_weight_ref
	@ %def event_accept_weight_prc
	@ Update the weight normalization, just after generation. Unweighted
	and weighted events are generated with a different default
	normalization. The intended normalization is stored in the
	configuration record.
	<<Events: event: TBP>>=
	procedure :: update_normalization => event_update_normalization
	<<Events: procedures>>=
	subroutine event_update_normalization (event, mode_ref)
	class(event_t), intent(inout) :: event
	integer, intent(in), optional :: mode_ref
	integer :: mode_old
	real(default) :: weight, excess
	if (present (mode_ref)) then
	mode_old = mode_ref
	else if (event%config%unweighted) then
	mode_old = NORM_UNIT
	else
	mode_old = NORM_SIGMA
	end if
	weight = event%get_weight_prc ()
	call event_normalization_update (weight, &
	event%config%sigma, event%config%n, &
	mode_new = event%config%norm_mode, &
	mode_old = mode_old)
	call event%set_weight_prc (weight)
	excess = event%get_excess_prc ()
	call event_normalization_update (excess, &
	event%config%sigma, event%config%n, &
	mode_new = event%config%norm_mode, &
	mode_old = mode_old)
	call event%set_excess_prc (excess)
	end subroutine event_update_normalization

	@ %def event_update_normalization
	@
	The event is complete if it has a particle set plus valid entries for
	the sqme and weight values.
	<<Events: event: TBP>>=
	procedure :: check => event_check
	<<Events: procedures>>=
	subroutine event_check (event)
	class(event_t), intent(inout) :: event
	event%is_complete = event%has_valid_particle_set () &
	.and. event%sqme_ref_is_known () &
	.and. event%sqme_prc_is_known () &
	.and. event%weight_ref_is_known () &
	.and. event%weight_prc_is_known ()
	if (event%get_n_alt () /= 0) then
	event%is_complete = event%is_complete &
	.and. event%sqme_alt_is_known () &
	.and. event%weight_alt_is_known ()
	end if
	end subroutine event_check

	@ %def event_check
	@
	@
	\subsection{Generation}
	Assuming that we have a valid process associated to the event, we
	generate an event. We complete the event data, then factorize the
	spin density matrix and transfer it to the particle set.

	When done, we retrieve squared matrix element and weight. In case of
	explicit generation, the reference values coincide with the process
	values, so we [[accept]] the latter.

	The explicit random number argument [[r]] should be generated by a
	random-number generator. It is taken for the factorization algorithm,
	bypassing the event-specific random-number generator. This is useful
	for deterministic testing.
	<<Events: event: TBP>>=
	procedure :: generate => event_generate
	<<Events: procedures>>=
	subroutine event_generate (event, i_mci, r, i_nlo)
	class(event_t), intent(inout) :: event
	integer, intent(in) :: i_mci
	real(default), dimension(:), intent(in), optional :: r
	integer, intent(in), optional :: i_nlo
	logical :: generate_new
	generate_new = .true.
	if (present (i_nlo)) generate_new = (i_nlo == 1)
	if (generate_new) call event%reset_contents ()
	event%selected_i_mci = i_mci
	if (event%config%unweighted) then
	call event%instance%generate_unweighted_event (i_mci)
	if (signal_is_pending ()) return
	call event%instance%evaluate_event_data ()
	call event%instance%normalize_weight ()
	else
	if (generate_new) &
	call event%instance%generate_weighted_event (i_mci)
	if (signal_is_pending ()) return
	call event%instance%evaluate_event_data ()
	end if
	event%selected_channel = event%instance%get_channel ()
	call event%import_instance_results ()
	call event%accept_sqme_prc ()
	call event%update_normalization ()
	call event%accept_weight_prc ()
	call event%evaluate_transforms (r)
	if (signal_is_pending ()) return
	call event%check ()
	end subroutine event_generate

	@ %def event_generate
	@ Get a copy of the particle set belonging to the hard process.
	<<Events: event: TBP>>=
	procedure :: get_hard_particle_set => event_get_hard_particle_set
	<<Events: procedures>>=
	subroutine event_get_hard_particle_set (event, pset)
	class(event_t), intent(in) :: event
	type(particle_set_t), intent(out) :: pset
	class(evt_t), pointer :: evt
	evt => event%transform_first
	pset = evt%particle_set
	end subroutine event_get_hard_particle_set

	@ %def event_get_hard_particle_set
	@
	\subsection{Recovering an event}
	Select MC group, term, and integration channel.
	<<Events: event: TBP>>=
	procedure :: select => event_select
	<<Events: procedures>>=
	subroutine event_select (event, i_mci, i_term, channel)
	class(event_t), intent(inout) :: event
	integer, intent(in) :: i_mci, i_term, channel
	if (associated (event%instance)) then
	event%selected_i_mci = i_mci
	event%selected_i_term = i_term
	event%selected_channel = channel
	else
	event%selected_i_mci = 0
	event%selected_i_term = 0
	event%selected_channel = 0
	end if
	end subroutine event_select

	@ %def event_select
	@
	Copy a particle set into the event record.

	We deliberately use the first (the trivial) transform for this, i.e.,
	the hard process. The event reader may either read in the transformed
	event separately, or apply all event
	transforms to the hard particle set to (re)generate a fully dressed
	event.

	Since this makes all subsequent event transforms invalid, we call
	[[reset]] on them.
	<<Events: event: TBP>>=
	procedure :: set_hard_particle_set => event_set_hard_particle_set
	<<Events: procedures>>=
	subroutine event_set_hard_particle_set (event, particle_set)
	class(event_t), intent(inout) :: event
	type(particle_set_t), intent(in) :: particle_set
	class(evt_t), pointer :: evt
	evt => event%transform_first
	call evt%set_particle_set (particle_set, &
	event%selected_i_mci, event%selected_i_term)
	call event%link_particle_set (evt%particle_set)
	evt => evt%next
	do while (associated (evt))
	call evt%reset ()
	evt => evt%next
	end do
	end subroutine event_set_hard_particle_set

	@ %def event_set_hard_particle_set
	@
	Set the $\alpha_s$ value that should be used in a recalculation. This should
	be called only if we explicitly want to override the QCD setting of the
	process core.
	<<Events: event: TBP>>=
	procedure :: set_alpha_qcd_forced => event_set_alpha_qcd_forced
	<<Events: procedures>>=
	subroutine event_set_alpha_qcd_forced (event, alpha_qcd)
	class(event_t), intent(inout) :: event
	real(default), intent(in) :: alpha_qcd
	if (allocated (event%alpha_qcd_forced)) then
	event%alpha_qcd_forced = alpha_qcd
	else
	allocate (event%alpha_qcd_forced, source = alpha_qcd)
	end if
	end subroutine event_set_alpha_qcd_forced

	@ %def event_set_alpha_qcd_forced
	@
	Analogously, for the common scale. This forces also renormalization and
	factorization scale.
	<<Events: event: TBP>>=
	procedure :: set_scale_forced => event_set_scale_forced
	<<Events: procedures>>=
	subroutine event_set_scale_forced (event, scale)
	class(event_t), intent(inout) :: event
	real(default), intent(in) :: scale
	if (allocated (event%scale_forced)) then
	event%scale_forced = scale
	else
	allocate (event%scale_forced, source = scale)
	end if
	end subroutine event_set_scale_forced

	@ %def event_set_scale_forced
	@
	Here we try to recover an event from the [[particle_set]] subobject
	and recalculate the structure functions and matrix elements. We
	have the appropriate [[process]] object and an initialized
	[[process_instance]] at hand, so beam and configuration data are
	known. From the [[particle_set]], we get the momenta.

	The quantum-number information may be incomplete, e.g., helicity
	information may be partial or absent. We recover the event just from
	the momentum configuration.

	We do not transfer the matrix element from the process instance to the
	event record, as we do when generating an event. The event record may
	contain the matrix element as read from file, and the current
	calculation may use different parameters. We thus can compare old and
	new values.

	The event [[weight]] may also be known already. If yes, we pass it to the
	[[evaluate_event_data]] procedure. It should already be normalized. If we
	have an [[weight_factor]] value, we obtain the event weight by multiplying the
	computed [[sqme]] by this factor. Otherwise, we make use of the MCI setup
	(which should be valid then) to compute the event weight, and we should
	normalize the result just as when generating events.

	Evaluating event expressions must also be done separately.

	If [[recover_phs]] is set (and false), do not attempt any phase-space
	calculation, including MCI evaluation. Useful if we need only matrix elements.
	<<Events: event: TBP>>=
	procedure :: recalculate => event_recalculate
	<<Events: procedures>>=
	subroutine event_recalculate &
	(event, update_sqme, weight_factor, recover_beams, recover_phs)
	class(event_t), intent(inout) :: event
	logical, intent(in) :: update_sqme
	real(default), intent(in), optional :: weight_factor
	logical, intent(in), optional :: recover_beams
	logical, intent(in), optional :: recover_phs
	type(particle_set_t), pointer :: particle_set
	integer :: i_mci, i_term, channel
	logical :: rec_phs_mci
	rec_phs_mci = .true.; if (present (recover_phs)) rec_phs_mci = recover_phs
	if (event%has_valid_particle_set ()) then
	particle_set => event%get_particle_set_ptr ()
	i_mci = event%selected_i_mci
	i_term = event%selected_i_term
	channel = event%selected_channel
	if (i_mci == 0 .or. i_term == 0 .or. channel == 0) then
	call msg_bug ("Event: recalculate: undefined selection parameters")
	end if
	call event%instance%choose_mci (i_mci)
	call event%instance%set_trace (particle_set, i_term, recover_beams)
	if (allocated (event%alpha_qcd_forced)) then
	call event%instance%set_alpha_qcd_forced &
	(i_term, event%alpha_qcd_forced)
	end if
	call event%instance%recover (channel, i_term, &
	update_sqme, rec_phs_mci, event%scale_forced)
	if (signal_is_pending ()) return
	if (update_sqme .and. present (weight_factor)) then
	call event%instance%evaluate_event_data &
	(weight = event%instance%get_sqme () * weight_factor)
	else if (event%weight_ref_is_known ()) then
	call event%instance%evaluate_event_data &
	(weight = event%get_weight_ref ())
	else if (rec_phs_mci) then
	call event%instance%recover_event ()
	if (signal_is_pending ()) return
	call event%instance%evaluate_event_data ()
	if (event%config%unweighted) then
	call event%instance%normalize_weight ()
	end if
	end if
	if (signal_is_pending ()) return
	if (update_sqme) then
	call event%import_instance_results ()
	else
	call event%accept_sqme_ref ()
	call event%accept_weight_ref ()
	end if
	else
	call msg_bug ("Event: can't recalculate, particle set is undefined")
	end if
	end subroutine event_recalculate

	@ %def event_recalculate
	@
	\subsection{Access content}
	Pointer to the associated process object (the associated model).
	<<Events: event: TBP>>=
	procedure :: get_process_ptr => event_get_process_ptr
	procedure :: get_process_instance_ptr => event_get_process_instance_ptr
	procedure :: get_model_ptr => event_get_model_ptr
	<<Events: procedures>>=
	function event_get_process_ptr (event) result (ptr)
	class(event_t), intent(in) :: event
	type(process_t), pointer :: ptr
	ptr => event%process
	end function event_get_process_ptr

	function event_get_process_instance_ptr (event) result (ptr)
	class(event_t), intent(in) :: event
	type(process_instance_t), pointer :: ptr
	ptr => event%instance
	end function event_get_process_instance_ptr

	function event_get_model_ptr (event) result (model)
	class(event_t), intent(in) :: event
	class(model_data_t), pointer :: model
	if (associated (event%process)) then
	model => event%process%get_model_ptr ()
	else
	model => null ()
	end if
	end function event_get_model_ptr

	@ %def event_get_process_ptr
	@ %def event_get_process_instance_ptr
	@ %def event_get_model_ptr
	@ Return the current values of indices: the MCI group of components, the term
	index (different terms corresponding, potentially, to different effective
	kinematics), and the MC integration channel. The [[i_mci]] call is delegated
	to the current process instance.
	<<Events: event: TBP>>=
	procedure :: get_i_mci => event_get_i_mci
	procedure :: get_i_term => event_get_i_term
	procedure :: get_channel => event_get_channel
	<<Events: procedures>>=
	function event_get_i_mci (event) result (i_mci)
	class(event_t), intent(in) :: event
	integer :: i_mci
	i_mci = event%selected_i_mci
	end function event_get_i_mci

	function event_get_i_term (event) result (i_term)
	class(event_t), intent(in) :: event
	integer :: i_term
	i_term = event%selected_i_term
	end function event_get_i_term

	function event_get_channel (event) result (channel)
	class(event_t), intent(in) :: event
	integer :: channel
	channel = event%selected_channel
	end function event_get_channel

	@ %def event_get_i_mci
	@ %def event_get_i_term
	@ %def event_get_channel
	@ This flag tells us whether the event consists just of a hard process
	(i.e., holds at most the first, trivial transform), or is a dressed
	events with additional transforms.
	<<Events: event: TBP>>=
	procedure :: has_transform => event_has_transform
	<<Events: procedures>>=
	function event_has_transform (event) result (flag)
	class(event_t), intent(in) :: event
	logical :: flag
	if (associated (event%transform_first)) then
	flag = associated (event%transform_first%next)
	else
	flag = .false.
	end if
	end function event_has_transform

	@ %def event_has_transform
	@ Return the currently selected normalization mode, or alternate
	normalization mode.
	<<Events: event: TBP>>=
	procedure :: get_norm_mode => event_get_norm_mode
	<<Events: procedures>>=
	elemental function event_get_norm_mode (event) result (norm_mode)
	class(event_t), intent(in) :: event
	integer :: norm_mode
	norm_mode = event%config%norm_mode
	end function event_get_norm_mode

	@ %def event_get_norm_mode
	@ Return the kinematical weight, defined as the ratio of event weight
	and squared matrix element.
	<<Events: event: TBP>>=
	procedure :: get_kinematical_weight => event_get_kinematical_weight
	<<Events: procedures>>=
	function event_get_kinematical_weight (event) result (f)
	class(event_t), intent(in) :: event
	real(default) :: f
	if (event%sqme_ref_is_known () .and. event%weight_ref_is_known () &
	.and. abs (event%get_sqme_ref ()) > 0) then
	f = event%get_weight_ref () / event%get_sqme_ref ()
	else
	f = 0
	end if
	end function event_get_kinematical_weight

	@ %def event_get_kinematical_weight
	@ Return data used by external event formats.
	<<Events: event: TBP>>=
	procedure :: has_index => event_has_index
	procedure :: get_index => event_get_index
	procedure :: get_fac_scale => event_get_fac_scale
	procedure :: get_alpha_s => event_get_alpha_s
	procedure :: get_sqrts => event_get_sqrts
	procedure :: get_polarization => event_get_polarization
	procedure :: get_beam_file => event_get_beam_file
	procedure :: get_process_name => event_get_process_name
	<<Events: procedures>>=
	function event_has_index (event) result (flag)
	class(event_t), intent(in) :: event
	logical :: flag
	flag = event%expr%has_event_index ()
	end function event_has_index

	function event_get_index (event) result (index)
	class(event_t), intent(in) :: event
	integer :: index
	index = event%expr%get_event_index ()
	end function event_get_index

	function event_get_fac_scale (event) result (fac_scale)
	class(event_t), intent(in) :: event
	real(default) :: fac_scale
	fac_scale = event%instance%get_fac_scale (event%selected_i_term)
	end function event_get_fac_scale

	function event_get_alpha_s (event) result (alpha_s)
	class(event_t), intent(in) :: event
	real(default) :: alpha_s
	alpha_s = event%instance%get_alpha_s (event%selected_i_term)
	end function event_get_alpha_s

	function event_get_sqrts (event) result (sqrts)
	class(event_t), intent(in) :: event
	real(default) :: sqrts
	sqrts = event%instance%get_sqrts ()
	end function event_get_sqrts

	function event_get_polarization (event) result (pol)
	class(event_t), intent(in) :: event
	real(default), dimension(2) :: pol
	pol = event%instance%get_polarization ()
	end function event_get_polarization

	function event_get_beam_file (event) result (file)
	class(event_t), intent(in) :: event
	type(string_t) :: file
	file = event%instance%get_beam_file ()
	end function event_get_beam_file

	function event_get_process_name (event) result (name)
	class(event_t), intent(in) :: event
	type(string_t) :: name
	name = event%instance%get_process_name ()
	end function event_get_process_name

	@ %def event_get_index
	@ %def event_get_fac_scale
	@ %def event_get_alpha_s
	@ %def event_get_sqrts
	@ %def event_get_polarization
	@ %def event_get_beam_file
	@ %def event_get_process_name
	@ Return the actual number of calls, as stored in the process instance.
	<<Events: event: TBP>>=
	procedure :: get_actual_calls_total => event_get_actual_calls_total
	<<Events: procedures>>=
	elemental function event_get_actual_calls_total (event) result (n)
	class(event_t), intent(in) :: event
	integer :: n
	if (associated (event%instance)) then
	n = event%instance%get_actual_calls_total ()
	else
	n = 0
	end if
	end function event_get_actual_calls_total

	@ %def event_get_actual_calls_total
	@
	Eliminate numerical noise in the [[subevt]] expression and in the event
	transforms (which includes associated process instances).
	<<Events: public>>=
	public :: pacify
	<<Events: interfaces>>=
	interface pacify
	module procedure pacify_event
	end interface pacify
	<<Events: procedures>>=
	subroutine pacify_event (event)
	class(event_t), intent(inout) :: event
	class(evt_t), pointer :: evt
	call event%pacify_particle_set ()
	if (event%expr%subevt_filled) call pacify (event%expr)
	evt => event%transform_first
	do while (associated (evt))
	select type (evt)
	type is (evt_decay_t); call pacify (evt)
	end select
	evt => evt%next
	end do
	end subroutine pacify_event

	@ %def pacify
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[events_ut.f90]]>>=
	<<File header>>

	module events_ut
	use unit_tests
	use events_uti

	<<Standard module head>>

	<<Events: public test>>

	contains

	<<Events: test driver>>

	end module events_ut
	@ %def events_ut
	@
	<<[[events_uti.f90]]>>=
	<<File header>>

	module events_uti

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use model_data
	use particles
	use process_libraries
	use process_stacks
	use event_transforms
	use decays
	use decays_ut, only: prepare_testbed

	use process, only: process_t
	use instances, only: process_instance_t

	use events

	<<Standard module head>>

	<<Events: test declarations>>

	contains

	<<Events: tests>>

	end module events_uti

	@ %def events_uti
	@ API: driver for the unit tests below.
	<<Events: public test>>=
	public :: events_test
	<<Events: test driver>>=
	subroutine events_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Events: execute tests>>
	end subroutine events_test

	@ %def events_test
	@
	\subsubsection{Empty event record}
	<<Events: execute tests>>=
	call test (events_1, "events_1", &
	"empty event record", &
	u, results)
	<<Events: test declarations>>=
	public :: events_1
	<<Events: tests>>=
	subroutine events_1 (u)
	integer, intent(in) :: u
	type(event_t), target :: event

	write (u, "(A)") "* Test output: events_1"
	write (u, "(A)") "* Purpose: display an empty event object"
	write (u, "(A)")

	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Test output end: events_1"

	end subroutine events_1

	@ %def events_1
	@
	\subsubsection{Simple event}
	<<Events: execute tests>>=
	call test (events_2, "events_2", &
	"generate event", &
	u, results)
	<<Events: test declarations>>=
	public :: events_2
	<<Events: tests>>=
	subroutine events_2 (u)
	use processes_ut, only: prepare_test_process, cleanup_test_process
	integer, intent(in) :: u
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(model_data_t), target :: model

	write (u, "(A)") "* Test output: events_2"
	write (u, "(A)") "* Purpose: generate and display an event"
	write (u, "(A)")

	call model%init_test ()

	write (u, "(A)") "* Generate test process event"

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	call process_instance%setup_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Initialize event object"

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())

	write (u, "(A)")
	write (u, "(A)") "* Generate test process event"

	call process_instance%generate_weighted_event (1)

	write (u, "(A)")
	write (u, "(A)") "* Fill event object"
	write (u, "(A)")

	call event%generate (1, [0.4_default, 0.4_default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: events_2"

	end subroutine events_2

	@ %def events_2
	@
	\subsubsection{Recovering an event}
	Generate an event and store the particle set. Then reset the event
	record, recall the particle set, and recover the event from that.

	Note: The extra [[particle_set_ptr]] auxiliary is a workaround for
	memory corruption in gfortran 4.7.
	<<Events: execute tests>>=
	call test (events_4, "events_4", &
	"recover event", &
	u, results)
	<<Events: test declarations>>=
	public :: events_4
	<<Events: tests>>=
	subroutine events_4 (u)
	use processes_ut, only: prepare_test_process, cleanup_test_process
	integer, intent(in) :: u
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(particle_set_t) :: particle_set
	type(particle_set_t), pointer :: particle_set_ptr
	type(model_data_t), target :: model

	write (u, "(A)") "* Test output: events_4"
	write (u, "(A)") "* Purpose: generate and recover an event"
	write (u, "(A)")

	call model%init_test ()

	write (u, "(A)") "* Generate test process event and save particle set"
	write (u, "(A)")

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	call process_instance%setup_event_data ()

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())

	call event%generate (1, [0.4_default, 0.4_default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call event%write (u)

	particle_set_ptr => event%get_particle_set_ptr ()
	particle_set = particle_set_ptr

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	write (u, "(A)")
	write (u, "(A)") "* Recover event from particle set"
	write (u, "(A)")

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	call process_instance%setup_event_data ()

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())

	call event%select (1, 1, 1)
	call event%set_hard_particle_set (particle_set)
	call event%recalculate (update_sqme = .true.)
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Transfer sqme and evaluate expressions"
	write (u, "(A)")

	call event%accept_sqme_prc ()
	call event%accept_weight_prc ()
	call event%check ()
	call event%set_index (1)
	call event%evaluate_expressions ()
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reset contents"
	write (u, "(A)")

	call event%reset_contents ()
	call event%reset_index ()
	event%transform_first%particle_set_exists = .false.
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call particle_set%final ()

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: events_4"

	end subroutine events_4

	@ %def events_4
	@
	\subsubsection{Partially Recovering an event}
	Generate an event and store the particle set. Then reset the event
	record, recall the particle set, and recover the event as far as possible
	without recomputing the squared matrix element.
	<<Events: execute tests>>=
	call test (events_5, "events_5", &
	"partially recover event", &
	u, results)
	<<Events: test declarations>>=
	public :: events_5
	<<Events: tests>>=
	subroutine events_5 (u)
	use processes_ut, only: prepare_test_process, cleanup_test_process
	integer, intent(in) :: u
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(particle_set_t) :: particle_set
	type(particle_set_t), pointer :: particle_set_ptr
	real(default) :: sqme, weight
	type(model_data_t), target :: model

	write (u, "(A)") "* Test output: events_5"
	write (u, "(A)") "* Purpose: generate and recover an event"
	write (u, "(A)")

	call model%init_test ()

	write (u, "(A)") "* Generate test process event and save particle set"
	write (u, "(A)")

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	call process_instance%setup_event_data ()

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())

	call event%generate (1, [0.4_default, 0.4_default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call event%write (u)

	particle_set_ptr => event%get_particle_set_ptr ()
	particle_set = particle_set_ptr
	sqme = event%get_sqme_ref ()
	weight = event%get_weight_ref ()

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	write (u, "(A)")
	write (u, "(A)") "* Recover event from particle set"
	write (u, "(A)")

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	call process_instance%setup_event_data ()

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())

	call event%select (1, 1, 1)
	call event%set_hard_particle_set (particle_set)
	call event%recalculate (update_sqme = .false.)
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Manually set sqme and evaluate expressions"
	write (u, "(A)")

	call event%set (sqme_ref = sqme, weight_ref = weight)
	call event%accept_sqme_ref ()
	call event%accept_weight_ref ()
	call event%set_index (1)
	call event%evaluate_expressions ()
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call particle_set%final ()

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: events_5"

	end subroutine events_5

	@ %def events_5
	@
	\subsubsection{Decays}
	Generate an event with subsequent decays.
	<<Events: execute tests>>=
	call test (events_6, "events_6", &
	"decays", &
	u, results)
	<<Events: test declarations>>=
	public :: events_6
	<<Events: tests>>=
	subroutine events_6 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(string_t) :: prefix, procname1, procname2
	type(process_library_t), target :: lib
	type(process_stack_t) :: process_stack
	class(evt_t), pointer :: evt_decay
	type(event_t), allocatable, target :: event
	type(process_t), pointer :: process
	type(process_instance_t), allocatable, target :: process_instance

	write (u, "(A)") "* Test output: events_6"
	write (u, "(A)") "* Purpose: generate an event with subsequent decays"
	write (u, "(A)")

	write (u, "(A)") "* Generate test process and decay"
	write (u, "(A)")

	call os_data_init (os_data)

	prefix = "events_6"
	procname1 = prefix // "_p"
	procname2 = prefix // "_d"
	call prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering=.true., decay=.true.)

	write (u, "(A)") "* Initialize decay process"

	process => process_stack%get_process_ptr (procname1)
	model => process%get_model_ptr ()
	call model%set_unstable (25, [procname2])

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	call process_instance%init_simulation (1)

	write (u, "(A)")
	write (u, "(A)") "* Initialize event transform: decay"

	allocate (evt_decay_t :: evt_decay)
	call evt_decay%connect (process_instance, model, process_stack)

	write (u, "(A)")
	write (u, "(A)") "* Initialize event object"
	write (u, "(A)")

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, model)
	call event%import_transform (evt_decay)

	call event%write (u, show_decay = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Generate event"
	write (u, "(A)")

	call event%generate (1, [0.4_default, 0.4_default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call event%final ()
	deallocate (event)

	call process_instance%final ()
	deallocate (process_instance)

	call process_stack%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: events_6"

	end subroutine events_6

	@ %def events_6
	@
	\subsubsection{Decays}
	Generate a decay event with varying options.
	<<Events: execute tests>>=
	call test (events_7, "events_7", &
	"decay options", &
	u, results)
	<<Events: test declarations>>=
	public :: events_7
	<<Events: tests>>=
	subroutine events_7 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	class(model_data_t), pointer :: model
	type(string_t) :: prefix, procname2
	type(process_library_t), target :: lib
	type(process_stack_t) :: process_stack
	type(process_t), pointer :: process
	type(process_instance_t), allocatable, target :: process_instance

	write (u, "(A)") "* Test output: events_7"
	write (u, "(A)") "* Purpose: check decay options"
	write (u, "(A)")

	write (u, "(A)") "* Prepare test process"
	write (u, "(A)")

	call os_data_init (os_data)

	prefix = "events_7"
	procname2 = prefix // "_d"
	call prepare_testbed &
	(lib, process_stack, prefix, os_data, &
	scattering=.false., decay=.true.)

	write (u, "(A)") "* Generate decay event, default options"
	write (u, "(A)")

	process => process_stack%get_process_ptr (procname2)
	model => process%get_model_ptr ()
	call model%set_unstable (25, [procname2])

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data (model)
	call process_instance%init_simulation (1)

	call process_instance%generate_weighted_event (1)
	call process_instance%write (u)

	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Generate decay event, helicity-diagonal decay"
	write (u, "(A)")

	process => process_stack%get_process_ptr (procname2)
	model => process%get_model_ptr ()
	call model%set_unstable (25, [procname2], diagonal = .true.)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data (model)
	call process_instance%init_simulation (1)

	call process_instance%generate_weighted_event (1)
	call process_instance%write (u)

	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Generate decay event, isotropic decay, &
	&polarized final state"
	write (u, "(A)")

	process => process_stack%get_process_ptr (procname2)
	model => process%get_model_ptr ()
	call model%set_unstable (25, [procname2], isotropic = .true.)
	call model%set_polarized (6)
	call model%set_polarized (-6)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data (model)
	call process_instance%init_simulation (1)

	call process_instance%generate_weighted_event (1)
	call process_instance%write (u)

	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call process_stack%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: events_7"

	end subroutine events_7

	@ %def events_7
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Raw Event I/O}
	The raw format is for internal use only. All data are stored
	unformatted, so they can be efficiently be re-read on the same
	machine, but not necessarily on another machine.

	This module explicitly depends on the [[events]] module which provides the
	concrete implementation of [[event_base]]. The other I/O formats
	access only the methods that are defined in [[event_base]].
	<<[[eio_raw.f90]]>>=
	<<File header>>

	module eio_raw

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use diagnostics
	use model_data
	use particles
	use event_base
	use eio_data
	use eio_base
	use events

	<<Standard module head>>

	<<EIO raw: public>>

	<<EIO raw: parameters>>

	<<EIO raw: types>>

	contains

	<<EIO raw: procedures>>

	end module eio_raw
	@ %def eio_raw
	@
	\subsection{File Format Version}
	This is the current default file version.
	<<EIO raw: parameters>>=
	integer, parameter :: CURRENT_FILE_VERSION = 2

	@ %def CURRENT_FILE_VERSION
	@ The user may change this number; this should force some
	compatibility mode for reading and writing. In any case, the file
	version stored in a event file that we read has to match the expected
	file version.

	History of version numbers:
	\begin{enumerate}
	\item
	Format for WHIZARD 2.2.0 to 2.2.3. No version number stored in the raw file.
	\item
	Format from 2.2.4 on. File contains version number. The file
	contains the transformed particle set (if applicable) after the
	hard-process particle set.
	\end{enumerate}
	@
	\subsection{Type}
	Note the file version number. The default may be reset during
	initialization, which should enforce some compatibility mode.
	<<EIO raw: public>>=
	public :: eio_raw_t
	<<EIO raw: types>>=
	type, extends (eio_t) :: eio_raw_t
	logical :: reading = .false.
	logical :: writing = .false.
	integer :: unit = 0
	integer :: norm_mode = NORM_UNDEFINED
	real(default) :: sigma = 1
	integer :: n = 1
	integer :: n_alt = 0
	logical :: check = .false.
	integer :: file_version = CURRENT_FILE_VERSION
	contains
	<<EIO raw: eio raw: TBP>>
	end type eio_raw_t

	@ %def eio_raw_t
	@ Output. This is not the actual event format, but a readable account
	of the current object status.
	<<EIO raw: eio raw: TBP>>=
	procedure :: write => eio_raw_write
	<<EIO raw: procedures>>=
	subroutine eio_raw_write (object, unit)
	class(eio_raw_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(1x,A)") "Raw event stream:"
	write (u, "(3x,A,L1)") "Check MD5 sum = ", object%check
	if (object%n_alt > 0) then
	write (u, "(3x,A,I0)") "Alternate weights = ", object%n_alt
	end if
	if (object%reading) then
	write (u, "(3x,A,A)") "Reading from file = ", char (object%filename)
	else if (object%writing) then
	write (u, "(3x,A,A)") "Writing to file = ", char (object%filename)
	else
	write (u, "(3x,A)") "[closed]"
	end if
	end subroutine eio_raw_write

	@ %def eio_raw_write
	@ Finalizer: close any open file.
	<<EIO raw: eio raw: TBP>>=
	procedure :: final => eio_raw_final
	<<EIO raw: procedures>>=
	subroutine eio_raw_final (object)
	class(eio_raw_t), intent(inout) :: object
	if (object%reading .or. object%writing) then
	write (msg_buffer, "(A,A,A)") "Events: closing raw file '", &
	char (object%filename), "'"
	call msg_message ()
	close (object%unit)
	object%reading = .false.
	object%writing = .false.
	end if
	end subroutine eio_raw_final

	@ %def eio_raw_final
	@ Set the [[check]] flag which determines whether we compare checksums on input.
	<<EIO raw: eio raw: TBP>>=
	procedure :: set_parameters => eio_raw_set_parameters
	<<EIO raw: procedures>>=
	subroutine eio_raw_set_parameters (eio, check, version_string, extension)
	class(eio_raw_t), intent(inout) :: eio
	logical, intent(in), optional :: check
	type(string_t), intent(in), optional :: version_string
	type(string_t), intent(in), optional :: extension
	if (present (check)) eio%check = check
	if (present (version_string)) then
	select case (char (version_string))
	case ("", "2.2.4")
	eio%file_version = CURRENT_FILE_VERSION
	case ("2.2")
	eio%file_version = 1
	case default
	call msg_fatal ("Raw event I/O: unsupported version '" &
	// char (version_string) // "'")
	eio%file_version = 0
	end select
	end if
	if (present (extension)) then
	eio%extension = extension
	else
	eio%extension = "evx"
	end if
	end subroutine eio_raw_set_parameters

	@ %def eio_raw_set_parameters
	@ Initialize event writing.
	<<EIO raw: eio raw: TBP>>=
	procedure :: init_out => eio_raw_init_out
	<<EIO raw: procedures>>=
	subroutine eio_raw_init_out (eio, sample, data, success, extension)
	class(eio_raw_t), intent(inout) :: eio
	type(string_t), intent(in) :: sample
	type(event_sample_data_t), intent(in), optional :: data
	logical, intent(out), optional :: success
	type(string_t), intent(in), optional :: extension
	character(32) :: md5sum_prc, md5sum_cfg
	character(32), dimension(:), allocatable :: md5sum_alt
	integer :: i
	if (present (extension)) then
	eio%extension = extension
	else
	eio%extension = "evx"
	end if
	eio%filename = sample // "." // eio%extension
	eio%unit = free_unit ()
	write (msg_buffer, "(A,A,A)") "Events: writing to raw file '", &
	char (eio%filename), "'"
	call msg_message ()
	eio%writing = .true.
	if (present (data)) then
	md5sum_prc = data%md5sum_prc
	md5sum_cfg = data%md5sum_cfg
	eio%norm_mode = data%norm_mode
	eio%sigma = data%total_cross_section
	eio%n = data%n_evt
	eio%n_alt = data%n_alt
	if (eio%n_alt > 0) then
	!!! !!! !!! Workaround for gfortran 5.0 ICE
	allocate (md5sum_alt (data%n_alt))
	md5sum_alt = data%md5sum_alt
	!!! allocate (md5sum_alt (data%n_alt), source = data%md5sum_alt)
	end if
	else
	md5sum_prc = ""
	md5sum_cfg = ""
	end if
	open (eio%unit, file = char (eio%filename), form = "unformatted", &
	action = "write", status = "replace")
	select case (eio%file_version)
	case (2:); write (eio%unit) eio%file_version
	end select
	write (eio%unit) md5sum_prc
	write (eio%unit) md5sum_cfg
	write (eio%unit) eio%norm_mode
	write (eio%unit) eio%n_alt
	if (allocated (md5sum_alt)) then
	do i = 1, eio%n_alt
	write (eio%unit) md5sum_alt(i)
	end do
	end if
	if (present (success)) success = .true.
	end subroutine eio_raw_init_out

	@ %def eio_raw_init_out
	@ Initialize event reading.
	<<EIO raw: eio raw: TBP>>=
	procedure :: init_in => eio_raw_init_in
	<<EIO raw: procedures>>=
	subroutine eio_raw_init_in (eio, sample, data, success, extension)
	class(eio_raw_t), intent(inout) :: eio
	type(string_t), intent(in) :: sample
	type(event_sample_data_t), intent(inout), optional :: data
	logical, intent(out), optional :: success
	type(string_t), intent(in), optional :: extension
	character(32) :: md5sum_prc, md5sum_cfg
	character(32), dimension(:), allocatable :: md5sum_alt
	integer :: i, file_version
	if (present (success)) success = .true.
	if (present (extension)) then
	eio%extension = extension
	else
	eio%extension = "evx"
	end if
	eio%filename = sample // "." // eio%extension
	eio%unit = free_unit ()
	if (present (data)) then
	eio%sigma = data%total_cross_section
	eio%n = data%n_evt
	end if
	write (msg_buffer, "(A,A,A)") "Events: reading from raw file '", &
	char (eio%filename), "'"
	call msg_message ()
	eio%reading = .true.
	open (eio%unit, file = char (eio%filename), form = "unformatted", &
	action = "read", status = "old")
	select case (eio%file_version)
	case (2:); read (eio%unit) file_version
	case default; file_version = 1
	end select
	if (file_version /= eio%file_version) then
	call msg_error ("Reading event file: raw-file version mismatch.")
	if (present (success)) success = .false.
	return
	else if (file_version /= CURRENT_FILE_VERSION) then
	call msg_warning ("Reading event file: compatibility mode.")
	end if
	read (eio%unit) md5sum_prc
	read (eio%unit) md5sum_cfg
	read (eio%unit) eio%norm_mode
	read (eio%unit) eio%n_alt
	if (present (data)) then
	if (eio%n_alt /= data%n_alt) then
	if (present (success)) success = .false.
	return
	end if
	end if
	allocate (md5sum_alt (eio%n_alt))
	do i = 1, eio%n_alt
	read (eio%unit) md5sum_alt(i)
	end do
	if (present (success)) then
	if (present (data)) then
	if (eio%check) then
	if (data%md5sum_prc /= "") then
	success = success .and. md5sum_prc == data%md5sum_prc
	end if
	if (data%md5sum_cfg /= "") then
	success = success .and. md5sum_cfg == data%md5sum_cfg
	end if
	do i = 1, eio%n_alt
	if (data%md5sum_alt(i) /= "") then
	success = success .and. md5sum_alt(i) == data%md5sum_alt(i)
	end if
	end do
	else
	call msg_warning ("Reading event file: MD5 sum check disabled")
	end if
	end if
	end if
	end subroutine eio_raw_init_in

	@ %def eio_raw_init_in
	@ Switch from input to output: reopen the file for reading.
	<<EIO raw: eio raw: TBP>>=
	procedure :: switch_inout => eio_raw_switch_inout
	<<EIO raw: procedures>>=
	subroutine eio_raw_switch_inout (eio, success)
	class(eio_raw_t), intent(inout) :: eio
	logical, intent(out), optional :: success
	write (msg_buffer, "(A,A,A)") "Events: appending to raw file '", &
	char (eio%filename), "'"
	call msg_message ()
	close (eio%unit, status = "keep")
	eio%reading = .false.
	open (eio%unit, file = char (eio%filename), form = "unformatted", &
	action = "write", position = "append", status = "old")
	eio%writing = .true.
	if (present (success)) success = .true.
	end subroutine eio_raw_switch_inout

	@ %def eio_raw_switch_inout
	@ Output an event. Write first the event indices, then weight and
	squared matrix element, then the particle set.

	We always write the particle set of the hard process. (Note: this
	should be reconsidered.) We do make a physical copy.

	On output, we write the [[prc]] values for weight and sqme, since
	these are the values just computed. On input, we store the values as
	[[ref]] values. The caller can then decide whether to recompute
	values and thus obtain distinct [[prc]] values, or just accept them.

	The [[passed]] flag is not written. This allow us to apply different
	selection criteria upon rereading.
	<<EIO raw: eio raw: TBP>>=
	procedure :: output => eio_raw_output
	<<EIO raw: procedures>>=
	subroutine eio_raw_output (eio, event, i_prc, reading, passed, pacify)
	class(eio_raw_t), intent(inout) :: eio
	class(generic_event_t), intent(in), target :: event
	logical, intent(in), optional :: reading, passed, pacify
	integer, intent(in) :: i_prc
	type(particle_set_t), pointer :: pset
	integer :: i
	if (eio%writing) then
	if (event%has_valid_particle_set ()) then
	select type (event)
	type is (event_t)
	write (eio%unit) i_prc
	write (eio%unit) event%get_index ()
	write (eio%unit) event%get_i_mci ()
	write (eio%unit) event%get_i_term ()
	write (eio%unit) event%get_channel ()
	write (eio%unit) event%expr%weight_prc
	write (eio%unit) event%expr%excess_prc
	write (eio%unit) event%expr%sqme_prc
	do i = 1, eio%n_alt
	write (eio%unit) event%expr%weight_alt(i)
	write (eio%unit) event%expr%sqme_alt(i)
	end do
	allocate (pset)
	call event%get_hard_particle_set (pset)
	call pset%write_raw (eio%unit)
	call pset%final ()
	deallocate (pset)
	select case (eio%file_version)
	case (2:)
	if (event%has_transform ()) then
	write (eio%unit) .true.
	pset => event%get_particle_set_ptr ()
	call pset%write_raw (eio%unit)
	else
	write (eio%unit) .false.
	end if
	end select
	class default
	call msg_bug ("Event: write raw: defined only for full event_t")
	end select
	else
	call msg_bug ("Event: write raw: particle set is undefined")
	end if
	else
	call eio%write ()
	call msg_fatal ("Raw event file is not open for writing")
	end if
	end subroutine eio_raw_output

	@ %def eio_raw_output
	@ Input an event.

	Note: the particle set is physically copied. If there is a
	performance issue, we might choose to pointer-assign it instead, with
	a different version of [[event%set_hard_particle_set]].
	<<EIO raw: eio raw: TBP>>=
	procedure :: input_i_prc => eio_raw_input_i_prc
	procedure :: input_event => eio_raw_input_event
	<<EIO raw: procedures>>=
	subroutine eio_raw_input_i_prc (eio, i_prc, iostat)
	class(eio_raw_t), intent(inout) :: eio
	integer, intent(out) :: i_prc
	integer, intent(out) :: iostat
	if (eio%reading) then
	read (eio%unit, iostat = iostat) i_prc
	else
	call eio%write ()
	call msg_fatal ("Raw event file is not open for reading")
	end if
	end subroutine eio_raw_input_i_prc

	subroutine eio_raw_input_event (eio, event, iostat)
	class(eio_raw_t), intent(inout) :: eio
	class(generic_event_t), intent(inout), target :: event
	integer, intent(out) :: iostat
	integer :: event_index, i_mci, i_term, channel, i
	real(default) :: weight, excess, sqme
	real(default), dimension(:), allocatable :: weight_alt, sqme_alt
	logical :: has_transform
	type(particle_set_t), pointer :: pset
	class(model_data_t), pointer :: model
	if (eio%reading) then
	select type (event)
	type is (event_t)
	read (eio%unit, iostat = iostat) event_index
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) i_mci
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) i_term
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) channel
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) weight
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) excess
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) sqme
	if (iostat /= 0) return
	call event%reset_contents ()
	call event%set_index (event_index)
	call event%select (i_mci, i_term, channel)
	if (eio%norm_mode /= NORM_UNDEFINED) then
	call event_normalization_update (weight, &
	eio%sigma, eio%n, event%get_norm_mode (), eio%norm_mode)
	call event_normalization_update (excess, &
	eio%sigma, eio%n, event%get_norm_mode (), eio%norm_mode)
	end if
	call event%set (sqme_ref = sqme, weight_ref = weight, &
	excess_prc = excess)
	if (eio%n_alt /= 0) then
	allocate (sqme_alt (eio%n_alt), weight_alt (eio%n_alt))
	do i = 1, eio%n_alt
	read (eio%unit, iostat = iostat) weight_alt(i)
	if (iostat /= 0) return
	read (eio%unit, iostat = iostat) sqme_alt(i)
	if (iostat /= 0) return
	end do
	call event%set (sqme_alt = sqme_alt, weight_alt = weight_alt)
	end if
	model => null ()
	if (associated (event%process)) then
	model => event%process%get_model_ptr ()
	end if
	allocate (pset)
	call pset%read_raw (eio%unit, iostat)
	if (iostat /= 0) return
	if (associated (model)) call pset%set_model (model)
	call event%set_hard_particle_set (pset)
	call pset%final ()
	deallocate (pset)
	select case (eio%file_version)
	case (2:)
	read (eio%unit, iostat = iostat) has_transform
	if (iostat /= 0) return
	if (has_transform) then
	allocate (pset)
	call pset%read_raw (eio%unit, iostat)
	if (iostat /= 0) return
	if (associated (model)) &
	call pset%set_model (model)
	call event%link_particle_set (pset)
	end if
	end select
	class default
	call msg_bug ("Event: read raw: defined only for full event_t")
	end select
	else
	call eio%write ()
	call msg_fatal ("Raw event file is not open for reading")
	end if
	end subroutine eio_raw_input_event

	@ %def eio_raw_input_i_prc
	@ %def eio_raw_input_event
	@
	<<EIO raw: eio raw: TBP>>=
	procedure :: skip => eio_raw_skip
	<<EIO raw: procedures>>=
	subroutine eio_raw_skip (eio, iostat)
	class(eio_raw_t), intent(inout) :: eio
	integer, intent(out) :: iostat
	if (eio%reading) then
	read (eio%unit, iostat = iostat)
	else
	call eio%write ()
	call msg_fatal ("Raw event file is not open for reading")
	end if
	end subroutine eio_raw_skip

	@ %def eio_raw_skip
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[eio_raw_ut.f90]]>>=
	<<File header>>

	module eio_raw_ut
	use unit_tests
	use eio_raw_uti

	<<Standard module head>>

	<<EIO raw: public test>>

	contains

	<<EIO raw: test driver>>

	end module eio_raw_ut
	@ %def eio_raw_ut
	@
	<<[[eio_raw_uti.f90]]>>=
	<<File header>>

	module eio_raw_uti

	<<Use kinds>>
	<<Use strings>>
	use model_data
	use variables
	use events
	use eio_data
	use eio_base

	use eio_raw

	use process, only: process_t
	use instances, only: process_instance_t

	<<Standard module head>>

	<<EIO raw: test declarations>>

	contains

	<<EIO raw: tests>>

	end module eio_raw_uti

	@ %def eio_raw_uti
	@ API: driver for the unit tests below.
	<<EIO raw: public test>>=
	public :: eio_raw_test
	<<EIO raw: test driver>>=
	subroutine eio_raw_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<EIO raw: execute tests>>
	end subroutine eio_raw_test

	@ %def eio_raw_test
	@
	\subsubsection{Test I/O methods}
	We test the implementation of all I/O methods.
	<<EIO raw: execute tests>>=
	call test (eio_raw_1, "eio_raw_1", &
	"read and write event contents", &
	u, results)
	<<EIO raw: test declarations>>=
	public :: eio_raw_1
	<<EIO raw: tests>>=
	subroutine eio_raw_1 (u)
	use processes_ut, only: prepare_test_process, cleanup_test_process
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	class(eio_t), allocatable :: eio
	integer :: i_prc, iostat
	type(string_t) :: sample

	write (u, "(A)") "* Test output: eio_raw_1"
	write (u, "(A)") "* Purpose: generate and read/write an event"
	write (u, "(A)")

	write (u, "(A)") "* Initialize test process"

	call model%init_test ()

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	call process_instance%setup_event_data ()

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())

	write (u, "(A)")
	write (u, "(A)") "* Generate and write an event"
	write (u, "(A)")

	sample = "eio_raw_1"

	allocate (eio_raw_t :: eio)

	call eio%init_out (sample)
	call event%generate (1, [0._default, 0._default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call event%write (u)
	write (u, "(A)")

	call eio%output (event, i_prc = 42)
	call eio%write (u)
	call eio%final ()

	call event%final ()
	deallocate (event)
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Re-read the event"
	write (u, "(A)")

	call eio%init_in (sample)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())

	call eio%input_i_prc (i_prc, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (i_prc):", iostat
	call eio%input_event (event, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (event):", iostat
	call eio%write (u)

	write (u, "(A)")
	write (u, "(1x,A,I0)") "i_prc = ", i_prc
	write (u, "(A)")
	call event%write (u)
	write (u, "(A)")
	write (u, "(A)") "* Generate and append another event"
	write (u, "(A)")

	call eio%switch_inout ()
	call event%generate (1, [0._default, 0._default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call event%write (u)
	write (u, "(A)")

	call eio%output (event, i_prc = 5)
	call eio%write (u)
	call eio%final ()

	call event%final ()
	deallocate (event)
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Re-read both events"
	write (u, "(A)")

	call eio%init_in (sample)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())

	call eio%input_i_prc (i_prc, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (i_prc/1):", iostat
	call eio%input_event (event, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (event/1):", iostat
	call eio%input_i_prc (i_prc, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (i_prc/2):", iostat
	call eio%input_event (event, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (event/2):", iostat
	call eio%write (u)

	write (u, "(A)")
	write (u, "(1x,A,I0)") "i_prc = ", i_prc
	write (u, "(A)")
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call eio%final ()
	deallocate (eio)

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: eio_raw_1"

	end subroutine eio_raw_1

	@ %def eio_raw_1
	@
	\subsubsection{Test I/O methods}
	We test the implementation of all I/O methods.
	<<EIO raw: execute tests>>=
	call test (eio_raw_2, "eio_raw_2", &
	"handle multiple weights", &
	u, results)
	<<EIO raw: test declarations>>=
	public :: eio_raw_2
	<<EIO raw: tests>>=
	subroutine eio_raw_2 (u)
	use processes_ut, only: prepare_test_process, cleanup_test_process
	integer, intent(in) :: u
	type(model_data_t), target :: model
	type(var_list_t) :: var_list
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(event_sample_data_t) :: data
	class(eio_t), allocatable :: eio
	integer :: i_prc, iostat
	type(string_t) :: sample

	write (u, "(A)") "* Test output: eio_raw_2"
	write (u, "(A)") "* Purpose: generate and read/write an event"
	write (u, "(A)") "* with multiple weights"
	write (u, "(A)")

	call model%init_test ()

	write (u, "(A)") "* Initialize test process"

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	call process_instance%setup_event_data ()

	call data%init (n_proc = 1, n_alt = 2)

	call var_list_append_log (var_list, var_str ("?unweighted"), .false., &
	intrinsic = .true.)
	call var_list_append_string (var_list, var_str ("$sample_normalization"), &
	var_str ("auto"), intrinsic = .true.)
	call var_list_append_real (var_list, var_str ("safety_factor"), &
	1._default, intrinsic = .true.)

	allocate (event)
	call event%basic_init (var_list, n_alt = 2)
	call event%connect (process_instance, process%get_model_ptr ())

	write (u, "(A)")
	write (u, "(A)") "* Generate and write an event"
	write (u, "(A)")

	sample = "eio_raw_2"

	allocate (eio_raw_t :: eio)

	call eio%init_out (sample, data)
	call event%generate (1, [0._default, 0._default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call event%set (sqme_alt = [2._default, 3._default])
	call event%set (weight_alt = &
	[2 * event%get_weight_ref (), 3 * event%get_weight_ref ()])
	call event%store_alt_values ()
	call event%check ()

	call event%write (u)
	write (u, "(A)")

	call eio%output (event, i_prc = 42)
	call eio%write (u)
	call eio%final ()

	call event%final ()
	deallocate (event)
	call process_instance%final ()
	deallocate (process_instance)

	write (u, "(A)")
	write (u, "(A)") "* Re-read the event"
	write (u, "(A)")

	call eio%init_in (sample, data)

	allocate (process_instance)
	call process_instance%init (process)
	call process_instance%setup_event_data ()
	allocate (event)
	call event%basic_init (var_list, n_alt = 2)
	call event%connect (process_instance, process%get_model_ptr ())

	call eio%input_i_prc (i_prc, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (i_prc):", iostat
	call eio%input_event (event, iostat)
	if (iostat /= 0) write (u, "(A,I0)") "I/O error (event):", iostat
	call eio%write (u)

	write (u, "(A)")
	write (u, "(1x,A,I0)") "i_prc = ", i_prc
	write (u, "(A)")
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call eio%final ()
	deallocate (eio)

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call model%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: eio_raw_2"

	end subroutine eio_raw_2

	@ %def eio_raw_2
	@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Dispatch}
	An event transform is responsible for dressing a partonic event.
	Since event transforms are not mutually exclusive but are
	concatenated, we provide individual dispatchers for each of them.

	<<[[dispatch_transforms.f90]]>>=
	<<File header>>

	module dispatch_transforms

	<<Use kinds>>
	<<Use strings>>
	use process
	use variables
	use system_defs, only: LF
	use system_dependencies, only: LHAPDF6_AVAILABLE
	use sf_lhapdf, only: lhapdf_initialize
	use diagnostics
	use models
	use os_interface
	use beam_structures
	use resonances, only: resonance_history_set_t
	use instances, only: process_instance_t, process_instance_hook_t

	use event_base, only: event_callback_t, event_callback_nop_t
	use eio_base
	use eio_raw
	use eio_checkpoints
	use eio_callback
	use eio_lhef
	use eio_hepmc
	use eio_lcio
	use eio_stdhep
	use eio_ascii
	use eio_weights
	use eio_dump

	use event_transforms
	use resonance_insertion
	use isr_epa_handler
	use decays
	use shower_base
	use shower_core
	use shower
	use shower_pythia6
	+ use shower_pythia8
	use hadrons
	use mlm_matching
	use powheg_matching
	use ckkw_matching
	use tauola_interface !NODEP!
	use evt_nlo

	<<Standard module head>>

	<<Dispatch transforms: public>>

	contains

	<<Dispatch transforms: procedures>>

	end module dispatch_transforms
	@ %def dispatch_transforms
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_nlo
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_nlo (evt, keep_failed_events)
	class(evt_t), intent(out), pointer :: evt
	logical, intent(in) :: keep_failed_events
	call msg_message ("Simulate: activating fixed-order NLO events")
	allocate (evt_nlo_t :: evt)
	evt%only_weighted_events = .true.
	select type (evt)
	type is (evt_nlo_t)
	evt%i_evaluation = 0
	evt%keep_failed_events = keep_failed_events
	end select
	end subroutine dispatch_evt_nlo

	@ %def dispatch_evt_nlo
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_resonance
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_resonance (evt, var_list, res_history_set, libname)
	class(evt_t), intent(out), pointer :: evt
	type(var_list_t), intent(in) :: var_list
	type(resonance_history_set_t), dimension(:), intent(in) :: res_history_set
	type(string_t), intent(in) :: libname
	logical :: resonance_history
	resonance_history = var_list%get_lval (var_str ("?resonance_history"))
	if (resonance_history) then
	allocate (evt_resonance_t :: evt)
	call msg_message ("Simulate: activating resonance insertion")
	select type (evt)
	type is (evt_resonance_t)
	call evt%set_resonance_data (res_history_set)
	call evt%set_library (libname)
	end select
	else
	evt => null ()
	end if
	end subroutine dispatch_evt_resonance

	@ %def dispatch_evt_resonance
	@ Initialize the ISR/EPA handler, depending on active settings.

	The activation is independent for both handlers, since only one may be
	needed at a time. However, if both handlers are active, the current
	implementation requires the handler modes of ISR and EPA to coincide.
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_isr_epa_handler
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_isr_epa_handler (evt, var_list)
	class(evt_t), intent(out), pointer :: evt
	type(var_list_t), intent(in) :: var_list
	logical :: isr_recoil
	logical :: epa_recoil
	logical :: isr_handler_active
	logical :: epa_handler_active
	type(string_t) :: isr_handler_mode
	type(string_t) :: epa_handler_mode
	real(default) :: sqrts
	real(default) :: isr_q_max
	real(default) :: epa_q_max
	real(default) :: isr_mass
	real(default) :: epa_mass
	isr_handler_active = var_list%get_lval (var_str ("?isr_handler"))
	if (isr_handler_active) then
	call msg_message ("Simulate: activating ISR handler")
	isr_recoil = var_list%get_lval (var_str ("?isr_recoil"))
	isr_handler_mode = var_list%get_sval (var_str ("$isr_handler_mode"))
	if (isr_recoil) then
	call msg_fatal ("Simulate: ISR handler is incompatible &
	&with ?isr_recoil=true")
	end if
	end if
	epa_handler_active = var_list%get_lval (var_str ("?epa_handler"))
	if (epa_handler_active) then
	call msg_message ("Simulate: activating EPA handler")
	epa_recoil = var_list%get_lval (var_str ("?epa_recoil"))
	epa_handler_mode = var_list%get_sval (var_str ("$epa_handler_mode"))
	if (epa_recoil) then
	call msg_fatal ("Simulate: EPA handler is incompatible &
	&with ?epa_recoil=true")
	end if
	end if
	if (isr_handler_active .and. epa_handler_active) then
	if (isr_handler_mode /= epa_handler_mode) then
	call msg_fatal ("Simulate: ISR/EPA handler: modes must coincide")
	end if
	end if
	if (isr_handler_active .or. epa_handler_active) then
	allocate (evt_isr_epa_t :: evt)
	select type (evt)
	type is (evt_isr_epa_t)
	if (isr_handler_active) then
	call evt%set_mode_string (isr_handler_mode)
	else
	call evt%set_mode_string (epa_handler_mode)
	end if
	sqrts = var_list%get_rval (var_str ("sqrts"))
	if (isr_handler_active) then
	isr_q_max = var_list%get_rval (var_str ("isr_q_max"))
	isr_mass = var_list%get_rval (var_str ("isr_mass"))
	call evt%set_data_isr (sqrts, isr_q_max, isr_mass)
	end if
	if (epa_handler_active) then
	epa_q_max = var_list%get_rval (var_str ("epa_q_max"))
	epa_mass = var_list%get_rval (var_str ("epa_mass"))
	call evt%set_data_epa (sqrts, epa_q_max, epa_mass)
	end if
	call msg_message ("Simulate: ISR/EPA handler mode: " &
	// char (evt%get_mode_string ()))
	end select
	else
	evt => null ()
	end if
	end subroutine dispatch_evt_isr_epa_handler

	@ %def dispatch_evt_isr_epa_handler
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_decay
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_decay (evt, var_list)
	class(evt_t), intent(out), pointer :: evt
	type(var_list_t), intent(in), target :: var_list
	logical :: allow_decays
	allow_decays = var_list%get_lval (var_str ("?allow_decays"))
	if (allow_decays) then
	allocate (evt_decay_t :: evt)
	call msg_message ("Simulate: activating decays")
	select type (evt)
	type is (evt_decay_t)
	call evt%set_var_list (var_list)
	end select
	else
	evt => null ()
	end if
	end subroutine dispatch_evt_decay

	@ %def dispatch_evt_decay
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_shower
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_shower (evt, var_list, model, fallback_model, &
	os_data, beam_structure, process)
	class(evt_t), intent(out), pointer :: evt
	type(var_list_t), intent(in) :: var_list
	type(model_t), pointer, intent(in) :: model, fallback_model
	type(os_data_t), intent(in) :: os_data
	type(beam_structure_t), intent(in) :: beam_structure
	type(process_t), intent(in), optional :: process
	type(string_t) :: lhapdf_file, lhapdf_dir, process_name
	integer :: lhapdf_member
	type(shower_settings_t) :: settings
	type(taudec_settings_t) :: taudec_settings
	call msg_message ("Simulate: activating parton shower")
	allocate (evt_shower_t :: evt)
	call settings%init (var_list)
	if (associated (model)) then
	call taudec_settings%init (var_list, model)
	else
	call taudec_settings%init (var_list, fallback_model)
	end if
	if (present (process)) then
	process_name = process%get_id ()
	else
	process_name = 'dispatch_testing'
	end if
	select type (evt)
	type is (evt_shower_t)
	call evt%init (fallback_model, os_data)
	lhapdf_member = &
	var_list%get_ival (var_str ("lhapdf_member"))
	if (LHAPDF6_AVAILABLE) then
	lhapdf_dir = &
	var_list%get_sval (var_str ("$lhapdf_dir"))
	lhapdf_file = &
	var_list%get_sval (var_str ("$lhapdf_file"))
	call lhapdf_initialize &
	(1, lhapdf_dir, lhapdf_file, lhapdf_member, evt%pdf_data%pdf)
	end if
	if (present (process)) call evt%pdf_data%setup ("Shower", &
	beam_structure, lhapdf_member, process%get_pdf_set ())
	select case (settings%method)
	case (PS_WHIZARD)
	allocate (shower_t :: evt%shower)
	case (PS_PYTHIA6)
	allocate (shower_pythia6_t :: evt%shower)
	+ case (PS_PYTHIA8)
	+ allocate (shower_pythia8_t :: evt%shower)
	case default
	call msg_fatal ('Shower: Method ' // &
	char (var_list%get_sval (var_str ("$shower_method"))) // &
	'not implemented!')
	end select
	- call evt%shower%init (settings, taudec_settings, evt%pdf_data)
	+ call evt%shower%init (settings, taudec_settings, evt%pdf_data, os_data)
	end select
	call dispatch_matching (evt, settings, var_list, process_name)
	end subroutine dispatch_evt_shower

	@ %def dispatch_evt_shower
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_shower_hook
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_shower_hook (hook, var_list, process_instance)
	class(process_instance_hook_t), pointer, intent(out) :: hook
	type(var_list_t), intent(in) :: var_list
	class(process_instance_t), intent(in), target :: process_instance
	if (var_list%get_lval (var_str ('?powheg_matching'))) then
	call msg_message ("Integration hook: add POWHEG hook")
	allocate (powheg_matching_hook_t :: hook)
	call hook%init (var_list, process_instance)
	else
	hook => null ()
	end if
	end subroutine dispatch_evt_shower_hook

	@ %def dispatch_evt_shower_hook
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_matching
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_matching (evt, settings, var_list, process_name)
	class(evt_t), intent(inout) :: evt
	type(var_list_t), intent(in) :: var_list
	type(string_t), intent(in) :: process_name
	type(shower_settings_t), intent(in) :: settings
	select type (evt)
	type is (evt_shower_t)
	if (settings%mlm_matching .and. settings%ckkw_matching) then
	call msg_fatal ("Both MLM and CKKW matching activated," // &
	LF // " aborting simulation")
	end if
	if (settings%powheg_matching) then
	call msg_message ("Simulate: applying POWHEG matching")
	allocate (powheg_matching_t :: evt%matching)
	end if
	if (settings%mlm_matching) then
	call msg_message ("Simulate: applying MLM matching")
	allocate (mlm_matching_t :: evt%matching)
	end if
	if (settings%ckkw_matching) then
	call msg_warning ("Simulate: CKKW(-L) matching not yet supported")
	allocate (ckkw_matching_t :: evt%matching)
	end if
	if (allocated (evt%matching)) &
	call evt%matching%init (var_list, process_name)
	end select
	end subroutine dispatch_matching

	@ %def dispatch_matching
	@
	<<Dispatch transforms: public>>=
	public :: dispatch_evt_hadrons
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_evt_hadrons (evt, var_list, fallback_model)
	class(evt_t), intent(out), pointer :: evt
	type(var_list_t), intent(in) :: var_list
	type(model_t), pointer, intent(in) :: fallback_model
	type(shower_settings_t) :: shower_settings
	type(hadron_settings_t) :: hadron_settings
	allocate (evt_hadrons_t :: evt)
	call msg_message ("Simulate: activating hadronization")
	call shower_settings%init (var_list)
	call hadron_settings%init (var_list)
	select type (evt)
	type is (evt_hadrons_t)
	call evt%init (fallback_model)
	select case (hadron_settings%method)
	case (HADRONS_WHIZARD)
	allocate (hadrons_hadrons_t :: evt%hadrons)
	case (HADRONS_PYTHIA6)
	allocate (hadrons_pythia6_t :: evt%hadrons)
	case (HADRONS_PYTHIA8)
	allocate (hadrons_pythia8_t :: evt%hadrons)
	case default
	call msg_fatal ('Hadronization: Method ' // &
	char (var_list%get_sval (var_str ("hadronization_method"))) // &
	'not implemented!')
	end select
	call evt%hadrons%init &
	(shower_settings, hadron_settings, fallback_model)
	end select
	end subroutine dispatch_evt_hadrons

	@ %def dispatch_evt_hadrons
	@ We cannot put this in the [[events]] subdir due to [[eio_raw_t]],
	which is defined here.
	<<Dispatch transforms: public>>=
	public :: dispatch_eio
	<<Dispatch transforms: procedures>>=
	subroutine dispatch_eio (eio, method, var_list, fallback_model, &
	event_callback)
	class(eio_t), allocatable, intent(inout) :: eio
	type(string_t), intent(in) :: method
	type(var_list_t), intent(in) :: var_list
	type(model_t), target, intent(in) :: fallback_model
	class(event_callback_t), allocatable, intent(in) :: event_callback
	!!! !!! !!! Workaround for ifort v18(beta) bug
	type(event_callback_nop_t) :: event_callback_tmp
	logical :: check, keep_beams, keep_remnants, recover_beams
	logical :: use_alphas_from_file, use_scale_from_file
	logical :: write_sqme_prc, write_sqme_ref, write_sqme_alt
	logical :: output_cross_section, ensure_order
	type(string_t) :: lhef_version, lhef_extension, raw_version
	type(string_t) :: extension_default, debug_extension, dump_extension, &
	extension_hepmc, &
	extension_lha, extension_hepevt, extension_ascii_short, &
	extension_ascii_long, extension_athena, extension_mokka, &
	extension_stdhep, extension_stdhep_up, extension_stdhep_ev4, &
	extension_raw, extension_hepevt_verb, extension_lha_verb, &
	extension_lcio
	integer :: checkpoint
	logical :: show_process, show_transforms, show_decay, verbose, pacified
	logical :: dump_weights, dump_compressed, dump_summary, dump_screen
	keep_beams = &
	var_list%get_lval (var_str ("?keep_beams"))
	keep_remnants = &
	var_list%get_lval (var_str ("?keep_remnants"))
	ensure_order = &
	var_list%get_lval (var_str ("?hepevt_ensure_order"))
	recover_beams = &
	var_list%get_lval (var_str ("?recover_beams"))
	use_alphas_from_file = &
	var_list%get_lval (var_str ("?use_alphas_from_file"))
	use_scale_from_file = &
	var_list%get_lval (var_str ("?use_scale_from_file"))
	select case (char (method))
	case ("raw")
	allocate (eio_raw_t :: eio)
	select type (eio)
	type is (eio_raw_t)
	check = &
	var_list%get_lval (var_str ("?check_event_file"))
	raw_version = &
	var_list%get_sval (var_str ("$event_file_version"))
	extension_raw = &
	var_list%get_sval (var_str ("$extension_raw"))
	call eio%set_parameters (check, raw_version, extension_raw)
	end select
	case ("checkpoint")
	allocate (eio_checkpoints_t :: eio)
	select type (eio)
	type is (eio_checkpoints_t)
	checkpoint = &
	var_list%get_ival (var_str ("checkpoint"))
	pacified = &
	var_list%get_lval (var_str ("?pacify"))
	call eio%set_parameters (checkpoint, blank = pacified)
	end select
	case ("callback")
	allocate (eio_callback_t :: eio)
	select type (eio)
	type is (eio_callback_t)
	checkpoint = &
	var_list%get_ival (var_str ("event_callback_interval"))
	if (allocated (event_callback)) then
	call eio%set_parameters (event_callback, checkpoint)
	else
	!!! !!! !!! Workaround for ifort v18(beta) bug
	! call eio%set_parameters (event_callback_nop_t (), 0)
	call eio%set_parameters (event_callback_tmp, 0)
	end if
	end select
	case ("lhef")
	allocate (eio_lhef_t :: eio)
	select type (eio)
	type is (eio_lhef_t)
	lhef_version = &
	var_list%get_sval (var_str ("$lhef_version"))
	lhef_extension = &
	var_list%get_sval (var_str ("$lhef_extension"))
	write_sqme_prc = &
	var_list%get_lval (var_str ("?lhef_write_sqme_prc"))
	write_sqme_ref = &
	var_list%get_lval (var_str ("?lhef_write_sqme_ref"))
	write_sqme_alt = &
	var_list%get_lval (var_str ("?lhef_write_sqme_alt"))
	call eio%set_parameters ( &
	keep_beams, keep_remnants, recover_beams, &
	use_alphas_from_file, use_scale_from_file, &
	char (lhef_version), lhef_extension, &
	write_sqme_ref, write_sqme_prc, write_sqme_alt)
	end select
	case ("hepmc")
	allocate (eio_hepmc_t :: eio)
	select type (eio)
	type is (eio_hepmc_t)
	output_cross_section = &
	var_list%get_lval (var_str ("?hepmc_output_cross_section"))
	extension_hepmc = &
	var_list%get_sval (var_str ("$extension_hepmc"))
	call eio%set_parameters (recover_beams, &
	use_alphas_from_file, use_scale_from_file, &
	extension_hepmc, output_cross_section)
	end select
	case ("lcio")
	allocate (eio_lcio_t :: eio)
	select type (eio)
	type is (eio_lcio_t)
	extension_lcio = &
	var_list%get_sval (var_str ("$extension_lcio"))
	call eio%set_parameters (recover_beams, &
	use_alphas_from_file, use_scale_from_file, &
	extension_lcio)
	end select
	case ("stdhep")
	allocate (eio_stdhep_hepevt_t :: eio)
	select type (eio)
	type is (eio_stdhep_hepevt_t)
	extension_stdhep = &
	var_list%get_sval (var_str ("$extension_stdhep"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, recover_beams, &
	use_alphas_from_file, use_scale_from_file, extension_stdhep)
	end select
	case ("stdhep_up")
	allocate (eio_stdhep_hepeup_t :: eio)
	select type (eio)
	type is (eio_stdhep_hepeup_t)
	extension_stdhep_up = &
	var_list%get_sval (var_str ("$extension_stdhep_up"))
	call eio%set_parameters (keep_beams, keep_remnants, ensure_order, &
	recover_beams, use_alphas_from_file, &
	use_scale_from_file, extension_stdhep_up)
	end select
	case ("stdhep_ev4")
	allocate (eio_stdhep_hepev4_t :: eio)
	select type (eio)
	type is (eio_stdhep_hepev4_t)
	extension_stdhep_ev4 = &
	var_list%get_sval (var_str ("$extension_stdhep_ev4"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, recover_beams, &
	use_alphas_from_file, use_scale_from_file, extension_stdhep_ev4)
	end select
	case ("ascii")
	allocate (eio_ascii_ascii_t :: eio)
	select type (eio)
	type is (eio_ascii_ascii_t)
	extension_default = &
	var_list%get_sval (var_str ("$extension_default"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_default)
	end select
	case ("athena")
	allocate (eio_ascii_athena_t :: eio)
	select type (eio)
	type is (eio_ascii_athena_t)
	extension_athena = &
	var_list%get_sval (var_str ("$extension_athena"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_athena)
	end select
	case ("debug")
	allocate (eio_ascii_debug_t :: eio)
	select type (eio)
	type is (eio_ascii_debug_t)
	debug_extension = &
	var_list%get_sval (var_str ("$debug_extension"))
	show_process = &
	var_list%get_lval (var_str ("?debug_process"))
	show_transforms = &
	var_list%get_lval (var_str ("?debug_transforms"))
	show_decay = &
	var_list%get_lval (var_str ("?debug_decay"))
	verbose = &
	var_list%get_lval (var_str ("?debug_verbose"))
	call eio%set_parameters ( &
	extension = debug_extension, &
	show_process = show_process, &
	show_transforms = show_transforms, &
	show_decay = show_decay, &
	verbose = verbose)
	end select
	case ("dump")
	allocate (eio_dump_t :: eio)
	select type (eio)
	type is (eio_dump_t)
	dump_extension = &
	var_list%get_sval (var_str ("$dump_extension"))
	pacified = &
	var_list%get_lval (var_str ("?pacify"))
	dump_weights = &
	var_list%get_lval (var_str ("?dump_weights"))
	dump_compressed = &
	var_list%get_lval (var_str ("?dump_compressed"))
	dump_summary = &
	var_list%get_lval (var_str ("?dump_summary"))
	dump_screen = &
	var_list%get_lval (var_str ("?dump_screen"))
	call eio%set_parameters ( &
	extension = dump_extension, &
	pacify = pacified, &
	weights = dump_weights, &
	compressed = dump_compressed, &
	summary = dump_summary, &
	screen = dump_screen)
	end select
	case ("hepevt")
	allocate (eio_ascii_hepevt_t :: eio)
	select type (eio)
	type is (eio_ascii_hepevt_t)
	extension_hepevt = &
	var_list%get_sval (var_str ("$extension_hepevt"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_hepevt)
	end select
	case ("hepevt_verb")
	allocate (eio_ascii_hepevt_verb_t :: eio)
	select type (eio)
	type is (eio_ascii_hepevt_verb_t)
	extension_hepevt_verb = &
	var_list%get_sval (var_str ("$extension_hepevt_verb"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_hepevt_verb)
	end select
	case ("lha")
	allocate (eio_ascii_lha_t :: eio)
	select type (eio)
	type is (eio_ascii_lha_t)
	extension_lha = &
	var_list%get_sval (var_str ("$extension_lha"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_lha)
	end select
	case ("lha_verb")
	allocate (eio_ascii_lha_verb_t :: eio)
	select type (eio)
	type is (eio_ascii_lha_verb_t)
	extension_lha_verb = var_list%get_sval ( &
	var_str ("$extension_lha_verb"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_lha_verb)
	end select
	case ("long")
	allocate (eio_ascii_long_t :: eio)
	select type (eio)
	type is (eio_ascii_long_t)
	extension_ascii_long = &
	var_list%get_sval (var_str ("$extension_ascii_long"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_ascii_long)
	end select
	case ("mokka")
	allocate (eio_ascii_mokka_t :: eio)
	select type (eio)
	type is (eio_ascii_mokka_t)
	extension_mokka = &
	var_list%get_sval (var_str ("$extension_mokka"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_mokka)
	end select
	case ("short")
	allocate (eio_ascii_short_t :: eio)
	select type (eio)
	type is (eio_ascii_short_t)
	extension_ascii_short = &
	var_list%get_sval (var_str ("$extension_ascii_short"))
	call eio%set_parameters &
	(keep_beams, keep_remnants, ensure_order, extension_ascii_short)
	end select
	case ("weight_stream")
	allocate (eio_weights_t :: eio)
	select type (eio)
	type is (eio_weights_t)
	pacified = &
	var_list%get_lval (var_str ("?pacify"))
	call eio%set_parameters (pacify = pacified)
	end select
	case default
	call msg_fatal ("Event I/O method '" // char (method) &
	// "' not implemented")
	end select
	call eio%set_fallback_model (fallback_model)
	end subroutine dispatch_eio

	@ %def dispatch_eio
	@
	@
	\subsection{Unit tests}
	Test module, followed by the corresponding implementation module.
	<<[[dispatch_transforms_ut.f90]]>>=
	<<File header>>

	module dispatch_transforms_ut
	use unit_tests
	use dispatch_transforms_uti

	<<Standard module head>>

	<<Dispatch transforms: public test>>

	contains

	<<Dispatch transforms: test driver>>

	end module dispatch_transforms_ut
	@ %def dispatch_transforms_ut
	@
	<<[[dispatch_transforms_uti.f90]]>>=
	<<File header>>

	module dispatch_transforms_uti

	<<Use kinds>>
	<<Use strings>>
	use format_utils, only: write_separator
	use variables
	use event_base, only: event_callback_t
	use models, only: model_t, model_list_t
	use models, only: syntax_model_file_init, syntax_model_file_final
	use resonances, only: resonance_history_set_t
	use beam_structures, only: beam_structure_t
	use eio_base, only: eio_t
	use os_interface, only: os_data_t, os_data_init
	use event_transforms, only: evt_t
	use dispatch_transforms

	<<Standard module head>>

	<<Dispatch transforms: test declarations>>

	contains

	<<Dispatch transforms: tests>>

	end module dispatch_transforms_uti
	@ %def dispatch_transforms_uti
	@ API: driver for the unit tests below.
	<<Dispatch transforms: public test>>=
	public ::dispatch_transforms_test
	<<Dispatch transforms: test driver>>=
	subroutine dispatch_transforms_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Dispatch transforms: execute tests>>
	end subroutine dispatch_transforms_test

	@ %def dispatch_transforms_test
	@
	\subsubsection{Event I/O}
	<<Dispatch transforms: execute tests>>=
	call test (dispatch_transforms_1, "dispatch_transforms_1", &
	"event I/O", &
	u, results)
	<<Dispatch transforms: test declarations>>=
	public :: dispatch_transforms_1
	<<Dispatch transforms: tests>>=
	subroutine dispatch_transforms_1 (u)
	integer, intent(in) :: u
	type(var_list_t) :: var_list
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(os_data_t) :: os_data
	class(event_callback_t), allocatable :: event_callback
	class(eio_t), allocatable :: eio

	write (u, "(A)") "* Test output: dispatch_transforms_1"
	write (u, "(A)") "* Purpose: allocate an event I/O (eio) stream"
	write (u, "(A)")

	call var_list%init_defaults (0)
	call os_data_init (os_data)
	call syntax_model_file_init ()
	call model_list%read_model (var_str ("SM_hadrons"), &
	var_str ("SM_hadrons.mdl"), os_data, model)

	write (u, "(A)") "* Allocate as raw"
	write (u, "(A)")

	call dispatch_eio (eio, var_str ("raw"), var_list, &
	model, event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as checkpoints:"
	write (u, "(A)")

	call dispatch_eio (eio, var_str ("checkpoint"), var_list, &
	model, event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as LHEF:"
	write (u, "(A)")

	call var_list%set_string (var_str ("$lhef_extension"), &
	var_str ("lhe_custom"), is_known = .true.)
	call dispatch_eio (eio, var_str ("lhef"), var_list, &
	model, event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as HepMC:"
	write (u, "(A)")

	call dispatch_eio (eio, var_str ("hepmc"), var_list, &
	model, event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as weight_stream"
	write (u, "(A)")

	call dispatch_eio (eio, var_str ("weight_stream"), var_list, &
	model, event_callback)

	call eio%write (u)

	call eio%final ()
	deallocate (eio)

	write (u, "(A)")
	write (u, "(A)") "* Allocate as debug format"
	write (u, "(A)")

	call var_list%set_log (var_str ("?debug_verbose"), &
	.false., is_known = .true.)
	call dispatch_eio (eio, var_str ("debug"), var_list, &
	model, event_callback)

	call eio%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call eio%final ()
	call var_list%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: dispatch_transforms_1"

	end subroutine dispatch_transforms_1

	@ %def dispatch_transforms_1
	@
	\subsubsection{Event transforms}
	This test dispatches [[evt]] (event transform) objects.
	<<Dispatch transforms: execute tests>>=
	call test (dispatch_transforms_2, "dispatch_transforms_2", &
	"event transforms", &
	u, results)
	<<Dispatch transforms: test declarations>>=
	public :: dispatch_transforms_2
	<<Dispatch transforms: tests>>=
	subroutine dispatch_transforms_2 (u)
	integer, intent(in) :: u
	type(var_list_t), target :: var_list
	type(model_list_t) :: model_list
	type(model_t), pointer :: model
	type(os_data_t) :: os_data
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(beam_structure_t) :: beam_structure
	class(evt_t), pointer :: evt

	write (u, "(A)") "* Test output: dispatch_transforms_2"
	write (u, "(A)") "* Purpose: configure event transform"
	write (u, "(A)")

	call syntax_model_file_init ()
	call var_list%init_defaults (0)
	call os_data_init (os_data)
	call model_list%read_model (var_str ("SM_hadrons"), &
	var_str ("SM_hadrons.mdl"), os_data, model)

	write (u, "(A)") "* Resonance insertion"
	write (u, "(A)")

	call var_list%set_log (var_str ("?resonance_history"), .true., &
	is_known = .true.)
	call dispatch_evt_resonance (evt, var_list, &
	res_history_set, &
	var_str ("foo_R"))
	call evt%write (u, verbose = .true., more_verbose = .true.)

	call evt%final ()
	deallocate (evt)

	write (u, "(A)")
	write (u, "(A)") "* ISR handler"
	write (u, "(A)")

	call var_list%set_log (var_str ("?isr_handler"), .true., &
	is_known = .true.)
	call var_list%set_log (var_str ("?epa_handler"), .false., &
	is_known = .true.)
	call var_list%set_string (var_str ("$isr_handler_mode"), &
	var_str ("recoil"), &
	is_known = .true.)
	call var_list%set_real (var_str ("sqrts"), 100._default, &
	is_known = .true.)
	call var_list%set_real (var_str ("isr_mass"), 511.e-6_default, &
	is_known = .true.)
	call dispatch_evt_isr_epa_handler (evt, var_list)
	call evt%write (u, verbose = .true., more_verbose = .true.)

	call evt%final ()
	deallocate (evt)

	write (u, "(A)")
	write (u, "(A)") "* EPA handler"
	write (u, "(A)")

	call var_list%set_log (var_str ("?isr_handler"), .false., &
	is_known = .true.)
	call var_list%set_log (var_str ("?epa_handler"), .true., &
	is_known = .true.)
	call var_list%set_string (var_str ("$epa_handler_mode"), &
	var_str ("recoil"), &
	is_known = .true.)
	call var_list%set_real (var_str ("sqrts"), 100._default, &
	is_known = .true.)
	call var_list%set_real (var_str ("epa_mass"), 511.e-6_default, &
	is_known = .true.)
	call dispatch_evt_isr_epa_handler (evt, var_list)
	call evt%write (u, verbose = .true., more_verbose = .true.)

	call evt%final ()
	deallocate (evt)

	write (u, "(A)")
	write (u, "(A)") "* Partonic decays"
	write (u, "(A)")

	call dispatch_evt_decay (evt, var_list)
	call evt%write (u, verbose = .true., more_verbose = .true.)

	call evt%final ()
	deallocate (evt)

	write (u, "(A)")
	write (u, "(A)") "* Shower"
	write (u, "(A)")

	call var_list%set_log (var_str ("?allow_shower"), .true., &
	is_known = .true.)
	call var_list%set_string (var_str ("$shower_method"), &
	var_str ("WHIZARD"), is_known = .true.)
	call dispatch_evt_shower (evt, var_list, model, &
	model, os_data, beam_structure)
	call evt%write (u)
	call write_separator (u, 2)

	call evt%final ()
	deallocate (evt)

	call var_list%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: dispatch_transforms_2"

	end subroutine dispatch_transforms_2

	@ %def dispatch_transforms_2
	Index: trunk/src/transforms/Makefile.am
	===================================================================
	--- trunk/src/transforms/Makefile.am (revision 8189)
	+++ trunk/src/transforms/Makefile.am (revision 8190)
	@@ -1,240 +1,241 @@
	## Makefile.am -- Makefile for WHIZARD
	##
	## Process this file with automake to produce Makefile.in
	#
	# Copyright (C) 1999-2018 by
	# Wolfgang Kilian <kilian@physik.uni-siegen.de>
	# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
	# Juergen Reuter <juergen.reuter@desy.de>
	# with contributions from
	# cf. main AUTHORS file
	#
	# WHIZARD is free software; you can redistribute it and/or modify it
	# under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 2, or (at your option)
	# any later version.
	#
	# WHIZARD is distributed in the hope that it will be useful, but
	# WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	# GNU General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with this program; if not, write to the Free Software
	# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
	#
	########################################################################

	## The files in this directory implement quantum field theory concepts
	## such as model representation and quantum numbers.

	## We create a library which is still to be combined with auxiliary libs.
	noinst_LTLIBRARIES = libtransforms.la
	check_LTLIBRARIES = libtransforms_ut.la

	libtransforms_la_SOURCES = \
	event_transforms.f90 \
	resonance_insertion.f90 \
	hadrons.f90 \
	recoil_kinematics.f90 \
	isr_epa_handler.f90 \
	decays.f90 \
	tau_decays.f90 \
	shower.f90 \
	evt_nlo.f90 \
	events.f90 \
	eio_raw.f90 \
	dispatch_transforms.f90

	libtransforms_ut_la_SOURCES = \
	event_transforms_uti.f90 event_transforms_ut.f90 \
	resonance_insertion_uti.f90 resonance_insertion_ut.f90 \
	recoil_kinematics_uti.f90 recoil_kinematics_ut.f90 \
	isr_epa_handler_uti.f90 isr_epa_handler_ut.f90 \
	decays_uti.f90 decays_ut.f90 \
	shower_uti.f90 shower_ut.f90 \
	events_uti.f90 events_ut.f90 \
	eio_raw_uti.f90 eio_raw_ut.f90 \
	dispatch_transforms_uti.f90 dispatch_transforms_ut.f90

	## Omitting this would exclude it from the distribution
	dist_noinst_DATA = transforms.nw

	# Dump module names into file Modules
	libtransforms_Modules = \
	${libtransforms_la_SOURCES:.f90=} \
	${libtransforms_ut_la_SOURCES:.f90=}
	Modules: Makefile
	@for module in $(libtransforms_Modules); do \
	echo $$module >> $@.new; \
	done
	@if diff $@ $@.new -q >/dev/null; then \
	rm $@.new; \
	else \
	mv $@.new $@; echo "Modules updated"; \
	fi
	BUILT_SOURCES = Modules

	## Fortran module dependencies
	# Get module lists from other directories
	module_lists = \
	../basics/Modules \
	../utilities/Modules \
	../testing/Modules \
	../system/Modules \
	../physics/Modules \
	../qft/Modules \
	../particles/Modules \
	../types/Modules \
	../matrix_elements/Modules \
	../me_methods/Modules \
	../rng/Modules \
	../mci/Modules \
	../phase_space/Modules \
	../process_integration/Modules \
	../matching/Modules \
	../model_features/Modules \
	../events/Modules \
	../shower/Modules \
	+ ../pythia8/Modules \
	../expr_base/Modules \
	../variables/Modules \
	../beams/Modules \
	../threshold/Modules \
	../fks/Modules

	# Explicit dependencies, not automatically generated
	event_transforms.lo: ../../vamp/src/vamp.$(FC_MODULE_EXT)
	shower.lo: ../lhapdf/lhapdf.$(FC_MODULE_EXT)
	shower.lo: ../pdf_builtin/pdf_builtin.$(FC_MODULE_EXT)

	$(module_lists):
	$(MAKE) -C `dirname $@` Modules

	Module_dependencies.sed: $(libtransforms_la_SOURCES) $(libtransforms_ut_la_SOURCES)
	Module_dependencies.sed: $(module_lists)
	@rm -f $@
	echo 's/, only:.//' >> $@
	echo 's/, *&//' >> $@
	echo 's/, .=>.*//' >> $@
	echo 's/$$/.lo/' >> $@
	for list in $(module_lists); do \
	dir="`dirname $$list`"; \
	for mod in `cat $$list`; do \
	echo 's!: '$$mod'.lo$$!': $$dir/$$mod'.lo!' >> $@; \
	done \
	done

	DISTCLEANFILES = Module_dependencies.sed

	# The following line just says
	# include Makefile.depend
	# but in a portable fashion (depending on automake's AM_MAKE_INCLUDE
	@am__include@ @am__quote@Makefile.depend@am__quote@

	Makefile.depend: Module_dependencies.sed
	Makefile.depend: $(libtransforms_la_SOURCES) $(libtransforms_ut_la_SOURCES)
	@rm -f $@
	for src in $^; do \
	module="`basename $$src \| sed 's/\.f[90][0358]//'`"; \
	grep '^ *use ' $$src \
	\| grep -v '!NODEP!' \
	\| sed -e 's/^ use /'$$module'.lo: /' \
	-f Module_dependencies.sed; \
	done > $@

	DISTCLEANFILES += Makefile.depend

	# Fortran90 module files are generated at the same time as object files
	.lo.$(FC_MODULE_EXT):
	@:
	# touch $@

	-AM_FCFLAGS = -I../basics -I../utilities -I../testing -I../system -I../combinatorics -I../parsing -I../physics -I../qft -I../particles -I../types -I../matrix_elements -I../me_methods -I../rng -I../mci -I../phase_space -I../process_integration -I../matching -I../model_features -I../events -I../tauola -I../shower -I../expr_base -I../variables -I../muli -I../beams -I../blha -I../threshold -I../fks -I../openloops -I../gosam -I../recola -I../fastjet -I../lhapdf -I../pdf_builtin -I../../vamp/src -I../user
	+AM_FCFLAGS = -I../basics -I../utilities -I../testing -I../system -I../combinatorics -I../parsing -I../physics -I../qft -I../particles -I../types -I../matrix_elements -I../me_methods -I../rng -I../mci -I../phase_space -I../process_integration -I../matching -I../model_features -I../events -I../tauola -I../shower -I../expr_base -I../variables -I../muli -I../beams -I../blha -I../threshold -I../fks -I../openloops -I../gosam -I../recola -I../fastjet -I../lhapdf -I../pdf_builtin -I../../vamp/src -I../user -I../pythia8


	########################################################################
	## Default Fortran compiler options

	## Profiling
	if FC_USE_PROFILING
	AM_FCFLAGS += $(FCFLAGS_PROFILING)
	endif

	## OpenMP
	if FC_USE_OPENMP
	AM_FCFLAGS += $(FCFLAGS_OPENMP)
	endif

	## MPI
	if FC_USE_MPI
	AM_FCFLAGS += $(FCFLAGS_MPI)
	endif

	if RECOLA_AVAILABLE
	AM_FCFLAGS += $(RECOLA_INCLUDES)
	endif

	########################################################################
	## Non-standard targets and dependencies

	## Install the modules used by generated matrix element code
	#execmoddir = $(pkglibdir)/mod/transforms
	#nodist_execmod_HEADERS = \#

	## (Re)create F90 sources from NOWEB source.
	if NOWEB_AVAILABLE

	PRELUDE = $(top_srcdir)/src/noweb-frame/whizard-prelude.nw
	POSTLUDE = $(top_srcdir)/src/noweb-frame/whizard-postlude.nw

	transforms.stamp: $(PRELUDE) $(srcdir)/transforms.nw $(POSTLUDE)
	@rm -f transforms.tmp
	@touch transforms.tmp
	for src in \
	$(libtransforms_la_SOURCES) \
	$(libtransforms_ut_la_SOURCES); do \
	$(NOTANGLE) -R[[$$src]] $^ \| $(CPIF) $$src; \
	done
	@mv -f transforms.tmp transforms.stamp

	$(libtransforms_la_SOURCES) $(libtransforms_ut_la_SOURCES): transforms.stamp
	## Recover from the removal of $@
	@if test -f $@; then :; else \
	rm -f transforms.stamp; \
	$(MAKE) $(AM_MAKEFLAGS) transforms.stamp; \
	fi

	endif


	########################################################################
	## Non-standard cleanup tasks
	## Remove sources that can be recreated using NOWEB
	if NOWEB_AVAILABLE
	maintainer-clean-noweb:
	-rm -f .f90 .c
	endif
	.PHONY: maintainer-clean-noweb

	## Remove those sources also if builddir and srcdir are different
	if NOWEB_AVAILABLE
	clean-noweb:
	test "$(srcdir)" != "." && rm -f .f90 .c \|\| true
	endif
	.PHONY: clean-noweb

	## Remove F90 module files
	clean-local: clean-noweb
	-rm -f transforms.stamp transforms.tmp
	-rm -f *.$(FC_MODULE_EXT)
	if FC_SUBMODULES
	-rm -f *.smod
	endif

	## Remove backup files
	maintainer-clean-backup:
	-rm -f *~
	.PHONY: maintainer-clean-backup

	## Register additional clean targets
	maintainer-clean-local: maintainer-clean-noweb maintainer-clean-backup
	Index: trunk/src/whizard-core/Makefile.am
	===================================================================
	--- trunk/src/whizard-core/Makefile.am (revision 8189)
	+++ trunk/src/whizard-core/Makefile.am (revision 8190)
	@@ -1,325 +1,326 @@
	## Makefile.am -- Makefile for WHIZARD
	##
	## Process this file with automake to produce Makefile.in
	#
	# Copyright (C) 1999-2018 by
	# Wolfgang Kilian <kilian@physik.uni-siegen.de>
	# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
	# Juergen Reuter <juergen.reuter@desy.de>
	# with contributions from
	# cf. main AUTHORS file
	#
	# WHIZARD is free software; you can redistribute it and/or modify it
	# under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 2, or (at your option)
	# any later version.
	#
	# WHIZARD is distributed in the hope that it will be useful, but
	# WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	# GNU General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with this program; if not, write to the Free Software
	# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
	#
	########################################################################

	## The files in this directory make up the WHIZARD core

	## We create a library which is still to be combined with auxiliary libs.
	noinst_LTLIBRARIES = libwhizard_core.la
	check_LTLIBRARIES = libwhizard_core_ut.la

	COMMON_F90 = \
	user_files.f90 \
	rt_data.f90 \
	dispatch_me_methods.f90 \
	process_configurations.f90 \
	compilations.f90 \
	event_streams.f90 \
	whizard.f90 \
	cmdline_options.f90 \
	features.f90
	MPI_F90 = \
	integrations.f90_mpi \
	restricted_subprocesses.f90_mpi \
	simulations.f90_mpi \
	commands.f90_mpi
	SERIAL_F90 = \
	integrations.f90_serial \
	restricted_subprocesses.f90_serial \
	simulations.f90_serial \
	commands.f90_serial

	nodist_libwhizard_core_la_SOURCES = \
	$(COMMON_F90) \
	integrations.f90 \
	restricted_subprocesses.f90 \
	simulations.f90 \
	commands.f90

	DISTCLEANFILES = integrations.f90 restricted_subprocesses.f90 \
	simulations.f90 commands.f90

	if FC_USE_MPI
	integrations.f90: integrations.f90_mpi
	-cp -f $< $@
	restricted_subprocesses.f90: restricted_subprocesses.f90_mpi
	-cp -f $< $@
	simulations.f90: simulations.f90_mpi
	-cp -f $< $@
	commands.f90: commands.f90_mpi
	-cp -f $< $@
	else
	integrations.f90: integrations.f90_serial
	-cp -f $< $@
	restricted_subprocesses.f90: restricted_subprocesses.f90_serial
	-cp -f $< $@
	simulations.f90: simulations.f90_serial
	-cp -f $< $@
	commands.f90: commands.f90_serial
	-cp -f $< $@
	endif

	libwhizard_core_ut_la_SOURCES = \
	expr_tests_uti.f90 expr_tests_ut.f90 \
	rt_data_uti.f90 rt_data_ut.f90 \
	dispatch_uti.f90 dispatch_ut.f90 \
	process_configurations_uti.f90 process_configurations_ut.f90 \
	compilations_uti.f90 compilations_ut.f90 \
	integrations_uti.f90 integrations_ut.f90 \
	event_streams_uti.f90 event_streams_ut.f90 \
	restricted_subprocesses_uti.f90 restricted_subprocesses_ut.f90 \
	simulations_uti.f90 simulations_ut.f90 \
	commands_uti.f90 commands_ut.f90

	# Adds the whizard-c-interface
	EXTRA_libwhizard_core_la_SOURCES = whizard-c-interface.f90
	libwhizard_core_la_LIBADD = whizard-c-interface.lo

	## The main program makes up a library on its own.
	lib_LTLIBRARIES = libwhizard_main.la
	check_LTLIBRARIES += libwhizard_main_ut.la

	MPI_F90 += main.f90_mpi
	SERIAL_F90 += main.f90_serial

	nodist_libwhizard_main_la_SOURCES = \
	main.f90

	DISTCLEANFILES += main.f90

	if FC_USE_MPI
	main.f90: main.f90_mpi
	-cp -f $< $@
	else
	main.f90: main.f90_serial
	-cp -f $< $@
	endif

	MPI_F90 += main_ut.f90_mpi
	SERIAL_F90 += main_ut.f90_serial

	nodist_libwhizard_main_ut_la_SOURCES = \
	main_ut.f90

	DISTCLEANFILES += main_ut.f90

	if FC_USE_MPI
	main_ut.f90: main_ut.f90_mpi
	-cp -f $< $@
	else
	main_ut.f90: main_ut.f90_serial
	-cp -f $< $@
	endif

	EXTRA_DIST = \
	$(COMMON_F90) \
	$(SERIAL_F90) \
	$(MPI_F90)

	## Omitting this would exclude it from the distribution
	dist_noinst_DATA = whizard.nw

	## Fortran module dependencies
	# Get module lists from other directories
	module_lists = \
	../basics/Modules \
	../utilities/Modules \
	../testing/Modules \
	../system/Modules \
	../combinatorics/Modules \
	../parsing/Modules \
	../rng/Modules \
	../physics/Modules \
	../qft/Modules \
	../expr_base/Modules \
	../types/Modules \
	../matrix_elements/Modules \
	../particles/Modules \
	../beams/Modules \
	../me_methods/Modules \
	+ ../pythia8/Modules \
	../events/Modules \
	../phase_space/Modules \
	../mci/Modules \
	../vegas/Modules \
	../user/Modules \
	../blha/Modules \
	../gosam/Modules \
	../openloops/Modules \
	../recola/Modules \
	../fks/Modules \
	../variables/Modules \
	../model_features/Modules \
	../muli/Modules \
	../shower/Modules \
	../matching/Modules \
	../process_integration/Modules \
	../transforms/Modules \
	../threshold/Modules

	$(module_lists):
	$(MAKE) -C `dirname $@` Modules

	Module_dependencies.sed: $(nodist_libwhizard_core_la_SOURCES) \
	$(libwhizard_core_ut_la_SOURCES) \
	$(nodist_libwhizard_main_la_SOURCES) \
	$(nodist_libwhizard_main_ut_la_SOURCES) \
	$(EXTRA_libwhizard_core_la_SOURCES)
	Module_dependencies.sed: $(module_lists)
	@rm -f $@
	echo 's/, only:.//' >> $@
	echo 's/, *&//' >> $@
	echo 's/, .=>.*//' >> $@
	echo 's/$$/.lo/' >> $@
	for list in $(module_lists); do \
	dir="`dirname $$list`"; \
	for mod in `cat $$list`; do \
	echo 's!: '$$mod'.lo$$!': $$dir/$$mod'.lo!' >> $@; \
	done \
	done

	DISTCLEANFILES += Module_dependencies.sed

	# The following line just says
	# include Makefile.depend
	# but in a portable fashion (depending on automake's AM_MAKE_INCLUDE
	@am__include@ @am__quote@Makefile.depend@am__quote@

	Makefile.depend: Module_dependencies.sed
	Makefile.depend: $(nodist_libwhizard_core_la_SOURCES) \
	$(libwhizard_core_ut_la_SOURCES) \
	$(nodist_libwhizard_main_la_SOURCES) \
	$(nodist_libwhizard_main_ut_la_SOURCES) \
	$(EXTRA_libwhizard_core_la_SOURCES)
	@rm -f $@
	for src in $^; do \
	module="`basename $$src \| sed 's/\.f[90][0358]//'`"; \
	grep '^ *use ' $$src \
	\| grep -v '!NODEP!' \
	\| sed -e 's/^ use /'$$module'.lo: /' \
	-f Module_dependencies.sed; \
	done > $@

	DISTCLEANFILES += Makefile.depend

	SUFFIXES = .lo .$(FC_MODULE_EXT)
	# Fortran90 module files are generated at the same time as object files
	.lo.$(FC_MODULE_EXT):
	@:
	# touch $@

	-AM_FCFLAGS = -I../basics -I../utilities -I../testing -I../system -I../combinatorics -I../parsing -I../rng -I../physics -I../qed_pdf -I../qft -I../expr_base -I../types -I../matrix_elements -I../particles -I../beams -I../me_methods -I../events -I../phase_space -I../mci -I../vegas -I../user -I../blha -I../gosam -I../openloops -I../fks -I../variables -I../model_features -I../muli -I../shower -I../matching -I../process_integration -I../transforms -I../xdr -I../../vamp/src -I../pdf_builtin -I../../circe1/src -I../../circe2/src -I../lhapdf -I../fastjet -I../threshold -I../tauola -I../recola
	+AM_FCFLAGS = -I../basics -I../utilities -I../testing -I../system -I../combinatorics -I../parsing -I../rng -I../physics -I../qed_pdf -I../qft -I../expr_base -I../types -I../matrix_elements -I../particles -I../beams -I../me_methods -I../events -I../phase_space -I../mci -I../vegas -I../user -I../blha -I../gosam -I../openloops -I../fks -I../variables -I../model_features -I../muli -I../pythia8 -I../shower -I../matching -I../process_integration -I../transforms -I../xdr -I../../vamp/src -I../pdf_builtin -I../../circe1/src -I../../circe2/src -I../lhapdf -I../fastjet -I../threshold -I../tauola -I../recola
	########################################################################
	## Default Fortran compiler options

	## Profiling
	if FC_USE_PROFILING
	AM_FCFLAGS += $(FCFLAGS_PROFILING)
	endif

	## OpenMP
	if FC_USE_OPENMP
	AM_FCFLAGS += $(FCFLAGS_OPENMP)
	endif

	## MPI
	if FC_USE_MPI
	AM_FCFLAGS += $(FCFLAGS_MPI)
	endif

	if RECOLA_AVAILABLE
	AM_FCFLAGS += $(RECOLA_INCLUDES)
	endif

	########################################################################
	## Non-standard targets and dependencies

	## (Re)create F90 sources from NOWEB source.
	if NOWEB_AVAILABLE

	FILTER = -filter "sed 's/defn MPI:/defn/'"

	COMMON_SRC = \
	$(COMMON_F90) \
	$(libwhizard_core_ut_la_SOURCES) \
	$(EXTRA_libwhizard_core_la_SOURCES)

	PRELUDE = $(top_srcdir)/src/noweb-frame/whizard-prelude.nw
	POSTLUDE = $(top_srcdir)/src/noweb-frame/whizard-postlude.nw

	whizard.stamp: $(PRELUDE) $(srcdir)/whizard.nw $(POSTLUDE)
	@rm -f whizard.tmp
	@touch whizard.tmp
	for src in $(COMMON_SRC); do \
	$(NOTANGLE) -R[[$$src]] $^ \| $(CPIF) $$src; \
	done
	for src in $(MPI_F90:.f90_mpi=.f90); do \
	$(NOTANGLE) -R[[$$src]] $(FILTER) $^ \| $(CPIF) $$src'_mpi'; \
	done
	for src in $(SERIAL_F90:.f90_serial=.f90); do \
	$(NOTANGLE) -R[[$$src]] $^ \| $(CPIF) $$src'_serial'; \
	done
	@mv -f whizard.tmp whizard.stamp

	$(MPI_F90) $(SERIAL_F90) $(COMMON_SRC): whizard.stamp
	## Recover from the removal of $@
	@if test -f $@; then :; else \
	rm -f whizard.stamp; \
	$(MAKE) $(AM_MAKEFLAGS) whizard.stamp; \
	fi

	endif

	########################################################################
	## Non-standard cleanup tasks
	## Remove sources that can be recreated using NOWEB
	if NOWEB_AVAILABLE
	maintainer-clean-noweb:
	-rm -f .f90 .f90_mpi .f90_serial .c
	endif
	.PHONY: maintainer-clean-noweb

	## Remove those sources also if builddir and srcdir are different
	if NOWEB_AVAILABLE
	clean-noweb:
	test "$(srcdir)" != "." && rm -f .f90 .f90_mpi .f90_serial .c \|\| true
	endif
	.PHONY: clean-noweb

	## Remove F90 module files
	clean-local: clean-noweb
	-rm -f whizard.stamp whizard.tmp
	-rm -f *.$(FC_MODULE_EXT)
	if FC_SUBMODULES
	-rm -f *.smod
	endif

	## Remove backup files
	maintainer-clean-backup:
	-rm -f *~
	.PHONY: maintainer-clean-backup

	## Register additional clean targets
	maintainer-clean-local: maintainer-clean-noweb maintainer-clean-backup
	Index: trunk/src/whizard-core/whizard.nw
	===================================================================
	--- trunk/src/whizard-core/whizard.nw (revision 8189)
	+++ trunk/src/whizard-core/whizard.nw (revision 8190)
	@@ -1,31415 +1,31433 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD main code as NOWEB source
	\includemodulegraph{whizard-core}
	\chapter{Integration and Simulation}
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{User-controlled File I/O}

	The SINDARIN language includes commands that write output to file (input may
	be added later). We identify files by their name, and manage the unit
	internally. We need procedures for opening, closing, and printing files.

	<<[[user_files.f90]]>>=
	<<File header>>

	module user_files

	<<Use strings>>
	use 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_final
	@ Check if a file is open with correct status.
	<<User files: procedures>>=
	function file_is_open (file, action) result (flag)
	logical :: flag
	type(file_t), intent(in) :: file
	character(*), intent(in) :: action
	select case (action)
	case ("read")
	flag = file%reading
	case ("write")
	flag = file%writing
	case ("readwrite")
	flag = file%reading .and. file%writing
	case default
	call msg_bug ("Checking file '" // char (file%name) &
	// "': illegal action specifier")
	end select
	end function file_is_open

	@ %def file_is_open
	@ Return the unit number of a file for direct access. It should be checked
	first whether the file is open.
	<<User files: procedures>>=
	function file_get_unit (file) result (unit)
	integer :: unit
	type(file_t), intent(in) :: file
	unit = file%unit
	end function file_get_unit

	@ %def file_get_unit
	@ Write to the file. Error if in wrong mode. If there is no string, just
	write an empty record. If there is a string, respect the [[advancing]]
	option.
	<<User files: procedures>>=
	subroutine file_write_string (file, string, advancing)
	type(file_t), intent(in) :: file
	type(string_t), intent(in), optional :: string
	logical, intent(in), optional :: advancing
	if (file%writing) then
	if (present (string)) then
	if (present (advancing)) then
	if (advancing) then
	write (file%unit, "(A)") char (string)
	else
	write (file%unit, "(A)", advance="no") char (string)
	end if
	else
	write (file%unit, "(A)") char (string)
	end if
	else
	write (file%unit, *)
	end if
	else
	call msg_error ("Writing to file: File '" // char (file%name) &
	// "' is not open for writing.")
	end if
	end subroutine file_write_string

	@ %def file_write
	@ Write a whole ifile, line by line.
	<<User files: procedures>>=
	subroutine file_write_ifile (file, ifile)
	type(file_t), intent(in) :: file
	type(ifile_t), intent(in) :: ifile
	type(line_p) :: line
	call line_init (line, ifile)
	do while (line_is_associated (line))
	call file_write_string (file, line_get_string_advance (line))
	end do
	end subroutine file_write_ifile

	@ %def file_write_ifile
	@ Write an analysis object (or all objects) to an open file.
	<<User files: procedures>>=
	subroutine file_write_analysis (file, tag)
	type(file_t), intent(in) :: file
	type(string_t), intent(in), optional :: tag
	if (file%writing) then
	if (present (tag)) then
	call analysis_write (tag, unit = file%unit)
	else
	call analysis_write (unit = file%unit)
	end if
	else
	call msg_error ("Writing analysis to file: File '" // char (file%name) &
	// "' is not open for writing.")
	end if
	end subroutine file_write_analysis

	@ %def file_write_analysis
	@
	\subsection{The file list}
	We maintain a list of all open files and their attributes. The list must be
	doubly-linked because we may delete entries.
	<<User files: public>>=
	public :: file_list_t
	<<User files: types>>=
	type :: file_list_t
	type(file_t), pointer :: first => null ()
	type(file_t), pointer :: last => null ()
	end type file_list_t

	@ %def file_list_t
	@ There is no initialization routine, but a finalizer which deletes all:
	<<User files: public>>=
	public :: file_list_final
	<<User files: 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
	@ Return the unit number for a file. It should be checked first whether the
	file is open.
	<<User files: public>>=
	public :: file_list_get_unit
	<<User files: procedures>>=
	function file_list_get_unit (file_list, name) result (unit)
	integer :: unit
	type(file_list_t), intent(in) :: file_list
	type(string_t), intent(in) :: name
	type(file_t), pointer :: current
	current => file_list_get_file_ptr (file_list, name)
	if (associated (current)) then
	unit = file_get_unit (current)
	else
	unit = -1
	end if
	end function file_list_get_unit

	@ %def file_list_get_unit
	@ Append a new file entry, i.e., open this file. Error if it is
	already open.
	<<User files: public>>=
	public :: file_list_open
	<<User files: 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 models
	use subevents
	use pdg_arrays
	use variables, only: var_list_t
	use process_libraries
	use prclib_stacks
	use prc_core, only: helicity_selection_t
	use beam_structures
	use event_base, only: event_callback_t
	use user_files
	use process_stacks
	use iterations

	<<Standard module head>>

	<<RT data: public>>

	<<RT data: types>>

	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(string_t), dimension(:), allocatable :: export
	type(var_list_t) :: var_list
	type(iterations_list_t) :: it_list
	type(os_data_t) :: os_data
	type(model_list_t) :: model_list
	type(model_t), pointer :: model => null ()
	logical :: model_is_copy = .false.
	type(model_t), pointer :: preload_model => null ()
	type(model_t), pointer :: fallback_model => null ()
	type(prclib_stack_t) :: prclib_stack
	type(process_library_t), pointer :: prclib => null ()
	type(beam_structure_t) :: beam_structure
	type(rt_parse_nodes_t) :: pn
	type(process_stack_t) :: process_stack
	type(string_t), dimension(:), allocatable :: sample_fmt
	class(event_callback_t), allocatable :: event_callback
	type(file_list_t), pointer :: out_files => null ()
	logical :: quit = .false.
	integer :: quit_code = 0
	type(string_t) :: logfile
	logical :: nlo_fixed_order = .false.
	logical, dimension(0:5) :: selected_nlo_parts = .false.
	integer, dimension(:), allocatable :: nlo_component
	contains
	<<RT data: rt data: TBP>>
	end type rt_data_t

	@ %def rt_data_t
	@
	\subsection{Output}
	<<RT data: rt data: TBP>>=
	procedure :: write => rt_data_write
	<<RT data: 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 (object%get_n_export () > 0) then
	call write_separator (u, 2)
	write (u, "(1x,A)") "Exported objects and variables:"
	call write_separator (u)
	call object%write_exports (u)
	end if
	if (present (vars)) then
	if (size (vars) /= 0) then
	call write_separator (u, 2)
	write (u, "(1x,A)") "Selected variables:"
	call write_separator (u)
	call object%write_vars (u, vars)
	end if
	else
	call write_separator (u, 2)
	if (associated (object%model)) then
	call object%model%write_var_list (u, follow_link=.true.)
	else
	call object%var_list%write (u, follow_link=.true.)
	end if
	end if
	if (object%it_list%get_n_pass () > 0) then
	call write_separator (u, 2)
	write (u, "(1x)", advance="no")
	call object%it_list%write (u)
	end if
	if (associated (object%model)) then
	call write_separator (u, 2)
	call object%model%write (u)
	end if
	call object%prclib_stack%write (u)
	call object%beam_structure%write (u)
	call write_separator (u, 2)
	call object%pn%write (u)
	if (allocated (object%sample_fmt)) then
	call write_separator (u)
	write (u, "(1x,A)", advance="no") "Event sample formats = "
	do i = 1, size (object%sample_fmt)
	if (i > 1) write (u, "(A,1x)", advance="no") ","
	write (u, "(A)", advance="no") char (object%sample_fmt(i))
	end do
	write (u, "(A)")
	end if
	call write_separator (u)
	write (u, "(1x,A)", advance="no") "Event callback:"
	if (allocated (object%event_callback)) then
	call object%event_callback%write (u)
	else
	write (u, "(1x,A)") "[undefined]"
	end if
	call object%process_stack%write (u, pacify)
	write (u, "(1x,A,1x,L1)") "quit :", object%quit
	write (u, "(1x,A,1x,I0)") "quit_code:", object%quit_code
	call write_separator (u, 2)
	write (u, "(1x,A,1x,A)") "Logfile :", "'" // trim (char (object%logfile)) // "'"
	call write_separator (u, 2)
	end subroutine rt_data_write

	@ %def rt_data_write
	@ Write only selected variables.
	<<RT data: rt data: TBP>>=
	procedure :: write_vars => rt_data_write_vars
	<<RT data: 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) :: vars
	type(var_list_t), pointer :: var_list
	integer :: u, i
	u = given_output_unit (unit)
	var_list => object%get_var_list_ptr ()
	do i = 1, size (vars)
	associate (var => vars(i))
	if (var_list%contains (var, follow_link=.true.)) then
	call var_list%write_var (var, unit = u, &
	follow_link = .true., defined=.true.)
	end if
	end associate
	end do
	end subroutine rt_data_write_vars

	@ %def rt_data_write_vars
	@ Write only the model list.
	<<RT data: rt data: TBP>>=
	procedure :: write_model_list => rt_data_write_model_list
	<<RT data: 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
	@
	<<RT data: rt data: TBP>>=
	procedure :: write_var_descriptions => rt_data_write_var_descriptions
	<<RT data: procedures>>=
	subroutine rt_data_write_var_descriptions (rt_data, unit, ascii_output)
	class(rt_data_t), intent(in) :: rt_data
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: ascii_output
	integer :: u
	logical :: ao
	u = given_output_unit (unit)
	ao = .false.; if (present (ascii_output)) ao = ascii_output
	call rt_data%var_list%write (u, follow_link=.true., &
	descriptions=.true., ascii_output=ao)
	end subroutine rt_data_write_var_descriptions

	@ %def rt_data_write_var_descriptions
	@
	<<RT data: rt data: TBP>>=
	procedure :: show_description_of_string => rt_data_show_description_of_string
	<<RT data: procedures>>=
	subroutine rt_data_show_description_of_string (rt_data, string, &
	unit, ascii_output)
	class(rt_data_t), intent(in) :: rt_data
	type(string_t), intent(in) :: string
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: ascii_output
	integer :: u
	logical :: ao
	u = given_output_unit (unit)
	ao = .false.; if (present (ascii_output)) ao = ascii_output
	call rt_data%var_list%write_var (string, unit=u, follow_link=.true., &
	defined=.false., descriptions=.true., ascii_output=ao)
	end subroutine rt_data_show_description_of_string

	@ %def rt_data_show_description_of_string
	@
	\subsection{Clear}
	The [[clear]] command can remove the contents of various subobjects.
	The objects themselves should stay.
	<<RT data: rt data: TBP>>=
	procedure :: clear_beams => rt_data_clear_beams
	<<RT data: 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
	integer :: seed
	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 global%var_list%init_defaults (seed, paths)
	call global%init_pointer_variables ()
	call global%process_stack%init_var_list (global%var_list)
	end subroutine rt_data_global_init

	@ %def rt_data_global_init
	@
	\subsection{Local copies}
	This is done at compile time when a local copy of runtime data is
	needed: Link the variable list and initialize all derived parameters.
	This allows for synchronizing them with local variable changes without
	affecting global data.

	Also re-initialize pointer variables, so they point to local copies of
	their targets.
	<<RT data: rt data: TBP>>=
	procedure :: local_init => rt_data_local_init
	<<RT data: 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 local%var_list%append_string (var_str ("$model_name"), &
	var_str (""), intrinsic=.true.)
	call local%init_pointer_variables ()
	local%fallback_model => global%fallback_model
	local%os_data = global%os_data
	local%logfile = global%logfile
	call local%model_list%link (global%model_list)
	local%model => global%model
	if (associated (local%model)) then
	call local%model%link_var_list (local%var_list)
	end if
	if (allocated (global%event_callback)) then
	allocate (local%event_callback, source = global%event_callback)
	end if
	end subroutine rt_data_local_init

	@ %def rt_data_local_init
	@ These variables point to objects which get local copies:
	<<RT data: rt data: TBP>>=
	procedure :: init_pointer_variables => rt_data_init_pointer_variables
	<<RT data: procedures>>=
	subroutine rt_data_init_pointer_variables (local)
	class(rt_data_t), intent(inout), target :: local
	logical, target, save :: known = .true.
	call local%var_list%append_string_ptr (var_str ("$fc"), &
	local%os_data%fc, known, intrinsic=.true., &
	description=var_str('This string variable gives the ' // &
	'\ttt{Fortran} compiler used within \whizard. It can ' // &
	'only be accessed, not set by the user. (cf. also ' // &
	'\ttt{\$fcflags})'))
	call local%var_list%append_string_ptr (var_str ("$fcflags"), &
	local%os_data%fcflags, known, intrinsic=.true., &
	description=var_str('This string variable gives the ' // &
	'compiler flags for the \ttt{Fortran} compiler used ' // &
	'within \whizard. It can only be accessed, not set by ' // &
	'the user. (cf. also \ttt{\$fc})'))
	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. May also modify (remove) the local objects.
	<<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(inout) :: local
	global%prclib_stack = local%prclib_stack
	call local%handle_exports (global)
	end subroutine rt_data_restore_globals

	@ %def rt_data_restore_globals
	@
	\subsection{Exported objects}
	Exported objects are transferred to the global state when a local environment
	is closed. (For the top-level global data set, there is no effect.)

	The current implementation handles only the [[results]] object, which resolves
	to the local process stack. The stack elements are appended to the global
	stack without modification, the local stack becomes empty.

	Write names of objects to be exported:
	<<RT data: rt data: TBP>>=
	procedure :: write_exports => rt_data_write_exports
	<<RT data: procedures>>=
	subroutine rt_data_write_exports (rt_data, unit)
	class(rt_data_t), intent(in) :: rt_data
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	do i = 1, rt_data%get_n_export ()
	write (u, "(A)") char (rt_data%export(i))
	end do
	end subroutine rt_data_write_exports

	@ %def rt_data_write_exports
	@ The number of entries in the export list.
	<<RT data: rt data: TBP>>=
	procedure :: get_n_export => rt_data_get_n_export
	<<RT data: procedures>>=
	function rt_data_get_n_export (rt_data) result (n)
	class(rt_data_t), intent(in) :: rt_data
	integer :: n
	if (allocated (rt_data%export)) then
	n = size (rt_data%export)
	else
	n = 0
	end if
	end function rt_data_get_n_export

	@ %def rt_data_get_n_export
	@ Return a specific export
	@ Append new names to the export list. If a duplicate occurs, do not transfer
	it.
	<<RT data: rt data: TBP>>=
	procedure :: append_exports => rt_data_append_exports
	<<RT data: procedures>>=
	subroutine rt_data_append_exports (rt_data, export)
	class(rt_data_t), intent(inout) :: rt_data
	type(string_t), dimension(:), intent(in) :: export
	logical, dimension(:), allocatable :: mask
	type(string_t), dimension(:), allocatable :: tmp
	integer :: i, j, n
	if (.not. allocated (rt_data%export)) allocate (rt_data%export (0))
	n = size (rt_data%export)
	allocate (mask (size (export)), source=.false.)
	do i = 1, size (export)
	mask(i) = all (export(i) /= rt_data%export) &
	.and. all (export(i) /= export(:i-1))
	end do
	if (count (mask) > 0) then
	allocate (tmp (n + count (mask)))
	tmp(1:n) = rt_data%export(:)
	j = n
	do i = 1, size (export)
	if (mask(i)) then
	j = j + 1
	tmp(j) = export(i)
	end if
	end do
	call move_alloc (from=tmp, to=rt_data%export)
	end if
	end subroutine rt_data_append_exports

	@ %def rt_data_append_exports
	@ Transfer export-objects from the [[local]] rt data to the [[global]] rt
	data, as far as supported.
	<<RT data: rt data: TBP>>=
	procedure :: handle_exports => rt_data_handle_exports
	<<RT data: procedures>>=
	subroutine rt_data_handle_exports (local, global)
	class(rt_data_t), intent(inout), target :: local
	class(rt_data_t), intent(inout), target :: global
	type(string_t) :: export
	integer :: i
	if (local%get_n_export () > 0) then
	do i = 1, local%get_n_export ()
	export = local%export(i)
	select case (char (export))
	case ("results")
	call msg_message ("Exporting integration results &
	&to outer environment")
	call local%transfer_process_stack (global)
	case default
	call msg_bug ("handle exports: '" &
	// char (export) // "' unsupported")
	end select
	end do
	end if
	end subroutine rt_data_handle_exports

	@ %def rt_data_handle_exports
	@ Export the process stack. One-by-one, take the last process from the local
	stack and push it on the global stack. Also handle the corresponding result
	variables: append if the process did not exist yet in the global stack,
	otherwise update.

	TODO: result variables don't work that way yet, require initialization in the
	global variable list.
	<<RT data: rt data: TBP>>=
	procedure :: transfer_process_stack => rt_data_transfer_process_stack
	<<RT data: procedures>>=
	subroutine rt_data_transfer_process_stack (local, global)
	class(rt_data_t), intent(inout), target :: local
	class(rt_data_t), intent(inout), target :: global
	type(process_entry_t), pointer :: process
	type(string_t) :: process_id
	do
	call local%process_stack%pop_last (process)
	if (.not. associated (process)) exit
	process_id = process%get_id ()
	call global%process_stack%push (process)
	call global%process_stack%fill_result_vars (process_id)
	call global%process_stack%update_result_vars &
	(process_id, global%var_list)
	end do
	end subroutine rt_data_transfer_process_stack

	@ %def rt_data_transfer_process_stack
	@
	\subsection{Finalization}
	Finalizer for the variable list and the structure-function list.
	This is done only for the global RT dataset; local copies contain
	pointers to this and do not need a finalizer.
	<<RT data: rt data: TBP>>=
	procedure :: final => rt_data_global_final
	<<RT data: 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
	@ Read a UFO model. Create it on the fly if necessary.
	<<RT data: rt data: TBP>>=
	procedure :: read_ufo_model => rt_data_read_ufo_model
	<<RT data: procedures>>=
	subroutine rt_data_read_ufo_model (global, name, model, ufo_path)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(model_t), pointer, intent(out) :: model
	type(string_t), intent(in), optional :: ufo_path
	type(string_t) :: filename
	filename = name // ".ufo.mdl"
	call global%model_list%read_model &
	(name, filename, global%os_data, model, ufo=.true., ufo_path=ufo_path)
	end subroutine rt_data_read_ufo_model

	@ %def rt_data_read_ufo_model
	@ Initialize the fallback model. This model is used
	whenever the current model does not describe all physical particles
	(hadrons, mainly). It is not supposed to be modified, and the pointer
	should remain linked to this model.
	<<RT data: rt data: TBP>>=
	procedure :: init_fallback_model => rt_data_init_fallback_model
	<<RT data: 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
	@
	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, ufo, ufo_path)
	class(rt_data_t), intent(inout), target :: global
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	logical, intent(in), optional :: ufo
	type(string_t), intent(in), optional :: ufo_path
	logical :: same_model, ufo_model
	ufo_model = .false.; if (present (ufo)) ufo_model = ufo
	if (associated (global%model)) then
	same_model = global%model%matches (name, scheme, ufo)
	else
	same_model = .false.
	end if
	if (.not. same_model) then
	global%model => global%model_list%get_model_ptr (name, scheme, ufo)
	if (.not. associated (global%model)) then
	if (ufo_model) then
	call global%read_ufo_model (name, global%model, ufo_path)
	else
	call global%read_model (name, global%model)
	end if
	global%model_is_copy = .false.
	else if (associated (global%context)) then
	global%model_is_copy = &
	global%model_list%model_exists (name, scheme, ufo, &
	follow_link=.false.)
	else
	global%model_is_copy = .false.
	end if
	end if
	if (associated (global%model)) then
	call global%model%link_var_list (global%var_list)
	call global%var_list%set_string (var_str ("$model_name"), &
	name, is_known = .true.)
	if (global%model%is_ufo_model ()) then
	call msg_message ("Switching to model '" // char (name) // "' " &
	// "(generated from UFO source)")
	else if (global%model%has_schemes ()) then
	call msg_message ("Switching to model '" // char (name) // "', " &
	// "scheme '" // char (global%model%get_scheme ()) // "'")
	else
	call msg_message ("Switching to model '" // char (name) // "'")
	end if
	else
	call global%var_list%set_string (var_str ("$model_name"), &
	var_str (""), is_known = .false.)
	end if
	end subroutine rt_data_select_model

	@ %def rt_data_select_model
	@
	Remove the model link 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 local%var_list%append_log (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 local%var_list%append_int (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 local%var_list%append_real (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 local%var_list%append_cmplx (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 local%var_list%append_subevt (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 local%var_list%append_pdg_array (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 local%var_list%append_string (name, sval, &
	intrinsic = intrinsic, user = user)
	end subroutine rt_data_append_string

	@ %def rt_data_append_log
	@ %def rt_data_append_int
	@ %def rt_data_append_real
	@ %def rt_data_append_cmplx
	@ %def rt_data_append_subevt
	@ %def rt_data_append_pdg_array
	@ %def rt_data_append_string
	@ Import values for all local variables, given a global context environment
	where these variables are defined.
	<<RT data: rt data: TBP>>=
	procedure :: import_values => rt_data_import_values
	<<RT data: 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 local%var_list%import (global%var_list)
	end if
	end subroutine rt_data_import_values

	@ %def rt_data_import_values
	@ Unset all variable values.
	<<RT data: rt data: TBP>>=
	procedure :: unset_values => rt_data_unset_values
	<<RT data: procedures>>=
	subroutine rt_data_unset_values (global)
	class(rt_data_t), intent(inout) :: global
	call global%var_list%undefine (follow_link=.false.)
	end subroutine rt_data_unset_values

	@ %def rt_data_unset_values
	@ Set a variable. (Not a model variable, these are handled separately.) We
	can assume that the variable has been initialized.
	<<RT data: rt data: TBP>>=
	procedure :: set_log => rt_data_set_log
	procedure :: set_int => rt_data_set_int
	procedure :: set_real => rt_data_set_real
	procedure :: set_cmplx => rt_data_set_cmplx
	procedure :: set_subevt => rt_data_set_subevt
	procedure :: set_pdg_array => rt_data_set_pdg_array
	procedure :: set_string => rt_data_set_string
	<<RT data: procedures>>=
	subroutine rt_data_set_log &
	(global, name, lval, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	logical, intent(in) :: lval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	call global%var_list%set_log (name, lval, is_known, &
	force=force, verbose=verbose)
	end subroutine rt_data_set_log

	subroutine rt_data_set_int &
	(global, name, ival, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	integer, intent(in) :: ival
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	call global%var_list%set_int (name, ival, is_known, &
	force=force, verbose=verbose)
	end subroutine rt_data_set_int

	subroutine rt_data_set_real &
	(global, name, rval, is_known, force, verbose, pacified)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	real(default), intent(in) :: rval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose, pacified
	call global%var_list%set_real (name, rval, is_known, &
	force=force, verbose=verbose, pacified=pacified)
	end subroutine rt_data_set_real

	subroutine rt_data_set_cmplx &
	(global, name, cval, is_known, force, verbose, pacified)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	complex(default), intent(in) :: cval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose, pacified
	call global%var_list%set_cmplx (name, cval, is_known, &
	force=force, verbose=verbose, pacified=pacified)
	end subroutine rt_data_set_cmplx

	subroutine rt_data_set_subevt &
	(global, name, pval, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(subevt_t), intent(in) :: pval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	call global%var_list%set_subevt (name, pval, is_known, &
	force=force, verbose=verbose)
	end subroutine rt_data_set_subevt

	subroutine rt_data_set_pdg_array &
	(global, name, aval, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(pdg_array_t), intent(in) :: aval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	call global%var_list%set_pdg_array (name, aval, is_known, &
	force=force, verbose=verbose)
	end subroutine rt_data_set_pdg_array

	subroutine rt_data_set_string &
	(global, name, sval, is_known, force, verbose)
	class(rt_data_t), intent(inout) :: global
	type(string_t), intent(in) :: name
	type(string_t), intent(in) :: sval
	logical, intent(in) :: is_known
	logical, intent(in), optional :: force, verbose
	call global%var_list%set_string (name, sval, is_known, &
	force=force, verbose=verbose)
	end subroutine rt_data_set_string

	@ %def rt_data_set_log
	@ %def rt_data_set_int
	@ %def rt_data_set_real
	@ %def rt_data_set_cmplx
	@ %def rt_data_set_subevt
	@ %def rt_data_set_pdg_array
	@ %def rt_data_set_string
	@ Return the value of a variable, assuming that the type is correct.
	<<RT data: rt data: TBP>>=
	procedure :: get_lval => rt_data_get_lval
	procedure :: get_ival => rt_data_get_ival
	procedure :: get_rval => rt_data_get_rval
	procedure :: get_cval => rt_data_get_cval
	procedure :: get_pval => rt_data_get_pval
	procedure :: get_aval => rt_data_get_aval
	procedure :: get_sval => rt_data_get_sval
	<<RT data: 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 global%var_list%append_string ( &
	var_str ("$library_name"), global%prclib%get_name (), &
	intrinsic = .true.)
	end if
	end subroutine rt_data_update_prclib

	@ %def rt_data_update_prclib
	@
	\subsection{Miscellaneous}
	The helicity selection data are distributed among several parameters. Here,
	we collect them in a single record.
	<<RT data: rt data: TBP>>=
	procedure :: get_helicity_selection => rt_data_get_helicity_selection
	<<RT data: 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
	@ Force system-dependent objects to well-defined values. Some of the
	variables are locked and therefore must be addressed directly.

	This is, of course, only required for testing purposes. In principle,
	the [[real_specimen]] variables could be set to their values in
	[[rt_data_t]], but this depends on the precision again, so we set
	them to some dummy values.
	<<RT data: public>>=
	public :: fix_system_dependencies
	<<RT data: procedures>>=
	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
	@
	<<RT data: public>>=
	public :: show_description_of_string
	<<RT data: procedures>>=
	subroutine show_description_of_string (string)
	type(string_t), intent(in) :: string
	type(rt_data_t), target :: global
	call global%global_init ()
	call global%show_description_of_string (string, ascii_output=.true.)
	end subroutine show_description_of_string

	@ %def show_description_of_string
	@
	<<RT data: public>>=
	public :: show_tex_descriptions
	<<RT data: procedures>>=
	subroutine show_tex_descriptions ()
	type(rt_data_t), target :: global
	call global%global_init ()
	call fix_system_dependencies (global)
	call global%set_int (var_str ("seed"), 0, is_known=.true.)
	call global%var_list%sort ()
	call global%write_var_descriptions ()
	end subroutine show_tex_descriptions

	@ %def show_tex_descriptions
	@
	\subsection{Unit Tests}
	Test module, followed by the corresponding implementation module.
	<<[[rt_data_ut.f90]]>>=
	<<File header>>

	module rt_data_ut
	use unit_tests
	use rt_data_uti

	<<Standard module head>>

	<<RT data: public test>>

	contains

	<<RT data: test driver>>

	end module rt_data_ut
	@ %def rt_data_ut
	@
	<<[[rt_data_uti.f90]]>>=
	<<File header>>

	module rt_data_uti

	<<Use kinds>>
	<<Use strings>>
	use format_defs, only: FMT_19
	use ifiles
	use lexers
	use parser
	use flavors
	use variables, only: var_list_t, var_entry_t, var_entry_init_int
	use eval_trees
	use models
	use prclib_stacks

	use rt_data

	<<Standard module head>>

	<<RT data: test declarations>>

	contains

	<<RT data: test auxiliary>>

	<<RT data: tests>>

	end module rt_data_uti
	@ %def rt_data_ut
	@ API: driver for the unit tests below.
	<<RT data: public test>>=
	public :: rt_data_test
	<<RT data: test driver>>=
	subroutine rt_data_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<RT data: execute tests>>
	end subroutine rt_data_test

	@ %def rt_data_test
	@
	\subsubsection{Initial content}
	@
	Display the RT data in the state just after (global) initialization.
	<<RT data: execute tests>>=
	call test (rt_data_1, "rt_data_1", &
	"initialize", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_1
	<<RT data: tests>>=
	subroutine rt_data_1 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: rt_data_1"
	write (u, "(A)") "* Purpose: initialize global runtime data"
	write (u, "(A)")

	call global%global_init (logfile = var_str ("rt_data.log"))
	call fix_system_dependencies (global)

	call global%set_int (var_str ("seed"), 0, is_known=.true.)

	call global%it_list%init ([2, 3], [5000, 20000])

	call global%write (u)

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_1"

	end subroutine rt_data_1

	@ %def rt_data_1
	@
	\subsubsection{Fill values}
	Fill in empty slots in the runtime data block.
	<<RT data: execute tests>>=
	call test (rt_data_2, "rt_data_2", &
	"fill", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_2
	<<RT data: tests>>=
	subroutine rt_data_2 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(flavor_t), dimension(2) :: flv
	type(string_t) :: cut_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree

	write (u, "(A)") "* Test output: rt_data_2"
	write (u, "(A)") "* Purpose: initialize global runtime data &
	&and fill contents"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call fix_system_dependencies (global)

	call global%select_model (var_str ("Test"))

	call global%set_real (var_str ("sqrts"), &
	1000._default, is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)
	call flv%init ([25,25], global%model)

	call global%set_string (var_str ("$run_id"), &
	var_str ("run1"), is_known = .true.)
	call global%set_real (var_str ("luminosity"), &
	33._default, is_known = .true.)

	call syntax_pexpr_init ()
	cut_expr_text = "all Pt > 100 [s]"
	call ifile_append (ifile, cut_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (parse_tree, stream, .true.)
	global%pn%cuts_lexpr => parse_tree%get_root_ptr ()

	allocate (global%sample_fmt (2))
	global%sample_fmt(1) = "foo_fmt"
	global%sample_fmt(2) = "bar_fmt"

	call global%write (u)

	call parse_tree_final (parse_tree)
	call stream_final (stream)
	call ifile_final (ifile)
	call syntax_pexpr_final ()

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_2"

	end subroutine rt_data_2

	@ %def rt_data_2
	@
	\subsubsection{Save and restore}
	Set up a local runtime data block, change some contents, restore the
	global block.
	<<RT data: execute tests>>=
	call test (rt_data_3, "rt_data_3", &
	"save/restore", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_3
	<<RT data: tests>>=
	subroutine rt_data_3 (u)
	use event_base, only: event_callback_nop_t
	integer, intent(in) :: u
	type(rt_data_t), target :: global, local
	type(flavor_t), dimension(2) :: flv
	type(string_t) :: cut_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree
	type(prclib_entry_t), pointer :: lib
	type(event_callback_nop_t) :: event_callback_nop

	write (u, "(A)") "* Test output: rt_data_3"
	write (u, "(A)") "* Purpose: initialize global runtime data &
	&and fill contents;"
	write (u, "(A)") "* copy to local block and back"
	write (u, "(A)")

	write (u, "(A)") "* Init global data"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call fix_system_dependencies (global)

	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%select_model (var_str ("Test"))

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call flv%init ([25,25], global%model)

	call global%beam_structure%init_sf (flv%get_name (), [1])
	call global%beam_structure%set_sf (1, 1, var_str ("pdf_builtin"))

	call global%set_string (var_str ("$run_id"), &
	var_str ("run1"), is_known = .true.)
	call global%set_real (var_str ("luminosity"), &
	33._default, is_known = .true.)

	call syntax_pexpr_init ()
	cut_expr_text = "all Pt > 100 [s]"
	call ifile_append (ifile, cut_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_lexpr (parse_tree, stream, .true.)
	global%pn%cuts_lexpr => parse_tree%get_root_ptr ()

	allocate (global%sample_fmt (2))
	global%sample_fmt(1) = "foo_fmt"
	global%sample_fmt(2) = "bar_fmt"

	allocate (lib)
	call lib%init (var_str ("library_1"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Init and modify local data"
	write (u, "(A)")

	call local%local_init (global)
	call local%append_string (var_str ("$integration_method"), intrinsic=.true.)
	call local%append_string (var_str ("$phs_method"), intrinsic=.true.)

	call local%activate ()

	write (u, "(1x,A,L1)") "model associated = ", associated (local%model)
	write (u, "(1x,A,L1)") "library associated = ", associated (local%prclib)
	write (u, *)

	call local%model_set_real (var_str ("ms"), 150._default)
	call local%set_string (var_str ("$integration_method"), &
	var_str ("midpoint"), is_known = .true.)
	call local%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)

	local%os_data%fc = "Local compiler"

	allocate (lib)
	call lib%init (var_str ("library_2"))
	call local%add_prclib (lib)

	call local%set_event_callback (event_callback_nop)

	call local%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Restore global data"
	write (u, "(A)")

	call local%deactivate (global)

	write (u, "(1x,A,L1)") "model associated = ", associated (global%model)
	write (u, "(1x,A,L1)") "library associated = ", associated (global%prclib)
	write (u, *)

	call global%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call parse_tree_final (parse_tree)
	call stream_final (stream)
	call ifile_final (ifile)
	call syntax_pexpr_final ()

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_3"

	end subroutine rt_data_3

	@ %def rt_data_3
	@
	\subsubsection{Show variables}
	Display selected variables in the global record.
	<<RT data: execute tests>>=
	call test (rt_data_4, "rt_data_4", &
	"show variables", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_4
	<<RT data: tests>>=
	subroutine rt_data_4 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	type(string_t), dimension(0) :: empty_string_array

	write (u, "(A)") "* Test output: rt_data_4"
	write (u, "(A)") "* Purpose: display selected variables"
	write (u, "(A)")

	call global%global_init ()

	write (u, "(A)") "* No variables:"
	write (u, "(A)")

	call global%write_vars (u, empty_string_array)

	write (u, "(A)") "* Two variables:"
	write (u, "(A)")

	call global%write_vars (u, &
	[var_str ("?unweighted"), var_str ("$phs_method")])

	write (u, "(A)")
	write (u, "(A)") "* Display whole record with selected variables"
	write (u, "(A)")

	call global%write (u, &
	vars = [var_str ("?unweighted"), var_str ("$phs_method")])

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_4"

	end subroutine rt_data_4

	@ %def rt_data_4
	@
	\subsubsection{Show parts}
	Display only selected parts in the state just after (global) initialization.
	<<RT data: execute tests>>=
	call test (rt_data_5, "rt_data_5", &
	"show parts", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_5
	<<RT data: tests>>=
	subroutine rt_data_5 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: rt_data_5"
	write (u, "(A)") "* Purpose: display parts of rt data"
	write (u, "(A)")

	call global%global_init ()
	call global%write_libraries (u)

	write (u, "(A)")

	call global%write_beams (u)

	write (u, "(A)")

	call global%write_process_stack (u)

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_5"

	end subroutine rt_data_5

	@ %def rt_data_5
	@
	\subsubsection{Local Model}
	Locally modify a model and restore the global one. We need an auxiliary
	function to determine the status of a model particle:
	<<RT data: test auxiliary>>=
	function is_stable (pdg, global) result (flag)
	integer, intent(in) :: pdg
	type(rt_data_t), intent(in) :: global
	logical :: flag
	type(flavor_t) :: flv
	call flv%init (pdg, global%model)
	flag = flv%is_stable ()
	end function is_stable

	function is_polarized (pdg, global) result (flag)
	integer, intent(in) :: pdg
	type(rt_data_t), intent(in) :: global
	logical :: flag
	type(flavor_t) :: flv
	call flv%init (pdg, global%model)
	flag = flv%is_polarized ()
	end function is_polarized

	@ %def is_stable is_polarized
	<<RT data: execute tests>>=
	call test (rt_data_6, "rt_data_6", &
	"local model", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_6
	<<RT data: tests>>=
	subroutine rt_data_6 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global, local
	type(var_list_t), pointer :: model_vars
	type(string_t) :: var_name

	write (u, "(A)") "* Test output: rt_data_6"
	write (u, "(A)") "* Purpose: apply and keep local modifications to model"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%select_model (var_str ("Test"))

	write (u, "(A)") "* Original model"
	write (u, "(A)")

	call global%write_model_list (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, global)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, global)

	write (u, *)

	var_name = "ff"

	write (u, "(A)", advance="no") "Global model variable: "
	model_vars => global%model%get_var_list_ptr ()
	call model_vars%write_var (var_name, u)

	write (u, "(A)")
	write (u, "(A)") "* Apply local modifications: unstable"
	write (u, "(A)")

	call local%local_init (global)
	call local%activate ()

	call local%model_set_real (var_name, 0.4_default)
	call local%modify_particle (25, stable = .false., decay = [var_str ("d1")])
	call local%modify_particle (6, stable = .false., &
	decay = [var_str ("f1")], isotropic_decay = .true.)
	call local%modify_particle (-6, stable = .false., &
	decay = [var_str ("f2"), var_str ("f3")], diagonal_decay = .true.)

	call local%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Further modifications"
	write (u, "(A)")

	call local%modify_particle (6, stable = .false., &
	decay = [var_str ("f1")], &
	diagonal_decay = .true., isotropic_decay = .false.)
	call local%modify_particle (-6, stable = .false., &
	decay = [var_str ("f2"), var_str ("f3")], &
	diagonal_decay = .false., isotropic_decay = .true.)
	call local%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Further modifications: f stable but polarized"
	write (u, "(A)")

	call local%modify_particle (6, stable = .true., polarized = .true.)
	call local%modify_particle (-6, stable = .true.)
	call local%model%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Global model"
	write (u, "(A)")

	call global%model%write (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, global)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, global)

	write (u, "(A)")
	write (u, "(A)") "* Local model"
	write (u, "(A)")

	call local%model%write (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, local)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, local)

	write (u, *)

	write (u, "(A)", advance="no") "Global model variable: "
	model_vars => global%model%get_var_list_ptr ()
	call model_vars%write_var (var_name, u)

	write (u, "(A)", advance="no") "Local model variable: "
	associate (model_var_list_ptr => local%model%get_var_list_ptr())
	call model_var_list_ptr%write_var (var_name, u)
	end associate

	write (u, "(A)")
	write (u, "(A)") "* Restore global"

	call local%deactivate (global, keep_local = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Global model"
	write (u, "(A)")

	call global%model%write (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, global)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, global)

	write (u, "(A)")
	write (u, "(A)") "* Local model"
	write (u, "(A)")

	call local%model%write (u)
	write (u, *)
	write (u, "(A,L1)") "s is stable = ", is_stable (25, local)
	write (u, "(A,L1)") "f is polarized = ", is_polarized (6, local)

	write (u, *)

	write (u, "(A)", advance="no") "Global model variable: "
	model_vars => global%model%get_var_list_ptr ()
	call model_vars%write_var (var_name, u)

	write (u, "(A)", advance="no") "Local model variable: "
	associate (model_var_list_ptr => local%model%get_var_list_ptr())
	call model_var_list_ptr%write_var (var_name, u)
	end associate

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call local%model%final ()
	deallocate (local%model)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_6"

	end subroutine rt_data_6

	@ %def rt_data_6
	@
	\subsubsection{Result variables}
	Initialize result variables and check that they are accessible via the
	global variable list.
	<<RT data: execute tests>>=
	call test (rt_data_7, "rt_data_7", &
	"result variables", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_7
	<<RT data: tests>>=
	subroutine rt_data_7 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: rt_data_7"
	write (u, "(A)") "* Purpose: set and access result variables"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process variables"
	write (u, "(A)")

	call global%global_init ()
	call global%process_stack%init_result_vars (var_str ("testproc"))

	call global%var_list%write_var (&
	var_str ("integral(testproc)"), u, defined=.true.)
	call global%var_list%write_var (&
	var_str ("error(testproc)"), u, defined=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_7"

	end subroutine rt_data_7

	@ %def rt_data_7
	@
	\subsubsection{Beam energy}
	If beam parameters are set, the variable [[sqrts]] is not necessarily
	the collision energy. The method [[get_sqrts]] fetches the correct value.
	<<RT data: execute tests>>=
	call test (rt_data_8, "rt_data_8", &
	"beam energy", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_8
	<<RT data: tests>>=
	subroutine rt_data_8 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: rt_data_8"
	write (u, "(A)") "* Purpose: get correct collision energy"
	write (u, "(A)")

	write (u, "(A)") "* Initialize"
	write (u, "(A)")

	call global%global_init ()

	write (u, "(A)") "* Set sqrts"
	write (u, "(A)")

	call global%set_real (var_str ("sqrts"), &
	1000._default, is_known = .true.)
	write (u, "(1x,A," // FMT_19 // ")") "sqrts =", global%get_sqrts ()

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_8"

	end subroutine rt_data_8

	@ %def rt_data_8
	@
	\subsubsection{Local variable modifications}
	<<RT data: execute tests>>=
	call test (rt_data_9, "rt_data_9", &
	"local variables", &
	u, results)
	<<RT data: test declarations>>=
	public :: rt_data_9
	<<RT data: tests>>=
	subroutine rt_data_9 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global, local
	type(var_list_t), pointer :: var_list

	write (u, "(A)") "* Test output: rt_data_9"
	write (u, "(A)") "* Purpose: handle local variables"
	write (u, "(A)")

	call syntax_model_file_init ()

	write (u, "(A)") "* Initialize global record and set some variables"
	write (u, "(A)")

	call global%global_init ()
	call global%select_model (var_str ("Test"))

	call global%set_real (var_str ("sqrts"), 17._default, is_known = .true.)
	call global%set_real (var_str ("luminosity"), 2._default, is_known = .true.)
	call global%model_set_real (var_str ("ff"), 0.5_default)
	call global%model_set_real (var_str ("gy"), 1.2_default)

	var_list => global%get_var_list_ptr ()

	call var_list%write_var (var_str ("sqrts"), u, defined=.true.)
	call var_list%write_var (var_str ("luminosity"), u, defined=.true.)
	call var_list%write_var (var_str ("ff"), u, defined=.true.)
	call var_list%write_var (var_str ("gy"), u, defined=.true.)
	call var_list%write_var (var_str ("mf"), u, defined=.true.)
	call var_list%write_var (var_str ("x"), u, defined=.true.)

	write (u, "(A)")

	write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
	global%get_rval (var_str ("sqrts"))
	write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
	global%get_rval (var_str ("luminosity"))
	write (u, "(1x,A,1x,F5.2)") "ff = ", &
	global%get_rval (var_str ("ff"))
	write (u, "(1x,A,1x,F5.2)") "gy = ", &
	global%get_rval (var_str ("gy"))
	write (u, "(1x,A,1x,F5.2)") "mf = ", &
	global%get_rval (var_str ("mf"))
	write (u, "(1x,A,1x,F5.2)") "x = ", &
	global%get_rval (var_str ("x"))

	write (u, "(A)")
	write (u, "(A)") "* Create local record with local variables"
	write (u, "(A)")

	call local%local_init (global)

	call local%append_real (var_str ("luminosity"), intrinsic = .true.)
	call local%append_real (var_str ("x"), user = .true.)

	call local%activate ()

	var_list => local%get_var_list_ptr ()

	call var_list%write_var (var_str ("sqrts"), u)
	call var_list%write_var (var_str ("luminosity"), u)
	call var_list%write_var (var_str ("ff"), u)
	call var_list%write_var (var_str ("gy"), u)
	call var_list%write_var (var_str ("mf"), u)
	call var_list%write_var (var_str ("x"), u, defined=.true.)

	write (u, "(A)")

	write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
	local%get_rval (var_str ("sqrts"))
	write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
	local%get_rval (var_str ("luminosity"))
	write (u, "(1x,A,1x,F5.2)") "ff = ", &
	local%get_rval (var_str ("ff"))
	write (u, "(1x,A,1x,F5.2)") "gy = ", &
	local%get_rval (var_str ("gy"))
	write (u, "(1x,A,1x,F5.2)") "mf = ", &
	local%get_rval (var_str ("mf"))
	write (u, "(1x,A,1x,F5.2)") "x = ", &
	local%get_rval (var_str ("x"))

	write (u, "(A)")
	write (u, "(A)") "* Modify some local variables"
	write (u, "(A)")

	call local%set_real (var_str ("luminosity"), 42._default, is_known=.true.)
	call local%set_real (var_str ("x"), 6.66_default, is_known=.true.)
	call local%model_set_real (var_str ("ff"), 0.7_default)

	var_list => local%get_var_list_ptr ()

	call var_list%write_var (var_str ("sqrts"), u)
	call var_list%write_var (var_str ("luminosity"), u)
	call var_list%write_var (var_str ("ff"), u)
	call var_list%write_var (var_str ("gy"), u)
	call var_list%write_var (var_str ("mf"), u)
	call var_list%write_var (var_str ("x"), u, defined=.true.)

	write (u, "(A)")

	write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
	local%get_rval (var_str ("sqrts"))
	write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
	local%get_rval (var_str ("luminosity"))
	write (u, "(1x,A,1x,F5.2)") "ff = ", &
	local%get_rval (var_str ("ff"))
	write (u, "(1x,A,1x,F5.2)") "gy = ", &
	local%get_rval (var_str ("gy"))
	write (u, "(1x,A,1x,F5.2)") "mf = ", &
	local%get_rval (var_str ("mf"))
	write (u, "(1x,A,1x,F5.2)") "x = ", &
	local%get_rval (var_str ("x"))

	write (u, "(A)")
	write (u, "(A)") "* Restore globals"
	write (u, "(A)")

	call local%deactivate (global)

	var_list => global%get_var_list_ptr ()

	call var_list%write_var (var_str ("sqrts"), u)
	call var_list%write_var (var_str ("luminosity"), u)
	call var_list%write_var (var_str ("ff"), u)
	call var_list%write_var (var_str ("gy"), u)
	call var_list%write_var (var_str ("mf"), u)
	call var_list%write_var (var_str ("x"), u, defined=.true.)

	write (u, "(A)")

	write (u, "(1x,A,1x,F5.2)") "sqrts = ", &
	global%get_rval (var_str ("sqrts"))
	write (u, "(1x,A,1x,F5.2)") "luminosity = ", &
	global%get_rval (var_str ("luminosity"))
	write (u, "(1x,A,1x,F5.2)") "ff = ", &
	global%get_rval (var_str ("ff"))
	write (u, "(1x,A,1x,F5.2)") "gy = ", &
	global%get_rval (var_str ("gy"))
	write (u, "(1x,A,1x,F5.2)") "mf = ", &
	global%get_rval (var_str ("mf"))
	write (u, "(1x,A,1x,F5.2)") "x = ", &
	global%get_rval (var_str ("x"))

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call local%local_final ()

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_9"

	end subroutine rt_data_9

	@ %def rt_data_9
	@
	\subsubsection{Descriptions}
	<<RT data: execute tests>>=
	call test(rt_data_10, "rt_data_10", &
	"descriptions", u, results)
	<<RT data: test declarations>>=
	public :: rt_data_10
	<<RT data: tests>>=
	subroutine rt_data_10 (u)
	integer, intent(in) :: u
	type(rt_data_t) :: global
	! type(var_list_t) :: var_list
	write (u, "(A)") "* Test output: rt_data_10"
	write (u, "(A)") "* Purpose: display descriptions"
	write (u, "(A)")

	call global%var_list%append_real (var_str ("sqrts"), &
	intrinsic=.true., &
	description=var_str ('Real variable in order to set the center-of-mass ' // &
	'energy for the collisions.'))
	call global%var_list%append_real (var_str ("luminosity"), 0._default, &
	intrinsic=.true., &
	description=var_str ('This specifier \ttt{luminosity = {\em ' // &
	'<num>}} sets the integrated luminosity (in inverse femtobarns, ' // &
	'fb${}^{-1}$) for the event generation of the processes in the ' // &
	'\sindarin\ input files.'))
	call global%var_list%append_int (var_str ("seed"), 1234, &
	intrinsic=.true., &
	description=var_str ('Integer variable \ttt{seed = {\em <num>}} ' // &
	'that allows to set a specific random seed \ttt{num}.'))
	call global%var_list%append_string (var_str ("$method"), var_str ("omega"), &
	intrinsic=.true., &
	description=var_str ('This string variable specifies the method ' // &
	'for the matrix elements to be used in the evaluation.'))
	call global%var_list%append_log (var_str ("?read_color_factors"), .true., &
	intrinsic=.true., &
	description=var_str ('This flag decides whether to read QCD ' // &
	'color factors from the matrix element provided by each method, ' // &
	'or to try and calculate the color factors in \whizard\ internally.'))

	call global%var_list%sort ()

	call global%write_var_descriptions (u)
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_10"
	end subroutine rt_data_10

	@ %def rt_data_10
	@
	\subsubsection{Export objects}
	Export objects are variables or other data that should be copied or otherwise
	applied to corresponding objects in the outer scope.

	We test appending and retrieval for the export list.
	<<RT data: execute tests>>=
	call test(rt_data_11, "rt_data_11", &
	"export objects", u, results)
	<<RT data: test declarations>>=
	public :: rt_data_11
	<<RT data: tests>>=
	subroutine rt_data_11 (u)
	integer, intent(in) :: u
	type(rt_data_t) :: global
	type(string_t), dimension(:), allocatable :: exports
	integer :: i

	write (u, "(A)") "* Test output: rt_data_11"
	write (u, "(A)") "* Purpose: handle export object list"
	write (u, "(A)")

	write (u, "(A)") "* Empty export list"
	write (u, "(A)")

	call global%write_exports (u)

	write (u, "(A)") "* Add an entry"
	write (u, "(A)")

	allocate (exports (1))
	exports(1) = var_str ("results")
	do i = 1, size (exports)
	write (u, "('+ ',A)") char (exports(i))
	end do
	write (u, *)

	call global%append_exports (exports)
	call global%write_exports (u)

	write (u, "(A)")
	write (u, "(A)") "* Add more entries, including doubler"
	write (u, "(A)")

	deallocate (exports)
	allocate (exports (3))
	exports(1) = var_str ("foo")
	exports(2) = var_str ("results")
	exports(3) = var_str ("bar")
	do i = 1, size (exports)
	write (u, "('+ ',A)") char (exports(i))
	end do
	write (u, *)

	call global%append_exports (exports)
	call global%write_exports (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: rt_data_11"
	end subroutine rt_data_11

	@ %def rt_data_11
	@
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Select implementations}
	For abstract types (process core, integrator, phase space, etc.), we need a
	way to dynamically select a concrete type, using either data given by the user
	or a previous selection of a concrete type. This is done by subroutines in
	the current module.

	We would like to put this in the [[me_methods]] folder but it also
	depends on [[gosam]] and [[openloops]], so it is unclear where to put
	it.
	<<[[dispatch_me_methods.f90]]>>=
	<<File header>>

	module dispatch_me_methods

	<<Use strings>>
	use physics_defs, only: BORN
	use diagnostics
	use sm_qcd
	use variables, only: var_list_t
	use models
	use model_data

	use prc_core_def
	use prc_core
	use prc_test_core
	use prc_template_me
	use prc_test
	use prc_omega
	use prc_user_defined
	use prc_gosam
	use prc_openloops
	use prc_recola
	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, method)
	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), intent(in), optional :: method
	type(string_t) :: model_name, meth
	type(string_t) :: ufo_path
	type(string_t) :: restrictions
	logical :: ufo
	logical :: cms_scheme
	logical :: openmp_support
	logical :: report_progress
	logical :: diags, diags_color
	logical :: write_phs_output
	type(string_t) :: extra_options
	integer :: nlo
	integer :: alpha_power
	integer :: alphas_power
	if (present (method)) then
	meth = method
	else
	meth = var_list%get_sval (var_str ("$method"))
	end if
	call msg_debug2 (D_CORE, "dispatch_core_def")
	if (associated (model)) then
	model_name = model%get_name ()
	cms_scheme = model%get_scheme () == "Complex_Mass_Scheme"
	ufo = model%is_ufo_model ()
	ufo_path = model%get_ufo_path ()
	else
	model_name = ""
	cms_scheme = .false.
	ufo = .false.
	end if
	restrictions = var_list%get_sval (&
	var_str ("$restrictions"))
	diags = var_list%get_lval (&
	var_str ("?vis_diags"))
	diags_color = var_list%get_lval (&
	var_str ("?vis_diags_color"))
	openmp_support = var_list%get_lval (&
	var_str ("?omega_openmp"))
	report_progress = var_list%get_lval (&
	var_str ("?report_progress"))
	write_phs_output = var_list%get_lval (&
	var_str ("?omega_write_phs_output"))
	extra_options = var_list%get_sval (&
	var_str ("$omega_flags"))
	nlo = BORN; if (present (nlo_type)) nlo = nlo_type
	alpha_power = var_list%get_ival (var_str ("alpha_power"))
	alphas_power = var_list%get_ival (var_str ("alphas_power"))
	call msg_debug2 (D_CORE, "dispatching core method: ", meth)
	select case (char (meth))
	case ("unit_test")
	allocate (prc_test_def_t :: core_def)
	select type (core_def)
	type is (prc_test_def_t)
	call core_def%init (model_name, prt_in, prt_out)
	end select
	case ("template")
	allocate (template_me_def_t :: core_def)
	select type (core_def)
	type is (template_me_def_t)
	call core_def%init (model, prt_in, prt_out, unity = .false.)
	end select
	case ("template_unity")
	allocate (template_me_def_t :: core_def)
	select type (core_def)
	type is (template_me_def_t)
	call core_def%init (model, prt_in, prt_out, unity = .true.)
	end select
	case ("omega")
	allocate (omega_def_t :: core_def)
	select type (core_def)
	type is (omega_def_t)
	call core_def%init (model_name, prt_in, prt_out, &
	.false., ufo, ufo_path, &
	restrictions, cms_scheme, &
	openmp_support, report_progress, write_phs_output, &
	extra_options, diags, diags_color)
	end select
	case ("ovm")
	allocate (omega_def_t :: core_def)
	select type (core_def)
	type is (omega_def_t)
	call core_def%init (model_name, prt_in, prt_out, &
	.true., .false., var_str (""), &
	restrictions, cms_scheme, &
	openmp_support, report_progress, write_phs_output, &
	extra_options, diags, diags_color)
	end select
	case ("gosam")
	allocate (gosam_def_t :: core_def)
	select type (core_def)
	type is (gosam_def_t)
	if (present (id)) then
	call core_def%init (id, model_name, prt_in, &
	prt_out, nlo, 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 ("recola")
	call abort_if_recola_not_active ()
	allocate (recola_def_t :: core_def)
	select type (core_def)
	type is (recola_def_t)
	if (present (id)) then
	call core_def%init (id, model_name, prt_in, &
	prt_out, nlo, alpha_power, alphas_power)
	else
	call msg_fatal ("Dispatch RECOLA 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 (meth) // "' not implemented")
	end select
	end subroutine dispatch_core_def

	@ %def dispatch_core_def
	@
	\subsection{Process core allocation}
	Here we allocate an object of abstract type [[prc_core_t]] with a concrete
	type that matches a process definition. The [[prc_omega_t]] extension
	will require the current parameter set, so we take the opportunity to
	grab it from the model.
	<<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 (recola_def_t)
	if (.not. allocated (core)) allocate (prc_recola_t :: core)
	select type (core)
	type is (prc_recola_t)
	call core%set_parameters (qcd, model)
	end select
	type is (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)
	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 os_interface, only: os_data_t, os_data_init
	use physics_defs, only: ELECTRON, PROTON
	use sm_qcd, only: qcd_t
	use flavors, only: flavor_t
	use interactions, only: reset_interaction_counter
	use pdg_arrays, only: pdg_array_t, assignment(=)
	use prc_core_def, only: prc_core_def_t
	use prc_test_core, only: test_t
	use prc_core, only: prc_core_t
	use prc_test, only: prc_test_def_t
	use prc_omega, only: omega_def_t, prc_omega_t
	use sf_mappings, only: sf_channel_t
	use sf_base, only: sf_data_t, sf_config_t
	use phs_base, only: phs_channel_collection_t
	use variables, only: var_list_t
	use model_data, only: model_data_t
	use models, only: syntax_model_file_init, syntax_model_file_final
	use rt_data, only: rt_data_t

	use dispatch_phase_space, only: dispatch_sf_channels
	use dispatch_beams, only: sf_prop_t, dispatch_qcd
	use dispatch_beams, only: dispatch_sf_config, dispatch_sf_data
	use dispatch_me_methods, only: dispatch_core_def, dispatch_core
	use dispatch_me_methods, only: dispatch_core_update, dispatch_core_restore

	use sf_base_ut, only: sf_test_data_t

	<<Standard module head>>

	<<Dispatch: public test auxiliary>>

	<<Dispatch: test declarations>>

	contains

	<<Dispatch: tests>>

	<<Dispatch: test auxiliary>>

	end module dispatch_uti

	@ %def dispatch_uti
	@ API: driver for the unit tests below.
	<<Dispatch: public test>>=
	public :: dispatch_test
	<<Dispatch: test driver>>=
	subroutine dispatch_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Dispatch: execute tests>>
	end subroutine dispatch_test

	@ %def dispatch_test
	@
	\subsubsection{Select type: process definition}
	<<Dispatch: execute tests>>=
	call test (dispatch_1, "dispatch_1", &
	"process configuration method", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_1
	<<Dispatch: tests>>=
	subroutine dispatch_1 (u)
	integer, intent(in) :: u
	type(string_t), dimension(2) :: prt_in, prt_out
	type(rt_data_t), target :: global
	class(prc_core_def_t), allocatable :: core_def

	write (u, "(A)") "* Test output: dispatch_1"
	write (u, "(A)") "* Purpose: select process configuration method"
	write (u, "(A)")

	call global%global_init ()

	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	prt_in = [var_str ("a"), var_str ("b")]
	prt_out = [var_str ("c"), var_str ("d")]

	write (u, "(A)") "* Allocate core_def as prc_test_def"

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
	select type (core_def)
	type is (prc_test_def_t)
	call core_def%write (u)
	end select

	deallocate (core_def)

	write (u, "(A)")
	write (u, "(A)") "* Allocate core_def as omega_def"
	write (u, "(A)")

	call global%set_string (var_str ("$method"), &
	var_str ("omega"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
	select type (core_def)
	type is (omega_def_t)
	call core_def%write (u)
	end select

	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: dispatch_1"

	end subroutine dispatch_1

	@ %def dispatch_1
	@
	\subsubsection{Select type: process core}
	<<Dispatch: execute tests>>=
	call test (dispatch_2, "dispatch_2", &
	"process core", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_2
	<<Dispatch: tests>>=
	subroutine dispatch_2 (u)
	integer, intent(in) :: u
	type(string_t), dimension(2) :: prt_in, prt_out
	type(rt_data_t), target :: global
	class(prc_core_def_t), allocatable :: core_def
	class(prc_core_t), allocatable :: core

	write (u, "(A)") "* Test output: dispatch_2"
	write (u, "(A)") "* Purpose: select process configuration method"
	write (u, "(A)") " and allocate process core"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()

	prt_in = [var_str ("a"), var_str ("b")]
	prt_out = [var_str ("c"), var_str ("d")]

	write (u, "(A)") "* Allocate core as test_t"
	write (u, "(A)")

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)
	call dispatch_core (core, core_def)
	select type (core)
	type is (test_t)
	call core%write (u)
	end select

	deallocate (core)
	deallocate (core_def)

	write (u, "(A)")
	write (u, "(A)") "* Allocate core as prc_omega_t"
	write (u, "(A)")

	call global%set_string (var_str ("$method"), &
	var_str ("omega"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)

	call global%select_model (var_str ("Test"))

	call global%set_log (&
	var_str ("?helicity_selection_active"), &
	.true., is_known = .true.)
	call global%set_real (&
	var_str ("helicity_selection_threshold"), &
	1e9_default, is_known = .true.)
	call global%set_int (&
	var_str ("helicity_selection_cutoff"), &
	10, is_known = .true.)

	call dispatch_core (core, core_def, &
	global%model, &
	global%get_helicity_selection ())
	call core_def%allocate_driver (core%driver, var_str (""))

	select type (core)
	type is (prc_omega_t)
	call core%write (u)
	end select

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: dispatch_2"

	end subroutine dispatch_2

	@ %def dispatch_2
	@
	\subsubsection{Select type: structure-function data}
	This is an extra dispatcher that enables the test structure
	functions. This procedure should be assigned to the
	[[dispatch_sf_data_extra]] hook before any tests are executed.
	<<Dispatch: public test auxiliary>>=
	public :: dispatch_sf_data_test
	<<Dispatch: test auxiliary>>=
	subroutine dispatch_sf_data_test (data, sf_method, i_beam, sf_prop, &
	var_list, var_list_global, model, os_data, sqrts, pdg_in, pdg_prc, polarized)
	class(sf_data_t), allocatable, intent(inout) :: data
	type(string_t), intent(in) :: sf_method
	integer, dimension(:), intent(in) :: i_beam
	type(var_list_t), intent(in) :: var_list
	type(var_list_t), intent(inout) :: var_list_global
	class(model_data_t), target, intent(in) :: model
	type(os_data_t), intent(in) :: os_data
	real(default), intent(in) :: sqrts
	type(pdg_array_t), dimension(:), intent(inout) :: pdg_in
	type(pdg_array_t), dimension(:,:), intent(in) :: pdg_prc
	type(sf_prop_t), intent(inout) :: sf_prop
	logical, intent(in) :: polarized
	select case (char (sf_method))
	case ("sf_test_0", "sf_test_1")
	allocate (sf_test_data_t :: data)
	select type (data)
	type is (sf_test_data_t)
	select case (char (sf_method))
	case ("sf_test_0"); call data%init (model, pdg_in(i_beam(1)))
	case ("sf_test_1"); call data%init (model, pdg_in(i_beam(1)),&
	mode = 1)
	end select
	end select
	end select
	end subroutine dispatch_sf_data_test

	@ %def dispatch_sf_data_test
	@ The actual test. We can't move this to [[beams]] as it depends on
	[[model_features]] for the [[model_list_t]].
	<<Dispatch: execute tests>>=
	call test (dispatch_7, "dispatch_7", &
	"structure-function data", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_7
	<<Dispatch: tests>>=
	subroutine dispatch_7 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(os_data_t) :: os_data
	type(string_t) :: prt, sf_method
	type(sf_prop_t) :: sf_prop
	class(sf_data_t), allocatable :: data
	type(pdg_array_t), dimension(1) :: pdg_in
	type(pdg_array_t), dimension(1,1) :: pdg_prc
	type(pdg_array_t), dimension(1) :: pdg_out
	integer, dimension(:), allocatable :: pdg1

	write (u, "(A)") "* Test output: dispatch_7"
	write (u, "(A)") "* Purpose: select and configure &
	&structure function data"
	write (u, "(A)")

	call global%global_init ()

	call os_data_init (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}
	The actual test. We can't move this to [[beams]] as it depends on
	[[model_features]] for the [[model_list_t]].
	<<Dispatch: execute tests>>=
	call test (dispatch_8, "dispatch_8", &
	"beam structure", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_8
	<<Dispatch: tests>>=
	subroutine dispatch_8 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(os_data_t) :: os_data
	type(flavor_t), dimension(2) :: flv
	type(sf_config_t), dimension(:), allocatable :: sf_config
	type(sf_prop_t) :: sf_prop
	type(sf_channel_t), dimension(:), allocatable :: sf_channel
	type(phs_channel_collection_t) :: coll
	type(string_t) :: sf_string
	integer :: i
	type(pdg_array_t), dimension (2,1) :: pdg_prc

	write (u, "(A)") "* Test output: dispatch_8"
	write (u, "(A)") "* Purpose: configure a structure-function chain"
	write (u, "(A)")

	call global%global_init ()

	call os_data_init (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{Update process core parameters}
	This test dispatches a process core, temporarily modifies parameters,
	then restores the original.
	<<Dispatch: execute tests>>=
	call test (dispatch_10, "dispatch_10", &
	"process core update", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_10
	<<Dispatch: tests>>=
	subroutine dispatch_10 (u)
	integer, intent(in) :: u
	type(string_t), dimension(2) :: prt_in, prt_out
	type(rt_data_t), target :: global
	class(prc_core_def_t), allocatable :: core_def
	class(prc_core_t), allocatable :: core, saved_core
	type(var_list_t), pointer :: model_vars

	write (u, "(A)") "* Test output: dispatch_10"
	write (u, "(A)") "* Purpose: select process configuration method,"
	write (u, "(A)") " allocate process core,"
	write (u, "(A)") " temporarily reset parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()

	prt_in = [var_str ("a"), var_str ("b")]
	prt_out = [var_str ("c"), var_str ("d")]

	write (u, "(A)") "* Allocate core as prc_omega_t"
	write (u, "(A)")

	call global%set_string (var_str ("$method"), &
	var_str ("omega"), is_known = .true.)
	call dispatch_core_def (core_def, prt_in, prt_out, global%model, global%var_list)

	call global%select_model (var_str ("Test"))

	call dispatch_core (core, core_def, global%model)
	call core_def%allocate_driver (core%driver, var_str (""))

	select type (core)
	type is (prc_omega_t)
	call core%write (u)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Update core with modified model and helicity selection"
	write (u, "(A)")

	model_vars => global%model%get_var_list_ptr ()

	call model_vars%set_real (var_str ("gy"), 2._default, &
	is_known = .true.)
	call global%model%update_parameters ()

	call global%set_log (&
	var_str ("?helicity_selection_active"), &
	.true., is_known = .true.)
	call global%set_real (&
	var_str ("helicity_selection_threshold"), &
	2e10_default, is_known = .true.)
	call global%set_int (&
	var_str ("helicity_selection_cutoff"), &
	5, is_known = .true.)

	call dispatch_core_update (core, &
	global%model, &
	global%get_helicity_selection (), &
	saved_core = saved_core)
	select type (core)
	type is (prc_omega_t)
	call core%write (u)
	end select

	write (u, "(A)")
	write (u, "(A)") "* Restore core from save"
	write (u, "(A)")

	call dispatch_core_restore (core, saved_core)
	select type (core)
	type is (prc_omega_t)
	call core%write (u)
	end select

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: dispatch_10"

	end subroutine dispatch_10

	@ %def dispatch_10
	@
	\subsubsection{QCD Coupling}
	This test dispatches an [[qcd]] object, which is used to compute the
	(running) coupling by one of several possible methods.

	We can't move this to [[beams]] as it depends on
	[[model_features]] for the [[model_list_t]].
	<<Dispatch: execute tests>>=
	call test (dispatch_11, "dispatch_11", &
	"QCD coupling", &
	u, results)
	<<Dispatch: test declarations>>=
	public :: dispatch_11
	<<Dispatch: tests>>=
	subroutine dispatch_11 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(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 ("?alphas_is_fixed"), &
	.true., is_known = .true.)
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate alpha_s as running (built-in)"
	write (u, "(A)")

	call global%set_log (var_str ("?alphas_is_fixed"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?alphas_from_mz"), &
	.true., is_known = .true.)
	call global%set_int &
	(var_str ("alphas_order"), 1, is_known = .true.)
	call model_vars%set_real (var_str ("alphas"), 0.1234_default, &
	is_known=.true.)
	call model_vars%set_real (var_str ("mZ"), 91.234_default, &
	is_known=.true.)
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate alpha_s as running (built-in, Lambda defined)"
	write (u, "(A)")

	call global%set_log (var_str ("?alphas_from_mz"), &
	.false., is_known = .true.)
	call global%set_log (&
	var_str ("?alphas_from_lambda_qcd"), &
	.true., is_known = .true.)
	call global%set_real &
	(var_str ("lambda_qcd"), 250.e-3_default, &
	is_known=.true.)
	call global%set_int &
	(var_str ("alphas_order"), 2, is_known = .true.)
	call global%set_int &
	(var_str ("alphas_nf"), 4, is_known = .true.)
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call qcd%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate alpha_s as running (using builtin PDF set)"
	write (u, "(A)")

	call global%set_log (&
	var_str ("?alphas_from_lambda_qcd"), &
	.false., is_known = .true.)
	call global%set_log &
	(var_str ("?alphas_from_pdf_builtin"), &
	.true., is_known = .true.)
	call dispatch_qcd (qcd, global%get_var_list_ptr (), global%os_data)
	call qcd%write (u)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: dispatch_11"

	end subroutine dispatch_11

	@ %def dispatch_11
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process Configuration}
	This module communicates between the toplevel command structure with
	its runtime data set and the process-library handling modules which
	collect the definition of individual processes. Its primary purpose
	is to select from the available matrix-element generating methods and
	configure the entry in the process library accordingly.
	<<[[process_configurations.f90]]>>=
	<<File header>>

	module process_configurations

	<<Use strings>>
	use diagnostics
	use io_units
	use physics_defs, only: BORN, NLO_VIRTUAL, NLO_REAL, NLO_DGLAP, &
	NLO_SUBTRACTION, NLO_MISMATCH
	use models
	use prc_core_def
	use particle_specifiers
	use process_libraries
	use rt_data
	use variables, only: var_list_t

	use dispatch_me_methods, only: dispatch_core_def
	use prc_user_defined, only: user_defined_def_t

	<<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
	@ Output (for unit tests).
	<<Process configurations: process configuration: TBP>>=
	procedure :: write => process_configuration_write
	<<Process configurations: procedures>>=
	subroutine process_configuration_write (config, unit)
	class(process_configuration_t), intent(in) :: config
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(A)") "Process configuration:"
	if (associated (config%entry)) then
	call config%entry%write (u)
	else
	write (u, "(1x,3A)") "ID = '", char (config%id), "'"
	write (u, "(1x,A,1x,I0)") "num ID =", config%num_id
	write (u, "(2x,A)") "[no entry]"
	end if
	end subroutine process_configuration_write

	@ %def process_configuration_write
	@ Initialize a process. We only need the name, the number of incoming
	particles, and the number of components.
	<<Process configurations: process configuration: TBP>>=
	procedure :: init => process_configuration_init
	<<Process configurations: procedures>>=
	subroutine process_configuration_init &
	(config, prc_name, n_in, n_components, model, var_list, nlo_process)
	class(process_configuration_t), intent(out) :: config
	type(string_t), intent(in) :: prc_name
	integer, intent(in) :: n_in
	integer, intent(in) :: n_components
	type(model_t), intent(in), pointer :: model
	type(var_list_t), intent(in) :: var_list
	logical, intent(in), optional :: nlo_process
	logical :: nlo_proc
	logical :: requires_resonances
	call msg_debug (D_CORE, "process_configuration_init")
	config%id = prc_name
	if (present (nlo_process)) then
	nlo_proc = nlo_process
	else
	nlo_proc = .false.
	end if
	requires_resonances = var_list%get_lval (var_str ("?resonance_history"))

	call msg_debug (D_CORE, "nlo_process", nlo_proc)
	allocate (config%entry)
	if (var_list%is_known (var_str ("process_num_id"))) then
	config%num_id = &
	var_list%get_ival (var_str ("process_num_id"))
	call config%entry%init (prc_name, &
	model = model, n_in = n_in, n_components = n_components, &
	num_id = config%num_id, &
	nlo_process = nlo_proc, &
	requires_resonances = requires_resonances)
	else
	call config%entry%init (prc_name, &
	model = model, n_in = n_in, n_components = n_components, &
	nlo_process = nlo_proc, &
	requires_resonances = requires_resonances)
	end if
	end subroutine process_configuration_init

	@ %def process_configuration_init
	@ Initialize a process component. The details depend on the process method,
	which determines the type of the process component core. We set the incoming
	and outgoing particles (as strings, to be interpreted by the process driver).
	All other information is taken from the variable list.

	The dispatcher gets only the names of the particles. The process
	component definition gets the complete specifiers which contains a
	polarization flag and names of decay processes, where applicable.
	<<Process configurations: process configuration: TBP>>=
	procedure :: setup_component => process_configuration_setup_component
	<<Process configurations: 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
	type(string_t) :: born_me_method
	type(string_t) :: real_tree_me_method
	type(string_t) :: loop_me_method
	type(string_t) :: correlation_me_method
	type(string_t) :: dglap_me_method
	integer :: i
	call msg_debug2 (D_CORE, "process_configuration_setup_component")
	allocate (prt_str_in (size (prt_in)))
	allocate (prt_str_out (size (prt_out)))
	forall (i = 1:size (prt_in)) prt_str_in(i) = prt_in(i)% get_name ()
	forall (i = 1:size (prt_out)) prt_str_out(i) = prt_out(i)%get_name ()

	method = var_list%get_sval (var_str ("$method"))
	if (present (nlo_type)) then
	select case (nlo_type)
	case (BORN)
	born_me_method = var_list%get_sval (var_str ("$born_me_method"))
	if (born_me_method /= var_str ("")) then
	method = born_me_method
	end if
	case (NLO_VIRTUAL)
	loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
	if (loop_me_method /= var_str ("")) then
	method = loop_me_method
	end if
	case (NLO_REAL)
	real_tree_me_method = &
	var_list%get_sval (var_str ("$real_tree_me_method"))
	if (real_tree_me_method /= var_str ("")) then
	method = real_tree_me_method
	end if
	case (NLO_DGLAP)
	dglap_me_method = &
	var_list%get_sval (var_str ("$dglap_me_method"))
	if (dglap_me_method /= var_str ("")) then
	method = dglap_me_method
	end if
	case (NLO_SUBTRACTION,NLO_MISMATCH)
	correlation_me_method = &
	var_list%get_sval (var_str ("$correlation_me_method"))
	if (correlation_me_method /= var_str ("")) then
	method = correlation_me_method
	end if
	case default
	end select
	end if
	call dispatch_core_def (core_def, prt_str_in, prt_str_out, &
	model, var_list, config%id, nlo_type, method)
	select type (core_def)
	class is (user_defined_def_t)
	if (present (can_be_integrated)) then
	call core_def%set_active_writer (can_be_integrated)
	else
	call msg_fatal ("Cannot decide if user-defined core is integrated!")
	end if
	end select

	call msg_debug2 (D_CORE, "import_component with method ", method)
	call config%entry%import_component (i_component, &
	n_out = size (prt_out), &
	prt_in = prt_in, &
	prt_out = prt_out, &
	method = method, &
	variant = core_def, &
	nlo_type = nlo_type, &
	can_be_integrated = can_be_integrated)
	end subroutine process_configuration_setup_component

	@ %def process_configuration_setup_component
	@
	<<Process configurations: process configuration: TBP>>=
	procedure :: set_fixed_emitter => process_configuration_set_fixed_emitter
	<<Process configurations: 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, remnant, use_real_finite, mismatch)
	class(process_configuration_t), intent(inout) :: config
	integer, dimension(:), intent(in) :: i_list
	logical, intent(in) :: remnant, use_real_finite, mismatch
	integer :: i_component
	do i_component = 1, config%entry%get_n_components ()
	if (any (i_list == i_component)) then
	call config%entry%set_associated_components (i_component, &
	i_list, remnant, use_real_finite, mismatch)
	end if
	end do
	end subroutine process_configuration_set_component_associations

	@ %def process_configuration_set_component_associations
	@ Record a process configuration: append it to the currently selected process
	definition library.
	<<Process configurations: process configuration: TBP>>=
	procedure :: record => process_configuration_record
	<<Process configurations: 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%model, global%var_list)
	call prc_config%setup_component (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), &
	global%model, global%var_list)
	call prc_config%record (global)

	deallocate (prt_in, prt_out)

	end if

	if (btest (mode, 1)) then

	call global%select_model (var_str ("QED"))

	if (present (procname)) then
	prc_name = procname(2)
	else
	prc_name = "prc_config_b"
	end if
	n_components = 1
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("m+"), var_str ("m-")]

	call global%set_string (var_str ("$method"),&
	var_str ("omega"), is_known = .true.)

	call prc_config%init (prc_name, &
	size (prt_in), n_components, &
	global%model, global%var_list)
	call prc_config%setup_component (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), &
	global%model, global%var_list)
	call prc_config%record (global)

	deallocate (prt_in, prt_out)

	end if

	if (btest (mode, 2)) then

	call global%select_model (var_str ("Test"))

	if (present (procname)) then
	prc_name = procname(1)
	else
	prc_name = "prc_config_a"
	end if
	n_components = 1
	allocate (prt_in (1), prt_out (2))
	prt_in = [var_str ("s")]
	prt_out = [var_str ("f"), var_str ("fbar")]

	call global%set_string (var_str ("$method"),&
	var_str ("unit_test"), is_known = .true.)

	call prc_config%init (prc_name, &
	size (prt_in), n_components, &
	global%model, global%var_list)
	call prc_config%setup_component (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), &
	global%model, global%var_list)
	call prc_config%record (global)

	deallocate (prt_in, prt_out)

	end if

	end subroutine prepare_test_library

	@ %def prepare_test_library
	@ The actual test: the previous procedure with some prelude and postlude.
	In the global variable list, just before printing we reset the
	variables where the value may depend on the system and run environment.
	<<Process configurations: execute tests>>=
	call test (process_configurations_1, "process_configurations_1", &
	"test processes", &
	u, results)
	<<Process configurations: test declarations>>=
	public :: process_configurations_1
	<<Process configurations: tests>>=
	subroutine process_configurations_1 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: process_configurations_1"
	write (u, "(A)") "* Purpose: configure test processes"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	write (u, "(A)") "* Configure processes as prc_test, model Test"
	write (u, "(A)") "* and omega, model QED"
	write (u, *)

	call global%set_int (var_str ("process_num_id"), &
	42, is_known = .true.)
	call prepare_test_library (global, var_str ("prc_config_lib_1"), 3)

	global%os_data%fc = "Fortran-compiler"
	global%os_data%fcflags = "Fortran-flags"

	call global%write_libraries (u)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: process_configurations_1"

	end subroutine process_configurations_1

	@ %def process_configurations_1
	@
	\subsubsection{\oMega\ options}
	Slightly extended example where we pass \oMega\ options to the
	library. The [[prepare_test_library]] contents are spelled out.
	<<Process configurations: execute tests>>=
	call test (process_configurations_2, "process_configurations_2", &
	"omega options", &
	u, results)
	<<Process configurations: test declarations>>=
	public :: process_configurations_2
	<<Process configurations: tests>>=
	subroutine process_configurations_2 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global

	type(string_t) :: libname
	type(prclib_entry_t), pointer :: lib
	type(string_t) :: prc_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	integer :: n_components
	type(process_configuration_t) :: prc_config

	write (u, "(A)") "* Test output: process_configurations_2"
	write (u, "(A)") "* Purpose: configure test processes with options"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	write (u, "(A)") "* Configure processes as omega, model QED"
	write (u, *)

	libname = "prc_config_lib_2"

	allocate (lib)
	call lib%init (libname)
	call global%add_prclib (lib)

	call global%select_model (var_str ("QED"))

	prc_name = "prc_config_c"
	n_components = 2
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("m+"), var_str ("m-")]

	call global%set_string (var_str ("$method"),&
	var_str ("omega"), is_known = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	call prc_config%init (prc_name, size (prt_in), n_components, &
	global%model, global%var_list)

	call global%set_log (var_str ("?report_progress"), &
	.true., is_known = .true.)
	call prc_config%setup_component (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)

	call global%set_log (var_str ("?report_progress"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.true., is_known = .true.)
	call global%set_string (var_str ("$restrictions"),&
	var_str ("3+4~A"), is_known = .true.)
	call global%set_string (var_str ("$omega_flags"), &
	var_str ("-fusion:progress_file omega_prc_config.log"), &
	is_known = .true.)
	call prc_config%setup_component (2, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), global%model, global%var_list)

	call prc_config%record (global)

	deallocate (prt_in, prt_out)

	global%os_data%fc = "Fortran-compiler"
	global%os_data%fcflags = "Fortran-flags"

	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, only: var_list_t
	use model_data
	use process_libraries
	use prclib_stacks
	use rt_data

	<<Standard module head>>

	<<Compilations: public>>

	<<Compilations: types>>

	<<Compilations: parameters>>

	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.
	logical :: verbose = .false.
	logical :: use_workspace = .false.
	type(string_t) :: workspace
	contains
	<<Compilations: compilation item: TBP>>
	end type compilation_item_t

	@ %def compilation_item_t
	@ Initialize.

	Set flags and global properties of the library. Establish the workspace name,
	if defined.
	<<Compilations: compilation item: TBP>>=
	procedure :: init => compilation_item_init
	<<Compilations: 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"))
	comp%verbose = &
	var_list%get_lval (var_str ("?me_verbose"))
	comp%use_workspace = &
	var_list%is_known (var_str ("$compile_workspace"))
	if (comp%use_workspace) then
	comp%workspace = &
	var_list%get_sval (var_str ("$compile_workspace"))
	if (comp%workspace == "") comp%use_workspace = .false.
	else
	comp%workspace = ""
	end if
	end subroutine compilation_item_init

	@ %def compilation_item_init
	@ Compile the current library. The [[force]] flag has the
	effect that we first delete any previous files, as far as accessible
	by the current makefile. It also guarantees that previous files not
	accessible by a makefile will be overwritten.
	<<Compilations: compilation item: TBP>>=
	procedure :: compile => compilation_item_compile
	<<Compilations: 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
	if (comp%use_workspace) call setup_workspace (comp%workspace, os_data)
	call msg_message ("Process library '" &
	// char (comp%libname) // "': compiling ...")
	call comp%lib%configure (os_data)
	if (signal_is_pending ()) return
	call comp%lib%compute_md5sum (model)
	call comp%lib%write_makefile &
	(os_data, force, verbose=comp%verbose, workspace=comp%workspace)
	if (signal_is_pending ()) return
	if (force) then
	call comp%lib%clean &
	(os_data, distclean = .false., workspace=comp%workspace)
	if (signal_is_pending ()) return
	end if
	call comp%lib%write_driver (force, workspace=comp%workspace)
	if (signal_is_pending ()) return
	if (recompile) then
	call comp%lib%load &
	(os_data, keep_old_source = .true., workspace=comp%workspace)
	if (signal_is_pending ()) return
	end if
	call comp%lib%update_status (os_data, workspace=comp%workspace)
	end if
	end subroutine compilation_item_compile

	@ %def compilation_item_compile
	@ The workspace directory is created if it does not exist. (Applies only if
	the use has set the workspace directory.)
	<<Compilations: parameters>>=
	character(*), parameter :: ALLOWED_IN_DIRNAME = &
	"abcdefghijklmnopqrstuvwxyz&
	&ABCDEFGHIJKLMNOPQRSTUVWXYZ&
	&1234567890&
	&.,_-+="
	@ %def ALLOWED_IN_DIRNAME
	<<Compilations: procedures>>=
	subroutine setup_workspace (workspace, os_data)
	type(string_t), intent(in) :: workspace
	type(os_data_t), intent(in) :: os_data
	if (verify (workspace, ALLOWED_IN_DIRNAME) == 0) then
	call msg_message ("Compile: preparing workspace directory '" &
	// char (workspace) // "'")
	call os_system_call ("mkdir -p '" // workspace // "'")
	else
	call msg_fatal ("compile: workspace name '" &
	// char (workspace) // "' contains illegal characters")
	end if
	end subroutine setup_workspace

	@ %def setup_workspace
	@ Load the current library, just after compiling it.
	<<Compilations: compilation item: TBP>>=
	procedure :: load => compilation_item_load
	<<Compilations: 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, workspace=comp%workspace)
	end if
	end subroutine compilation_item_load

	@ %def compilation_item_load
	@ Message as a separate call:
	<<Compilations: compilation item: TBP>>=
	procedure :: success => compilation_item_success
	<<Compilations: 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.
	Optionally, we may provide a workspace directory.
	<<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, verbose)
	class(compilation_t), intent(in) :: compilation
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	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)
	if (verbose) then
	write (u, "(A)") "FCOMPILE = $(LIBTOOL) --tag=FC --mode=compile"
	write (u, "(A)") "LINK = $(LIBTOOL) --tag=FC --mode=link"
	else
	write (u, "(A)") "FCOMPILE = @$(LIBTOOL) --silent --tag=FC --mode=compile"
	write (u, "(A)") "LINK = @$(LIBTOOL) --silent --tag=FC --mode=link"
	end if
	write (u, "(A)") ""
	write (u, "(A)") "# Compile commands (default)"
	write (u, "(A)") "LTFCOMPILE = $(FCOMPILE) $(FC) -c $(FCINCL) $(FCFLAGS)"
	write (u, "(A)") ""
	write (u, "(A)") "# Default target"
	write (u, "(A)") "all: link"
	write (u, "(A)") ""
	write (u, "(A)") "# Libraries"
	do i = 1, size (compilation%lib_name)
	associate (lib_name => compilation%lib_name(i))
	write (u, "(A)") "LIBRARIES += " // char (lib_name) // ".la"
	write (u, "(A)") char (lib_name) // ".la:"
	write (u, "(A)") TAB // "$(MAKE) -f " // char (lib_name) // ".makefile"
	end associate
	end do
	write (u, "(A)") ""
	write (u, "(A)") "# Library dispatcher"
	write (u, "(A)") "DISP = $(EXE)_prclib_dispatcher"
	write (u, "(A)") "$(DISP).lo: $(DISP).f90 $(LIBRARIES)"
	if (.not. verbose) then
	write (u, "(A)") TAB // '@echo " FC " $@'
	end if
	write (u, "(A)") TAB // "$(LTFCOMPILE) $<"
	write (u, "(A)") ""
	write (u, "(A)") "# Executable"
	write (u, "(A)") "$(EXE): $(DISP).lo $(LIBRARIES)"
	if (.not. verbose) then
	write (u, "(A)") TAB // '@echo " FCLD " $@'
	end if
	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, verbose
	integer :: i
	ext_libtag = ""
	force = &
	global%var_list%get_lval (var_str ("?rebuild_library"))
	recompile = &
	global%var_list%get_lval (var_str ("?recompile_library"))
	verbose = &
	global%var_list%get_lval (var_str ("?me_verbose"))
	call compilation%init (exename, [libname])
	if (signal_is_pending ()) return
	call compilation%write_dispatcher ()
	if (signal_is_pending ()) return
	do i = 1, size (libname)
	call item%init (libname(i), global%prclib_stack, global%var_list)
	call item%compile (global%model, global%os_data, &
	force=force, recompile=recompile)
	ext_libtag = "" // item%lib%get_static_modelname (global%os_data)
	if (signal_is_pending ()) return
	call item%success ()
	end do
	call compilation%write_makefile &
	(global%os_data, ext_libtag=ext_libtag, verbose=verbose)
	if (signal_is_pending ()) return
	call compilation%make_compile (global%os_data)
	if (signal_is_pending ()) return
	call compilation%make_link (global%os_data)
	end subroutine compile_executable

	@ %def compile_executable
	@
	\subsection{Unit Tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[compilations_ut.f90]]>>=
	<<File header>>

	module compilations_ut
	use unit_tests
	use compilations_uti

	<<Standard module head>>

	<<Compilations: public test>>

	contains

	<<Compilations: test driver>>

	end module compilations_ut
	@ %def compilations_ut
	@
	<<[[compilations_uti.f90]]>>=
	<<File header>>

	module compilations_uti

	<<Use strings>>
	use io_units
	use models
	use rt_data
	use process_configurations_ut, only: prepare_test_library

	use compilations

	<<Standard module head>>

	<<Compilations: test declarations>>

	contains

	<<Compilations: tests>>

	end module compilations_uti

	@ %def compilations_uti
	@ API: driver for the unit tests below.
	<<Compilations: public test>>=
	public :: compilations_test
	<<Compilations: test driver>>=
	subroutine compilations_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Compilations: execute tests>>
	end subroutine compilations_test

	@ %def compilations_test
	@
	\subsubsection{Intrinsic Matrix Element}
	Compile an intrinsic test matrix element ([[prc_test]] type).

	Note: In this and the following test, we reset the Fortran compiler and flag
	variables immediately before they are printed, so the test is portable.
	<<Compilations: execute tests>>=
	call test (compilations_1, "compilations_1", &
	"intrinsic test processes", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_1
	<<Compilations: tests>>=
	subroutine compilations_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: compilations_1"
	write (u, "(A)") "* Purpose: configure and compile test process"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	libname = "compilation_1"
	procname = "prc_comp_1"
	call prepare_test_library (global, libname, 1, [procname])

	call compile_library (libname, global)

	call global%write_libraries (u)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: compilations_1"

	end subroutine compilations_1

	@ %def compilations_1
	@
	\subsubsection{External Matrix Element}
	Compile an external test matrix element ([[omega]] type)
	<<Compilations: execute tests>>=
	call test (compilations_2, "compilations_2", &
	"external process (omega)", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_2
	<<Compilations: tests>>=
	subroutine compilations_2 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	write (u, "(A)") "* Test output: compilations_2"
	write (u, "(A)") "* Purpose: configure and compile test process"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	libname = "compilation_2"
	procname = "prc_comp_2"
	call prepare_test_library (global, libname, 2, [procname,procname])

	call compile_library (libname, global)

	call global%write_libraries (u, libpath = .false.)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: compilations_2"

	end subroutine compilations_2

	@ %def compilations_2
	@
	\subsubsection{External Matrix Element}
	Compile an external test matrix element ([[omega]] type) and
	create driver files for a static executable.
	<<Compilations: execute tests>>=
	call test (compilations_3, "compilations_3", &
	"static executable: driver", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_3
	<<Compilations: tests>>=
	subroutine compilations_3 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname, exename
	type(rt_data_t), target :: global
	type(compilation_t) :: compilation
	integer :: u_file
	character(80) :: buffer

	write (u, "(A)") "* Test output: compilations_3"
	write (u, "(A)") "* Purpose: make static executable"
	write (u, "(A)")

	write (u, "(A)") "* Initialize library"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	libname = "compilations_3_lib"
	procname = "prc_comp_3"
	exename = "compilations_3"

	call prepare_test_library (global, libname, 2, [procname,procname])

	call compilation%init (exename, [libname])
	call compilation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write dispatcher"
	write (u, "(A)")

	call compilation%write_dispatcher ()

	u_file = free_unit ()
	open (u_file, file = char (exename) // "_prclib_dispatcher.f90", &
	status = "old", action = "read")
	do
	read (u_file, "(A)", end = 1) buffer
	write (u, "(A)") trim (buffer)
	end do
	1 close (u_file)

	write (u, "(A)")
	write (u, "(A)") "* Write Makefile"
	write (u, "(A)")

	associate (os_data => global%os_data)
	os_data%fc = "fortran-compiler"
	os_data%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, verbose = .true.)

	open (u_file, file = char (exename) // ".makefile", &
	status = "old", action = "read")
	do
	read (u_file, "(A)", end = 2) buffer
	write (u, "(A)") trim (buffer)
	end do
	2 close (u_file)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: compilations_3"

	end subroutine compilations_3

	@ %def compilations_3
	@
	\subsection{Test static build}
	The tests for building a static executable are separate, since they
	should be skipped if the \whizard\ build itself has static libraries
	disabled.
	<<Compilations: public test>>=
	public :: compilations_static_test
	<<Compilations: test driver>>=
	subroutine compilations_static_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Compilations: static tests>>
	end subroutine compilations_static_test

	@ %def compilations_static_test
	@
	\subsubsection{External Matrix Element}
	Compile an external test matrix element ([[omega]] type) and
	incorporate this in a new static WHIZARD executable.
	<<Compilations: static tests>>=
	call test (compilations_static_1, "compilations_static_1", &
	"static executable: compilation", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_static_1
	<<Compilations: tests>>=
	subroutine compilations_static_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname, exename
	type(rt_data_t), target :: global
	type(compilation_item_t) :: item
	type(compilation_t) :: compilation
	logical :: exist

	write (u, "(A)") "* Test output: compilations_static_1"
	write (u, "(A)") "* Purpose: make static executable"
	write (u, "(A)")

	write (u, "(A)") "* Initialize library"

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	libname = "compilations_static_1_lib"
	procname = "prc_comp_stat_1"
	exename = "compilations_static_1"

	call prepare_test_library (global, libname, 2, [procname,procname])

	call compilation%init (exename, [libname])

	write (u, "(A)")
	write (u, "(A)") "* Write dispatcher"

	call compilation%write_dispatcher ()

	write (u, "(A)")
	write (u, "(A)") "* Write Makefile"

	call compilation%write_makefile (global%os_data, verbose = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Build libraries"

	call item%init (libname, global%prclib_stack, global%var_list)
	call item%compile &
	(global%model, global%os_data, force=.true., recompile=.false.)
	call item%success ()

	write (u, "(A)")
	write (u, "(A)") "* Check executable (should be absent)"
	write (u, "(A)")

	call compilation%make_clean_exe (global%os_data)
	inquire (file = char (exename), exist = exist)
	write (u, "(A,A,L1)") char (exename), " exists = ", exist

	write (u, "(A)")
	write (u, "(A)") "* Build executable"
	write (u, "(A)")

	call compilation%make_compile (global%os_data)
	call compilation%make_link (global%os_data)

	write (u, "(A)") "* Check executable (should be present)"
	write (u, "(A)")

	inquire (file = char (exename), exist = exist)
	write (u, "(A,A,L1)") char (exename), " exists = ", exist

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call compilation%make_clean_exe (global%os_data)

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: compilations_static_1"

	end subroutine compilations_static_1

	@ %def compilations_static_1
	@
	\subsubsection{External Matrix Element}
	Compile an external test matrix element ([[omega]] type) and
	incorporate this in a new static WHIZARD executable. In this version,
	we use the wrapper [[compile_executable]] procedure.
	<<Compilations: static tests>>=
	call test (compilations_static_2, "compilations_static_2", &
	"static executable: shortcut", &
	u, results)
	<<Compilations: test declarations>>=
	public :: compilations_static_2
	<<Compilations: tests>>=
	subroutine compilations_static_2 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname, exename
	type(rt_data_t), target :: global
	logical :: exist
	integer :: u_file

	write (u, "(A)") "* Test output: compilations_static_2"
	write (u, "(A)") "* Purpose: make static executable"
	write (u, "(A)")

	write (u, "(A)") "* Initialize library and compile"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	libname = "compilations_static_2_lib"
	procname = "prc_comp_stat_2"
	exename = "compilations_static_2"

	call prepare_test_library (global, libname, 2, [procname,procname])

	call compile_executable (exename, [libname], global)

	write (u, "(A)") "* Check executable (should be present)"
	write (u, "(A)")

	inquire (file = char (exename), exist = exist)
	write (u, "(A,A,L1)") char (exename), " exists = ", exist

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	u_file = free_unit ()
	open (u_file, file = char (exename), status = "old", action = "write")
	close (u_file, status = "delete")

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: compilations_static_2"

	end subroutine compilations_static_2

	@ %def compilations_static_2
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Integration}
	This module manages phase space setup, matrix-element evaluation and
	integration, as far as it is not done by lower-level routines, in particular
	in the [[processes]] module.
	<<[[integrations.f90]]>>=
	<<File header>>

	module integrations

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use diagnostics
	use os_interface
	use cputime
	use sm_qcd
	use physics_defs
	use model_data
	use pdg_arrays
	use variables, only: var_list_t
	use eval_trees
	use sf_mappings
	use sf_base
	use phs_base
	use mappings
	use phs_forests, only: phs_parameters_t
	use rng_base
	use mci_base
	use process_libraries
	use prc_core
	use process_config, only: COMP_MASTER, COMP_REAL_FIN, &
	COMP_MISMATCH, COMP_PDF, COMP_REAL, COMP_SUB, COMP_VIRT, &
	COMP_REAL_SING
	use process
	use pcm_base, only: pcm_t
	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 dispatch_transforms, only: dispatch_evt_shower_hook

	use compilations, only: compile_library

	use dispatch_fks, only: dispatch_fks_s
	use blha_olp_interfaces
	use nlo_data
	<<Use mpi f08>>

	<<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, init_only)
	class(integration_t), intent(inout) :: intg
	type(rt_data_t), intent(inout), target :: local
	logical, intent(in), optional :: verbose
	logical, intent(in), optional :: init_only
	type(var_list_t), pointer :: var_list
	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, initialize_only
	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
	type(string_t) :: workspace
	integer :: i_real
	integer :: i_core
	integer :: i_core_born, i_core_real
	logical :: first_real_component, has_pdfs
	integer :: nlo_type_fetched
	class(pcm_t), pointer :: pcm => null ()
	i_real = 0
	verb = .true.; if (present (verbose)) verb = verbose
	initialize_only = .false.; if (present (init_only)) initialize_only = init_only
	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 ()

	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

	call intg%process%init_cores ()
	first_real_component = .true.

	pcm => intg%process%get_pcm_ptr ()
	pcm%has_pdfs = local%beam_structure%has_pdf ()

	do i_component = 1, n_components
	config => intg%process%get_component_def_ptr (i_component)
	nlo_type_fetched = config%get_nlo_type ()
	if (nlo_type_fetched == NLO_MISMATCH) nlo_type_fetched = NLO_SUBTRACTION
	core => intg%process%get_core_from_md5sum ( &
	intg%process%get_md5sum_constants (i_component, &
	config%get_def_type_string (), nlo_type_fetched))
	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

	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 ()

	workspace = var_list%get_sval (var_str ("$integrate_workspace"))
	if (workspace == "") then
	call intg%process%configure_phs &
	(intg%rebuild_phs, intg%ignore_phs_mismatch, &
	combined_integration = intg%combined_integration)
	else
	call intg%process%configure_phs &
	(intg%rebuild_phs, intg%ignore_phs_mismatch, &
	combined_integration = intg%combined_integration, &
	subdir = workspace)
	end if

	if (intg%process%is_nlo_calculation ()) then
	call dispatch_fks_s (fks_template, local%var_list)
	call intg%process%init_nlo_settings (var_list, fks_template)
	call intg%process%check_if_threshold_method ()
	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))
	if (var_list%get_lval (var_str ("?nlo_use_real_partition"))) then
	call intg%process%setup_real_partition &
	(var_list%get_rval (var_str ("real_partition_scale")))
	end if
	end if

	if (intg%process%needs_extra_code ()) then
	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_top_yukawa")), &
	var_list%get_sval (var_str ("$blha_ew_scheme")))
	call intg%process%init_blha_cores (blha_template, var_list)
	call intg%process%create_and_load_extra_libraries &
	(local%beam_structure, var_list, local%os_data)
	end if

	call intg%process%setup_terms (with_beams = local%beam_structure%has_polarized_beams ())

	if (verb) then
	call intg%process%write (screen = .true.)
	call intg%process%print_phs_startup_message ()
	end if

	if (intg%process_has_me) then
	if (size (sf_config) > 0) then
	call intg%process%collect_channels (phs_channel_collection)
	else if (.not. initialize_only &
	.and. 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

	subroutine setup_born_component ()
	call intg%process%init_component (i_component, &
	core%has_matrix_element (), mci_template, phs_config_template)
	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)
	call intg%process%set_component_type (i_component, COMP_VIRT)
	end subroutine setup_virtual_component

	subroutine setup_real_component ()
	logical :: use_finite_real
	use_finite_real = var_list%get_lval (var_str ("?nlo_use_real_partition"))
	if (first_real_component) then
	call dispatch_phs (phs_config_template_other, local%var_list, &
	local%os_data, intg%process_id, mapping_defs, phs_par, &
	var_str ('fks'))
	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 (use_finite_real) then
	if (first_real_component) then
	call intg%process%set_component_type (i_component, COMP_REAL_SING)
	first_real_component = .false.
	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 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

	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_call_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, init_only)
	class(integration_t), intent(out) :: intg
	type(string_t), intent(in) :: process_id
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	logical, intent(in), optional :: init_only
	logical, intent(in), optional :: local_stack
	logical :: use_local
	use_local = .false.; if (present (local_stack)) use_local = local_stack
	if (present (global)) then
	call intg%create_process (process_id, global)
	else if (use_local) then
	call intg%create_process (process_id, local)
	else
	call intg%create_process (process_id)
	end if
	call intg%init_process (local)
	call intg%setup_process (local, init_only = init_only)
	call intg%init_iteration_multipliers (local)
	end subroutine integration_init

	@ %def integration_init
	@ Do the integration for a single process, both warmup and final evaluation.
	The [[eff_reset]] flag is to suppress numerical noise in the graphical output
	of the integration history.
	<<Integrations: integration: TBP>>=
	procedure :: integrate => integration_integrate
	<<Integrations: 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)

	var_list => intg%process%get_var_list_ptr ()
	call openmp_set_num_threads_verbose &
	(var_list%get_ival (var_str ("openmp_num_threads")), &
	var_list%get_lval (var_str ("?openmp_logging")))
	pacify = var_list%get_lval (var_str ("?pacify"))

	display_summed = .true.
	n_mci = intg%process%get_n_mci ()
	if (n_mci == 1) then
	write (msg_buffer, "(A,A,A)") &
	"Starting integration for process '", &
	char (intg%process%get_id ()), "'"
	call msg_message ()
	end if

	call setup_hooks ()

	nlo_active = any (intg%process%get_component_nlo_type &
	([(i_mci, i_mci = 1, n_mci)]) /= BORN)
	do i_mci = 1, n_mci
	i_component = intg%process%get_master_component (i_mci)
	nlo_type = intg%process%get_component_nlo_type (i_component)
	if (intg%process%component_can_be_integrated (i_component)) then
	if (n_mci > 1) then
	if (nlo_active) then
	if (intg%combined_integration .and. nlo_type == BORN) then
	component_output = var_str ("Combined")
	else
	component_output = component_status (nlo_type)
	end if
	write (msg_buffer, "(A,A,A,A,A)") &
	"Starting integration for process '", &
	char (intg%process%get_id ()), "' part '", &
	char (component_output), "'"
	else
	write (msg_buffer, "(A,A,A,I0)") &
	"Starting integration for process '", &
	char (intg%process%get_id ()), "' part ", i_mci
	end if
	call msg_message ()
	end if
	n_pass = local%it_list%get_n_pass ()
	if (n_pass == 0) then
	call msg_message ("Integrate: iterations not specified, &
	&using default")
	call intg%make_iterations_list (it_list)
	n_pass = it_list%get_n_pass ()
	else
	it_list = local%it_list
	end if
	call intg%apply_call_multipliers (n_pass, i_mci, it_list)
	call msg_message ("Integrate: " // char (it_list%to_string ()))
	do pass = 1, n_pass
	call intg%evaluate (process_instance, i_mci, pass, it_list, pacify)
	if (signal_is_pending ()) return
	end do
	call intg%process%final_integration (i_mci)
	if (intg%vis_history) then
	call intg%process%display_integration_history &
	(i_mci, intg%history_filename, local%os_data, eff_reset)
	end if
	if (local%logfile == intg%log_filename) then
	if (intg%run_id /= "") then
	log_filename = intg%process_id // "." // intg%run_id // &
	".var.log"
	else
	log_filename = intg%process_id // ".var.log"
	end if
	call msg_message ("Name clash for global logfile and process log: ", &
	arr =[var_str ("\| Renaming log file from ") // local%logfile, &
	var_str ("\| to ") // log_filename // var_str (" .")])
	else
	log_filename = intg%log_filename
	end if
	call intg%process%write_logfile (i_mci, log_filename)
	end if
	end do

	if (n_mci > 1 .and. display_summed) then
	call msg_message ("Integrate: sum of all components")
	call intg%process%display_summed_results (pacify)
	end if

	call process_instance%final ()
	deallocate (process_instance)
	contains
	subroutine setup_hooks ()
	class(process_instance_hook_t), pointer :: hook
	call dispatch_evt_shower_hook (hook, var_list, process_instance)
	if (associated (hook)) then
	call process_instance%append_after_hook (hook)
	end if
	end subroutine setup_hooks
	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
	<<Integrations: integrate process: variables>>
	<<Integrations: integrate process: init>>
	if (.not. associated (local%prclib)) then
	call msg_fatal ("Integrate: current process library is undefined")
	return
	end if

	if (.not. local%prclib%is_active ()) then
	call msg_message ("Integrate: current process library needs compilation")
	prclib_name = local%prclib%get_name ()
	call compile_library (prclib_name, local)
	if (signal_is_pending ()) return
	call msg_message ("Integrate: compilation done")
	end if

	call intg%init (process_id, local, global, local_stack, init_only)
	if (signal_is_pending ()) return

	if (present (init_only)) then
	if (init_only) return
	end if

	if (intg%n_calls_test > 0) then
	write (buffer, "(I0)") intg%n_calls_test
	call msg_message ("Integrate: test (" // trim (buffer) // " calls) ...")
	call intg%sampler_test ()
	call msg_message ("Integrate: ... test complete.")
	if (signal_is_pending ()) return
	end if
	<<Integrations: integrate process: end init>>

	if (intg%phs_only) then
	call msg_message ("Integrate: phase space only, skipping integration")
	else
	if (intg%process_has_me) then
	call intg%integrate (local, eff_reset)
	else
	call intg%integrate_dummy ()
	end if
	end if
	end subroutine integrate_process

	@ %def integrate_process
	<<Integrations: integrate process: variables>>=
	@
	<<Integrations: integrate process: init>>=
	@
	<<Integrations: integrate process: end init>>=
	@
	@ The parallelization leads to undefined behavior while writing simultaneously to one file.
	The master worker has to initialize single-handed the corresponding library files and the phase space file.
	The slave worker will wait with a blocking [[MPI_BCAST]] until they receive a logical flag.
	<<MPI: Integrations: integrate process: variables>>=
	type(var_list_t), pointer :: var_list
	logical :: mpi_logging, process_init
	integer :: rank, n_size
	<<MPI: Integrations: integrate process: init>>=
	call msg_debug (D_MPI, "integrate_process")
	var_list => local%get_var_list_ptr ()
	process_init = .false.
	call mpi_get_comm_id (n_size, rank)
	mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) .and. &
	& (n_size > 1)) .or. var_list%get_lval (var_str ("?mpi_logging")))
	call msg_debug (D_MPI, "n_size", rank)
	call msg_debug (D_MPI, "rank", rank)
	call msg_debug (D_MPI, "mpi_logging", mpi_logging)
	if (rank /= 0) then
	if (mpi_logging) then
	call msg_message ("MPI: wait for master to finish process initialization ...")
	end if
	call MPI_bcast (process_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
	else
	process_init = .true.
	end if

	if (process_init) then
	<<MPI: Integrations: integrate process: end init>>=
	if (rank == 0) then
	if (mpi_logging) then
	call msg_message ("MPI: finish process initialization, load slaves ...")
	end if
	call MPI_bcast (process_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
	end if
	end if
	call MPI_barrier (MPI_COMM_WORLD)
	call mpi_set_logging (mpi_logging)
	@ %def integrate_process_mpi
	@
	\subsection{Unit Tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[integrations_ut.f90]]>>=
	<<File header>>

	module integrations_ut
	use unit_tests
	use integrations_uti

	<<Standard module head>>

	<<Integrations: public test>>

	contains

	<<Integrations: test driver>>

	end module integrations_ut
	@ %def integrations_ut
	@
	<<[[integrations_uti.f90]]>>=
	<<File header>>

	module integrations_uti

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use ifiles
	use lexers
	use parser
	use 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 // ".r1.i1.phs"
	inquire (file = char (phs_file), exist = exist)
	if (exist) then
	u_phs = free_unit ()
	open (u_phs, file = char (phs_file), action = "read", status = "old")
	iostat = 0
	do while (iostat == 0)
	read (u_phs, "(A)", iostat = iostat) buffer
	if (iostat == 0) write (u, "(A)") trim (buffer)
	end do
	close (u_phs)
	else
	write (u, "(A)") "[file is missing]"
	end if

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_7"

	end subroutine integrations_7

	@ %def integrations_7
	@
	\subsubsection{Structure functions}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type) using the default ([[phs_wood]]) phase-space
	implementation. The integration method is [[vamp]]. There is a structure
	function of type [[unit_test]].

	We use a test structure function $f(x)=x$ for both beams. Together with the
	$1/x_1x_2$ factor from the phase-space flux and a unit matrix element, we
	should get the same result as previously for the process without structure
	functions. There is a slight correction due to the $m_s$ mass which we set to
	zero here.
	<<Integrations: execute tests>>=
	call test (integrations_8, "integrations_8", &
	"integration with structure function", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_8
	<<Integrations: tests>>=
	subroutine integrations_8 (u)
	<<Use kinds>>
	<<Use strings>>
	use interactions, only: reset_interaction_counter
	use phs_forests
	use models
	use rt_data
	use process_configurations_ut, only: prepare_test_library
	use compilations, only: compile_library
	use integrations

	implicit none

	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global
	type(flavor_t) :: flv
	type(string_t) :: name

	write (u, "(A)") "* Test output: integrations_8"
	write (u, "(A)") "* Purpose: integrate test process using VAMP &
	&with structure function"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()

	libname = "integrations_8_lib"
	procname = "integrations_8"

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?phs_s_mapping"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%model_set_real (var_str ("ms"), 0._default)

	call reset_interaction_counter ()

	call flv%init (25, global%model)

	name = flv%get_name ()
	call global%beam_structure%init_sf ([name, name], [1])
	call global%beam_structure%set_sf (1, 1, var_str ("sf_test_1"))

	write (u, "(A)") "* Integrate"
	write (u, "(A)")

	call global%it_list%init ([1], [1000])
	call integrate_process (procname, global, local_stack=.true.)

	call global%write (u, vars = [var_str ("ms")])

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_8"

	end subroutine integrations_8

	@ %def integrations_8
	@
	\subsubsection{Integration with sign change}
	Compile and integrate an intrinsic test matrix element ([[prc_test]]
	type). The phase-space implementation is [[phs_single]]
	(single-particle phase space), the integrator is [[mci_midpoint]].
	The weight that is applied changes the sign in half of phase space.
	The weight is $-3$ and $1$, respectively, so the total result is equal
	to the original, but negative sign.

	The efficiency should (approximately) become the average of $1$ and
	$1/3$, that is $2/3$.
	<<Integrations: execute tests>>=
	call test (integrations_9, "integrations_9", &
	"handle sign change", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_9
	<<Integrations: tests>>=
	subroutine integrations_9 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global

	type(string_t) :: wgt_expr_text
	type(ifile_t) :: ifile
	type(stream_t) :: stream
	type(parse_tree_t) :: parse_tree

	write (u, "(A)") "* Test output: integrations_9"
	write (u, "(A)") "* Purpose: integrate test process"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()

	write (u, "(A)") "* Prepare a weight expression"
	write (u, "(A)")

	call syntax_pexpr_init ()
	wgt_expr_text = "eval 2 * sgn (Pz) - 1 [s]"
	call ifile_append (ifile, wgt_expr_text)
	call stream_init (stream, ifile)
	call parse_tree_init_expr (parse_tree, stream, .true.)
	global%pn%weight_expr => parse_tree%get_root_ptr ()

	write (u, "(A)") "* Build and evaluate a test process"
	write (u, "(A)")

	libname = "integration_9"
	procname = "prc_config_a"

	call prepare_test_library (global, libname, 1)
	call compile_library (libname, global)

	call global%set_string (var_str ("$run_id"), &
	var_str ("integrations1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true.)

	call global%write (u, vars = [ &
	var_str ("$method"), &
	var_str ("sqrts"), &
	var_str ("$integration_method"), &
	var_str ("$phs_method"), &
	var_str ("$run_id")])

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_9"

	end subroutine integrations_9

	@ %def integrations_9
	@
	\subsubsection{Integration history for VAMP integration with default
	phase space}
	This test is only run when event analysis can be done.
	<<Integrations: execute history tests>>=
	call test (integrations_history_1, "integrations_history_1", &
	"Test integration history files", &
	u, results)
	<<Integrations: test declarations>>=
	public :: integrations_history_1
	<<Integrations: tests>>=
	subroutine integrations_history_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname
	type(rt_data_t), target :: global
	type(string_t), dimension(0) :: no_vars
	integer :: iostat, u_his
	character(91) :: buffer
	type(string_t) :: his_file, ps_file, pdf_file
	logical :: exist, exist_ps, exist_pdf

	write (u, "(A)") "* Test output: integrations_history_1"
	write (u, "(A)") "* Purpose: test integration history files"
	write (u, "(A)")

	write (u, "(A)") "* Initialize process and parameters"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()

	libname = "integrations_history_1_lib"
	procname = "integrations_history_1"

	call global%set_log (var_str ("?vis_history"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?phs_s_mapping"),&
	.false., is_known = .true.)

	call prepare_test_library (global, libname, 1, [procname])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$run_id"), &
	var_str ("r1"), is_known = .true.)
	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("wood"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("vamp"), is_known = .true.)
	call global%set_log (var_str ("?use_vamp_equivalences"),&
	.true., is_known = .true.)
	call global%set_real (var_str ("error_threshold"),&
	5E-6_default, is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known=.true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([2, 2, 2], [1000, 1000, 1000], &
	adapt = [.true., .true., .false.], &
	adapt_code = [var_str ("wg"), var_str ("g"), var_str ("")])

	write (u, "(A)") "* Integrate"
	write (u, "(A)")

	call reset_interaction_counter ()
	call integrate_process (procname, global, local_stack=.true., &
	eff_reset = .true.)

	call global%pacify (efficiency_reset = .true., error_reset = .true.)
	call global%write (u, vars = no_vars, pacify = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Generated history files"
	write (u, "(A)")

	his_file = procname // ".r1.history.tex"
	ps_file = procname // ".r1.history.ps"
	pdf_file = procname // ".r1.history.pdf"
	inquire (file = char (his_file), exist = exist)
	if (exist) then
	u_his = free_unit ()
	open (u_his, file = char (his_file), action = "read", status = "old")
	iostat = 0
	do while (iostat == 0)
	read (u_his, "(A)", iostat = iostat) buffer
	if (iostat == 0) write (u, "(A)") trim (buffer)
	end do
	close (u_his)
	else
	write (u, "(A)") "[History LaTeX file is missing]"
	end if
	inquire (file = char (ps_file), exist = exist_ps)
	if (exist_ps) then
	write (u, "(A)") "[History Postscript file exists and is nonempty]"
	else
	write (u, "(A)") "[History Postscript file is missing/non-regular]"
	end if
	inquire (file = char (pdf_file), exist = exist_pdf)
	if (exist_pdf) then
	write (u, "(A)") "[History PDF file exists and is nonempty]"
	else
	write (u, "(A)") "[History PDF file is missing/non-regular]"
	end if

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: integrations_history_1"

	end subroutine integrations_history_1

	@ %def integrations_history_1
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Event Streams}
	This module manages I/O from/to multiple concurrent event streams.
	Usually, there is at most one input stream, but several output
	streams. For the latter, we set up an array which can hold [[eio_t]]
	(event I/O) objects of different dynamic types simultaneously. One of
	them may be marked as an input channel.
	<<[[event_streams.f90]]>>=
	<<File header>>

	module event_streams

	<<Use strings>>
	use 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) then
	if (mod (event_index, eio%split_n_evt) == 1) then
	call eio%split_out ()
	end if
	else if (eio%split_n_kbytes > 0) then
	call eio%update_split_count (increased)
	if (increased) call eio%split_out ()
	end if
	end if
	call eio%output (event, i_prc, reading = es_array%i_in /= 0, &
	passed = passed, &
	pacify = pacify)
	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%set_index (42)
	call event%evaluate_expressions ()
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Allocate raw eio stream and write event to file"
	write (u, "(A)")

	sample = "event_streams_2"

	call es_array%init (sample, [var_str ("raw")], global)
	call es_array%output (event, 1, 1)
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Reallocate raw eio stream for reading"
	write (u, "(A)")

	sample = "foo"
	call es_array%init (sample, empty_string_array, global, &
	input = var_str ("raw"), input_sample = var_str ("event_streams_2"))
	call es_array%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reread event"
	write (u, "(A)")

	call es_array%input_i_prc (i_prc, iostat)

	write (u, "(1x,A,I0)") "i_prc = ", i_prc
	write (u, "(A)")
	call es_array%input_event (event, iostat)
	call es_array%final ()

	call event%write (u)

	call global%final ()

	call model%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: event_streams_2"

	end subroutine event_streams_2

	@ %def event_streams_2
	@
	\subsubsection{Switch in/out}
	Here we generate an event file and test switching from writing to
	reading when the file is exhausted.
	<<Event streams: execute tests>>=
	call test (event_streams_3, "event_streams_3", &
	"switch input/output", &
	u, results)
	<<Event streams: test declarations>>=
	public :: event_streams_3
	<<Event streams: tests>>=
	subroutine event_streams_3 (u)
	use processes_ut, only: prepare_test_process
	integer, intent(in) :: u
	type(event_stream_array_t) :: es_array
	type(rt_data_t) :: global
	type(model_data_t), target :: model
	type(event_t), allocatable, target :: event
	type(process_t), allocatable, target :: process
	type(process_instance_t), allocatable, target :: process_instance
	type(string_t) :: sample
	type(string_t), dimension(0) :: empty_string_array
	integer :: i_prc, iostat

	write (u, "(A)") "* Test output: event_streams_3"
	write (u, "(A)") "* Purpose: handle in/out switching"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call model%init_test ()

	write (u, "(A)") "* Generate test process event"
	write (u, "(A)")

	allocate (process)
	allocate (process_instance)
	call prepare_test_process (process, process_instance, model)
	call process_instance%setup_event_data ()

	allocate (event)
	call event%basic_init ()
	call event%connect (process_instance, process%get_model_ptr ())
	call event%generate (1, [0.4_default, 0.4_default])
	call event%increment_index ()
	call event%evaluate_expressions ()

	write (u, "(A)") "* Allocate raw eio stream and write event to file"
	write (u, "(A)")

	sample = "event_streams_3"

	call es_array%init (sample, [var_str ("raw")], global)
	call es_array%output (event, 1, 1)
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Reallocate raw eio stream for reading"
	write (u, "(A)")

	call es_array%init (sample, empty_string_array, global, &
	input = var_str ("raw"))
	call es_array%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reread event"
	write (u, "(A)")

	call es_array%input_i_prc (i_prc, iostat)
	call es_array%input_event (event, iostat)

	write (u, "(A)") "* Attempt to read another event (fail), then generate"
	write (u, "(A)")

	call es_array%input_i_prc (i_prc, iostat)
	if (iostat < 0) then
	call es_array%switch_inout ()
	call event%generate (1, [0.3_default, 0.3_default])
	call event%increment_index ()
	call event%evaluate_expressions ()
	call es_array%output (event, 1, 2)
	end if
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reallocate raw eio stream for reading"
	write (u, "(A)")

	call es_array%init (sample, empty_string_array, global, &
	input = var_str ("raw"))
	call es_array%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Reread two events and display 2nd event"
	write (u, "(A)")

	call es_array%input_i_prc (i_prc, iostat)
	call es_array%input_event (event, iostat)
	call es_array%input_i_prc (i_prc, iostat)

	call es_array%input_event (event, iostat)
	call es_array%final ()

	call event%write (u)

	call global%final ()

	call model%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: event_streams_3"

	end subroutine event_streams_3

	@ %def event_streams_3
	@
	\subsubsection{Checksum}
	Here we generate an event file and repeat twice, once with identical
	parameters and once with modified parameters.
	<<Event streams: execute tests>>=
	call test (event_streams_4, "event_streams_4", &
	"check MD5 sum", &
	u, results)
	<<Event streams: test declarations>>=
	public :: event_streams_4
	<<Event streams: tests>>=
	subroutine event_streams_4 (u)
	integer, intent(in) :: u
	type(event_stream_array_t) :: es_array
	type(rt_data_t) :: global
	type(process_t), allocatable, target :: process
	type(string_t) :: sample
	type(string_t), dimension(0) :: empty_string_array
	type(event_sample_data_t) :: data

	write (u, "(A)") "* Test output: event_streams_4"
	write (u, "(A)") "* Purpose: handle in/out switching"
	write (u, "(A)")

	write (u, "(A)") "* Generate test process event"
	write (u, "(A)")

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%set_log (var_str ("?check_event_file"), &
	.true., is_known = .true.)

	allocate (process)

	write (u, "(A)") "* Allocate raw eio stream for writing"
	write (u, "(A)")

	sample = "event_streams_4"
	data%md5sum_cfg = "1234567890abcdef1234567890abcdef"

	call es_array%init (sample, [var_str ("raw")], global, data)
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Reallocate raw eio stream for reading"
	write (u, "(A)")

	call es_array%init (sample, empty_string_array, global, &
	data, input = var_str ("raw"))
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Reallocate modified raw eio stream for reading (fail)"
	write (u, "(A)")

	data%md5sum_cfg = "1234567890______1234567890______"
	call es_array%init (sample, empty_string_array, global, &
	data, input = var_str ("raw"))
	call es_array%write (u)
	call es_array%final ()

	write (u, "(A)")
	write (u, "(A)") "* Repeat ignoring checksum"
	write (u, "(A)")

	call global%set_log (var_str ("?check_event_file"), &
	.false., is_known = .true.)
	call es_array%init (sample, empty_string_array, global, &
	data, input = var_str ("raw"))
	call es_array%write (u)
	call es_array%final ()

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: event_streams_4"

	end subroutine event_streams_4

	@ %def event_streams_4
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Restricted Subprocesses}
	This module provides an automatic means to construct restricted subprocesses
	of a current process object. A restricted subprocess has the same initial and
	final state as the current process, but a restricted set of Feynman graphs.

	The actual application extracts the set of resonance histories that apply to
	the process and uses this to construct subprocesses that are restricted to one
	of those histories, respectively. The resonance histories are derived from
	the phase-space setup. This implies that the method is tied to the OMega
	matrix element generator and to the wood phase space method.

	The processes are collected in a new process library that is generated
	on-the-fly.

	The [[resonant_subprocess_t]] object is intended as a component of the event
	record, which manages all operations regarding resonance handling.

	The run-time calculations are delegated to an event transform
	([[evt_resonance_t]]), as a part of the event transform chain. The transform
	selects one (or none) of the resonance histories, given the momentum
	configuration, computes matrix elements and inserts resonances into the
	particle set.
	<<[[restricted_subprocesses.f90]]>>=
	<<File header>>

	module restricted_subprocesses

	<<Use kinds>>
	<<Use strings>>
	use diagnostics, only: msg_message, msg_fatal, msg_bug
	use diagnostics, only: signal_is_pending
	use io_units, only: given_output_unit
	use format_defs, only: FMT_14, FMT_19
	use string_utils, only: str
	use lorentz, only: vector4_t
	use particle_specifiers, only: prt_spec_t
	use particles, only: particle_set_t
	use resonances, only: resonance_history_t, resonance_history_set_t
	use variables, only: var_list_t
	use models, only: model_t
	use process_libraries, only: process_component_def_t
	use process_libraries, only: process_library_t
	use process_libraries, only: STAT_ACTIVE
	use prclib_stacks, only: prclib_entry_t
	use event_transforms, only: evt_t
	use resonance_insertion, only: evt_resonance_t
	use rt_data, only: rt_data_t
	use compilations, only: compile_library
	use process_configurations, only: process_configuration_t
	use process, only: process_t, process_ptr_t
	use instances, only: process_instance_t, process_instance_ptr_t
	use integrations, only: integrate_process

	<<Use mpi f08>>

	<<Standard module head>>

	<<Restricted subprocesses: public>>

	<<Restricted subprocesses: types>>

	<<Restricted subprocesses: interfaces>>

	contains

	<<Restricted subprocesses: procedures>>

	end module restricted_subprocesses
	@ %def restricted_subprocesses
	@
	\subsection{Process configuration}
	We extend the [[process_configuration_t]] by another method for initialization
	that takes into account a resonance history.
	<<Restricted subprocesses: public>>=
	public :: restricted_process_configuration_t
	<<Restricted subprocesses: types>>=
	type, extends (process_configuration_t) :: restricted_process_configuration_t
	private
	contains
	<<Restricted subprocesses: restricted process configuration: TBP>>
	end type restricted_process_configuration_t

	@ %def restricted_process_configuration_t
	@
	Resonance history as an argument. We use it to override the [[restrictions]]
	setting in a local variable list. Since we can construct the restricted
	process only by using OMega, we enforce it as the ME method. Other settings
	are taken from the variable list. The model will most likely be set, but we
	insert a safeguard just in case.

	Also, the resonant subprocess should not itself spawn resonant
	subprocesses, so we unset [[?resonance_history]].

	We have to create a local copy of the model here, via pointer
	allocation. The reason is that the model as stored (via pointer) in
	the base type will be finalized and deallocated.

	The current implementation will generate a LO process, the optional
	[[nlo_process]] is unset. (It is not obvious
	whether the construction makes sense beyond LO.)
	<<Restricted subprocesses: restricted process configuration: TBP>>=
	procedure :: init_resonant_process
	<<Restricted subprocesses: procedures>>=
	subroutine init_resonant_process &
	(prc_config, prc_name, prt_in, prt_out, res_history, model, var_list)
	class(restricted_process_configuration_t), intent(out) :: prc_config
	type(string_t), intent(in) :: prc_name
	type(prt_spec_t), dimension(:), intent(in) :: prt_in
	type(prt_spec_t), dimension(:), intent(in) :: prt_out
	type(resonance_history_t), intent(in) :: res_history
	type(model_t), intent(in), target :: model
	type(var_list_t), intent(in), target :: var_list
	type(model_t), pointer :: local_model
	type(var_list_t) :: local_var_list
	allocate (local_model)
	call local_model%init_instance (model)
	call local_var_list%link (var_list)
	call local_var_list%append_string (var_str ("$model_name"), &
	sval = local_model%get_name (), &
	intrinsic=.true.)
	call local_var_list%append_string (var_str ("$method"), &
	sval = var_str ("omega"), &
	intrinsic=.true.)
	call local_var_list%append_string (var_str ("$restrictions"), &
	sval = res_history%as_omega_string (size (prt_in)), &
	intrinsic = .true.)
	call local_var_list%append_log (var_str ("?resonance_history"), &
	lval = .false., &
	intrinsic = .true.)
	call prc_config%init (prc_name, size (prt_in), 1, &
	local_model, local_var_list)
	call prc_config%setup_component (1, &
	prt_in, prt_out, &
	local_model, local_var_list)
	end subroutine init_resonant_process

	@ %def init_resonant_process
	@
	\subsection{Resonant-subprocess set manager}
	This data type enables generation of a library of resonant subprocesses for a
	given master process, and it allows for convenient access. The matrix
	elements from the subprocesses can be used as channel weights to activate a
	selector, which then returns a preferred channel via some random number
	generator.
	<<Restricted subprocesses: public>>=
	public :: resonant_subprocess_set_t
	<<Restricted subprocesses: types>>=
	type :: resonant_subprocess_set_t
	private
	integer, dimension(:), allocatable :: n_history
	type(resonance_history_set_t), dimension(:), allocatable :: res_history_set
	logical :: lib_active = .false.
	type(string_t) :: libname
	type(string_t), dimension(:), allocatable :: proc_id
	type(process_ptr_t), dimension(:), allocatable :: subprocess
	type(process_instance_ptr_t), dimension(:), allocatable :: instance
	logical :: filled = .false.
	type(evt_resonance_t), pointer :: evt => null ()
	contains
	<<Restricted subprocesses: resonant subprocess set: TBP>>
	end type resonant_subprocess_set_t

	@ %def resonant_subprocess_set_t
	@ Output
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: write => resonant_subprocess_set_write
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_write (prc_set, unit, testflag)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	logical :: truncate
	integer :: u, i
	u = given_output_unit (unit)
	truncate = .false.; if (present (testflag)) truncate = testflag
	write (u, "(1x,A)") "Resonant subprocess set:"
	if (allocated (prc_set%n_history)) then
	if (any (prc_set%n_history > 0)) then
	do i = 1, size (prc_set%n_history)
	if (prc_set%n_history(i) > 0) then
	write (u, "(1x,A,I0)") "Component #", i
	call prc_set%res_history_set(i)%write (u, indent=1)
	end if
	end do
	if (prc_set%lib_active) then
	write (u, "(3x,A,A,A)") "Process library = '", &
	char (prc_set%libname), "'"
	else
	write (u, "(3x,A)") "Process library: [inactive]"
	end if
	if (associated (prc_set%evt)) then
	if (truncate) then
	write (u, "(3x,A,1x," // FMT_14 // ")") &
	"Process sqme =", prc_set%get_master_sqme ()
	else
	write (u, "(3x,A,1x," // FMT_19 // ")") &
	"Process sqme =", prc_set%get_master_sqme ()
	end if
	end if
	if (associated (prc_set%evt)) then
	write (u, "(3x,A)") "Event transform: associated"
	write (u, "(2x)", advance="no")
	call prc_set%evt%write_selector (u, testflag)
	else
	write (u, "(3x,A)") "Event transform: not associated"
	end if
	else
	write (u, "(2x,A)") "[empty]"
	end if
	else
	write (u, "(3x,A)") "[not allocated]"
	end if
	end subroutine resonant_subprocess_set_write

	@ %def resonant_subprocess_set_write
	@
	\subsection{Resonance history set}
	Initialize subprocess set with an array of pre-created resonance
	history sets.

	Safeguard: if there are no resonances in the input, initialize the local set
	as empty, but complete.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: init => resonant_subprocess_set_init
	procedure :: fill_resonances => resonant_subprocess_set_fill_resonances
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_init (prc_set, n_component)
	class(resonant_subprocess_set_t), intent(out) :: prc_set
	integer, intent(in) :: n_component
	allocate (prc_set%res_history_set (n_component))
	allocate (prc_set%n_history (n_component), source = 0)
	end subroutine resonant_subprocess_set_init

	subroutine resonant_subprocess_set_fill_resonances (prc_set, &
	res_history_set, i_component)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(resonance_history_set_t), intent(in) :: res_history_set
	integer, intent(in) :: i_component
	prc_set%n_history(i_component) = res_history_set%get_n_history ()
	if (prc_set%n_history(i_component) > 0) then
	prc_set%res_history_set(i_component) = res_history_set
	else
	call prc_set%res_history_set(i_component)%init (initial_size = 0)
	call prc_set%res_history_set(i_component)%freeze ()
	end if
	end subroutine resonant_subprocess_set_fill_resonances

	@ %def resonant_subprocess_set_init
	@ %def resonant_subprocess_set_fill_resonances
	@ Return the resonance history set.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: get_resonance_history_set &
	=> resonant_subprocess_set_get_resonance_history_set
	<<Restricted subprocesses: procedures>>=
	function resonant_subprocess_set_get_resonance_history_set (prc_set) &
	result (res_history_set)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	type(resonance_history_set_t), dimension(:), allocatable :: res_history_set
	res_history_set = prc_set%res_history_set
	end function resonant_subprocess_set_get_resonance_history_set

	@ %def resonant_subprocess_set_get_resonance_history_set
	@
	\subsection{Library for the resonance history set}
	The recommended library name: append [[_R]] to the process name.
	<<Restricted subprocesses: public>>=
	public :: get_libname_res
	<<Restricted subprocesses: procedures>>=
	elemental function get_libname_res (proc_id) result (libname)
	type(string_t), intent(in) :: proc_id
	type(string_t) :: libname
	libname = proc_id // "_R"
	end function get_libname_res

	@ %def get_libname_res
	@ Here we scan the global process library whether any
	processes require resonant subprocesses to be constructed. If yes,
	create process objects with phase space and construct the process
	libraries as usual. Then append the library names to the array.

	The temporary integration objects should carry the [[phs_only]]
	flag. We set this in the local environment.

	Once a process object with resonance histories (derived from phase
	space) has been created, we extract the resonance histories and use
	them, together with the process definition, to create the new library.

	Finally, compile the library.
	<<Restricted subprocesses: public>>=
	public :: spawn_resonant_subprocess_libraries
	<<Restricted subprocesses: procedures>>=
	subroutine spawn_resonant_subprocess_libraries &
	(libname, local, global, libname_res)
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), target :: global
	type(string_t), dimension(:), allocatable, intent(inout) :: libname_res
	type(process_library_t), pointer :: lib
	type(string_t), dimension(:), allocatable :: process_id_res
	type(process_t), pointer :: process
	type(resonance_history_set_t) :: res_history_set
	type(process_component_def_t), pointer :: process_component_def
	logical :: phs_only_saved, exist
	integer :: i_proc, i_component
	lib => global%prclib_stack%get_library_ptr (libname)
	call lib%get_process_id_req_resonant (process_id_res)
	if (size (process_id_res) > 0) then
	call msg_message ("Creating resonant-subprocess libraries &
	&for library '" // char (libname) // "'")
	libname_res = get_libname_res (process_id_res)
	phs_only_saved = local%var_list%get_lval (var_str ("?phs_only"))
	call local%var_list%set_log &
	(var_str ("?phs_only"), .true., is_known=.true.)
	do i_proc = 1, size (process_id_res)
	associate (proc_id => process_id_res (i_proc))
	call msg_message ("Process '" // char (proc_id) // "': &
	&constructing phase space for resonance structure")
	call integrate_process (proc_id, local, global)
	process => global%process_stack%get_process_ptr (proc_id)
	call create_library (libname_res(i_proc), global, exist)
	if (.not. exist) then
	do i_component = 1, process%get_n_components ()
	call process%extract_resonance_history_set &
	(res_history_set, i_component = i_component)
	process_component_def &
	=> process%get_component_def_ptr (i_component)
	call add_to_library (libname_res(i_proc), &
	res_history_set, &
	process_component_def%get_prt_spec_in (), &
	process_component_def%get_prt_spec_out (), &
	global)
	end do
	call msg_message ("Process library '" &
	// char (libname_res(i_proc)) &
	// "': created")
	end if
	call global%update_prclib (lib)
	end associate
	end do
	call local%var_list%set_log &
	(var_str ("?phs_only"), phs_only_saved, is_known=.true.)
	end if
	end subroutine spawn_resonant_subprocess_libraries

	@ %def spawn_resonant_subprocess_libraries
	@ This is another version of the library constructor, bound to a
	restricted-subprocess set object. Create the appropriate
	process library, add processes, and close the library.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: create_library => resonant_subprocess_set_create_library
	procedure :: add_to_library => resonant_subprocess_set_add_to_library
	procedure :: freeze_library => resonant_subprocess_set_freeze_library
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_create_library (prc_set, &
	libname, global, exist)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: global
	logical, intent(out) :: exist
	prc_set%libname = libname
	call create_library (prc_set%libname, global, exist)
	end subroutine resonant_subprocess_set_create_library

	subroutine resonant_subprocess_set_add_to_library (prc_set, &
	i_component, prt_in, prt_out, global)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	integer, intent(in) :: i_component
	type(prt_spec_t), dimension(:), intent(in) :: prt_in
	type(prt_spec_t), dimension(:), intent(in) :: prt_out
	type(rt_data_t), intent(inout), target :: global
	call add_to_library (prc_set%libname, &
	prc_set%res_history_set(i_component), &
	prt_in, prt_out, global)
	end subroutine resonant_subprocess_set_add_to_library

	subroutine resonant_subprocess_set_freeze_library (prc_set, global)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(rt_data_t), intent(inout), target :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	lib => global%prclib_stack%get_library_ptr (prc_set%libname)
	call lib%get_process_id_list (prc_set%proc_id)
	prc_set%lib_active = .true.
	end subroutine resonant_subprocess_set_freeze_library

	@ %def resonant_subprocess_set_create_library
	@ %def resonant_subprocess_set_add_to_library
	@ %def resonant_subprocess_set_freeze_library
	@ The common parts of the procedures above: (i) create a new process
	library or recover it, (ii) for each history, create a
	process configuration and record it.
	<<Restricted subprocesses: procedures>>=
	subroutine create_library (libname, global, exist)
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: global
	logical, intent(out) :: exist
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	type(resonance_history_t) :: res_history
	type(string_t), dimension(:), allocatable :: proc_id
	type(restricted_process_configuration_t) :: prc_config
	integer :: i
	lib => global%prclib_stack%get_library_ptr (libname)
	exist = associated (lib)
	if (.not. exist) then
	call msg_message ("Creating library for resonant subprocesses '" &
	// char (libname) // "'")
	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)
	else
	call msg_message ("Using library for resonant subprocesses '" &
	// char (libname) // "'")
	call global%update_prclib (lib)
	end if
	end subroutine create_library

	subroutine add_to_library (libname, res_history_set, prt_in, prt_out, global)
	type(string_t), intent(in) :: libname
	type(resonance_history_set_t), intent(in) :: res_history_set
	type(prt_spec_t), dimension(:), intent(in) :: prt_in
	type(prt_spec_t), dimension(:), intent(in) :: prt_out
	type(rt_data_t), intent(inout), target :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	type(resonance_history_t) :: res_history
	type(string_t), dimension(:), allocatable :: proc_id
	type(restricted_process_configuration_t) :: prc_config
	integer :: n0, i
	lib => global%prclib_stack%get_library_ptr (libname)
	if (associated (lib)) then
	n0 = lib%get_n_processes ()
	allocate (proc_id (res_history_set%get_n_history ()))
	do i = 1, size (proc_id)
	proc_id(i) = libname // str (n0 + i)
	res_history = res_history_set%get_history(i)
	call prc_config%init_resonant_process (proc_id(i), &
	prt_in, prt_out, &
	res_history, &
	global%model, global%var_list)
	call msg_message ("Resonant subprocess #" &
	// char (str(n0+i)) // ": " &
	// char (res_history%as_omega_string (size (prt_in))))
	call prc_config%record (global)
	if (signal_is_pending ()) return
	end do
	else
	call msg_bug ("Adding subprocesses: library '" &
	// char (libname) // "' not found")
	end if
	end subroutine add_to_library

	@ %def create_library
	@ %def add_to_library
	@ Compile the generated library, required settings taken from the
	[[global]] data set.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: compile_library => resonant_subprocess_set_compile_library
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_compile_library (prc_set, global)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	type(rt_data_t), intent(inout), target :: global
	type(process_library_t), pointer :: lib
	lib => global%prclib_stack%get_library_ptr (prc_set%libname)
	if (lib%get_status () < STAT_ACTIVE) then
	call compile_library (prc_set%libname, global)
	end if
	end subroutine resonant_subprocess_set_compile_library

	@ %def resonant_subprocess_set_compile_library
	@ Check if the library has been created / the process has been evaluated.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: is_active => resonant_subprocess_set_is_active
	<<Restricted subprocesses: procedures>>=
	function resonant_subprocess_set_is_active (prc_set) result (flag)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	logical :: flag
	flag = prc_set%lib_active
	end function resonant_subprocess_set_is_active

	@ %def resonant_subprocess_set_is_active
	@ Return number of generated process objects, library, and process IDs.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: get_n_process => resonant_subprocess_set_get_n_process
	procedure :: get_libname => resonant_subprocess_set_get_libname
	procedure :: get_proc_id => resonant_subprocess_set_get_proc_id
	<<Restricted subprocesses: procedures>>=
	function resonant_subprocess_set_get_n_process (prc_set) result (n)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	integer :: n
	if (prc_set%lib_active) then
	n = size (prc_set%proc_id)
	else
	n = 0
	end if
	end function resonant_subprocess_set_get_n_process

	function resonant_subprocess_set_get_libname (prc_set) result (libname)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	type(string_t) :: libname
	if (prc_set%lib_active) then
	libname = prc_set%libname
	else
	libname = ""
	end if
	end function resonant_subprocess_set_get_libname

	function resonant_subprocess_set_get_proc_id (prc_set, i) result (proc_id)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	integer, intent(in) :: i
	type(string_t) :: proc_id
	if (allocated (prc_set%proc_id)) then
	proc_id = prc_set%proc_id(i)
	else
	proc_id = ""
	end if
	end function resonant_subprocess_set_get_proc_id

	@ %def resonant_subprocess_set_get_n_process
	@ %def resonant_subprocess_set_get_libname
	@ %def resonant_subprocess_set_get_proc_id
	@
	\subsection{Process objects and instances}
	Prepare process objects for all entries in the resonant-subprocesses
	library. The process objects are appended to the global process
	stack. A local environment can be used where we place temporary
	variable settings that affect process-object generation. We
	initialize the processes, such that we can evaluate matrix elements,
	but we do not need to integrate them.

	The internal procedure [[prepare_process]] is an abridged version of
	the procedure with this name in the [[simulations]] module.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: prepare_process_objects &
	=> resonant_subprocess_set_prepare_process_objects
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_prepare_process_objects &
	(prc_set, local, global)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	type(rt_data_t), pointer :: current
	type(process_library_t), pointer :: lib
	type(string_t) :: proc_id, libname_cur, libname_res
	integer :: i, n
	if (.not. prc_set%is_active ()) return
	if (present (global)) then
	current => global
	else
	current => local
	end if
	libname_cur = current%prclib%get_name ()
	libname_res = prc_set%get_libname ()
	lib => current%prclib_stack%get_library_ptr (libname_res)
	if (associated (lib)) call current%update_prclib (lib)
	call local%set_string (var_str ("$phs_method"), &
	var_str ("none"), is_known = .true.)
	call local%set_string (var_str ("$integration_method"), &
	var_str ("none"), is_known = .true.)
	n = prc_set%get_n_process ()
	allocate (prc_set%subprocess (n))
	do i = 1, n
	proc_id = prc_set%get_proc_id (i)
	call prepare_process (prc_set%subprocess(i)%p, proc_id)
	if (signal_is_pending ()) return
	end do
	lib => current%prclib_stack%get_library_ptr (libname_cur)
	if (associated (lib)) call current%update_prclib (lib)
	contains
	subroutine prepare_process (process, process_id)
	type(process_t), pointer, intent(out) :: process
	type(string_t), intent(in) :: process_id
	call msg_message ("Simulate: initializing resonant subprocess '" &
	// char (process_id) // "'")
	if (present (global)) then
	call integrate_process (process_id, local, global, &
	init_only = .true.)
	else
	call integrate_process (process_id, local, local_stack = .true., &
	init_only = .true.)
	end if
	process => current%process_stack%get_process_ptr (process_id)
	if (.not. associated (process)) then
	call msg_fatal ("Simulate: resonant subprocess '" &
	// char (process_id) // "' could not be initialized: aborting")
	end if
	end subroutine prepare_process
	end subroutine resonant_subprocess_set_prepare_process_objects

	@ %def resonant_subprocess_set_prepare_process_objects
	@ Workspace for the resonant subprocesses.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: prepare_process_instances &
	=> resonant_subprocess_set_prepare_process_instances
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_prepare_process_instances (prc_set, global)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	type(rt_data_t), intent(in), target :: global
	integer :: i, n
	if (.not. prc_set%is_active ()) return
	n = size (prc_set%subprocess)
	allocate (prc_set%instance (n))
	do i = 1, n
	allocate (prc_set%instance(i)%p)
	call prc_set%instance(i)%p%init (prc_set%subprocess(i)%p)
	call prc_set%instance(i)%p%setup_event_data (global%model)
	end do
	end subroutine resonant_subprocess_set_prepare_process_instances

	@ %def resonant_subprocess_set_prepare_process_instances
	@
	\subsection{Event transform connection}
	The idea is that the resonance-insertion event transform has been
	allocated somewhere (namely, in the standard event-transform chain),
	but we maintain a link such that we can inject matrix-element results
	event by event. The event transform holds a selector, to choose one
	of the resonance histories (or none), and it manages resonance
	insertion for the particle set.

	The data that the event transform requires can be provided here. The
	resonance history set has already been assigned with the [[dispatch]]
	initializer. Here, we supply the set of subprocess instances that we
	have generated (see above). The master-process instance is set
	when we [[connect]] the transform by the standard method.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: connect_transform => &
	resonant_subprocess_set_connect_transform
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_connect_transform (prc_set, evt)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	class(evt_t), intent(in), target :: evt
	select type (evt)
	type is (evt_resonance_t)
	prc_set%evt => evt
	call prc_set%evt%set_subprocess_instances (prc_set%instance)
	class default
	call msg_bug ("Resonant subprocess set: event transform has wrong type")
	end select
	end subroutine resonant_subprocess_set_connect_transform

	@ %def resonant_subprocess_set_connect_transform
	@ Set the on-shell limit value in the connected transform.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: set_on_shell_limit => resonant_subprocess_set_on_shell_limit
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_on_shell_limit (prc_set, on_shell_limit)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	real(default), intent(in) :: on_shell_limit
	call prc_set%evt%set_on_shell_limit (on_shell_limit)
	end subroutine resonant_subprocess_set_on_shell_limit

	@ %def resonant_subprocess_set_on_shell_limit
	@ Set the Gaussian turnoff parameter in the connected transform.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: set_on_shell_turnoff => resonant_subprocess_set_on_shell_turnoff
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_on_shell_turnoff &
	(prc_set, on_shell_turnoff)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	real(default), intent(in) :: on_shell_turnoff
	call prc_set%evt%set_on_shell_turnoff (on_shell_turnoff)
	end subroutine resonant_subprocess_set_on_shell_turnoff

	@ %def resonant_subprocess_set_on_shell_turnoff
	@ Reweight (suppress) the background contribution probability, for the
	kinematics where a resonance history is active.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: set_background_factor &
	=> resonant_subprocess_set_background_factor
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_background_factor &
	(prc_set, background_factor)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	real(default), intent(in) :: background_factor
	call prc_set%evt%set_background_factor (background_factor)
	end subroutine resonant_subprocess_set_background_factor

	@ %def resonant_subprocess_set_background_factor
	@
	\subsection{Wrappers for runtime calculations}
	All runtime calculations are delegated to the event transform. The
	following procedures are essentially redundant wrappers. We retain
	them for a unit test below.

	Debugging aid:
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: dump_instances => resonant_subprocess_set_dump_instances
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_dump_instances (prc_set, unit, testflag)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	integer :: i, n, u
	u = given_output_unit (unit)
	write (u, "(A)") "*** Process instances of resonant subprocesses"
	write (u, *)
	n = size (prc_set%subprocess)
	do i = 1, n
	associate (instance => prc_set%instance(i)%p)
	call instance%write (u, testflag)
	write (u, *)
	write (u, *)
	end associate
	end do
	end subroutine resonant_subprocess_set_dump_instances

	@ %def resonant_subprocess_set_dump_instances
	@ Inject the current kinematics configuration, reading from the
	previous event transform or from the process instance.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: fill_momenta => resonant_subprocess_set_fill_momenta
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_fill_momenta (prc_set)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	integer :: i, n
	call prc_set%evt%fill_momenta ()
	end subroutine resonant_subprocess_set_fill_momenta

	@ %def resonant_subprocess_set_fill_momenta
	@ Determine the indices of the resonance histories that can be
	considered on-shell for the current kinematics.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: determine_on_shell_histories &
	=> resonant_subprocess_set_determine_on_shell_histories
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_determine_on_shell_histories &
	(prc_set, i_component, index_array)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	integer, intent(in) :: i_component
	integer, dimension(:), allocatable, intent(out) :: index_array
	call prc_set%evt%determine_on_shell_histories (index_array)
	end subroutine resonant_subprocess_set_determine_on_shell_histories

	@ %def resonant_subprocess_set_determine_on_shell_histories
	@ Evaluate selected subprocesses. (In actual operation, the ones that
	have been tagged as on-shell.)
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: evaluate_subprocess &
	=> resonant_subprocess_set_evaluate_subprocess
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_evaluate_subprocess (prc_set, index_array)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	integer, dimension(:), intent(in) :: index_array
	call prc_set%evt%evaluate_subprocess (index_array)
	end subroutine resonant_subprocess_set_evaluate_subprocess

	@ %def resonant_subprocess_set_evaluate_subprocess
	@ Extract the matrix elements of the master process / the resonant
	subprocesses. After the previous routine has been executed, they
	should be available and stored in the corresponding process instances.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: get_master_sqme &
	=> resonant_subprocess_set_get_master_sqme
	procedure :: get_subprocess_sqme &
	=> resonant_subprocess_set_get_subprocess_sqme
	<<Restricted subprocesses: procedures>>=
	function resonant_subprocess_set_get_master_sqme (prc_set) result (sqme)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	real(default) :: sqme
	sqme = prc_set%evt%get_master_sqme ()
	end function resonant_subprocess_set_get_master_sqme

	subroutine resonant_subprocess_set_get_subprocess_sqme (prc_set, sqme)
	class(resonant_subprocess_set_t), intent(in) :: prc_set
	real(default), dimension(:), intent(inout) :: sqme
	integer :: i
	call prc_set%evt%get_subprocess_sqme (sqme)
	end subroutine resonant_subprocess_set_get_subprocess_sqme

	@ %def resonant_subprocess_set_get_master_sqme
	@ %def resonant_subprocess_set_get_subprocess_sqme
	@ We use the calculations of resonant matrix elements to determine
	probabilities for all resonance configurations.
	<<Restricted subprocesses: resonant subprocess set: TBP>>=
	procedure :: compute_probabilities &
	=> resonant_subprocess_set_compute_probabilities
	<<Restricted subprocesses: procedures>>=
	subroutine resonant_subprocess_set_compute_probabilities (prc_set, prob_array)
	class(resonant_subprocess_set_t), intent(inout) :: prc_set
	real(default), dimension(:), allocatable, intent(out) :: prob_array
	integer, dimension(:), allocatable :: index_array
	real(default) :: sqme, sqme_sum, sqme_bg
	real(default), dimension(:), allocatable :: sqme_res
	integer :: n
	n = size (prc_set%subprocess)
	allocate (prob_array (0:n), source = 0._default)
	call prc_set%evt%compute_probabilities ()
	call prc_set%evt%get_selector_weights (prob_array)
	end subroutine resonant_subprocess_set_compute_probabilities

	@ %def resonant_subprocess_set_compute_probabilities
	@
	\subsection{Unit tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[restricted_subprocesses_ut.f90]]>>=
	<<File header>>

	module restricted_subprocesses_ut
	use unit_tests
	use restricted_subprocesses_uti

	<<Standard module head>>

	<<Restricted subprocesses: public test>>

	contains

	<<Restricted subprocesses: test driver>>

	end module restricted_subprocesses_ut
	@ %def restricted_subprocesses_ut
	@
	<<[[restricted_subprocesses_uti.f90]]>>=
	<<File header>>

	module restricted_subprocesses_uti

	<<Use kinds>>
	<<Use strings>>
	use io_units, only: free_unit
	use format_defs, only: FMT_10, FMT_12
	use lorentz, only: vector4_t, vector3_moving, vector4_moving
	use particle_specifiers, only: new_prt_spec
	use process_libraries, only: process_library_t
	use resonances, only: resonance_info_t
	use resonances, only: resonance_history_t
	use resonances, only: resonance_history_set_t
	use sm_qcd, only: qcd_t
	use state_matrices, only: FM_IGNORE_HELICITY
	use particles, only: particle_set_t
	use model_data, only: model_data_t
	use models, only: syntax_model_file_init, syntax_model_file_final
	use models, only: model_t
	use rng_base, only: rng_factory_t
	use rng_base_ut, only: rng_test_factory_t
	use mci_base, only: mci_t
	use mci_none, only: mci_none_t
	use phs_base, only: phs_config_t
	use phs_forests, only: syntax_phs_forest_init, syntax_phs_forest_final
	use phs_wood, only: phs_wood_config_t
	use process_libraries, only: process_def_entry_t
	use process_libraries, only: process_component_def_t
	use prclib_stacks, only: prclib_entry_t
	use prc_core_def, only: prc_core_def_t
	use prc_omega, only: omega_def_t
	use process, only: process_t
	use instances, only: process_instance_t
	use process_stacks, only: process_entry_t
	use event_transforms, only: evt_trivial_t
	use resonance_insertion, only: evt_resonance_t
	use integrations, only: integrate_process
	use rt_data, only: rt_data_t

	use restricted_subprocesses

	<<Standard module head>>

	<<Restricted subprocesses: test declarations>>

	<<Restricted subprocesses: test auxiliary types>>

	<<Restricted subprocesses: public test auxiliary>>

	contains

	<<Restricted subprocesses: tests>>

	<<Restricted subprocesses: test auxiliary>>

	end module restricted_subprocesses_uti

	@ %def restricted_subprocesses_uti
	@ API: driver for the unit tests below.
	<<Restricted subprocesses: public test>>=
	public :: restricted_subprocesses_test
	<<Restricted subprocesses: test driver>>=
	subroutine restricted_subprocesses_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Restricted subprocesses: execute tests>>
	end subroutine restricted_subprocesses_test

	@ %def restricted_subprocesses_test
	@
	\subsubsection{subprocess configuration}
	Initialize a [[restricted_subprocess_configuration_t]] object which represents
	a given process with a defined resonance history.
	<<Restricted subprocesses: execute tests>>=
	call test (restricted_subprocesses_1, "restricted_subprocesses_1", &
	"single subprocess", &
	u, results)
	<<Restricted subprocesses: test declarations>>=
	public :: restricted_subprocesses_1
	<<Restricted subprocesses: tests>>=
	subroutine restricted_subprocesses_1 (u)
	integer, intent(in) :: u
	type(rt_data_t) :: global
	type(resonance_info_t) :: res_info
	type(resonance_history_t) :: res_history
	type(string_t) :: prc_name
	type(string_t), dimension(2) :: prt_in
	type(string_t), dimension(3) :: prt_out
	type(restricted_process_configuration_t) :: prc_config

	write (u, "(A)") "* Test output: restricted_subprocesses_1"
	write (u, "(A)") "* Purpose: create subprocess list from resonances"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%select_model (var_str ("SM"))

	write (u, "(A)") "* Create resonance history"
	write (u, "(A)")

	call res_info%init (3, -24, global%model, 5)
	call res_history%add_resonance (res_info)
	call res_history%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Create process configuration"
	write (u, "(A)")

	prc_name = "restricted_subprocesses_1_p"
	prt_in(1) = "e-"
	prt_in(2) = "e+"
	prt_out(1) = "d"
	prt_out(2) = "u"
	prt_out(3) = "W+"

	call prc_config%init_resonant_process (prc_name, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), &
	res_history, global%model, global%var_list)

	call prc_config%write (u)

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: restricted_subprocesses_1"

	end subroutine restricted_subprocesses_1

	@ %def restricted_subprocesses_1
	@
	\subsubsection{Subprocess library configuration}
	Create a process library that represents restricted subprocesses for a given
	set of resonance histories
	<<Restricted subprocesses: execute tests>>=
	call test (restricted_subprocesses_2, "restricted_subprocesses_2", &
	"subprocess library", &
	u, results)
	<<Restricted subprocesses: test declarations>>=
	public :: restricted_subprocesses_2
	<<Restricted subprocesses: tests>>=
	subroutine restricted_subprocesses_2 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	type(resonance_info_t) :: res_info
	type(resonance_history_t), dimension(2) :: res_history
	type(resonance_history_set_t) :: res_history_set
	type(string_t) :: libname
	type(string_t), dimension(2) :: prt_in
	type(string_t), dimension(3) :: prt_out
	type(resonant_subprocess_set_t) :: prc_set
	type(process_library_t), pointer :: lib
	logical :: exist

	write (u, "(A)") "* Test output: restricted_subprocesses_2"
	write (u, "(A)") "* Purpose: create subprocess library from resonances"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%select_model (var_str ("SM"))

	write (u, "(A)") "* Create resonance histories"
	write (u, "(A)")

	call res_info%init (3, -24, global%model, 5)
	call res_history(1)%add_resonance (res_info)
	call res_history(1)%write (u)

	call res_info%init (7, 23, global%model, 5)
	call res_history(2)%add_resonance (res_info)
	call res_history(2)%write (u)

	call res_history_set%init ()
	call res_history_set%enter (res_history(1))
	call res_history_set%enter (res_history(2))
	call res_history_set%freeze ()

	write (u, "(A)")
	write (u, "(A)") "* Empty restricted subprocess set"
	write (u, "(A)")

	write (u, "(A,1x,L1)") "active =", prc_set%is_active ()
	write (u, "(A)")

	call prc_set%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Fill restricted subprocess set"
	write (u, "(A)")

	libname = "restricted_subprocesses_2_p_R"
	prt_in(1) = "e-"
	prt_in(2) = "e+"
	prt_out(1) = "d"
	prt_out(2) = "u"
	prt_out(3) = "W+"

	call prc_set%init (1)
	call prc_set%fill_resonances (res_history_set, 1)
	call prc_set%create_library (libname, global, exist)
	if (.not. exist) then
	call prc_set%add_to_library (1, &
	new_prt_spec (prt_in), new_prt_spec (prt_out), &
	global)
	end if
	call prc_set%freeze_library (global)

	write (u, "(A,1x,L1)") "active =", prc_set%is_active ()
	write (u, "(A)")

	call prc_set%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Queries"
	write (u, "(A)")

	write (u, "(A,1x,I0)") "n_process =", prc_set%get_n_process ()
	write (u, "(A)")
	write (u, "(A,A,A)") "libname = '", char (prc_set%get_libname ()), "'"
	write (u, "(A)")
	write (u, "(A,A,A)") "proc_id(1) = '", char (prc_set%get_proc_id (1)), "'"
	write (u, "(A,A,A)") "proc_id(2) = '", char (prc_set%get_proc_id (2)), "'"


	write (u, "(A)")
	write (u, "(A)") "* Process library"
	write (u, "(A)")

	call prc_set%compile_library (global)

	lib => global%prclib_stack%get_library_ptr (libname)
	if (associated (lib)) call lib%write (u, libpath=.false.)

	write (u, *)
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: restricted_subprocesses_2"

	end subroutine restricted_subprocesses_2

	@ %def restricted_subprocesses_2
	@
	\subsubsection{Auxiliary: Test processes}
	Auxiliary subroutine that constructs the process library for the above test.
	This parallels a similar subroutine in [[processes_uti]], but this time we
	want an \oMega\ process.
	<<Restricted subprocesses: public test auxiliary>>=
	public :: prepare_resonance_test_library
	<<Restricted subprocesses: test auxiliary>>=
	subroutine prepare_resonance_test_library &
	(lib, libname, procname, model, global, u)
	type(process_library_t), target, intent(out) :: lib
	type(string_t), intent(in) :: libname
	type(string_t), intent(in) :: procname
	class(model_data_t), intent(in), pointer :: model
	type(rt_data_t), intent(in), target :: global
	integer, intent(in) :: u
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry

	call lib%init (libname)

	allocate (prt_in (2), prt_out (3))
	prt_in = [var_str ("e+"), var_str ("e-")]
	prt_out = [var_str ("d"), var_str ("ubar"), var_str ("W+")]

	allocate (omega_def_t :: def)
	select type (def)
	type is (omega_def_t)
	call def%init (model%get_name (), prt_in, prt_out, &
	ovm=.false., ufo=.false.)
	end select
	allocate (entry)
	call entry%init (procname, &
	model_name = model%get_name (), &
	n_in = 2, n_components = 1, &
	requires_resonances = .true.)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("omega"), &
	variant = def)
	call entry%write (u)

	call lib%append (entry)

	call lib%configure (global%os_data)
	call lib%write_makefile (global%os_data, force = .true., verbose = .false.)
	call lib%clean (global%os_data, distclean = .false.)
	call lib%write_driver (force = .true.)
	call lib%load (global%os_data)

	end subroutine prepare_resonance_test_library

	@ %def prepare_resonance_test_library
	@
	\subsubsection{Kinematics and resonance selection}
	Prepare an actual process with resonant subprocesses. Insert
	kinematics and apply the resonance selector in an associated event
	transform.
	<<Restricted subprocesses: execute tests>>=
	call test (restricted_subprocesses_3, "restricted_subprocesses_3", &
	"resonance kinematics and probability", &
	u, results)
	<<Restricted subprocesses: test declarations>>=
	public :: restricted_subprocesses_3
	<<Restricted subprocesses: tests>>=
	subroutine restricted_subprocesses_3 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(model_t), pointer :: model
	class(model_data_t), pointer :: model_data
	type(string_t) :: libname, libname_res
	type(string_t) :: procname
	type(process_component_def_t), pointer :: process_component_def
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	logical :: exist
	type(process_t), pointer :: process
	type(process_instance_t), target :: process_instance
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(resonant_subprocess_set_t) :: prc_set
	type(particle_set_t) :: pset
	real(default) :: sqrts, mw, pp
	real(default), dimension(3) :: p3
	type(vector4_t), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: m
	integer, dimension(:), allocatable :: pdg
	real(default), dimension(:), allocatable :: sqme
	logical, dimension(:), allocatable :: mask
	real(default) :: on_shell_limit
	integer, dimension(:), allocatable :: i_array
	real(default), dimension(:), allocatable :: prob_array
	type(evt_resonance_t), target :: evt_resonance
	integer :: i, u_dump

	write (u, "(A)") "* Test output: restricted_subprocesses_3"
	write (u, "(A)") "* Purpose: handle process and resonance kinematics"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()
	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%set_log (var_str ("?resonance_history"), &
	.true., is_known = .true.)

	call global%select_model (var_str ("SM"))
	allocate (model)
	call model%init_instance (global%model)
	model_data => model

	libname = "restricted_subprocesses_3_lib"
	libname_res = "restricted_subprocesses_3_lib_res"
	procname = "restricted_subprocesses_3_p"

	write (u, "(A)") "* Initialize process library and process"
	write (u, "(A)")

	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)

	call prepare_resonance_test_library &
	(lib, libname, procname, model_data, global, u)

	call integrate_process (procname, global, &
	local_stack = .true., init_only = .true.)

	process => global%process_stack%get_process_ptr (procname)

	call process_instance%init (process)
	call process_instance%setup_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Extract resonance history set"
	write (u, "(A)")

	call process%extract_resonance_history_set &
	(res_history_set(1), include_trivial=.true., i_component=1)
	call res_history_set(1)%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Build resonant-subprocess library"
	write (u, "(A)")

	call prc_set%init (1)
	call prc_set%fill_resonances (res_history_set(1), 1)

	process_component_def => process%get_component_def_ptr (1)
	call prc_set%create_library (libname_res, global, exist)
	if (.not. exist) then
	call prc_set%add_to_library (1, &
	process_component_def%get_prt_spec_in (), &
	process_component_def%get_prt_spec_out (), &
	global)
	end if
	call prc_set%freeze_library (global)
	call prc_set%compile_library (global)
	call prc_set%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Build particle set"
	write (u, "(A)")

	sqrts = global%get_rval (var_str ("sqrts"))
	mw = 80._default ! deliberately slightly different from true mw
	pp = sqrt (sqrts*2 - 4 mw**2) / 2

	allocate (pdg (5), p (5), m (5))
	pdg(1) = -11
	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	m(1) = 0
	pdg(2) = 11
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	m(2) = 0
	pdg(3) = 1
	p3(1) = pp/2
	p3(2) = mw/2
	p3(3) = 0
	p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(3) = 0
	p3(2) = -mw/2
	pdg(4) = -2
	p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(4) = 0
	pdg(5) = 24
	p(5) = vector4_moving (sqrts/2,-pp, 1)
	m(5) = mw

	call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
	call pset%set_momentum (p, m**2)
	call pset%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Fill process instance"

	! workflow from event_recalculate
	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1)
	call process_instance%recover &
	(1, 1, update_sqme=.true., recover_phs=.false.)
	call process_instance%evaluate_event_data (weight = 1._default)

	write (u, "(A)")
	write (u, "(A)") "* Prepare resonant subprocesses"

	call prc_set%prepare_process_objects (global)
	call prc_set%prepare_process_instances (global)

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call prc_set%connect_transform (evt_resonance)
	call evt_resonance%connect (process_instance, model)

	call prc_set%fill_momenta ()

	write (u, "(A)")
	write (u, "(A)") "* Show squared matrix element of master process,"
	write (u, "(A)") " should coincide with 2nd subprocess sqme"
	write (u, "(A)")

	write (u, "(1x,I0,1x," // FMT_12 // ")") 0, prc_set%get_master_sqme ()

	write (u, "(A)")
	write (u, "(A)") "* Compute squared matrix elements &
	&of selected resonant subprocesses [1,2]"
	write (u, "(A)")

	call prc_set%evaluate_subprocess ([1,2])

	allocate (sqme (3), source = 0._default)
	call prc_set%get_subprocess_sqme (sqme)
	do i = 1, size (sqme)
	write (u, "(1x,I0,1x," // FMT_12 // ")") i, sqme(i)
	end do
	deallocate (sqme)

	write (u, "(A)")
	write (u, "(A)") "* Compute squared matrix elements &
	&of all resonant subprocesses"
	write (u, "(A)")

	call prc_set%evaluate_subprocess ([1,2,3])

	allocate (sqme (3), source = 0._default)
	call prc_set%get_subprocess_sqme (sqme)
	do i = 1, size (sqme)
	write (u, "(1x,I0,1x," // FMT_12 // ")") i, sqme(i)
	end do
	deallocate (sqme)

	write (u, "(A)")
	write (u, "(A)") "* Write process instances to file &
	&restricted_subprocesses_3_lib_res.dat"

	u_dump = free_unit ()
	open (unit = u_dump, file = "restricted_subprocesses_3_lib_res.dat", &
	action = "write", status = "replace")
	call prc_set%dump_instances (u_dump)
	close (u_dump)

	write (u, "(A)")
	write (u, "(A)") "* Determine on-shell resonant subprocesses"
	write (u, "(A)")

	on_shell_limit = 0
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	write (u, "(1x,A,9(1x,I0))") "resonant =", i_array

	on_shell_limit = 0.1_default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	write (u, "(1x,A,9(1x,I0))") "resonant =", i_array

	on_shell_limit = 10._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	write (u, "(1x,A,9(1x,I0))") "resonant =", i_array

	on_shell_limit = 10000._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	write (u, "(1x,A,9(1x,I0))") "resonant =", i_array

	write (u, "(A)")
	write (u, "(A)") "* Compute probabilities for applicable resonances"
	write (u, "(A)") " and initialize the process selector"
	write (u, "(A)") " (The first number is the probability for background)"
	write (u, "(A)")

	on_shell_limit = 0
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	call prc_set%compute_probabilities (prob_array)
	write (u, "(1x,A,9(1x,"// FMT_12 // "))") "resonant =", prob_array
	call prc_set%write (u, testflag=.true.)
	write (u, *)

	on_shell_limit = 10._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	call prc_set%compute_probabilities (prob_array)
	write (u, "(1x,A,9(1x,"// FMT_12 // "))") "resonant =", prob_array
	call prc_set%write (u, testflag=.true.)
	write (u, *)

	on_shell_limit = 10000._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call prc_set%set_on_shell_limit (on_shell_limit)
	call prc_set%determine_on_shell_histories (1, i_array)
	call prc_set%compute_probabilities (prob_array)
	write (u, "(1x,A,9(1x,"// FMT_12 // "))") "resonant =", prob_array
	write (u, *)
	call prc_set%write (u, testflag=.true.)
	write (u, *)

	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: restricted_subprocesses_3"

	end subroutine restricted_subprocesses_3

	@ %def restricted_subprocesses_3
	@
	\subsubsection{Event transform}
	Prepare an actual process with resonant subprocesses. Prepare the
	resonance selector for a fixed event and apply the resonance-insertion
	event transform.
	<<Restricted subprocesses: execute tests>>=
	call test (restricted_subprocesses_4, "restricted_subprocesses_4", &
	"event transform", &
	u, results)
	<<Restricted subprocesses: test declarations>>=
	public :: restricted_subprocesses_4
	<<Restricted subprocesses: tests>>=
	subroutine restricted_subprocesses_4 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(model_t), pointer :: model
	class(model_data_t), pointer :: model_data
	type(string_t) :: libname, libname_res
	type(string_t) :: procname
	type(process_component_def_t), pointer :: process_component_def
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	logical :: exist
	type(process_t), pointer :: process
	type(process_instance_t), target :: process_instance
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(resonant_subprocess_set_t) :: prc_set
	type(particle_set_t) :: pset
	real(default) :: sqrts, mw, pp
	real(default), dimension(3) :: p3
	type(vector4_t), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: m
	integer, dimension(:), allocatable :: pdg
	real(default) :: on_shell_limit
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	real(default) :: probability
	integer :: i

	write (u, "(A)") "* Test output: restricted_subprocesses_4"
	write (u, "(A)") "* Purpose: employ event transform"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()
	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%set_log (var_str ("?resonance_history"), &
	.true., is_known = .true.)

	call global%select_model (var_str ("SM"))
	allocate (model)
	call model%init_instance (global%model)
	model_data => model

	libname = "restricted_subprocesses_4_lib"
	libname_res = "restricted_subprocesses_4_lib_res"
	procname = "restricted_subprocesses_4_p"

	write (u, "(A)") "* Initialize process library and process"
	write (u, "(A)")

	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)

	call prepare_resonance_test_library &
	(lib, libname, procname, model_data, global, u)

	call integrate_process (procname, global, &
	local_stack = .true., init_only = .true.)

	process => global%process_stack%get_process_ptr (procname)

	call process_instance%init (process)
	call process_instance%setup_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Extract resonance history set"

	call process%extract_resonance_history_set &
	(res_history_set(1), include_trivial=.false., i_component=1)

	write (u, "(A)")
	write (u, "(A)") "* Build resonant-subprocess library"

	call prc_set%init (1)
	call prc_set%fill_resonances (res_history_set(1), 1)

	process_component_def => process%get_component_def_ptr (1)
	call prc_set%create_library (libname_res, global, exist)
	if (.not. exist) then
	call prc_set%add_to_library (1, &
	process_component_def%get_prt_spec_in (), &
	process_component_def%get_prt_spec_out (), &
	global)
	end if
	call prc_set%freeze_library (global)
	call prc_set%compile_library (global)

	write (u, "(A)")
	write (u, "(A)") "* Build particle set"
	write (u, "(A)")

	sqrts = global%get_rval (var_str ("sqrts"))
	mw = 80._default ! deliberately slightly different from true mw
	pp = sqrt (sqrts*2 - 4 mw**2) / 2

	allocate (pdg (5), p (5), m (5))
	pdg(1) = -11
	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	m(1) = 0
	pdg(2) = 11
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	m(2) = 0
	pdg(3) = 1
	p3(1) = pp/2
	p3(2) = mw/2
	p3(3) = 0
	p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(3) = 0
	p3(2) = -mw/2
	pdg(4) = -2
	p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(4) = 0
	pdg(5) = 24
	p(5) = vector4_moving (sqrts/2,-pp, 1)
	m(5) = mw

	call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
	call pset%set_momentum (p, m**2)

	write (u, "(A)") "* Fill process instance"
	write (u, "(A)")

	! workflow from event_recalculate
	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1)
	call process_instance%recover &
	(1, 1, update_sqme=.true., recover_phs=.false.)
	call process_instance%evaluate_event_data (weight = 1._default)

	write (u, "(A)") "* Prepare resonant subprocesses"
	write (u, "(A)")

	call prc_set%prepare_process_objects (global)
	call prc_set%prepare_process_instances (global)

	write (u, "(A)") "* Fill trivial event transform (deliberately w/o color)"
	write (u, "(A)")

	call evt_trivial%connect (process_instance, model)
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize resonance-insertion event transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%connect (process_instance, model)
	call prc_set%connect_transform (evt_resonance)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Compute probabilities for applicable resonances"
	write (u, "(A)") " and initialize the process selector"
	write (u, "(A)")

	on_shell_limit = 10._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", on_shell_limit
	call evt_resonance%set_on_shell_limit (on_shell_limit)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate resonance-insertion event transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (1, .false.)

	call evt_resonance%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: restricted_subprocesses_4"

	end subroutine restricted_subprocesses_4

	@ %def restricted_subprocesses_4
	@
	\subsubsection{Gaussian turnoff}
	Identical to the previous process, except that we apply a Gaussian
	turnoff to the resonance kinematics, which affects the subprocess selector.
	<<Restricted subprocesses: execute tests>>=
	call test (restricted_subprocesses_5, "restricted_subprocesses_5", &
	"event transform with gaussian turnoff", &
	u, results)
	<<Restricted subprocesses: test declarations>>=
	public :: restricted_subprocesses_5
	<<Restricted subprocesses: tests>>=
	subroutine restricted_subprocesses_5 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(model_t), pointer :: model
	class(model_data_t), pointer :: model_data
	type(string_t) :: libname, libname_res
	type(string_t) :: procname
	type(process_component_def_t), pointer :: process_component_def
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	logical :: exist
	type(process_t), pointer :: process
	type(process_instance_t), target :: process_instance
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(resonant_subprocess_set_t) :: prc_set
	type(particle_set_t) :: pset
	real(default) :: sqrts, mw, pp
	real(default), dimension(3) :: p3
	type(vector4_t), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: m
	integer, dimension(:), allocatable :: pdg
	real(default) :: on_shell_limit
	real(default) :: on_shell_turnoff
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	real(default) :: probability
	integer :: i

	write (u, "(A)") "* Test output: restricted_subprocesses_5"
	write (u, "(A)") "* Purpose: employ event transform &
	&with gaussian turnoff"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()
	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%set_log (var_str ("?resonance_history"), &
	.true., is_known = .true.)

	call global%select_model (var_str ("SM"))
	allocate (model)
	call model%init_instance (global%model)
	model_data => model

	libname = "restricted_subprocesses_5_lib"
	libname_res = "restricted_subprocesses_5_lib_res"
	procname = "restricted_subprocesses_5_p"

	write (u, "(A)") "* Initialize process library and process"
	write (u, "(A)")

	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)

	call prepare_resonance_test_library &
	(lib, libname, procname, model_data, global, u)

	call integrate_process (procname, global, &
	local_stack = .true., init_only = .true.)

	process => global%process_stack%get_process_ptr (procname)

	call process_instance%init (process)
	call process_instance%setup_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Extract resonance history set"

	call process%extract_resonance_history_set &
	(res_history_set(1), include_trivial=.false., i_component=1)

	write (u, "(A)")
	write (u, "(A)") "* Build resonant-subprocess library"

	call prc_set%init (1)
	call prc_set%fill_resonances (res_history_set(1), 1)

	process_component_def => process%get_component_def_ptr (1)
	call prc_set%create_library (libname_res, global, exist)
	if (.not. exist) then
	call prc_set%add_to_library (1, &
	process_component_def%get_prt_spec_in (), &
	process_component_def%get_prt_spec_out (), &
	global)
	end if
	call prc_set%freeze_library (global)
	call prc_set%compile_library (global)

	write (u, "(A)")
	write (u, "(A)") "* Build particle set"
	write (u, "(A)")

	sqrts = global%get_rval (var_str ("sqrts"))
	mw = 80._default ! deliberately slightly different from true mw
	pp = sqrt (sqrts*2 - 4 mw**2) / 2

	allocate (pdg (5), p (5), m (5))
	pdg(1) = -11
	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	m(1) = 0
	pdg(2) = 11
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	m(2) = 0
	pdg(3) = 1
	p3(1) = pp/2
	p3(2) = mw/2
	p3(3) = 0
	p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(3) = 0
	p3(2) = -mw/2
	pdg(4) = -2
	p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(4) = 0
	pdg(5) = 24
	p(5) = vector4_moving (sqrts/2,-pp, 1)
	m(5) = mw

	call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
	call pset%set_momentum (p, m**2)

	write (u, "(A)") "* Fill process instance"
	write (u, "(A)")

	! workflow from event_recalculate
	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1)
	call process_instance%recover &
	(1, 1, update_sqme=.true., recover_phs=.false.)
	call process_instance%evaluate_event_data (weight = 1._default)

	write (u, "(A)") "* Prepare resonant subprocesses"
	write (u, "(A)")

	call prc_set%prepare_process_objects (global)
	call prc_set%prepare_process_instances (global)

	write (u, "(A)") "* Fill trivial event transform (deliberately w/o color)"
	write (u, "(A)")

	call evt_trivial%connect (process_instance, model)
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize resonance-insertion event transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%connect (process_instance, model)
	call prc_set%connect_transform (evt_resonance)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Compute probabilities for applicable resonances"
	write (u, "(A)") " and initialize the process selector"
	write (u, "(A)")

	on_shell_limit = 10._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_limit =", &
	on_shell_limit
	call evt_resonance%set_on_shell_limit (on_shell_limit)

	on_shell_turnoff = 1._default
	write (u, "(1x,A,1x," // FMT_10 // ")") "on_shell_turnoff =", &
	on_shell_turnoff
	call evt_resonance%set_on_shell_turnoff (on_shell_turnoff)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate resonance-insertion event transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (1, .false.)

	call evt_resonance%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: restricted_subprocesses_5"

	end subroutine restricted_subprocesses_5

	@ %def restricted_subprocesses_5
	@
	\subsubsection{Event transform}
	The same process and event again. This time, switch off the background
	contribution, so the selector becomes trivial.
	<<Restricted subprocesses: execute tests>>=
	call test (restricted_subprocesses_6, "restricted_subprocesses_6", &
	"event transform with background switched off", &
	u, results)
	<<Restricted subprocesses: test declarations>>=
	public :: restricted_subprocesses_6
	<<Restricted subprocesses: tests>>=
	subroutine restricted_subprocesses_6 (u)
	integer, intent(in) :: u
	type(rt_data_t), target :: global
	class(model_t), pointer :: model
	class(model_data_t), pointer :: model_data
	type(string_t) :: libname, libname_res
	type(string_t) :: procname
	type(process_component_def_t), pointer :: process_component_def
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	logical :: exist
	type(process_t), pointer :: process
	type(process_instance_t), target :: process_instance
	type(resonance_history_set_t), dimension(1) :: res_history_set
	type(resonant_subprocess_set_t) :: prc_set
	type(particle_set_t) :: pset
	real(default) :: sqrts, mw, pp
	real(default), dimension(3) :: p3
	type(vector4_t), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: m
	integer, dimension(:), allocatable :: pdg
	real(default) :: on_shell_limit
	real(default) :: background_factor
	type(evt_trivial_t), target :: evt_trivial
	type(evt_resonance_t), target :: evt_resonance
	real(default) :: probability
	integer :: i

	write (u, "(A)") "* Test output: restricted_subprocesses_6"
	write (u, "(A)") "* Purpose: employ event transform &
	&with background switched off"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	call global%global_init ()
	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%set_log (var_str ("?resonance_history"), &
	.true., is_known = .true.)

	call global%select_model (var_str ("SM"))
	allocate (model)
	call model%init_instance (global%model)
	model_data => model

	libname = "restricted_subprocesses_6_lib"
	libname_res = "restricted_subprocesses_6_lib_res"
	procname = "restricted_subprocesses_6_p"

	write (u, "(A)") "* Initialize process library and process"
	write (u, "(A)")

	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)

	call prepare_resonance_test_library &
	(lib, libname, procname, model_data, global, u)

	call integrate_process (procname, global, &
	local_stack = .true., init_only = .true.)

	process => global%process_stack%get_process_ptr (procname)

	call process_instance%init (process)
	call process_instance%setup_event_data ()

	write (u, "(A)")
	write (u, "(A)") "* Extract resonance history set"

	call process%extract_resonance_history_set &
	(res_history_set(1), include_trivial=.false., i_component=1)

	write (u, "(A)")
	write (u, "(A)") "* Build resonant-subprocess library"

	call prc_set%init (1)
	call prc_set%fill_resonances (res_history_set(1), 1)

	process_component_def => process%get_component_def_ptr (1)
	call prc_set%create_library (libname_res, global, exist)
	if (.not. exist) then
	call prc_set%add_to_library (1, &
	process_component_def%get_prt_spec_in (), &
	process_component_def%get_prt_spec_out (), &
	global)
	end if
	call prc_set%freeze_library (global)
	call prc_set%compile_library (global)

	write (u, "(A)")
	write (u, "(A)") "* Build particle set"
	write (u, "(A)")

	sqrts = global%get_rval (var_str ("sqrts"))
	mw = 80._default ! deliberately slightly different from true mw
	pp = sqrt (sqrts*2 - 4 mw**2) / 2

	allocate (pdg (5), p (5), m (5))
	pdg(1) = -11
	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	m(1) = 0
	pdg(2) = 11
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	m(2) = 0
	pdg(3) = 1
	p3(1) = pp/2
	p3(2) = mw/2
	p3(3) = 0
	p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(3) = 0
	p3(2) = -mw/2
	pdg(4) = -2
	p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(4) = 0
	pdg(5) = 24
	p(5) = vector4_moving (sqrts/2,-pp, 1)
	m(5) = mw

	call pset%init_direct (0, 2, 0, 0, 3, pdg, model)
	call pset%set_momentum (p, m**2)

	write (u, "(A)") "* Fill process instance"
	write (u, "(A)")

	! workflow from event_recalculate
	call process_instance%choose_mci (1)
	call process_instance%set_trace (pset, 1)
	call process_instance%recover &
	(1, 1, update_sqme=.true., recover_phs=.false.)
	call process_instance%evaluate_event_data (weight = 1._default)

	write (u, "(A)") "* Prepare resonant subprocesses"
	write (u, "(A)")

	call prc_set%prepare_process_objects (global)
	call prc_set%prepare_process_instances (global)

	write (u, "(A)") "* Fill trivial event transform (deliberately w/o color)"
	write (u, "(A)")

	call evt_trivial%connect (process_instance, model)
	call evt_trivial%set_particle_set (pset, 1, 1)
	call evt_trivial%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize resonance-insertion event transform"
	write (u, "(A)")

	evt_trivial%next => evt_resonance
	evt_resonance%previous => evt_trivial

	call evt_resonance%set_resonance_data (res_history_set)
	call evt_resonance%select_component (1)
	call evt_resonance%connect (process_instance, model)
	call prc_set%connect_transform (evt_resonance)
	call evt_resonance%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Compute probabilities for applicable resonances"
	write (u, "(A)") " and initialize the process selector"
	write (u, "(A)")

	on_shell_limit = 10._default
	write (u, "(1x,A,1x," // FMT_10 // ")") &
	"on_shell_limit =", on_shell_limit
	call evt_resonance%set_on_shell_limit (on_shell_limit)

	background_factor = 0
	write (u, "(1x,A,1x," // FMT_10 // ")") &
	"background_factor =", background_factor
	call evt_resonance%set_background_factor (background_factor)

	write (u, "(A)")
	write (u, "(A)") "* Evaluate resonance-insertion event transform"
	write (u, "(A)")

	call evt_resonance%prepare_new_event (1, 1)
	call evt_resonance%generate_weighted (probability)
	call evt_resonance%make_particle_set (1, .false.)

	call evt_resonance%write (u, testflag=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call global%final ()
	call syntax_phs_forest_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: restricted_subprocesses_6"

	end subroutine restricted_subprocesses_6

	@ %def restricted_subprocesses_6
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Simulation}
	This module manages simulation: event generation and reading/writing of event
	files. The [[simulation]] object is intended to be used (via a pointer)
	outside of \whizard, if events are generated individually by an external
	driver.
	<<[[simulations.f90]]>>=
	<<File header>>

	module simulations

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use format_utils, only: write_separator
	use format_defs, only: FMT_15, FMT_19
	use os_interface
	use numeric_utils
	use string_utils, only: str
	use diagnostics
	use lorentz, only: vector4_t
	use sm_qcd
	use md5
	use variables, only: var_list_t
	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 rng_stream, only: rng_stream_t
	use selectors
	use resonances, only: resonance_history_set_t
	use process_libraries, only: process_library_t
	use process_libraries, only: process_component_def_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_isr_epa_handler
	use dispatch_transforms, only: dispatch_evt_resonance
	use dispatch_transforms, only: dispatch_evt_decay
	use dispatch_transforms, only: dispatch_evt_shower
	use dispatch_transforms, only: dispatch_evt_hadrons
	use dispatch_transforms, only: dispatch_evt_nlo

	use integrations
	use event_streams
	use restricted_subprocesses, only: resonant_subprocess_set_t
	use restricted_subprocesses, only: get_libname_res

	use evt_nlo

	<<Use mpi f08>>

	<<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 .and. counter%nlo_weight_counter > 1) then
	print *, "Reconstructed cross-section from event weights: "
	print *, counter%mean, '+-', sqrt (counter%varsq / (counter%nlo_weight_counter - 1))
	end if
	end subroutine counter_show_mean_and_variance

	@ %def counter_show_mean_and_variance
	@ Count an event. The weight and event source are optional; by
	default we assume that the event has been generated and has positive
	weight.
	<<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, pacified)
	class(mci_set_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacified
	logical :: pacify
	integer :: u, i
	u = given_output_unit (unit)
	pacify = .false.; if (present (pacified)) pacify = pacified
	write (u, "(3x,A)") "Components:"
	do i = 1, object%n_components
	write (u, "(5x,I0,A,A,A)") object%i_component(i), &
	": '", char (object%component_id(i)), "'"
	end do
	if (object%has_integral) then
	if (pacify) then
	write (u, "(3x,A," // FMT_15 // ")") "Integral = ", object%integral
	write (u, "(3x,A," // FMT_15 // ")") "Error = ", object%error
	write (u, "(3x,A,F9.6)") "Weight =", object%weight_mci
	else
	write (u, "(3x,A," // FMT_19 // ")") "Integral = ", object%integral
	write (u, "(3x,A," // FMT_19 // ")") "Error = ", object%error
	write (u, "(3x,A,F13.10)") "Weight =", object%weight_mci
	end if
	else
	write (u, "(3x,A)") "Integral = [undefined]"
	end if
	call object%counter%write (u)
	end subroutine mci_set_write

	@ %def mci_set_write
	@ Initialize: Get the indices and names for the process components
	that will contribute to this set.
	<<Simulations: mci set: TBP>>=
	procedure :: init => mci_set_init
	<<Simulations: 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. [[use_process]] implies that the process should
	already exist as an object in the process stack. If integration is
	not yet done, do it. Any generated process object should be put on
	the global stack, if it is separate from the local one.
	<<Simulations: procedures>>=
	subroutine prepare_process &
	(process, process_id, use_process, integrate, local, global)
	type(process_t), pointer, intent(out) :: process
	type(string_t), intent(in) :: process_id
	logical, intent(in) :: use_process, integrate
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	type(rt_data_t), pointer :: current
	call msg_debug (D_CORE, "prepare_process")
	call msg_debug (D_CORE, "global present", present (global))
	if (present (global)) then
	current => global
	else
	current => local
	end if
	process => current%process_stack%get_process_ptr (process_id)
	call msg_debug (D_CORE, "use_process", use_process)
	call msg_debug (D_CORE, "associated process", associated (process))
	if (use_process .and. .not. associated (process)) then
	if (integrate) then
	call msg_message ("Simulate: process '" &
	// char (process_id) // "' needs integration")
	else
	call msg_message ("Simulate: process '" &
	// char (process_id) // "' needs initialization")
	end if
	if (present (global)) then
	call integrate_process (process_id, local, global, &
	init_only = .not. integrate)
	else
	call integrate_process (process_id, local, &
	local_stack = .true., init_only = .not. integrate)
	end if
	if (signal_is_pending ()) return
	process => current%process_stack%get_process_ptr (process_id)
	if (associated (process)) then
	if (integrate) then
	call msg_message ("Simulate: integration done")
	call current%process_stack%fill_result_vars (process_id)
	else
	call msg_message ("Simulate: process initialization done")
	end if
	else
	call msg_fatal ("Simulate: process '" &
	// char (process_id) // "' could not be initialized: aborting")
	end if
	else if (.not. associated (process)) then
	if (present (global)) then
	call integrate_process (process_id, local, global, &
	init_only = .true.)
	else
	call integrate_process (process_id, local, &
	local_stack = .true., init_only = .true.)
	end if
	process => current%process_stack%get_process_ptr (process_id)
	call msg_message &
	("Simulate: process '" &
	// char (process_id) // "': enabled for rescan only")
	end if
	end subroutine prepare_process

	@ %def prepare_process
	@
	\subsection{Simulation entry}
	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
	logical :: has_resonant_subprocess_set = .false.
	type(resonant_subprocess_set_t) :: resonant_subprocess_set
	type(core_safe_t), dimension(:), allocatable :: core_safe
	class(model_data_t), pointer :: model => null ()
	type(qcd_t) :: qcd
	type(entry_t), pointer :: first => null ()
	type(entry_t), pointer :: next => null ()
	class(evt_t), pointer :: evt_powheg => null ()
	contains
	<<Simulations: entry: TBP>>
	end type entry_t

	@ %def entry_t
	@ Output. Write just the configuration, the event is written by a
	separate routine.

	The [[verbose]] option is unused, it is required by the interface of
	the base-object method.
	<<Simulations: entry: TBP>>=
	procedure :: write_config => entry_write_config
	<<Simulations: procedures>>=
	subroutine entry_write_config (object, unit, pacified)
	class(entry_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: pacified
	logical :: pacify
	integer :: u, i
	u = given_output_unit (unit)
	pacify = .false.; if (present (pacified)) pacify = pacified
	write (u, "(3x,A,A,A)") "Process = '", char (object%process_id), "'"
	write (u, "(3x,A,A,A)") "Library = '", char (object%library), "'"
	write (u, "(3x,A,A,A)") "Run = '", char (object%run_id), "'"
	write (u, "(3x,A,L1)") "is valid = ", object%valid
	if (object%has_integral) then
	if (pacify) then
	write (u, "(3x,A," // FMT_15 // ")") "Integral = ", object%integral
	write (u, "(3x,A," // FMT_15 // ")") "Error = ", object%error
	write (u, "(3x,A,F9.6)") "Weight =", object%process_weight
	else
	write (u, "(3x,A," // FMT_19 // ")") "Integral = ", object%integral
	write (u, "(3x,A," // FMT_19 // ")") "Error = ", object%error
	write (u, "(3x,A,F13.10)") "Weight =", object%process_weight
	end if
	else
	write (u, "(3x,A)") "Integral = [undefined]"
	end if
	write (u, "(3x,A,I0)") "MCI sets = ", object%n_mci
	call object%counter%write (u)
	do i = 1, size (object%mci_sets)
	write (u, "(A)")
	write (u, "(1x,A,I0,A)") "MCI set #", i, ":"
	call object%mci_sets(i)%write (u, pacified)
	end do
	if (object%resonant_subprocess_set%is_active ()) then
	write (u, "(A)")
	call object%write_resonant_subprocess_data (u)
	end if
	if (allocated (object%core_safe)) then
	do i = 1, size (object%core_safe)
	write (u, "(1x,A,I0,A)") "Saved process-component core #", i, ":"
	call object%core_safe(i)%core%write (u)
	end do
	end if
	end subroutine entry_write_config

	@ %def entry_write_config
	@ Finalizer. The [[instance]] pointer component of the [[event_t]]
	base type points to a target which we did explicitly allocate in the
	[[entry_init]] procedure. Therefore, we finalize and explicitly
	deallocate it here. Then we call the finalizer of the base type.
	<<Simulations: entry: TBP>>=
	procedure :: final => entry_final
	<<Simulations: 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.

	If [[resonance_history]] is set, we create a separate process library
	which contains all possible restricted subprocesses with distinct
	resonance histories. These processes will not be integrated, but
	their matrix element codes are used for determining probabilities of
	resonance histories. Note that this can work only if the process
	method is OMega, and the phase-space method is 'wood'.

	When done, we assign the [[instance]] and [[process]] pointers of the
	base type by the [[connect]] method, so we can reference them later.
	<<Simulations: entry: TBP>>=
	procedure :: init => entry_init
	<<Simulations: procedures>>=
	subroutine entry_init &
	(entry, process_id, &
	use_process, integrate, generate, update_sqme, &
	support_resonance_history, &
	local, global, n_alt)
	class(entry_t), intent(inout), target :: entry
	type(string_t), intent(in) :: process_id
	logical, intent(in) :: use_process, integrate, generate, update_sqme
	logical, intent(in) :: support_resonance_history
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	integer, intent(in), optional :: n_alt
	type(process_t), pointer :: process, master_process
	type(process_instance_t), pointer :: process_instance
	type(process_library_t), pointer :: prclib_saved
	integer :: i
	logical :: res_include_trivial
	logical :: combined_integration
	integer :: selected_mci
	selected_mci = 0
	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"))) &
	selected_mci = process%extract_active_component_mci ()
	call prepare_process_instance (process_instance, process, local%model, &
	local = local)

	if (generate) then
	if (selected_mci > 0) then
	call process%prepare_simulation (selected_mci)
	call process_instance%init_simulation (selected_mci, entry%config%safety_factor, &
	local%get_lval (var_str ("?keep_failed_events")))
	else
	do i = 1, entry%n_mci
	call process%prepare_simulation (i)
	call process_instance%init_simulation (i, entry%config%safety_factor, &
	local%get_lval (var_str ("?keep_failed_events")))
	end do
	end if
	end if

	if (support_resonance_history) then
	prclib_saved => local%prclib
	call entry%setup_resonant_subprocesses (local, process)
	if (entry%has_resonant_subprocess_set) then
	if (signal_is_pending ()) return
	call entry%compile_resonant_subprocesses (local)
	if (signal_is_pending ()) return
	call entry%prepare_resonant_subprocesses (local, global)
	if (signal_is_pending ()) return
	call entry%prepare_resonant_subprocess_instances (local)
	end if
	if (signal_is_pending ()) return
	if (associated (prclib_saved)) call local%update_prclib (prclib_saved)
	end if

	call entry%setup_event_transforms (process, local)

	call dispatch_qcd (entry%qcd, local%get_var_list_ptr (), local%os_data)

	call entry%connect_qcd ()

	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)
	class(entry_t), intent(inout) :: entry
	integer :: i_active_real
	select type (pcm => entry%instance%pcm)
	class is (pcm_instance_nlo_t)
	i_active_real = entry%instance%get_real_of_mci ()
	call msg_debug2 (D_CORE, "i_active_real", i_active_real)
	if (associated (entry%evt_powheg)) then
	select type (evt => entry%evt_powheg)
	type is (evt_shower_t)
	if (entry%process%get_component_type(i_active_real) == COMP_REAL_FIN) then
	call msg_debug (D_CORE, "Disabling Powheg matching for ", i_active_real)
	call evt%disable_powheg_matching ()
	else
	call msg_debug (D_CORE, "Enabling Powheg matching for ", i_active_real)
	call evt%enable_powheg_matching ()
	end if
	class default
	call msg_fatal ("powheg-evt should be evt_shower_t!")
	end select
	end if
	end select
	end subroutine entry_set_active_real_components

	@ %def entry_set_active_real_components
	@ Part of simulation-entry initialization: set up a process object for
	local use.
	<<Simulations: procedures>>=
	subroutine prepare_local_process (process, process_id, local)
	type(process_t), pointer, intent(inout) :: process
	type(string_t), intent(in) :: process_id
	type(rt_data_t), intent(inout), target :: local
	type(integration_t) :: intg
	call intg%create_process (process_id)
	call intg%init_process (local)
	call intg%setup_process (local, verbose=.false.)
	process => intg%get_process_ptr ()
	end subroutine prepare_local_process

	@ %def prepare_local_process
	@ Part of simulation-entry initialization: set up a process instance
	matching the selected process object.

	The model that we can provide as an extra argument can modify particle
	settings (polarization) in the density matrices that will be constructed. It
	does not affect parameters.
	<<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%set_radiation_event ()
	end select
	end select
	if (process%needs_extra_code () .and. present (local)) then
	call process%create_and_load_extra_libraries &
	(local%beam_structure, process%get_var_list_ptr (), &
	local%os_data)
	end if
	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
	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
	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 + 1))
	evt%event_deps%n_phs = n_phs
	evt%qcd => entry%qcd
	do i = 1, n_phs
	allocate (current_entry%next)
	current_entry%next%first => current_entry%first
	current_entry => current_entry%next
	call entry%copy_entry (current_entry)
	current_entry%i_event = i
	end do
	else
	allocate (evt%particle_set_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. If a transform is not applicable or
	switched off via some variable, it will be skipped.

	Regarding resonances/decays: these two transforms are currently mutually
	exclusive. Resonance insertion will not be applied if there is an
	unstable particle in the game.
	<<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_isr_handler
	logical :: enable_epa_handler
	logical :: enable_fixed_order
	logical :: enable_shower
	var_list => local%get_var_list_ptr ()
	enable_isr_handler = local%get_lval (var_str ("?isr_handler"))
	enable_epa_handler = local%get_lval (var_str ("?epa_handler"))
	if (enable_isr_handler .or. enable_epa_handler) then
	call dispatch_evt_isr_epa_handler (evt, local%var_list)
	if (associated (evt)) call entry%import_transform (evt)
	end if
	if (process%contains_unstable (local%model)) then
	call dispatch_evt_decay (evt, local%var_list)
	if (associated (evt)) call entry%import_transform (evt)
	else if (entry%resonant_subprocess_set%is_active ()) then
	call dispatch_evt_resonance (evt, local%var_list, &
	entry%resonant_subprocess_set%get_resonance_history_set (), &
	entry%resonant_subprocess_set%get_libname ())
	if (associated (evt)) then
	call entry%resonant_subprocess_set%connect_transform (evt)
	call entry%resonant_subprocess_set%set_on_shell_limit &
	(local%get_rval (var_str ("resonance_on_shell_limit")))
	call entry%resonant_subprocess_set%set_on_shell_turnoff &
	(local%get_rval (var_str ("resonance_on_shell_turnoff")))
	call entry%resonant_subprocess_set%set_background_factor &
	(local%get_rval (var_str ("resonance_background_factor")))
	call entry%import_transform (evt)
	end if
	end if
	enable_fixed_order = local%get_lval (var_str ("?fixed_order_nlo_events"))
	if (enable_fixed_order) then
	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, local%get_lval (var_str ("?keep_failed_events")))
	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")
	i_mci = entry%process%extract_active_component_mci ()
	if (i_mci == 0) call entry%mci_selector%generate (entry%rng, i_mci)
	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{Handling resonant subprocesses}
	Resonant subprocesses are required if we want to determine resonance histories
	when generating events. The feature is optional, to be switched on by
	the user.

	This procedure initializes a new, separate process library that
	contains copies of the current process, restricted to the relevant
	resonance histories. (If this library exists already, it is just
	kept.) The histories can be extracted from the process object.

	The code has to match the assignments in
	[[create_resonant_subprocess_library]]. The library may already
	exist -- in that case, here it will be recovered without recompilation.
	<<Simulations: entry: TBP>>=
	procedure :: setup_resonant_subprocesses &
	=> entry_setup_resonant_subprocesses
	<<Simulations: procedures>>=
	subroutine entry_setup_resonant_subprocesses (entry, global, process)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(inout), target :: global
	type(process_t), intent(in), target :: process
	type(string_t) :: libname
	type(resonance_history_set_t) :: res_history_set
	type(process_library_t), pointer :: lib
	type(process_component_def_t), pointer :: process_component_def
	logical :: req_resonant, library_exist
	integer :: i_component
	libname = process%get_library_name ()
	lib => global%prclib_stack%get_library_ptr (libname)
	entry%has_resonant_subprocess_set = lib%req_resonant (process%get_id ())
	if (entry%has_resonant_subprocess_set) then
	libname = get_libname_res (process%get_id ())
	call entry%resonant_subprocess_set%init (process%get_n_components ())
	call entry%resonant_subprocess_set%create_library &
	(libname, global, library_exist)
	do i_component = 1, process%get_n_components ()
	call process%extract_resonance_history_set &
	(res_history_set, i_component = i_component)
	call entry%resonant_subprocess_set%fill_resonances &
	(res_history_set, i_component)
	if (.not. library_exist) then
	process_component_def &
	=> process%get_component_def_ptr (i_component)
	call entry%resonant_subprocess_set%add_to_library &
	(i_component, &
	process_component_def%get_prt_spec_in (), &
	process_component_def%get_prt_spec_out (), &
	global)
	end if
	end do
	call entry%resonant_subprocess_set%freeze_library (global)
	end if
	end subroutine entry_setup_resonant_subprocesses

	@ %def entry_setup_resonant_subprocesses
	@ Compile the resonant-subprocesses library. The library is assumed
	to be the current library in the [[global]] object. This is a simple wrapper.
	<<Simulations: entry: TBP>>=
	procedure :: compile_resonant_subprocesses &
	=> entry_compile_resonant_subprocesses
	<<Simulations: procedures>>=
	subroutine entry_compile_resonant_subprocesses (entry, global)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(inout), target :: global
	call entry%resonant_subprocess_set%compile_library (global)
	end subroutine entry_compile_resonant_subprocesses

	@ %def entry_compile_resonant_subprocesses
	@ Prepare process objects for the resonant-subprocesses library. The
	process objects are appended to the global process stack. We
	initialize the processes, such that we can evaluate matrix elements,
	but we do not need to integrate them.
	<<Simulations: entry: TBP>>=
	procedure :: prepare_resonant_subprocesses &
	=> entry_prepare_resonant_subprocesses
	<<Simulations: procedures>>=
	subroutine entry_prepare_resonant_subprocesses (entry, local, global)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), optional, target :: global
	call entry%resonant_subprocess_set%prepare_process_objects (local, global)
	end subroutine entry_prepare_resonant_subprocesses

	@ %def entry_prepare_resonant_subprocesses
	@ Prepare process instances. They are linked to their corresponding process
	objects. Both, process and instance objects, are allocated as anonymous
	targets inside the [[resonant_subprocess_set]] component.

	NOTE: those anonymous object are likely forgotten during finalization of the
	parent [[event_t]] (extended as [[entry_t]]) object. This should be checked!
	The memory leak is probably harmless as long as the event object is created
	once per run, not once per event.
	<<Simulations: entry: TBP>>=
	procedure :: prepare_resonant_subprocess_instances &
	=> entry_prepare_resonant_subprocess_instances
	<<Simulations: procedures>>=
	subroutine entry_prepare_resonant_subprocess_instances (entry, global)
	class(entry_t), intent(inout) :: entry
	type(rt_data_t), intent(in), target :: global
	call entry%resonant_subprocess_set%prepare_process_instances (global)
	end subroutine entry_prepare_resonant_subprocess_instances

	@ %def entry_prepare_resonant_subprocess_instances
	@ Display the resonant subprocesses. This includes, upon request, the
	resonance set that defines those subprocess, and a short or long account of the
	process objects themselves.
	<<Simulations: entry: TBP>>=
	procedure :: write_resonant_subprocess_data &
	=> entry_write_resonant_subprocess_data
	<<Simulations: procedures>>=
	subroutine entry_write_resonant_subprocess_data (entry, unit)
	class(entry_t), intent(in) :: entry
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	call entry%resonant_subprocess_set%write (unit)
	write (u, "(1x,A,I0)") "Resonant subprocesses refer to &
	&process component #", 1
	end subroutine entry_write_resonant_subprocess_data

	@ %def entry_write_resonant_subprocess_data
	@ Display of the master process for the current event, for diagnostics.
	<<Simulations: entry: TBP>>=
	procedure :: write_process_data => entry_write_process_data
	<<Simulations: procedures>>=
	subroutine entry_write_process_data &
	(entry, unit, show_process, show_instance, verbose)
	class(entry_t), intent(in) :: entry
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: show_process
	logical, intent(in), optional :: show_instance
	logical, intent(in), optional :: verbose
	integer :: u, i
	logical :: s_proc, s_inst, verb
	type(process_t), pointer :: process
	type(process_instance_t), pointer :: instance
	u = given_output_unit (unit)
	s_proc = .false.; if (present (show_process)) s_proc = show_process
	s_inst = .false.; if (present (show_instance)) s_inst = show_instance
	verb = .false.; if (present (verbose)) verb = verbose
	if (s_proc .or. s_inst) then
	write (u, "(1x,A,':')") "Process data"
	if (s_proc) then
	process => entry%process
	if (associated (process)) then
	if (verb) then
	call write_separator (u, 2)
	call process%write (.false., u)
	else
	call process%show (u, verbose=.false.)
	end if
	else
	write (u, "(3x,A)") "[not associated]"
	end if
	end if
	if (s_inst) then
	instance => entry%instance
	if (associated (instance)) then
	if (verb) then
	call instance%write (u)
	else
	call instance%write_header (u)
	end if
	else
	write (u, "(3x,A)") "Process instance: [not associated]"
	end if
	end if
	end if
	end subroutine entry_write_process_data

	@ %def entry_write_process_data
	@
	\subsection{Entries for alternative environment}
	Entries for alternate environments. [No additional components
	anymore, so somewhat redundant.]
	<<Simulations: types>>=
	type, extends (entry_t) :: alt_entry_t
	contains
	<<Simulations: alt entry: TBP>>
	end type alt_entry_t

	@ %def alt_entry_t
	The alternative entries are there to re-evaluate the event, given
	momenta, in a different context.

	Therefore, we allocate a local process object and use this as the
	reference for the local process instance, when initializing the entry.
	We temporarily import the [[process]] object into an [[integration_t]]
	wrapper, to take advantage of the associated methods. The local
	process object is built in the context of the current environment,
	here called [[global]]. Then, we initialize the process instance.

	The [[master_process]] object contains the integration results to which we
	refer when recalculating an event. Therefore, we use this object instead of
	the locally built [[process]] when we extract the integration results.

	The locally built [[process]] object should be finalized when done. It
	remains accessible via the [[event_t]] base object of [[entry]], which
	contains pointers to the process and instance.
	<<Simulations: alt entry: TBP>>=
	procedure :: init_alt => alt_entry_init
	<<Simulations: 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 :: support_resonance_history = .false.
	logical :: respect_selection = .true.
	integer :: norm_mode = NORM_UNDEFINED
	logical :: update_sqme = .false.
	logical :: update_weight = .false.
	logical :: update_event = .false.
	logical :: recover_beams = .false.
	logical :: pacify = .false.
	integer :: n_max_tries = 10000
	integer :: n_prc = 0
	integer :: n_alt = 0
	logical :: has_integral = .false.
	logical :: valid = .false.
	real(default) :: integral = 0
	real(default) :: error = 0
	integer :: version = 1
	character(32) :: md5sum_prc = ""
	character(32) :: md5sum_cfg = ""
	character(32), dimension(:), allocatable :: md5sum_alt
	type(entry_t), dimension(:), allocatable :: entry
	type(alt_entry_t), dimension(:,:), allocatable :: alt_entry
	type(selector_t) :: process_selector
	integer :: n_evt_requested = 0
	integer :: event_index_offset = 0
	logical :: event_index_set = .false.
	integer :: event_index = 0
	integer :: split_n_evt = 0
	integer :: split_n_kbytes = 0
	integer :: split_index = 0
	type(counter_t) :: counter
	class(rng_t), allocatable :: rng
	integer :: i_prc = 0
	integer :: i_mci = 0
	real(default) :: weight = 0
	real(default) :: excess = 0
	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, testflag)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	logical :: pacified
	integer :: u, i
	u = given_output_unit (unit)
	pacified = object%pacify; if (present (testflag)) pacified = testflag
	call write_separator (u, 2)
	write (u, "(1x,A,A,A)") "Event sample: '", char (object%sample_id), "'"
	write (u, "(3x,A,I0)") "Processes = ", object%n_prc
	if (object%n_alt > 0) then
	write (u, "(3x,A,I0)") "Alt.wgts = ", object%n_alt
	end if
	write (u, "(3x,A,L1)") "Unweighted = ", object%unweighted
	write (u, "(3x,A,A)") "Event norm = ", &
	char (event_normalization_string (object%norm_mode))
	write (u, "(3x,A,L1)") "Neg. weights = ", object%negative_weights
	write (u, "(3x,A,L1)") "Res. history = ", object%support_resonance_history
	write (u, "(3x,A,L1)") "Respect sel. = ", object%respect_selection
	write (u, "(3x,A,L1)") "Update sqme = ", object%update_sqme
	write (u, "(3x,A,L1)") "Update wgt = ", object%update_weight
	write (u, "(3x,A,L1)") "Update event = ", object%update_event
	write (u, "(3x,A,L1)") "Recov. beams = ", object%recover_beams
	write (u, "(3x,A,L1)") "Pacify = ", object%pacify
	write (u, "(3x,A,I0)") "Max. tries = ", object%n_max_tries
	if (object%has_integral) then
	if (pacified) then
	write (u, "(3x,A," // FMT_15 // ")") &
	"Integral = ", object%integral
	write (u, "(3x,A," // FMT_15 // ")") &
	"Error = ", object%error
	else
	write (u, "(3x,A," // FMT_19 // ")") &
	"Integral = ", object%integral
	write (u, "(3x,A," // FMT_19 // ")") &
	"Error = ", object%error
	end if
	else
	write (u, "(3x,A)") "Integral = [undefined]"
	end if
	write (u, "(3x,A,L1)") "Sim. valid = ", object%valid
	write (u, "(3x,A,I0)") "Ev.file ver. = ", object%version
	if (object%md5sum_prc /= "") then
	write (u, "(3x,A,A,A)") "MD5 sum (proc) = '", object%md5sum_prc, "'"
	end if
	if (object%md5sum_cfg /= "") then
	write (u, "(3x,A,A,A)") "MD5 sum (config) = '", object%md5sum_cfg, "'"
	end if
	write (u, "(3x,A,I0)") "Events requested = ", object%n_evt_requested
	if (object%event_index_offset /= 0) then
	write (u, "(3x,A,I0)") "Event index offset= ", object%event_index_offset
	end if
	if (object%event_index_set) then
	write (u, "(3x,A,I0)") "Event index = ", object%event_index
	end if
	if (object%split_n_evt > 0 .or. object%split_n_kbytes > 0) then
	write (u, "(3x,A,I0)") "Events per file = ", object%split_n_evt
	write (u, "(3x,A,I0)") "KBytes per file = ", object%split_n_kbytes
	write (u, "(3x,A,I0)") "First file index = ", object%split_index
	end if
	call object%counter%write (u)
	call write_separator (u)
	if (object%i_prc /= 0) then
	write (u, "(1x,A)") "Current event:"
	write (u, "(3x,A,I0,A,A)") "Process #", &
	object%i_prc, ": ", &
	char (object%entry(object%i_prc)%process_id)
	write (u, "(3x,A,I0)") "MCI set #", object%i_mci
	write (u, "(3x,A," // FMT_19 // ")") "Weight = ", object%weight
	if (.not. vanishes (object%excess)) &
	write (u, "(3x,A," // FMT_19 // ")") "Excess = ", object%excess
	else
	write (u, "(1x,A,I0,A,A)") "Current event: [undefined]"
	end if
	call write_separator (u)
	if (allocated (object%rng)) then
	call object%rng%write (u)
	else
	write (u, "(3x,A)") "Random-number generator: [undefined]"
	end if
	if (allocated (object%entry)) then
	do i = 1, size (object%entry)
	if (i == 1) then
	call write_separator (u, 2)
	else
	call write_separator (u)
	end if
	write (u, "(1x,A,I0,A)") "Process #", i, ":"
	call object%entry(i)%write_config (u, pacified)
	end do
	end if
	call write_separator (u, 2)
	end subroutine simulation_write

	@ %def simulation_write
	@ Write the current event record. If an explicit index is given,
	write that event record.

	We implement writing to [[unit]] (event contents / debugging format)
	and writing to an [[eio]] event stream (storage). We include a [[testflag]]
	in order to suppress numerical noise in the testsuite.
	<<Simulations: simulation: TBP>>=
	generic :: write_event => write_event_unit
	procedure :: write_event_unit => simulation_write_event_unit
	<<Simulations: 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
	@ This writes the contents of the resonant subprocess set in the current event
	record.
	<<Simulations: simulation: TBP>>=
	procedure :: write_resonant_subprocess_data &
	=> simulation_write_resonant_subprocess_data
	<<Simulations: procedures>>=
	subroutine simulation_write_resonant_subprocess_data (object, unit, i_prc)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: i_prc
	integer :: i
	if (present (i_prc)) then
	i = i_prc
	else
	i = object%i_prc
	end if
	call object%entry(i)%write_resonant_subprocess_data (unit)
	end subroutine simulation_write_resonant_subprocess_data

	@ %def simulation_write_resonant_subprocess_data
	@ The same for the master process, as an additional debugging aid.
	<<Simulations: simulation: TBP>>=
	procedure :: write_process_data &
	=> simulation_write_process_data
	<<Simulations: procedures>>=
	subroutine simulation_write_process_data &
	(object, unit, i_prc, &
	show_process, show_instance, verbose)
	class(simulation_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer, intent(in), optional :: i_prc
	logical, intent(in), optional :: show_process
	logical, intent(in), optional :: show_instance
	logical, intent(in), optional :: verbose
	integer :: i
	if (present (i_prc)) then
	i = i_prc
	else
	i = object%i_prc
	end if
	call object%entry(i)%write_process_data &
	(unit, show_process, show_instance, verbose)
	end subroutine simulation_write_process_data

	@ %def simulation_write_process_data
	@ 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
	type(string_t) :: sample_suffix
	<<Simulations: simulation init: variables>>
	sample_suffix = ""
	<<Simulations: simulation init: init>>
	simulation%local => local
	simulation%sample_id = &
	local%get_sval (var_str ("$sample")) // sample_suffix
	simulation%unweighted = &
	local%get_lval (var_str ("?unweighted"))
	simulation%negative_weights = &
	local%get_lval (var_str ("?negative_weights"))
	simulation%support_resonance_history = &
	local%get_lval (var_str ("?resonance_history"))
	simulation%respect_selection = &
	local%get_lval (var_str ("?sample_select"))
	version_string = &
	local%get_sval (var_str ("$event_file_version"))
	norm_string = &
	local%get_sval (var_str ("$sample_normalization"))
	simulation%norm_mode = &
	event_normalization_mode (norm_string, simulation%unweighted)
	simulation%pacify = &
	local%get_lval (var_str ("?sample_pacify"))
	simulation%event_index_offset = &
	local%get_ival (var_str ("event_index_offset"))
	simulation%n_max_tries = &
	local%get_ival (var_str ("sample_max_tries"))
	simulation%split_n_evt = &
	local%get_ival (var_str ("sample_split_n_evt"))
	simulation%split_n_kbytes = &
	local%get_ival (var_str ("sample_split_n_kbytes"))
	simulation%split_index = &
	local%get_ival (var_str ("sample_split_index"))
	simulation%update_sqme = &
	local%get_lval (var_str ("?update_sqme"))
	simulation%update_weight = &
	local%get_lval (var_str ("?update_weight"))
	simulation%update_event = &
	local%get_lval (var_str ("?update_event"))
	simulation%recover_beams = &
	local%get_lval (var_str ("?recover_beams"))
	simulation%counter%reproduce_xsection = &
	local%get_lval (var_str ("?check_event_weights_against_xsection"))
	use_process = &
	integrate .or. generate &
	.or. simulation%update_sqme &
	.or. simulation%update_weight &
	.or. simulation%update_event &
	.or. present (alt_env)
	select case (size (process_id))
	case (0)
	call msg_error ("Simulation: no process selected")
	case (1)
	write (msg_buffer, "(A,A,A)") &
	"Starting simulation for process '", &
	char (process_id(1)), "'"
	call msg_message ()
	case default
	write (msg_buffer, "(A,A,A)") &
	"Starting simulation for processes '", &
	char (process_id(1)), "' etc."
	call msg_message ()
	end select
	select case (char (version_string))
	case ("", "2.2.4")
	simulation%version = 2
	case ("2.2")
	simulation%version = 1
	case default
	simulation%version = 0
	end select
	if (simulation%version == 0) then
	call msg_fatal ("Event file format '" &
	// char (version_string) &
	// "' is not compatible with this version.")
	end if
	simulation%n_prc = size (process_id)
	allocate (simulation%entry (simulation%n_prc))
	if (present (alt_env)) then
	simulation%n_alt = size (alt_env)
	do i = 1, simulation%n_prc
	call simulation%entry(i)%init (process_id(i), &
	use_process, integrate, generate, &
	simulation%update_sqme, &
	simulation%support_resonance_history, &
	local, global, simulation%n_alt)
	if (signal_is_pending ()) return
	end do
	simulation%valid = any (simulation%entry%valid)
	if (.not. simulation%valid) then
	call msg_error ("Simulate: no process has a valid matrix element.")
	return
	end if
	call simulation%update_processes ()
	allocate (simulation%alt_entry (simulation%n_prc, simulation%n_alt))
	allocate (simulation%md5sum_alt (simulation%n_alt))
	simulation%md5sum_alt = ""
	do j = 1, simulation%n_alt
	do i = 1, simulation%n_prc
	call simulation%alt_entry(i,j)%init_alt (process_id(i), &
	simulation%entry(i)%get_process_ptr (), alt_env(j))
	if (signal_is_pending ()) return
	end do
	end do
	call simulation%restore_processes ()
	else
	do i = 1, simulation%n_prc
	call simulation%entry(i)%init &
	(process_id(i), &
	use_process, integrate, generate, &
	simulation%update_sqme, &
	simulation%support_resonance_history, &
	local, global)
	call simulation%entry(i)%determine_if_powheg_matching ()
	if (signal_is_pending ()) return
	if (simulation%entry(i)%is_nlo ()) &
	call simulation%entry(i)%setup_additional_entries ()
	end do
	simulation%valid = any (simulation%entry%valid)
	if (.not. simulation%valid) then
	call msg_error ("Simulate: " &
	// "no process has a valid matrix element.")
	return
	end if
	end if
	!!! if this becomes conditional, some ref files will need update (seed change)
	! if (generate) then
	call dispatch_rng_factory (rng_factory, local%var_list)
	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
	@
	<<MPI: Simulations: simulation init: variables>>=
	integer :: rank, n_size
	@
	<<MPI: Simulations: simulation init: init>>=
	call mpi_get_comm_id (n_size, rank)
	if (n_size > 1) then
	sample_suffix = var_str ("_") // str (rank)
	end if
	@
	@ 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
	<<Simulations: simulation generate: variables>>
	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 ()
	call simulation%init_event_index ()
	<<Simulations: simulation generate: init>>
	do i = start_it, end_it
	call simulation%increment_event_index ()
	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))
	entry%instance%i_mci = simulation%i_mci
	call entry%set_active_real_components ()
	current_entry => entry%get_first ()
	do k = 1, current_entry%count_nlo_entries ()
	if (k > 1) then
	current_entry => current_entry%get_next ()
	current_entry%particle_set => current_entry%first%particle_set
	current_entry%particle_set_is_valid &
	= current_entry%first%particle_set_is_valid
	end if
	do j = 1, simulation%n_max_tries
	if (.not. current_entry%valid) call msg_warning &
	("Process '" // char (current_entry%process_id) // "': " // &
	"matrix element vanishes, no events can be generated.")
	call current_entry%generate (simulation%i_mci, i_nlo = k)
	if (signal_is_pending ()) return
	call simulation%counter%record_mean_and_variance &
	(current_entry%weight_prc, k)
	if (current_entry%has_valid_particle_set ()) exit
	end do
	end do
	if (entry%is_nlo ()) call entry%reset_nlo_counter ()
	if (.not. entry%has_valid_particle_set ()) then
	write (msg_buffer, "(A,I0,A)") "Simulation: failed to &
	&generate valid event after ", &
	simulation%n_max_tries, " tries (sample_max_tries)"
	call msg_fatal ()
	end if
	current_entry => entry%get_first ()
	do k = 1, current_entry%count_nlo_entries ()
	if (k > 1) current_entry => current_entry%get_next ()
	call current_entry%set_index (simulation%get_event_index ())
	call current_entry%evaluate_expressions ()
	end do
	if (signal_is_pending ()) return
	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 simulation%set_event_index (entry%get_index ())
	call entry%accept_sqme_ref ()
	call entry%accept_weight_ref ()
	call entry%check ()
	call entry%evaluate_expressions ()
	if (signal_is_pending ()) return
	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
	<<Simulations: simulation generate: finalize>>
	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
	@
	<<Simulations: simulation generate: variables>>=
	integer :: start_it, end_it
	@
	<<Simulations: simulation generate: init>>=
	start_it = 1
	end_it = n
	@
	<<Simulations: simulation generate: finalize>>=
	@
	<<MPI: Simulations: simulation generate: variables>>=
	integer :: n_size, rank
	integer :: worker_n_events, root_n_events
	<<MPI: Simulations: simulation generate: init>>=
	call mpi_get_comm_id (n_size, rank)
	if (n_size > 1) then
	start_it = start_it + nint (rank * (real (n) / n_size))
	end_it = min (nint ((rank + 1) * (real (n) / n_size)), n)
	write (msg_buffer, "(A,I0,A,I0,A)") &
	& "MPI: generate events [", start_it, ":", end_it, "]"
	call msg_message ()
	do i = 1, rank + 1
	select type (rng => simulation%rng)
	type is (rng_stream_t)
	call rng%next_substream ()
	end select
	end do
	end if
	@
	<<MPI: Simulations: simulation generate: finalize>>=
	call MPI_Barrier (MPI_COMM_WORLD)
	if (n_size > 1) then
	worker_n_events = end_it - start_it + 1
	call MPI_Reduce (worker_n_events, root_n_events, 1, MPI_INTEGER, MPI_SUM,&
	& 0, MPI_COMM_WORLD)
	if (rank == 0) then
	write (msg_buffer, "(A,I0)") "MPI: Number of generated events in world = ", root_n_events
	call msg_message ()
	end if
	end if
	@
	@ 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%set_index (simulation%get_event_index ())
	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 ()
	call simulation%init_event_index ()
	do
	call simulation%increment_event_index ()
	call simulation%read_event (es_array, .false., complete)
	if (complete) exit
	if (simulation%update_event &
	.or. simulation%update_sqme &
	.or. simulation%update_weight) then
	call simulation%recalculate ()
	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
	@ Here we handle the event index that is kept in the simulation record. The
	event index is valid for the current sample. When generating or reading
	events, we initialize the index with the offset that the user provides (if any)
	and increment it for each event that is generated or read from file. The event
	index is stored in the event-entry that is current for the event. If an
	event on file comes with its own index, that index overwrites the predefined
	one and also resets the index within the simulation record.

	The event index is not connected to the [[counter]] object. The counter is
	supposed to collect statistical information. The event index is a user-level
	object that is visible in event records and analysis expressions.
	<<Simulations: simulation: TBP>>=
	procedure :: init_event_index => simulation_init_event_index
	procedure :: increment_event_index => simulation_increment_event_index
	procedure :: set_event_index => simulation_set_event_index
	procedure :: get_event_index => simulation_get_event_index
	<<Simulations: procedures>>=
	subroutine simulation_init_event_index (simulation)
	class(simulation_t), intent(inout) :: simulation
	call simulation%set_event_index (simulation%event_index_offset)
	end subroutine simulation_init_event_index

	subroutine simulation_increment_event_index (simulation)
	class(simulation_t), intent(inout) :: simulation
	if (simulation%event_index_set) then
	simulation%event_index = simulation%event_index + 1
	end if
	end subroutine simulation_increment_event_index

	subroutine simulation_set_event_index (simulation, i)
	class(simulation_t), intent(inout) :: simulation
	integer, intent(in) :: i
	simulation%event_index = i
	simulation%event_index_set = .true.
	end subroutine simulation_set_event_index

	function simulation_get_event_index (simulation) result (i)
	class(simulation_t), intent(in) :: simulation
	integer :: i
	if (simulation%event_index_set) then
	i = simulation%event_index
	else
	i = 0
	end if
	end function simulation_get_event_index

	@ %def simulation_init_event_index
	@ %def simulation_increment_event_index
	@ %def simulation_set_event_index
	@ %def simulation_get_event_index
	@
	@ 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) then
	if (mod (object%counter%total, object%split_n_evt) == 1) then
	call eio%split_out ()
	end if
	else if (object%split_n_kbytes > 0) then
	call eio%update_split_count (increased)
	if (increased) call eio%split_out ()
	end if
	call eio%output (object%entry(current)%event_t, current, pacify = object%pacify)
	else
	call msg_fatal ("Simulation: write event: no process selected")
	end if
	end subroutine simulation_write_event_eio

	@ %def simulation_write_event
	@
	Read an event from a generic [[eio]] event stream. The event stream element
	must specify the process within the sample ([[i_prc]]), the MC group for this
	process ([[i_mci]]), the selected term ([[i_term]]), the selected MC
	integration [[channel]], and the particle set of the event.

	We may encounter EOF, which we indicate by storing 0 for the process index
	[[i_prc]]. An I/O error will be reported, and we also abort reading.
	<<Simulations: simulation: TBP>>=
	generic :: read_event => read_event_eio
	procedure :: read_event_eio => simulation_read_event_eio
	<<Simulations: 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 current_entry%set_index (object%get_event_index ())
	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]].

	If [[recover_phs]] is set (and false), do not attempt any phase-space
	calculation. Useful if we need only matrix elements (esp. testing); this flag
	is not stored in the simulation record.
	<<Simulations: simulation: TBP>>=
	procedure :: recalculate => simulation_recalculate
	<<Simulations: procedures>>=
	subroutine simulation_recalculate (simulation, recover_phs)
	class(simulation_t), intent(inout) :: simulation
	logical, intent(in), optional :: recover_phs
	integer :: i_prc
	i_prc = simulation%i_prc
	associate (entry => simulation%entry(i_prc))
	if (simulation%update_weight) then
	call entry%recalculate &
	(update_sqme = simulation%update_sqme, &
	recover_beams = simulation%recover_beams, &
	recover_phs = recover_phs, &
	weight_factor = entry%get_kinematical_weight ())
	else
	call entry%recalculate &
	(update_sqme = simulation%update_sqme, &
	recover_beams = simulation%recover_beams, &
	recover_phs = recover_phs)
	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
	call msg_debug (D_CORE, "simulation_get_data")
	call msg_debug (D_CORE, "alternative setup", enable_alt)
	if (enable_alt) then
	call sdata%init (simulation%n_prc, simulation%n_alt)
	do i = 1, simulation%n_alt
	sdata%md5sum_alt(i) = simulation%get_md5sum_alt (i)
	end do
	else
	call sdata%init (simulation%n_prc)
	end if
	sdata%unweighted = simulation%unweighted
	sdata%negative_weights = simulation%negative_weights
	sdata%norm_mode = simulation%norm_mode
	process => simulation%entry(1)%get_process_ptr ()
	if (associated (process)) then
	beam_data => process%get_beam_data_ptr ()
	construct_beam_data = .false.
	else
	n = simulation%entry(1)%n_in
	sqrts = simulation%local%get_sqrts ()
	beam_structure => simulation%local%beam_structure
	call beam_structure%check_against_n_in (n, construct_beam_data)
	if (construct_beam_data) then
	allocate (beam_data)
	model => simulation%local%model
	decay_rest_frame = &
	simulation%local%get_lval (var_str ("?decay_rest_frame"))
	call beam_data%init_structure (beam_structure, &
	sqrts, model, decay_rest_frame)
	else
	beam_data => null ()
	end if
	end if
	if (associated (beam_data)) then
	n = beam_data%get_n_in ()
	sdata%n_beam = n
	allocate (flv (n))
	flv = beam_data%get_flavor ()
	sdata%pdg_beam(:n) = flv%get_pdg ()
	sdata%energy_beam(:n) = beam_data%get_energy ()
	if (construct_beam_data) deallocate (beam_data)
	else
	n = simulation%entry(1)%n_in
	sdata%n_beam = n
	process_id = simulation%entry(1)%process_id
	call simulation%local%prclib%get_pdg_in_1 &
	(process_id, sdata%pdg_beam(:n))
	sdata%energy_beam(:n) = sqrts / n
	end if
	do i = 1, simulation%n_prc
	if (.not. simulation%entry(i)%valid) cycle
	process => simulation%entry(i)%get_process_ptr ()
	if (associated (process)) then
	sdata%proc_num_id(i) = process%get_num_id ()
	else
	process_id = simulation%entry(i)%process_id
	sdata%proc_num_id(i) = simulation%local%prclib%get_num_id (process_id)
	end if
	if (sdata%proc_num_id(i) == 0) sdata%proc_num_id(i) = i
	if (simulation%entry(i)%has_integral) then
	sdata%cross_section(i) = simulation%entry(i)%integral
	sdata%error(i) = simulation%entry(i)%error
	end if
	end do
	sdata%total_cross_section = sum (sdata%cross_section)
	sdata%md5sum_prc = simulation%get_md5sum_prc ()
	sdata%md5sum_cfg = simulation%get_md5sum_cfg ()
	if (simulation%split_n_evt > 0 .or. simulation%split_n_kbytes > 0) then
	sdata%split_n_evt = simulation%split_n_evt
	sdata%split_n_kbytes = simulation%split_n_kbytes
	sdata%split_index = simulation%split_index
	end if
	end function simulation_get_data

	@ %def simulation_get_data
	@ Return a default name for the current event sample. This is the
	process ID of the first process.
	<<Simulations: simulation: TBP>>=
	procedure :: get_default_sample_name => simulation_get_default_sample_name
	<<Simulations: 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
	@
	Return the hard-interaction particle set for event entry [[i_prc]].
	<<Simulations: simulation: TBP>>=
	procedure :: get_hard_particle_set => simulation_get_hard_particle_set
	<<Simulations: procedures>>=
	function simulation_get_hard_particle_set (simulation, i_prc) result (pset)
	class(simulation_t), intent(in) :: simulation
	integer, intent(in) :: i_prc
	type(particle_set_t) :: pset
	call simulation%entry(i_prc)%get_hard_particle_set (pset)
	end function simulation_get_hard_particle_set

	@ %def simulation_get_hard_particle_set
	@
	\subsection{Auxiliary}
	Call pacify: eliminate numerical noise.
	<<Simulations: public>>=
	public :: pacify
	<<Simulations: interfaces>>=
	interface pacify
	module procedure pacify_simulation
	end interface
	<<Simulations: 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
	@ Manually evaluate expressions for the currently selected process.
	This is used only in the unit tests.
	<<Simulations: simulation: TBP>>=
	procedure :: evaluate_expressions => simulation_evaluate_expressions
	<<Simulations: 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
	@ Manually evaluate event transforms for the currently selected
	process. This is used only in the unit tests.
	<<Simulations: simulation: TBP>>=
	procedure :: evaluate_transforms => simulation_evaluate_transforms
	<<Simulations: procedures>>=
	subroutine simulation_evaluate_transforms (simulation)
	class(simulation_t), intent(inout) :: simulation
	associate (entry => simulation%entry(simulation%i_prc))
	call entry%evaluate_transforms ()
	end associate
	end subroutine simulation_evaluate_transforms

	@ %def simulation_evaluate_transforms
	@
	\subsection{Unit tests}
	Test module, followed by the stand-alone unit-test procedures.
	<<[[simulations_ut.f90]]>>=
	<<File header>>

	module simulations_ut
	use unit_tests
	use simulations_uti

	<<Standard module head>>

	<<Simulations: public test>>

	contains

	<<Simulations: test driver>>

	end module simulations_ut
	@ %def simulations_ut
	@
	<<[[simulations_uti.f90]]>>=
	<<File header>>

	module simulations_uti

	<<Use kinds>>
	use kinds, only: i64
	<<Use strings>>
	use io_units
	use format_defs, only: FMT_10, FMT_12
	use ifiles
	use lexers
	use parser
	use lorentz
	use flavors
	use interactions, only: reset_interaction_counter
	use process_libraries, only: process_library_t
	use prclib_stacks
	use phs_forests
	use event_base, only: generic_event_t
	use event_base, only: event_callback_t
	use particles, only: particle_set_t
	use eio_data
	use eio_base
	use eio_direct, only: eio_direct_t
	use eio_raw
	use eio_ascii
	use eio_dump
	use eio_callback
	use eval_trees
	use model_data, only: model_data_t
	use models
	use rt_data
	use event_streams
	use decays_ut, only: prepare_testbed
	use process, only: process_t
	use process_stacks, only: process_entry_t
	use process_configurations_ut, only: prepare_test_library
	use compilations, only: compile_library
	use integrations, only: integrate_process

	use simulations

	use restricted_subprocesses_uti, only: prepare_resonance_test_library

	<<Standard module head>>

	<<Simulations: test declarations>>

	<<Simulations: test auxiliary types>>

	contains

	<<Simulations: tests>>

	<<Simulations: test auxiliary>>

	end module simulations_uti

	@ %def simulations_uti
	@ API: driver for the unit tests below.
	<<Simulations: public test>>=
	public :: simulations_test
	<<Simulations: test driver>>=
	subroutine simulations_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Simulations: execute tests>>
	end subroutine simulations_test

	@ %def simulations_test
	@
	\subsubsection{Initialization}
	Initialize a [[simulation_t]] object, including the embedded event records.
	<<Simulations: execute tests>>=
	call test (simulations_1, "simulations_1", &
	"initialization", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_1
	<<Simulations: tests>>=
	subroutine simulations_1 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1, procname2
	type(rt_data_t), target :: global
	type(simulation_t), target :: simulation

	write (u, "(A)") "* Test output: simulations_1"
	write (u, "(A)") "* Purpose: initialize simulation"
	write (u, "(A)")

	write (u, "(A)") "* Initialize processes"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_1a"
	procname1 = "simulation_1p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	procname2 = "sim_extra"

	call prepare_test_library (global, libname, 1, [procname2])
	call compile_library (libname, global)
	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations2"), is_known = .true.)


	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_string (var_str ("$sample"), &
	var_str ("sim1"), is_known = .true.)
	call integrate_process (procname2, global, local_stack=.true.)

	call simulation%init ([procname1, procname2], .false., .true., global)
	call simulation%init_process_selector ()
	call simulation%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the event record for the first process"
	write (u, "(A)")

	call simulation%write_event (u, i_prc = 1)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_1"

	end subroutine simulations_1

	@ %def simulations_1
	@
	\subsubsection{Weighted events}
	Generate events for a single process.
	<<Simulations: execute tests>>=
	call test (simulations_2, "simulations_2", &
	"weighted events", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_2
	<<Simulations: tests>>=
	subroutine simulations_2 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, procname1
	type(rt_data_t), target :: global
	type(simulation_t), target :: simulation
	type(event_sample_data_t) :: data

	write (u, "(A)") "* Test output: simulations_2"
	write (u, "(A)") "* Purpose: generate events for a single process"
	write (u, "(A)")

	write (u, "(A)") "* Initialize processes"
	write (u, "(A)")

	call syntax_model_file_init ()

	call global%global_init ()
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)

	libname = "simulation_2a"
	procname1 = "simulation_2p"

	call prepare_test_library (global, libname, 1, [procname1])
	call compile_library (libname, global)

	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)

	call global%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known = .true.)
	call global%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known = .true.)
	call global%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known = .true.)
	call global%set_log (var_str ("?vis_history"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)

	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)

	call global%it_list%init ([1], [1000])

	call global%set_string (var_str ("$run_id"), &
	var_str ("simulations1"), is_known = .true.)
	call integrate_process (procname1, global, local_stack=.true.)

	write (u, "(A)") "* Initialize event generation"
	write (u, "(A)")

	call global%set_log (var_str ("?unweighted"), &
	.false., is_known = .true.)
	call simulation%init ([procname1], .true., .true., global)
	call simulation%init_process_selector ()

	data = simulation%get_data ()
	call data%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Generate three events"
	write (u, "(A)")

	call simulation%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
	@
	\subsubsection{Resonant subprocess setup}
	Prepare a process with resonances and enter resonant subprocesses in
	the simulation object. Select a kinematics configuration and compute
	probabilities for resonant subprocesses.

	The process and its initialization is taken from [[processes_18]], but
	we need a complete \oMega\ matrix element here.
	<<Simulations: execute tests>>=
	call test (simulations_14, "simulations_14", &
	"resonant subprocesses evaluation", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_14
	<<Simulations: tests>>=
	subroutine simulations_14 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, libname_generated
	type(string_t) :: procname
	type(string_t) :: model_name
	type(rt_data_t), target :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	class(model_t), pointer :: model
	class(model_data_t), pointer :: model_data
	type(simulation_t), target :: simulation
	type(particle_set_t) :: pset
	type(eio_direct_t) :: eio_in
	type(eio_dump_t) :: eio_out
	real(default) :: sqrts, mw, pp
	real(default), dimension(3) :: p3
	type(vector4_t), dimension(:), allocatable :: p
	real(default), dimension(:), allocatable :: m
	integer :: u_verbose, i
	real(default) :: sqme_proc
	real(default), dimension(:), allocatable :: sqme
	real(default) :: on_shell_limit
	integer, dimension(:), allocatable :: i_array
	real(default), dimension(:), allocatable :: prob_array

	write (u, "(A)") "* Test output: simulations_14"
	write (u, "(A)") "* Purpose: construct resonant subprocesses &
	&in the simulation object"
	write (u, "(A)")

	write (u, "(A)") "* Build and load a test library with one process"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	libname = "simulations_14_lib"
	procname = "simulations_14_p"

	call global%global_init ()
	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?update_sqme"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_weight"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_event"), &
	.true., is_known = .true.)

	model_name = "SM"
	call global%select_model (model_name)
	allocate (model)
	call model%init_instance (global%model)
	model_data => model

	write (u, "(A)") "* Initialize process library and process"
	write (u, "(A)")

	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)

	call prepare_resonance_test_library &
	(lib, libname, procname, model_data, global, u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize simulation object &
	&with resonant subprocesses"
	write (u, "(A)")

	call global%set_log (var_str ("?resonance_history"), &
	.true., is_known = .true.)
	call global%set_real (var_str ("resonance_on_shell_limit"), &
	10._default, is_known = .true.)

	call simulation%init ([procname], &
	integrate=.false., generate=.false., local=global)

	call simulation%write_resonant_subprocess_data (u, 1)

	write (u, "(A)")
	write (u, "(A)") "* Resonant subprocesses: generated library"
	write (u, "(A)")

	libname_generated = procname // "_R"
	lib => global%prclib_stack%get_library_ptr (libname_generated)
	if (associated (lib)) call lib%write (u, libpath=.false.)

	write (u, "(A)")
	write (u, "(A)") "* Generated process stack"
	write (u, "(A)")

	call global%process_stack%show (u)

	write (u, "(A)")
	write (u, "(A)") "* Particle set"
	write (u, "(A)")

	pset = simulation%get_hard_particle_set (1)
	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize object for direct access"
	write (u, "(A)")

	call eio_in%init_direct &
	(n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 3, &
	pdg = [-11, 11, 1, -2, 24], model=global%model)
	call eio_in%set_selection_indices (1, 1, 1, 1)

	sqrts = global%get_rval (var_str ("sqrts"))
	mw = 80._default ! deliberately slightly different from true mw
	pp = sqrt (sqrts*2 - 4 mw**2) / 2

	allocate (p (5), m (5))
	p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
	m(1) = 0
	p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
	m(2) = 0
	p3(1) = pp/2
	p3(2) = mw/2
	p3(3) = 0
	p(3) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(3) = 0
	p3(2) = -mw/2
	p(4) = vector4_moving (sqrts/4, vector3_moving (p3))
	m(4) = 0
	p(5) = vector4_moving (sqrts/2,-pp, 1)
	m(5) = mw
	call eio_in%set_momentum (p, m**2)

	call eio_in%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Transfer and show particle set"
	write (u, "(A)")

	call simulation%read_event (eio_in)
	pset = simulation%get_hard_particle_set (1)
	call pset%write (u)

	write (u, "(A)")
	write (u, "(A)") "* (Re)calculate matrix element"
	write (u, "(A)")

	call simulation%recalculate (recover_phs = .false.)
	call simulation%evaluate_transforms ()

	write (u, "(A)") "* Show event with sqme"
	write (u, "(A)")

	call eio_out%set_parameters (unit = u, &
	weights = .true., pacify = .true., compressed = .true.)
	call eio_out%init_out (var_str (""))
	call simulation%write_event (eio_out)

	write (u, "(A)")
	write (u, "(A)") "* Write event to separate file &
	&'simulations_14_event_verbose.log'"

	u_verbose = free_unit ()
	open (unit = u_verbose, file = "simulations_14_event_verbose.log", &
	status = "replace", action = "write")
	call simulation%write (u_verbose)
	write (u_verbose, *)
	call simulation%write_event (u_verbose, verbose =.true., testflag = .true.)
	close (u_verbose)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_14"

	end subroutine simulations_14

	@ %def simulations_14
	@
	\subsubsection{Resonant subprocess simulation}
	Prepare a process with resonances and enter resonant subprocesses in
	the simulation object. Simulate events with selection of resonance
	histories.

	The process and its initialization is taken from [[processes_18]], but
	we need a complete \oMega\ matrix element here.
	<<Simulations: execute tests>>=
	call test (simulations_15, "simulations_15", &
	"resonant subprocesses in simulation", &
	u, results)
	<<Simulations: test declarations>>=
	public :: simulations_15
	<<Simulations: tests>>=
	subroutine simulations_15 (u)
	integer, intent(in) :: u
	type(string_t) :: libname, libname_generated
	type(string_t) :: procname
	type(string_t) :: model_name
	type(rt_data_t), target :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	class(model_t), pointer :: model
	class(model_data_t), pointer :: model_data
	type(simulation_t), target :: simulation
	real(default) :: sqrts
	type(eio_dump_t) :: eio_out
	integer :: u_verbose

	write (u, "(A)") "* Test output: simulations_15"
	write (u, "(A)") "* Purpose: generate event with resonant subprocess"
	write (u, "(A)")

	write (u, "(A)") "* Build and load a test library with one process"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_phs_forest_init ()

	libname = "simulations_15_lib"
	procname = "simulations_15_p"

	call global%global_init ()
	call global%append_log (&
	var_str ("?rebuild_phase_space"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_grids"), .true., intrinsic = .true.)
	call global%append_log (&
	var_str ("?rebuild_events"), .true., intrinsic = .true.)
	call global%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	call global%set_int (var_str ("seed"), &
	0, is_known = .true.)
	call global%set_real (var_str ("sqrts"),&
	1000._default, is_known = .true.)
	call global%set_log (var_str ("?recover_beams"), &
	.false., is_known = .true.)
	call global%set_log (var_str ("?update_sqme"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_weight"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?update_event"), &
	.true., is_known = .true.)
	call global%set_log (var_str ("?resonance_history"), &
	.true., is_known = .true.)
	call global%set_real (var_str ("resonance_on_shell_limit"), &
	10._default, is_known = .true.)

	model_name = "SM"
	call global%select_model (model_name)
	allocate (model)
	call model%init_instance (global%model)
	model_data => model

	write (u, "(A)") "* Initialize process library and process"
	write (u, "(A)")

	allocate (lib_entry)
	call lib_entry%init (libname)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)

	call prepare_resonance_test_library &
	(lib, libname, procname, model_data, global, u)

	write (u, "(A)")
	write (u, "(A)") "* Initialize simulation object &
	&with resonant subprocesses"
	write (u, "(A)")

	call global%it_list%init ([1], [1000])
	call simulation%init ([procname], &
	integrate=.true., generate=.true., local=global)

	call simulation%write_resonant_subprocess_data (u, 1)

	write (u, "(A)")
	write (u, "(A)") "* Generate event"
	write (u, "(A)")

	call simulation%init_process_selector ()
	call simulation%generate (1)

	call eio_out%set_parameters (unit = u, &
	weights = .true., pacify = .true., compressed = .true.)
	call eio_out%init_out (var_str (""))
	call simulation%write_event (eio_out)

	write (u, "(A)")
	write (u, "(A)") "* Write event to separate file &
	&'simulations_15_event_verbose.log'"

	u_verbose = free_unit ()
	open (unit = u_verbose, file = "simulations_15_event_verbose.log", &
	status = "replace", action = "write")
	call simulation%write (u_verbose)
	write (u_verbose, *)
	call simulation%write_event (u_verbose, verbose =.true., testflag = .true.)
	close (u_verbose)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call simulation%final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: simulations_15"

	end subroutine simulations_15

	@ %def simulations_15
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{More Unit Tests}

	This chapter collects some procedures for testing that can't be
	provided at the point where the corresponding modules are defined,
	because they use other modules of a different level.

	(We should move them back, collecting the high-level functionality in
	init/final hooks that we can set at runtime.)


	\section{Expression Testing}

	Expression objects are part of process and event objects, but the
	process and event object modules should not depend on the
	implementation of expressions. Here, we collect unit tests that
	depend on expression implementation.
	<<[[expr_tests_ut.f90]]>>=
	<<File header>>
	module expr_tests_ut

	use unit_tests
	use expr_tests_uti

	<<Standard module head>>

	<<Expr tests: public test>>

	contains

	<<Expr tests: test driver>>

	end module expr_tests_ut
	@ %def expr_tests_ut
	@
	<<[[expr_tests_uti.f90]]>>=
	<<File header>>

	module expr_tests_uti

	<<Use kinds>>
	<<Use strings>>
	use format_defs, only: FMT_12
	use format_utils, only: write_separator
	use os_interface
	use sm_qcd
	use lorentz
	use ifiles
	use lexers
	use parser
	use model_data
	use interactions, only: reset_interaction_counter
	use process_libraries
	use subevents
	use subevt_expr
	use rng_base
	use mci_base
	use phs_base
	use variables, only: var_list_t
	use eval_trees
	use models
	use prc_core
	use prc_test
	use process, only: process_t
	use instances, only: process_instance_t
	use events

	use rng_base_ut, only: rng_test_factory_t
	use phs_base_ut, only: phs_test_config_t

	<<Standard module head>>

	<<Expr tests: test declarations>>

	contains

	<<Expr tests: tests>>

	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 expr%var_list%append_real (var_str ("tolerance"), 0._default)
	call expr%link_var_list (model%get_var_list_ptr ())

	call expr_factory%init (pn_cuts)
	call expr%setup_selection (expr_factory)
	call expr_factory%init (pn_scale)
	call expr%setup_scale (expr_factory)
	call expr_factory%init (pn_fac_scale)
	call expr%setup_fac_scale (expr_factory)
	call expr_factory%init (pn_ren_scale)
	call expr%setup_ren_scale (expr_factory)
	call expr_factory%init (pn_weight)
	call expr%setup_weight (expr_factory)

	call write_separator (u)
	call expr%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill subevt and evaluate expressions"
	write (u, "(A)")

	call subevt_init (expr%subevt_t, 6)
	E = 500._default
	Ex = 400._default
	m = 125._default
	pdg = 25
	p(1) = vector4_moving (E, sqrt (E2 - m2), 3)
	p(2) = vector4_moving (E, -sqrt (E2 - m2), 3)
	p(3) = vector4_moving (Ex, sqrt (Ex2 - m2), 3)
	p(4) = vector4_moving (Ex, -sqrt (Ex2 - m2), 3)
	p(5) = vector4_moving (Ex, sqrt (Ex2 - m2), 1)
	p(6) = vector4_moving (Ex, -sqrt (Ex2 - m2), 1)

	call expr%reset_contents ()
	do i = 1, 2
	call 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 expr%var_list%append_real (var_str ("tolerance"), 0._default)

	call expr_factory%init (pn_selection)
	call expr%setup_selection (expr_factory)
	call expr_factory%init (pn_analysis)
	call expr%setup_analysis (expr_factory)
	call expr_factory%init (pn_reweight)
	call expr%setup_reweight (expr_factory)

	call write_separator (u)
	call expr%write (u)
	call write_separator (u)

	write (u, "(A)")
	write (u, "(A)") "* Fill subevt and evaluate expressions"
	write (u, "(A)")

	call subevt_init (expr%subevt_t, 6)
	E = 500._default
	Ex = 400._default
	m = 125._default
	pdg = 25
	p(1) = vector4_moving (E, sqrt (E2 - m2), 3)
	p(2) = vector4_moving (E, -sqrt (E2 - m2), 3)
	p(3) = vector4_moving (Ex, sqrt (Ex2 - m2), 3)
	p(4) = vector4_moving (Ex, -sqrt (Ex2 - m2), 3)
	p(5) = vector4_moving (Ex, sqrt (Ex2 - m2), 1)
	p(6) = vector4_moving (Ex, -sqrt (Ex2 - m2), 1)

	call expr%reset_contents ()
	do i = 1, 2
	call 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 (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_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 (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 (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 event%expr%var_list%append_real (var_str ("tolerance"), 0._default)
	call event%setup_expressions ()

	write (u, "(A)")
	write (u, "(A)") "* Generate test process event"

	call process_instance%generate_weighted_event (1)

	write (u, "(A)")
	write (u, "(A)") "* Fill event object and evaluate expressions"
	write (u, "(A)")

	call event%generate (1, [0.4_default, 0.4_default])
	call event%set_index (42)
	call event%evaluate_expressions ()
	call event%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call event%final ()
	deallocate (event)

	call cleanup_test_process (process, process_instance)
	deallocate (process_instance)
	deallocate (process)

	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: events_3"

	end subroutine events_3

	@ %def events_3
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Top Level}

	The top level consists of
	\begin{description}
	\item[commands]
	Defines generic command-list and command objects, and all specific
	implementations. Each command type provides a specific
	functionality. Together with the modules that provide expressions
	and variables, this module defines the Sindarin language.
	\item[whizard]
	This module interprets streams of various kind in terms of the
	command language. It also contains the unit-test feature. We also
	define the externally visible procedures here, for the \whizard\ as
	a library.
	\item[main]
	The driver for \whizard\ as a stand-alone program. Contains the
	command-line interpreter.
	\item[whizard\_c\_interface]
	Alternative top-level procedures, for use in the context of a
	C-compatible caller program.
	\end{description}

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Commands}
	This module defines the command language of the main input file.
	<<[[commands.f90]]>>=
	<<File header>>

	module commands

	<<Use kinds>>
	<<Use strings>>
	use io_units
	use string_utils, only: lower_case, split_string, str
	use format_utils, only: write_indent
	use format_defs, only: FMT_14, FMT_19
	use 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, only: var_list_t, V_NONE, V_LOG, V_INT, V_REAL, V_CMPLX, V_STR, V_PDG
	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 restricted_subprocesses, only: get_libname_res
	use restricted_subprocesses, only: spawn_resonant_subprocess_libraries
	use event_streams
	use simulations

	use radiation_generator

	<<Use mpi f08>>

	<<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_export")
	allocate (cmd_export_t :: command)
	case ("cmd_quit")
	allocate (cmd_quit_t :: command)
	case default
	print *, char (parse_node_get_rule_key (pn))
	call msg_bug ("Command not implemented")
	end select
	command%pn => pn
	end subroutine dispatch_command

	@ %def dispatch_command
	@ Output. We allow for indentation so we can display a command tree.
	<<Commands: command: TBP>>=
	procedure (command_write), deferred :: write
	<<Commands: interfaces>>=
	abstract interface
	subroutine command_write (cmd, unit, indent)
	import
	class(command_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	end subroutine command_write
	end interface

	@ %def command_write
	@ Compile a command. The command type is already fixed, so this is a
	deferred type-bound procedure.
	<<Commands: command: TBP>>=
	procedure (command_compile), deferred :: compile
	<<Commands: interfaces>>=
	abstract interface
	subroutine command_compile (cmd, global)
	import
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine command_compile
	end interface

	@ %def command_compile
	@ Execute a command. This will use and/or modify the runtime data
	set. If the [[quit]] flag is set, the caller should terminate command
	execution.
	<<Commands: command: TBP>>=
	procedure (command_execute), deferred :: execute
	<<Commands: interfaces>>=
	abstract interface
	subroutine command_execute (cmd, global)
	import
	class(command_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	end subroutine command_execute
	end interface

	@ %def command_execute
	@
	\subsection{Options}
	The [[options]] command list is allocated, initialized, and executed, if the
	command is associated with an option text in curly braces. If present, a
	separate local runtime data set [[local]] will be allocated and initialized;
	otherwise, [[local]] becomes a pointer to the global dataset.

	For output, we indent the options list.
	<<Commands: command: TBP>>=
	procedure :: write_options => command_write_options
	<<Commands: 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
	logical :: ufo_model = .false.
	logical :: ufo_path_set = .false.
	type(string_t) :: ufo_path
	contains
	<<Commands: cmd model: TBP>>
	end type cmd_model_t

	@ %def cmd_model_t
	@ Output
	<<Commands: cmd model: TBP>>=
	procedure :: write => cmd_model_write
	<<Commands: 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,'""')", advance="no") "model =", char (cmd%name)
	if (cmd%ufo_model) then
	if (cmd%ufo_path_set) then
	write (u, "(1x,A,A,A)") "(ufo (", char (cmd%ufo_path), "))"
	else
	write (u, "(1x,A)") "(ufo)"
	end if
	else if (cmd%scheme /= "") then
	write (u, "(1x,'(',A,')')") char (cmd%scheme)
	else
	write (u, *)
	end if
	end subroutine cmd_model_write

	@ %def cmd_model_write
	@ Compile. Get the model name and read the model from file, so it is
	readily available when the command list is executed. If the model has a
	scheme argument, take this into account.

	Assign the model pointer in the [[global]] record, so it can be used for
	(read-only) variable lookup while compiling further commands.
	<<Commands: cmd model: TBP>>=
	procedure :: compile => cmd_model_compile
	<<Commands: 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(parse_node_t), pointer :: pn_ufo_arg, pn_path
	type(model_t), pointer :: model
	type(string_t) :: scheme
	pn_name => cmd%pn%get_sub_ptr (3)
	pn_arg => pn_name%get_next_ptr ()
	if (associated (pn_arg)) then
	pn_scheme => pn_arg%get_sub_ptr ()
	else
	pn_scheme => null ()
	end if
	cmd%name = pn_name%get_string ()
	if (associated (pn_scheme)) then
	select case (char (pn_scheme%get_rule_key ()))
	case ("ufo_spec")
	cmd%ufo_model = .true.
	pn_ufo_arg => pn_scheme%get_sub_ptr (2)
	if (associated (pn_ufo_arg)) then
	pn_path => pn_ufo_arg%get_sub_ptr ()
	cmd%ufo_path_set = .true.
	cmd%ufo_path = pn_path%get_string ()
	end if
	case default
	scheme = pn_scheme%get_string ()
	select case (char (lower_case (scheme)))
	case ("ufo"); cmd%ufo_model = .true.
	case default; cmd%scheme = scheme
	end select
	end select
	if (cmd%ufo_model) then
	if (cmd%ufo_path_set) then
	call preload_ufo_model (model, cmd%name, cmd%ufo_path)
	else
	call preload_ufo_model (model, cmd%name)
	end if
	else
	call preload_model (model, cmd%name, cmd%scheme)
	end if
	else
	cmd%scheme = ""
	call preload_model (model, cmd%name)
	end if
	global%model => model
	if (associated (global%model)) then
	call global%model%link_var_list (global%var_list)
	end if
	contains
	subroutine preload_model (model, name, scheme)
	type(model_t), pointer, intent(out) :: model
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: scheme
	model => null ()
	if (associated (global%model)) then
	if (global%model%matches (name, scheme)) then
	model => global%model
	end if
	end if
	if (.not. associated (model)) then
	if (global%model_list%model_exists (name, scheme)) then
	model => global%model_list%get_model_ptr (name, scheme)
	else
	call global%read_model (name, model, scheme)
	end if
	end if
	end subroutine preload_model
	subroutine preload_ufo_model (model, name, ufo_path)
	type(model_t), pointer, intent(out) :: model
	type(string_t), intent(in) :: name
	type(string_t), intent(in), optional :: ufo_path
	model => null ()
	if (associated (global%model)) then
	if (global%model%matches (name, ufo=.true., ufo_path=ufo_path)) then
	model => global%model
	end if
	end if
	if (.not. associated (model)) then
	if (global%model_list%model_exists (name, &
	ufo=.true., ufo_path=ufo_path)) then
	model => global%model_list%get_model_ptr (name, &
	ufo=.true., ufo_path=ufo_path)
	else
	call global%read_ufo_model (name, model, ufo_path=ufo_path)
	end if
	end if
	end subroutine preload_ufo_model
	end subroutine cmd_model_compile

	@ %def cmd_model_compile
	@ Execute: Insert a pointer into the global data record and reassign
	the variable list.
	<<Commands: cmd model: TBP>>=
	procedure :: execute => cmd_model_execute
	<<Commands: procedures>>=
	subroutine cmd_model_execute (cmd, global)
	class(cmd_model_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	if (cmd%ufo_model) then
	if (cmd%ufo_path_set) then
	call global%select_model (cmd%name, ufo=.true., ufo_path=cmd%ufo_path)
	else
	call global%select_model (cmd%name, ufo=.true.)
	end if
	else if (cmd%scheme /= "") then
	call global%select_model (cmd%name, cmd%scheme)
	else
	call global%select_model (cmd%name)
	end if
	if (.not. associated (global%model)) &
	call msg_fatal ("Switching to model '" &
	// char (cmd%name) // "': model not found")
	end subroutine cmd_model_execute

	@ %def cmd_model_execute
	@
	\subsubsection{Library configuration}
	We configure a process library that should hold the subsequently
	defined processes. If the referenced library exists already, just
	make it the currently active one.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_library_t
	private
	type(string_t) :: name
	contains
	<<Commands: cmd library: TBP>>
	end type cmd_library_t

	@ %def cmd_library_t
	@ Output.
	<<Commands: cmd library: TBP>>=
	procedure :: write => cmd_library_write
	<<Commands: 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.

	There are two possibilities that a process contains more than
	component: by an explicit component statement by the user for
	inclusive processes, or by having one process at NLO level. The first
	option is determined in the routine [[scan_components]], and
	determines [[n_components]].
	<<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, dimension(:), allocatable :: nlo_comp
	integer :: i, j, n_in, n_out, n_terms, n_components
	logical :: nlo_fixed_order
	logical :: qcd_corr, qed_corr
	type(string_t), dimension(:), allocatable :: prt_in_nlo, prt_out_nlo
	type(radiation_generator_t) :: radiation_generator
	type(pdg_list_t) :: pl_in, pl_out, pl_excluded_gauge_splittings
	type(string_t) :: method, born_me_method, loop_me_method, &
	correlation_me_method, real_tree_me_method, dglap_me_method
	integer, dimension(:), allocatable :: i_list
	logical :: use_real_finite
	logical :: gks_active
	logical :: initial_state_colored
	integer :: comp_mult
	integer :: gks_multiplicity
	integer :: n_components_init
	integer :: alpha_power, alphas_power
	logical :: requires_soft_mismatch, requires_dglap_remnants
	call msg_debug (D_CORE, "cmd_process_execute")
	var_list => cmd%local%get_var_list_ptr ()

	n_in = size (cmd%pn_pdg_in)
	allocate (prt_in (n_in), prt_spec_in (n_in))
	do i = 1, n_in
	pdg_in = &
	eval_pdg_array (cmd%pn_pdg_in(i)%ptr, var_list)
	prt_in(i) = make_flavor_string (pdg_in, cmd%local%model)
	prt_spec_in(i) = new_prt_spec (prt_in(i))
	end do
	call compile_prt_expr &
	(prt_expr_out, cmd%pn_out, var_list, cmd%local%model)
	call prt_expr_out%expand ()
	call scan_components ()
	allocate (nlo_comp (n_components))

	nlo_fixed_order = cmd%local%nlo_fixed_order
	gks_multiplicity = var_list%get_ival (var_str ('gks_multiplicity'))
	gks_active = gks_multiplicity > 2
	call check_for_nlo_corrections ()

	method = var_list%get_sval (var_str ("$method"))
	born_me_method = var_list%get_sval (var_str ("$born_me_method"))
	if (born_me_method == var_str ("")) born_me_method = method
	use_real_finite = var_list%get_lval (var_str ('?nlo_use_real_partition'))
	if (nlo_fixed_order) then
	real_tree_me_method = &
	var_list%get_sval (var_str ("$real_tree_me_method"))
	if (real_tree_me_method == var_str ("")) &
	real_tree_me_method = method
	loop_me_method = var_list%get_sval (var_str ("$loop_me_method"))
	if (loop_me_method == var_str ("")) &
	loop_me_method = method
	correlation_me_method = &
	var_list%get_sval (var_str ("$correlation_me_method"))
	if (correlation_me_method == var_str ("")) &
	correlation_me_method = method
	dglap_me_method = var_list%get_sval (var_str ("$dglap_me_method"))
	if (dglap_me_method == var_str ("")) &
	dglap_me_method = method
	call check_nlo_options (cmd%local)
	end if

	call determine_needed_components ()
	call prc_config%init (cmd%id, n_in, n_components_init, &
	cmd%local%model, cmd%local%var_list, &
	nlo_process = nlo_fixed_order)

	alpha_power = var_list%get_ival (var_str ("alpha_power"))
	alphas_power = var_list%get_ival (var_str ("alphas_power"))
	call prc_config%set_coupling_powers (alpha_power, alphas_power)

	call setup_components ()
	call prc_config%record (cmd%local)

	contains

	<<Commands: cmd process execute procedures>>

	end subroutine cmd_process_execute

	@ %def cmd_process_execute
	@
	<<Commands: cmd process execute procedures>>=
	elemental function is_threshold (method)
	logical :: is_threshold
	type(string_t), intent(in) :: method
	is_threshold = method == var_str ("threshold")
	end function is_threshold

	subroutine check_threshold_consistency ()
	if (nlo_fixed_order .and. is_threshold (born_me_method)) then
	if (.not. (is_threshold (real_tree_me_method) .and. is_threshold (loop_me_method) &
	.and. is_threshold (correlation_me_method))) then
	print *, 'born: ', char (born_me_method)
	print *, 'real: ', char (real_tree_me_method)
	print *, 'loop: ', char (loop_me_method)
	print *, 'correlation: ', char (correlation_me_method)
	call msg_fatal ("Inconsistent methods: All components need to be threshold")
	end if
	end if
	end subroutine check_threshold_consistency

	@ %def check_threshold_consistency
	<<Commands: cmd process execute procedures>>=
	subroutine check_for_nlo_corrections ()
	type(string_t) :: nlo_correction_type
	type(pdg_array_t), dimension(:), allocatable :: pdg
	if (nlo_fixed_order .or. gks_active) then
	nlo_correction_type = &
	var_list%get_sval (var_str ('$nlo_correction_type'))
	select case (char(nlo_correction_type))
	case ("QCD")
	qcd_corr = .true.; qed_corr = .false.
	case ("QED")
	qcd_corr = .false.; qed_corr = .true.
	case ("Full")
	qcd_corr =.true.; qed_corr = .true.
	case default
	call msg_fatal ("Invalid NLO correction type! " // &
	"Valid inputs are: QCD, QED, Full (default: QCD)")
	end select
	call check_for_excluded_gauge_boson_splitting_partners ()
	call setup_radiation_generator ()
	end if
	if (nlo_fixed_order) then
	call radiation_generator%find_splittings ()
	if (debug2_active (D_CORE)) then
	print *, ''
	print *, 'Found (pdg) splittings: '
	do i = 1, radiation_generator%if_table%get_length ()
	call radiation_generator%if_table%get_pdg_out (i, pdg)
	call pdg_array_write_set (pdg)
	print *, '----------------'
	end do
	end if

	nlo_fixed_order = radiation_generator%contains_emissions ()
	if (.not. nlo_fixed_order) call msg_warning &
	(arr = [var_str ("No NLO corrections found for process ") // &
	cmd%id // var_str("."), var_str ("Proceed with usual " // &
	"leading-order integration and simulation")])
	end if
	end subroutine check_for_nlo_corrections

	@ %def check_for_nlo_corrections
	@
	<<Commands: cmd process execute procedures>>=
	subroutine check_for_excluded_gauge_boson_splitting_partners ()
	type(string_t) :: str_excluded_partners
	type(string_t), dimension(:), allocatable :: excluded_partners
	type(pdg_list_t) :: pl_tmp, pl_anti
	integer :: i, n_anti
	str_excluded_partners = var_list%get_sval &
	(var_str ("$exclude_gauge_splittings"))
	if (str_excluded_partners == "") then
	return
	else
	call split_string (str_excluded_partners, &
	var_str (":"), excluded_partners)
	call pl_tmp%init (size (excluded_partners))
	do i = 1, size (excluded_partners)
	call pl_tmp%set (i, &
	cmd%local%model%get_pdg (excluded_partners(i), .true.))
	end do
	call pl_tmp%create_antiparticles (pl_anti, n_anti)
	call pl_excluded_gauge_splittings%init (pl_tmp%get_size () + n_anti)
	do i = 1, pl_tmp%get_size ()
	call pl_excluded_gauge_splittings%set (i, pl_tmp%get(i))
	end do
	do i = 1, n_anti
	j = i + pl_tmp%get_size ()
	call pl_excluded_gauge_splittings%set (j, pl_anti%get(i))
	end do
	end if
	end subroutine check_for_excluded_gauge_boson_splitting_partners

	@ %def check_for_excluded_gauge_boson_splitting_partners
	@
	<<Commands: cmd process execute procedures>>=
	subroutine determine_needed_components ()
	type(string_t) :: fks_method
	comp_mult = 1
	if (nlo_fixed_order) then
	fks_method = var_list%get_sval (var_str ('$fks_mapping_type'))
	call check_threshold_consistency ()
	requires_soft_mismatch = fks_method == var_str ('resonances')
	comp_mult = needed_extra_components (requires_dglap_remnants, &
	use_real_finite, requires_soft_mismatch)
	allocate (i_list (comp_mult))
	else if (gks_active) then
	call radiation_generator%generate_multiple &
	(gks_multiplicity, cmd%local%model)
	comp_mult = radiation_generator%get_n_gks_states () + 1
	end if
	n_components_init = n_components * comp_mult
	end subroutine determine_needed_components

	@ %def determine_needed_components
	@
	<<Commands: cmd process execute procedures>>=
	subroutine setup_radiation_generator ()
	call split_prt (prt_spec_in, n_in, pl_in)
	call split_prt (prt_spec_out, n_out, pl_out)
	call radiation_generator%init (pl_in, pl_out, &
	pl_excluded_gauge_splittings, qcd = qcd_corr, qed = qed_corr)
	call radiation_generator%set_n (n_in, n_out, 0)
	initial_state_colored = pdg_in%has_colored_particles ()
	if ((n_in == 2 .and. initial_state_colored) .or. qed_corr) then
	requires_dglap_remnants = n_in == 2 .and. initial_state_colored
	call radiation_generator%set_initial_state_emissions ()
	else
	requires_dglap_remnants = .false.
	end if
	call radiation_generator%set_constraints (.false., .false., .true., .true.)
	call radiation_generator%setup_if_table (cmd%local%model)
	end subroutine setup_radiation_generator

	@ %def setup_radiation_generator
	@
	<<Commands: cmd process execute 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

	@ %def split_prt
	@
	<<Commands: cmd process execute procedures>>=
	subroutine setup_components()
	integer :: k, i_comp, add_index
	i_comp = 0
	add_index = 0
	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 msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 1)
	call prc_config%setup_component (i_comp + 1, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, BORN, &
	can_be_integrated = selected_nlo_parts (BORN))
	call radiation_generator%generate_real_particle_strings &
	(prt_in_nlo, prt_out_nlo)
	call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 2)
	call prc_config%setup_component (i_comp + 2, &
	new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
	cmd%local%model, var_list, NLO_REAL, &
	can_be_integrated = selected_nlo_parts (NLO_REAL))
	call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 3)
	call prc_config%setup_component (i_comp + 3, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, NLO_VIRTUAL, &
	can_be_integrated = selected_nlo_parts (NLO_VIRTUAL))
	call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 4)
	call prc_config%setup_component (i_comp + 4, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, NLO_SUBTRACTION, &
	can_be_integrated = selected_nlo_parts (NLO_SUBTRACTION))
	do k = 1, 4
	i_list(k) = i_comp + k
	end do
	if (requires_dglap_remnants) then
	call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 5)
	call prc_config%setup_component (i_comp + 5, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, NLO_DGLAP, &
	can_be_integrated = selected_nlo_parts (NLO_DGLAP))
	i_list(5) = i_comp + 5
	add_index = add_index + 1
	end if
	if (use_real_finite) then
	call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 5 + add_index)
	call prc_config%setup_component (i_comp + 5 + add_index, &
	new_prt_spec (prt_in_nlo), new_prt_spec (prt_out_nlo), &
	cmd%local%model, var_list, NLO_REAL, &
	can_be_integrated = selected_nlo_parts (NLO_REAL))
	i_list(5 + add_index) = i_comp + 5 + add_index
	add_index = add_index + 1
	end if
	if (requires_soft_mismatch) then
	call msg_debug (D_CORE, "Setting up this NLO component:", &
	i_comp + 5 + add_index)
	call prc_config%setup_component (i_comp + 5 + add_index, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, NLO_MISMATCH, &
	can_be_integrated = selected_nlo_parts (NLO_MISMATCH))
	i_list(5 + add_index) = i_comp + 5 + add_index
	end if
	call prc_config%set_component_associations (i_list, &
	requires_dglap_remnants, use_real_finite, &
	requires_soft_mismatch)
	end associate
	else if (gks_active) then
	call prc_config%setup_component (i_comp + 1, prt_spec_in, &
	prt_spec_out, cmd%local%model, var_list, BORN, &
	can_be_integrated = .true.)
	call radiation_generator%reset_queue ()
	do j = 1, comp_mult
	prt_out_nlo = radiation_generator%get_next_state ()
	call prc_config%setup_component (i_comp + 1 + j, &
	new_prt_spec (prt_in), new_prt_spec (prt_out_nlo), &
	cmd%local%model, var_list, GKS, can_be_integrated = .false.)
	end do
	else
	call prc_config%setup_component (i, &
	prt_spec_in, prt_spec_out, &
	cmd%local%model, var_list, can_be_integrated = .true.)
	end if
	i_comp = i_comp + comp_mult
	end do
	end subroutine setup_components

	@
	@ These three functions should be bundled with the logicals they depend
	on into an object (the pcm?).
	<<Commands: procedures>>=
	subroutine check_nlo_options (local)
	type(rt_data_t), intent(in) :: local
	type(var_list_t), pointer :: var_list => null ()
	logical :: nlo, combined, powheg
	logical :: case_lo_but_any_other
	logical :: case_nlo_powheg_but_not_combined
	logical :: vamp_equivalences_enabled
	logical :: fixed_order_nlo_events
	var_list => local%get_var_list_ptr ()
	nlo = local%nlo_fixed_order
	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
	fixed_order_nlo_events = &
	var_list%get_lval (var_str ('?fixed_order_nlo_events'))
	if (fixed_order_nlo_events .and. .not. combined .and. &
	all (local%selected_nlo_parts)) &
	call msg_fatal ("Option mismatch: Fixed order NLO events of the full ", &
	[var_str ("process are requested, but ?combined_nlo_integration"), &
	var_str ("is false. You can either switch to the combined NLO"), &
	var_str ("integration mode or choose one individual NLO component"), &
	var_str ("to generate events with.")])
	vamp_equivalences_enabled = var_list%get_lval &
	(var_str ('?use_vamp_equivalences'))
	if (nlo .and. vamp_equivalences_enabled) &
	call msg_warning ("You have not disabled VAMP equivalences. ", &
	[var_str (" Note that they are automatically switched off "), &
	var_str (" for NLO calculations.")])
	end subroutine check_nlo_options

	@ %def check_nlo_options
	@ There are four components for a general NLO process, namely Born,
	real, virtual and subtraction. There will be additional components for
	DGLAP remnant, in case real contributions are split into singular and
	finite pieces, and for resonance-aware FKS subtraction for the needed
	soft mismatch component.
	<<Commands: procedures>>=
	pure function needed_extra_components (requires_dglap_remnant, &
	use_real_finite, requires_soft_mismatch) result (n)
	integer :: n
	logical, intent(in) :: requires_dglap_remnant, &
	use_real_finite, requires_soft_mismatch
	n = 4
	if (requires_dglap_remnant) n = n + 1
	if (use_real_finite) n = n + 1
	if (requires_soft_mismatch) n = n + 1
	end function needed_extra_components

	@ %def needed_extra_components
	@ This is a method of the eval tree, but cannot be coded inside the
	[[expressions]] module since it uses the [[model]] and [[flv]] types
	which are not available there.
	<<Commands: procedures>>=
	function make_flavor_string (aval, model) result (prt)
	type(string_t) :: prt
	type(pdg_array_t), intent(in) :: aval
	type(model_t), intent(in), target :: model
	integer, dimension(:), allocatable :: pdg
	type(flavor_t), dimension(:), allocatable :: flv
	integer :: i
	pdg = aval
	allocate (flv (size (pdg)))
	call flv%init (pdg, model)
	if (size (pdg) /= 0) then
	prt = flv(1)%get_name ()
	do i = 2, size (flv)
	prt = prt // ":" // flv(i)%get_name ()
	end do
	else
	prt = "?"
	end if
	end function make_flavor_string

	@ %def make_flavor_string
	@ Create a pdg array from a particle-specification array
	<<Commands: procedures>>=
	function make_pdg_array (prt, model) result (pdg_array)
	type(prt_spec_t), intent(in), dimension(:) :: prt
	type(model_t), intent(in) :: model
	integer, dimension(:), allocatable :: aval
	type(pdg_array_t) :: pdg_array
	type(flavor_t) :: flv
	integer :: k
	allocate (aval (size (prt)))
	do k = 1, size (prt)
	call flv%init (prt(k)%to_string (), model)
	aval (k) = flv%get_pdg ()
	end do
	pdg_array = aval
	end function make_pdg_array

	@ %def make_pdg_array
	@ Compile a (possible nested) expression, to obtain a
	particle-specifier expression which we can process further.
	<<Commands: procedures>>=
	recursive subroutine compile_prt_expr (prt_expr, pn, var_list, model)
	type(prt_expr_t), intent(out) :: prt_expr
	type(parse_node_t), intent(in), target :: pn
	type(var_list_t), intent(in), target :: var_list
	type(model_t), intent(in), target :: model
	type(parse_node_t), pointer :: pn_entry, pn_term, pn_addition
	type(pdg_array_t) :: pdg
	type(string_t) :: prt_string
	integer :: n_entry, n_term, i
	select case (char (parse_node_get_rule_key (pn)))
	case ("prt_state_list")
	n_entry = parse_node_get_n_sub (pn)
	pn_entry => parse_node_get_sub_ptr (pn)
	if (n_entry == 1) then
	call compile_prt_expr (prt_expr, pn_entry, var_list, model)
	else
	call prt_expr%init_list (n_entry)
	select type (x => prt_expr%x)
	type is (prt_spec_list_t)
	do i = 1, n_entry
	call compile_prt_expr (x%expr(i), pn_entry, var_list, model)
	pn_entry => parse_node_get_next_ptr (pn_entry)
	end do
	end select
	end if
	case ("prt_state_sum")
	n_term = parse_node_get_n_sub (pn)
	pn_term => parse_node_get_sub_ptr (pn)
	pn_addition => pn_term
	if (n_term == 1) then
	call compile_prt_expr (prt_expr, pn_term, var_list, model)
	else
	call prt_expr%init_sum (n_term)
	select type (x => prt_expr%x)
	type is (prt_spec_sum_t)
	do i = 1, n_term
	call compile_prt_expr (x%expr(i), pn_term, var_list, model)
	pn_addition => parse_node_get_next_ptr (pn_addition)
	if (associated (pn_addition)) &
	pn_term => parse_node_get_sub_ptr (pn_addition, 2)
	end do
	end select
	end if
	case ("cexpr")
	pdg = eval_pdg_array (pn, var_list)
	prt_string = make_flavor_string (pdg, model)
	call prt_expr%init_spec (new_prt_spec (prt_string))
	case default
	call parse_node_write_rec (pn)
	call msg_bug ("compile prt expr: impossible syntax rule")
	end select
	end subroutine compile_prt_expr

	@ %def compile_prt_expr
	@
	\subsubsection{Initiating a NLO calculation}
	<<Commands: types>>=
	type, extends (command_t) :: cmd_nlo_t
	private
	integer, dimension(:), allocatable :: nlo_component
	contains
	<<Commands: cmd nlo: TBP>>
	end type cmd_nlo_t

	@ %def cmd_nlo_t
	@
	<<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, n_comp
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 3)
	if (associated (pn_arg)) then
	n_comp = parse_node_get_n_sub (pn_arg)
	allocate (cmd%nlo_component (n_comp))
	pn_comp => parse_node_get_sub_ptr (pn_arg)
	i = 0
	do while (associated (pn_comp))
	i = i + 1
	cmd%nlo_component(i) = component_status &
	(parse_node_get_rule_key (pn_comp))
	pn_comp => parse_node_get_next_ptr (pn_comp)
	end do
	else
	allocate (cmd%nlo_component (0))
	end if
	end subroutine cmd_nlo_compile

	@ %def cmd_nlo_compile
	@
	<<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(string_t) :: string
	integer :: n, i, j
	logical, dimension(0:5) :: selected_nlo_parts
	call msg_debug (D_CORE, "cmd_nlo_execute")
	selected_nlo_parts = .false.
	if (allocated (cmd%nlo_component)) then
	n = size (cmd%nlo_component)
	else
	n = 0
	end if
	do i = 1, n
	select case (cmd%nlo_component (i))
	case (BORN, NLO_VIRTUAL, NLO_MISMATCH, NLO_DGLAP, NLO_REAL)
	selected_nlo_parts(cmd%nlo_component (i)) = .true.
	case (NLO_FULL)
	selected_nlo_parts = .true.
	selected_nlo_parts (NLO_SUBTRACTION) = .false.
	case default
	string = var_str ("")
	do j = BORN, NLO_DGLAP
	string = string // component_status (j) // ", "
	end do
	string = string // component_status (NLO_FULL)
	call msg_fatal ("Invalid NLO mode. Valid modes are: " // &
	char (string))
	end select
	end do
	global%nlo_fixed_order = any (selected_nlo_parts)
	global%selected_nlo_parts = selected_nlo_parts
	allocate (global%nlo_component (size (cmd%nlo_component)))
	global%nlo_component = cmd%nlo_component
	end subroutine cmd_nlo_execute

	@ %def cmd_nlo_execute
	@
	\subsubsection{Process compilation}
	<<Commands: types>>=
	type, extends (command_t) :: cmd_compile_t
	private
	type(string_t), dimension(:), allocatable :: libname
	logical :: make_executable = .false.
	type(string_t) :: exec_name
	contains
	<<Commands: cmd compile: TBP>>
	end type cmd_compile_t

	@ %def cmd_compile_t
	@ Output: list all libraries to be compiled.
	<<Commands: cmd compile: TBP>>=
	procedure :: write => cmd_compile_write
	<<Commands: 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.

	As a bonus, a compiled library may be able to spawn new process
	libraries. For instance, a processes may ask for a set of resonant
	subprocesses which go into their own library, but this can be
	determined only after the process is available as a compiled object.
	Therefore, the compilation loop is implemented as a recursive internal
	subroutine.

	We can compile static libraries (which actually just loads them). However, we
	can't incorporate in a generated executable.
	<<Commands: cmd compile: TBP>>=
	procedure :: execute => cmd_compile_execute
	<<Commands: 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, n_lib
	<<Commands: cmd compile execute: variables>>
	<<Commands: cmd compile execute: init>>
	if (allocated (cmd%libname)) then
	allocate (libname (size (cmd%libname)))
	libname = cmd%libname
	else
	call cmd%local%prclib_stack%get_names (libname)
	end if
	n_lib = size (libname)
	if (cmd%make_executable) then
	call get_prclib_static (libname_static)
	do i = 1, n_lib
	if (any (libname_static == libname(i))) then
	call msg_fatal ("Compile: can't include static library '" &
	// char (libname(i)) // "'")
	end if
	end do
	call compile_executable (cmd%exec_name, libname, cmd%local)
	else
	call compile_libraries (libname)
	call global%update_prclib &
	(global%prclib_stack%get_library_ptr (libname(n_lib)))
	end if
	<<Commands: cmd compile execute: end init>>
	contains
	recursive subroutine compile_libraries (libname)
	type(string_t), dimension(:), intent(in) :: libname
	integer :: i
	type(string_t), dimension(:), allocatable :: libname_extra
	type(process_library_t), pointer :: lib_saved
	do i = 1, size (libname)
	call compile_library (libname(i), cmd%local)
	lib_saved => global%prclib
	call spawn_extra_libraries &
	(libname(i), cmd%local, global, libname_extra)
	call compile_libraries (libname_extra)
	call global%update_prclib (lib_saved)
	end do
	end subroutine compile_libraries
	end subroutine cmd_compile_execute

	@ %def cmd_compile_execute
	<<Commands: cmd compile execute: variables>>=
	@
	<<Commands: cmd compile execute: init>>=
	@
	<<Commands: cmd compile execute: end init>>=
	@
	@ The parallelization leads to undefined behavior while writing simultaneously to one file.
	The master worker has to initialize single-handed the corresponding library files.
	The slave worker will wait with a blocking [[MPI_BCAST]] until they receive a logical flag.
	<<MPI: Commands: cmd compile execute: variables>>=
	logical :: compile_init
	integer :: rank, n_size
	<<MPI: Commands: cmd compile execute: init>>=
	call msg_debug (D_MPI, "cmd_compile_execute")
	compile_init = .false.
	call mpi_get_comm_id (n_size, rank)
	call msg_debug (D_MPI, "n_size", rank)
	call msg_debug (D_MPI, "rank", rank)
	if (rank /= 0) then
	call msg_debug (D_MPI, "wait for master")
	call MPI_bcast (compile_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
	else
	compile_init = .true.
	end if

	if (compile_init) then
	<<MPI: Commands: cmd compile execute: end init>>=
	if (rank == 0) then
	call msg_debug (D_MPI, "load slaves")
	call MPI_bcast (compile_init, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD)
	end if
	end if
	call MPI_barrier (MPI_COMM_WORLD)
	@ %def cmd_compile_execute_mpi
	@
	This is the interface to the external procedure which returns the
	names of all static libraries which are part of the executable. (The
	default is none.) The routine must allocate the array.
	<<Commands: public>>=
	public :: get_prclib_static
	<<Commands: interfaces>>=
	interface
	subroutine get_prclib_static (libname)
	import
	type(string_t), dimension(:), intent(inout), allocatable :: libname
	end subroutine get_prclib_static
	end interface

	@ %def get_prclib_static
	@
	Spawn extra libraries. We can ask the processes within a compiled
	library, which we have available at this point, whether they need additional
	processes which should go into their own libraries.

	The current implementation only concerns resonant subprocesses.

	Note that the libraries should be created (source code), but not be
	compiled here. This is done afterwards.
	<<Commands: procedures>>=
	subroutine spawn_extra_libraries (libname, local, global, libname_extra)
	type(string_t), intent(in) :: libname
	type(rt_data_t), intent(inout), target :: local
	type(rt_data_t), intent(inout), target :: global
	type(string_t), dimension(:), allocatable, intent(out) :: libname_extra
	type(string_t), dimension(:), allocatable :: libname_res
	allocate (libname_extra (0))
	call spawn_resonant_subprocess_libraries &
	(libname, local, global, libname_res)
	if (allocated (libname_res)) libname_extra = [libname_extra, libname_res]
	end subroutine spawn_extra_libraries

	@ %def spawn_extra_libraries
	@
	\subsubsection{Execute a shell command}
	The argument is a string expression.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_exec_t
	private
	type(parse_node_t), pointer :: pn_command => null ()
	contains
	<<Commands: cmd exec: TBP>>
	end type cmd_exec_t

	@ %def cmd_exec_t
	@ Simply tell the status.
	<<Commands: cmd exec: TBP>>=
	procedure :: write => cmd_exec_write
	<<Commands: 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 global%var_list%check_user_var (var_name, type, new)
	cmd%name = var_name
	cmd%pn_value => parse_node_get_next_ptr (pn_name, 2)
	if (global%var_list%contains (cmd%name, follow_link = .false.)) then
	! local variable
	cmd%is_intrinsic = &
	global%var_list%is_intrinsic (cmd%name, follow_link = .false.)
	cmd%type = &
	global%var_list%get_type (cmd%name, follow_link = .false.)
	else
	if (new) cmd%type = type
	if (global%var_list%contains (cmd%name, follow_link = .true.)) then
	! global variable
	cmd%is_intrinsic = &
	global%var_list%is_intrinsic (cmd%name, follow_link = .true.)
	if (cmd%type == V_NONE) then
	cmd%type = &
	global%var_list%get_type (cmd%name, follow_link = .true.)
	end if
	else if (associated (model_vars)) then ! check model variable
	cmd%is_model_var = &
	model_vars%contains (cmd%name)
	if (cmd%type == V_NONE) then
	cmd%type = &
	model_vars%get_type (cmd%name)
	end if
	end if
	if (cmd%type == V_NONE) then
	call msg_fatal ("Variable '" // char (cmd%name) // "' " &
	// "set without declaration")
	cmd%type = V_NONE; return
	end if
	if (cmd%is_model_var) then
	if (new) then
	call msg_fatal ("Model variable '" // char (cmd%name) // "' " &
	// "redeclared")
	else if (model_vars%is_locked (cmd%name)) then
	call msg_fatal ("Model variable '" // char (cmd%name) // "' " &
	// "is locked")
	end if
	else
	select case (cmd%type)
	case (V_LOG)
	call global%var_list%append_log (cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_INT)
	call global%var_list%append_int (cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_REAL)
	call global%var_list%append_real (cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_CMPLX)
	call global%var_list%append_cmplx (cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_PDG)
	call global%var_list%append_pdg_array (cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	case (V_STR)
	call global%var_list%append_string (cmd%name, &
	intrinsic=cmd%is_intrinsic, user=.true.)
	end select
	end if
	end if
	end subroutine cmd_var_compile

	@ %def cmd_var_compile
	@ Execute. Evaluate the definition and assign the variable value.
	If the variable is a model variable, take a snapshot of the model if necessary
	and set the variable in the local model.
	<<Commands: cmd var: TBP>>=
	procedure :: execute => cmd_var_execute
	<<Commands: 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
	type(string_t) :: out_file
	integer :: i, j, u, u_log, u_out, u_ext
	u = free_unit ()
	var_list => cmd%local%var_list
	if (associated (cmd%local%model)) then
	model_vars => cmd%local%model%get_var_list_ptr ()
	else
	model_vars => null ()
	end if
	pacified = var_list%get_lval (var_str ("?pacify"))
	out_file = var_list%get_sval (var_str ("$out_file"))
	if (file_list_is_open (global%out_files, out_file, action="write")) then
	call msg_message ("show: copying output to file '" &
	// char (out_file) // "'")
	u_ext = file_list_get_unit (global%out_files, out_file)
	else
	u_ext = -1
	end if
	open (u, status = "scratch", action = "readwrite")
	if (associated (cmd%local%model)) then
	name = cmd%local%model%get_name ()
	end if
	if (size (cmd%name) == 0) then
	if (associated (model_vars)) then
	call model_vars%write (model_name = name, &
	unit = u, pacified = pacified, follow_link = .false.)
	end if
	call var_list%write (unit = u, pacified = pacified)
	else
	do i = 1, size (cmd%name)
	select case (char (cmd%name(i)))
	case ("model")
	if (associated (cmd%local%model)) then
	call cmd%local%model%show (u)
	else
	write (u, "(A)") "Model: [undefined]"
	end if
	case ("library")
	if (associated (cmd%local%prclib)) then
	call cmd%local%prclib%show (u)
	else
	write (u, "(A)") "Process library: [undefined]"
	end if
	case ("beams")
	call cmd%local%show_beams (u)
	case ("iterations")
	call cmd%local%it_list%write (u)
	case ("results")
	call cmd%local%process_stack%show (u, fifo=.true.)
	case ("stable")
	call cmd%local%model%show_stable (u)
	case ("polarized")
	call cmd%local%model%show_polarized (u)
	case ("unpolarized")
	call cmd%local%model%show_unpolarized (u)
	case ("unstable")
	model => cmd%local%model
	call model%show_unstable (u)
	n = model%get_n_field ()
	do j = 1, n
	pdg = model%get_pdg (j)
	call flv%init (pdg, model)
	if (.not. flv%is_stable ()) &
	call show_unstable (cmd%local, pdg, u)
	if (flv%has_antiparticle ()) then
	associate (anti => flv%anti ())
	if (.not. anti%is_stable ()) &
	call show_unstable (cmd%local, -pdg, u)
	end associate
	end if
	end do
	case ("cuts", "weight", "scale", &
	"factorization_scale", "renormalization_scale", &
	"selection", "reweight", "analysis")
	call cmd%local%pn%show (cmd%name(i), u)
	case ("expect")
	call expect_summary (force = .true.)
	case ("intrinsic")
	call var_list%write (intrinsic=.true., unit=u, &
	pacified = pacified)
	case ("logical")
	if (associated (model_vars)) then
	call model_vars%write (only_type=V_LOG, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list%write (&
	only_type=V_LOG, unit=u, pacified = pacified)
	case ("int")
	if (associated (model_vars)) then
	call model_vars%write (only_type=V_INT, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list%write (only_type=V_INT, &
	unit=u, pacified = pacified)
	case ("real")
	if (associated (model_vars)) then
	call model_vars%write (only_type=V_REAL, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list%write (only_type=V_REAL, &
	unit=u, pacified = pacified)
	case ("complex")
	if (associated (model_vars)) then
	call model_vars%write (only_type=V_CMPLX, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list%write (only_type=V_CMPLX, &
	unit=u, pacified = pacified)
	case ("pdg")
	if (associated (model_vars)) then
	call model_vars%write (only_type=V_PDG, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list%write (only_type=V_PDG, &
	unit=u, pacified = pacified)
	case ("string")
	if (associated (model_vars)) then
	call model_vars%write (only_type=V_STR, &
	model_name = name, unit=u, pacified = pacified, &
	follow_link=.false.)
	end if
	call var_list%write (only_type=V_STR, &
	unit=u, pacified = pacified)
	case default
	if (analysis_exists (cmd%name(i))) then
	call analysis_write (cmd%name(i), u)
	else if (cmd%local%process_stack%exists (cmd%name(i))) then
	process => cmd%local%process_stack%get_process_ptr (cmd%name(i))
	call process%show (u)
	else if (associated (cmd%local%prclib_stack%get_library_ptr &
	(cmd%name(i)))) then
	prc_lib => cmd%local%prclib_stack%get_library_ptr (cmd%name(i))
	call prc_lib%show (u)
	else if (associated (model_vars)) then
	if (model_vars%contains (cmd%name(i), follow_link=.false.)) then
	call model_vars%write_var (cmd%name(i), &
	unit = u, model_name = name, pacified = pacified)
	else if (var_list%contains (cmd%name(i))) then
	call var_list%write_var (cmd%name(i), &
	unit = u, pacified = pacified)
	else
	call msg_error ("show: object '" // char (cmd%name(i)) &
	// "' not found")
	end if
	else if (var_list%contains (cmd%name(i))) then
	call var_list%write_var (cmd%name(i), &
	unit = u, pacified = pacified)
	else
	call msg_error ("show: object '" // char (cmd%name(i)) &
	// "' not found")
	end if
	end select
	end do
	end if
	rewind (u)
	u_log = logfile_unit ()
	u_out = given_output_unit ()
	do
	read (u, "(A)", end = 1) buffer
	if (u_log > 0) write (u_log, "(A)") trim (buffer)
	if (u_out > 0) write (u_out, "(A)") trim (buffer)
	if (u_ext > 0) write (u_ext, "(A)") trim (buffer)
	end do
	1 close (u)
	if (u_log > 0) flush (u_log)
	if (u_out > 0) flush (u_out)
	if (u_ext > 0) flush (u_ext)
	end subroutine cmd_show_execute

	@ %def cmd_show_execute
	@
	\subsubsection{Clear values}
	This command clears the current values of variables or other objects,
	where this makes sense. It parallels the [[show]] command. The
	objects are cleared, but not deleted.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_clear_t
	private
	type(string_t), dimension(:), allocatable :: name
	contains
	<<Commands: cmd clear: TBP>>
	end type cmd_clear_t

	@ %def cmd_clear_t
	@ Output: list the names of the objects to be cleared.
	<<Commands: cmd clear: TBP>>=
	procedure :: write => cmd_clear_write
	<<Commands: 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))
	call global%process_stack%update_result_vars &
	(cmd%process_id(i), global%var_list)
	if (signal_is_pending ()) return
	end do
	end subroutine cmd_integrate_execute

	@ %def cmd_integrate_execute
	@
	\subsubsection{Observables}
	Declare an observable. After the declaration, it can be used to
	record data, and at the end one can retrieve average and error.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_observable_t
	private
	type(string_t) :: id
	contains
	<<Commands: cmd observable: TBP>>
	end type cmd_observable_t

	@ %def cmd_observable_t
	@ Output. We know the ID.
	<<Commands: cmd observable: TBP>>=
	procedure :: write => cmd_observable_write
	<<Commands: 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(6), parameter, public :: &
	FORBIDDEN_ENDINGS2 = [ "mp", "ps", "vg", "pg", "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.

	To determine decay branching rations, we look at the decay process IDs
	and inspect the corresponding [[integral()]] result variables.
	<<Commands: procedures>>=
	subroutine show_unstable (global, pdg, u)
	type(rt_data_t), intent(in), target :: global
	integer, intent(in) :: pdg, u
	type(flavor_t) :: flv
	type(string_t), dimension(:), allocatable :: decay
	real(default), dimension(:), allocatable :: br
	real(default) :: width
	type(process_t), pointer :: process
	type(process_component_def_t), pointer :: prc_def
	type(string_t), dimension(:), allocatable :: prt_out, prt_out_str
	integer :: i, j
	logical :: opened
	call flv%init (pdg, global%model)
	call flv%get_decays (decay)
	if (.not. allocated (decay)) return
	allocate (prt_out_str (size (decay)))
	allocate (br (size (decay)))
	do i = 1, size (br)
	process => global%process_stack%get_process_ptr (decay(i))
	prc_def => process%get_component_def_ptr (1)
	call prc_def%get_prt_out (prt_out)
	prt_out_str(i) = prt_out(1)
	do j = 2, size (prt_out)
	prt_out_str(i) = prt_out_str(i) // ", " // prt_out(j)
	end do
	br(i) = global%get_rval ("integral(" // decay(i) // ")")
	end do
	if (all (br >= 0)) then
	if (any (br > 0)) then
	width = sum (br)
	br = br / sum (br)
	write (u, "(A)") "Unstable particle " &
	// char (flv%get_name ()) &
	// ": computed branching ratios:"
	do i = 1, size (br)
	write (u, "(2x,A,':'," // FMT_14 // ",3x,A)") &
	char (decay(i)), br(i), char (prt_out_str(i))
	end do
	write (u, "(2x,'Total width ='," // FMT_14 // ",' GeV (computed)')") width
	write (u, "(2x,' ='," // FMT_14 // ",' GeV (preset)')") &
	flv%get_width ()
	if (flv%decays_isotropically ()) then
	write (u, "(2x,A)") "Decay options: isotropic"
	else if (flv%decays_diagonal ()) then
	write (u, "(2x,A)") "Decay options: &
	&projection on diagonal helicity states"
	else if (flv%has_decay_helicity ()) then
	write (u, "(2x,A,1x,I0)") "Decay options: projection onto helicity =", &
	flv%get_decay_helicity ()
	else
	write (u, "(2x,A)") "Decay options: helicity treated exactly"
	end if
	else
	inquire (unit = u, opened = opened)
	if (opened .and. .not. mask_fatal_errors) close (u)
	call msg_fatal ("Unstable particle " &
	// char (flv%get_name ()) &
	// ": partial width vanishes for all decay channels")
	end if
	else
	inquire (unit = u, opened = opened)
	if (opened .and. .not. mask_fatal_errors) close (u)
	call msg_fatal ("Unstable particle " &
	// char (flv%get_name ()) &
	// ": partial width is negative")
	end if
	end subroutine show_unstable

	@ %def show_unstable
	@ If no decays have been found, issue a non-fatal error.
	<<Commands: procedures>>=
	subroutine err_unstable (global, pdg)
	type(rt_data_t), intent(in), target :: global
	integer, intent(in) :: pdg
	type(flavor_t) :: flv
	call flv%init (pdg, global%model)
	call msg_error ("Unstable: no allowed decays found for particle " &
	// char (flv%get_name ()) // ", keeping as stable")
	end subroutine err_unstable

	@ %def err_unstable
	@ Auto decays: create process IDs and make up process
	configurations, using the PDG codes generated by the [[ds_table]] make
	method.

	We allocate and use a self-contained process library that contains only the
	decay processes of the current particle. When done, we revert the global
	library pointer to the original library but return the name of the new one.
	The new library becomes part of the global library stack and can thus be
	referred to at any time.
	<<Commands: procedures>>=
	subroutine create_auto_decays &
	(pdg_in, mult, rad, libname_dec, process_id, global)
	integer, intent(in) :: pdg_in
	integer, intent(in) :: mult
	logical, intent(in) :: rad
	type(string_t), intent(out) :: libname_dec
	type(string_t), dimension(:), allocatable, intent(out) :: process_id
	type(rt_data_t), intent(inout) :: global
	type(prclib_entry_t), pointer :: lib_entry
	type(process_library_t), pointer :: lib
	type(ds_table_t) :: ds_table
	type(split_constraints_t) :: constraints
	type(pdg_array_t), dimension(:), allocatable :: pa_out
	character(80) :: buffer
	character :: p_or_a
	type(string_t) :: process_string, libname_cur
	type(flavor_t) :: flv_in, flv_out
	type(string_t) :: prt_in
	type(string_t), dimension(:), allocatable :: prt_out
	type(process_configuration_t) :: prc_config
	integer :: i, j, k
	call flv_in%init (pdg_in, global%model)
	if (rad) then
	call constraints%init (2)
	else
	call constraints%init (3)
	call constraints%set (3, constrain_radiation ())
	end if
	call constraints%set (1, constrain_n_tot (mult))
	call constraints%set (2, &
	constrain_mass_sum (flv_in%get_mass (), margin = 0._default))
	call ds_table%make (global%model, pdg_in, constraints)
	prt_in = flv_in%get_name ()
	if (pdg_in > 0) then
	p_or_a = "p"
	else
	p_or_a = "a"
	end if
	if (ds_table%get_length () == 0) then
	call msg_warning ("Auto-decays: Particle " // char (prt_in) // ": " &
	// "no decays found")
	libname_dec = ""
	allocate (process_id (0))
	else
	call msg_message ("Creating decay process library for particle " &
	// char (prt_in))
	libname_cur = global%prclib%get_name ()
	write (buffer, "(A,A,I0)") "_d", p_or_a, abs (pdg_in)
	libname_dec = libname_cur // trim (buffer)
	lib => global%prclib_stack%get_library_ptr (libname_dec)
	if (.not. (associated (lib))) then
	allocate (lib_entry)
	call lib_entry%init (libname_dec)
	lib => lib_entry%process_library_t
	call global%add_prclib (lib_entry)
	else
	call global%update_prclib (lib)
	end if
	allocate (process_id (ds_table%get_length ()))
	do i = 1, size (process_id)
	write (buffer, "(A,'_',A,I0,'_',I0)") &
	"decay", p_or_a, abs (pdg_in), i
	process_id(i) = trim (buffer)
	process_string = process_id(i) // ": " // prt_in // " =>"
	call ds_table%get_pdg_out (i, pa_out)
	allocate (prt_out (size (pa_out)))
	do j = 1, size (pa_out)
	do k = 1, pa_out(j)%get_length ()
	call flv_out%init (pa_out(j)%get (k), global%model)
	if (k == 1) then
	prt_out(j) = flv_out%get_name ()
	else
	prt_out(j) = prt_out(j) // ":" // flv_out%get_name ()
	end if
	end do
	process_string = process_string // " " // prt_out(j)
	end do
	call msg_message (char (process_string))
	call prc_config%init (process_id(i), 1, 1, &
	global%model, global%var_list, &
	nlo_process = global%nlo_fixed_order)
	!!! 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, sample_suffix
	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
	<<Commands: cmd simulate execute: variables>>
	var_list => cmd%local%var_list
	if (allocated (cmd%local%pn%alt_setup)) then
	allocate (alt_env (size (cmd%local%pn%alt_setup)))
	do i = 1, size (alt_env)
	call build_alt_setup (alt_env(i), cmd%local, &
	cmd%local%pn%alt_setup(i)%ptr)
	end do
	call sim%init (cmd%process_id, .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_suffix = ""
	<<Commands: cmd simulate execute: init>>
	sample = var_list%get_sval (var_str ("$sample"))
	if (sample == "") then
	sample = sim%get_default_sample_name () // sample_suffix
	else
	sample = var_list%get_sval (var_str ("$sample")) // sample_suffix
	end if
	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
	<<Commands: cmd simulate execute: variables>>=
	@
	<<Commands: cmd simulate execute: init>>=
	@
	<<MPI: Commands: cmd simulate execute: variables>>=
	logical :: mpi_logging
	integer :: rank, n_size
	@ Append rank id to sample name.
	<<MPI: Commands: cmd simulate execute: init>>=
	call mpi_get_comm_id (n_size, rank)
	if (n_size > 1) then
	sample_suffix = var_str ("_") // str (rank)
	end if
	mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) &
	& .and. (n_size > 1)) &
	& .or. var_list%get_lval (var_str ("?mpi_logging")))
	call mpi_set_logging (mpi_logging)
	@
	@ 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, sample_suffix
	logical :: exist, write_raw, update_event, update_sqme
	type(simulation_t), target :: sim
	type(event_sample_data_t) :: input_data, data
	type(string_t) :: input_sample
	integer :: n_fmt
	type(string_t), dimension(:), allocatable :: sample_fmt
	type(string_t) :: input_format, input_ext, input_file
	type(string_t) :: lhef_extension, extension_hepmc, extension_lcio
	type(event_stream_array_t) :: es_array
	integer :: i, n_events
	<<Commands: cmd rescan execute: variables>>
	var_list => cmd%local%var_list
	if (allocated (cmd%local%pn%alt_setup)) then
	allocate (alt_env (size (cmd%local%pn%alt_setup)))
	do i = 1, size (alt_env)
	call build_alt_setup (alt_env(i), cmd%local, &
	cmd%local%pn%alt_setup(i)%ptr)
	end do
	call sim%init (cmd%process_id, .false., .false., cmd%local, global, &
	alt_env)
	else
	call sim%init (cmd%process_id, .false., .false., cmd%local, global)
	end if
	call sim%compute_n_events (n_events, var_list)
	input_sample = eval_string (cmd%pn_filename, var_list)
	input_format = var_list%get_sval (&
	var_str ("$rescan_input_format"))
	sample_suffix = ""
	<<Commands: cmd rescan execute: init>>
	sample = var_list%get_sval (var_str ("$sample"))
	if (sample == "") then
	sample = sim%get_default_sample_name () // sample_suffix
	else
	sample = var_list%get_sval (var_str ("$sample")) // sample_suffix
	end if
	write_raw = var_list%get_lval (var_str ("?write_raw"))
	if (allocated (cmd%local%sample_fmt)) then
	n_fmt = size (cmd%local%sample_fmt)
	else
	n_fmt = 0
	end if
	if (write_raw) then
	if (sample == input_sample) then
	call msg_error ("Rescan: ?write_raw = true: " &
	// "suppressing raw event output (filename clashes with input)")
	allocate (sample_fmt (n_fmt))
	if (n_fmt > 0) sample_fmt = cmd%local%sample_fmt
	else
	allocate (sample_fmt (n_fmt + 1))
	if (n_fmt > 0) sample_fmt(:n_fmt) = cmd%local%sample_fmt
	sample_fmt(n_fmt+1) = var_str ("raw")
	end if
	else
	allocate (sample_fmt (n_fmt))
	if (n_fmt > 0) sample_fmt = cmd%local%sample_fmt
	end if
	update_event = &
	var_list%get_lval (var_str ("?update_event"))
	update_sqme = &
	var_list%get_lval (var_str ("?update_sqme"))
	if (update_event .or. update_sqme) then
	call msg_message ("Recalculating observables")
	if (update_sqme) then
	call msg_message ("Recalculating squared matrix elements")
	end if
	end if
	lhef_extension = &
	var_list%get_sval (var_str ("$lhef_extension"))
	extension_hepmc = &
	var_list%get_sval (var_str ("$extension_hepmc"))
	extension_lcio = &
	var_list%get_sval (var_str ("$extension_lcio"))
	select case (char (input_format))
	case ("raw"); input_ext = "evx"
	call cmd%local%set_log &
	(var_str ("?recover_beams"), .false., is_known=.true.)
	case ("lhef"); input_ext = lhef_extension
	case ("hepmc"); input_ext = extension_hepmc
	case 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
	@
	<<Commands: cmd rescan execute: variables>>=
	@
	<<Commands: cmd rescan execute: init>>=
	@
	<<MPI: Commands: cmd rescan execute: variables>>=
	logical :: mpi_logging
	integer :: rank, n_size
	@ Append rank id to sample name.
	<<MPI: Commands: cmd rescan execute: init>>=
	call mpi_get_comm_id (n_size, rank)
	if (n_size > 1) then
	sample_suffix = var_str ("_") // str (rank)
	end if
	mpi_logging = (("vamp2" == char (var_list%get_sval (var_str ("$integration_method"))) &
	& .and. (n_size > 1)) &
	& .or. var_list%get_lval (var_str ("?mpi_logging")))
	call mpi_set_logging (mpi_logging)
	@
	\subsubsection{Parameters: number of iterations}
	Specify number of iterations and number of calls for one integration pass.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_iterations_t
	private
	integer :: n_pass = 0
	type(parse_node_p), dimension(:), allocatable :: pn_expr_n_it
	type(parse_node_p), dimension(:), allocatable :: pn_expr_n_calls
	type(parse_node_p), dimension(:), allocatable :: pn_sexpr_adapt
	contains
	<<Commands: cmd iterations: TBP>>
	end type cmd_iterations_t

	@ %def cmd_iterations_t
	@ Output. Display the number of passes, which is known after compilation.
	<<Commands: cmd iterations: TBP>>=
	procedure :: write => cmd_iterations_write
	<<Commands: 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
	call msg_debug (D_CORE, "cmd_scan_compile")
	if (debug_active (D_CORE)) call parse_node_write_rec (cmd%pn)
	pn_var => parse_node_get_sub_ptr (cmd%pn, 2)
	pn_body => parse_node_get_next_ptr (pn_var)
	if (associated (pn_body)) then
	pn_body_first => parse_node_get_sub_ptr (pn_body)
	else
	pn_body_first => null ()
	end if
	key = parse_node_get_rule_key (pn_var)
	select case (char (key))
	case ("scan_num")
	pn_name => parse_node_get_sub_ptr (pn_var)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_num"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_int")
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_int"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_real")
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_real"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_complex")
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str("cmd_complex"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_alias")
	pn_name => parse_node_get_sub_ptr (pn_var, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, var_str ("cmd_alias"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_string_decl")
	pn_decl => parse_node_get_sub_ptr (pn_var, 2)
	pn_name => parse_node_get_sub_ptr (pn_decl, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule_decl => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_string"))
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_string_decl"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_log_decl")
	pn_decl => parse_node_get_sub_ptr (pn_var, 2)
	pn_name => parse_node_get_sub_ptr (pn_decl, 2)
	cmd%name = parse_node_get_string (pn_name)
	var_rule_decl => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_log"))
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_log_decl"))
	pn_arg => parse_node_get_next_ptr (pn_name, 2)
	case ("scan_cuts")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_cuts"))
	cmd%name = "cuts"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_weight")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_weight"))
	cmd%name = "weight"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_scale")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_scale"))
	cmd%name = "scale"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_ren_scale")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_ren_scale"))
	cmd%name = "renormalization_scale"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_fac_scale")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_fac_scale"))
	cmd%name = "factorization_scale"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_selection")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_selection"))
	cmd%name = "selection"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_reweight")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_reweight"))
	cmd%name = "reweight"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_analysis")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_analysis"))
	cmd%name = "analysis"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_model")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_model"))
	cmd%name = "model"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case ("scan_library")
	var_rule => syntax_get_rule_ptr (syntax_cmd_list, &
	var_str ("cmd_library"))
	cmd%name = "library"
	pn_arg => parse_node_get_sub_ptr (pn_var, 3)
	case default
	call msg_bug ("scan: case '" // char (key) // "' not implemented")
	end select
	if (associated (pn_arg)) then
	cmd%n_values = parse_node_get_n_sub (pn_arg)
	end if
	var_list => global%get_var_list_ptr ()
	allocate (cmd%scan_cmd (cmd%n_values))
	select case (char (key))
	case ("scan_num")
	var_type = &
	var_list%get_type (cmd%name)
	select case (var_type)
	case (V_INT)
	!!! !!! 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_active (D_CORE)) then
	do i = 1, cmd%n_values
	print *, "scan command ", i
	call parse_node_write_rec (cmd%scan_cmd(i)%ptr)
	if (allocated (cmd%range_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{Export values}
	This command exports the current values of variables or other objects to the
	surrounding scope. By default, a scope enclosed by braces keeps all objects
	local to it. The [[export]] command exports the values that are generated
	within the scope to the corresponding object in the outer scope.

	The allowed set of exportable objects is, in principle, the same as the set of
	objects that the [[show]] command supports. This includes some convenience
	abbreviations.

	TODO: The initial implementation inherits syntax from [[show]], but supports
	only the [[results]] pseudo-object. The results (i.e., the process stack) is
	appended to the outer process stack instead of being discarded. The behavior
	of the [[export]] command for other object kinds is to be defined on a
	case-by-case basis. It may involve replacing the outer value or, instead,
	doing some sort of appending or reduction.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_export_t
	private
	type(string_t), dimension(:), allocatable :: name
	contains
	<<Commands: cmd export: TBP>>
	end type cmd_export_t

	@ %def cmd_export_t
	@ Output: list the object names, not values.
	<<Commands: cmd export: TBP>>=
	procedure :: write => cmd_export_write
	<<Commands: procedures>>=
	subroutine cmd_export_write (cmd, unit, indent)
	class(cmd_export_t), intent(in) :: cmd
	integer, intent(in), optional :: unit, indent
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call write_indent (u, indent)
	write (u, "(1x,A)", advance="no") "export: "
	if (allocated (cmd%name)) then
	do i = 1, size (cmd%name)
	write (u, "(1x,A)", advance="no") char (cmd%name(i))
	end do
	write (u, *)
	else
	write (u, "(5x,A)") "[undefined]"
	end if
	end subroutine cmd_export_write

	@ %def cmd_export_write
	@ Compile. Allocate an array which is filled with the names of the
	variables to export.
	<<Commands: cmd export: TBP>>=
	procedure :: compile => cmd_export_compile
	<<Commands: procedures>>=
	subroutine cmd_export_compile (cmd, global)
	class(cmd_export_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	type(parse_node_t), pointer :: pn_arg, pn_var, pn_prefix, pn_name
	type(string_t) :: key
	integer :: i, n_args
	pn_arg => parse_node_get_sub_ptr (cmd%pn, 2)
	if (associated (pn_arg)) then
	select case (char (parse_node_get_rule_key (pn_arg)))
	case ("show_arg")
	cmd%pn_opt => parse_node_get_next_ptr (pn_arg)
	case default
	cmd%pn_opt => pn_arg
	pn_arg => null ()
	end select
	end if
	call cmd%compile_options (global)
	if (associated (pn_arg)) then
	n_args = parse_node_get_n_sub (pn_arg)
	allocate (cmd%name (n_args))
	pn_var => parse_node_get_sub_ptr (pn_arg)
	i = 0
	do while (associated (pn_var))
	i = i + 1
	select case (char (parse_node_get_rule_key (pn_var)))
	case ("model", "library", "beams", "iterations", &
	"cuts", "weight", "int", "real", "complex", &
	"scale", "factorization_scale", "renormalization_scale", &
	"selection", "reweight", "analysis", "pdg", &
	"stable", "unstable", "polarized", "unpolarized", &
	"results", "expect", "intrinsic", "string", "logical")
	cmd%name(i) = parse_node_get_key (pn_var)
	case ("result_var")
	pn_prefix => parse_node_get_sub_ptr (pn_var)
	pn_name => parse_node_get_next_ptr (pn_prefix)
	if (associated (pn_name)) then
	cmd%name(i) = parse_node_get_key (pn_prefix) &
	// "(" // parse_node_get_string (pn_name) // ")"
	else
	cmd%name(i) = parse_node_get_key (pn_prefix)
	end if
	case ("log_var", "string_var", "alias_var")
	pn_prefix => parse_node_get_sub_ptr (pn_var)
	pn_name => parse_node_get_next_ptr (pn_prefix)
	key = parse_node_get_key (pn_prefix)
	if (associated (pn_name)) then
	select case (char (parse_node_get_rule_key (pn_name)))
	case ("var_name")
	select case (char (key))
	case ("?", "$") ! $ sign
	cmd%name(i) = key // parse_node_get_string (pn_name)
	case ("alias")
	cmd%name(i) = parse_node_get_string (pn_name)
	end select
	case default
	call parse_node_mismatch &
	("var_name", pn_name)
	end select
	else
	cmd%name(i) = key
	end if
	case default
	cmd%name(i) = parse_node_get_string (pn_var)
	end select
	!!! restriction imposed by current lack of implementation
	select case (char (parse_node_get_rule_key (pn_var)))
	case ("results")
	case default
	call msg_fatal ("export: object (type) '" &
	// char (parse_node_get_rule_key (pn_var)) &
	// "' not supported yet")
	end select
	pn_var => parse_node_get_next_ptr (pn_var)
	end do
	else
	allocate (cmd%name (0))
	end if
	end subroutine cmd_export_compile

	@ %def cmd_export_compile
	@ Execute. Scan the list of objects to export.
	<<Commands: cmd export: TBP>>=
	procedure :: execute => cmd_export_execute
	<<Commands: procedures>>=
	subroutine cmd_export_execute (cmd, global)
	class(cmd_export_t), intent(inout) :: cmd
	type(rt_data_t), intent(inout), target :: global
	call global%append_exports (cmd%name)
	end subroutine cmd_export_execute

	@ %def cmd_export_execute
	@
	\subsubsection{Quit command execution}
	The code is the return code of the whole program if it is terminated
	by this command.
	<<Commands: types>>=
	type, extends (command_t) :: cmd_quit_t
	private
	logical :: has_code = .false.
	type(parse_node_t), pointer :: pn_code_expr => null ()
	contains
	<<Commands: cmd quit: TBP>>
	end type cmd_quit_t

	@ %def cmd_quit_t
	@ Output.
	<<Commands: cmd quit: TBP>>=
	procedure :: write => cmd_quit_write
	<<Commands: 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_export \| " &
	// "cmd_polarized \| cmd_unpolarized \| " &
	// "cmd_open_out \| cmd_close_out \| cmd_printf \| " &
	// "cmd_write_analysis \| cmd_compile_analysis \| cmd_nlo \| cmd_components")
	call ifile_append (ifile, "GRO options = '{' local_command_list '}'")
	call ifile_append (ifile, "SEQ local_command_list = local_command*")
	call ifile_append (ifile, "ALT local_command = " &
	// "cmd_model \| cmd_library \| cmd_iterations \| cmd_sample_format \| " &
	// "cmd_var \| cmd_slha \| " &
	// "cmd_show \| " &
	// "cmd_expect \| " &
	// "cmd_cuts \| cmd_scale \| cmd_fac_scale \| cmd_ren_scale \| " &
	// "cmd_weight \| cmd_selection \| cmd_reweight \| " &
	// "cmd_beams \| cmd_beams_pol_density \| cmd_beams_pol_fraction \| " &
	// "cmd_beams_momentum \| cmd_beams_theta \| cmd_beams_phi \| " &
	// "cmd_observable \| cmd_histogram \| cmd_plot \| cmd_graph \| " &
	// "cmd_clear \| cmd_record \| " &
	// "cmd_analysis \| cmd_alt_setup \| " &
	// "cmd_open_out \| cmd_close_out \| cmd_printf \| " &
	// "cmd_write_analysis \| cmd_compile_analysis \| cmd_nlo \| cmd_components")
	call ifile_append (ifile, "SEQ cmd_model = model '=' model_name model_arg?")
	call ifile_append (ifile, "KEY model")
	call ifile_append (ifile, "ALT model_name = model_id \| string_literal")
	call ifile_append (ifile, "IDE model_id")
	call ifile_append (ifile, "ARG model_arg = ( model_scheme? )")
	call ifile_append (ifile, "ALT model_scheme = " &
	// "ufo_spec \| scheme_id \| string_literal")
	call ifile_append (ifile, "SEQ ufo_spec = ufo ufo_arg?")
	call ifile_append (ifile, "KEY ufo")
	call ifile_append (ifile, "ARG ufo_arg = ( string_literal )")
	call ifile_append (ifile, "IDE scheme_id")
	call ifile_append (ifile, "SEQ cmd_library = library '=' lib_name")
	call ifile_append (ifile, "KEY library")
	call ifile_append (ifile, "ALT lib_name = lib_id \| string_literal")
	call ifile_append (ifile, "IDE lib_id")
	call ifile_append (ifile, "ALT cmd_var = " &
	// "cmd_log_decl \| cmd_log \| " &
	// "cmd_int \| cmd_real \| cmd_complex \| cmd_num \| " &
	// "cmd_string_decl \| cmd_string \| cmd_alias \| " &
	// "cmd_result")
	call ifile_append (ifile, "SEQ cmd_log_decl = logical cmd_log")
	call ifile_append (ifile, "SEQ cmd_log = '?' var_name '=' lexpr")
	call ifile_append (ifile, "SEQ cmd_int = int var_name '=' expr")
	call ifile_append (ifile, "SEQ cmd_real = real var_name '=' expr")
	call ifile_append (ifile, "SEQ cmd_complex = complex var_name '=' expr")
	call ifile_append (ifile, "SEQ cmd_num = var_name '=' expr")
	call ifile_append (ifile, "SEQ cmd_string_decl = string cmd_string")
	call ifile_append (ifile, "SEQ cmd_string = " &
	// "'$' var_name '=' sexpr") ! $
	call ifile_append (ifile, "SEQ cmd_alias = alias var_name '=' cexpr")
	call ifile_append (ifile, "SEQ cmd_result = result '=' expr")
	call ifile_append (ifile, "SEQ cmd_slha = slha_action slha_arg options?")
	call ifile_append (ifile, "ALT slha_action = " &
	// "read_slha \| write_slha")
	call ifile_append (ifile, "KEY read_slha")
	call ifile_append (ifile, "KEY write_slha")
	call ifile_append (ifile, "ARG slha_arg = ( string_literal )")
	call ifile_append (ifile, "SEQ cmd_show = show show_arg options?")
	call ifile_append (ifile, "KEY show")
	call ifile_append (ifile, "ARG show_arg = ( showable* )")
	call ifile_append (ifile, "ALT showable = " &
	// "model \| library \| beams \| iterations \| " &
	// "cuts \| weight \| logical \| string \| pdg \| " &
	// "scale \| factorization_scale \| renormalization_scale \| " &
	// "selection \| reweight \| analysis \| " &
	// "stable \| unstable \| polarized \| unpolarized \| " &
	// "expect \| intrinsic \| int \| real \| complex \| " &
	// "alias_var \| string \| results \| result_var \| " &
	// "log_var \| string_var \| var_name")
	call ifile_append (ifile, "KEY results")
	call ifile_append (ifile, "KEY intrinsic")
	call ifile_append (ifile, "SEQ alias_var = alias var_name")
	call ifile_append (ifile, "SEQ result_var = result_key result_arg?")
	call ifile_append (ifile, "SEQ log_var = '?' var_name")
	call ifile_append (ifile, "SEQ string_var = '$' var_name") ! $
	call ifile_append (ifile, "SEQ cmd_clear = clear clear_arg options?")
	call ifile_append (ifile, "KEY clear")
	call ifile_append (ifile, "ARG clear_arg = ( clearable* )")
	call ifile_append (ifile, "ALT clearable = " &
	// "beams \| iterations \| " &
	// "cuts \| weight \| " &
	// "scale \| factorization_scale \| renormalization_scale \| " &
	// "selection \| reweight \| analysis \| " &
	// "unstable \| polarized \| " &
	// "expect \| " &
	// "log_var \| string_var \| var_name")
	call ifile_append (ifile, "SEQ cmd_expect = expect expect_arg options?")
	call ifile_append (ifile, "KEY expect")
	call ifile_append (ifile, "ARG expect_arg = ( lexpr )")
	call ifile_append (ifile, "SEQ cmd_cuts = cuts '=' lexpr")
	call ifile_append (ifile, "SEQ cmd_scale = scale '=' expr")
	call ifile_append (ifile, "SEQ cmd_fac_scale = " &
	// "factorization_scale '=' expr")
	call ifile_append (ifile, "SEQ cmd_ren_scale = " &
	// "renormalization_scale '=' expr")
	call ifile_append (ifile, "SEQ cmd_weight = weight '=' expr")
	call ifile_append (ifile, "SEQ cmd_selection = selection '=' lexpr")
	call ifile_append (ifile, "SEQ cmd_reweight = reweight '=' expr")
	call ifile_append (ifile, "KEY cuts")
	call ifile_append (ifile, "KEY scale")
	call ifile_append (ifile, "KEY factorization_scale")
	call ifile_append (ifile, "KEY renormalization_scale")
	call ifile_append (ifile, "KEY weight")
	call ifile_append (ifile, "KEY selection")
	call ifile_append (ifile, "KEY reweight")
	call ifile_append (ifile, "SEQ cmd_process = process process_id '=' " &
	// "process_prt '=>' prt_state_list options?")
	call ifile_append (ifile, "KEY process")
	call ifile_append (ifile, "KEY '=>'")
	call ifile_append (ifile, "LIS process_prt = cexpr+")
	call ifile_append (ifile, "LIS prt_state_list = prt_state_sum+")
	call ifile_append (ifile, "SEQ prt_state_sum = " &
	// "prt_state prt_state_addition*")
	call ifile_append (ifile, "SEQ prt_state_addition = '+' prt_state")
	call ifile_append (ifile, "ALT prt_state = grouped_prt_state_list \| cexpr")
	call ifile_append (ifile, "GRO grouped_prt_state_list = " &
	// "( prt_state_list )")
	call ifile_append (ifile, "SEQ cmd_compile = compile_cmd options?")
	call ifile_append (ifile, "SEQ compile_cmd = compile_clause compile_arg?")
	call ifile_append (ifile, "SEQ compile_clause = compile exec_name_spec?")
	call ifile_append (ifile, "KEY compile")
	call ifile_append (ifile, "SEQ exec_name_spec = as exec_name")
	call ifile_append (ifile, "KEY as")
	call ifile_append (ifile, "ALT exec_name = exec_id \| string_literal")
	call ifile_append (ifile, "IDE exec_id")
	call ifile_append (ifile, "ARG compile_arg = ( lib_name* )")
	call ifile_append (ifile, "SEQ cmd_exec = exec exec_arg")
	call ifile_append (ifile, "KEY exec")
	call ifile_append (ifile, "ARG exec_arg = ( sexpr )")
	call ifile_append (ifile, "SEQ cmd_beams = beams '=' beam_def")
	call ifile_append (ifile, "KEY beams")
	call ifile_append (ifile, "SEQ beam_def = beam_spec strfun_seq*")
	call ifile_append (ifile, "SEQ beam_spec = beam_list")
	call ifile_append (ifile, "LIS beam_list = cexpr, cexpr?")
	call ifile_append (ifile, "SEQ cmd_beams_pol_density = " &
	// "beams_pol_density '=' beams_pol_spec")
	call ifile_append (ifile, "KEY beams_pol_density")
	call ifile_append (ifile, "LIS beams_pol_spec = smatrix, smatrix?")
	call ifile_append (ifile, "SEQ smatrix = '@' smatrix_arg")
	! call ifile_append (ifile, "KEY '@'") !!! Key already exists
	call ifile_append (ifile, "ARG smatrix_arg = ( sentry* )")
	call ifile_append (ifile, "SEQ sentry = expr extra_sentry*")
	call ifile_append (ifile, "SEQ extra_sentry = ':' expr")
	call ifile_append (ifile, "SEQ cmd_beams_pol_fraction = " &
	// "beams_pol_fraction '=' beams_par_spec")
	call ifile_append (ifile, "KEY beams_pol_fraction")
	call ifile_append (ifile, "SEQ cmd_beams_momentum = " &
	// "beams_momentum '=' beams_par_spec")
	call ifile_append (ifile, "KEY beams_momentum")
	call ifile_append (ifile, "SEQ cmd_beams_theta = " &
	// "beams_theta '=' beams_par_spec")
	call ifile_append (ifile, "KEY beams_theta")
	call ifile_append (ifile, "SEQ cmd_beams_phi = " &
	// "beams_phi '=' beams_par_spec")
	call ifile_append (ifile, "KEY beams_phi")
	call ifile_append (ifile, "LIS beams_par_spec = expr, expr?")
	call ifile_append (ifile, "SEQ strfun_seq = '=>' strfun_pair")
	call ifile_append (ifile, "LIS strfun_pair = strfun_def, strfun_def?")
	call ifile_append (ifile, "SEQ strfun_def = strfun_id")
	call ifile_append (ifile, "ALT strfun_id = " &
	// "none \| lhapdf \| lhapdf_photon \| pdf_builtin \| pdf_builtin_photon \| " &
	// "isr \| epa \| ewa \| circe1 \| circe2 \| energy_scan \| " &
	// "gaussian \| beam_events")
	call ifile_append (ifile, "KEY none")
	call ifile_append (ifile, "KEY lhapdf")
	call ifile_append (ifile, "KEY lhapdf_photon")
	call ifile_append (ifile, "KEY pdf_builtin")
	call ifile_append (ifile, "KEY pdf_builtin_photon")
	call ifile_append (ifile, "KEY isr")
	call ifile_append (ifile, "KEY epa")
	call ifile_append (ifile, "KEY ewa")
	call ifile_append (ifile, "KEY circe1")
	call ifile_append (ifile, "KEY circe2")
	call ifile_append (ifile, "KEY energy_scan")
	call ifile_append (ifile, "KEY gaussian")
	call ifile_append (ifile, "KEY beam_events")
	call ifile_append (ifile, "SEQ cmd_integrate = " &
	// "integrate proc_arg options?")
	call ifile_append (ifile, "KEY integrate")
	call ifile_append (ifile, "ARG proc_arg = ( proc_id* )")
	call ifile_append (ifile, "IDE proc_id")
	call ifile_append (ifile, "SEQ cmd_iterations = " &
	// "iterations '=' iterations_list")
	call ifile_append (ifile, "KEY iterations")
	call ifile_append (ifile, "LIS iterations_list = iterations_spec+")
	call ifile_append (ifile, "ALT iterations_spec = it_spec")
	call ifile_append (ifile, "SEQ it_spec = expr calls_spec adapt_spec?")
	call ifile_append (ifile, "SEQ calls_spec = ':' expr")
	call ifile_append (ifile, "SEQ adapt_spec = ':' sexpr")
	call ifile_append (ifile, "SEQ cmd_components = " &
	// "active '=' component_list")
	call ifile_append (ifile, "KEY active")
	call ifile_append (ifile, "LIS component_list = sexpr+")
	call ifile_append (ifile, "SEQ cmd_sample_format = " &
	// "sample_format '=' event_format_list")
	call ifile_append (ifile, "KEY sample_format")
	call ifile_append (ifile, "LIS event_format_list = event_format+")
	call ifile_append (ifile, "IDE event_format")
	call ifile_append (ifile, "SEQ cmd_observable = " &
	// "observable analysis_tag options?")
	call ifile_append (ifile, "KEY observable")
	call ifile_append (ifile, "SEQ cmd_histogram = " &
	// "histogram analysis_tag histogram_arg " &
	// "options?")
	call ifile_append (ifile, "KEY histogram")
	call ifile_append (ifile, "ARG histogram_arg = (expr, expr, expr?)")
	call ifile_append (ifile, "SEQ cmd_plot = plot analysis_tag options?")
	call ifile_append (ifile, "KEY plot")
	call ifile_append (ifile, "SEQ cmd_graph = graph graph_term '=' graph_def")
	call ifile_append (ifile, "KEY graph")
	call ifile_append (ifile, "SEQ graph_term = analysis_tag options?")
	call ifile_append (ifile, "SEQ graph_def = graph_term graph_append*")
	call ifile_append (ifile, "SEQ graph_append = '&' graph_term")
	call ifile_append (ifile, "SEQ cmd_analysis = analysis '=' lexpr")
	call ifile_append (ifile, "KEY analysis")
	call ifile_append (ifile, "SEQ cmd_alt_setup = " &
	// "alt_setup '=' option_list_expr")
	call ifile_append (ifile, "KEY alt_setup")
	call ifile_append (ifile, "ALT option_list_expr = " &
	// "grouped_option_list \| option_list")
	call ifile_append (ifile, "GRO grouped_option_list = ( option_list_expr )")
	call ifile_append (ifile, "LIS option_list = options+")
	call ifile_append (ifile, "SEQ cmd_open_out = open_out open_arg options?")
	call ifile_append (ifile, "SEQ cmd_close_out = close_out open_arg options?")
	call ifile_append (ifile, "KEY open_out")
	call ifile_append (ifile, "KEY close_out")
	call ifile_append (ifile, "ARG open_arg = (sexpr)")
	call ifile_append (ifile, "SEQ cmd_printf = printf_cmd options?")
	call ifile_append (ifile, "SEQ printf_cmd = printf_clause sprintf_args?")
	call ifile_append (ifile, "SEQ printf_clause = printf sexpr")
	call ifile_append (ifile, "KEY printf")
	call ifile_append (ifile, "SEQ cmd_record = record_cmd")
	call ifile_append (ifile, "SEQ cmd_unstable = " &
	// "unstable cexpr unstable_arg options?")
	call ifile_append (ifile, "KEY unstable")
	call ifile_append (ifile, "ARG unstable_arg = ( proc_id* )")
	call ifile_append (ifile, "SEQ cmd_stable = stable stable_list options?")
	call ifile_append (ifile, "KEY stable")
	call ifile_append (ifile, "LIS stable_list = cexpr+")
	call ifile_append (ifile, "KEY polarized")
	call ifile_append (ifile, "SEQ cmd_polarized = polarized polarized_list options?")
	call ifile_append (ifile, "LIS polarized_list = cexpr+")
	call ifile_append (ifile, "KEY unpolarized")
	call ifile_append (ifile, "SEQ cmd_unpolarized = unpolarized unpolarized_list options?")
	call ifile_append (ifile, "LIS unpolarized_list = cexpr+")
	call ifile_append (ifile, "SEQ cmd_simulate = " &
	// "simulate proc_arg options?")
	call ifile_append (ifile, "KEY simulate")
	call ifile_append (ifile, "SEQ cmd_rescan = " &
	// "rescan sexpr proc_arg options?")
	call ifile_append (ifile, "KEY rescan")
	call ifile_append (ifile, "SEQ cmd_scan = scan scan_var scan_body?")
	call ifile_append (ifile, "KEY scan")
	call ifile_append (ifile, "ALT scan_var = " &
	// "scan_log_decl \| scan_log \| " &
	// "scan_int \| scan_real \| scan_complex \| scan_num \| " &
	// "scan_string_decl \| scan_string \| scan_alias \| " &
	// "scan_cuts \| scan_weight \| " &
	// "scan_scale \| scan_ren_scale \| scan_fac_scale \| " &
	// "scan_selection \| scan_reweight \| scan_analysis \| " &
	// "scan_model \| scan_library")
	call ifile_append (ifile, "SEQ scan_log_decl = logical scan_log")
	call ifile_append (ifile, "SEQ scan_log = '?' var_name '=' scan_log_arg")
	call ifile_append (ifile, "ARG scan_log_arg = ( lexpr* )")
	call ifile_append (ifile, "SEQ scan_int = int var_name '=' scan_num_arg")
	call ifile_append (ifile, "SEQ scan_real = real var_name '=' scan_num_arg")
	call ifile_append (ifile, "SEQ scan_complex = " &
	// "complex var_name '=' scan_num_arg")
	call ifile_append (ifile, "SEQ scan_num = var_name '=' scan_num_arg")
	call ifile_append (ifile, "ARG scan_num_arg = ( range* )")
	call ifile_append (ifile, "ALT range = grouped_range \| range_expr")
	call ifile_append (ifile, "GRO grouped_range = ( range_expr )")
	call ifile_append (ifile, "SEQ range_expr = expr range_spec?")
	call ifile_append (ifile, "SEQ range_spec = '=>' expr step_spec?")
	call ifile_append (ifile, "SEQ step_spec = step_op expr")
	call ifile_append (ifile, "ALT step_op = " &
	// "'/+' \| '/-' \| '/' \| '//' \| '/+/' \| '//'")
	call ifile_append (ifile, "KEY '/+'")
	call ifile_append (ifile, "KEY '/-'")
	call ifile_append (ifile, "KEY '/*'")
	call ifile_append (ifile, "KEY '//'")
	call ifile_append (ifile, "KEY '/+/'")
	call ifile_append (ifile, "KEY '/*/'")
	call ifile_append (ifile, "SEQ scan_string_decl = string scan_string")
	call ifile_append (ifile, "SEQ scan_string = " &
	// "'$' var_name '=' scan_string_arg")
	call ifile_append (ifile, "ARG scan_string_arg = ( sexpr* )")
	call ifile_append (ifile, "SEQ scan_alias = " &
	// "alias var_name '=' scan_alias_arg")
	call ifile_append (ifile, "ARG scan_alias_arg = ( cexpr* )")
	call ifile_append (ifile, "SEQ scan_cuts = cuts '=' scan_lexpr_arg")
	call ifile_append (ifile, "ARG scan_lexpr_arg = ( lexpr* )")
	call ifile_append (ifile, "SEQ scan_scale = scale '=' scan_expr_arg")
	call ifile_append (ifile, "ARG scan_expr_arg = ( expr* )")
	call ifile_append (ifile, "SEQ scan_fac_scale = " &
	// "factorization_scale '=' scan_expr_arg")
	call ifile_append (ifile, "SEQ scan_ren_scale = " &
	// "renormalization_scale '=' scan_expr_arg")
	call ifile_append (ifile, "SEQ scan_weight = weight '=' scan_expr_arg")
	call ifile_append (ifile, "SEQ scan_selection = selection '=' scan_lexpr_arg")
	call ifile_append (ifile, "SEQ scan_reweight = reweight '=' scan_expr_arg")
	call ifile_append (ifile, "SEQ scan_analysis = analysis '=' scan_lexpr_arg")
	call ifile_append (ifile, "SEQ scan_model = model '=' scan_model_arg")
	call ifile_append (ifile, "ARG scan_model_arg = ( model_name* )")
	call ifile_append (ifile, "SEQ scan_library = library '=' scan_library_arg")
	call ifile_append (ifile, "ARG scan_library_arg = ( lib_name* )")
	call ifile_append (ifile, "GRO scan_body = '{' command_list '}'")
	call ifile_append (ifile, "SEQ cmd_if = " &
	// "if lexpr then command_list elsif_clauses else_clause endif")
	call ifile_append (ifile, "SEQ elsif_clauses = cmd_elsif*")
	call ifile_append (ifile, "SEQ cmd_elsif = elsif lexpr then command_list")
	call ifile_append (ifile, "SEQ else_clause = cmd_else?")
	call ifile_append (ifile, "SEQ cmd_else = else command_list")
	call ifile_append (ifile, "SEQ cmd_include = include include_arg")
	call ifile_append (ifile, "KEY include")
	call ifile_append (ifile, "ARG include_arg = ( string_literal )")
	call ifile_append (ifile, "SEQ cmd_quit = quit_cmd quit_arg?")
	call ifile_append (ifile, "ALT quit_cmd = quit \| exit")
	call ifile_append (ifile, "KEY quit")
	call ifile_append (ifile, "KEY exit")
	call ifile_append (ifile, "ARG quit_arg = ( expr )")
	call ifile_append (ifile, "SEQ cmd_export = export show_arg options?")
	call ifile_append (ifile, "KEY export")
	call ifile_append (ifile, "SEQ cmd_write_analysis = " &
	// "write_analysis_clause options?")
	call ifile_append (ifile, "SEQ cmd_compile_analysis = " &
	// "compile_analysis_clause options?")
	call ifile_append (ifile, "SEQ write_analysis_clause = " &
	// "write_analysis write_analysis_arg?")
	call ifile_append (ifile, "SEQ compile_analysis_clause = " &
	// "compile_analysis write_analysis_arg?")
	call ifile_append (ifile, "KEY write_analysis")
	call ifile_append (ifile, "KEY compile_analysis")
	call ifile_append (ifile, "ARG write_analysis_arg = ( analysis_tag* )")
	call ifile_append (ifile, "SEQ cmd_nlo = " &
	// "nlo_calculation '=' nlo_calculation_list")
	call ifile_append (ifile, "KEY nlo_calculation")
	call ifile_append (ifile, "LIS nlo_calculation_list = nlo_comp+")
	call ifile_append (ifile, "ALT nlo_comp = " // &
	"full \| born \| real \| virtual \| dglap \| subtraction \| " // &
	"mismatch \| GKS")
	call ifile_append (ifile, "KEY full")
	call ifile_append (ifile, "KEY born")
	call ifile_append (ifile, "KEY virtual")
	call ifile_append (ifile, "KEY dglap")
	call ifile_append (ifile, "KEY subtraction")
	call ifile_append (ifile, "KEY mismatch")
	call ifile_append (ifile, "KEY GKS")
	call define_expr_syntax (ifile, particles=.true., analysis=.true.)
	end subroutine define_cmd_list_syntax

	@ %def define_cmd_list_syntax
	<<Commands: public>>=
	public :: lexer_init_cmd_list
	<<Commands: 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, only: var_list_t
	use models
	use slha_interface
	use rt_data
	use event_base, only: generic_event_t, event_callback_t

	use commands

	<<Standard module head>>

	<<Commands: test declarations>>

	<<Commands: test auxiliary types>>

	contains

	<<Commands: tests>>

	<<Commands: test auxiliary>>

	end module commands_uti

	@ %def commands_uti
	@ API: driver for the unit tests below.
	<<Commands: public test>>=
	public :: commands_test
	<<Commands: test driver>>=
	subroutine commands_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Commands: execute tests>>
	end subroutine commands_test

	@ %def commands_test
	@
	\subsubsection{Prepare Sindarin code}
	This routine parses an internal file, prints the parse tree, and
	returns a parse node to the root. We use the routine in the tests
	below.
	<<Commands: public test auxiliary>>=
	public :: parse_ifile
	<<Commands: test auxiliary>>=
	subroutine parse_ifile (ifile, pn_root, u)
	use ifiles
	use lexers
	use parser
	use commands
	type(ifile_t), intent(in) :: ifile
	type(parse_node_t), pointer, intent(out) :: pn_root
	integer, intent(in), optional :: u
	type(stream_t), target :: stream
	type(lexer_t), target :: lexer
	type(parse_tree_t) :: parse_tree

	call lexer_init_cmd_list (lexer)
	call stream_init (stream, ifile)
	call lexer_assign_stream (lexer, stream)

	call parse_tree_init (parse_tree, syntax_cmd_list, lexer)
	if (present (u)) call parse_tree_write (parse_tree, u)
	pn_root => parse_tree%get_root_ptr ()

	call stream_final (stream)
	call lexer_final (lexer)
	end subroutine parse_ifile

	@ %def parse_ifile
	@
	\subsubsection{Empty command list}
	Compile and execute an empty command list. Should do nothing but
	test the integrity of the workflow.
	<<Commands: execute tests>>=
	call test (commands_1, "commands_1", &
	"empty command list", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_1
	<<Commands: tests>>=
	subroutine commands_1 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_1"
	write (u, "(A)") "* Purpose: compile and execute empty command list"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Parse empty file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"

	if (associated (pn_root)) then
	call command_list%compile (pn_root, global)
	end if

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"

	call global%activate ()
	call command_list%execute (global)
	call global%deactivate ()

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call syntax_cmd_list_final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_1"

	end subroutine commands_1

	@ %def commands_1
	@
	\subsubsection{Read model}
	Execute a [[model]] assignment.
	<<Commands: execute tests>>=
	call test (commands_2, "commands_2", &
	"model", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_2
	<<Commands: tests>>=
	subroutine commands_2 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_2"
	write (u, "(A)") "* Purpose: set model"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')

	call ifile_write (ifile, u)

	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_2"

	end subroutine commands_2

	@ %def commands_2
	@
	\subsubsection{Declare Process}
	Read a model, then declare a process. The process library is allocated
	explicitly. For the process definition, We take the default ([[omega]])
	method. Since we do not compile, \oMega\ is not actually called.
	<<Commands: execute tests>>=
	call test (commands_3, "commands_3", &
	"process declaration", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_3
	<<Commands: tests>>=
	subroutine commands_3 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_3"
	write (u, "(A)") "* Purpose: define process"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd3"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process t3 = s, s => s, s')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%prclib_stack%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_3"

	end subroutine commands_3

	@ %def commands_3
	@
	\subsubsection{Compile Process}
	Read a model, then declare a process and compile the library. The process
	library is allocated explicitly. For the process definition, We take the
	default ([[unit_test]]) method. There is no external code, so compilation of
	the library is merely a formal status change.
	<<Commands: execute tests>>=
	call test (commands_4, "commands_4", &
	"compilation", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_4
	<<Commands: tests>>=
	subroutine commands_4 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_4"
	write (u, "(A)") "* Purpose: define process and compile library"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd4"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process t4 = s, s => s, s')
	call ifile_append (ifile, 'compile ("lib_cmd4")')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%prclib_stack%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_4"

	end subroutine commands_4

	@ %def commands_4
	@
	\subsubsection{Integrate Process}
	Read a model, then declare a process, compile the library, and
	integrate over phase space. We take the
	default ([[unit_test]]) method and use the simplest methods of
	phase-space parameterization and integration.
	<<Commands: execute tests>>=
	call test (commands_5, "commands_5", &
	"integration", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_5
	<<Commands: tests>>=
	subroutine commands_5 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_5"
	write (u, "(A)") "* Purpose: define process, iterations, and integrate"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)
	call global%var_list%set_int (var_str ("seed"), 0, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd5"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process t5 = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (t5)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call reset_interaction_counter ()
	call command_list%execute (global)

	call global%it_list%write (u)
	write (u, "(A)")
	call global%process_stack%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_5"

	end subroutine commands_5

	@ %def commands_5
	@
	\subsubsection{Variables}
	Set intrinsic and user-defined variables.
	<<Commands: execute tests>>=
	call test (commands_6, "commands_6", &
	"variables", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_6
	<<Commands: tests>>=
	subroutine commands_6 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_6"
	write (u, "(A)") "* Purpose: define and set variables"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()
	call global%write_vars (u, [ &
	var_str ("$run_id"), &
	var_str ("?unweighted"), &
	var_str ("sqrts")])

	write (u, "(A)")
	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$run_id = "run1"')
	call ifile_append (ifile, '?unweighted = false')
	call ifile_append (ifile, 'sqrts = 1000')
	call ifile_append (ifile, 'int j = 10')
	call ifile_append (ifile, 'real x = 1000.')
	call ifile_append (ifile, 'complex z = 5')
	call ifile_append (ifile, 'string $text = "abcd"')
	call ifile_append (ifile, 'logical ?flag = true')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_vars (u, [ &
	var_str ("$run_id"), &
	var_str ("?unweighted"), &
	var_str ("sqrts"), &
	var_str ("j"), &
	var_str ("x"), &
	var_str ("z"), &
	var_str ("$text"), &
	var_str ("?flag")])


	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call syntax_cmd_list_final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_6"

	end subroutine commands_6

	@ %def commands_6
	@
	\subsubsection{Process library}
	Open process libraries explicitly.
	<<Commands: execute tests>>=
	call test (commands_7, "commands_7", &
	"process library", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_7
	<<Commands: tests>>=
	subroutine commands_7 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_7"
	write (u, "(A)") "* Purpose: declare process libraries"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()
	call global%var_list%set_log (var_str ("?omega_openmp"), &
	.false., is_known = .true.)
	global%os_data%fc = "Fortran-compiler"
	global%os_data%fcflags = "Fortran-flags"

	write (u, "(A)")
	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'library = "lib_cmd7_1"')
	call ifile_append (ifile, 'library = "lib_cmd7_2"')
	call ifile_append (ifile, 'library = "lib_cmd7_1"')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_libraries (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call syntax_cmd_list_final ()
	call global%final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_7"

	end subroutine commands_7

	@ %def commands_7
	@
	\subsubsection{Generate events}
	Read a model, then declare a process, compile the library, and
	generate weighted events. We take the
	default ([[unit_test]]) method and use the simplest methods of
	phase-space parameterization and integration.
	<<Commands: execute tests>>=
	call test (commands_8, "commands_8", &
	"event generation", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_8
	<<Commands: tests>>=
	subroutine commands_8 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_8"
	write (u, "(A)") "* Purpose: define process, integrate, generate events"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd8"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_8_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (commands_8_p)')
	call ifile_append (ifile, '?unweighted = false')
	call ifile_append (ifile, 'n_events = 3')
	call ifile_append (ifile, '?read_raw = false')
	call ifile_append (ifile, 'simulate (commands_8_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"

	call command_list%execute (global)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_8"

	end subroutine commands_8

	@ %def commands_8
	@
	\subsubsection{Define cuts}
	Declare a cut expression.
	<<Commands: execute tests>>=
	call test (commands_9, "commands_9", &
	"cuts", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_9
	<<Commands: tests>>=
	subroutine commands_9 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(string_t), dimension(0) :: no_vars

	write (u, "(A)") "* Test output: commands_9"
	write (u, "(A)") "* Purpose: define cuts"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'cuts = all Pt > 0 [particle]')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write (u, vars = no_vars)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_9"

	end subroutine commands_9

	@ %def commands_9
	@
	\subsubsection{Beams}
	Define beam setup.
	<<Commands: execute tests>>=
	call test (commands_10, "commands_10", &
	"beams", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_10
	<<Commands: tests>>=
	subroutine commands_10 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_10"
	write (u, "(A)") "* Purpose: define beams"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = QCD')
	call ifile_append (ifile, 'sqrts = 1000')
	call ifile_append (ifile, 'beams = p, p')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_beams (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_10"

	end subroutine commands_10

	@ %def commands_10
	@
	\subsubsection{Structure functions}
	Define beam setup with structure functions
	<<Commands: execute tests>>=
	call test (commands_11, "commands_11", &
	"structure functions", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_11
	<<Commands: tests>>=
	subroutine commands_11 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_11"
	write (u, "(A)") "* Purpose: define beams with structure functions"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = QCD')
	call ifile_append (ifile, 'sqrts = 1100')
	call ifile_append (ifile, 'beams = p, p => lhapdf => pdf_builtin, isr')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_beams (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_11"

	end subroutine commands_11

	@ %def commands_11
	@
	\subsubsection{Rescan events}
	Read a model, then declare a process, compile the library, and
	generate weighted events. We take the
	default ([[unit_test]]) method and use the simplest methods of
	phase-space parameterization and integration. Then, rescan the
	generated event sample.
	<<Commands: execute tests>>=
	call test (commands_12, "commands_12", &
	"event rescanning", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_12
	<<Commands: tests>>=
	subroutine commands_12 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_12"
	write (u, "(A)") "* Purpose: generate events and rescan"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()

	call global%global_init ()
	call global%var_list%append_log (&
	var_str ("?rebuild_phase_space"), .false., &
	intrinsic=.true.)
	call global%var_list%append_log (&
	var_str ("?rebuild_grids"), .false., &
	intrinsic=.true.)
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd12"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_12_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (commands_12_p)')
	call ifile_append (ifile, '?unweighted = false')
	call ifile_append (ifile, 'n_events = 3')
	call ifile_append (ifile, '?read_raw = false')
	call ifile_append (ifile, 'simulate (commands_12_p)')
	call ifile_append (ifile, '?write_raw = false')
	call ifile_append (ifile, 'rescan "commands_12_p" (commands_12_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"

	call command_list%execute (global)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_12"

	end subroutine commands_12

	@ %def commands_12
	@
	\subsubsection{Event Files}
	Set output formats for event files.
	<<Commands: execute tests>>=
	call test (commands_13, "commands_13", &
	"event output formats", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_13
	<<Commands: tests>>=
	subroutine commands_13 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib
	logical :: exist

	write (u, "(A)") "* Test output: commands_13"
	write (u, "(A)") "* Purpose: generate events and rescan"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd13"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_13_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (commands_13_p)')
	call ifile_append (ifile, '?unweighted = false')
	call ifile_append (ifile, 'n_events = 1')
	call ifile_append (ifile, '?read_raw = false')
	call ifile_append (ifile, 'sample_format = weight_stream')
	call ifile_append (ifile, 'simulate (commands_13_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"

	call command_list%execute (global)

	write (u, "(A)")
	write (u, "(A)") "* Verify output files"
	write (u, "(A)")

	inquire (file = "commands_13_p.evx", exist = exist)
	if (exist) write (u, "(1x,A)") "raw"

	inquire (file = "commands_13_p.weights.dat", exist = exist)
	if (exist) write (u, "(1x,A)") "weight_stream"

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_13"

	end subroutine commands_13

	@ %def commands_13
	@
	\subsubsection{Compile Empty Libraries}
	(This is a regression test:) Declare two empty libraries and compile them.
	<<Commands: execute tests>>=
	call test (commands_14, "commands_14", &
	"empty libraries", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_14
	<<Commands: tests>>=
	subroutine commands_14 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_14"
	write (u, "(A)") "* Purpose: define and compile empty libraries"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_model_file_init ()
	call syntax_cmd_list_init ()

	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'library = "lib1"')
	call ifile_append (ifile, 'library = "lib2"')
	call ifile_append (ifile, 'compile ()')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%prclib_stack%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()

	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_14"

	end subroutine commands_14

	@ %def commands_14
	@
	\subsubsection{Compile Process}
	Read a model, then declare a process and compile the library. The process
	library is allocated explicitly. For the process definition, We take the
	default ([[unit_test]]) method. There is no external code, so compilation of
	the library is merely a formal status change.
	<<Commands: execute tests>>=
	call test (commands_15, "commands_15", &
	"compilation", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_15
	<<Commands: tests>>=
	subroutine commands_15 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_15"
	write (u, "(A)") "* Purpose: define process and compile library"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd15"))
	call global%add_prclib (lib)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process t15 = s, s => s, s')
	call ifile_append (ifile, 'iterations = 1:1000')
	call ifile_append (ifile, 'integrate (t15)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%prclib_stack%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_15"

	end subroutine commands_15

	@ %def commands_15
	@
	\subsubsection{Observable}
	Declare an observable, fill it and display.
	<<Commands: execute tests>>=
	call test (commands_16, "commands_16", &
	"observables", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_16
	<<Commands: tests>>=
	subroutine commands_16 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_16"
	write (u, "(A)") "* Purpose: declare an observable"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$obs_label = "foo"')
	call ifile_append (ifile, '$obs_unit = "cm"')
	call ifile_append (ifile, '$title = "Observable foo"')
	call ifile_append (ifile, '$description = "This is observable foo"')
	call ifile_append (ifile, 'observable foo')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Record two data items"
	write (u, "(A)")

	call analysis_record_data (var_str ("foo"), 1._default)
	call analysis_record_data (var_str ("foo"), 3._default)

	write (u, "(A)") "* Display analysis store"
	write (u, "(A)")

	call analysis_write (u, verbose=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_16"

	end subroutine commands_16

	@ %def commands_16
	@
	\subsubsection{Histogram}
	Declare a histogram, fill it and display.
	<<Commands: execute tests>>=
	call test (commands_17, "commands_17", &
	"histograms", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_17
	<<Commands: tests>>=
	subroutine commands_17 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(string_t), dimension(3) :: name
	integer :: i

	write (u, "(A)") "* Test output: commands_17"
	write (u, "(A)") "* Purpose: declare histograms"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$obs_label = "foo"')
	call ifile_append (ifile, '$obs_unit = "cm"')
	call ifile_append (ifile, '$title = "Histogram foo"')
	call ifile_append (ifile, '$description = "This is histogram foo"')
	call ifile_append (ifile, 'histogram foo (0,5,1)')
	call ifile_append (ifile, '$title = "Histogram bar"')
	call ifile_append (ifile, '$description = "This is histogram bar"')
	call ifile_append (ifile, 'n_bins = 2')
	call ifile_append (ifile, 'histogram bar (0,5)')
	call ifile_append (ifile, '$title = "Histogram gee"')
	call ifile_append (ifile, '$description = "This is histogram gee"')
	call ifile_append (ifile, '?normalize_bins = true')
	call ifile_append (ifile, 'histogram gee (0,5)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Record two data items"
	write (u, "(A)")

	name(1) = "foo"
	name(2) = "bar"
	name(3) = "gee"

	do i = 1, 3
	call analysis_record_data (name(i), 0.1_default, &
	weight = 0.25_default)
	call analysis_record_data (name(i), 3.1_default)
	call analysis_record_data (name(i), 4.1_default, &
	excess = 0.5_default)
	call analysis_record_data (name(i), 7.1_default)
	end do

	write (u, "(A)") "* Display analysis store"
	write (u, "(A)")

	call analysis_write (u, verbose=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_17"

	end subroutine commands_17

	@ %def commands_17
	@
	\subsubsection{Plot}
	Declare a plot, fill it and display contents.
	<<Commands: execute tests>>=
	call test (commands_18, "commands_18", &
	"plots", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_18
	<<Commands: tests>>=
	subroutine commands_18 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_18"
	write (u, "(A)") "* Purpose: declare a plot"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$obs_label = "foo"')
	call ifile_append (ifile, '$obs_unit = "cm"')
	call ifile_append (ifile, '$title = "Plot foo"')
	call ifile_append (ifile, '$description = "This is plot foo"')
	call ifile_append (ifile, '$x_label = "x axis"')
	call ifile_append (ifile, '$y_label = "y axis"')
	call ifile_append (ifile, '?x_log = false')
	call ifile_append (ifile, '?y_log = true')
	call ifile_append (ifile, 'x_min = -1')
	call ifile_append (ifile, 'x_max = 1')
	call ifile_append (ifile, 'y_min = 0.1')
	call ifile_append (ifile, 'y_max = 1000')
	call ifile_append (ifile, 'plot foo')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Record two data items"
	write (u, "(A)")

	call analysis_record_data (var_str ("foo"), 0._default, 20._default, &
	xerr = 0.25_default)
	call analysis_record_data (var_str ("foo"), 0.5_default, 0.2_default, &
	yerr = 0.07_default)
	call analysis_record_data (var_str ("foo"), 3._default, 2._default)

	write (u, "(A)") "* Display analysis store"
	write (u, "(A)")

	call analysis_write (u, verbose=.true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_18"

	end subroutine commands_18

	@ %def commands_18
	@
	\subsubsection{Graph}
	Combine two (empty) plots to a graph.
	<<Commands: execute tests>>=
	call test (commands_19, "commands_19", &
	"graphs", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_19
	<<Commands: tests>>=
	subroutine commands_19 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_19"
	write (u, "(A)") "* Purpose: combine two plots to a graph"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'plot a')
	call ifile_append (ifile, 'plot b')
	call ifile_append (ifile, '$title = "Graph foo"')
	call ifile_append (ifile, '$description = "This is graph foo"')
	call ifile_append (ifile, 'graph foo = a & b')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis object"
	write (u, "(A)")

	call analysis_write (var_str ("foo"), u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_19"

	end subroutine commands_19

	@ %def commands_19
	@
	\subsubsection{Record Data}
	Record data in previously allocated analysis objects.
	<<Commands: execute tests>>=
	call test (commands_20, "commands_20", &
	"record data", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_20
	<<Commands: tests>>=
	subroutine commands_20 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_20"
	write (u, "(A)") "* Purpose: record data"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create observable, histogram, plot"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	call analysis_init_observable (var_str ("o"))
	call analysis_init_histogram (var_str ("h"), 0._default, 1._default, 3, &
	normalize_bins = .false.)
	call analysis_init_plot (var_str ("p"))

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'record o (1.234)')
	call ifile_append (ifile, 'record h (0.5)')
	call ifile_append (ifile, 'record p (1, 2)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis object"
	write (u, "(A)")

	call analysis_write (u, verbose = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_20"

	end subroutine commands_20

	@ %def commands_20
	@
	\subsubsection{Analysis}
	Declare an analysis expression and use it to fill an observable during
	event generation.
	<<Commands: execute tests>>=
	call test (commands_21, "commands_21", &
	"analysis expression", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_21
	<<Commands: tests>>=
	subroutine commands_21 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: commands_21"
	write (u, "(A)") "* Purpose: create and use analysis expression"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create observable"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)

	allocate (lib)
	call lib%init (var_str ("lib_cmd8"))
	call global%add_prclib (lib)

	call analysis_init_observable (var_str ("m"))

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'model = "Test"')
	call ifile_append (ifile, 'process commands_21_p = s, s => s, s')
	call ifile_append (ifile, 'compile')
	call ifile_append (ifile, 'iterations = 1:100')
	call ifile_append (ifile, 'integrate (commands_21_p)')
	call ifile_append (ifile, '?unweighted = true')
	call ifile_append (ifile, 'n_events = 3')
	call ifile_append (ifile, '?read_raw = false')
	call ifile_append (ifile, 'observable m')
	call ifile_append (ifile, 'analysis = record m (eval M [s])')
	call ifile_append (ifile, 'simulate (commands_21_p)')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis object"
	write (u, "(A)")

	call analysis_write (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_21"

	end subroutine commands_21

	@ %def commands_21
	@
	\subsubsection{Write Analysis}
	Write accumulated analysis data to file.
	<<Commands: execute tests>>=
	call test (commands_22, "commands_22", &
	"write analysis", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_22
	<<Commands: tests>>=
	subroutine commands_22 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	integer :: u_file, iostat
	logical :: exist
	character(80) :: buffer

	write (u, "(A)") "* Test output: commands_22"
	write (u, "(A)") "* Purpose: write analysis data"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create observable"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	call analysis_init_observable (var_str ("m"))
	call analysis_record_data (var_str ("m"), 125._default)

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, '$out_file = "commands_22.dat"')
	call ifile_append (ifile, 'write_analysis')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root)

	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)

	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Display analysis data"
	write (u, "(A)")

	inquire (file = "commands_22.dat", exist = exist)
	if (.not. exist) then
	write (u, "(A)") "ERROR: File commands_22.dat not found"
	return
	end if

	u_file = free_unit ()
	open (u_file, file = "commands_22.dat", &
	action = "read", status = "old")
	do
	read (u_file, "(A)", iostat = iostat) buffer
	if (iostat /= 0) exit
	write (u, "(A)") trim (buffer)
	end do
	close (u_file)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call analysis_final ()
	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_22"

	end subroutine commands_22

	@ %def commands_22
	@
	\subsubsection{Compile Analysis}
	Write accumulated analysis data to file and compile.
	<<Commands: execute tests>>=
	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 model_vars%write_var (var_str ("mch1"), u)
	call model_vars%write_var (var_str ("wch1"), u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	write (u, "(A)") "* Model MSSM, values from SLHA file"
	write (u, "(A)")

	call global%model%write (u, verbose = .false., &
	show_vertices = .false., show_particles = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Selected global variables"
	write (u, "(A)")

	model_vars => global%model%get_var_list_ptr ()

	call model_vars%write_var (var_str ("mch1"), u)
	call model_vars%write_var (var_str ("wch1"), u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_slha_final ()
	call syntax_model_file_final ()
	call syntax_cmd_list_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_29"

	end subroutine commands_29

	@ %def commands_29
	@
	\subsubsection{Expressions for scales}
	Declare a scale, factorization scale or factorization scale expression.
	<<Commands: execute tests>>=
	call test (commands_30, "commands_30", &
	"scales", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_30
	<<Commands: tests>>=
	subroutine commands_30 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_30"
	write (u, "(A)") "* Purpose: define scales"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'scale = 200 GeV')
	call ifile_append (ifile, &
	'factorization_scale = eval Pt [particle]')
	call ifile_append (ifile, &
	'renormalization_scale = eval E [particle]')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_expr (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_30"

	end subroutine commands_30

	@ %def commands_30
	@
	\subsubsection{Weight and reweight expressions}
	Declare an expression for event weights and reweighting.
	<<Commands: execute tests>>=
	call test (commands_31, "commands_31", &
	"event weights/reweighting", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_31
	<<Commands: tests>>=
	subroutine commands_31 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_31"
	write (u, "(A)") "* Purpose: define weight/reweight"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'weight = eval Pz [particle]')
	call ifile_append (ifile, 'reweight = eval M2 [particle]')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_expr (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()
	call syntax_model_file_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_31"

	end subroutine commands_31

	@ %def commands_31
	@
	\subsubsection{Selecting events}
	Declare an expression for selecting events in an analysis.
	<<Commands: execute tests>>=
	call test (commands_32, "commands_32", &
	"event selection", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_32
	<<Commands: tests>>=
	subroutine commands_32 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root

	write (u, "(A)") "* Test output: commands_32"
	write (u, "(A)") "* Purpose: define selection"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'selection = any PDG == 13 [particle]')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)

	call global%write_expr (u)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_32"

	end subroutine commands_32

	@ %def commands_32
	@
	\subsubsection{Executing shell commands}
	Execute a shell command.
	<<Commands: execute tests>>=
	call test (commands_33, "commands_33", &
	"execute shell command", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_33
	<<Commands: tests>>=
	subroutine commands_33 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	integer :: u_file, iostat
	character(3) :: buffer

	write (u, "(A)") "* Test output: commands_33"
	write (u, "(A)") "* Purpose: execute shell command"
	write (u, "(A)")

	write (u, "(A)") "* Initialization"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	write (u, "(A)") "* Input file"
	write (u, "(A)")

	call ifile_append (ifile, 'exec ("echo foo >> bar")')

	call ifile_write (ifile, u)

	write (u, "(A)")
	write (u, "(A)") "* Parse file"
	write (u, "(A)")

	call parse_ifile (ifile, pn_root, u)

	write (u, "(A)")
	write (u, "(A)") "* Compile command list"
	write (u, "(A)")

	call command_list%compile (pn_root, global)
	call command_list%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Execute command list"
	write (u, "(A)")

	call command_list%execute (global)
	u_file = free_unit ()
	open (u_file, file = "bar", &
	action = "read", status = "old")
	do
	read (u_file, "(A)", iostat = iostat) buffer
	if (iostat /= 0) exit
	end do
	write (u, "(A,A)") "should be 'foo': ", trim (buffer)
	close (u_file)

	write (u, "(A)")
	write (u, "(A)") "* Cleanup"

	call ifile_final (ifile)

	call command_list%final ()
	call global%final ()
	call syntax_cmd_list_final ()

	write (u, "(A)")
	write (u, "(A)") "* Test output end: commands_33"

	end subroutine commands_33

	@ %def commands_33
	@
	\subsubsection{Callback}
	Instead of an explicit write, use the callback feature to write the
	analysis file during event generation. We generate 4 events and
	arrange that the callback is executed while writing the 3rd event.
	<<Commands: execute tests>>=
	call test (commands_34, "commands_34", &
	"analysis via callback", &
	u, results)
	<<Commands: test declarations>>=
	public :: commands_34
	<<Commands: tests>>=
	subroutine commands_34 (u)
	integer, intent(in) :: u
	type(ifile_t) :: ifile
	type(command_list_t), target :: command_list
	type(rt_data_t), target :: global
	type(parse_node_t), pointer :: pn_root
	type(prclib_entry_t), pointer :: lib
	type(event_callback_34_t) :: event_callback

	write (u, "(A)") "* Test output: commands_34"
	write (u, "(A)") "* Purpose: write analysis data"
	write (u, "(A)")

	write (u, "(A)") "* Initialization: create observable"
	write (u, "(A)")

	call syntax_cmd_list_init ()
	call global%global_init ()

	call syntax_model_file_init ()
	call global%global_init ()
	call global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))

	call global%var_list%set_string (var_str ("$method"), &
	var_str ("unit_test"), is_known=.true.)
	call global%var_list%set_string (var_str ("$phs_method"), &
	var_str ("single"), is_known=.true.)
	call global%var_list%set_string (var_str ("$integration_method"),&
	var_str ("midpoint"), is_known=.true.)
	call global%var_list%set_real (var_str ("sqrts"), &
	1000._default, is_known=.true.)
	call global%var_list%set_log (var_str ("?vis_history"),&
	.false., is_known=.true.)
	call global%var_list%set_log (var_str ("?integration_timer"),&
	.false., is_known = .true.)

	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 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) :: job_id
	type(string_t), dimension(:), allocatable :: pack_args
	type(string_t), dimension(:), allocatable :: unpack_args
	type(string_t) :: preload_model
	type(string_t) :: default_lib
	type(string_t) :: preload_libraries
	logical :: rebuild_library = .false.
	logical :: recompile_library = .false.
	logical :: rebuild_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_job_id ()
	call whizard%init_rebuild_flags ()
	call whizard%unpack_files ()
	call whizard%preload_model ()
	call whizard%preload_library ()
	call whizard%global%init_fallback_model &
	(var_str ("SM_hadrons"), var_str ("SM_hadrons.mdl"))
	end subroutine whizard_init

	@ %def whizard_init
	@ Apart from the global data which have been initialized above, the
	process and model lists need to be finalized.
	<<WHIZARD: whizard: TBP>>=
	procedure :: final => whizard_final
	<<WHIZARD: procedures>>=
	subroutine whizard_final (whizard)
	class(whizard_t), intent(inout), target :: whizard
	call whizard%global%final ()
	call whizard%pt_stack%final ()
	call whizard%pack_files ()
	!!! JRR: WK please check (#529)
	! call user_code_final ()
	call final_syntax_tables ()
	end subroutine whizard_final

	@ %def whizard_final
	@ Set the job ID, if nonempty. If the ID string is empty, the value remains
	undefined.
	<<WHIZARD: whizard: TBP>>=
	procedure :: init_job_id => whizard_init_job_id
	<<WHIZARD: procedures>>=
	subroutine whizard_init_job_id (whizard)
	class(whizard_t), intent(inout), target :: whizard
	associate (var_list => whizard%global%var_list, options => whizard%options)
	if (options%job_id /= "") then
	call var_list%set_string (var_str ("$job_id"), &
	options%job_id, is_known=.true.)
	end if
	end associate
	end subroutine whizard_init_job_id

	@ %def whizard_init_job_id
	@
	Set the rebuild flags. They can be specified on the command line and
	set the initial value for the associated logical variables.
	<<WHIZARD: whizard: TBP>>=
	procedure :: init_rebuild_flags => whizard_init_rebuild_flags
	<<WHIZARD: 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_str ("?rebuild_library"), &
	options%rebuild_library, intrinsic=.true.)
	call var_list%append_log (var_str ("?recompile_library"), &
	options%recompile_library, intrinsic=.true.)
	call var_list%append_log (var_str ("?rebuild_phase_space"), &
	options%rebuild_phs, intrinsic=.true.)
	call var_list%append_log (var_str ("?rebuild_grids"), &
	options%rebuild_grids, intrinsic=.true.)
	call var_list%append_log (var_str ("?powheg_rebuild_grids"), &
	options%rebuild_grids, intrinsic=.true.)
	call var_list%append_log (var_str ("?rebuild_events"), &
	options%rebuild_events, intrinsic=.true.)
	end associate
	end subroutine whizard_init_rebuild_flags

	@ %def whizard_init_rebuild_flags
	@
	Pack/unpack files in the working directory, if requested.
	<<WHIZARD: whizard: TBP>>=
	procedure :: pack_files => whizard_pack_files
	procedure :: unpack_files => whizard_unpack_files
	<<WHIZARD: procedures>>=
	subroutine whizard_pack_files (whizard)
	class(whizard_t), intent(in), target :: whizard
	logical :: exist
	integer :: i
	type(string_t) :: file
	if (allocated (whizard%options%pack_args)) then
	do i = 1, size (whizard%options%pack_args)
	file = whizard%options%pack_args(i)
	call msg_message ("Packing file/dir '" // char (file) // "'")
	exist = os_file_exist (file) .or. os_dir_exist (file)
	if (exist) then
	call os_pack_file (whizard%options%pack_args(i), &
	whizard%global%os_data)
	else
	call msg_error ("File/dir '" // char (file) // "' not found")
	end if
	end do
	end if
	end subroutine whizard_pack_files

	subroutine whizard_unpack_files (whizard)
	class(whizard_t), intent(in), target :: whizard
	logical :: exist
	integer :: i
	type(string_t) :: file
	if (allocated (whizard%options%unpack_args)) then
	do i = 1, size (whizard%options%unpack_args)
	file = whizard%options%unpack_args(i)
	call msg_message ("Unpacking file '" // char (file) // "'")
	exist = os_file_exist (file)
	if (exist) then
	call os_unpack_file (whizard%options%unpack_args(i), &
	whizard%global%os_data)
	else
	call msg_error ("File '" // char (file) // "' not found")
	end if
	end do
	end if
	end subroutine whizard_unpack_files

	@ %def whizard_pack_files
	@ %def whizard_unpack_files
	@
	This procedure preloads a model, if a model name is given.
	<<WHIZARD: whizard: TBP>>=
	procedure :: preload_model => whizard_preload_model
	<<WHIZARD: 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 ("Recola")
	<<Features: dependencies>>=
	use system_dependencies, only: RECOLA_AVAILABLE
	<<Features: cases>>=
	case ("recola")
	if (RECOLA_AVAILABLE) then
	result = "yes"
	end if
	help = "external NLO matrix element provider"
	@
	<<Features: print>>=
	call print_check ("LHAPDF")
	<<Features: dependencies>>=
	use system_dependencies, only: LHAPDF5_AVAILABLE
	use system_dependencies, only: LHAPDF6_AVAILABLE
	<<Features: cases>>=
	case ("lhapdf")
	if (LHAPDF5_AVAILABLE) then
	result = "v5"
	else if (LHAPDF6_AVAILABLE) then
	result = "v6"
	end if
	help = "PDF library"
	@
	<<Features: print>>=
	call print_check ("HOPPET")
	<<Features: dependencies>>=
	use system_dependencies, only: HOPPET_AVAILABLE
	<<Features: cases>>=
	case ("hoppet")
	if (HOPPET_AVAILABLE) then
	result = "yes"
	end if
	help = "PDF evolution package"
	@
	<<Features: print>>=
	call print_check ("fastjet")
	<<Features: dependencies>>=
	use jets, only: fastjet_available
	<<Features: cases>>=
	case ("fastjet")
	if (fastjet_available ()) then
	result = "yes"
	end if
	help = "jet-clustering package"
	@
	<<Features: print>>=
	call print_check ("Pythia6")
	<<Features: dependencies>>=
	use system_dependencies, only: PYTHIA6_AVAILABLE
	<<Features: cases>>=
	case ("pythia6")
	if (PYTHIA6_AVAILABLE) then
	result = "yes"
	end if
	help = "direct access for shower/hadronization"
	@
	<<Features: print>>=
	call print_check ("Pythia8")
	<<Features: dependencies>>=
	use system_dependencies, only: PYTHIA8_AVAILABLE
	<<Features: cases>>=
	case ("pythia8")
	if (PYTHIA8_AVAILABLE) then
	result = "yes"
	end if
	help = "direct access for shower/hadronization"
	@
	<<Features: print>>=
	call print_check ("StdHEP")
	<<Features: cases>>=
	case ("stdhep")
	result = "yes"
	help = "event I/O format"
	@
	<<Features: print>>=
	call print_check ("HepMC")
	<<Features: dependencies>>=
	use hepmc_interface, only: hepmc_is_available
	<<Features: cases>>=
	case ("hepmc")
	if (hepmc_is_available ()) then
	result = "yes"
	end if
	help = "event I/O format"
	@
	<<Features: print>>=
	call print_check ("LCIO")
	<<Features: dependencies>>=
	use lcio_interface, only: lcio_is_available
	<<Features: cases>>=
	case ("lcio")
	if (lcio_is_available ()) then
	result = "yes"
	end if
	help = "event I/O format"
	@
	<<Features: print>>=
	call print_check ("MetaPost")
	<<Features: dependencies>>=
	use system_dependencies, only: EVENT_ANALYSIS
	<<Features: cases>>=
	case ("metapost")
	result = EVENT_ANALYSIS
	help = "graphical event analysis via LaTeX/MetaPost"
	@
	@
	\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 system_dependencies
	use diagnostics
	use ifiles
	use os_interface
	use rt_data, only: show_description_of_string, show_tex_descriptions
	use whizard

	use cmdline_options
	use features

	<<Use mpi f08>>

	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
	logical :: look_for_options
	logical :: interactive
	logical :: banner
	type(string_t) :: job_id, files, this, model, default_lib, library, libraries
	type(string_t) :: logfile, query_string
	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
	type(string_t) :: pack_arg, unpack_arg
	type(string_t), dimension(:), allocatable :: pack_args, unpack_args
	type(string_t), dimension(:), allocatable :: tmp_strings
	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.
	job_id = ""
	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)

	<<Main: MPI init>>

	! 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 ("--job-id")
	job_id = get_option_value (i, long_option, value)
	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 ("--query")
	call no_option_value (long_option, value)
	query_string = get_option_value (i, long_option, value)
	call show_description_of_string (query_string)
	call exit (0)
	case ("--generate-variables-tex")
	call no_option_value (long_option, value)
	call show_tex_descriptions ()
	call exit (0)
	case ("--debug")
	call no_option_value (long_option, value)
	call set_debug_levels (get_option_value (i, long_option, value))
	cycle SCAN_CMDLINE
	case ("--debug2")
	call no_option_value (long_option, value)
	call set_debug2_levels (get_option_value (i, long_option, value))
	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 ("--pack")
	pack_arg = get_option_value (i, long_option, value)
	if (allocated (pack_args)) then
	call move_alloc (from=pack_args, to=tmp_strings)
	allocate (pack_args (size (tmp_strings)+1))
	pack_args(1:size(tmp_strings)) = tmp_strings
	else
	allocate (pack_args (1))
	end if
	pack_args(size(pack_args)) = pack_arg
	cycle SCAN_CMDLINE
	case ("--unpack")
	unpack_arg = get_option_value (i, long_option, value)
	if (allocated (unpack_args)) then
	call move_alloc (from=unpack_args, to=tmp_strings)
	allocate (unpack_args (size (tmp_strings)+1))
	unpack_args(1:size(tmp_strings)) = tmp_strings
	else
	allocate (unpack_args (1))
	end if
	unpack_args(size(unpack_args)) = unpack_arg
	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 ("-J")
	if (j == len_trim (arg)) then
	job_id = get_option_value (i, var_str (option))
	else
	job_id = trim (arg(j+1:))
	end if
	cycle SCAN_CMDLINE
	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 ("-q")
	call no_option_value (long_option, value)
	query_string = get_option_value (i, long_option, value)
	call show_description_of_string (query_string)
	call exit (0)
	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%job_id = job_id
	if (allocated (pack_args)) then
	options%pack_args = pack_args
	else
	allocate (options%pack_args (0))
	end if
	if (allocated (unpack_args)) then
	options%unpack_args = unpack_args
	else
	allocate (options%unpack_args (0))
	end if
	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
	<<Main: dependent flags>>

	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)

	<<Main: MPI finalize>>

	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-2018 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)", "-J, --job-id STRING set job ID to STRING (default: empty)"
	print "(A)", "-l, --library LIB 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)", " --pack DIR tar/gzip DIR after job"
	print "(A)", "-q, --query VARIABLE display documentation of VARIABLE"
	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)", " --unpack FILE untar/gunzip FILE before job"
	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!
	<<Use mpi f08>>

	<<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
	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 = ""

	<<Main: MPI init>>

	! 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)
	call set_debug_levels (get_option_value (i, long_option, value))
	cycle SCAN_CMDLINE
	case ("--debug2")
	call no_option_value (long_option, value)
	call set_debug2_levels (get_option_value (i, long_option, value))
	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

	<<Main: MPI finalize>>

	call msg_terminate (quit_code = quit_code)

	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	contains

	subroutine print_version ()
	print "(A)", "WHIZARD " // WHIZARD_VERSION // " (unit test driver)"
	print "(A)", "Copyright (C) 1999-2018 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
	@
	<<Main: MPI init>>=
	@
	<<Main: MPI finalize>>=
	@
	@ MPI init.
	<<MPI: Main: MPI init>>=
	call MPI_init ()
	<<MPI: Main: MPI finalize>>=
	call MPI_finalize ()
	@ %def MPI_init MPI_finalize
	<<Main: dependent flags>>=
	@
	Every rebuild action is forbidden for the slave workers except
	[[rebuild_grids]], which is handled correctly inside the corresponding
	integration object.
	<<MPI: Main: dependent flags>>=
	if (.not. mpi_is_comm_master ()) then
	options%rebuild_library = .false.
	options%recompile_library = .false.
	options%rebuild_user = .false.
	options%rebuild_phs = .false.
	options%rebuild_events = .false.
	end if
	@
	\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, only: var_list_t
	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_str ("?unweighted"), unweighted, &
	intrinsic = .true.)
	else
	call var_list%append_log (&
	var_str ("?unweighted"), .true., &
	intrinsic = .true.)
	end if
	call var_list%append_string (&
	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_rng_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{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{Resonances}
	<<Main: use tests>>=
	use resonances_ut, only: resonances_test
	<<Main: test cases>>=
	case ("resonances")
	call resonances_test (u, results)
	<<Main: all tests>>=
	call resonances_test (u, results)
	@
	\subsubsection{PHS Trees}
	<<Main: use tests>>=
	use phs_trees_ut, only: phs_trees_test
	<<Main: test cases>>=
	case ("phs_trees")
	call phs_trees_test (u, results)
	<<Main: all tests>>=
	call phs_trees_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 None}
	<<Main: use tests>>=
	use phs_none_ut, only: phs_none_test
	<<Main: test cases>>=
	case ("phs_none")
	call phs_none_test (u, results)
	<<Main: all tests>>=
	call phs_none_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 Rambo}
	<<Main: use tests>>=
	use phs_rambo_ut, only: phs_rambo_test
	<<Main: test cases>>=
	case ("phs_rambo")
	call phs_rambo_test (u, results)
	<<Main: all tests>>=
	call phs_rambo_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{Real subtraction}
	<<Main: use tests>>=
	use real_subtraction_ut, only: real_subtraction_test
	<<Main: test cases>>=
	case ("real_subtraction")
	call real_subtraction_test (u, results)
	<<Main: all tests>>=
	call real_subtraction_test (u, results)
	@
	\subsubsection{RECOLA}
	<<Main: use tests>>=
	use prc_recola_ut, only: prc_recola_test
	<<Main: test cases>>=
	case ("prc_recola")
	call prc_recola_test (u, results)
	<<Main: all tests>>=
	call prc_recola_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{RNG Stream}
	<<Main: use tests>>=
	use rng_stream_ut, only: rng_stream_test
	<<Main: test cases>>=
	case ("rng_stream")
	call rng_stream_test (u, results)
	<<Main: all tests>>=
	call rng_stream_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{VEGAS}
	<<Main: use tests>>=
	use vegas_ut, only: vegas_test
	<<Main: test cases>>=
	case ("vegas")
	call vegas_test (u, results)
	<<Main: all tests>>=
	call vegas_test (u, results)
	@
	\subsubsection{VAMP2}
	<<Main: use tests>>=
	use vamp2_ut, only: vamp2_test
	<<Main: test cases>>=
	case ("vamp2")
	call vamp2_test (u, results)
	<<Main: all tests>>=
	call vamp2_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 None}
	<<Main: use tests>>=
	use mci_none_ut, only: mci_none_test
	<<Main: test cases>>=
	case ("mci_none")
	call mci_none_test (u, results)
	<<Main: all tests>>=
	call mci_none_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{MCI VAMP2}
	<<Main: use tests>>=
	use mci_vamp2_ut, only: mci_vamp2_test
	<<Main: test cases>>=
	case ("mci_vamp2")
	call mci_vamp2_test (u, results)
	<<Main: all tests>>=
	call mci_vamp2_test (u, results)
	@
	\subsubsection{Integration Results}
	<<Main: use tests>>=
	use integration_results_ut, only: integration_results_test
	<<Main: test cases>>=
	case ("integration_results")
	call integration_results_test (u, results)
	<<Main: all tests>>=
	call integration_results_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)
	@
	+\subsection{LHA User Process WHIZARD}
	+<<Main: use tests>>=
	+ use whizard_lha_ut, only: whizard_lha_test
	+<<Main: test cases>>=
	+ case ("whizard_lha")
	+ call whizard_lha_test (u, results)
	+<<Main: all tests>>=
	+ call whizard_lha_test (u, results)
	+@
	+\subsection{Pythia8}
	+<<Main: use tests>>=
	+ use pythia8_ut, only: pythia8_test
	+<<Main: test cases>>=
	+ case ("pythia8")
	+ call pythia8_test (u, results)
	+<<Main: all tests>>=
	+ call pythia8_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{Cascades2 lexer}
	<<Main: use tests>>=
	use cascades2_lexer_ut, only: cascades2_lexer_test
	<<Main: test cases>>=
	case ("cascades2_lexer")
	call cascades2_lexer_test (u, results)
	<<Main: all tests>>=
	call cascades2_lexer_test (u, results)
	@
	\subsubsection{Cascades2}
	<<Main: use tests>>=
	use cascades2_ut, only: cascades2_test
	<<Main: test cases>>=
	case ("cascades2")
	call cascades2_test (u, results)
	<<Main: all tests>>=
	call cascades2_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{Resonance Insertion Transform}
	<<Main: use tests>>=
	use resonance_insertion_ut, only: resonance_insertion_test
	<<Main: test cases>>=
	case ("resonance_insertion")
	call resonance_insertion_test (u, results)
	<<Main: all tests>>=
	call resonance_insertion_test (u, results)
	@
	\subsubsection{Recoil Kinematics}
	<<Main: use tests>>=
	use recoil_kinematics_ut, only: recoil_kinematics_test
	<<Main: test cases>>=
	case ("recoil_kinematics")
	call recoil_kinematics_test (u, results)
	<<Main: all tests>>=
	call recoil_kinematics_test (u, results)
	@
	\subsubsection{ISR Handler}
	<<Main: use tests>>=
	use isr_epa_handler_ut, only: isr_handler_test
	<<Main: test cases>>=
	case ("isr_handler")
	call isr_handler_test (u, results)
	<<Main: all tests>>=
	call isr_handler_test (u, results)
	@
	\subsubsection{EPA Handler}
	<<Main: use tests>>=
	use isr_epa_handler_ut, only: epa_handler_test
	<<Main: test cases>>=
	case ("epa_handler")
	call epa_handler_test (u, results)
	<<Main: all tests>>=
	call epa_handler_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 Direct}
	<<Main: use tests>>=
	use eio_direct_ut, only: eio_direct_test
	<<Main: test cases>>=
	case ("eio_direct")
	call eio_direct_test (u, results)
	<<Main: all tests>>=
	call eio_direct_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{Dispatch RNG}
	<<Main: use tests>>=
	use dispatch_rng_ut, only: dispatch_rng_test
	<<Main: test cases>>=
	case ("dispatch_rng")
	call dispatch_rng_test (u, results)
	<<Main: all tests>>=
	call dispatch_rng_test (u, results)
	@
	\subsubsection{Dispatch MCI}
	<<Main: use tests>>=
	use dispatch_mci_ut, only: dispatch_mci_test
	<<Main: test cases>>=
	case ("dispatch_mci")
	call dispatch_mci_test (u, results)
	<<Main: all tests>>=
	call dispatch_mci_test (u, results)
	@
	\subsubsection{Dispatch PHS}
	<<Main: use tests>>=
	use dispatch_phs_ut, only: dispatch_phs_test
	<<Main: test cases>>=
	case ("dispatch_phs")
	call dispatch_phs_test (u, results)
	<<Main: all tests>>=
	call dispatch_phs_test (u, results)
	@
	\subsubsection{Dispatch transforms}
	<<Main: use tests>>=
	use dispatch_transforms_ut, only: dispatch_transforms_test
	<<Main: test cases>>=
	case ("dispatch_transforms")
	call dispatch_transforms_test (u, results)
	<<Main: all tests>>=
	call dispatch_transforms_test (u, results)
	@
	\subsubsection{Shower partons}
	<<Main: use tests>>=
	use shower_base_ut, only: shower_base_test
	<<Main: test cases>>=
	case ("shower_base")
	call shower_base_test (u, results)
	<<Main: all tests>>=
	call shower_base_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{Restricted Subprocesses}
	<<Main: use tests>>=
	use restricted_subprocesses_ut, only: restricted_subprocesses_test
	<<Main: test cases>>=
	case ("restricted_subprocesses")
	call restricted_subprocesses_test (u, results)
	<<Main: all tests>>=
	call restricted_subprocesses_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 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
	@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	Index: trunk/src/Makefile.am
	===================================================================
	--- trunk/src/Makefile.am (revision 8189)
	+++ trunk/src/Makefile.am (revision 8190)
	@@ -1,293 +1,296 @@
	## Makefile.am -- Makefile for WHIZARD
	##
	## Process this file with automake to produce Makefile.in
	#
	# Copyright (C) 1999-2018 by
	# Wolfgang Kilian <kilian@physik.uni-siegen.de>
	# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
	# Juergen Reuter <juergen.reuter@desy.de>
	# with contributions from
	# cf. main AUTHORS file
	#
	# WHIZARD is free software; you can redistribute it and/or modify it
	# under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 2, or (at your option)
	# any later version.
	#
	# WHIZARD is distributed in the hope that it will be useful, but
	# WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	# GNU General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with this program; if not, write to the Free Software
	# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
	#
	########################################################################

	## Subdirectories to configure
	## directories in one line do not depend on each other
	SUBDIRS = \
	noweb-frame \
	basics \
	- hepmc lcio lhapdf lhapdf5 looptools pythia8 xdr \
	+ hepmc lcio lhapdf lhapdf5 looptools xdr \
	expr_base utilities \
	system \
	combinatorics pdf_builtin testing \
	hoppet \
	muli parsing physics qed_pdf \
	fastjet types qft threshold \
	models particles matrix_elements variables \
	events prebuilt rng \
	beams tauola \
	- me_methods shower user \
	+ me_methods pythia8 shower user \
	blha model_features \
	gosam openloops \
	recola phase_space \
	fks vegas mci \
	process_integration \
	matching \
	transforms \
	whizard-core

	if MPOST_AVAILABLE
	SUBDIRS += gamelan feynmf
	endif

	########################################################################
	## Build
	## (1) the toplevel WHIZARD library, which wraps various libraries
	## built in the subdirectories
	## (2) the WHIZARD test library that is linked to the main executable
	## as the provider of internal unit tests
	## (3) the wrapper O'Mega library, which contains omegalib and
	## the W/O interface modules for the various models

	lib_LTLIBRARIES = libwhizard.la libomega.la

	libwhizard_la_SOURCES =
	libwhizard_la_LDFLAGS = $(LIBRARY_VERSION)

	## Collect the various partial libraries
	libwhizard_la_LIBADD = \
	threshold/libthreshold.la \
	whizard-core/libwhizard_core.la \
	transforms/libtransforms.la \
	../vamp/src/libvamp.la \
	../circe1/src/libcirce1.la \
	../circe2/src/libcirce2.la \
	shower/libshower.la \
	tauola/libtauola_interface.la \
	muli/libmuli.la \
	pdf_builtin/libpdf_builtin.la \
	model_features/libmodel_features.la \
	variables/libvariables.la \
	process_integration/libprocess_integration.la \
	matching/libmatching.la \
	fks/libfks.la \
	gosam/libgosam.la \
	openloops/liboloops.la \
	recola/libwo_recola.la \
	blha/libblha.la \
	user/libuser.la \
	vegas/libvegas.la \
	mci/libmci.la \
	phase_space/libphase_space.la \
	xdr/libWOStdHep.la \
	events/libevents.la \
	beams/libbeams.la \
	particles/libparticles.la \
	me_methods/libme_methods.la \
	matrix_elements/libmatrix_elements.la \
	types/libtypes.la \
	qft/libqft.la \
	physics/libphysics.la \
	qed_pdf/libqed_pdf.la \
	expr_base/libexpr_base.la \
	rng/librng.la \
	parsing/libparsing.la \
	combinatorics/libcombinatorics.la \
	system/libsystem.la \
	testing/libtesting.la \
	utilities/libutilities.la \
	basics/libbasics.la

	if HEPMC_AVAILABLE
	libwhizard_la_LIBADD += hepmc/libHepMCWrap.la
	else
	libwhizard_la_LIBADD += hepmc/libHepMCWrap_dummy.la
	endif

	if LCIO_AVAILABLE
	libwhizard_la_LIBADD += lcio/libLCIOWrap.la
	else
	libwhizard_la_LIBADD += lcio/libLCIOWrap_dummy.la
	endif

	## If (parts of) LHAPDF is not available, link in a dummy as replacements
	if LHAPDF5_AVAILABLE
	libwhizard_la_LIBADD += $(LDFLAGS_LHAPDF)
	if LHAPDF5_HAS_PHOTON_DUMMY
	libwhizard_la_LIBADD += lhapdf5/libLHAPDF5_dummy.la
	endif
	else
	if !LHAPDF6_AVAILABLE
	libwhizard_la_LIBADD += lhapdf5/libLHAPDF5_dummy.la
	endif
	endif

	if LHAPDF6_AVAILABLE
	libwhizard_la_LIBADD += $(LHAPDF_LIBS) lhapdf/libLHAPDFWrap.la
	else
	libwhizard_la_LIBADD += lhapdf/libLHAPDFWrap_dummy.la
	endif

	if HOPPET_AVAILABLE
	libwhizard_la_LIBADD += $(LDFLAGS_HOPPET) hoppet/libhoppet.la
	else
	libwhizard_la_LIBADD += hoppet/libhoppet_dummy.la
	endif

	if FASTJET_AVAILABLE
	libwhizard_la_LIBADD += $(FASTJET_LIBS) fastjet/libFastjetWrap.la
	else
	libwhizard_la_LIBADD += fastjet/libFastjetWrap_dummy.la
	endif

	if LOOPTOOLS_AVAILABLE
	libwhizard_la_LIBADD += $(LDFLAGS_LOOPTOOLS) looptools/liblooptools.la
	else
	libwhizard_la_LIBADD += looptools/liblooptools_dummy.la
	endif

	+libwhizard_la_LIBADD += $(PYTHIA8_LIBS) pythia8/libwo_pythia8.la
	+
	if IS_IFORT_DARWIN
	libwhizard_la_LIBADD += $(FCLIBS)
	endif

	## -------------------------------------------------------------------
	## WHIZARD unit-test library

	check_LTLIBRARIES = libwhizard_test.la

	libwhizard_test_la_SOURCES =

	libwhizard_test_la_LIBADD = \
	threshold/libthreshold_ut.la \
	whizard-core/libwhizard_core_ut.la \
	transforms/libtransforms_ut.la \
	matching/libmatching_ut.la \
	fks/libfks_ut.la \
	shower/libshower_ut.la \
	process_integration/libprocess_integration_ut.la \
	recola/libwo_recola_ut.la \
	blha/libblha_ut.la \
	model_features/libmodel_features_ut.la \
	vegas/libvegas_ut.la mci/libmci_ut.la \
	phase_space/libphase_space_ut.la \
	+ pythia8/libwo_pythia8_ut.la \
	events/libevents_ut.la \
	beams/libbeams_ut.la \
	particles/libparticles_ut.la \
	me_methods/libme_methods_ut.la \
	matrix_elements/libmatrix_elements_ut.la \
	types/libtypes_ut.la \
	qft/libqft_ut.la \
	physics/libphysics_ut.la \
	rng/librng_ut.la \
	parsing/libparsing_ut.la \
	combinatorics/libcombinatorics_ut.la \
	system/libsystem_ut.la

	## -------------------------------------------------------------------
	## O'Mega main library

	libomega_la_SOURCES =

	libomega_la_LIBADD = \
	../omega/src/libomega_core.la \
	models/libmodels.la

	if RECOLA_AVAILABLE
	libwhizard_la_LIBADD += $(LDFLAGS_RECOLA)
	libwhizard_test_la_LIBADD += $(LDFLAGS_RECOLA)
	endif

	########################################################################
	## Build a standalone program

	bin_PROGRAMS = whizard

	whizard_SOURCES =

	## A dummy source tells libtool that the F90 compiler is used for linking
	## Without dummy, libtool uses the C linker (default: ld)
	nodist_EXTRA_whizard_SOURCES = dummy.f90

	if IS_IFORT_DARWIN
	whizard_LDFLAGS = $(AM_LDFLAGS) -static
	endif

	whizard_LDADD = whizard-core/libwhizard_main.la
	whizard_LDADD += ./libwhizard.la
	whizard_LDADD += prebuilt/libwhizard_prebuilt.la
	whizard_LDADD += $(CXXLIBS)
	whizard_LDADD += $(LDFLAGS_LHAPDF)
	whizard_LDADD += $(LDFLAGS_HEPMC)
	whizard_LDADD += $(LDFLAGS_LCIO)
	whizard_LDADD += $(LDFLAGS_HOPPET)
	whizard_LDADD += $(FASTJET_LIBS)
	whizard_LDADD += $(LDFLAGS_LOOPTOOLS)

	## -------------------------------------------------------------------
	## Build a standalone program for running the unit tests

	check_PROGRAMS = whizard_ut

	whizard_ut_SOURCES =

	## A dummy source tells libtool that the F90 compiler is used for linking
	## Without dummy, libtool uses the C linker (default: ld)
	nodist_EXTRA_whizard_ut_SOURCES = dummy.f90

	if IS_IFORT_DARWIN
	whizard_ut_LDFLAGS = $(AM_LDFLAGS) -static
	endif

	whizard_ut_LDADD = whizard-core/libwhizard_main_ut.la
	whizard_ut_LDADD += ./libwhizard_test.la
	whizard_ut_LDADD += ./libwhizard.la
	whizard_ut_LDADD += prebuilt/libwhizard_prebuilt.la
	whizard_ut_LDADD += $(CXXLIBS)
	whizard_ut_LDADD += $(LDFLAGS_LHAPDF)
	whizard_ut_LDADD += $(LDFLAGS_HEPMC)
	whizard_ut_LDADD += $(LDFLAGS_LCIO)
	whizard_ut_LDADD += $(LDFLAGS_HOPPET)
	whizard_ut_LDADD += $(FASTJET_LIBS)
	whizard_ut_LDADD += $(LDFLAGS_LOOPTOOLS)

	########################################################################
	## Default Fortran compiler options

	AM_FCFLAGS =

	## Profiling
	if FC_USE_PROFILING
	AM_FCFLAGS += $(FCFLAGS_PROFILING)
	endif

	## OpenMP
	if FC_USE_OPENMP
	AM_FCFLAGS += $(FCFLAGS_OPENMP)
	endif

	########################################################################
	## Non-standard cleanup tasks

	## Remove backup files
	maintainer-clean-local:
	-rm -f *~

	## Remove Module lists only after final subdir cleanup
	distclean-local:
	for d in $(SUBDIRS); do \
	rm -f $$d/Modules; \
	done
	Index: trunk/share/tests/functional_tests/ref-output-double/powheg_1.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-double/powheg_1.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output-double/powheg_1.ref (revision 8190)
	@@ -1,718 +1,730 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	openmp_num_threads = 1
	?pacify = true
	seed = 0
	SM.wtop => 0.00000E+00
	SM.mtop => 1.75000E+02
	?use_vamp_equivalences = false
	$loop_me_method = "dummy"
	?alphas_is_fixed = false
	?alphas_from_mz = true
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = true
	?powheg_matching = true
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_grid_sampling_points = 1000
	powheg_pt_min = 1.00000E+00
	?powheg_use_singular_jacobian = false
	\| Process library 'powheg_1_lib': recorded process 'powheg_1_p1'
	sqrts = 5.00000E+02
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_1_lib': compiling ...
	\| Process library 'powheg_1_lib': writing makefile
	\| Process library 'powheg_1_lib': removing old files
	\| Process library 'powheg_1_lib': writing driver
	\| Process library 'powheg_1_lib': creating source code
	\| Process library 'powheg_1_lib': compiling sources
	\| Process library 'powheg_1_lib': linking
	\| Process library 'powheg_1_lib': loading
	\| Process library 'powheg_1_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process powheg_1_p1:
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e+ (mass = 5.1099700E-04 GeV)
	\| e- (mass = 5.1099700E-04 GeV)
	\| sqrts = 5.000000000000E+02 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p1.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p1.i3.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_1_p1'
	\| Library name = 'powheg_1_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'powheg_1_p1_i1': e+, e- => t, tbar [omega]
	\| 2: 'powheg_1_p1_i2': e+, e- => t, tbar, gl [omega], [real]
	\| 3: 'powheg_1_p1_i3': e+, e- => t, tbar [dummy], [virtual]
	\| 4: 'powheg_1_p1_i4': e+, e- => t, tbar [inactive], [subtraction]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| Using user-defined general scale.
	\| Starting integration for process 'powheg_1_p1'
	\| Integration hook: add POWHEG hook
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 1 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.673E+02 2.15E+01 4.60 0.46 45.8
	\|-----------------------------------------------------------------------------\|
	1 100 4.673E+02 2.15E+01 4.60 0.46 45.8
	\|=============================================================================\|
	n_events = 1
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?write_raw = false
	\| Starting simulation for process 'powheg_1_p1'
	\| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 2.1397E-03
	\| Events: writing to ASCII file 'powheg_1_p1.debug'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p1_1000.pg'
	\| Grid: Mean value of the grid: 1.663321575E-02
	\| Grid: Max value of the grid: 3.908543674E-02
	\| Grid: Mean/Max value of the grid: 4.255604424E-01
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 20.00 %
	\| Events: closing ASCII file 'powheg_1_p1.debug'
	n_events = 2
	\| Starting simulation for process 'powheg_1_p1'
	\| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 2
	\| corr. to luminosity [fb-1] = 4.2794E-03
	\| Events: writing to ASCII file 'powheg_1_p1.debug'
	\| Events: generating 2 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p1_1000.pg'
	\| Grid: Mean value of the grid: 1.663321575E-02
	\| Grid: Max value of the grid: 3.908543674E-02
	\| Grid: Mean/Max value of the grid: 4.255604424E-01
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 100.00 %
	\| Events: closing ASCII file 'powheg_1_p1.debug'
	?nlo_use_real_partition = true
	real_partition_scale = 5.00000E+00
	\| Process library 'powheg_1_lib': unloading
	\| Process library 'powheg_1_lib': open
	\| Process library 'powheg_1_lib': recorded process 'powheg_1_p2'
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_1_lib': compiling ...
	\| Process library 'powheg_1_lib': writing makefile
	\| Process library 'powheg_1_lib': removing old files
	\| Process library 'powheg_1_lib': writing driver
	\| Process library 'powheg_1_lib': creating source code
	\| Process library 'powheg_1_lib': compiling sources
	\| Process library 'powheg_1_lib': linking
	\| Process library 'powheg_1_lib': loading
	\| Process library 'powheg_1_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Initializing integration for process powheg_1_p2:
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e+ (mass = 5.1099700E-04 GeV)
	\| e- (mass = 5.1099700E-04 GeV)
	\| sqrts = 5.000000000000E+02 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p2.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p2.i3.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p2.i5.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_1_p2'
	\| Library name = 'powheg_1_lib'
	\| Process index = 2
	\| Process components:
	\| 1: 'powheg_1_p2_i1': e+, e- => t, tbar [omega]
	\| 2: 'powheg_1_p2_i2': e+, e- => t, tbar, gl [omega], [real]
	\| 3: 'powheg_1_p2_i3': e+, e- => t, tbar [dummy], [virtual]
	\| 4: 'powheg_1_p2_i4': e+, e- => t, tbar [inactive], [subtraction]
	\| 5: 'powheg_1_p2_i5': e+, e- => t, tbar, gl [omega], [real]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| Using user-defined general scale.
	\| Integration hook: add POWHEG hook
	\| Starting integration for process 'powheg_1_p2' part 'Combined'
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 1 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
	\|-----------------------------------------------------------------------------\|
	1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
	\|=============================================================================\|
	\| Starting integration for process 'powheg_1_p2' part 'real'
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 2 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
	\|-----------------------------------------------------------------------------\|
	1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
	\|=============================================================================\|
	\| Integrate: sum of all components
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 0 4.978E+02 2.90E+01 5.83 0.00 31.2
	\| NLO Correction: [O(alpha_s+1)/O(alpha_s)]
	\| ( 0.0000 +- 0.00000 ) %
	\|=============================================================================\|
	tolerance = 1.08355E+02
	\| expect: success
	\| Starting simulation for process 'powheg_1_p2'
	\| Simulate: using integration grids from file 'powheg_1_p2.m1.vg'
	\| Simulate: using integration grids from file 'powheg_1_p2.m2.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 4
	\| Simulation: requested number of events = 2
	\| corr. to luminosity [fb-1] = 4.0177E-03
	\| Events: writing to ASCII file 'powheg_1_p2.debug'
	\| Events: generating 2 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p2_1000.pg'
	\| Grid: Mean value of the grid: 1.508227131E-03
	\| Grid: Max value of the grid: 1.844005614E-02
	\| Grid: Mean/Max value of the grid: 8.179081015E-02
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 20.00 %
	\| Events: closing ASCII file 'powheg_1_p2.debug'
	\| Summary of value checks:
	\| Failures: 0 / Total: 1
	\| There were no errors and 2 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Contents of powheg_1_p1.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.80466E-02
	Squared matrix el. (prc) = 2.80466E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 9.608533E+01 -1.236770E+02 -8.571236E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -9.608533E+01 1.236770E+02 8.571236E+01
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 8
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [v] t 1 0 1-2 5-7 250.000 96.085 -123.677 -85.712 30625.000
	4 [v] tbar 0 1 1-2 5-7 250.000 -96.085 123.677 85.712 30625.000
	5 [o] t 2 0 3-4 [none] 160.932 104.618 -121.732 11.639 30625.000
	6 [o] tbar 0 1 3-4 [none] 244.520 -91.910 118.303 81.988 30625.000
	7 [o] gl 1 2 3-4 [none] 94.548 -12.708 3.430 -93.627 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 3
	n_tot* => 5
	$process_id* => "powheg_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.80466E-02
	sqme_ref* => 2.80466E-02
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 1.6093234E+02; 1.0461835E+02,-1.2173226E+02, 1.1639310E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.4451983E+02;-9.1909962E+01, 1.1830264E+02, 8.1987752E+01\| 3.0625000E+04\| 4)
	5 prt(o:21\| 9.4547831E+01;-1.2708391E+01, 3.4296182E+00,-9.3627062E+01\| 0.0000000E+00\| 5)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.76791E-02
	Squared matrix el. (prc) = 2.76791E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 1.688666E+02 3.093682E+01 -4.901007E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -1.688666E+02 -3.093682E+01 4.901007E+01
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 8
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 250.000 168.867 30.937 -49.010 30625.000
	4 [o] tbar 0 1 1-2 [none] 250.000 -168.867 -30.937 49.010 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.76791E-02
	sqme_ref* => 2.76791E-02
	event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.5000000E+02; 1.6886659E+02, 3.0936816E+01,-4.9010068E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.5000000E+02;-1.6886659E+02,-3.0936816E+01, 4.9010068E+01\| 3.0625000E+04\| 4)
	========================================================================
	Contents of powheg_1_p2.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 1.41607E-05
	Squared matrix el. (prc) = 1.41607E-05
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 2
	Selected term = 6
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	seed = 196611
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4 5
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4 5
	Particle 3 [o] f(6)c(1 )
	E = 2.219832E+02
	P = -7.125693E+01 -1.137429E+02 -2.522963E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-2 )
	E = 2.128305E+02
	P = 1.983915E+01 1.013308E+02 6.332695E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 5 [o] f(21)c(2 -1)
	E = 6.518630E+01
	P = 5.141778E+01 1.241207E+01 -3.809732E+01
	T = 0.000000000E+00
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	seed = 196612
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-5 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-5 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 221.983 -71.257 -113.743 -25.230 30625.000
	4 [o] tbar 0 2 1-2 [none] 212.831 19.839 101.331 63.327 30625.000
	5 [o] gl 2 1 1-2 [none] 65.186 51.418 12.412 -38.097 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 3
	n_tot* => 5
	$process_id* => "powheg_1_p2"
	process_num_id* => [unknown integer]
	sqme* => 1.41607E-05
	sqme_ref* => 1.41607E-05
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.2198318E+02;-7.1256929E+01,-1.1374290E+02,-2.5229632E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.1283052E+02; 1.9839145E+01, 1.0133083E+02, 6.3326954E+01\| 3.0625000E+04\| 4)
	5 prt(o:21\| 6.5186300E+01; 5.1417783E+01, 1.2412066E+01,-3.8097321E+01\| 0.0000000E+00\| 5)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 3.51646E-02
	Squared matrix el. (prc) = 3.51646E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	seed = 196611
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 1.143154E+02 2.823158E+00 -1.371095E+02
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -1.143154E+02 -2.823158E+00 1.371095E+02
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	seed = 196612
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 250.000 114.315 2.823 -137.110 30625.000
	4 [o] tbar 0 1 1-2 [none] 250.000 -114.315 -2.823 137.110 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p2"
	process_num_id* => [unknown integer]
	sqme* => 3.51646E-02
	sqme_ref* => 3.51646E-02
	event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.5000000E+02; 1.1431539E+02, 2.8231580E+00,-1.3710953E+02\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.5000000E+02;-1.1431539E+02,-2.8231580E+00, 1.3710953E+02\| 3.0625000E+04\| 4)
	========================================================================
	Contents of powheg_1_p1_1000.pg:
	3
	5 5 2
	2.530628868E-02 3.365661356E-02 2.917605664E-02 2.032377557E-02 1.640278887E-02 3.676894300E-02 3.908543674E-02 3.100080495E-02 2.758624245E-02 2.075434874E-02 2.184925489E-02 2.585980329E-02 2.428139324E-02 1.869552256E-02 1.052110477E-02 1.026073271E-02 1.131493273E-02 8.439663926E-03 6.062965365E-03 1.289001907E-03 1.045379810E-03 1.753780815E-03 1.601313783E-03 1.460207807E-03 5.505925036E-04 2.514689543E-02 3.495738663E-02 2.886327519E-02 2.828859804E-02 6.796005668E-03 3.768978052E-02 3.879496248E-02 2.947606320E-02 2.189014004E-02 1.692351528E-02 2.171460560E-02 2.407351405E-02 2.142085306E-02 1.201357305E-02 1.557409642E-02 1.031224117E-02 1.094206595E-02 9.348217154E-03 3.791167470E-03 2.417082638E-03 1.119303366E-03 1.532803981E-03 1.760726952E-03 1.192584996E-03 5.743799354E-04
	Contents of powheg_1_p2_1000.pg:
	3
	5 5 2
	1.843958392E-02 0.000000000E+00 3.840440224E-04 0.000000000E+00 0.000000000E+00 1.702837027E-02 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 1.628435741E-03 1.957292199E-04 3.584548479E-05 0.000000000E+00 2.651880710E-06 1.844005614E-02 0.000000000E+00 3.796755693E-04 0.000000000E+00 0.000000000E+00 1.703837568E-02 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 1.586894276E-03 2.098734563E-04 3.901738168E-05 0.000000000E+00 2.803501495E-06
	Index: trunk/share/tests/functional_tests/ref-output-double/pythia6_3.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-double/pythia6_3.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output-double/pythia6_3.ref (revision 8190)
	@@ -1,748 +1,757 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	?pacify = true
	$method = "omega"
	\| Process library 'pythia6_3_lib': recorded process 'pythia6_3_p1'
	SM.me => 1.00000E+01
	\| Process library 'pythia6_3_lib': compiling ...
	\| Process library 'pythia6_3_lib': writing makefile
	\| Process library 'pythia6_3_lib': removing old files
	\| Process library 'pythia6_3_lib': writing driver
	\| Process library 'pythia6_3_lib': creating source code
	\| Process library 'pythia6_3_lib': compiling sources
	\| Process library 'pythia6_3_lib': linking
	\| Process library 'pythia6_3_lib': loading
	\| Process library 'pythia6_3_lib': ... success.
	seed = 0
	$phs_method = "wood"
	$integration_method = "vamp"
	sqrts = 5.00000E+02
	openmp_num_threads = 1
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process pythia6_3_p1:
	\| Beam structure: e-, e+ => circe1 => isr
	\| Beam data (collision):
	\| e- (mass = 1.0000000E+01 GeV)
	\| e+ (mass = 1.0000000E+01 GeV)
	\| sqrts = 5.000000000000E+02 GeV
	\| CIRCE1: activating generator mode
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'pythia6_3_p1.i1.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'pythia6_3_p1'
	\| Library name = 'pythia6_3_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'pythia6_3_p1_i1': e-, e+ => u, ubar [omega]
	\| ------------------------------------------------------------------------
	\| Phase space: 2 channels, 2 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Beam structure: circe1 => isr, none => none, isr
	\| Beam structure: 2 channels, 2 dimensions
	\| Applying user-defined cuts.
	\| Starting integration for process 'pythia6_3_p1'
	\| Integrate: iterations = 3:1000:"g", 3:1000
	\| Integrator: 2 chains, 2 channels, 4 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 1000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 1000 6.612E+02 2.37E+01 3.58 1.13 22.4
	2 1000 6.567E+02 1.27E+01 1.94 0.61 36.6
	3 1000 6.522E+02 1.09E+01 1.67 0.53 36.1
	\|-----------------------------------------------------------------------------\|
	3 3000 6.549E+02 7.81E+00 1.19 0.65 36.1 0.08 3
	\|-----------------------------------------------------------------------------\|
	4 1000 6.726E+02 1.02E+01 1.52 0.48 31.0
	5 1000 6.538E+02 1.15E+01 1.76 0.56 25.4
	6 1000 6.640E+02 1.11E+01 1.67 0.53 24.9
	\|-----------------------------------------------------------------------------\|
	6 3000 6.642E+02 6.29E+00 0.95 0.52 24.9 0.75 3
	\|=============================================================================\|
	n_events = 1
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?allow_shower = true
	?ps_fsr_active = true
	$shower_method = "PYTHIA6"
	$sample = "pythia6_3a"
	\| Starting simulation for process 'pythia6_3_p1'
	\| Simulate: using integration grids from file 'pythia6_3_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 1.5055E-03
	\| Events: writing to ASCII file 'pythia6_3a.debug'
	\| Events: writing to raw file 'pythia6_3a.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 12.50 %
	\| Events: closing ASCII file 'pythia6_3a.debug'
	\| Events: closing raw file 'pythia6_3a.evx'
	?hadronization_active = true
	$sample = "pythia6_3b"
	\| Starting simulation for process 'pythia6_3_p1'
	\| Simulate: using integration grids from file 'pythia6_3_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| Simulate: activating hadronization
	\| Hadronization: Using PYTHIA6 interface for hadronization and decays
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 1.5055E-03
	\| Events: writing to ASCII file 'pythia6_3b.debug'
	\| Events: writing to raw file 'pythia6_3b.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 50.00 %
	\| Events: closing ASCII file 'pythia6_3b.debug'
	\| Events: closing raw file 'pythia6_3b.evx'
	\| WHIZARD run finished.
	\|=============================================================================\|
	Partial contents of pythia6_3a.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.93481E+15
	Squared matrix el. (prc) = 2.93481E+15
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 2
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.497999E+02
	T = 1.000000000E+02
	Children: 3 4
	Particle 2 [b] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Children: 3 4
	Particle 3 [v] f(11)
	E = 2.476793E+02
	P = 0.000000E+00 0.000000E+00 2.474773E+02
	T = 1.000000000E+02
	Parents: 1 2
	Children: 5 7
	Particle 4 [v] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Parents: 1 2
	Children: 6 8
	Particle 5 [i] f(11)
	E = 1.816877E+02
	P = 0.000000E+00 0.000000E+00 1.814123E+02
	T = 1.000000000E+02
	Parents: 3
	Children: 9 10
	Particle 6 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Parents: 4
	Children: 9 10
	Particle 7 [x] f(22*)
	E = 6.606507E+01
	P = 0.000000E+00 0.000000E+00 6.606507E+01
	T = 0.000000000E+00
	Parents: 3
	Particle 8 [x] f(22*)
	E = 1.064227E-18
	P = 0.000000E+00 0.000000E+00 -1.064227E-18
	T = 0.000000000E+00
	Parents: 4
	Particle 9 [o] f(2)c(1 )
	E = 1.994908E+02
	P = -2.038903E+01 -1.860521E+02 6.903249E+01
	T = 0.000000000E+00
	Parents: 5 6
	Particle 10 [o] f(-2)c(-1 )
	E = 2.321969E+02
	P = 2.038903E+01 1.860521E+02 -1.374201E+02
	T = 0.000000000E+00
	Parents: 5 6
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 3
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 250.000 0.000 0.000 249.800 100.000
	2 [b] e+ 0 0 [none] 3-4 250.000 0.000 0.000 -249.800 100.000
	3 [r] e- 0 0 1-2 5,7 247.679 0.000 0.000 247.477 100.000
	4 [r] e+ 0 0 1-2 6,8 250.000 0.000 0.000 -249.800 100.000
	5 [i] e- 0 0 3 9-10 181.688 0.000 0.000 181.412 100.000
	6 [i] e+ 0 0 4 9-10 250.000 0.000 0.000 -249.800 100.000
	7 [x] A 0 0 3 [none] 66.065 0.000 0.000 66.065 0.000
	8 [x] A 0 0 4 [none] 0.000 0.000 0.000 -0.000 0.000
	9 [r] u 1 0 5-6 18-28 199.491 -20.389 -186.052 69.032 0.000
	10 [r] ubar 0 1 5-6 11-17 232.197 20.389 186.052 -137.420 0.000
	11 [o] ubar 0 500 10 [none] 17.840 0.835 15.017 -9.596 0.000
	12 [o] gl 500 501 10 [none] 6.032 -0.227 5.313 -2.848 0.000
	13 [o] gl 501 502 10 [none] 2.657 0.140 1.996 -1.748 0.000
	14 [o] gl 502 503 10 [none] 6.248 0.663 4.791 -3.955 0.000
	15 [o] gl 503 504 10 [none] 40.324 4.179 31.765 -24.486 0.000
	16 [o] gl 504 505 10 [none] 71.138 6.390 57.010 -42.067 0.000
	17 [o] gl 505 506 10 [none] 59.970 5.932 47.551 -36.057 0.000
	18 [o] gl 506 507 9 [none] 1.832 -1.515 -0.920 0.462 0.000
	19 [o] gl 507 508 9 [none] 0.982 -0.069 -0.980 -0.022 0.000
	20 [o] gl 508 509 9 [none] 2.047 -1.584 -0.573 -1.163 0.000
	21 [o] gl 509 510 9 [none] 9.757 -8.611 -1.046 -4.468 0.000
	22 [o] gl 510 511 9 [none] 31.749 -27.254 -1.890 -16.175 0.000
	23 [o] gl 511 512 9 [none] 1.145 -1.075 0.159 -0.360 0.000
	24 [o] gl 512 513 9 [none] 2.337 -1.921 -0.890 -0.991 0.000
	25 [o] gl 513 514 9 [none] 1.913 -1.459 -1.204 0.283 0.000
	26 [o] gl 514 515 9 [none] 8.198 2.070 -5.298 5.904 0.000
	27 [o] gl 515 516 9 [none] 84.258 13.920 -75.987 33.639 0.000
	28 [o] u 516 0 9 [none] 83.260 9.587 -74.814 35.260 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 431.688 0.000 0.000 -68.388
	Sum of beam remnant momenta: p(0:3) = 66.065 0.000 0.000 66.065
	Sum of outgoing momenta: p(0:3) = 431.688 0.000 0.000 -68.388
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 4.26236E+02
	n_in* => 2
	n_out* => 20
	n_tot* => 22
	$process_id* => "pythia6_3_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.93481E+15
	sqme_ref* => 2.93481E+15
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.4979992E+02\| 1.0000000E+02\| 1)
	2 prt(b:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.4979992E+02\| 1.0000000E+02\| 2)
	3 prt(i:11\|-1.8168767E+02; 0.0000000E+00, 0.0000000E+00,-1.8141227E+02\| 1.0000000E+02\| 3)
	4 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.4979992E+02\| 1.0000000E+02\| 4)
	5 prt(o:22\| 6.6065065E+01; 0.0000000E+00, 0.0000000E+00, 6.6065065E+01\| 0.0000000E+00\| 5)
	6 prt(o:22\| 0.0000000E+00; 0.0000000E+00, 0.0000000E+00, 0.0000000E+00\| 0.0000000E+00\| 6)
	7 prt(o:-2\| 1.7840363E+01; 8.3458261E-01, 1.5016817E+01,-9.5956879E+00\| 0.0000000E+00\| 7)
	8 prt(o:21\| 6.0324361E+00;-2.2698312E-01, 5.3128683E+00,-2.8481913E+00\| 0.0000000E+00\| 8)
	9 prt(o:21\| 2.6574615E+00; 1.3985103E-01, 1.9963433E+00,-1.7484727E+00\| 0.0000000E+00\| 9)
	10 prt(o:21\| 6.2481251E+00; 6.6349745E-01, 4.7914324E+00,-3.9548722E+00\| 0.0000000E+00\| 10)
	11 prt(o:21\| 4.0323927E+01; 4.1789129E+00, 3.1764563E+01,-2.4486085E+01\| 0.0000000E+00\| 11)
	12 prt(o:21\| 7.1137951E+01; 6.3898001E+00, 5.7010018E+01,-4.2067045E+01\| 0.0000000E+00\| 12)
	13 prt(o:21\| 5.9969604E+01; 5.9316697E+00, 4.7550805E+01,-3.6056755E+01\| 0.0000000E+00\| 13)
	14 prt(o:21\| 1.8317721E+00;-1.5147157E+00,-9.2046176E-01, 4.6235855E-01\| 0.0000000E+00\| 14)
	15 prt(o:21\| 9.8226448E-01;-6.9131687E-02,-9.7957324E-01,-2.2373561E-02\| 0.0000000E+00\| 15)
	16 prt(o:21\| 2.0468250E+00;-1.5841906E+00,-5.7298893E-01,-1.1625474E+00\| 0.0000000E+00\| 16)
	17 prt(o:21\| 9.7571174E+00;-8.6109749E+00,-1.0457295E+00,-4.4675385E+00\| 0.0000000E+00\| 17)
	18 prt(o:21\| 3.1748937E+01;-2.7253986E+01,-1.8898703E+00,-1.6175403E+01\| 0.0000000E+00\| 18)
	19 prt(o:21\| 1.1445698E+00;-1.0748048E+00, 1.5855989E-01,-3.6012969E-01\| 0.0000000E+00\| 19)
	20 prt(o:21\| 2.3373315E+00;-1.9208514E+00,-8.9003317E-01,-9.9060037E-01\| 0.0000000E+00\| 20)
	21 prt(o:21\| 1.9130277E+00;-1.4594023E+00,-1.2039567E+00, 2.8338690E-01\| 0.0000000E+00\| 21)
	22 prt(o:21\| 8.1981939E+00; 2.0701013E+00,-5.2980301E+00, 5.9038919E+00\| 0.0000000E+00\| 22)
	23 prt(o:21\| 8.4257748E+01; 1.3919610E+01,-7.5987122E+01, 3.3638813E+01\| 0.0000000E+00\| 23)
	24 prt(o:2\| 8.3260021E+01; 9.5870151E+00,-7.4813641E+01, 3.5259600E+01\| 0.0000000E+00\| 24)
	========================================================================
	Partial contents of pythia6_3b.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 1.50365E+33
	Squared matrix el. (prc) = 1.50365E+33
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 6
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.497999E+02
	T = 1.000000000E+02
	Children: 3 4
	Particle 2 [b] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Children: 3 4
	Particle 3 [v] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.497999E+02
	T = 1.000000000E+02
	Parents: 1 2
	Children: 5 7
	Particle 4 [v] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Parents: 1 2
	Children: 6 8
	Particle 5 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.497999E+02
	T = 1.000000000E+02
	Parents: 3
	Children: 9 10
	Particle 6 [i] f(-11)
	E = 2.448843E+02
	P = 0.000000E+00 0.000000E+00 -2.446800E+02
	T = 1.000000000E+02
	Parents: 4
	Children: 9 10
	Particle 7 [x] f(22*)
	E = 1.372475E-35
	P = 0.000000E+00 0.000000E+00 1.372475E-35
	T = 0.000000000E+00
	Parents: 3
	Particle 8 [x] f(22*)
	E = 5.119932E+00
	P = 0.000000E+00 0.000000E+00 -5.119932E+00
	T = 0.000000000E+00
	Parents: 4
	Particle 9 [o] f(2)c(1 )
	E = 2.482219E+02
	P = -2.281881E+02 5.891482E+01 7.793173E+01
	T = 0.000000000E+00
	Parents: 5 6
	Particle 10 [o] f(-2)c(-1 )
	E = 2.466624E+02
	P = 2.281881E+02 -5.891482E+01 -7.281180E+01
	T = 0.000000000E+00
	Parents: 5 6
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 7
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 250.000 0.000 0.000 249.800 100.000
	2 [b] e+ 0 0 [none] 3-4 250.000 0.000 0.000 -249.800 100.000
	3 [r] e- 0 0 1-2 5,7 250.000 0.000 0.000 249.800 100.000
	4 [r] e+ 0 0 1-2 6,8 250.000 0.000 0.000 -249.800 100.000
	5 [i] e- 0 0 3 9-10 250.000 0.000 0.000 249.800 100.000
	6 [i] e+ 0 0 4 9-10 244.884 0.000 0.000 -244.680 100.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 5.120 0.000 0.000 -5.120 0.000
	9 [r] u 1 0 5-6 18-24 248.222 -228.188 58.915 77.932 0.000
	10 [r] ubar 0 1 5-6 11-17,25-27 246.662 228.188 -58.915 -72.812 0.000
	11 [o] ubar 0 500 10 [none] 67.357 66.997 6.822 1.337 0.000
	12 [o] gl 500 501 10 [none] 11.047 10.915 1.575 -0.649 0.000
	13 [o] gl 501 502 10 [none] 11.146 11.016 1.691 -0.137 0.000
	14 [o] gl 502 503 10 [none] 21.964 21.568 3.720 -1.849 0.000
	15 [o] gl 503 504 10 [none] 12.944 11.841 2.560 -4.558 0.000
	16 [o] gl 504 505 10 [none] 3.236 2.996 -0.650 -1.036 0.000
	17 [o] d 505 0 10 [none] 115.186 79.739 -61.708 -55.693 0.109
	18 [o] u 506 0 9 [none] 103.402 -95.299 24.538 31.745 0.000
	19 [o] gl 507 506 9 [none] 91.901 -84.310 22.825 28.578 0.000
	20 [o] gl 508 507 9 [none] 25.417 -23.490 6.720 7.007 0.000
	21 [o] gl 509 508 9 [none] 5.099 -4.741 0.335 1.846 0.000
	22 [o] gl 510 509 9 [none] 3.435 -2.839 1.076 1.606 0.000
	23 [o] gl 511 510 9 [none] 6.122 -5.399 0.472 2.847 0.000
	24 [o] gl 512 511 9 [none] 0.284 -0.118 -0.149 0.211 0.000
	25 [o] gl 513 512 10 [none] 3.181 1.224 -2.448 -1.622 0.000
	26 [o] gl 514 513 10 [none] 5.206 4.057 -2.824 -1.632 0.000
	27 [o] dbar 0 514 10 [none] 7.958 5.843 -4.558 -2.882 0.109
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 494.884 0.000 0.000 5.120
	Sum of beam remnant momenta: p(0:3) = 5.120 0.000 0.000 -5.120
	Sum of outgoing momenta: p(0:3) = 494.884 0.000 0.000 5.120
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	========================================================================
	Event transform: hadronization
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 9
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 250.000 0.000 0.000 249.800 100.000
	2 [b] e+ 0 0 [none] 3-4 250.000 0.000 0.000 -249.800 100.000
	3 [r] e- 0 0 1-2 5,7 250.000 0.000 0.000 249.800 100.000
	4 [r] e+ 0 0 1-2 6,8 250.000 0.000 0.000 -249.800 100.000
	5 [i] e- 0 0 3 9-10 250.000 0.000 0.000 249.800 100.000
	6 [i] e+ 0 0 4 9-10 244.884 0.000 0.000 -244.680 100.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 5.120 0.000 0.000 -5.120 0.000
	9 [r] u 1 0 5-6 18-24 248.222 -228.188 58.915 77.932 0.000
	10 [r] ubar 0 1 5-6 11-17,25-27 246.662 228.188 -58.915 -72.812 0.000
	11 [r] ubar 0 500 10 28 67.357 66.997 6.822 1.337 0.000
	12 [r] gl 500 501 10 28 11.047 10.915 1.575 -0.649 0.000
	13 [r] gl 501 502 10 28 11.146 11.016 1.691 -0.137 0.000
	14 [r] gl 502 503 10 28 21.964 21.568 3.720 -1.849 0.000
	15 [r] gl 503 504 10 28 12.944 11.841 2.560 -4.558 0.000
	16 [r] gl 504 505 10 28 3.236 2.996 -0.650 -1.036 0.000
	17 [r] d 505 0 10 28 115.186 79.739 -61.708 -55.693 0.109
	18 [r] u 506 0 9 43 103.402 -95.299 24.538 31.745 0.000
	19 [r] gl 507 506 9 43 91.901 -84.310 22.825 28.578 0.000
	20 [r] gl 508 507 9 43 25.417 -23.490 6.720 7.007 0.000
	21 [r] gl 509 508 9 43 5.099 -4.741 0.335 1.846 0.000
	22 [r] gl 510 509 9 43 3.435 -2.839 1.076 1.606 0.000
	23 [r] gl 511 510 9 43 6.122 -5.399 0.472 2.847 0.000
	24 [r] gl 512 511 9 43 0.284 -0.118 -0.149 0.211 0.000
	25 [r] gl 513 512 10 43 3.181 1.224 -2.448 -1.622 0.000
	26 [r] gl 514 513 10 43 5.206 4.057 -2.824 -1.632 0.000
	27 [r] dbar 0 514 10 43 7.958 5.843 -4.558 -2.882 0.109
	28 [r] hr3 0 0 11-17 29-42 242.880 205.071 -45.988 -62.585 10904.673
	29 [r] eta 0 0 28 61-62 46.261 46.022 4.643 0.467 0.300
	30 [r] rhom 0 0 28 63-64 21.989 21.860 2.220 0.469 0.503
	31 [o] pip 0 0 28 [none] 12.531 12.296 2.129 -1.132 0.019
	32 [o] pim 0 0 28 [none] 7.484 7.385 1.188 0.176 0.019
	33 [r] Deltaba 0 0 28 65-66 13.176 12.996 1.548 -0.953 1.394
	34 [r] rhom 0 0 28 67-68 5.729 5.434 1.396 -0.884 0.559
	35 [r] Delta0 0 0 28 69-70 12.026 11.481 2.262 -2.494 1.474
	36 [r] etaprim 0 0 28 71-73 5.769 5.402 0.821 -1.585 0.917
	37 [o] nbar 0 0 28 [none] 4.121 2.740 -2.146 -1.998 0.883
	38 [r] lambda 0 0 28 74-75 11.162 8.411 -5.246 -5.007 1.245
	39 [o] kp 0 0 28 [none] 2.239 1.529 -1.059 -1.144 0.244
	40 [r] rhom 0 0 28 76-77 29.728 20.577 -16.048 -14.231 0.285
	41 [r] etaprim 0 0 28 78-79 31.116 21.617 -16.528 -15.060 0.917
	42 [r] omega 0 0 28 80-82 39.548 27.319 -21.169 -19.210 0.590
	43 [r] hr3 0 0 18-27 44-60 252.004 -205.071 45.988 67.705 14753.249
	44 [r] kstarp 0 0 43 83-84 91.143 -83.758 22.325 28.148 0.846
	45 [r] k0 0 0 43 85 58.028 -53.701 13.747 17.154 0.248
	46 [r] rho0 0 0 43 86-87 20.299 -18.491 5.060 6.609 0.852
	47 [r] k0 0 0 43 88 21.383 -19.668 4.678 6.949 0.248
	48 [o] km 0 0 43 [none] 16.013 -14.682 4.375 4.634 0.244
	49 [r] rhop 0 0 43 89-90 14.432 -13.297 3.323 4.489 0.281
	50 [o] pim 0 0 43 [none] 2.473 -2.072 0.941 0.958 0.019
	51 [r] rho0 0 0 43 91-92 6.531 -5.860 0.784 2.602 0.928
	52 [r] pi0 0 0 43 93-94 1.708 -1.657 0.307 0.240 0.018
	53 [r] omega 0 0 43 95-97 1.815 -1.186 0.286 1.092 0.611
	54 [r] rho0 0 0 43 98-99 1.669 -1.426 -0.231 0.021 0.700
	55 [o] pip 0 0 43 [none] 0.718 -0.237 -0.652 0.119 0.019
	56 [r] rhom 0 0 43 100-101 1.673 1.124 -1.001 -0.339 0.416
	57 [r] kstarp 0 0 43 102-103 3.822 3.212 -1.671 -0.818 0.829
	58 [r] k0 0 0 43 104 3.760 1.740 -2.527 -2.115 0.248
	59 [o] pim 0 0 43 [none] 2.447 1.809 -1.575 -0.463 0.019
	60 [o] pip 0 0 43 [none] 4.091 3.080 -2.180 -1.575 0.019
	61 [o] A 0 0 29 [none] 20.026 19.906 2.148 0.435 0.000
	62 [o] A 0 0 29 [none] 26.235 26.116 2.495 0.032 0.000
	63 [o] pim 0 0 30 [none] 5.683 5.630 0.750 -0.093 0.019
	64 [r] pi0 0 0 30 105-106 16.307 16.230 1.470 0.562 0.018
	65 [o] nbar 0 0 33 [none] 8.951 8.821 1.047 -0.562 0.883
	66 [o] pip 0 0 33 [none] 4.225 4.175 0.500 -0.391 0.019
	67 [o] pim 0 0 34 [none] 2.318 2.117 0.642 -0.678 0.019
	68 [r] pi0 0 0 34 107-108 3.411 3.317 0.754 -0.205 0.018
	69 [o] p 0 0 35 [none] 8.602 8.248 1.589 -1.600 0.880
	70 [o] pim 0 0 35 [none] 3.424 3.233 0.673 -0.893 0.019
	71 [o] pim 0 0 36 [none] 1.553 1.504 0.123 -0.338 0.019
	72 [o] pip 0 0 36 [none] 1.520 1.430 0.294 -0.401 0.019
	73 [r] eta 0 0 36 109-111 2.697 2.469 0.405 -0.846 0.300
	74 [o] p 0 0 38 [none] 10.130 7.615 -4.828 -4.522 0.880
	75 [o] pim 0 0 38 [none] 1.032 0.796 -0.418 -0.486 0.019
	76 [o] pim 0 0 40 [none] 2.712 1.835 -1.467 -1.348 0.019
	77 [r] pi0 0 0 40 112-113 27.015 18.742 -14.580 -12.883 0.018
	78 [o] A 0 0 41 [none] 3.573 2.496 -1.969 -1.630 0.000
	79 [r] rho0 0 0 41 114-115 27.543 19.121 -14.559 -13.430 0.680
	80 [o] pim 0 0 42 [none] 14.294 9.989 -7.402 -7.051 0.019
	81 [o] pip 0 0 42 [none] 16.069 11.022 -8.718 -7.792 0.019
	82 [r] pi0 0 0 42 116-117 9.185 6.308 -5.048 -4.366 0.018
	83 [r] k0 0 0 44 118 28.784 -26.473 7.060 8.808 0.248
	84 [o] pip 0 0 44 [none] 62.358 -57.285 15.265 19.339 0.019
	85 [o] kL0 0 0 45 [none] 58.028 -53.701 13.747 17.154 0.248
	86 [o] pim 0 0 46 [none] 13.730 -12.649 3.050 4.380 0.019
	87 [o] pip 0 0 46 [none] 6.569 -5.842 2.010 2.229 0.019
	88 [r] kS0 0 0 47 119-120 21.383 -19.668 4.678 6.949 0.248
	89 [o] pip 0 0 49 [none] 3.943 -3.670 0.720 1.240 0.019
	90 [r] pi0 0 0 49 121-122 10.490 -9.627 2.603 3.249 0.018
	91 [o] pim 0 0 51 [none] 5.906 -5.432 0.527 2.253 0.019
	92 [o] pip 0 0 51 [none] 0.626 -0.428 0.257 0.350 0.019
	93 [o] A 0 0 52 [none] 0.348 -0.326 0.062 0.102 0.000
	94 [o] A 0 0 52 [none] 1.360 -1.331 0.245 0.138 0.000
	95 [o] pip 0 0 53 [none] 0.528 -0.291 0.231 0.349 0.019
	96 [o] pim 0 0 53 [none] 0.159 -0.021 0.059 0.045 0.019
	97 [r] pi0 0 0 53 123-124 1.127 -0.874 -0.004 0.698 0.018
	98 [o] pip 0 0 54 [none] 1.127 -1.083 0.081 0.266 0.019
	99 [o] pim 0 0 54 [none] 0.542 -0.342 -0.312 -0.245 0.019
	100 [o] pim 0 0 56 [none] 0.321 0.026 -0.250 -0.142 0.019
	101 [r] pi0 0 0 56 125-126 1.352 1.098 -0.750 -0.197 0.018
	102 [r] k0 0 0 57 127 2.210 1.727 -1.221 -0.405 0.248
	103 [o] pip 0 0 57 [none] 1.612 1.485 -0.450 -0.412 0.019
	104 [r] kS0 0 0 58 128-129 3.760 1.740 -2.527 -2.115 0.248
	105 [o] A 0 0 64 [none] 15.070 14.997 1.379 0.548 0.000
	106 [o] A 0 0 64 [none] 1.237 1.233 0.091 0.014 0.000
	107 [o] A 0 0 68 [none] 1.147 1.101 0.304 -0.106 0.000
	108 [o] A 0 0 68 [none] 2.263 2.216 0.450 -0.099 0.000
	109 [r] pi0 0 0 73 130-131 0.659 0.614 0.164 -0.113 0.018
	110 [r] pi0 0 0 73 132-133 0.593 0.545 0.116 -0.153 0.018
	111 [r] pi0 0 0 73 134-135 1.444 1.310 0.125 -0.580 0.018
	112 [o] A 0 0 77 [none] 25.723 17.861 -13.859 -12.272 0.000
	113 [o] A 0 0 77 [none] 1.292 0.881 -0.721 -0.611 0.000
	114 [o] pim 0 0 79 [none] 26.657 18.540 -14.088 -12.975 0.019
	115 [o] pip 0 0 79 [none] 0.886 0.581 -0.471 -0.455 0.019
	116 [o] A 0 0 82 [none] 7.813 5.360 -4.330 -3.683 0.000
	117 [o] A 0 0 82 [none] 1.372 0.948 -0.718 -0.683 0.000
	118 [o] kL0 0 0 83 [none] 28.784 -26.473 7.060 8.808 0.248
	119 [o] pip 0 0 88 [none] 4.788 -4.345 1.169 1.629 0.019
	120 [o] pim 0 0 88 [none] 16.596 -15.323 3.509 5.320 0.019
	121 [o] A 0 0 90 [none] 7.131 -6.520 1.805 2.254 0.000
	122 [o] A 0 0 90 [none] 3.359 -3.108 0.798 0.995 0.000
	123 [o] A 0 0 97 [none] 0.132 -0.081 0.034 0.099 0.000
	124 [o] A 0 0 97 [none] 0.995 -0.793 -0.037 0.600 0.000
	125 [o] A 0 0 101 [none] 0.486 0.370 -0.288 -0.128 0.000
	126 [o] A 0 0 101 [none] 0.865 0.728 -0.462 -0.070 0.000
	127 [o] kL0 0 0 102 [none] 2.210 1.727 -1.221 -0.405 0.248
	128 [r] pi0 0 0 104 136-137 1.531 0.572 -0.991 -1.007 0.018
	129 [r] pi0 0 0 104 138-139 2.229 1.168 -1.536 -1.107 0.018
	130 [o] A 0 0 109 [none] 0.210 0.206 -0.010 -0.037 0.000
	131 [o] A 0 0 109 [none] 0.450 0.407 0.174 -0.077 0.000
	132 [o] A 0 0 110 [none] 0.538 0.516 0.072 -0.135 0.000
	133 [o] A 0 0 110 [none] 0.055 0.029 0.043 -0.018 0.000
	134 [o] A 0 0 111 [none] 0.766 0.722 0.070 -0.246 0.000
	135 [o] A 0 0 111 [none] 0.678 0.588 0.055 -0.334 0.000
	136 [o] A 0 0 128 [none] 1.499 0.561 -0.962 -1.003 0.000
	137 [o] A 0 0 128 [none] 0.032 0.011 -0.030 -0.004 0.000
	138 [o] A 0 0 129 [none] 0.802 0.470 -0.511 -0.401 0.000
	139 [o] A 0 0 129 [none] 1.426 0.698 -1.024 -0.706 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 494.884 0.000 0.000 5.120
	Sum of beam remnant momenta: p(0:3) = 5.120 0.000 0.000 -5.120
	Sum of outgoing momenta: p(0:3) = 494.884 0.000 0.000 5.120
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	------------------------------------------------------------------------
	Hadronization settings:
	------------------------------------------------------------------------
	Master switches:
	active = T
	General settings:
	hadron_method = PYTHIA6
	pT generation parameters
	enhanced_fraction = 1.000000000000E-02
	enhanced_width = 2.000000000000E+00
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 4.94858E+02
	n_in* => 2
	n_out* => 72
	n_tot* => 74
	$process_id* => "pythia6_3_p1"
	process_num_id* => [unknown integer]
	sqme* => 1.50365E+33
	sqme_ref* => 1.50365E+33
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.4979992E+02\| 1.0000000E+02\| 1)
	2 prt(b:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.4979992E+02\| 1.0000000E+02\| 2)
	3 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.4979992E+02\| 1.0000000E+02\| 3)
	4 prt(i:-11\|-2.4488425E+02; 0.0000000E+00, 0.0000000E+00, 2.4467999E+02\| 1.0000000E+02\| 4)
	5 prt(o:22\| 0.0000000E+00; 0.0000000E+00, 0.0000000E+00, 0.0000000E+00\| 0.0000000E+00\| 5)
	6 prt(o:22\| 5.1199315E+00; 0.0000000E+00, 0.0000000E+00,-5.1199315E+00\| 0.0000000E+00\| 6)
	7 prt(o:211\| 1.2530564E+01; 1.2295576E+01, 2.1293341E+00,-1.1315039E+00\| 1.9479785E-02\| 7)
	8 prt(o:-211\| 7.4835960E+00; 7.3852619E+00, 1.1880966E+00, 1.7624362E-01\| 1.9479785E-02\| 8)
	9 prt(o:-2112\| 4.1213007E+00; 2.7398508E+00,-2.1459160E+00,-1.9976462E+00\| 8.8279178E-01\| 9)
	10 prt(o:321\| 2.2392609E+00; 1.5293502E+00,-1.0592266E+00,-1.1444542E+00\| 2.4364096E-01\| 10)
	11 prt(o:-321\| 1.6013057E+01;-1.4682024E+01, 4.3747203E+00, 4.6340446E+00\| 2.4364096E-01\| 11)
	12 prt(o:-211\| 2.4729218E+00;-2.0716999E+00, 9.4136316E-01, 9.5799675E-01\| 1.9479785E-02\| 12)
	13 prt(o:211\| 7.1777686E-01;-2.3701446E-01,-6.5221419E-01, 1.1901527E-01\| 1.9479785E-02\| 13)
	14 prt(o:-211\| 2.4467731E+00; 1.8086975E+00,-1.5751756E+00,-4.6330784E-01\| 1.9479785E-02\| 14)
	15 prt(o:211\| 4.0910409E+00; 3.0796670E+00,-2.1802659E+00,-1.5745562E+00\| 1.9479785E-02\| 15)
	16 prt(o:22\| 2.0026465E+01; 1.9906175E+01, 2.1480410E+00, 4.3524408E-01\| 0.0000000E+00\| 16)
	17 prt(o:22\| 2.6234805E+01; 2.6115843E+01, 2.4953362E+00, 3.2022179E-02\| 0.0000000E+00\| 17)
	18 prt(o:-211\| 5.6825564E+00; 5.6303426E+00, 7.5007455E-01,-9.2723455E-02\| 1.9479785E-02\| 18)
	19 prt(o:-2112\| 8.9506389E+00; 8.8214430E+00, 1.0474656E+00,-5.6223039E-01\| 8.8279178E-01\| 19)
	20 prt(o:211\| 4.2249108E+00; 4.1745917E+00, 5.0036710E-01,-3.9090710E-01\| 1.9479785E-02\| 20)
	21 prt(o:-211\| 2.3183627E+00; 2.1172490E+00, 6.4206094E-01,-6.7848372E-01\| 1.9479785E-02\| 21)
	22 prt(o:2212\| 8.6024627E+00; 8.2483630E+00, 1.5892002E+00,-1.6003015E+00\| 8.8035059E-01\| 22)
	23 prt(o:-211\| 3.4238326E+00; 3.2330833E+00, 6.7266748E-01,-8.9321909E-01\| 1.9479785E-02\| 23)
	24 prt(o:-211\| 1.5527677E+00; 1.5041120E+00, 1.2253691E-01,-3.3799370E-01\| 1.9479785E-02\| 24)
	25 prt(o:211\| 1.5198516E+00; 1.4296280E+00, 2.9351554E-01,-4.0060153E-01\| 1.9479785E-02\| 25)
	26 prt(o:2212\| 1.0130344E+01; 7.6147994E+00,-4.8284752E+00,-4.5215241E+00\| 8.8035059E-01\| 26)
	27 prt(o:-211\| 1.0316079E+00; 7.9644446E-01,-4.1792187E-01,-4.8554364E-01\| 1.9479785E-02\| 27)
	28 prt(o:-211\| 2.7121640E+00; 1.8347791E+00,-1.4672267E+00,-1.3480301E+00\| 1.9479785E-02\| 28)
	29 prt(o:22\| 3.5730191E+00; 2.4962273E+00,-1.9693577E+00,-1.6300137E+00\| 0.0000000E+00\| 29)
	30 prt(o:-211\| 1.4294008E+01; 9.9894627E+00,-7.4018791E+00,-7.0513831E+00\| 1.9479785E-02\| 30)
	31 prt(o:211\| 1.6069386E+01; 1.1021620E+01,-8.7182344E+00,-7.7924297E+00\| 1.9479785E-02\| 31)
	32 prt(o:211\| 6.2358495E+01;-5.7284746E+01, 1.5264901E+01, 1.9339158E+01\| 1.9479785E-02\| 32)
	33 prt(o:130\| 5.8028485E+01;-5.3701158E+01, 1.3747261E+01, 1.7153887E+01\| 2.4767543E-01\| 33)
	34 prt(o:-211\| 1.3729654E+01;-1.2649044E+01, 3.0502547E+00, 4.3796744E+00\| 1.9479785E-02\| 34)
	35 prt(o:211\| 6.5694343E+00;-5.8419907E+00, 2.0099104E+00, 2.2292132E+00\| 1.9479785E-02\| 35)
	36 prt(o:211\| 3.9425782E+00;-3.6698797E+00, 7.2049767E-01, 1.2398827E+00\| 1.9479785E-02\| 36)
	37 prt(o:-211\| 5.9056150E+00;-5.4318119E+00, 5.2660529E-01, 2.2527573E+00\| 1.9479785E-02\| 37)
	38 prt(o:211\| 6.2567121E-01;-4.2847103E-01, 2.5731743E-01, 3.4954970E-01\| 1.9479785E-02\| 38)
	39 prt(o:22\| 3.4750730E-01;-3.2632231E-01, 6.2213195E-02, 1.0200288E-01\| 0.0000000E+00\| 39)
	40 prt(o:22\| 1.3603311E+00;-1.3309615E+00, 2.4513427E-01, 1.3766455E-01\| 0.0000000E+00\| 40)
	41 prt(o:211\| 5.2824349E-01;-2.9068937E-01, 2.3084186E-01, 3.4896006E-01\| 1.9479785E-02\| 41)
	42 prt(o:-211\| 1.5937081E-01;-2.1485222E-02, 5.8807986E-02, 4.4713253E-02\| 1.9479785E-02\| 42)
	43 prt(o:211\| 1.1269109E+00;-1.0831605E+00, 8.0837758E-02, 2.6585145E-01\| 1.9479785E-02\| 43)
	44 prt(o:-211\| 5.4212782E-01;-3.4239723E-01,-3.1180295E-01,-2.4487926E-01\| 1.9479785E-02\| 44)
	45 prt(o:-211\| 3.2092517E-01; 2.5889248E-02,-2.5043780E-01,-1.4185851E-01\| 1.9479785E-02\| 45)
	46 prt(o:211\| 1.6119431E+00; 1.4853352E+00,-4.5019012E-01,-4.1229711E-01\| 1.9479785E-02\| 46)
	47 prt(o:22\| 1.5070039E+01; 1.4996762E+01, 1.3794994E+00, 5.4790110E-01\| 0.0000000E+00\| 47)
	48 prt(o:22\| 1.2366024E+00; 1.2331997E+00, 9.0651194E-02, 1.3655893E-02\| 0.0000000E+00\| 48)
	49 prt(o:22\| 1.1474415E+00; 1.1014394E+00, 3.0376414E-01,-1.0573869E-01\| 0.0000000E+00\| 49)
	50 prt(o:22\| 2.2630868E+00; 2.2156066E+00, 4.5030723E-01,-9.9362536E-02\| 0.0000000E+00\| 50)
	51 prt(o:22\| 2.5723241E+01; 1.7861029E+01,-1.3859217E+01,-1.2271548E+01\| 0.0000000E+00\| 51)
	52 prt(o:22\| 1.2922092E+00; 8.8082586E-01,-7.2113379E-01,-6.1148718E-01\| 0.0000000E+00\| 52)
	53 prt(o:-211\| 2.6656825E+01; 1.8540000E+01,-1.4088118E+01,-1.2975368E+01\| 1.9479785E-02\| 53)
	54 prt(o:211\| 8.8649538E-01; 5.8110600E-01,-4.7081254E-01,-4.5502269E-01\| 1.9479785E-02\| 54)
	55 prt(o:22\| 7.8134538E+00; 5.3602648E+00,-4.3304923E+00,-3.6829957E+00\| 0.0000000E+00\| 55)
	56 prt(o:22\| 1.3716445E+00; 9.4808402E-01,-7.1794647E-01,-6.8344589E-01\| 0.0000000E+00\| 56)
	57 prt(o:130\| 2.8784020E+01;-2.6473449E+01, 7.0597487E+00, 8.8084397E+00\| 2.4767543E-01\| 57)
	58 prt(o:211\| 4.7876845E+00;-4.3453320E+00, 1.1689906E+00, 1.6291085E+00\| 1.9479785E-02\| 58)
	59 prt(o:-211\| 1.6595806E+01;-1.5322744E+01, 3.5087191E+00, 5.3201227E+00\| 1.9479785E-02\| 59)
	60 prt(o:22\| 7.1307614E+00;-6.5197924E+00, 1.8049675E+00, 2.2543641E+00\| 0.0000000E+00\| 60)
	61 prt(o:22\| 3.3589876E+00;-3.1075329E+00, 7.9769168E-01, 9.9484933E-01\| 0.0000000E+00\| 61)
	62 prt(o:22\| 1.3197203E-01;-8.1169434E-02, 3.3516616E-02, 9.8512819E-02\| 0.0000000E+00\| 62)
	63 prt(o:22\| 9.9492597E-01;-7.9315445E-01,-3.7171875E-02, 5.9950142E-01\| 0.0000000E+00\| 63)
	64 prt(o:22\| 4.8630875E-01; 3.7008628E-01,-2.8841219E-01,-1.2787006E-01\| 0.0000000E+00\| 64)
	65 prt(o:22\| 8.6531205E-01; 7.2829200E-01,-4.6207154E-01,-6.9610326E-02\| 0.0000000E+00\| 65)
	66 prt(o:130\| 2.2102843E+00; 1.7268532E+00,-1.2211784E+00,-4.0544135E-01\| 2.4767543E-01\| 66)
	67 prt(o:22\| 2.0971926E-01; 2.0628417E-01,-9.6011240E-03,-3.6562689E-02\| 0.0000000E+00\| 67)
	68 prt(o:22\| 4.4962562E-01; 4.0744998E-01, 1.7395920E-01,-7.6719686E-02\| 0.0000000E+00\| 68)
	69 prt(o:22\| 5.3778610E-01; 5.1556122E-01, 7.2490752E-02,-1.3474275E-01\| 0.0000000E+00\| 69)
	70 prt(o:22\| 5.5302074E-02; 2.9230696E-02, 4.3388201E-02,-1.7926233E-02\| 0.0000000E+00\| 70)
	71 prt(o:22\| 7.6595846E-01; 7.2199161E-01, 6.9603838E-02,-2.4612148E-01\| 0.0000000E+00\| 71)
	72 prt(o:22\| 6.7846243E-01; 5.8801805E-01, 5.5008071E-02,-3.3394633E-01\| 0.0000000E+00\| 72)
	73 prt(o:22\| 1.4986082E+00; 5.6067882E-01,-9.6156053E-01,-1.0034277E+00\| 0.0000000E+00\| 73)
	74 prt(o:22\| 3.2114559E-02; 1.1131862E-02,-2.9848555E-02,-4.0608314E-03\| 0.0000000E+00\| 74)
	75 prt(o:22\| 8.0242534E-01; 4.7028235E-01,-5.1139229E-01,-4.0149578E-01\| 0.0000000E+00\| 75)
	76 prt(o:22\| 1.4263816E+00; 6.9806271E-01,-1.0243872E+00,-7.0562306E-01\| 0.0000000E+00\| 76)
	========================================================================
	Index: trunk/share/tests/functional_tests/ref-output-double/pythia6_4.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-double/pythia6_4.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output-double/pythia6_4.ref (revision 8190)
	@@ -1,699 +1,708 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	?pacify = true
	$method = "omega"
	\| Process library 'pythia6_4_lib': recorded process 'pythia6_4_p1'
	\| Process library 'pythia6_4_lib': recorded process 'pythia6_4_p2'
	\| Process library 'pythia6_4_lib': recorded process 'pythia6_4_p3'
	SM.me => 1.00000E+00
	isr_mass = 1.00000E+00
	\| Process library 'pythia6_4_lib': compiling ...
	\| Process library 'pythia6_4_lib': writing makefile
	\| Process library 'pythia6_4_lib': removing old files
	\| Process library 'pythia6_4_lib': writing driver
	\| Process library 'pythia6_4_lib': creating source code
	\| Process library 'pythia6_4_lib': compiling sources
	\| Process library 'pythia6_4_lib': linking
	\| Process library 'pythia6_4_lib': loading
	\| Process library 'pythia6_4_lib': ... success.
	seed = 0
	$phs_method = "wood"
	$integration_method = "vamp"
	sqrts = 1.00000E+03
	openmp_num_threads = 1
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process pythia6_4_p1:
	\| Beam structure: e-, e+ => circe1 => isr
	\| Beam data (collision):
	\| e- (mass = 1.0000000E+00 GeV)
	\| e+ (mass = 1.0000000E+00 GeV)
	\| sqrts = 1.000000000000E+03 GeV
	\| CIRCE1: activating generator mode
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'pythia6_4_p1.i1.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'pythia6_4_p1'
	\| Library name = 'pythia6_4_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'pythia6_4_p1_i1': e-, e+ => Z, H [omega]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 2 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: Using 1 equivalence between channels.
	\| Phase space: wood
	\| Beam structure: circe1 => isr, none => none, isr
	\| Beam structure: 1 channels, 2 dimensions
	Warning: No cuts have been defined.
	\| Starting integration for process 'pythia6_4_p1'
	\| Integrate: iterations = 3:1000:"g", 3:1000
	\| Integrator: 1 chains, 1 channels, 4 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 1000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 1000 1.729E+01 3.15E-01 1.82 0.58 13.5
	2 1000 1.684E+01 1.92E-01 1.14 0.36 24.5
	3 1000 1.722E+01 1.96E-01 1.14 0.36 20.9
	\|-----------------------------------------------------------------------------\|
	3 3000 1.707E+01 1.26E-01 0.74 0.40 20.9 1.28 3
	\|-----------------------------------------------------------------------------\|
	4 1000 1.705E+01 1.77E-01 1.04 0.33 20.7
	5 1000 1.691E+01 1.68E-01 0.99 0.31 20.5
	6 1000 1.719E+01 2.18E-01 1.27 0.40 18.0
	\|-----------------------------------------------------------------------------\|
	6 3000 1.703E+01 1.06E-01 0.62 0.34 18.0 0.53 3
	\|=============================================================================\|
	error_threshold = 1.00000E-08
	n_events = 1
	?rebuild_events = true
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?allow_shower = true
	?ps_fsr_active = true
	$shower_method = "PYTHIA6"
	$sample = "pythia6_4a"
	\| Starting simulation for process 'pythia6_4_p1'
	\| Simulate: using integration grids from file 'pythia6_4_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 5.8727E-02
	\| Events: writing to ASCII file 'pythia6_4a.debug'
	\| Events: writing to raw file 'pythia6_4a.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 16.67 %
	\| Events: closing ASCII file 'pythia6_4a.debug'
	\| Events: closing raw file 'pythia6_4a.evx'
	$sample = "pythia6_4b"
	?hadronization_active = true
	\| Starting simulation for process 'pythia6_4_p1'
	\| Simulate: using integration grids from file 'pythia6_4_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| Simulate: activating hadronization
	\| Hadronization: Using PYTHIA6 interface for hadronization and decays
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 5.8727E-02
	\| Events: writing to ASCII file 'pythia6_4b.debug'
	\| Events: writing to raw file 'pythia6_4b.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 11.11 %
	\| Events: closing ASCII file 'pythia6_4b.debug'
	\| Events: closing raw file 'pythia6_4b.evx'
	\| There were no errors and 1 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Partial contents of pythia6_4a.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 1.25845E+29
	Squared matrix el. (prc) = 1.25845E+29
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 2
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 4.999990E+02
	T = 1.000000000E+00
	Children: 3 4
	Particle 2 [b] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -4.999990E+02
	T = 1.000000000E+00
	Children: 3 4
	Particle 3 [v] f(11)
	E = 4.889225E+02
	P = 0.000000E+00 0.000000E+00 4.889215E+02
	T = 1.000000000E+00
	Parents: 1 2
	Children: 5 7
	Particle 4 [v] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -4.999990E+02
	T = 1.000000000E+00
	Parents: 1 2
	Children: 6 8
	Particle 5 [i] f(11)
	E = 4.889225E+02
	P = 0.000000E+00 0.000000E+00 4.889215E+02
	T = 1.000000000E+00
	Parents: 3
	Children: 9 10
	Particle 6 [i] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -4.999990E+02
	T = 1.000000000E+00
	Parents: 4
	Children: 9 10
	Particle 7 [x] f(22*)
	E = 9.300760E-26
	P = 0.000000E+00 0.000000E+00 9.300760E-26
	T = 0.000000000E+00
	Parents: 3
	Particle 8 [x] f(22*)
	E = 3.006218E-06
	P = 0.000000E+00 0.000000E+00 -3.006218E-06
	T = 0.000000000E+00
	Parents: 4
	Particle 9 [o] f(23)
	E = 4.877064E+02
	P = 2.139291E+02 3.349478E+02 2.675566E+02
	T = 8.315287819E+03
	Parents: 5 6
	Particle 10 [o] f(25)
	E = 5.012162E+02
	P = -2.139291E+02 -3.349478E+02 -2.786341E+02
	T = 1.562500000E+04
	Parents: 5 6
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 3
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 500.000 0.000 0.000 499.999 1.000
	2 [b] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -499.999 1.000
	3 [r] e- 0 0 1-2 5,7 488.923 0.000 0.000 488.922 1.000
	4 [r] e+ 0 0 1-2 6,8 500.000 0.000 0.000 -499.999 1.000
	5 [i] e- 0 0 3 9-10 488.923 0.000 0.000 488.922 1.000
	6 [i] e+ 0 0 4 9-10 500.000 0.000 0.000 -499.999 1.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 0.000 0.000 0.000 -0.000 0.000
	9 [r] Z 0 0 5-6 11-12 487.706 213.929 334.948 267.557 8315.288
	10 [r] H 0 0 5-6 13-14 501.216 -213.929 -334.948 -278.634 15625.000
	11 [r] nue 0 0 9 15 208.602 57.608 171.247 104.262 0.000
	12 [r] nuebar 0 0 9 16 279.104 156.321 163.701 163.294 0.000
	13 [r] tau- 0 0 10 17 321.892 -111.677 -261.421 -150.993 3.158
	14 [r] tau+ 0 0 10 18-19 179.324 -102.252 -73.527 -127.641 3.158
	15 [o] nue 0 0 11 [none] 208.602 57.608 171.247 104.262 0.000
	16 [o] nuebar 0 0 12 [none] 279.104 156.321 163.701 163.294 0.000
	17 [r] tau- 0 0 13 20-22 321.886 -111.675 -261.416 -150.990 3.158
	18 [r] tau+ 0 0 14 23-24 179.287 -102.224 -73.513 -127.619 3.158
	19 [o] A 0 0 14 [none] 0.043 -0.030 -0.019 -0.024 0.000
	20 [o] numubar 0 0 17 [none] 14.550 -5.197 -11.824 -6.700 0.000
	21 [o] mu- 0 0 17 [none] 174.206 -59.698 -141.785 -81.738 0.011
	22 [o] nutau 0 0 17 [none] 133.129 -46.779 -107.807 -62.553 0.000
	23 [o] nutauba 0 0 18 [none] 3.537 -1.902 -1.305 -2.681 0.000
	24 [o] pip 0 0 18 [none] 175.750 -100.322 -72.207 -124.938 0.019
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 988.923 0.000 0.000 -11.077
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 988.923 0.000 0.000 -11.077
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.00000E+03
	sqrts_hat* => 9.88860E+02
	n_in* => 2
	n_out* => 10
	n_tot* => 12
	$process_id* => "pythia6_4_p1"
	process_num_id* => [unknown integer]
	sqme* => 1.25845E+29
	sqme_ref* => 1.25845E+29
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-4.9999900E+02\| 1.0000000E+00\| 1)
	2 prt(b:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 4.9999900E+02\| 1.0000000E+00\| 2)
	3 prt(i:11\|-4.8892252E+02; 0.0000000E+00, 0.0000000E+00,-4.8892150E+02\| 1.0000000E+00\| 3)
	4 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 4.9999900E+02\| 1.0000000E+00\| 4)
	5 prt(o:22\| 0.0000000E+00; 0.0000000E+00, 0.0000000E+00, 0.0000000E+00\| 0.0000000E+00\| 5)
	6 prt(o:22\| 3.0062176E-06; 0.0000000E+00, 0.0000000E+00,-3.0062176E-06\| 0.0000000E+00\| 6)
	7 prt(o:12\| 2.0860198E+02; 5.7608276E+01, 1.7124674E+02, 1.0426230E+02\| 0.0000000E+00\| 7)
	8 prt(o:-12\| 2.7910439E+02; 1.5632082E+02, 1.6370106E+02, 1.6329428E+02\| 0.0000000E+00\| 8)
	9 prt(o:22\| 4.3097492E-02;-2.9784046E-02,-1.9454200E-02,-2.4327732E-02\| 0.0000000E+00\| 9)
	10 prt(o:-14\| 1.4550165E+01;-5.1971530E+00,-1.1824181E+01,-6.6996758E+00\| 0.0000000E+00\| 10)
	11 prt(o:13\| 1.7420643E+02;-5.9698419E+01,-1.4178479E+02,-8.1737639E+01\| 1.1164036E-02\| 11)
	12 prt(o:16\| 1.3312946E+02;-4.6779293E+01,-1.0780662E+02,-6.2553049E+01\| 0.0000000E+00\| 12)
	13 prt(o:-16\| 3.5371441E+00;-1.9024990E+00,-1.3054410E+00,-2.6809905E+00\| 0.0000000E+00\| 13)
	14 prt(o:211\| 1.7574985E+02;-1.0032194E+02,-7.2207308E+01,-1.2493840E+02\| 1.9479785E-02\| 14)
	========================================================================
	Partial contents of pythia6_4b.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 4.52522E+10
	Squared matrix el. (prc) = 4.52522E+10
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 6
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 4.999990E+02
	T = 1.000000000E+00
	Children: 3 4
	Particle 2 [b] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -4.999990E+02
	T = 1.000000000E+00
	Children: 3 4
	Particle 3 [v] f(11)
	E = 4.945513E+02
	P = 0.000000E+00 0.000000E+00 4.945503E+02
	T = 1.000000000E+00
	Parents: 1 2
	Children: 5 7
	Particle 4 [v] f(-11)
	E = 4.992909E+02
	P = 0.000000E+00 0.000000E+00 -4.992899E+02
	T = 1.000000000E+00
	Parents: 1 2
	Children: 6 8
	Particle 5 [i] f(11)
	E = 4.945513E+02
	P = 0.000000E+00 0.000000E+00 4.945503E+02
	T = 1.000000000E+00
	Parents: 3
	Children: 9 10
	Particle 6 [i] f(-11)
	E = 4.971974E+02
	P = 0.000000E+00 0.000000E+00 -4.971963E+02
	T = 1.000000000E+00
	Parents: 4
	Children: 9 10
	Particle 7 [x] f(22*)
	E = 2.014712E-12
	P = 0.000000E+00 0.000000E+00 2.014712E-12
	T = 0.000000000E+00
	Parents: 3
	Particle 8 [x] f(22*)
	E = 2.093565E+00
	P = 0.000000E+00 0.000000E+00 -2.093565E+00
	T = 0.000000000E+00
	Parents: 4
	Particle 9 [o] f(23)
	E = 4.923197E+02
	P = -2.803370E+02 -3.910834E+02 -5.028266E+01
	T = 8.315287819E+03
	Parents: 5 6
	Particle 10 [o] f(25)
	E = 4.994290E+02
	P = 2.803370E+02 3.910834E+02 4.763662E+01
	T = 1.562500000E+04
	Parents: 5 6
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 7
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 500.000 0.000 0.000 499.999 1.000
	2 [b] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -499.999 1.000
	3 [r] e- 0 0 1-2 5,7 494.551 0.000 0.000 494.550 1.000
	4 [r] e+ 0 0 1-2 6,8 499.291 0.000 0.000 -499.290 1.000
	5 [i] e- 0 0 3 9-10 494.551 0.000 0.000 494.550 1.000
	6 [i] e+ 0 0 4 9-10 497.197 0.000 0.000 -497.196 1.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 2.094 0.000 0.000 -2.094 0.000
	9 [r] Z 0 0 5-6 11-12 492.320 -280.337 -391.083 -50.283 8315.288
	10 [r] H 0 0 5-6 13-14 499.429 280.337 391.083 47.637 15625.000
	11 [r] d 500 0 9 23-28 374.024 -196.293 -318.218 -10.022 0.109
	12 [r] dbar 501 500 9 18-22,29-33 118.296 -84.044 -72.866 -40.261 0.109
	13 [r] tau- 0 0 10 15 380.190 242.187 292.947 -8.297 3.158
	14 [r] tau+ 0 0 10 16-17 119.239 38.150 98.136 55.934 3.158
	15 [r] tau- 0 0 13 34-35 380.190 242.187 292.947 -8.297 3.158
	16 [r] tau+ 0 0 14 36-38 119.176 38.130 98.085 55.904 3.158
	17 [o] A 0 0 14 [none] 0.063 0.020 0.052 0.030 0.000
	18 [o] dbar 502 501 12 [none] 36.571 -26.561 -20.362 -14.739 0.109
	19 [o] gl 503 502 12 [none] 16.471 -10.475 -11.514 -5.383 0.000
	20 [o] gl 504 503 12 [none] 38.088 -25.698 -25.008 -12.841 0.000
	21 [o] gl 505 504 12 [none] 5.932 -3.764 -4.247 -1.727 0.000
	22 [o] u 0 505 12 [none] 17.635 -11.855 -12.204 -4.626 0.109
	23 [o] d 506 0 11 [none] 260.325 -137.274 -221.069 -7.298 0.109
	24 [o] gl 507 506 11 [none] 61.400 -31.962 -52.411 -1.216 0.000
	25 [o] gl 508 507 11 [none] 13.328 -7.096 -11.282 -0.058 0.000
	26 [o] gl 509 508 11 [none] 4.456 -2.246 -3.848 0.030 0.000
	27 [o] gl 510 509 11 [none] 5.566 -2.710 -4.832 -0.532 0.000
	28 [o] gl 511 510 11 [none] 2.460 -1.216 -2.095 -0.428 0.000
	29 [o] gl 512 511 12 [none] 5.823 -2.817 -5.096 -0.051 0.000
	30 [o] gl 513 512 12 [none] 1.176 -0.897 -0.692 -0.319 0.000
	31 [o] gl 514 513 12 [none] 12.096 -8.230 -8.792 1.136 0.000
	32 [o] gl 515 514 12 [none] 0.463 -0.280 -0.269 -0.253 0.000
	33 [o] ubar 0 515 12 [none] 10.530 -7.257 -7.362 -1.977 0.109
	34 [o] nutau 0 0 15 [none] 241.142 154.242 185.294 -5.019 0.000
	35 [o] pim 0 0 15 [none] 139.047 87.945 107.653 -3.278 0.019
	36 [o] nue 0 0 16 [none] 74.911 24.100 61.660 35.055 0.000
	37 [o] e+ 0 0 16 [none] 7.721 2.726 6.401 3.348 0.000
	38 [o] nutauba 0 0 16 [none] 36.544 11.304 30.023 17.501 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 991.749 0.000 0.000 -2.646
	Sum of beam remnant momenta: p(0:3) = 2.094 0.000 0.000 -2.094
	Sum of outgoing momenta: p(0:3) = 991.749 0.000 0.000 -2.646
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	========================================================================
	Event transform: hadronization
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 9
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 500.000 0.000 0.000 499.999 1.000
	2 [b] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -499.999 1.000
	3 [r] e- 0 0 1-2 5,7 494.551 0.000 0.000 494.550 1.000
	4 [r] e+ 0 0 1-2 6,8 499.291 0.000 0.000 -499.290 1.000
	5 [i] e- 0 0 3 9-10 494.551 0.000 0.000 494.550 1.000
	6 [i] e+ 0 0 4 9-10 497.197 0.000 0.000 -497.196 1.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 2.094 0.000 0.000 -2.094 0.000
	9 [r] Z 0 0 5-6 11-12 492.320 -280.337 -391.083 -50.283 8315.288
	10 [r] H 0 0 5-6 13-14 499.429 280.337 391.083 47.637 15625.000
	11 [r] d 500 0 9 23-28 374.024 -196.293 -318.218 -10.022 0.109
	12 [r] dbar 501 500 9 18-22,29-33 118.296 -84.044 -72.866 -40.261 0.109
	13 [r] tau- 0 0 10 15 380.190 242.187 292.947 -8.297 3.158
	14 [r] tau+ 0 0 10 16-17 119.239 38.150 98.136 55.934 3.158
	15 [r] tau- 0 0 13 34-35 380.190 242.187 292.947 -8.297 3.158
	16 [r] tau+ 0 0 14 36-38 119.176 38.130 98.085 55.904 3.158
	17 [o] A 0 0 14 [none] 0.063 0.020 0.052 0.030 0.000
	18 [r] dbar 502 501 12 39 36.571 -26.561 -20.362 -14.739 0.109
	19 [r] gl 503 502 12 39 16.471 -10.475 -11.514 -5.383 0.000
	20 [r] gl 504 503 12 39 38.088 -25.698 -25.008 -12.841 0.000
	21 [r] gl 505 504 12 39 5.932 -3.764 -4.247 -1.727 0.000
	22 [r] u 0 505 12 39 17.635 -11.855 -12.204 -4.626 0.109
	23 [r] d 506 0 11 47 260.325 -137.274 -221.069 -7.298 0.109
	24 [r] gl 507 506 11 47 61.400 -31.962 -52.411 -1.216 0.000
	25 [r] gl 508 507 11 47 13.328 -7.096 -11.282 -0.058 0.000
	26 [r] gl 509 508 11 47 4.456 -2.246 -3.848 0.030 0.000
	27 [r] gl 510 509 11 47 5.566 -2.710 -4.832 -0.532 0.000
	28 [r] gl 511 510 11 47 2.460 -1.216 -2.095 -0.428 0.000
	29 [r] gl 512 511 12 47 5.823 -2.817 -5.096 -0.051 0.000
	30 [r] gl 513 512 12 47 1.176 -0.897 -0.692 -0.319 0.000
	31 [r] gl 514 513 12 47 12.096 -8.230 -8.792 1.136 0.000
	32 [r] gl 515 514 12 47 0.463 -0.280 -0.269 -0.253 0.000
	33 [r] ubar 0 515 12 47 10.530 -7.257 -7.362 -1.977 0.109
	34 [o] nutau 0 0 15 [none] 241.142 154.242 185.294 -5.019 0.000
	35 [o] pim 0 0 15 [none] 139.047 87.945 107.653 -3.278 0.019
	36 [o] nue 0 0 16 [none] 74.911 24.100 61.660 35.055 0.000
	37 [o] e+ 0 0 16 [none] 7.721 2.726 6.401 3.348 0.000
	38 [o] nutauba 0 0 16 [none] 36.544 11.304 30.023 17.501 0.000
	39 [r] hr3 0 0 18-22 40-46 114.696 -78.353 -73.335 -39.317 92.230
	40 [r] etaprim 0 0 39 57-59 18.165 -12.914 -10.922 -6.556 0.918
	41 [r] rho0 0 0 39 60-61 9.870 -6.845 -5.467 -4.461 0.770
	42 [o] pip 0 0 39 [none] 20.644 -14.648 -12.293 -7.776 0.019
	43 [r] rhom 0 0 39 62-63 9.208 -6.164 -6.099 -3.015 0.503
	44 [r] rhop 0 0 39 64-65 16.232 -10.640 -11.053 -5.261 0.426
	45 [r] rho0 0 0 39 66-67 10.824 -7.415 -7.110 -3.328 0.544
	46 [r] rho0 0 0 39 68-69 29.755 -19.728 -20.391 -8.920 0.802
	47 [r] hr3 0 0 23-33 48-56 377.623 -201.984 -317.748 -10.966 717.598
	48 [r] rhom 0 0 47 70-71 118.200 -62.025 -100.558 -3.378 0.713
	49 [o] pip 0 0 47 [none] 125.711 -67.004 -106.321 -3.097 0.019
	50 [r] rhom 0 0 47 72-73 84.528 -43.077 -72.700 -1.833 0.668
	51 [o] p 0 0 47 [none] 9.534 -5.556 -7.668 -0.601 0.880
	52 [r] rhom 0 0 47 74-75 7.325 -4.282 -5.883 -0.101 0.708
	53 [r] Deltaba 0 0 47 76-77 12.660 -6.637 -10.711 -0.408 1.331
	54 [r] rhop 0 0 47 78-79 9.098 -5.994 -6.778 0.474 0.680
	55 [o] pim 0 0 47 [none] 0.319 -0.155 -0.202 -0.131 0.019
	56 [r] rho0 0 0 47 80-81 10.248 -7.255 -6.927 -1.890 0.839
	57 [r] pi0 0 0 40 82-83 7.669 -5.456 -4.583 -2.834 0.018
	58 [r] pi0 0 0 40 84-85 2.486 -1.801 -1.493 -0.827 0.018
	59 [r] eta 0 0 40 86-88 8.010 -5.657 -4.846 -2.894 0.300
	60 [o] pip 0 0 41 [none] 6.231 -4.442 -3.140 -3.036 0.019
	61 [o] pim 0 0 41 [none] 3.638 -2.404 -2.327 -1.424 0.019
	62 [o] pim 0 0 43 [none] 4.729 -3.012 -3.370 -1.385 0.019
	63 [r] pi0 0 0 43 89-90 4.479 -3.152 -2.729 -1.630 0.018
	64 [o] pip 0 0 44 [none] 6.374 -3.987 -4.547 -2.008 0.019
	65 [r] pi0 0 0 44 91-92 9.858 -6.653 -6.506 -3.253 0.018
	66 [o] pim 0 0 45 [none] 9.214 -6.282 -6.009 -3.049 0.019
	67 [o] pip 0 0 45 [none] 1.610 -1.133 -1.101 -0.279 0.019
	68 [o] pim 0 0 46 [none] 24.467 -16.434 -16.664 -7.130 0.019
	69 [o] pip 0 0 46 [none] 5.288 -3.294 -3.728 -1.790 0.019
	70 [o] pim 0 0 48 [none] 52.847 -27.776 -44.945 -1.117 0.019
	71 [r] pi0 0 0 48 93-94 65.353 -34.249 -55.613 -2.262 0.018
	72 [o] pim 0 0 50 [none] 69.153 -35.283 -59.448 -1.780 0.019
	73 [r] pi0 0 0 50 95-96 15.375 -7.794 -13.252 -0.053 0.018
	74 [o] pim 0 0 52 [none] 6.557 -3.744 -5.380 0.074 0.019
	75 [r] pi0 0 0 52 97-98 0.769 -0.538 -0.503 -0.175 0.018
	76 [o] nbar 0 0 53 [none] 10.086 -5.187 -8.595 -0.238 0.883
	77 [r] pi0 0 0 53 99-100 2.574 -1.450 -2.116 -0.170 0.018
	78 [o] pip 0 0 54 [none] 2.469 -1.471 -1.973 -0.142 0.019
	79 [r] pi0 0 0 54 101-102 6.629 -4.524 -4.805 0.615 0.018
	80 [o] pip 0 0 56 [none] 5.139 -3.931 -3.154 -0.992 0.019
	81 [o] pim 0 0 56 [none] 5.109 -3.323 -3.773 -0.898 0.019
	82 [o] A 0 0 57 [none] 6.482 -4.645 -3.839 -2.388 0.000
	83 [o] A 0 0 57 [none] 1.187 -0.811 -0.744 -0.446 0.000
	84 [o] A 0 0 58 [none] 2.137 -1.582 -1.252 -0.705 0.000
	85 [o] A 0 0 58 [none] 0.348 -0.219 -0.242 -0.122 0.000
	86 [r] pi0 0 0 59 103-104 2.957 -2.059 -1.770 -1.164 0.018
	87 [r] pi0 0 0 59 105-106 2.502 -1.854 -1.487 -0.769 0.018
	88 [r] pi0 0 0 59 107-108 2.551 -1.744 -1.589 -0.962 0.018
	89 [o] A 0 0 63 [none] 0.128 -0.104 -0.061 -0.044 0.000
	90 [o] A 0 0 63 [none] 4.351 -3.048 -2.669 -1.586 0.000
	91 [o] A 0 0 65 [none] 4.367 -2.899 -2.928 -1.449 0.000
	92 [o] A 0 0 65 [none] 5.491 -3.754 -3.578 -1.804 0.000
	93 [o] A 0 0 71 [none] 47.378 -24.779 -40.349 -1.625 0.000
	94 [o] A 0 0 71 [none] 17.975 -9.469 -15.265 -0.637 0.000
	95 [o] A 0 0 73 [none] 2.167 -1.132 -1.847 -0.033 0.000
	96 [o] A 0 0 73 [none] 13.208 -6.662 -11.405 -0.020 0.000
	97 [o] A 0 0 75 [none] 0.739 -0.514 -0.496 -0.191 0.000
	98 [o] A 0 0 75 [none] 0.029 -0.023 -0.007 0.016 0.000
	99 [o] A 0 0 77 [none] 0.075 -0.058 -0.046 -0.000 0.000
	100 [o] A 0 0 77 [none] 2.500 -1.392 -2.069 -0.170 0.000
	101 [o] A 0 0 79 [none] 2.041 -1.367 -1.497 0.243 0.000
	102 [o] A 0 0 79 [none] 4.588 -3.157 -3.308 0.372 0.000
	103 [o] A 0 0 86 [none] 1.839 -1.250 -1.099 -0.782 0.000
	104 [o] A 0 0 86 [none] 1.118 -0.809 -0.671 -0.382 0.000
	105 [o] A 0 0 87 [none] 0.128 -0.074 -0.086 -0.058 0.000
	106 [o] A 0 0 87 [none] 2.374 -1.780 -1.401 -0.711 0.000
	107 [o] A 0 0 88 [none] 1.544 -1.031 -1.011 -0.546 0.000
	108 [o] A 0 0 88 [none] 1.007 -0.713 -0.577 -0.415 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 991.749 0.000 0.000 -2.646
	Sum of beam remnant momenta: p(0:3) = 2.094 0.000 0.000 -2.094
	Sum of outgoing momenta: p(0:3) = 991.749 0.000 0.000 -2.646
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	------------------------------------------------------------------------
	Hadronization settings:
	------------------------------------------------------------------------
	Master switches:
	active = T
	General settings:
	hadron_method = PYTHIA6
	pT generation parameters
	enhanced_fraction = 1.000000000000E-02
	enhanced_width = 2.000000000000E+00
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.00000E+03
	sqrts_hat* => 9.91745E+02
	n_in* => 2
	n_out* => 51
	n_tot* => 53
	$process_id* => "pythia6_4_p1"
	process_num_id* => [unknown integer]
	sqme* => 4.52522E+10
	sqme_ref* => 4.52522E+10
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-4.9999900E+02\| 1.0000000E+00\| 1)
	2 prt(b:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 4.9999900E+02\| 1.0000000E+00\| 2)
	3 prt(i:11\|-4.9455132E+02; 0.0000000E+00, 0.0000000E+00,-4.9455031E+02\| 1.0000000E+00\| 3)
	4 prt(i:-11\|-4.9719735E+02; 0.0000000E+00, 0.0000000E+00, 4.9719635E+02\| 1.0000000E+00\| 4)
	5 prt(o:22\| 2.0147116E-12; 0.0000000E+00, 0.0000000E+00, 2.0147116E-12\| 0.0000000E+00\| 5)
	6 prt(o:22\| 2.0935646E+00; 0.0000000E+00, 0.0000000E+00,-2.0935646E+00\| 0.0000000E+00\| 6)
	7 prt(o:22\| 6.2995338E-02; 1.9868382E-02, 5.1829118E-02, 2.9789302E-02\| 0.0000000E+00\| 7)
	8 prt(o:16\| 2.4114248E+02; 1.5424206E+02, 1.8529406E+02,-5.0192754E+00\| 0.0000000E+00\| 8)
	9 prt(o:-211\| 1.3904739E+02; 8.7944642E+01, 1.0765292E+02,-3.2780286E+00\| 1.9479785E-02\| 9)
	10 prt(o:12\| 7.4911229E+01; 2.4099862E+01, 6.1660490E+01, 3.5055284E+01\| 0.0000000E+00\| 10)
	11 prt(o:-11\| 7.7210351E+00; 2.7263708E+00, 6.4007961E+00, 3.3482973E+00\| 0.0000000E+00\| 11)
	12 prt(o:-16\| 3.6543848E+01; 1.1304184E+01, 3.0023307E+01, 1.7500551E+01\| 0.0000000E+00\| 12)
	13 prt(o:211\| 2.0643934E+01;-1.4647990E+01,-1.2293043E+01,-7.7762471E+00\| 1.9479785E-02\| 13)
	14 prt(o:211\| 1.2571101E+02;-6.7003673E+01,-1.0632100E+02,-3.0971443E+00\| 1.9479785E-02\| 14)
	15 prt(o:2212\| 9.5344759E+00;-5.5556206E+00,-7.6680839E+00,-6.0120602E-01\| 8.8035059E-01\| 15)
	16 prt(o:-211\| 3.1898225E-01;-1.5518637E-01,-2.0228024E-01,-1.3141457E-01\| 1.9479785E-02\| 16)
	17 prt(o:211\| 6.2311241E+00;-4.4415605E+00,-3.1401286E+00,-3.0363729E+00\| 1.9479785E-02\| 17)
	18 prt(o:-211\| 3.6384183E+00;-2.4037040E+00,-2.3265038E+00,-1.4241471E+00\| 1.9479785E-02\| 18)
	19 prt(o:-211\| 4.7288527E+00;-3.0115252E+00,-3.3697115E+00,-1.3850374E+00\| 1.9479785E-02\| 19)
	20 prt(o:211\| 6.3738480E+00;-3.9871264E+00,-4.5470428E+00,-2.0084034E+00\| 1.9479785E-02\| 20)
	21 prt(o:-211\| 9.2135805E+00;-6.2821054E+00,-6.0089928E+00,-3.0492199E+00\| 1.9479785E-02\| 21)
	22 prt(o:211\| 1.6100327E+00;-1.1325825E+00,-1.1009654E+00,-2.7902938E-01\| 1.9479785E-02\| 22)
	23 prt(o:-211\| 2.4467044E+01;-1.6434495E+01,-1.6663847E+01,-7.1302394E+00\| 1.9479785E-02\| 23)
	24 prt(o:211\| 5.2881185E+00;-3.2935494E+00,-3.7275301E+00,-1.7896284E+00\| 1.9479785E-02\| 24)
	25 prt(o:-211\| 5.2847218E+01;-2.7775988E+01,-4.4945041E+01,-1.1165748E+00\| 1.9479785E-02\| 25)
	26 prt(o:-211\| 6.9152736E+01;-3.5282728E+01,-5.9447824E+01,-1.7795319E+00\| 1.9479785E-02\| 26)
	27 prt(o:-211\| 6.5567648E+00;-3.7439250E+00,-5.3804465E+00, 7.4206897E-02\| 1.9479785E-02\| 27)
	28 prt(o:-2112\| 1.0085641E+01;-5.1869343E+00,-8.5951505E+00,-2.3763194E-01\| 8.8279178E-01\| 28)
	29 prt(o:211\| 2.4688538E+00;-1.4707574E+00,-1.9729405E+00,-1.4190708E-01\| 1.9479785E-02\| 29)
	30 prt(o:211\| 5.1385732E+00;-3.9313598E+00,-3.1537929E+00,-9.9169336E-01\| 1.9479785E-02\| 30)
	31 prt(o:-211\| 5.1094766E+00;-3.3233691E+00,-3.7730904E+00,-8.9792982E-01\| 1.9479785E-02\| 31)
	32 prt(o:22\| 6.4820789E+00;-4.6450281E+00,-3.8392314E+00,-2.3877528E+00\| 0.0000000E+00\| 32)
	33 prt(o:22\| 1.1871661E+00;-8.1059047E-01,-7.4369886E-01,-4.4633907E-01\| 0.0000000E+00\| 33)
	34 prt(o:22\| 2.1372701E+00;-1.5821983E+00,-1.2518346E+00,-7.0532410E-01\| 0.0000000E+00\| 34)
	35 prt(o:22\| 3.4824808E-01;-2.1906041E-01,-2.4159747E-01,-1.2214714E-01\| 0.0000000E+00\| 35)
	36 prt(o:22\| 1.2825007E-01;-1.0412570E-01,-6.0629801E-02,-4.3931144E-02\| 0.0000000E+00\| 36)
	37 prt(o:22\| 4.3505900E+00;-3.0480346E+00,-2.6686502E+00,-1.5860091E+00\| 0.0000000E+00\| 37)
	38 prt(o:22\| 4.3674517E+00;-2.8988314E+00,-2.9277100E+00,-1.4491119E+00\| 0.0000000E+00\| 38)
	39 prt(o:22\| 5.4905317E+00;-3.7539366E+00,-3.5778856E+00,-1.8035055E+00\| 0.0000000E+00\| 39)
	40 prt(o:22\| 4.7378028E+01;-2.4779411E+01,-4.0348693E+01,-1.6252196E+00\| 0.0000000E+00\| 40)
	41 prt(o:22\| 1.7974514E+01;-9.4692125E+00,-1.5264724E+01,-6.3669947E-01\| 0.0000000E+00\| 41)
	42 prt(o:22\| 2.1670945E+00;-1.1322492E+00,-1.8474881E+00,-3.3139464E-02\| 0.0000000E+00\| 42)
	43 prt(o:22\| 1.3208099E+01;-6.6620968E+00,-1.1404821E+01,-2.0051703E-02\| 0.0000000E+00\| 43)
	44 prt(o:22\| 7.3948113E-01;-5.1440676E-01,-4.9555448E-01,-1.9142568E-01\| 0.0000000E+00\| 44)
	45 prt(o:22\| 2.9205533E-02;-2.3445407E-02,-7.0177055E-03, 1.5938252E-02\| 0.0000000E+00\| 45)
	46 prt(o:22\| 7.4525935E-02;-5.8329684E-02,-4.6387063E-02,-5.7585739E-05\| 0.0000000E+00\| 46)
	47 prt(o:22\| 2.4995312E+00;-1.3915190E+00,-2.0694013E+00,-1.7002812E-01\| 0.0000000E+00\| 47)
	48 prt(o:22\| 2.0413834E+00;-1.3665523E+00,-1.4968738E+00, 2.4320758E-01\| 0.0000000E+00\| 48)
	49 prt(o:22\| 4.5876635E+00;-3.1570460E+00,-3.3077436E+00, 3.7222211E-01\| 0.0000000E+00\| 49)
	50 prt(o:22\| 1.8387722E+00;-1.2501325E+00,-1.0987460E+00,-7.8167074E-01\| 0.0000000E+00\| 50)
	51 prt(o:22\| 1.1183742E+00;-8.0874748E-01,-6.7139389E-01,-3.8199305E-01\| 0.0000000E+00\| 51)
	52 prt(o:22\| 1.2812160E-01;-7.4447284E-02,-8.6425164E-02,-5.8338982E-02\| 0.0000000E+00\| 52)
	53 prt(o:22\| 2.3737977E+00;-1.7796981E+00,-1.4009780E+00,-7.1052850E-01\| 0.0000000E+00\| 53)
	54 prt(o:22\| 1.5437408E+00;-1.0308366E+00,-1.0110698E+00,-5.4612202E-01\| 0.0000000E+00\| 54)
	55 prt(o:22\| 1.0070956E+00;-7.1287256E-01,-5.7743531E-01,-4.1547885E-01\| 0.0000000E+00\| 55)
	========================================================================
	Index: trunk/share/tests/functional_tests/ref-output/vars.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output/vars.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output/vars.ref (revision 8190)
	@@ -1,373 +1,375 @@
	?openmp_logging = false
	[user variable] foo = -7.800000000000E-02
	[user variable] bar = 1
	[user variable] a = 2.010000000000E-05
	[user variable] i = 3
	[user variable] foo = 2.922000000000E+00
	[user variable] i = 9
	[user variable] foo = 2.922000000000E+00
	[user variable] bar = 1
	[user variable] i = 9
	[user variable] k = 1
	[user variable] k2 = 1.000000000000E+00
	[user variable] i = -1
	[user variable] k = 2
	[user variable] k2 = 4.000000000000E+00
	[user variable] i = -2
	[user variable] k = 3
	[user variable] k2 = 9.000000000000E+00
	[user variable] i = -3
	[user variable] k = 4
	[user variable] k2 = 1.600000000000E+01
	[user variable] i = -4
	[user variable] k = 8
	[user variable] k2 = 6.400000000000E+01
	[user variable] i = -8
	[user variable] i = 9
	[user variable] MW = 7.980000000000E+01
	[user variable] MW = 7.980000000000E+01
	SM.mtau => 8.000000000000E-01
	SM.mW => 8.011900000000E+01
	SM.mW => 8.011900000000E+01
	SM.sw* => 4.775372811515E-01
	SM.mW => 7.500000000000E+01
	SM.sw* => 5.688014954824E-01
	SM.mW => 8.000000000000E+01
	SM.sw* => 4.799305327664E-01
	SM.mW => 8.050000000000E+01
	SM.sw* => 4.697684723671E-01
	SM.mW => 8.100000000000E+01
	SM.sw* => 4.593162187090E-01
	SM.mW => 8.150000000000E+01
	SM.sw* => 4.485534858838E-01
	SM.mW => 8.200000000000E+01
	SM.sw* => 4.374573583998E-01
	SM.mW => 8.300000000000E+01
	SM.sw* => 4.141569403361E-01
	SM.mW => 8.469722796445E+01
	SM.sw* => 3.705366373038E-01
	SM.mW => 8.642916174533E+01
	SM.sw* => 3.188332912310E-01
	SM.mW => 8.819651102555E+01
	SM.sw* => 2.540459583362E-01
	SM.mW => 9.000000000000E+01
	SM.sw* => 1.609055729882E-01
	mW is 80.119 and sw is: 0.4775
	seed = 32
	seed = 32
	seed = 30
	seed = 30
	seed = 28
	seed = 28
	seed = 26
	seed = 26
	seed = 24
	seed = 24
	seed = 22
	seed = 22
	seed = 20
	seed = 20
	seed = 18
	seed = 18
	seed = 16
	seed = 16
	seed = 14
	seed = 14
	seed = 12
	seed = 12
	seed = 10
	seed = 10
	seed = 8
	seed = 8
	seed = 6
	seed = 6
	seed = 4
	seed = 4
	seed = 2
	seed = 2
	[user variable] $str = "foo"
	[user variable] $str = "bar"
	[user variable] ?ok = false
	[user variable] ?ok = false
	[user variable] ?ok = true
	?sf_trace = false
	?sf_allow_s_mapping = true
	?hoppet_b_matching = false
	?isr_recoil = false
	?isr_keep_energy = false
	?isr_handler = false
	?epa_recoil = false
	?epa_keep_energy = false
	?epa_handler = false
	?ewa_recoil = false
	?ewa_keep_energy = false
	?circe1_photon1 = false
	?circe1_photon2 = false
	?circe1_generate = true
	?circe1_map = true
	?circe1_with_radiation = false
	?circe2_polarized = true
	?beam_events_warn_eof = true
	?energy_scan_normalize = false
	?logging => true
	?report_progress = true
	[user variable] ?me_verbose = false
	?omega_write_phs_output = false
	?read_color_factors = true
	?slha_read_input = true
	?slha_read_spectrum = true
	?slha_read_decays = false
	?alphas_is_fixed = true
	?alphas_from_lhapdf = false
	?alphas_from_pdf_builtin = false
	?alphas_from_mz = false
	?alphas_from_lambda_qcd = false
	?fatal_beam_decay = true
	?helicity_selection_active = true
	?vis_diags = false
	?vis_diags_color = false
	?check_event_file = true
	?unweighted = true
	?negative_weights = false
	?resonance_history = false
	?keep_beams = false
	?keep_remnants = true
	?recover_beams = true
	?update_event = false
	?update_sqme = false
	?update_weight = false
	?use_alphas_from_file = false
	?use_scale_from_file = false
	?allow_decays = true
	?auto_decays = false
	?auto_decays_radiative = false
	?decay_rest_frame = false
	?isotropic_decay = false
	?diagonal_decay = false
	?polarized_events = false
	?colorize_subevt = false
	?pacify = false
	?out_advance = true
	?stratified = true
	?use_vamp_equivalences = true
	?vamp_verbose = false
	?vamp_history_global = true
	?vamp_history_global_verbose = false
	?vamp_history_channels = false
	?vamp_history_channels_verbose = false
	?integration_timer = true
	?check_grid_file = true
	?vis_channels = false
	?check_phs_file = true
	?phs_only = false
	?phs_keep_nonresonant = true
	?phs_step_mapping = true
	?phs_step_mapping_exp = true
	?phs_s_mapping = true
	?vis_history = false
	?normalize_bins = false
	?y_log = false
	?x_log = false
	[undefined] ?draw_histogram = [unknown logical]
	[undefined] ?draw_base = [unknown logical]
	[undefined] ?draw_piecewise = [unknown logical]
	[undefined] ?fill_curve = [unknown logical]
	[undefined] ?draw_curve = [unknown logical]
	[undefined] ?draw_errors = [unknown logical]
	[undefined] ?draw_symbols = [unknown logical]
	?analysis_file_only = false
	?keep_flavors_when_clustering = false
	?sample_pacify = false
	?sample_select = true
	?read_raw = true
	?write_raw = true
	?debug_process = true
	?debug_transforms = true
	?debug_decay = true
	?debug_verbose = true
	?dump_compressed = false
	?dump_weights = false
	?dump_summary = false
	?dump_screen = false
	?hepevt_ensure_order = false
	?lhef_write_sqme_prc = true
	?lhef_write_sqme_ref = false
	?lhef_write_sqme_alt = true
	?hepmc_output_cross_section = false
	?allow_shower = true
	?ps_fsr_active = false
	?ps_isr_active = false
	?ps_taudec_active = false
	?muli_active = false
	?shower_verbose = false
	?ps_isr_alphas_running = true
	?ps_fsr_alphas_running = true
	?ps_isr_pt_ordered = false
	?ps_isr_angular_ordered = true
	?ps_isr_only_onshell_emitted_partons = false
	?allow_hadronization = true
	?hadronization_active = false
	?ps_tauola_photos = false
	?ps_tauola_transverse = false
	?ps_tauola_dec_rad_cor = true
	?ps_tauola_pol_vector = false
	?mlm_matching = false
	?powheg_matching = false
	?powheg_use_singular_jacobian = false
	?powheg_rebuild_grids = false
	?powheg_test_sudakov = false
	?powheg_disable_sudakov = false
	?ckkw_matching = false
	?omega_openmp => false
	?openmp_is_active* = false
	?openmp_logging = false
	?mpi_logging = false
	?test_soft_limit = false
	?test_coll_limit = false
	?test_anti_coll_limit = false
	?virtual_collinear_resonance_aware = true
	?openloops_use_cms = true
	?openloops_switch_off_muon_yukawa = false
	?openloops_use_collier = true
	?disable_subtraction = false
	?vis_fks_regions = false
	?combined_nlo_integration = false
	?fixed_order_nlo_events = false
	?check_event_weights_against_xsection = false
	?keep_failed_events = false
	?nlo_use_born_scale = true
	?nlo_cut_all_sqmes = true
	?nlo_use_real_partition = false
	?rebuild_library = true
	?recompile_library = false
	?rebuild_phase_space = true
	?rebuild_grids = true
	?powheg_rebuild_grids = true
	?rebuild_events = true
	[user variable] ?ok = true
	[user variable] $str = "foo"
	[user variable] $str = "foobar"
	$sf_trace_file = ""
	$lhapdf_dir = ""
	$lhapdf_file = ""
	$lhapdf_photon_file = ""
	$pdf_builtin_set = "CTEQ6L"
	$isr_handler_mode = "trivial"
	$epa_handler_mode = "trivial"
	$circe1_acc = "SBAND"
	[undefined] $circe2_file = [unknown string]
	$circe2_design = "*"
	[undefined] $beam_events_file = [unknown string]
	[undefined] $job_id = [unknown string]
	[undefined] $compile_workspace = [unknown string]
	$model_name = "SM"
	$method = "omega"
	$restrictions = ""
	$omega_flags = ""
	$library_name = "vars_lib"
	$rng_method = "tao"
	$event_file_version = ""
	$polarization_mode = "helicity"
	$out_file = ""
	$integration_method = "vamp"
	$run_id = ""
	[undefined] $integrate_workspace = [unknown string]
	$phs_method = "default"
	$phs_file = ""
	$obs_label = ""
	$obs_unit = ""
	$title = ""
	$description = ""
	$x_label = ""
	$y_label = ""
	$gmlcode_bg = ""
	$gmlcode_fg = ""
	[undefined] $fill_options = [unknown string]
	[undefined] $draw_options = [unknown string]
	[undefined] $err_options = [unknown string]
	[undefined] $symbol = [unknown string]
	$sample = ""
	$sample_normalization = "auto"
	$rescan_input_format = "raw"
	$extension_raw = "evx"
	$extension_default = "evt"
	$debug_extension = "debug"
	$dump_extension = "pset.dat"
	$extension_hepevt = "hepevt"
	$extension_ascii_short = "short.evt"
	$extension_ascii_long = "long.evt"
	$extension_athena = "athena.evt"
	$extension_mokka = "mokka.evt"
	$lhef_version = "2.0"
	$lhef_extension = "lhe"
	$extension_lha = "lha"
	$extension_hepmc = "hepmc"
	$extension_lcio = "slcio"
	$extension_stdhep = "hep"
	$extension_stdhep_up = "up.hep"
	$extension_stdhep_ev4 = "ev4.hep"
	$extension_hepevt_verb = "hepevt.verb"
	$extension_lha_verb = "lha.verb"
	$shower_method = "WHIZARD"
	$ps_PYTHIA_PYGIVE = ""
	+$ps_PYTHIA8_config = ""
	+$ps_PYTHIA8_config_file = ""
	$hadronization_method = "PYTHIA6"
	$born_me_method = ""
	$loop_me_method = ""
	$correlation_me_method = ""
	$real_tree_me_method = ""
	$dglap_me_method = ""
	$select_alpha_regions = ""
	$virtual_selection = "Full"
	$blha_ew_scheme = "alpha_qed"
	$openloops_extra_cmd = ""
	$fks_mapping_type = "default"
	$resonances_exclude_particles = "default"
	$gosam_filter_lo = ""
	$gosam_filter_nlo = ""
	$gosam_symmetries = "family,generation"
	$gosam_fc = ""
	$dalitz_plot = ""
	$nlo_correction_type = "QCD"
	$exclude_gauge_splittings = "c:b:t:e2:e3"
	$fc => Fortran-compiler
	$fcflags => Fortran-flags
	[user variable] $str = "foobar"
	[user variable] q = PDG(2)
	[user variable] q = PDG(2, 1, -2, -1)
	Q is only local and hence not not defined
	******************************************************************************
	*** ERROR: show: object 'Q' not found
	******************************************************************************
	\| (WHIZARD run continues)
	SM.u* = PDG(2)
	[user variable] q = PDG(2, 1, -2, -1)
	[user variable] i = 1
	one = 1
	[user variable] i = 2
	two
	[user variable] i = 3
	three
	[user variable] i = 4
	four
	[user variable] i = -1
	[user variable] $str = "i<=0"
	[user variable] i = 1
	[user variable] $str = "i>0"
	[user variable] i = 2
	[user variable] $str = "i>1"
	Testing the complex calculus
	[user variable] ca = ( 2.000000000000E+00, 1.000000000000E+00)
	[user variable] ca = ( 2.000000000000E+00, 1.000000000000E+00)
	[user variable] ia = 2
	[user variable] ia = 2
	[user variable] ra = 2.000000000000E+00
	[user variable] ra = 2.000000000000E+00
	[user variable] cb = ( 3.000000000000E+00, 4.000000000000E+00)
	[user variable] cb = ( 3.000000000000E+00, 4.000000000000E+00)
	?pacify = true
	[user variable] cc = ( 1.00000E+00, 0.00000E+00)
	?pacify = true
	[user variable] cc = ( 1.00000E+00, 0.00000E+00)
	\| There were 1 error(s) and no warnings.
	\| WHIZARD run finished.
	\|=============================================================================\|
	Index: trunk/share/tests/functional_tests/ref-output/pythia6_2.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output/pythia6_2.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output/pythia6_2.ref (revision 8190)
	@@ -1,1266 +1,1410 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	?pacify = true
	SM.me => 0.00000E+00
	$method = "omega"
	\| Process library 'pythia6_2_lib': recorded process 'pythia6_2_p1'
	\| Process library 'pythia6_2_lib': recorded process 'pythia6_2_p2'
	\| Process library 'pythia6_2_lib': recorded process 'pythia6_2_p3'
	\| Process library 'pythia6_2_lib': compiling ...
	\| Process library 'pythia6_2_lib': writing makefile
	\| Process library 'pythia6_2_lib': removing old files
	\| Process library 'pythia6_2_lib': writing driver
	\| Process library 'pythia6_2_lib': creating source code
	\| Process library 'pythia6_2_lib': compiling sources
	\| Process library 'pythia6_2_lib': linking
	\| Process library 'pythia6_2_lib': loading
	\| Process library 'pythia6_2_lib': ... success.
	seed = 0
	$phs_method = "wood"
	$integration_method = "vamp"
	sqrts = 1.00000E+03
	openmp_num_threads = 1
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process pythia6_2_p1:
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e- (mass = 0.0000000E+00 GeV)
	\| e+ (mass = 0.0000000E+00 GeV)
	\| sqrts = 1.000000000000E+03 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'pythia6_2_p1.i1.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'pythia6_2_p1'
	\| Library name = 'pythia6_2_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'pythia6_2_p1_i1': e-, e+ => Z, H [omega]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 2 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: Using 1 equivalence between channels.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| Starting integration for process 'pythia6_2_p1'
	\| Integrate: iterations = 1:1000
	\| Integrator: 1 chains, 1 channels, 2 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 1000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 800 1.286E+01 2.06E-02 0.16 0.05 69.0
	\|-----------------------------------------------------------------------------\|
	1 800 1.286E+01 2.06E-02 0.16 0.05 69.0
	\|=============================================================================\|
	error_threshold = 1.00000E-08
	n_events = 1
	?rebuild_events = true
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?allow_shower = true
	?ps_fsr_active = true
	$shower_method = "PYTHIA6"
	$sample = "pythia6_2a"
	\| Starting simulation for process 'pythia6_2_p1'
	\| Simulate: using integration grids from file 'pythia6_2_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 7.7772E-02
	\| Events: writing to ASCII file 'pythia6_2a.debug'
	\| Events: writing to raw file 'pythia6_2a.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 100.00 %
	\| Events: closing ASCII file 'pythia6_2a.debug'
	\| Events: closing raw file 'pythia6_2a.evx'
	$sample = "pythia6_2b"
	?hadronization_active = true
	\| Starting simulation for process 'pythia6_2_p1'
	\| Simulate: using integration grids from file 'pythia6_2_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| Simulate: activating hadronization
	\| Hadronization: Using PYTHIA6 interface for hadronization and decays
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 7.7772E-02
	\| Events: writing to ASCII file 'pythia6_2b.debug'
	\| Events: writing to raw file 'pythia6_2b.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 33.33 %
	\| Events: closing ASCII file 'pythia6_2b.debug'
	\| Events: closing raw file 'pythia6_2b.evx'
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Initializing integration for process pythia6_2_p2:
	\| Beam structure: [any particles]
	\| Beam data (decay):
	\| Z (mass = 9.1188200E+01 GeV)
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'pythia6_2_p2.i1.phs'
	\| ------------------------------------------------------------------------
	\| Process [decay]: 'pythia6_2_p2'
	\| Library name = 'pythia6_2_lib'
	\| Process index = 2
	\| Process components:
	\| 1: 'pythia6_2_p2_i1': Z => e-, e+ [omega]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 2 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: Using 1 equivalence between channels.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| Starting integration for process 'pythia6_2_p2'
	\| Integrate: iterations not specified, using default
	\| Integrate: iterations = 1:100:""
	\| Integrator: 1 chains, 1 channels, 2 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[GeV] Error[GeV] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 8.397E-02 0.00E+00 0.00 0.00 100.0
	\|-----------------------------------------------------------------------------\|
	1 100 8.397E-02 0.00E+00 0.00 0.00 100.0
	\|=============================================================================\|
	\| Unstable particle Z: computed branching ratios:
	\| pythia6_2_p2: 1.0000000E+00 e-, e+
	\| Total width = 8.3965692E-02 GeV (computed)
	\| = 2.4430000E+00 GeV (preset)
	\| Decay options: helicity treated exactly
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 4
	\| Initializing integration for process pythia6_2_p3:
	\| Beam structure: [any particles]
	\| Beam data (decay):
	\| H (mass = 1.2500000E+02 GeV)
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'pythia6_2_p3.i1.phs'
	\| ------------------------------------------------------------------------
	\| Process [decay]: 'pythia6_2_p3'
	\| Library name = 'pythia6_2_lib'
	\| Process index = 3
	\| Process components:
	\| 1: 'pythia6_2_p3_i1': H => b, bbar [omega]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 2 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: Using 1 equivalence between channels.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| Starting integration for process 'pythia6_2_p3'
	\| Integrate: iterations not specified, using default
	\| Integrate: iterations = 1:100:""
	\| Integrator: 1 chains, 1 channels, 2 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[GeV] Error[GeV] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.312E-03 0.00E+00 0.00 0.00 100.0
	\|-----------------------------------------------------------------------------\|
	1 100 4.312E-03 0.00E+00 0.00 0.00 100.0
	\|=============================================================================\|
	\| Unstable particle H: computed branching ratios:
	\| pythia6_2_p3: 1.0000000E+00 b, bbar
	\| Total width = 4.3122140E-03 GeV (computed)
	\| = 4.1430000E-03 GeV (preset)
	\| Decay options: helicity treated exactly
	$sample = "pythia6_2c"
	\| Starting simulation for process 'pythia6_2_p1'
	\| Simulate: using integration grids from file 'pythia6_2_p1.m1.vg'
	\| Simulate: activating decays
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| Simulate: using integration grids from file 'pythia6_2_p2.m1.vg'
	\| Simulate: using integration grids from file 'pythia6_2_p3.m1.vg'
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 5
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 7.7772E-02
	\| Events: writing to ASCII file 'pythia6_2c.debug'
	\| Events: writing to raw file 'pythia6_2c.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 100.00 %
	\| Events: closing ASCII file 'pythia6_2c.debug'
	\| Events: closing raw file 'pythia6_2c.evx'
	$sample = "pythia6_2d"
	?hadronization_active = true
	\| Starting simulation for process 'pythia6_2_p1'
	\| Simulate: using integration grids from file 'pythia6_2_p1.m1.vg'
	\| Simulate: activating decays
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| Simulate: activating hadronization
	\| Hadronization: Using PYTHIA6 interface for hadronization and decays
	\| Simulate: using integration grids from file 'pythia6_2_p2.m1.vg'
	\| Simulate: using integration grids from file 'pythia6_2_p3.m1.vg'
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 6
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 7.7772E-02
	\| Events: writing to ASCII file 'pythia6_2d.debug'
	\| Events: writing to raw file 'pythia6_2d.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 50.00 %
	\| Events: closing ASCII file 'pythia6_2d.debug'
	\| Events: closing raw file 'pythia6_2d.evx'
	\| There were no errors and 3 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Contents of pythia6_2a.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.43417E-03
	Squared matrix el. (prc) = 2.43417E-03
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_2_p1'
	TAO random-number generator:
	seed = 2
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 2 [i] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 3 [o] f(23)
	E = 4.963451E+02
	P = 4.672281E+02 1.282625E+02 -5.735730E+01
	T = 8.315287819E+03
	Parents: 1 2
	Particle 4 [o] f(25)
	E = 5.036549E+02
	P = -4.672281E+02 -1.282625E+02 5.735730E+01
	T = 1.562500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_2_p1'
	TAO random-number generator:
	seed = 3
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	3 [r] Z 0 0 1-2 5-6 496.345 467.228 128.263 -57.357 8315.288
	4 [r] H 0 0 1-2 7-8 503.655 -467.228 -128.263 57.357 15625.000
	5 [r] nue 0 0 3 9 104.738 83.275 57.073 -27.893 0.000
	6 [r] nuebar 0 0 3 10 391.607 383.953 71.189 -29.465 0.000
	7 [r] tau- 0 0 4 11 244.595 -208.521 -118.353 48.320 3.158
	8 [r] tau+ 0 0 4 12-13 259.060 -258.707 -9.910 9.038 3.158
	9 [o] nue 0 0 5 [none] 104.738 83.275 57.073 -27.893 0.000
	10 [o] nuebar 0 0 6 [none] 391.607 383.953 71.189 -29.465 0.000
	11 [r] tau- 0 0 7 14-16 244.590 -208.517 -118.351 48.319 3.158
	12 [r] tau+ 0 0 8 17-18 258.977 -258.624 -9.903 9.027 3.158
	13 [o] A 0 0 8 [none] 0.087 -0.086 -0.009 0.011 0.000
	14 [o] numubar 0 0 11 [none] 43.230 -36.904 -20.747 8.749 0.000
	15 [o] mu- 0 0 11 [none] 57.442 -48.620 -28.409 11.341 0.011
	16 [o] nutau 0 0 11 [none] 143.917 -122.993 -69.195 28.229 0.000
	17 [o] nutauba 0 0 12 [none] 41.423 -41.364 -1.116 1.893 0.000
	18 [o] pip 0 0 12 [none] 217.555 -217.260 -8.787 7.134 0.019
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.00000E+03
	sqrts_hat* => 1.00000E+03
	n_in* => 2
	n_out* => 8
	n_tot* => 10
	$process_id* => "pythia6_2_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.43417E-03
	sqme_ref* => 2.43417E-03
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02\| 0.0000000E+00\| 1)
	2 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02\| 0.0000000E+00\| 2)
	3 prt(o:12\| 1.0473826E+02; 8.3275123E+01, 5.7073186E+01,-2.7892800E+01\| 0.0000000E+00\| 3)
	4 prt(o:-12\| 3.9160688E+02; 3.8395296E+02, 7.1189338E+01,-2.9464503E+01\| 0.0000000E+00\| 4)
	5 prt(o:22\| 8.7455990E-02;-8.6269448E-02,-9.1144209E-03, 1.1093229E-02\| 0.0000000E+00\| 5)
	6 prt(o:-14\| 4.3230285E+01;-3.6903659E+01,-2.0746827E+01, 8.7490941E+00\| 0.0000000E+00\| 6)
	7 prt(o:13\| 5.7442208E+01;-4.8620214E+01,-2.8408594E+01, 1.1341195E+01\| 1.1164036E-02\| 7)
	8 prt(o:16\| 1.4391744E+02;-1.2299348E+02,-6.9195264E+01, 2.8228537E+01\| 0.0000000E+00\| 8)
	9 prt(o:-16\| 4.1422756E+01;-4.1364436E+01,-1.1155208E+00, 1.8930985E+00\| 0.0000000E+00\| 9)
	10 prt(o:211\| 2.1755471E+02;-2.1726003E+02,-8.7872035E+00, 7.1342849E+00\| 1.9479785E-02\| 10)
	========================================================================
	Contents of pythia6_2b.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.34324E-03
	Squared matrix el. (prc) = 2.34324E-03
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_2_p1'
	TAO random-number generator:
	seed = 6
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 2 [i] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 3 [o] f(23)
	E = 4.963451E+02
	P = -4.340495E+02 -1.922594E+02 -1.126082E+02
	T = 8.315287819E+03
	Parents: 1 2
	Particle 4 [o] f(25)
	E = 5.036549E+02
	P = 4.340495E+02 1.922594E+02 1.126082E+02
	T = 1.562500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_2_p1'
	TAO random-number generator:
	seed = 7
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	3 [r] Z 0 0 1-2 5-6 496.345 -434.049 -192.259 -112.608 8315.288
	4 [r] H 0 0 1-2 7-8 503.655 434.049 192.259 112.608 15625.000
	5 [r] d 500 0 3 17-22 268.271 -226.533 -139.638 -33.959 0.109
	6 [r] dbar 501 500 3 12-16,23-27 228.074 -207.516 -52.622 -78.649 0.109
	7 [r] tau- 0 0 4 9 389.257 355.403 153.917 38.930 3.158
	8 [r] tau+ 0 0 4 10-11 114.398 78.646 38.342 73.678 3.158
	9 [r] tau- 0 0 7 28-29 389.257 355.403 153.917 38.930 3.158
	10 [r] tau+ 0 0 8 30-32 114.338 78.605 38.322 73.639 3.158
	11 [o] A 0 0 8 [none] 0.061 0.041 0.020 0.039 0.000
	12 [o] dbar 502 501 6 [none] 81.781 -74.674 -15.654 -29.440 0.109
	13 [o] gl 503 502 6 [none] 25.286 -22.376 -7.257 -9.275 0.000
	14 [o] gl 504 503 6 [none] 66.159 -59.463 -16.927 -23.550 0.000
	15 [o] gl 505 504 6 [none] 8.543 -7.559 -2.627 -2.990 0.000
	16 [o] u 0 505 6 [none] 27.117 -24.420 -7.935 -8.714 0.109
	17 [o] d 506 0 5 [none] 188.686 -159.670 -97.559 -24.291 0.109
	18 [o] gl 507 506 5 [none] 43.118 -36.323 -22.689 -5.002 0.000
	19 [o] gl 508 507 5 [none] 9.711 -8.311 -4.933 -0.951 0.000
	20 [o] gl 509 508 5 [none] 2.890 -2.412 -1.579 -0.210 0.000
	21 [o] gl 510 509 5 [none] 3.705 -2.954 -2.074 -0.836 0.000
	22 [o] gl 511 510 5 [none] 1.899 -1.520 -0.958 -0.614 0.000
	23 [o] gl 512 511 6 [none] 3.510 -2.843 -2.034 -0.315 0.000
	24 [o] gl 513 512 6 [none] 2.386 -2.211 -0.529 -0.723 0.000
	25 [o] gl 514 513 6 [none] 15.030 -14.275 -4.595 -1.012 0.000
	26 [o] gl 515 514 6 [none] 1.018 -0.899 -0.173 -0.445 0.000
	27 [o] ubar 0 515 6 [none] 15.507 -14.140 -4.737 -4.240 0.109
	28 [o] nutau 0 0 9 [none] 327.399 299.154 128.891 32.922 0.000
	29 [o] pim 0 0 9 [none] 61.858 56.249 25.026 6.009 0.019
	30 [o] nue 0 0 10 [none] 66.853 45.947 22.702 42.928 0.000
	31 [o] e+ 0 0 10 [none] 16.127 11.455 5.138 10.123 0.000
	32 [o] nutauba 0 0 10 [none] 31.358 21.203 10.482 20.588 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	========================================================================
	Event transform: hadronization
	------------------------------------------------------------------------
	Associated process: 'pythia6_2_p1'
	TAO random-number generator:
	seed = 9
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	3 [r] Z 0 0 1-2 5-6 496.345 -434.049 -192.259 -112.608 8315.288
	4 [r] H 0 0 1-2 7-8 503.655 434.049 192.259 112.608 15625.000
	5 [r] d 500 0 3 17-22 268.271 -226.533 -139.638 -33.959 0.109
	6 [r] dbar 501 500 3 12-16,23-27 228.074 -207.516 -52.622 -78.649 0.109
	7 [r] tau- 0 0 4 9 389.257 355.403 153.917 38.930 3.158
	8 [r] tau+ 0 0 4 10-11 114.398 78.646 38.342 73.678 3.158
	9 [r] tau- 0 0 7 28-29 389.257 355.403 153.917 38.930 3.158
	10 [r] tau+ 0 0 8 30-32 114.338 78.605 38.322 73.639 3.158
	11 [o] A 0 0 8 [none] 0.061 0.041 0.020 0.039 0.000
	12 [r] dbar 502 501 6 33 81.781 -74.674 -15.654 -29.440 0.109
	13 [r] gl 503 502 6 33 25.286 -22.376 -7.257 -9.275 0.000
	14 [r] gl 504 503 6 33 66.159 -59.463 -16.927 -23.550 0.000
	15 [r] gl 505 504 6 33 8.543 -7.559 -2.627 -2.990 0.000
	16 [r] u 0 505 6 33 27.117 -24.420 -7.935 -8.714 0.109
	17 [r] d 506 0 5 41 188.686 -159.670 -97.559 -24.291 0.109
	18 [r] gl 507 506 5 41 43.118 -36.323 -22.689 -5.002 0.000
	19 [r] gl 508 507 5 41 9.711 -8.311 -4.933 -0.951 0.000
	20 [r] gl 509 508 5 41 2.890 -2.412 -1.579 -0.210 0.000
	21 [r] gl 510 509 5 41 3.705 -2.954 -2.074 -0.836 0.000
	22 [r] gl 511 510 5 41 1.899 -1.520 -0.958 -0.614 0.000
	23 [r] gl 512 511 6 41 3.510 -2.843 -2.034 -0.315 0.000
	24 [r] gl 513 512 6 41 2.386 -2.211 -0.529 -0.723 0.000
	25 [r] gl 514 513 6 41 15.030 -14.275 -4.595 -1.012 0.000
	26 [r] gl 515 514 6 41 1.018 -0.899 -0.173 -0.445 0.000
	27 [r] ubar 0 515 6 41 15.507 -14.140 -4.737 -4.240 0.109
	28 [o] nutau 0 0 9 [none] 327.399 299.154 128.891 32.922 0.000
	29 [o] pim 0 0 9 [none] 61.858 56.249 25.026 6.009 0.019
	30 [o] nue 0 0 10 [none] 66.853 45.947 22.702 42.928 0.000
	31 [o] e+ 0 0 10 [none] 16.127 11.455 5.138 10.123 0.000
	32 [o] nutauba 0 0 10 [none] 31.358 21.203 10.482 20.588 0.000
	33 [r] hr3 0 0 12-16 34-40 208.886 -188.492 -50.400 -73.969 92.230
	34 [r] etaprim 0 0 33 55-56 38.139 -34.649 -8.357 -13.540 0.918
	35 [r] rho0 0 0 33 57-58 20.117 -18.283 -3.501 -7.575 0.770
	36 [o] pip 0 0 33 [none] 42.391 -38.466 -9.084 -15.325 0.019
	37 [r] rhom 0 0 33 59-60 16.290 -14.665 -4.210 -5.662 0.503
	38 [r] rhop 0 0 33 61-62 26.192 -23.387 -7.143 -9.360 0.426
	39 [r] rho0 0 0 33 63-64 21.662 -19.597 -5.612 -7.289 0.544
	40 [r] rho0 0 0 33 65-66 44.095 -39.445 -12.492 -15.218 0.802
	41 [r] hr3 0 0 17-27 42-54 287.459 -245.557 -141.859 -38.639 717.598
	42 [o] pim 0 0 41 [none] 50.073 -42.296 -26.096 -6.109 0.019
	43 [r] rho0 0 0 41 67-68 79.285 -67.179 -40.977 -9.669 0.519
	44 [o] pip 0 0 41 [none] 31.484 -26.442 -16.506 -4.429 0.019
	45 [r] Delta0 0 0 41 69-70 24.408 -20.833 -12.209 -3.374 1.264
	46 [r] Deltaba 0 0 41 71-72 31.218 -26.353 -16.259 -3.765 1.528
	47 [r] pi0 0 0 41 73-74 19.671 -16.599 -10.127 -2.973 0.018
	48 [o] pip 0 0 41 [none] 8.862 -7.234 -5.067 -0.724 0.019
	49 [r] pi0 0 0 41 75-76 7.275 -6.735 -2.633 -0.782 0.018
	50 [r] kstar0 0 0 41 77-78 6.984 -6.034 -3.255 -0.894 0.973
	51 [r] kstar0 0 0 41 79-80 5.223 -4.652 -1.974 -0.968 0.799
	52 [o] n 0 0 41 [none] 4.766 -4.348 -1.339 -1.064 0.883
	53 [o] nbar 0 0 41 [none] 13.630 -12.712 -3.989 -2.721 0.883
	54 [r] rhom 0 0 41 81-82 4.581 -4.140 -1.430 -1.167 0.444
	55 [o] A 0 0 34 [none] 4.531 -4.053 -0.980 -1.773 0.000
	56 [r] rho0 0 0 34 83-84 33.609 -30.596 -7.377 -11.767 0.545
	57 [o] pim 0 0 35 [none] 7.134 -6.641 -1.153 -2.334 0.019
	58 [o] pip 0 0 35 [none] 12.983 -11.642 -2.348 -5.241 0.019
	59 [o] pim 0 0 37 [none] 14.412 -13.064 -3.642 -4.875 0.019
	60 [r] pi0 0 0 37 85-86 1.878 -1.601 -0.568 -0.787 0.018
	61 [o] pip 0 0 38 [none] 4.723 -4.165 -1.199 -1.870 0.019
	62 [r] pi0 0 0 38 87-88 21.469 -19.222 -5.944 -7.490 0.018
	63 [o] pim 0 0 39 [none] 19.227 -17.344 -5.159 -6.498 0.019
	64 [o] pip 0 0 39 [none] 2.435 -2.253 -0.454 -0.791 0.019
	65 [o] pim 0 0 40 [none] 32.192 -28.967 -8.897 -10.865 0.019
	66 [o] pip 0 0 40 [none] 11.903 -10.478 -3.595 -4.353 0.019
	67 [o] pip 0 0 43 [none] 51.091 -43.124 -26.656 -6.326 0.019
	68 [o] pim 0 0 43 [none] 28.194 -24.054 -14.321 -3.342 0.019
	69 [o] n 0 0 45 [none] 22.258 -18.964 -11.207 -3.053 0.883
	70 [r] pi0 0 0 45 89-90 2.149 -1.869 -1.002 -0.321 0.018
	71 [o] pbar 0 0 46 [none] 27.918 -23.587 -14.563 -3.182 0.880
	72 [r] pi0 0 0 46 91-92 3.300 -2.767 -1.696 -0.583 0.018
	73 [o] A 0 0 47 [none] 17.885 -15.112 -9.182 -2.683 0.000
	74 [o] A 0 0 47 [none] 1.786 -1.487 -0.946 -0.291 0.000
	75 [o] A 0 0 49 [none] 3.061 -2.816 -1.137 -0.386 0.000
	76 [o] A 0 0 49 [none] 4.214 -3.919 -1.496 -0.396 0.000
	77 [o] kp 0 0 50 [none] 4.708 -4.127 -2.020 -0.898 0.244
	78 [o] pim 0 0 50 [none] 2.276 -1.907 -1.235 0.004 0.019
	79 [o] km 0 0 51 [none] 2.026 -1.771 -0.827 -0.208 0.244
	80 [o] pip 0 0 51 [none] 3.196 -2.881 -1.147 -0.760 0.019
	81 [o] pim 0 0 54 [none] 4.138 -3.720 -1.389 -1.158 0.019
	82 [r] pi0 0 0 54 93-94 0.443 -0.420 -0.042 -0.009 0.018
	83 [o] pip 0 0 56 [none] 24.336 -22.276 -5.127 -8.350 0.019
	84 [o] pim 0 0 56 [none] 9.273 -8.320 -2.250 -3.416 0.019
	85 [o] A 0 0 60 [none] 0.180 -0.166 -0.061 -0.038 0.000
	86 [o] A 0 0 60 [none] 1.697 -1.436 -0.508 -0.749 0.000
	87 [o] A 0 0 62 [none] 20.360 -18.239 -5.608 -7.100 0.000
	88 [o] A 0 0 62 [none] 1.110 -0.983 -0.335 -0.390 0.000
	89 [o] A 0 0 70 [none] 0.128 -0.096 -0.084 -0.004 0.000
	90 [o] A 0 0 70 [none] 2.021 -1.773 -0.918 -0.316 0.000
	91 [o] A 0 0 72 [none] 2.425 -2.014 -1.262 -0.482 0.000
	92 [o] A 0 0 72 [none] 0.874 -0.753 -0.433 -0.101 0.000
	93 [o] A 0 0 82 [none] 0.340 -0.336 -0.027 0.048 0.000
	94 [o] A 0 0 82 [none] 0.103 -0.084 -0.015 -0.057 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	------------------------------------------------------------------------
	Hadronization settings:
	------------------------------------------------------------------------
	Master switches:
	active = T
	General settings:
	hadron_method = PYTHIA6
	pT generation parameters
	enhanced_fraction = 1.000000000000E-02
	enhanced_width = 2.000000000000E+00
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.00000E+03
	sqrts_hat* => 1.00000E+03
	n_in* => 2
	n_out* => 46
	n_tot* => 48
	$process_id* => "pythia6_2_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.34324E-03
	sqme_ref* => 2.34324E-03
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02\| 0.0000000E+00\| 1)
	2 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02\| 0.0000000E+00\| 2)
	3 prt(o:22\| 6.0500467E-02; 4.1452364E-02, 2.0063493E-02, 3.9236007E-02\| 0.0000000E+00\| 3)
	4 prt(o:16\| 3.2739891E+02; 2.9915441E+02, 1.2889085E+02, 3.2921620E+01\| 0.0000000E+00\| 4)
	5 prt(o:-211\| 6.1857692E+01; 5.6248840E+01, 2.5026378E+01, 6.0085756E+00\| 1.9479785E-02\| 5)
	6 prt(o:12\| 6.6852895E+01; 4.5946554E+01, 2.2702314E+01, 4.2928181E+01\| 0.0000000E+00\| 6)
	7 prt(o:-11\| 1.6126981E+01; 1.1454746E+01, 5.1378843E+00, 1.0122769E+01\| 0.0000000E+00\| 7)
	8 prt(o:-16\| 3.1357881E+01; 2.1203451E+01, 1.0481893E+01, 2.0587867E+01\| 0.0000000E+00\| 8)
	9 prt(o:211\| 4.2391225E+01;-3.8465739E+01,-9.0840233E+00,-1.5325271E+01\| 1.9479785E-02\| 9)
	10 prt(o:-211\| 5.0073038E+01;-4.2296441E+01,-2.6095533E+01,-6.1093245E+00\| 1.9479785E-02\| 10)
	11 prt(o:211\| 3.1483957E+01;-2.6441683E+01,-1.6505728E+01,-4.4292701E+00\| 1.9479785E-02\| 11)
	12 prt(o:211\| 8.8624859E+00;-7.2338288E+00,-5.0667822E+00,-7.2361353E-01\| 1.9479785E-02\| 12)
	13 prt(o:2112\| 4.7656589E+00;-4.3480447E+00,-1.3386795E+00,-1.0635590E+00\| 8.8279178E-01\| 13)
	14 prt(o:-2112\| 1.3630426E+01;-1.2711749E+01,-3.9888695E+00,-2.7214114E+00\| 8.8279178E-01\| 14)
	15 prt(o:22\| 4.5307400E+00;-4.0525434E+00,-9.8003448E-01,-1.7731412E+00\| 0.0000000E+00\| 15)
	16 prt(o:-211\| 7.1344016E+00;-6.6409569E+00,-1.1533647E+00,-2.3340196E+00\| 1.9479785E-02\| 16)
	17 prt(o:211\| 1.2982558E+01;-1.1642255E+01,-2.3479539E+00,-5.2414077E+00\| 1.9479785E-02\| 17)
	18 prt(o:-211\| 1.4412157E+01;-1.3063731E+01,-3.6417545E+00,-4.8751764E+00\| 1.9479785E-02\| 18)
	19 prt(o:211\| 4.7225021E+00;-4.1652262E+00,-1.1991112E+00,-1.8696442E+00\| 1.9479785E-02\| 19)
	20 prt(o:-211\| 1.9226732E+01;-1.7343932E+01,-5.1589002E+00,-6.4978082E+00\| 1.9479785E-02\| 20)
	21 prt(o:211\| 2.4348381E+00;-2.2534023E+00,-4.5350284E-01,-7.9086671E-01\| 1.9479785E-02\| 21)
	22 prt(o:-211\| 3.2191928E+01;-2.8967020E+01,-8.8971146E+00,-1.0865258E+01\| 1.9479785E-02\| 22)
	23 prt(o:211\| 1.1903075E+01;-1.0478124E+01,-3.5953247E+00,-4.3527328E+00\| 1.9479785E-02\| 23)
	24 prt(o:211\| 5.1091248E+01;-4.3124415E+01,-2.6656283E+01,-6.3264124E+00\| 1.9479785E-02\| 24)
	25 prt(o:-211\| 2.8193730E+01;-2.4054327E+01,-1.4320811E+01,-3.3422455E+00\| 1.9479785E-02\| 25)
	26 prt(o:2112\| 2.2258364E+01;-1.8964077E+01,-1.1206897E+01,-3.0530644E+00\| 8.8279178E-01\| 26)
	27 prt(o:-2212\| 2.7918341E+01;-2.3586778E+01,-1.4563351E+01,-3.1821563E+00\| 8.8035059E-01\| 27)
	28 prt(o:22\| 1.7884900E+01;-1.5111868E+01,-9.1817043E+00,-2.6827979E+00\| 0.0000000E+00\| 28)
	29 prt(o:22\| 1.7862048E+00;-1.4872300E+00,-9.4562707E-01,-2.9062674E-01\| 0.0000000E+00\| 29)
	30 prt(o:22\| 3.0610383E+00;-2.8158026E+00,-1.1367291E+00,-3.8608035E-01\| 0.0000000E+00\| 30)
	31 prt(o:22\| 4.2136505E+00;-3.9192873E+00,-1.4958471E+00,-3.9557344E-01\| 0.0000000E+00\| 31)
	32 prt(o:321\| 4.7076738E+00;-4.1270431E+00,-2.0198137E+00,-8.9800858E-01\| 2.4364096E-01\| 32)
	33 prt(o:-211\| 2.2762584E+00;-1.9070333E+00,-1.2349412E+00, 4.1075117E-03\| 1.9479785E-02\| 33)
	34 prt(o:-321\| 2.0264790E+00;-1.7706275E+00,-8.2737715E-01,-2.0808997E-01\| 2.4364096E-01\| 34)
	35 prt(o:211\| 3.1960232E+00;-2.8813297E+00,-1.1466986E+00,-7.6033305E-01\| 1.9479785E-02\| 35)
	36 prt(o:-211\| 4.1382184E+00;-3.7198534E+00,-1.3885154E+00,-1.1576214E+00\| 1.9479785E-02\| 36)
	37 prt(o:211\| 2.4335933E+01;-2.2275504E+01,-5.1273252E+00,-8.3504857E+00\| 1.9479785E-02\| 37)
	38 prt(o:-211\| 9.2726466E+00;-8.3204979E+00,-2.2495161E+00,-3.4163559E+00\| 1.9479785E-02\| 38)
	39 prt(o:22\| 1.8049505E-01;-1.6562612E-01,-6.0763069E-02,-3.8135315E-02\| 0.0000000E+00\| 39)
	40 prt(o:22\| 1.6971228E+00;-1.4357914E+00,-5.0758408E-01,-7.4905761E-01\| 0.0000000E+00\| 40)
	41 prt(o:22\| 2.0359580E+01;-1.8238639E+01,-5.6084910E+00,-7.0999555E+00\| 0.0000000E+00\| 41)
	42 prt(o:22\| 1.1097667E+00;-9.8340275E-01,-3.3517155E-01,-3.9007849E-01\| 0.0000000E+00\| 42)
	43 prt(o:22\| 1.2774177E-01;-9.6345840E-02,-8.3760620E-02,-4.4270257E-03\| 0.0000000E+00\| 43)
	44 prt(o:22\| 2.0214306E+00;-1.7729522E+00,-9.1802649E-01,-3.1630611E-01\| 0.0000000E+00\| 44)
	45 prt(o:22\| 2.4251749E+00;-2.0137964E+00,-1.2623097E+00,-4.8236064E-01\| 0.0000000E+00\| 45)
	46 prt(o:22\| 8.7448940E-01;-7.5288271E-01,-4.3333545E-01,-1.0059680E-01\| 0.0000000E+00\| 46)
	47 prt(o:22\| 3.4031820E-01;-3.3580095E-01,-2.7119973E-02, 4.8152969E-02\| 0.0000000E+00\| 47)
	48 prt(o:22\| 1.0259288E-01;-8.3864384E-02,-1.4702763E-02,-5.7235411E-02\| 0.0000000E+00\| 48)
	========================================================================
	Contents of pythia6_2c.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.22586E-03
	Squared matrix el. (prc) = 2.22586E-03
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_2_p1'
	TAO random-number generator:
	- seed = 11
	+ seed = 12
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 2 [i] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 3 [o] f(23)
	E = 4.963451E+02
	P = -3.075785E+02 3.444355E+02 1.574893E+02
	T = 8.315287819E+03
	Parents: 1 2
	Particle 4 [o] f(25)
	E = 5.036549E+02
	P = 3.075785E+02 -3.444355E+02 -1.574893E+02
	T = 1.562500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: partonic decays
	========================================================================
	Associated process: 'pythia6_2_p1'
	TAO random-number generator:
	- seed = 12
	- calls = 6
	- Number of tries = 4
	+ seed = 13
	+ calls = 3
	+ Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 2 [i] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 3 [r] f(23)
	E = 4.963451E+02
	P = -3.075785E+02 3.444355E+02 1.574893E+02
	T = 8.315287819E+03
	Parents: 1 2
	Children: 5 6
	Particle 4 [r] f(25)
	E = 5.036549E+02
	P = 3.075785E+02 -3.444355E+02 -1.574893E+02
	T = 1.562500000E+04
	Parents: 1 2
	Children: 7 8
	Particle 5 [o] f(11)
	- E = 4.286745E+02
	- P = -2.605765E+02 2.966668E+02 1.668849E+02
	+ E = 2.266848E+02
	+ P = -1.117798E+02 1.663207E+02 1.059656E+02
	T = 0.000000000E+00
	Parents: 3
	Particle 6 [o] f(-11)
	- E = 6.767062E+01
	- P = -4.700197E+01 4.776873E+01 -9.395555E+00
	+ E = 2.696603E+02
	+ P = -1.957986E+02 1.781148E+02 5.152371E+01
	T = 0.000000000E+00
	Parents: 3
	Particle 7 [o] f(5)c(1 )
	- E = 3.360318E+02
	- P = 2.537060E+02 -2.030459E+02 -8.547143E+01
	+ E = 2.351212E+02
	+ P = 1.859474E+02 -1.400046E+02 -3.296392E+01
	T = 1.764000000E+01
	Parents: 4
	Particle 8 [o] f(-5)c(-1 )
	- E = 1.676230E+02
	- P = 5.387242E+01 -1.413896E+02 -7.201788E+01
	+ E = 2.685337E+02
	+ P = 1.216311E+02 -2.044309E+02 -1.245254E+02
	T = 1.764000000E+01
	Parents: 4
	------------------------------------------------------------------------
	Variable list for simulation: [associated, not shown]
	========================================================================
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_2_p1'
	TAO random-number generator:
	- seed = 15
	+ seed = 16
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	3 [r] Z 0 0 1-2 5-6 496.345 -307.578 344.436 157.489 8315.288
	4 [r] H 0 0 1-2 7-8 503.655 307.578 -344.436 -157.489 15625.000
	- 5 [r] e- 0 0 3 9,12-13 428.675 -260.576 296.667 166.885 0.000
	- 6 [r] e+ 0 0 3 10-11 67.671 -47.002 47.769 -9.396 0.000
	- 7 [r] b 1 0 4 14-16 336.032 253.706 -203.046 -85.471 17.640
	- 8 [r] bbar 0 1 4 17-24 167.623 53.872 -141.390 -72.018 17.640
	- 9 [o] A 0 0 5 [none] 0.000 -0.000 0.000 0.000 0.000
	- 10 [o] e+ 0 0 6 [none] 1.346 -0.935 0.950 -0.187 0.000
	- 11 [o] A 0 0 6 [none] 66.325 -46.067 46.819 -9.208 0.000
	- 12 [o] e- 0 0 5 [none] 428.183 -260.278 296.326 166.693 0.000
	- 13 [o] A 0 0 5 [none] 0.492 -0.299 0.340 0.191 0.000
	- 14 [o] b 500 0 7 [none] 189.605 139.822 -118.028 -49.512 17.640
	- 15 [o] gl 501 500 7 [none] 23.206 17.681 -13.956 -5.581 0.000
	- 16 [o] gl 502 501 7 [none] 93.490 73.190 -53.410 -23.045 0.000
	- 17 [o] gl 503 502 8 [none] 8.624 6.996 -3.641 -3.487 0.000
	- 18 [o] gl 504 503 8 [none] 7.858 5.642 -3.663 -4.062 0.000
	- 19 [o] gl 505 504 8 [none] 2.646 1.658 -1.341 -1.566 0.000
	- 20 [o] gl 506 505 8 [none] 10.964 5.425 -6.843 -6.630 0.000
	- 21 [o] gl 507 506 8 [none] 0.677 0.281 -0.614 0.039 0.000
	- 22 [o] gl 508 507 8 [none] 1.580 0.708 -1.175 -0.784 0.000
	- 23 [o] gl 509 508 8 [none] 3.112 0.873 -2.810 -1.012 0.000
	- 24 [o] bbar 0 509 8 [none] 161.894 55.303 -138.954 -61.849 17.640
	+ 5 [r] e- 0 0 3 9,12-13 226.685 -111.780 166.321 105.966 0.000
	+ 6 [r] e+ 0 0 3 10-11 269.660 -195.799 178.115 51.524 0.000
	+ 7 [r] b 1 0 4 14 235.121 185.947 -140.005 -32.964 17.640
	+ 8 [r] bbar 0 1 4 15-18 268.534 121.631 -204.431 -124.525 17.640
	+ 9 [o] A 0 0 5 [none] 0.152 -0.076 0.113 0.068 0.000
	+ 10 [o] e+ 0 0 6 [none] 248.072 -180.152 163.847 47.321 0.000
	+ 11 [o] A 0 0 6 [none] 21.590 -15.647 14.270 4.204 0.000
	+ 12 [o] e- 0 0 5 [none] 226.530 -111.703 166.206 105.896 0.000
	+ 13 [o] A 0 0 5 [none] 0.000 -0.000 0.000 0.000 0.000
	+ 14 [o] b 500 0 7 [none] 232.918 184.203 -138.693 -32.657 17.640
	+ 15 [o] gl 501 500 8 [none] 1.983 1.330 -1.356 -0.570 0.000
	+ 16 [o] gl 502 501 8 [none] 5.348 3.515 -3.410 -2.150 0.000
	+ 17 [o] gl 503 502 8 [none] 23.350 9.800 -18.368 -10.572 0.000
	+ 18 [o] bbar 0 503 8 [none] 240.056 108.731 -182.608 -111.541 17.640
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.00000E+03
	sqrts_hat* => 1.00000E+03
	n_in* => 2
	-n_out* => 16
	-n_tot* => 18
	+n_out* => 10
	+n_tot* => 12
	$process_id* => "pythia6_2_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.22586E-03
	sqme_ref* => 2.22586E-03
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02\| 0.0000000E+00\| 1)
	2 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02\| 0.0000000E+00\| 2)
	- 3 prt(o:22\| 5.3749927E-05;-3.2910320E-05, 3.6924664E-05, 2.1036508E-05\| 0.0000000E+00\| 3)
	- 4 prt(o:-11\| 1.3457689E+00;-9.3456505E-01, 9.5005716E-01,-1.8727936E-01\| 0.0000000E+00\| 4)
	- 5 prt(o:22\| 6.6324853E+01;-4.6067407E+01, 4.6818669E+01,-9.2082751E+00\| 0.0000000E+00\| 5)
	- 6 prt(o:11\| 4.2818276E+02;-2.6027757E+02, 2.9632645E+02, 1.6669343E+02\| 0.0000000E+00\| 6)
	- 7 prt(o:22\| 4.9170815E-01;-2.9888135E-01, 3.4030369E-01, 1.9141641E-01\| 0.0000000E+00\| 7)
	- 8 prt(o:5\| 1.8960476E+02; 1.3982225E+02,-1.1802793E+02,-4.9512346E+01\| 1.7640000E+01\| 8)
	- 9 prt(o:21\| 2.3206197E+01; 1.7681027E+01,-1.3955699E+01,-5.5809799E+00\| 0.0000000E+00\| 9)
	- 10 prt(o:21\| 9.3490288E+01; 7.3189585E+01,-5.3410199E+01,-2.3044938E+01\| 0.0000000E+00\| 10)
	- 11 prt(o:21\| 8.6235337E+00; 6.9962947E+00,-3.6412368E+00,-3.4869167E+00\| 0.0000000E+00\| 11)
	- 12 prt(o:21\| 7.8582881E+00; 5.6420940E+00,-3.6629679E+00,-4.0622817E+00\| 0.0000000E+00\| 12)
	- 13 prt(o:21\| 2.6455673E+00; 1.6577876E+00,-1.3409211E+00,-1.5661090E+00\| 0.0000000E+00\| 13)
	- 14 prt(o:21\| 1.0963862E+01; 5.4245006E+00,-6.8432461E+00,-6.6295585E+00\| 0.0000000E+00\| 14)
	- 15 prt(o:21\| 6.7680183E-01; 2.8097760E-01,-6.1446077E-01, 3.9373602E-02\| 0.0000000E+00\| 15)
	- 16 prt(o:21\| 1.5799762E+00; 7.0813829E-01,-1.1745334E+00,-7.8443381E-01\| 0.0000000E+00\| 16)
	- 17 prt(o:21\| 3.1117517E+00; 8.7319663E-01,-2.8099043E+00,-1.0124053E+00\| 0.0000000E+00\| 17)
	- 18 prt(o:-5\| 1.6189383E+02; 5.5302611E+01,-1.3895442E+02,-6.1848713E+01\| 1.7640000E+01\| 18)
	+ 3 prt(o:22\| 1.5244097E-01;-7.5912492E-02, 1.1320167E-01, 6.8270968E-02\| 0.0000000E+00\| 3)
	+ 4 prt(o:-11\| 2.4807234E+02;-1.8015234E+02, 1.6384677E+02, 4.7320769E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:22\| 2.1590095E+01;-1.5647210E+01, 1.4269646E+01, 4.2040721E+00\| 0.0000000E+00\| 5)
	+ 6 prt(o:11\| 2.2653007E+02;-1.1170290E+02, 1.6620575E+02, 1.0589610E+02\| 0.0000000E+00\| 6)
	+ 7 prt(o:22\| 1.9580261E-04;-9.5956271E-05, 1.4408524E-04, 9.1490435E-05\| 0.0000000E+00\| 7)
	+ 8 prt(o:5\| 2.3291756E+02; 1.8420268E+02,-1.3869338E+02,-3.2656834E+01\| 1.7640000E+01\| 8)
	+ 9 prt(o:21\| 1.9832767E+00; 1.3304838E+00,-1.3558185E+00,-5.7004865E-01\| 0.0000000E+00\| 9)
	+ 10 prt(o:21\| 5.3482882E+00; 3.5150310E+00,-3.4097792E+00,-2.1499184E+00\| 0.0000000E+00\| 10)
	+ 11 prt(o:21\| 2.3349525E+01; 9.7997584E+00,-1.8368427E+01,-1.0571941E+01\| 0.0000000E+00\| 11)
	+ 12 prt(o:-5\| 2.4005621E+02; 1.0873051E+02,-1.8260811E+02,-1.1154057E+02\| 1.7640000E+01\| 12)
	========================================================================
	Contents of pythia6_2d.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.46579E-03
	Squared matrix el. (prc) = 2.46579E-03
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_2_p1'
	TAO random-number generator:
	- seed = 18
	+ seed = 19
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 2 [i] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 3 [o] f(23)
	E = 4.963451E+02
	P = -4.984482E+01 -4.853193E+02 -4.889900E+00
	T = 8.315287819E+03
	Parents: 1 2
	Particle 4 [o] f(25)
	E = 5.036549E+02
	P = 4.984482E+01 4.853193E+02 4.889900E+00
	T = 1.562500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: partonic decays
	========================================================================
	Associated process: 'pythia6_2_p1'
	TAO random-number generator:
	- seed = 19
	+ seed = 20
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 2 [i] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 3 [r] f(23)
	E = 4.963451E+02
	P = -4.984482E+01 -4.853193E+02 -4.889900E+00
	T = 8.315287819E+03
	Parents: 1 2
	Children: 5 6
	Particle 4 [r] f(25)
	E = 5.036549E+02
	P = 4.984482E+01 4.853193E+02 4.889900E+00
	T = 1.562500000E+04
	Parents: 1 2
	Children: 7 8
	Particle 5 [o] f(11)
	- E = 2.699030E+02
	- P = -5.763599E+00 -2.672518E+02 3.729415E+01
	+ E = 1.652463E+02
	+ P = -5.196004E+01 -1.548443E+02 -2.509479E+01
	T = 0.000000000E+00
	Parents: 3
	Particle 6 [o] f(-11)
	- E = 2.264422E+02
	- P = -4.408122E+01 -2.180674E+02 -4.218405E+01
	+ E = 3.310988E+02
	+ P = 2.115219E+00 -3.304750E+02 2.020489E+01
	T = 0.000000000E+00
	Parents: 3
	Particle 7 [o] f(5)c(1 )
	- E = 1.129729E+02
	- P = 4.203148E+01 9.641316E+01 4.102539E+01
	+ E = 3.461467E+02
	+ P = 1.423050E+01 3.410903E+02 5.705109E+01
	T = 1.764000000E+01
	Parents: 4
	Particle 8 [o] f(-5)c(-1 )
	- E = 3.906820E+02
	- P = 7.813342E+00 3.889061E+02 -3.613549E+01
	+ E = 1.575081E+02
	+ P = 3.561432E+01 1.442290E+02 -5.216119E+01
	T = 1.764000000E+01
	Parents: 4
	------------------------------------------------------------------------
	Variable list for simulation: [associated, not shown]
	========================================================================
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_2_p1'
	TAO random-number generator:
	- seed = 22
	+ seed = 23
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	3 [r] Z 0 0 1-2 5-6 496.345 -49.845 -485.319 -4.890 8315.288
	4 [r] H 0 0 1-2 7-8 503.655 49.845 485.319 4.890 15625.000
	- 5 [r] e- 0 0 3 9 269.903 -5.764 -267.252 37.294 0.000
	- 6 [r] e+ 0 0 3 10-11 226.442 -44.081 -218.067 -42.184 0.000
	- 7 [r] b 1 0 4 12-14 112.973 42.031 96.413 41.025 17.640
	- 8 [r] bbar 0 1 4 15-17 390.682 7.813 388.906 -36.135 17.640
	- 9 [o] e- 0 0 5 [none] 269.895 -5.763 -267.244 37.293 0.000
	- 10 [o] e+ 0 0 6 [none] 203.390 -39.444 -195.896 -37.902 0.000
	- 11 [o] A 0 0 6 [none] 23.060 -4.637 -22.180 -4.280 0.000
	- 12 [o] b 500 0 7 [none] 108.297 38.166 92.947 40.184 17.640
	- 13 [o] gl 501 500 7 [none] 9.780 2.803 9.255 1.460 0.000
	- 14 [o] gl 502 501 7 [none] 3.062 1.077 2.400 -1.567 0.000
	- 15 [o] gl 503 502 8 [none] 0.969 -0.298 0.921 0.023 0.000
	- 16 [o] gl 504 503 8 [none] 44.182 1.221 43.888 -4.939 0.000
	- 17 [o] bbar 0 504 8 [none] 337.365 6.876 335.908 -30.272 17.640
	+ 5 [r] e- 0 0 3 10-12 165.246 -51.960 -154.844 -25.095 0.000
	+ 6 [r] e+ 0 0 3 9 331.099 2.115 -330.475 20.205 0.000
	+ 7 [r] b 1 0 4 13-15 346.147 14.231 341.090 57.051 17.640
	+ 8 [r] bbar 0 1 4 16-25 157.508 35.614 144.229 -52.161 17.640
	+ 9 [o] e+ 0 0 6 [none] 331.099 2.115 -330.475 20.205 0.000
	+ 10 [o] A 0 0 5 [none] 0.048 -0.015 -0.045 -0.008 0.000
	+ 11 [o] e- 0 0 5 [none] 165.198 -51.945 -154.799 -25.087 0.000
	+ 12 [o] A 0 0 5 [none] 0.000 -0.000 -0.000 -0.000 0.000
	+ 13 [o] b 500 0 7 [none] 190.976 6.947 188.117 31.901 17.640
	+ 14 [o] gl 501 500 7 [none] 1.120 0.324 1.050 0.220 0.000
	+ 15 [o] gl 502 501 7 [none] 7.876 1.229 7.779 0.093 0.000
	+ 16 [o] gl 503 502 8 [none] 33.968 1.336 33.770 -3.404 0.000
	+ 17 [o] gl 504 503 8 [none] 29.552 0.478 29.477 -2.049 0.000
	+ 18 [o] gl 505 504 8 [none] 23.858 1.663 23.672 -2.465 0.000
	+ 19 [o] gl 506 505 8 [none] 46.041 7.520 45.369 -2.207 0.000
	+ 20 [o] gl 507 506 8 [none] 56.595 5.842 56.210 -3.057 0.000
	+ 21 [o] gl 508 507 8 [none] 76.502 14.628 75.082 -1.135 0.000
	+ 22 [o] gl 509 508 8 [none] 1.385 -0.507 0.595 -1.143 0.000
	+ 23 [o] gl 510 509 8 [none] 2.796 1.976 1.663 -1.071 0.000
	+ 24 [o] gl 511 510 8 [none] 19.251 13.660 13.143 -3.362 0.000
	+ 25 [o] bbar 0 511 8 [none] 13.735 -5.250 9.394 -7.431 17.640
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	========================================================================
	Event transform: hadronization
	------------------------------------------------------------------------
	Associated process: 'pythia6_2_p1'
	TAO random-number generator:
	- seed = 24
	+ seed = 25
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	3 [r] Z 0 0 1-2 5-6 496.345 -49.845 -485.319 -4.890 8315.288
	4 [r] H 0 0 1-2 7-8 503.655 49.845 485.319 4.890 15625.000
	- 5 [r] e- 0 0 3 9 269.903 -5.764 -267.252 37.294 0.000
	- 6 [r] e+ 0 0 3 10-11 226.442 -44.081 -218.067 -42.184 0.000
	- 7 [r] b 1 0 4 12-14 112.973 42.031 96.413 41.025 17.640
	- 8 [r] bbar 0 1 4 15-17 390.682 7.813 388.906 -36.135 17.640
	- 9 [o] e- 0 0 5 [none] 269.895 -5.763 -267.244 37.293 0.000
	- 10 [o] e+ 0 0 6 [none] 203.390 -39.444 -195.896 -37.902 0.000
	- 11 [o] A 0 0 6 [none] 23.060 -4.637 -22.180 -4.280 0.000
	- 12 [r] b 500 0 7 18 108.297 38.166 92.947 40.184 17.640
	- 13 [r] gl 501 500 7 18 9.780 2.803 9.255 1.460 0.000
	- 14 [r] gl 502 501 7 18 3.062 1.077 2.400 -1.567 0.000
	- 15 [r] gl 503 502 8 18 0.969 -0.298 0.921 0.023 0.000
	- 16 [r] gl 504 503 8 18 44.182 1.221 43.888 -4.939 0.000
	- 17 [r] bbar 0 504 8 18 337.365 6.876 335.908 -30.272 17.640
	- 18 [r] hr3 0 0 12-17 19-28 503.655 49.845 485.319 4.890 15625.000
	- 19 [r] bstarba 0 0 18 29-30 100.492 35.255 86.289 37.169 28.353
	- 20 [r] pi0 0 0 18 31-32 11.190 4.109 9.798 3.511 0.018
	- 21 [r] rhom 0 0 18 33-34 2.803 0.713 2.499 -0.663 0.665
	- 22 [o] kp 0 0 18 [none] 3.629 1.003 3.406 0.569 0.244
	- 23 [r] kstar0 0 0 18 35-36 3.358 0.708 3.109 -0.019 1.110
	- 24 [r] eta 0 0 18 37-39 6.602 -0.201 6.432 -1.371 0.300
	- 25 [o] pim 0 0 18 [none] 10.534 0.805 10.468 -0.847 0.019
	- 26 [r] omega 0 0 18 40-42 5.104 0.082 5.001 -0.641 0.624
	- 27 [o] kp 0 0 18 [none] 28.077 0.465 27.954 -2.532 0.244
	- 28 [r] bstars0 0 0 18 43-44 331.866 6.907 330.364 -30.285 29.336
	- 29 [r] bbar0 0 0 19 45-47 99.196 34.818 85.182 36.655 27.870
	- 30 [o] A 0 0 19 [none] 1.296 0.438 1.106 0.514 0.000
	- 31 [o] A 0 0 20 [none] 0.984 0.367 0.872 0.272 0.000
	- 32 [o] A 0 0 20 [none] 10.206 3.742 8.926 3.238 0.000
	- 33 [o] pim 0 0 21 [none] 1.278 0.637 0.994 -0.469 0.019
	- 34 [r] pi0 0 0 21 48-49 1.525 0.076 1.505 -0.194 0.018
	- 35 [o] km 0 0 23 [none] 3.120 0.743 2.986 -0.163 0.244
	- 36 [o] pip 0 0 23 [none] 0.238 -0.035 0.123 0.144 0.019
	- 37 [o] A 0 0 24 [none] 0.611 -0.007 0.562 -0.239 0.000
	- 38 [o] pip 0 0 24 [none] 3.326 -0.046 3.277 -0.548 0.019
	- 39 [o] pim 0 0 24 [none] 2.665 -0.148 2.592 -0.583 0.019
	- 40 [o] pip 0 0 26 [none] 1.752 0.078 1.736 -0.171 0.019
	- 41 [o] pim 0 0 26 [none] 3.086 -0.057 3.043 -0.486 0.019
	- 42 [r] pi0 0 0 26 50-51 0.267 0.060 0.222 0.015 0.018
	- 43 [r] bs0 0 0 28 52-53 329.641 6.819 328.153 -30.064 28.829
	- 44 [o] A 0 0 28 [none] 2.224 0.088 2.212 -0.220 0.000
	- 45 [r] dstarp 0 0 29 54-55 55.066 17.533 47.576 21.386 4.040
	- 46 [r] pi0 0 0 29 56-57 11.554 4.606 9.704 4.253 0.018
	- 47 [r] rhom 0 0 29 58-59 32.576 12.678 27.903 11.016 0.530
	- 48 [o] A 0 0 34 [none] 0.614 0.083 0.607 -0.038 0.000
	- 49 [o] A 0 0 34 [none] 0.912 -0.007 0.898 -0.157 0.000
	- 50 [o] A 0 0 42 [none] 0.070 -0.042 0.055 -0.009 0.000
	- 51 [o] A 0 0 42 [none] 0.197 0.102 0.166 0.024 0.000
	- 52 [r] dsp 0 0 43 60-62 63.402 0.495 63.161 -5.143 3.875
	- 53 [r] a1m 0 0 43 63-64 266.239 6.324 264.992 -24.921 1.409
	- 54 [r] d0 0 0 45 65-66 51.445 16.349 44.450 20.001 3.476
	- 55 [o] pip 0 0 45 [none] 3.620 1.184 3.125 1.385 0.019
	- 56 [o] A 0 0 46 [none] 5.159 2.107 4.297 1.926 0.000
	- 57 [o] A 0 0 46 [none] 6.395 2.500 5.407 2.327 0.000
	- 58 [o] pim 0 0 47 [none] 10.890 4.224 9.215 3.976 0.019
	- 59 [r] pi0 0 0 47 67-68 21.686 8.454 18.688 7.040 0.018
	- 60 [o] e+ 0 0 52 [none] 5.494 0.218 5.487 -0.157 0.000
	- 61 [o] nue 0 0 52 [none] 27.435 0.483 27.369 -1.828 0.000
	- 62 [r] eta 0 0 52 69-70 30.474 -0.206 30.304 -3.159 0.300
	- 63 [r] rhom 0 0 53 71-72 181.799 4.063 180.934 -17.229 0.576
	- 64 [r] pi0 0 0 53 73-74 84.439 2.261 84.058 -7.692 0.018
	- 65 [r] kstarm 0 0 54 75-76 33.579 10.093 29.268 12.964 1.058
	- 66 [o] pip 0 0 54 [none] 17.866 6.256 15.183 7.037 0.019
	- 67 [o] A 0 0 59 [none] 7.854 3.062 6.745 2.610 0.000
	- 68 [o] A 0 0 59 [none] 13.832 5.392 11.943 4.430 0.000
	- 69 [o] A 0 0 62 [none] 4.843 -0.233 4.811 -0.501 0.000
	- 70 [o] A 0 0 62 [none] 25.631 0.027 25.493 -2.657 0.000
	- 71 [o] pim 0 0 63 [none] 67.614 1.676 67.316 -6.112 0.019
	- 72 [r] pi0 0 0 63 77-78 114.186 2.387 113.618 -11.117 0.018
	- 73 [o] A 0 0 64 [none] 2.165 0.042 2.154 -0.212 0.000
	- 74 [o] A 0 0 64 [none] 82.275 2.219 81.904 -7.481 0.000
	- 75 [r] k0 0 0 65 79 23.487 6.926 20.650 8.776 0.248
	- 76 [o] pim 0 0 65 [none] 10.092 3.167 8.618 4.187 0.019
	- 77 [o] A 0 0 72 [none] 7.836 0.164 7.800 -0.729 0.000
	- 78 [o] A 0 0 72 [none] 106.349 2.223 105.817 -10.388 0.000
	- 79 [o] kL0 0 0 75 [none] 23.487 6.926 20.650 8.776 0.248
	+ 5 [r] e- 0 0 3 10-12 165.246 -51.960 -154.844 -25.095 0.000
	+ 6 [r] e+ 0 0 3 9 331.099 2.115 -330.475 20.205 0.000
	+ 7 [r] b 1 0 4 13-15 346.147 14.231 341.090 57.051 17.640
	+ 8 [r] bbar 0 1 4 16-25 157.508 35.614 144.229 -52.161 17.640
	+ 9 [o] e+ 0 0 6 [none] 331.099 2.115 -330.475 20.205 0.000
	+ 10 [o] A 0 0 5 [none] 0.048 -0.015 -0.045 -0.008 0.000
	+ 11 [o] e- 0 0 5 [none] 165.198 -51.945 -154.799 -25.087 0.000
	+ 12 [o] A 0 0 5 [none] 0.000 -0.000 -0.000 -0.000 0.000
	+ 13 [r] b 500 0 7 26 190.976 6.947 188.117 31.901 17.640
	+ 14 [r] gl 501 500 7 26 1.120 0.324 1.050 0.220 0.000
	+ 15 [r] gl 502 501 7 26 7.876 1.229 7.779 0.093 0.000
	+ 16 [r] gl 503 502 8 26 33.968 1.336 33.770 -3.404 0.000
	+ 17 [r] gl 504 503 8 26 29.552 0.478 29.477 -2.049 0.000
	+ 18 [r] gl 505 504 8 26 23.858 1.663 23.672 -2.465 0.000
	+ 19 [r] gl 506 505 8 26 46.041 7.520 45.369 -2.207 0.000
	+ 20 [r] gl 507 506 8 26 56.595 5.842 56.210 -3.057 0.000
	+ 21 [r] gl 508 507 8 26 76.502 14.628 75.082 -1.135 0.000
	+ 22 [r] gl 509 508 8 26 1.385 -0.507 0.595 -1.143 0.000
	+ 23 [r] gl 510 509 8 26 2.796 1.976 1.663 -1.071 0.000
	+ 24 [r] gl 511 510 8 26 19.251 13.660 13.143 -3.362 0.000
	+ 25 [r] bbar 0 511 8 26 13.735 -5.250 9.394 -7.431 17.640
	+ 26 [r] hr3 0 0 13-25 27-50 503.655 49.845 485.319 4.890 15625.000
	+ 27 [r] bstarba 0 0 26 51-52 182.134 7.359 179.321 30.567 28.353
	+ 28 [o] kp 0 0 26 [none] 14.161 0.077 14.144 0.470 0.244
	+ 29 [r] kstar0 0 0 26 53-54 6.632 0.917 6.494 0.417 0.790
	+ 30 [r] eta 0 0 26 55-57 9.926 0.099 9.801 -1.463 0.300
	+ 31 [r] rhom 0 0 26 58-59 13.426 0.886 13.380 -0.150 0.437
	+ 32 [r] rho0 0 0 26 60-61 14.206 1.368 14.056 -1.209 0.909
	+ 33 [r] kstarp 0 0 26 62-63 31.108 0.912 30.934 -3.042 0.732
	+ 34 [o] km 0 0 26 [none] 13.350 1.145 13.278 -0.596 0.244
	+ 35 [r] pi0 0 0 26 64-65 0.453 -0.036 0.430 0.020 0.018
	+ 36 [r] lambda 0 0 26 66-67 44.894 4.826 44.543 -2.619 1.245
	+ 37 [r] lambdab 0 0 26 68-69 28.895 4.695 28.447 -1.546 1.245
	+ 38 [r] rho0 0 0 26 70-71 29.205 4.755 28.799 -0.600 0.578
	+ 39 [r] rhop 0 0 26 72-73 21.960 3.884 21.576 -0.975 0.651
	+ 40 [r] rhom 0 0 26 74-75 16.053 1.716 15.909 -0.915 0.803
	+ 41 [o] kp 0 0 26 [none] 29.164 5.381 28.658 0.213 0.244
	+ 42 [r] kstar0 0 0 26 76-77 8.106 1.373 7.901 -0.645 0.991
	+ 43 [o] p 0 0 26 [none] 1.506 0.096 1.135 -0.301 0.880
	+ 44 [o] pim 0 0 26 [none] 3.168 1.171 2.887 -0.559 0.019
	+ 45 [o] pbar 0 0 26 [none] 1.956 0.937 1.405 -0.304 0.880
	+ 46 [r] omega 0 0 26 78-80 7.354 4.963 5.171 -1.452 0.597
	+ 47 [o] p 0 0 26 [none] 1.851 0.731 0.751 -1.203 0.880
	+ 48 [r] lambdab 0 0 26 81-82 6.679 4.783 4.346 -1.260 1.245
	+ 49 [r] kstarm 0 0 26 83-84 4.218 2.471 3.135 -1.049 0.760
	+ 50 [r] bstarP 0 0 26 85-86 13.251 -4.665 8.817 -6.909 28.353
	+ 51 [r] bbarM 0 0 27 87-90 180.401 7.309 177.607 30.316 27.867
	+ 52 [o] A 0 0 27 [none] 1.733 0.050 1.714 0.251 0.000
	+ 53 [o] km 0 0 29 [none] 5.207 0.971 5.084 0.280 0.244
	+ 54 [o] pip 0 0 29 [none] 1.425 -0.054 1.410 0.137 0.019
	+ 55 [o] A 0 0 30 [none] 2.197 -0.174 2.180 -0.213 0.000
	+ 56 [o] e- 0 0 30 [none] 4.237 0.140 4.184 -0.652 0.000
	+ 57 [o] e+ 0 0 30 [none] 3.492 0.132 3.438 -0.597 0.000
	+ 58 [o] pim 0 0 31 [none] 4.570 0.043 4.567 0.058 0.019
	+ 59 [r] pi0 0 0 31 91-92 8.856 0.844 8.812 -0.208 0.018
	+ 60 [o] pim 0 0 32 [none] 1.223 0.232 1.189 0.092 0.019
	+ 61 [o] pip 0 0 32 [none] 12.983 1.136 12.867 -1.301 0.019
	+ 62 [r] k0 0 0 33 93 20.591 0.358 20.491 -1.932 0.248
	+ 63 [o] pip 0 0 33 [none] 10.517 0.554 10.442 -1.110 0.019
	+ 64 [o] A 0 0 35 [none] 0.053 -0.021 0.034 -0.034 0.000
	+ 65 [o] A 0 0 35 [none] 0.400 -0.015 0.396 0.055 0.000
	+ 66 [o] n 0 0 36 [none] 40.096 4.390 39.778 -2.296 0.883
	+ 67 [r] pi0 0 0 36 94-95 4.798 0.436 4.765 -0.323 0.018
	+ 68 [o] pbar 0 0 37 [none] 21.842 3.542 21.501 -1.169 0.880
	+ 69 [o] pip 0 0 37 [none] 7.053 1.153 6.947 -0.377 0.019
	+ 70 [o] pim 0 0 38 [none] 27.447 4.388 27.089 -0.486 0.019
	+ 71 [o] pip 0 0 38 [none] 1.757 0.367 1.709 -0.114 0.019
	+ 72 [o] pip 0 0 39 [none] 8.047 1.746 7.852 -0.199 0.019
	+ 73 [r] pi0 0 0 39 96-97 13.912 2.138 13.725 -0.776 0.018
	+ 74 [o] pim 0 0 40 [none] 4.927 0.772 4.829 -0.579 0.019
	+ 75 [r] pi0 0 0 40 98-99 11.126 0.944 11.080 -0.336 0.018
	+ 76 [r] k0 0 0 42 100 4.124 0.385 4.049 -0.462 0.248
	+ 77 [r] pi0 0 0 42 101-102 3.983 0.987 3.852 -0.183 0.018
	+ 78 [o] pip 0 0 46 [none] 4.133 2.935 2.786 -0.827 0.019
	+ 79 [o] pim 0 0 46 [none] 0.429 0.239 0.324 -0.055 0.019
	+ 80 [r] pi0 0 0 46 103-104 2.791 1.789 2.061 -0.570 0.018
	+ 81 [o] pbar 0 0 48 [none] 6.121 4.371 4.001 -1.213 0.880
	+ 82 [o] pip 0 0 48 [none] 0.558 0.413 0.345 -0.047 0.019
	+ 83 [o] km 0 0 49 [none] 2.591 1.730 1.783 -0.545 0.244
	+ 84 [r] pi0 0 0 49 105-106 1.628 0.742 1.352 -0.504 0.018
	+ 85 [r] bP 0 0 50 107-111 13.195 -4.680 8.788 -6.864 27.867
	+ 86 [o] A 0 0 50 [none] 0.056 0.015 0.029 -0.045 0.000
	+ 87 [r] dstar0 0 0 51 112-113 115.135 4.977 113.623 17.803 4.027
	+ 88 [o] km 0 0 51 [none] 15.254 0.325 14.972 2.860 0.244
	+ 89 [r] k0 0 0 51 114 24.416 0.855 23.967 4.559 0.248
	+ 90 [r] omega 0 0 51 115-117 25.595 1.152 25.044 5.094 0.620
	+ 91 [o] A 0 0 59 [none] 3.294 0.260 3.282 -0.114 0.000
	+ 92 [o] A 0 0 59 [none] 5.562 0.583 5.531 -0.093 0.000
	+ 93 [o] kL0 0 0 62 [none] 20.591 0.358 20.491 -1.932 0.248
	+ 94 [o] A 0 0 67 [none] 1.438 0.069 1.434 -0.094 0.000
	+ 95 [o] A 0 0 67 [none] 3.359 0.367 3.331 -0.228 0.000
	+ 96 [o] A 0 0 73 [none] 12.346 1.855 12.187 -0.688 0.000
	+ 97 [o] A 0 0 73 [none] 1.566 0.283 1.538 -0.088 0.000
	+ 98 [o] A 0 0 75 [none] 6.816 0.528 6.793 -0.164 0.000
	+ 99 [o] A 0 0 75 [none] 4.310 0.416 4.287 -0.172 0.000
	+ 100 [r] kS0 0 0 76 118-119 4.124 0.385 4.049 -0.462 0.248
	+ 101 [o] A 0 0 77 [none] 1.180 0.291 1.137 -0.116 0.000
	+ 102 [o] A 0 0 77 [none] 2.803 0.696 2.714 -0.067 0.000
	+ 103 [o] A 0 0 80 [none] 1.117 0.687 0.862 -0.182 0.000
	+ 104 [o] A 0 0 80 [none] 1.674 1.102 1.198 -0.388 0.000
	+ 105 [o] A 0 0 84 [none] 0.116 0.052 0.104 -0.002 0.000
	+ 106 [o] A 0 0 84 [none] 1.512 0.690 1.248 -0.502 0.000
	+ 107 [r] dstar0 0 0 85 120-121 5.694 -3.296 3.263 -2.624 4.027
	+ 108 [r] rho0 0 0 85 122-123 2.905 -0.387 2.287 -1.448 0.960
	+ 109 [r] rhop 0 0 85 124-125 2.778 -0.380 2.005 -1.680 0.732
	+ 110 [o] pim 0 0 85 [none] 0.976 -0.238 0.616 -0.705 0.019
	+ 111 [o] pip 0 0 85 [none] 0.841 -0.378 0.616 -0.407 0.019
	+ 112 [r] d0 0 0 87 126-130 105.809 4.563 104.425 16.325 3.476
	+ 113 [r] pi0 0 0 87 131-132 9.326 0.414 9.198 1.478 0.018
	+ 114 [r] kS0 0 0 89 133-134 24.416 0.855 23.967 4.559 0.248
	+ 115 [o] pip 0 0 90 [none] 1.860 0.027 1.829 0.309 0.019
	+ 116 [o] pim 0 0 90 [none] 3.362 0.197 3.300 0.594 0.019
	+ 117 [r] pi0 0 0 90 135-136 20.373 0.928 19.916 4.191 0.018
	+ 118 [o] pip 0 0 100 [none] 1.967 -0.011 1.956 -0.158 0.019
	+ 119 [o] pim 0 0 100 [none] 2.157 0.396 2.093 -0.304 0.019
	+ 120 [r] dbar0 0 0 107 137-138 5.222 -3.031 2.996 -2.373 3.476
	+ 121 [r] pi0 0 0 107 139-140 0.473 -0.265 0.267 -0.252 0.018
	+ 122 [o] pim 0 0 108 [none] 1.902 -0.191 1.319 -1.350 0.019
	+ 123 [o] pip 0 0 108 [none] 1.003 -0.196 0.969 -0.098 0.019
	+ 124 [o] pip 0 0 109 [none] 0.738 -0.263 0.272 -0.618 0.019
	+ 125 [r] pi0 0 0 109 141-142 2.041 -0.118 1.734 -1.062 0.018
	+ 126 [r] k0 0 0 112 143 28.250 1.334 27.853 4.504 0.248
	+ 127 [o] pip 0 0 112 [none] 10.271 0.598 10.075 1.900 0.019
	+ 128 [o] pim 0 0 112 [none] 12.799 0.450 12.637 1.974 0.019
	+ 129 [r] pi0 0 0 112 144-145 23.572 0.876 23.302 3.449 0.018
	+ 130 [r] pi0 0 0 112 146-147 30.916 1.305 30.559 4.498 0.018
	+ 131 [o] A 0 0 113 [none] 3.333 0.099 3.296 0.486 0.000
	+ 132 [o] A 0 0 113 [none] 5.993 0.315 5.902 0.991 0.000
	+ 133 [o] pip 0 0 114 [none] 13.285 0.307 13.022 2.609 0.019
	+ 134 [o] pim 0 0 114 [none] 11.132 0.548 10.945 1.949 0.019
	+ 135 [o] A 0 0 117 [none] 3.736 0.160 3.663 0.718 0.000
	+ 136 [o] A 0 0 117 [none] 16.637 0.768 16.253 3.472 0.000
	+ 137 [r] kstarp 0 0 120 148-149 4.370 -2.405 2.960 -1.938 0.790
	+ 138 [r] rhom 0 0 120 150-151 0.852 -0.626 0.035 -0.434 0.144
	+ 139 [o] A 0 0 121 [none] 0.116 -0.062 0.097 -0.013 0.000
	+ 140 [o] A 0 0 121 [none] 0.357 -0.202 0.171 -0.239 0.000
	+ 141 [o] A 0 0 125 [none] 1.187 -0.026 0.984 -0.663 0.000
	+ 142 [o] A 0 0 125 [none] 0.854 -0.092 0.750 -0.399 0.000
	+ 143 [r] kS0 0 0 126 152-153 28.250 1.334 27.853 4.504 0.248
	+ 144 [o] A 0 0 129 [none] 13.168 0.484 13.007 1.993 0.000
	+ 145 [o] A 0 0 129 [none] 10.404 0.392 10.294 1.456 0.000
	+ 146 [o] A 0 0 130 [none] 2.137 0.056 2.113 0.316 0.000
	+ 147 [o] A 0 0 130 [none] 28.779 1.249 28.447 4.182 0.000
	+ 148 [r] k0 0 0 137 154 3.103 -1.837 2.170 -1.140 0.248
	+ 149 [o] pip 0 0 137 [none] 1.267 -0.568 0.791 -0.798 0.019
	+ 150 [o] pim 0 0 138 [none] 0.401 -0.246 -0.084 -0.271 0.019
	+ 151 [r] pi0 0 0 138 155-156 0.451 -0.380 0.119 -0.163 0.018
	+ 152 [r] pi0 0 0 143 157-158 25.105 1.261 24.747 4.026 0.018
	+ 153 [r] pi0 0 0 143 159-160 3.146 0.073 3.105 0.478 0.018
	+ 154 [r] kS0 0 0 148 161-162 3.103 -1.837 2.170 -1.140 0.248
	+ 155 [o] A 0 0 151 [none] 0.319 -0.251 0.138 -0.140 0.000
	+ 156 [o] A 0 0 151 [none] 0.132 -0.129 -0.019 -0.023 0.000
	+ 157 [o] A 0 0 152 [none] 15.450 0.712 15.236 2.462 0.000
	+ 158 [o] A 0 0 152 [none] 9.655 0.548 9.511 1.564 0.000
	+ 159 [o] A 0 0 153 [none] 2.857 0.079 2.816 0.471 0.000
	+ 160 [o] A 0 0 153 [none] 0.289 -0.007 0.289 0.007 0.000
	+ 161 [o] pip 0 0 154 [none] 1.497 -0.770 1.191 -0.460 0.019
	+ 162 [o] pim 0 0 154 [none] 1.606 -1.067 0.979 -0.680 0.019
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	------------------------------------------------------------------------
	Hadronization settings:
	------------------------------------------------------------------------
	Master switches:
	active = T
	General settings:
	hadron_method = PYTHIA6
	pT generation parameters
	enhanced_fraction = 1.000000000000E-02
	enhanced_width = 2.000000000000E+00
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.00000E+03
	sqrts_hat* => 1.00000E+03
	n_in* => 2
	-n_out* => 40
	-n_tot* => 42
	+n_out* => 87
	+n_tot* => 89
	$process_id* => "pythia6_2_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.46579E-03
	sqme_ref* => 2.46579E-03
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02\| 0.0000000E+00\| 1)
	2 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02\| 0.0000000E+00\| 2)
	- 3 prt(o:11\| 2.6989484E+02;-5.7634248E+00,-2.6724378E+02, 3.7293025E+01\| 0.0000000E+00\| 3)
	- 4 prt(o:-11\| 2.0339007E+02;-3.9444312E+01,-1.9589556E+02,-3.7902443E+01\| 0.0000000E+00\| 4)
	- 5 prt(o:22\| 2.3060231E+01;-4.6370852E+00,-2.2179927E+01,-4.2804824E+00\| 0.0000000E+00\| 5)
	- 6 prt(o:321\| 3.6290965E+00; 1.0027391E+00, 3.4055857E+00, 5.6850741E-01\| 2.4364096E-01\| 6)
	- 7 prt(o:-211\| 1.0534366E+01; 8.0512847E-01, 1.0468383E+01,-8.4741344E-01\| 1.9479785E-02\| 7)
	- 8 prt(o:321\| 2.8076779E+01; 4.6524085E-01, 2.7954137E+01,-2.5321301E+00\| 2.4364096E-01\| 8)
	- 9 prt(o:22\| 1.2958988E+00; 4.3762382E-01, 1.1062756E+00, 5.1380271E-01\| 0.0000000E+00\| 9)
	- 10 prt(o:22\| 9.8414597E-01; 3.6691890E-01, 8.7165664E-01, 2.7226548E-01\| 0.0000000E+00\| 10)
	- 11 prt(o:22\| 1.0206106E+01; 3.7419944E+00, 8.9260873E+00, 3.2383714E+00\| 0.0000000E+00\| 11)
	- 12 prt(o:-211\| 1.2781565E+00; 6.3709866E-01, 9.9429298E-01,-4.6871202E-01\| 1.9479785E-02\| 12)
	- 13 prt(o:-321\| 3.1204175E+00; 7.4269454E-01, 2.9858544E+00,-1.6261266E-01\| 2.4364096E-01\| 13)
	- 14 prt(o:211\| 2.3763955E-01;-3.5096244E-02, 1.2309381E-01, 1.4355814E-01\| 1.9479785E-02\| 14)
	- 15 prt(o:22\| 6.1104191E-01;-6.9503813E-03, 5.6211037E-01,-2.3949081E-01\| 0.0000000E+00\| 15)
	- 16 prt(o:211\| 3.3261945E+00;-4.6499824E-02, 3.2774356E+00,-5.4803620E-01\| 1.9479785E-02\| 16)
	- 17 prt(o:-211\| 2.6646489E+00;-1.4803661E-01, 2.5920570E+00,-5.8326646E-01\| 1.9479785E-02\| 17)
	- 18 prt(o:211\| 1.7516623E+00; 7.8174092E-02, 1.7359754E+00,-1.7064444E-01\| 1.9479785E-02\| 18)
	- 19 prt(o:-211\| 3.0855374E+00;-5.6809985E-02, 3.0433435E+00,-4.8568927E-01\| 1.9479785E-02\| 19)
	- 20 prt(o:22\| 2.2243226E+00; 8.8357560E-02, 2.2116122E+00,-2.2039834E-01\| 0.0000000E+00\| 20)
	- 21 prt(o:22\| 6.1365032E-01; 8.3014137E-02, 6.0683170E-01,-3.7823967E-02\| 0.0000000E+00\| 21)
	- 22 prt(o:22\| 9.1161818E-01;-7.0144564E-03, 8.9805287E-01,-1.5652328E-01\| 0.0000000E+00\| 22)
	- 23 prt(o:22\| 7.0138226E-02;-4.2166088E-02, 5.5363945E-02,-8.7307204E-03\| 0.0000000E+00\| 23)
	- 24 prt(o:22\| 1.9657475E-01; 1.0231248E-01, 1.6615922E-01, 2.3767681E-02\| 0.0000000E+00\| 24)
	- 25 prt(o:211\| 3.6204129E+00; 1.1837251E+00, 3.1253410E+00, 1.3852611E+00\| 1.9479785E-02\| 25)
	- 26 prt(o:22\| 5.1589138E+00; 2.1068279E+00, 4.2971723E+00, 1.9261304E+00\| 0.0000000E+00\| 26)
	- 27 prt(o:22\| 6.3949863E+00; 2.4996106E+00, 5.4066680E+00, 2.3271736E+00\| 0.0000000E+00\| 27)
	- 28 prt(o:-211\| 1.0890062E+01; 4.2243383E+00, 9.2153726E+00, 3.9756566E+00\| 1.9479785E-02\| 28)
	- 29 prt(o:-11\| 5.4937601E+00; 2.1752503E-01, 5.4872154E+00,-1.5668383E-01\| 0.0000000E+00\| 29)
	- 30 prt(o:12\| 2.7434507E+01; 4.8328539E-01, 2.7369278E+01,-1.8278980E+00\| 0.0000000E+00\| 30)
	- 31 prt(o:211\| 1.7866101E+01; 6.2563737E+00, 1.5182583E+01, 7.0374034E+00\| 1.9479785E-02\| 31)
	- 32 prt(o:22\| 7.8538202E+00; 3.0619116E+00, 6.7448957E+00, 2.6102818E+00\| 0.0000000E+00\| 32)
	- 33 prt(o:22\| 1.3831960E+01; 5.3920717E+00, 1.1942619E+01, 4.4297330E+00\| 0.0000000E+00\| 33)
	- 34 prt(o:22\| 4.8429791E+00;-2.3285538E-01, 4.8113327E+00,-5.0130061E-01\| 0.0000000E+00\| 34)
	- 35 prt(o:22\| 2.5631189E+01; 2.6702728E-02, 2.5493046E+01,-2.6573920E+00\| 0.0000000E+00\| 35)
	- 36 prt(o:-211\| 6.7613816E+01; 1.6764270E+00, 6.7316010E+01,-6.1117066E+00\| 1.9479785E-02\| 36)
	- 37 prt(o:22\| 2.1646999E+00; 4.2284936E-02, 2.1539148E+00,-2.1163354E-01\| 0.0000000E+00\| 37)
	- 38 prt(o:22\| 8.2274695E+01; 2.2185511E+00, 8.1903879E+01,-7.4805051E+00\| 0.0000000E+00\| 38)
	- 39 prt(o:-211\| 1.0092040E+01; 3.1668748E+00, 8.6178502E+00, 4.1872846E+00\| 1.9479785E-02\| 39)
	- 40 prt(o:22\| 7.8362006E+00; 1.6392412E-01, 7.8004990E+00,-7.2896105E-01\| 0.0000000E+00\| 40)
	- 41 prt(o:22\| 1.0634939E+02; 2.2226563E+00, 1.0581748E+02,-1.0388126E+01\| 0.0000000E+00\| 41)
	- 42 prt(o:130\| 2.3487327E+01; 6.9258638E+00, 2.0649804E+01, 8.7763805E+00\| 2.4767543E-01\| 42)
	+ 3 prt(o:-11\| 3.3109881E+02; 2.1152189E+00,-3.3047498E+02, 2.0204894E+01\| 0.0000000E+00\| 3)
	+ 4 prt(o:22\| 4.8388393E-02;-1.5149688E-02,-4.5329436E-02,-7.5608013E-03\| 0.0000000E+00\| 4)
	+ 5 prt(o:11\| 1.6519791E+02;-5.1944882E+01,-1.5479894E+02,-2.5087228E+01\| 0.0000000E+00\| 5)
	+ 6 prt(o:22\| 3.0699414E-05;-9.6116954E-06,-2.8779838E-05,-4.6680039E-06\| 0.0000000E+00\| 6)
	+ 7 prt(o:321\| 1.4160649E+01; 7.6828395E-02, 1.4144017E+01, 4.7031391E-01\| 2.4364096E-01\| 7)
	+ 8 prt(o:-321\| 1.3349618E+01; 1.1446294E+00, 1.3277931E+01,-5.9585666E-01\| 2.4364096E-01\| 8)
	+ 9 prt(o:321\| 2.9164002E+01; 5.3809019E+00, 2.8658259E+01, 2.1323435E-01\| 2.4364096E-01\| 9)
	+ 10 prt(o:2212\| 1.5063374E+00; 9.5681132E-02, 1.1353571E+00,-3.0085076E-01\| 8.8035059E-01\| 10)
	+ 11 prt(o:-211\| 3.1681364E+00; 1.1708063E+00, 2.8868622E+00,-5.5932824E-01\| 1.9479785E-02\| 11)
	+ 12 prt(o:-2212\| 1.9560137E+00; 9.3714573E-01, 1.4052918E+00,-3.0422342E-01\| 8.8035059E-01\| 12)
	+ 13 prt(o:2212\| 1.8507792E+00; 7.3127088E-01, 7.5083147E-01,-1.2027169E+00\| 8.8035059E-01\| 13)
	+ 14 prt(o:22\| 1.7328623E+00; 4.9675587E-02, 1.7138760E+00, 2.5094447E-01\| 0.0000000E+00\| 14)
	+ 15 prt(o:-321\| 5.2068891E+00; 9.7106918E-01, 5.0839363E+00, 2.8048188E-01\| 2.4364096E-01\| 15)
	+ 16 prt(o:211\| 1.4249777E+00;-5.4205367E-02, 1.4104799E+00, 1.3671148E-01\| 1.9479785E-02\| 16)
	+ 17 prt(o:22\| 2.1972063E+00;-1.7370210E-01, 2.1799419E+00,-2.1306465E-01\| 0.0000000E+00\| 17)
	+ 18 prt(o:11\| 4.2368956E+00; 1.4046514E-01, 4.1840137E+00,-6.5236735E-01\| 0.0000000E+00\| 18)
	+ 19 prt(o:-11\| 3.4915257E+00; 1.3196199E-01, 3.4375426E+00,-5.9719201E-01\| 0.0000000E+00\| 19)
	+ 20 prt(o:-211\| 4.5698893E+00; 4.2563748E-02, 4.5671952E+00, 5.7658180E-02\| 1.9479785E-02\| 20)
	+ 21 prt(o:-211\| 1.2230575E+00; 2.3205512E-01, 1.1891282E+00, 9.2273426E-02\| 1.9479785E-02\| 21)
	+ 22 prt(o:211\| 1.2983000E+01; 1.1363569E+00, 1.2866786E+01,-1.3012774E+00\| 1.9479785E-02\| 22)
	+ 23 prt(o:211\| 1.0516788E+01; 5.5394625E-01, 1.0442407E+01,-1.1102466E+00\| 1.9479785E-02\| 23)
	+ 24 prt(o:22\| 5.2843382E-02;-2.0895056E-02, 3.4320972E-02,-3.4320410E-02\| 0.0000000E+00\| 24)
	+ 25 prt(o:22\| 4.0007521E-01;-1.5185981E-02, 3.9602536E-01, 5.4712638E-02\| 0.0000000E+00\| 25)
	+ 26 prt(o:2112\| 4.0096485E+01; 4.3895169E+00, 3.9778180E+01,-2.2964961E+00\| 8.8279178E-01\| 26)
	+ 27 prt(o:-2212\| 2.1842199E+01; 3.5421763E+00, 2.1500885E+01,-1.1688633E+00\| 8.8035059E-01\| 27)
	+ 28 prt(o:211\| 7.0530403E+00; 1.1531435E+00, 6.9465044E+00,-3.7713951E-01\| 1.9479785E-02\| 28)
	+ 29 prt(o:-211\| 2.7447231E+01; 4.3880469E+00, 2.7089487E+01,-4.8551006E-01\| 1.9479785E-02\| 29)
	+ 30 prt(o:211\| 1.7574744E+00; 3.6704795E-01, 1.7092407E+00,-1.1405464E-01\| 1.9479785E-02\| 30)
	+ 31 prt(o:211\| 8.0471612E+00; 1.7458065E+00, 7.8517324E+00,-1.9945332E-01\| 1.9479785E-02\| 31)
	+ 32 prt(o:-211\| 4.9267081E+00; 7.7201003E-01, 4.8293157E+00,-5.7851814E-01\| 1.9479785E-02\| 32)
	+ 33 prt(o:211\| 4.1330635E+00; 2.9351393E+00, 2.7863238E+00,-8.2709804E-01\| 1.9479785E-02\| 33)
	+ 34 prt(o:-211\| 4.2943753E-01; 2.3913946E-01, 3.2365634E-01,-5.4732967E-02\| 1.9479785E-02\| 34)
	+ 35 prt(o:-2212\| 6.1210174E+00; 4.3708995E+00, 4.0012167E+00,-1.2132627E+00\| 8.8035059E-01\| 35)
	+ 36 prt(o:211\| 5.5768597E-01; 4.1259165E-01, 3.4511561E-01,-4.6874270E-02\| 1.9479785E-02\| 36)
	+ 37 prt(o:-321\| 2.5906588E+00; 1.7296154E+00, 1.7830699E+00,-5.4494393E-01\| 2.4364096E-01\| 37)
	+ 38 prt(o:22\| 5.5591171E-02; 1.5218568E-02, 2.8593022E-02,-4.5179780E-02\| 0.0000000E+00\| 38)
	+ 39 prt(o:-321\| 1.5254460E+01; 3.2546127E-01, 1.4972273E+01, 2.8600761E+00\| 2.4364096E-01\| 39)
	+ 40 prt(o:22\| 3.2940770E+00; 2.6033079E-01, 3.2817818E+00,-1.1436658E-01\| 0.0000000E+00\| 40)
	+ 41 prt(o:22\| 5.5621046E+00; 5.8336126E-01, 5.5306423E+00,-9.3237511E-02\| 0.0000000E+00\| 41)
	+ 42 prt(o:130\| 2.0591287E+01; 3.5796557E-01, 2.0491280E+01,-1.9320283E+00\| 2.4767543E-01\| 42)
	+ 43 prt(o:22\| 1.4384107E+00; 6.9172909E-02, 1.4336363E+00,-9.4485678E-02\| 0.0000000E+00\| 43)
	+ 44 prt(o:22\| 3.3593198E+00; 3.6699976E-01, 3.3313942E+00,-2.2837034E-01\| 0.0000000E+00\| 44)
	+ 45 prt(o:22\| 1.2346477E+01; 1.8552502E+00, 1.2186891E+01,-6.8792295E-01\| 0.0000000E+00\| 45)
	+ 46 prt(o:22\| 1.5660160E+00; 2.8271271E-01, 1.5377674E+00,-8.8039366E-02\| 0.0000000E+00\| 46)
	+ 47 prt(o:22\| 6.8157718E+00; 5.2824496E-01, 6.7932981E+00,-1.6371930E-01\| 0.0000000E+00\| 47)
	+ 48 prt(o:22\| 4.3104521E+00; 4.1594687E-01, 4.2868740E+00,-1.7232711E-01\| 0.0000000E+00\| 48)
	+ 49 prt(o:22\| 1.1797185E+00; 2.9104650E-01, 1.1373832E+00,-1.1570326E-01\| 0.0000000E+00\| 49)
	+ 50 prt(o:22\| 2.8028835E+00; 6.9629397E-01, 2.7141868E+00,-6.7236534E-02\| 0.0000000E+00\| 50)
	+ 51 prt(o:22\| 1.1174258E+00; 6.8700878E-01, 8.6225495E-01,-1.8214243E-01\| 0.0000000E+00\| 51)
	+ 52 prt(o:22\| 1.6737272E+00; 1.1019596E+00, 1.1984755E+00,-3.8820625E-01\| 0.0000000E+00\| 52)
	+ 53 prt(o:22\| 1.1573212E-01; 5.1737944E-02, 1.0350503E-01,-1.9542683E-03\| 0.0000000E+00\| 53)
	+ 54 prt(o:22\| 1.5120014E+00; 6.8995441E-01, 1.2482436E+00,-5.0199533E-01\| 0.0000000E+00\| 54)
	+ 55 prt(o:-211\| 9.7615353E-01;-2.3845114E-01, 6.1606930E-01,-7.0497915E-01\| 1.9479785E-02\| 55)
	+ 56 prt(o:211\| 8.4143989E-01;-3.7766088E-01, 6.1639853E-01,-4.0738976E-01\| 1.9479785E-02\| 56)
	+ 57 prt(o:211\| 1.8602932E+00; 2.7106473E-02, 1.8290160E+00, 3.0850707E-01\| 1.9479785E-02\| 57)
	+ 58 prt(o:-211\| 3.3615717E+00; 1.9681208E-01, 3.2998111E+00, 5.9430336E-01\| 1.9479785E-02\| 58)
	+ 59 prt(o:211\| 1.9671694E+00;-1.0664730E-02, 1.9557865E+00,-1.5830790E-01\| 1.9479785E-02\| 59)
	+ 60 prt(o:-211\| 2.1566537E+00; 3.9609589E-01, 2.0933875E+00,-3.0415828E-01\| 1.9479785E-02\| 60)
	+ 61 prt(o:-211\| 1.9019434E+00;-1.9085029E-01, 1.3186570E+00,-1.3500477E+00\| 1.9479785E-02\| 61)
	+ 62 prt(o:211\| 1.0030372E+00;-1.9635931E-01, 9.6874641E-01,-9.7863312E-02\| 1.9479785E-02\| 62)
	+ 63 prt(o:211\| 7.3753273E-01;-2.6253391E-01, 2.7167165E-01,-6.1785533E-01\| 1.9479785E-02\| 63)
	+ 64 prt(o:211\| 1.0271150E+01; 5.9774930E-01, 1.0075257E+01, 1.8997196E+00\| 1.9479785E-02\| 64)
	+ 65 prt(o:-211\| 1.2798646E+01; 4.5031043E-01, 1.2636649E+01, 1.9743820E+00\| 1.9479785E-02\| 65)
	+ 66 prt(o:22\| 3.3333777E+00; 9.9333234E-02, 3.2961933E+00, 4.8646658E-01\| 0.0000000E+00\| 66)
	+ 67 prt(o:22\| 5.9928141E+00; 3.1476743E-01, 5.9018661E+00, 9.9132187E-01\| 0.0000000E+00\| 67)
	+ 68 prt(o:211\| 1.3284919E+01; 3.0699351E-01, 1.3021786E+01, 2.6092987E+00\| 1.9479785E-02\| 68)
	+ 69 prt(o:-211\| 1.1131578E+01; 5.4776650E-01, 1.0944977E+01, 1.9493549E+00\| 1.9479785E-02\| 69)
	+ 70 prt(o:22\| 3.7361640E+00; 1.6000780E-01, 3.6629455E+00, 7.1843535E-01\| 0.0000000E+00\| 70)
	+ 71 prt(o:22\| 1.6637255E+01; 7.6805532E-01, 1.6252717E+01, 3.4723940E+00\| 0.0000000E+00\| 71)
	+ 72 prt(o:22\| 1.1583287E-01;-6.2457420E-02, 9.6708070E-02,-1.2801289E-02\| 0.0000000E+00\| 72)
	+ 73 prt(o:22\| 3.5666819E-01;-2.0243601E-01, 1.7062728E-01,-2.3899412E-01\| 0.0000000E+00\| 73)
	+ 74 prt(o:22\| 1.1867473E+00;-2.6188955E-02, 9.8399847E-01,-6.6289546E-01\| 0.0000000E+00\| 74)
	+ 75 prt(o:22\| 8.5418270E-01;-9.1517925E-02, 7.4972932E-01,-3.9894674E-01\| 0.0000000E+00\| 75)
	+ 76 prt(o:22\| 1.3167983E+01; 4.8370767E-01, 1.3007330E+01, 1.9927743E+00\| 0.0000000E+00\| 76)
	+ 77 prt(o:22\| 1.0404188E+01; 3.9242367E-01, 1.0294301E+01, 1.4561940E+00\| 0.0000000E+00\| 77)
	+ 78 prt(o:22\| 2.1368507E+00; 5.6390114E-02, 2.1125765E+00, 3.1618230E-01\| 0.0000000E+00\| 78)
	+ 79 prt(o:22\| 2.8779434E+01; 1.2488575E+00, 2.8446578E+01, 4.1819077E+00\| 0.0000000E+00\| 79)
	+ 80 prt(o:211\| 1.2669042E+00;-5.6818978E-01, 7.9078596E-01,-7.9836353E-01\| 1.9479785E-02\| 80)
	+ 81 prt(o:-211\| 4.0117974E-01;-2.4648551E-01,-8.3941083E-02,-2.7141146E-01\| 1.9479785E-02\| 81)
	+ 82 prt(o:22\| 3.1872398E-01;-2.5120227E-01, 1.3771044E-01,-1.3970764E-01\| 0.0000000E+00\| 82)
	+ 83 prt(o:22\| 1.3213489E-01;-1.2874431E-01,-1.8667628E-02,-2.3152787E-02\| 0.0000000E+00\| 83)
	+ 84 prt(o:22\| 1.5450117E+01; 7.1243109E-01, 1.5236013E+01, 2.4622089E+00\| 0.0000000E+00\| 84)
	+ 85 prt(o:22\| 9.6546420E+00; 5.4838291E-01, 9.5113195E+00, 1.5640302E+00\| 0.0000000E+00\| 85)
	+ 86 prt(o:22\| 2.8566045E+00; 7.9354403E-02, 2.8164407E+00, 4.7069521E-01\| 0.0000000E+00\| 86)
	+ 87 prt(o:22\| 2.8896068E-01;-6.5015102E-03, 2.8879262E-01, 7.4043707E-03\| 0.0000000E+00\| 87)
	+ 88 prt(o:211\| 1.4969813E+00;-7.6969590E-01, 1.1906141E+00,-4.5986892E-01\| 1.9479785E-02\| 88)
	+ 89 prt(o:-211\| 1.6058588E+00;-1.0669521E+00, 9.7901244E-01,-6.8003722E-01\| 1.9479785E-02\| 89)
	========================================================================
	Index: trunk/share/tests/functional_tests/ref-output/pythia8_1.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output/pythia8_1.ref (revision 0)
	+++ trunk/share/tests/functional_tests/ref-output/pythia8_1.ref (revision 8190)
	@@ -0,0 +1,868 @@
	+?openmp_logging = false
	+?vis_history = false
	+?integration_timer = false
	+?pacify = true
	+SM.me => 0.00000E+00
	+$method = "omega"
	+\| Process library 'pythia8_1_lib': recorded process 'pythia8_1_p1'
	+\| Process library 'pythia8_1_lib': compiling ...
	+\| Process library 'pythia8_1_lib': writing makefile
	+\| Process library 'pythia8_1_lib': removing old files
	+\| Process library 'pythia8_1_lib': writing driver
	+\| Process library 'pythia8_1_lib': creating source code
	+\| Process library 'pythia8_1_lib': compiling sources
	+\| Process library 'pythia8_1_lib': linking
	+\| Process library 'pythia8_1_lib': loading
	+\| Process library 'pythia8_1_lib': ... success.
	+seed = 1234
	+$phs_method = "wood"
	+$integration_method = "vamp2"
	+$rng_method = "rng_stream"
	+sqrts = 1.00000E+03
	+openmp_num_threads = 1
	+\| RNG: Initializing RNG Stream random-number generator
	+\| RNG: Setting seed for random-number generator to 1234
	+\| Initializing integration for process pythia8_1_p1:
	+\| Beam structure: [any particles]
	+\| Beam data (collision):
	+\| e- (mass = 0.0000000E+00 GeV)
	+\| e+ (mass = 0.0000000E+00 GeV)
	+\| sqrts = 1.000000000000E+03 GeV
	+\| Phase space: generating configuration ...
	+\| Phase space: ... success.
	+\| Phase space: writing configuration file 'pythia8_1_p1.i1.phs'
	+\| ------------------------------------------------------------------------
	+\| Process [scattering]: 'pythia8_1_p1'
	+\| Library name = 'pythia8_1_lib'
	+\| Process index = 1
	+\| Process components:
	+\| 1: 'pythia8_1_p1_i1': e-, e+ => u, ubar [omega]
	+\| ------------------------------------------------------------------------
	+\| Phase space: 2 channels, 2 dimensions
	+\| Phase space: found 2 channels, collected in 2 groves.
	+\| Phase space: Using 2 equivalences between channels.
	+\| Phase space: wood
	+\| Applying user-defined cuts.
	+\| Starting integration for process 'pythia8_1_p1'
	+\| Integrate: iterations = 3:1000:"g", 3:1000
	+\| Integrator: 2 chains, 2 channels, 2 dimensions
	+\| Integrator: Using VAMP2 channel equivalences
	+\| Integrator: 1000 initial calls, 20 max. bins, stratified = T
	+\| Integrator: VAMP2
	+\|=============================================================================\|
	+\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	+\|=============================================================================\|
	+\| [VAMP2] set chain: use chained weights.
	+ 1 900 1.680E+02 1.39E+00 0.83 0.25 36.5
	+ 2 900 1.694E+02 7.09E-01 0.42 0.13 35.1
	+ 3 900 1.682E+02 6.88E-01 0.41 0.12 59.3
	+\|-----------------------------------------------------------------------------\|
	+ 3 2700 1.687E+02 4.65E-01 0.28 0.14 59.3 0.86 3
	+\|-----------------------------------------------------------------------------\|
	+ 4 900 1.681E+02 6.79E-01 0.40 0.12 34.0
	+ 5 900 1.692E+02 7.30E-01 0.43 0.13 34.3
	+ 6 900 1.689E+02 6.74E-01 0.40 0.12 34.1
	+\|-----------------------------------------------------------------------------\|
	+ 6 2700 1.687E+02 4.00E-01 0.24 0.12 34.1 0.62 3
	+\|=============================================================================\|
	+n_events = 1
	+?debug_decay = false
	+?debug_process = false
	+?debug_verbose = false
	+?sample_pacify = true
	+?allow_shower = true
	+?ps_fsr_active = true
	+$shower_method = "PYTHIA8"
	+$sample = "pythia8_1a"
	+\| Starting simulation for process 'pythia8_1_p1'
	+\| Simulate: activating parton shower
	+\| Shower: Using PYTHIA8 shower
	+\| RNG: Initializing RNG Stream random-number generator
	+\| RNG: Setting seed for random-number generator to 1235
	+\| Simulation: requested number of events = 1
	+\| corr. to luminosity [fb-1] = 5.9271E-03
	+\| Events: writing to ASCII file 'pythia8_1a.debug'
	+\| Events: writing to raw file 'pythia8_1a.evx'
	+\| Events: generating 1 unweighted, unpolarized events ...
	+\| Events: event normalization mode '1'
	+\| ... event sample complete.
	+\| Events: actual unweighting efficiency = 50.00 %
	+\| Events: closing ASCII file 'pythia8_1a.debug'
	+\| Events: closing raw file 'pythia8_1a.evx'
	+?hadronization_active = true
	+$hadronization_method = "PYTHIA8"
	+$sample = "pythia8_1b"
	+\| Starting simulation for process 'pythia8_1_p1'
	+\| Simulate: activating parton shower
	+\| Shower: Using PYTHIA8 shower
	+\| Simulate: activating hadronization
	+\| Hadronization: Using PYTHIA8 interface for hadronization and decays.
	+\| RNG: Initializing RNG Stream random-number generator
	+\| RNG: Setting seed for random-number generator to 1236
	+\| Simulation: requested number of events = 1
	+\| corr. to luminosity [fb-1] = 5.9271E-03
	+\| Events: writing to ASCII file 'pythia8_1b.debug'
	+\| Events: writing to raw file 'pythia8_1b.evx'
	+\| Events: generating 1 unweighted, unpolarized events ...
	+\| Events: event normalization mode '1'
	+\| ... event sample complete.
	+\| Events: actual unweighting efficiency = 100.00 %
	+\| Events: closing ASCII file 'pythia8_1b.debug'
	+\| Events: closing raw file 'pythia8_1b.evx'
	+\| WHIZARD run finished.
	+\|=============================================================================\|
	+Contents of pythia8_1a.debug:
	+========================================================================
	+ Event #1
	+------------------------------------------------------------------------
	+ Unweighted = T
	+ Normalization = '1'
	+ Helicity handling = drop
	+ Keep correlations = F
	+------------------------------------------------------------------------
	+ Squared matrix el. (ref) = 5.20858E-02
	+ Squared matrix el. (prc) = 5.20858E-02
	+ Event weight (ref) = 1.00000E+00
	+ Event weight (prc) = 1.00000E+00
	+------------------------------------------------------------------------
	+ Selected MCI group = 1
	+ Selected term = 1
	+ Selected channel = 2
	+------------------------------------------------------------------------
	+ Passed selection = T
	+ Reweighting factor = 1.00000E+00
	+ Analysis flag = T
	+========================================================================
	+ Event transform: trivial (hard process)
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_1_p1'
	+ RNG Stream generator
	+ Current position = [
	+ 1406751874.0, 353173304.0, 69075414.0,
	+ 4120795872.0, 2940738971.0, 1076868956.0,
	+ ]
	+ Beginning substream = [
	+ 1645229399.0, 1877497944.0, 574158534.0,
	+ 2268932622.0, 3511034181.0, 2508020503.0,
	+ ]
	+ Initial stream = [
	+ 1645229399.0, 1877497944.0, 574158534.0,
	+ 2268932622.0, 3511034181.0, 2508020503.0,
	+ ]
	+ Number of tries = 1
	+------------------------------------------------------------------------
	+ Particle set:
	+------------------------------------------------------------------------
	+ Particle 1 [i] f(11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 2 [i] f(-11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 -5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 3 [o] f(2)c(1 )
	+ E = 5.000000E+02
	+ P = -2.541053E+02 -8.350176E+01 4.224428E+02
	+ T = 0.000000000E+00
	+ Parents: 1 2
	+ Particle 4 [o] f(-2)c(-1 )
	+ E = 5.000000E+02
	+ P = 2.541053E+02 8.350176E+01 -4.224428E+02
	+ T = 0.000000000E+00
	+ Parents: 1 2
	+========================================================================
	+========================================================================
	+ Event transform: shower
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_1_p1'
	+ RNG Stream generator
	+ Current position = [
	+ 244426135.0, 2098806856.0, 1330552735.0,
	+ 1957943094.0, 3060143382.0, 2035378285.0,
	+ ]
	+ Beginning substream = [
	+ 1172788459.0, 244426135.0, 2098806856.0,
	+ 19170156.0, 1957943094.0, 3060143382.0,
	+ ]
	+ Initial stream = [
	+ 1172788459.0, 244426135.0, 2098806856.0,
	+ 19170156.0, 1957943094.0, 3060143382.0,
	+ ]
	+ Number of tries = 1
	+ Particle set:
	+------------------------------------------------------------------------
	+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	+ 1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	+ 2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	+ 3 [v] u 1 0 1-2 7 500.000 -254.105 -83.502 422.443 0.000
	+ 4 [v] ubar 0 1 1-2 5-6 500.000 254.105 83.502 -422.443 0.000
	+ 5 [v] ubar 0 502 4 17-18 454.822 239.242 59.577 -382.200 0.000
	+ 6 [v] gl 502 501 4 8-9 47.226 13.822 23.583 -38.512 0.000
	+ 7 [v] u 501 0 3 10 497.951 -253.064 -83.160 420.712 0.000
	+ 8 [v] gl 502 503 6 19 45.145 18.993 18.597 -36.490 0.000
	+ 9 [v] gl 503 501 6 11-12 14.961 -11.717 2.835 8.860 0.000
	+ 10 [v] u 501 0 7 13 485.072 -246.518 -81.009 409.830 0.000
	+ 11 [v] gl 503 505 9 22 4.473 -1.121 -2.695 3.390 0.000
	+ 12 [v] gl 505 501 9 14-15 32.841 -21.956 1.797 24.356 0.000
	+ 13 [v] u 501 0 10 16 462.718 -235.158 -77.276 390.944 0.000
	+ 14 [v] gl 505 506 12 23-24 50.460 -32.491 -0.950 38.596 0.000
	+ 15 [v] gl 506 501 12 26-27 6.590 -1.768 -1.296 6.215 0.000
	+ 16 [v] u 501 0 13 28 438.509 -222.855 -73.233 370.490 0.000
	+ 17 [o] ubar 0 507 5 [none] 396.090 208.344 54.528 -332.425 0.000
	+ 18 [v] gl 507 502 5 38-39 59.936 31.404 5.545 -50.748 0.000
	+ 19 [v] gl 502 503 8 20-21 43.942 18.487 18.101 -35.518 0.000
	+ 20 [v] gl 502 508 19 40 27.986 13.708 11.776 -21.369 0.000
	+ 21 [v] gl 508 503 19 34 16.089 4.746 6.244 -14.048 0.000
	+ 22 [v] gl 503 505 11 25 4.340 -1.088 -2.614 3.289 0.000
	+ 23 [v] gl 509 506 14 43 40.891 -26.969 -0.104 30.736 0.000
	+ 24 [o] gl 505 509 14 [none] 9.980 -5.625 -1.093 8.171 0.000
	+ 25 [v] gl 503 505 22 32-33 3.929 -0.985 -2.367 2.978 0.000
	+ 26 [v] gl 506 510 15 41-42 3.716 -1.149 0.198 3.528 0.000
	+ 27 [v] gl 510 501 15 29-30 22.461 -10.574 -4.766 19.235 0.000
	+ 28 [v] u 501 0 16 31 418.922 -212.901 -69.961 353.941 0.000
	+ 29 [v] gl 510 511 27 55 71.045 -35.242 -13.648 60.159 0.000
	+ 30 [v] gl 511 501 27 52 24.497 -12.472 -3.322 20.821 0.000
	+ 31 [v] u 501 0 28 50-51 345.841 -175.760 -57.757 292.197 0.000
	+ 32 [v] gl 512 505 25 62-63 3.108 -1.297 -1.205 2.555 0.000
	+ 33 [v] gl 503 512 25 37 1.129 0.403 -1.043 0.154 0.000
	+ 34 [v] gl 508 503 21 35-36 15.782 4.655 6.125 -13.780 0.000
	+ 35 [v] gl 508 513 34 44-45 4.718 2.170 1.434 -3.936 0.000
	+ 36 [v] gl 513 503 34 46 11.148 2.515 4.614 -9.832 0.000
	+ 37 [v] gl 503 512 33 59-60 1.044 0.373 -0.965 0.143 0.000
	+ 38 [o] gl 507 514 18 [none] 60.264 31.237 5.887 -51.200 0.000
	+ 39 [v] gl 514 502 18 47-48 1.208 0.920 0.304 -0.721 0.000
	+ 40 [v] gl 502 508 20 49 26.449 12.956 11.130 -20.195 0.000
	+ 41 [v] gl 515 510 26 53-54 1.334 -0.164 0.376 1.269 0.000
	+ 42 [o] gl 506 515 26 [none] 8.701 -5.152 -0.194 7.009 0.000
	+ 43 [o] gl 509 506 23 [none] 34.572 -22.802 -0.088 25.986 0.000
	+ 44 [o] gl 508 516 35 [none] 9.410 3.195 3.166 -8.265 0.000
	+ 45 [o] gl 516 513 35 [none] 0.550 0.157 0.437 -0.294 0.000
	+ 46 [v] gl 513 503 36 61 5.906 1.332 2.444 -5.209 0.000
	+ 47 [o] gl 514 517 39 [none] 0.420 0.013 0.295 -0.298 0.000
	+ 48 [o] gl 517 502 39 [none] 11.673 6.238 4.589 -8.734 0.000
	+ 49 [o] gl 502 508 40 [none] 15.565 7.624 6.550 -11.884 0.000
	+ 50 [o] u 518 0 31 [none] 267.737 -135.926 -45.155 226.203 0.000
	+ 51 [o] gl 501 518 31 [none] 83.645 -42.655 -13.353 70.702 0.000
	+ 52 [v] gl 511 501 30 58 18.957 -9.652 -2.571 16.112 0.000
	+ 53 [o] gl 515 519 41 [none] 1.758 -0.847 0.519 1.450 0.000
	+ 54 [o] gl 519 510 41 [none] 3.764 -1.395 -0.947 3.365 0.000
	+ 55 [v] gl 510 511 29 56-57 66.858 -33.164 -12.844 56.613 0.000
	+ 56 [o] gl 510 520 55 [none] 46.017 -22.577 -9.095 39.053 0.000
	+ 57 [o] gl 520 511 55 [none] 26.850 -13.647 -4.564 22.669 0.000
	+ 58 [o] gl 511 501 52 [none] 12.947 -6.592 -1.756 11.004 0.000
	+ 59 [v] gl 521 512 37 64 1.130 0.731 -0.769 -0.390 0.000
	+ 60 [o] gl 503 521 37 [none] 0.320 -0.267 -0.028 0.174 0.000
	+ 61 [o] gl 513 503 46 [none] 5.501 1.241 2.276 -4.851 0.000
	+ 62 [o] gl 522 505 32 [none] 3.158 -1.168 -1.282 2.639 0.000
	+ 63 [o] gl 512 522 32 [none] 0.187 0.024 -0.084 -0.166 0.000
	+ 64 [o] gl 521 512 59 [none] 0.894 0.578 -0.608 -0.308 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	+Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+------------------------------------------------------------------------
	+ Shower settings:
	+------------------------------------------------------------------------
	+ Master switches:
	+ ps_isr_active = F
	+ ps_fsr_active = T
	+ ps_tau_dec = F
	+ muli_active = F
	+ hadronization_active = F
	+ General settings:
	+ method = PYTHIA8
	+ shower_verbose = F
	+ ps_mass_cutoff = 1.000000000000E+00
	+ ps_max_n_flavors = 5
	+ [ISR off]
	+ FSR settings:
	+ ps_fsr_lambda = 2.900000000000E-01
	+ ps_fsr_alphas_running = T
	+ Matching Settings:
	+ mlm_matching = F
	+ ckkw_matching = F
	+ PYTHIA6 specific settings:
	+ ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	+========================================================================
	+ Local variables:
	+------------------------------------------------------------------------
	+sqrts* = 1.00000E+03
	+sqrts_hat* => 1.00000E+03
	+n_in* => 2
	+n_out* => 22
	+n_tot* => 24
	+$process_id* => "pythia8_1_p1"
	+process_num_id* => [unknown integer]
	+sqme* => 5.20858E-02
	+sqme_ref* => 5.20858E-02
	+event_index* => 1
	+event_weight* => 1.00000E+00
	+event_weight_ref* => 1.00000E+00
	+event_excess* => 0.00000E+00
	+------------------------------------------------------------------------
	+ subevent:
	+ 1 prt(i:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02\| 0.0000000E+00\| 1)
	+ 2 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02\| 0.0000000E+00\| 2)
	+ 3 prt(o:-2\| 3.9608953E+02; 2.0834375E+02, 5.4527689E+01,-3.3242523E+02\| 0.0000000E+00\| 3)
	+ 4 prt(o:21\| 9.9802194E+00;-5.6251031E+00,-1.0932282E+00, 8.1711595E+00\| 0.0000000E+00\| 4)
	+ 5 prt(o:21\| 6.0264469E+01; 3.1236986E+01, 5.8874612E+00,-5.1199559E+01\| 0.0000000E+00\| 5)
	+ 6 prt(o:21\| 8.7008971E+00;-5.1521177E+00,-1.9407531E-01, 7.0088250E+00\| 0.0000000E+00\| 6)
	+ 7 prt(o:21\| 3.4571713E+01;-2.2801680E+01,-8.8023314E-02, 2.5986130E+01\| 0.0000000E+00\| 7)
	+ 8 prt(o:21\| 9.4100437E+00; 3.1952341E+00, 3.1659857E+00,-8.2653455E+00\| 0.0000000E+00\| 8)
	+ 9 prt(o:21\| 5.4951880E-01; 1.5738276E-01, 4.3698235E-01,-2.9368011E-01\| 0.0000000E+00\| 9)
	+ 10 prt(o:21\| 4.1957092E-01; 1.3414355E-02, 2.9469594E-01,-2.9835234E-01\| 0.0000000E+00\| 10)
	+ 11 prt(o:21\| 1.1672822E+01; 6.2381216E+00, 4.5893626E+00,-8.7337487E+00\| 0.0000000E+00\| 11)
	+ 12 prt(o:21\| 1.5564928E+01; 7.6241808E+00, 6.5496518E+00,-1.1884482E+01\| 0.0000000E+00\| 12)
	+ 13 prt(o:2\| 2.6773664E+02;-1.3592642E+02,-4.5154996E+01, 2.2620331E+02\| 0.0000000E+00\| 13)
	+ 14 prt(o:21\| 8.3645039E+01;-4.2654604E+01,-1.3353109E+01, 7.0701993E+01\| 0.0000000E+00\| 14)
	+ 15 prt(o:21\| 1.7575753E+00;-8.4663406E-01, 5.1930560E-01, 1.4500356E+00\| 0.0000000E+00\| 15)
	+ 16 prt(o:21\| 3.7636004E+00;-1.3945397E+00,-9.4745811E-01, 3.3648581E+00\| 0.0000000E+00\| 16)
	+ 17 prt(o:21\| 4.6017110E+01;-2.2577357E+01,-9.0950804E+00, 3.9052746E+01\| 0.0000000E+00\| 17)
	+ 18 prt(o:21\| 2.6850294E+01;-1.3647001E+01,-4.5635748E+00, 2.2668733E+01\| 0.0000000E+00\| 18)
	+ 19 prt(o:21\| 1.2946985E+01;-6.5918191E+00,-1.7558648E+00, 1.1004058E+01\| 0.0000000E+00\| 19)
	+ 20 prt(o:21\| 3.1986933E-01;-2.6670673E-01,-2.8027834E-02, 1.7435122E-01\| 0.0000000E+00\| 20)
	+ 21 prt(o:21\| 5.5005933E+00; 1.2407116E+00, 2.2763683E+00,-4.8513203E+00\| 0.0000000E+00\| 21)
	+ 22 prt(o:21\| 3.1579615E+00;-1.1676241E+00,-1.2824302E+00, 2.6390809E+00\| 0.0000000E+00\| 22)
	+ 23 prt(o:21\| 1.8700318E-01; 2.3996538E-02,-8.3517885E-02,-1.6558719E-01\| 0.0000000E+00\| 23)
	+ 24 prt(o:21\| 8.9361763E-01; 5.7783410E-01,-6.0811735E-01,-3.0798296E-01\| 0.0000000E+00\| 24)
	+========================================================================
	+Contents of pythia8_1b.debug:
	+========================================================================
	+ Event #1
	+------------------------------------------------------------------------
	+ Unweighted = T
	+ Normalization = '1'
	+ Helicity handling = drop
	+ Keep correlations = F
	+------------------------------------------------------------------------
	+ Squared matrix el. (ref) = 5.04278E-02
	+ Squared matrix el. (prc) = 5.04278E-02
	+ Event weight (ref) = 1.00000E+00
	+ Event weight (prc) = 1.00000E+00
	+------------------------------------------------------------------------
	+ Selected MCI group = 1
	+ Selected term = 1
	+ Selected channel = 1
	+------------------------------------------------------------------------
	+ Passed selection = T
	+ Reweighting factor = 1.00000E+00
	+ Analysis flag = T
	+========================================================================
	+ Event transform: trivial (hard process)
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_1_p1'
	+ RNG Stream generator
	+ Current position = [
	+ 1181672156.0, 918370603.0, 2351276331.0,
	+ 709317015.0, 3565763956.0, 3526655229.0,
	+ ]
	+ Beginning substream = [
	+ 1257951883.0, 2124301545.0, 1723027666.0,
	+ 2080453032.0, 1195684852.0, 1749773276.0,
	+ ]
	+ Initial stream = [
	+ 1257951883.0, 2124301545.0, 1723027666.0,
	+ 2080453032.0, 1195684852.0, 1749773276.0,
	+ ]
	+ Number of tries = 1
	+------------------------------------------------------------------------
	+ Particle set:
	+------------------------------------------------------------------------
	+ Particle 1 [i] f(11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 2 [i] f(-11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 -5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 3 [o] f(2)c(1 )
	+ E = 5.000000E+02
	+ P = -2.459287E+02 -1.531956E+02 4.074926E+02
	+ T = 0.000000000E+00
	+ Parents: 1 2
	+ Particle 4 [o] f(-2)c(-1 )
	+ E = 5.000000E+02
	+ P = 2.459287E+02 1.531956E+02 -4.074926E+02
	+ T = 0.000000000E+00
	+ Parents: 1 2
	+========================================================================
	+========================================================================
	+ Event transform: shower
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_1_p1'
	+ RNG Stream generator
	+ Current position = [
	+ 1459724150.0, 1113883731.0, 3072361390.0,
	+ 3768449865.0, 3588250432.0, 1148658053.0,
	+ ]
	+ Beginning substream = [
	+ 139826393.0, 1459724150.0, 1113883731.0,
	+ 1552647665.0, 3768449865.0, 3588250432.0,
	+ ]
	+ Initial stream = [
	+ 139826393.0, 1459724150.0, 1113883731.0,
	+ 1552647665.0, 3768449865.0, 3588250432.0,
	+ ]
	+ Number of tries = 1
	+ Particle set:
	+------------------------------------------------------------------------
	+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	+ 1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	+ 2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	+ 3 [v] u 1 0 1-2 5-6 500.000 -245.929 -153.196 407.493 0.000
	+ 4 [v] ubar 0 1 1-2 7 500.000 245.929 153.196 -407.493 0.000
	+ 5 [v] u 502 0 3 11-12 344.576 -207.722 -77.184 263.868 0.000
	+ 6 [v] gl 501 502 3 8-9 161.319 -35.307 -74.206 138.820 0.000
	+ 7 [v] ubar 0 501 4 10 494.105 243.029 151.389 -402.688 0.000
	+ 8 [v] gl 503 502 6 13 158.228 -38.308 -70.448 136.403 0.000
	+ 9 [v] gl 501 503 6 16 5.140 4.009 -3.130 0.747 0.000
	+ 10 [v] ubar 0 501 7 14-15 492.056 242.021 150.762 -401.018 0.000
	+ 11 [v] u 504 0 5 26-27 237.408 -140.735 -50.037 184.533 0.000
	+ 12 [v] gl 502 504 5 20-21 108.763 -67.373 -27.857 80.710 0.000
	+ 13 [v] gl 503 502 8 17-18 156.634 -37.922 -69.738 135.028 0.000
	+ 14 [o] ubar 0 505 10 [none] 394.148 197.637 121.285 -318.720 0.000
	+ 15 [v] gl 505 501 10 35-36 98.047 44.493 29.392 -82.278 0.000
	+ 16 [v] gl 501 503 9 19 5.001 3.900 -3.045 0.727 0.000
	+ 17 [v] gl 506 502 13 22 37.981 -12.920 -15.262 32.291 0.000
	+ 18 [v] gl 503 506 13 32-33 119.037 -24.702 -54.710 102.793 0.000
	+ 19 [v] gl 501 503 16 34 4.616 3.600 -2.811 0.671 0.000
	+ 20 [v] gl 507 504 12 28 100.848 -61.585 -23.607 76.292 0.000
	+ 21 [v] gl 502 507 12 23-24 16.709 -8.780 -7.784 11.896 0.000
	+ 22 [v] gl 506 502 17 25 29.187 -9.929 -11.728 24.814 0.000
	+ 23 [v] gl 508 507 21 31 21.279 -9.233 -10.806 15.836 0.000
	+ 24 [v] gl 502 508 21 40 8.840 -4.109 -2.367 7.461 0.000
	+ 25 [o] gl 506 502 22 [none] 15.776 -5.367 -6.339 13.413 0.000
	+ 26 [v] u 509 0 11 59-60 190.135 -112.849 -41.917 147.171 0.000
	+ 27 [v] gl 504 509 11 61 77.331 -46.241 -15.156 60.101 0.000
	+ 28 [v] gl 507 504 20 29-30 70.790 -43.229 -16.571 53.553 0.000
	+ 29 [o] dbar 0 504 28 [none] 31.756 -20.332 -7.124 23.328 0.109
	+ 30 [v] d 507 0 28 49 40.002 -23.317 -9.939 30.945 0.109
	+ 31 [v] gl 508 507 23 38-39 20.311 -8.813 -10.314 15.116 0.000
	+ 32 [v] gl 510 506 18 67 110.925 -22.396 -51.834 95.478 0.000
	+ 33 [v] gl 503 510 18 46 8.203 -2.234 -2.932 7.328 0.000
	+ 34 [v] gl 501 503 19 37 4.525 3.529 -2.755 0.658 0.000
	+ 35 [v] gl 505 511 15 50-51 96.802 43.606 28.682 -81.526 0.000
	+ 36 [v] gl 511 501 15 43 1.384 0.996 0.624 -0.732 0.000
	+ 37 [v] gl 501 503 34 41-42 4.386 3.420 -2.670 0.637 0.000
	+ 38 [v] gl 512 507 31 47-48 16.278 -7.838 -7.566 12.096 0.000
	+ 39 [v] gl 508 512 31 55 6.340 -2.048 -3.366 4.967 0.000
	+ 40 [v] gl 502 508 24 53-54 6.532 -3.036 -1.749 5.513 0.000
	+ 41 [v] gl 513 503 37 44-45 1.729 1.689 -0.109 0.353 0.000
	+ 42 [v] gl 501 513 37 70 3.131 2.072 -2.347 0.034 0.000
	+ 43 [v] gl 511 501 36 52 0.910 0.655 0.410 -0.481 0.000
	+ 44 [v] gl 513 514 41 68-69 1.738 1.665 0.126 0.479 0.000
	+ 45 [o] gl 514 503 41 [none] 1.353 -0.347 -0.722 1.090 0.000
	+ 46 [v] gl 503 510 33 65-66 6.842 -1.863 -2.446 6.112 0.000
	+ 47 [o] d 512 0 38 [none] 10.129 -4.444 -4.425 7.948 0.109
	+ 48 [o] dbar 0 507 38 [none] 8.599 -4.823 -3.748 6.043 0.109
	+ 49 [o] d 507 0 30 [none] 37.553 -21.889 -9.332 29.050 0.109
	+ 50 [v] gl 505 515 35 73 93.008 42.259 27.433 -78.180 0.000
	+ 51 [v] gl 515 511 35 71-72 3.973 1.476 1.331 -3.441 0.000
	+ 52 [o] gl 511 501 43 [none] 0.731 0.526 0.329 -0.387 0.000
	+ 53 [v] gl 502 516 40 58 1.451 -0.104 -0.635 1.300 0.000
	+ 54 [v] gl 516 508 40 56-57 8.721 -4.108 -3.046 7.064 0.000
	+ 55 [o] gl 508 512 39 [none] 2.701 -0.872 -1.434 2.116 0.000
	+ 56 [o] gl 518 508 54 [none] 6.979 -3.177 -2.007 5.881 0.000
	+ 57 [o] gl 516 518 54 [none] 2.715 -1.000 -1.465 2.055 0.000
	+ 58 [o] gl 502 516 53 [none] 0.478 -0.034 -0.209 0.428 0.000
	+ 59 [o] u 519 0 26 [none] 116.385 -69.550 -25.558 89.750 0.000
	+ 60 [v] gl 509 519 26 64 85.007 -50.030 -18.565 66.170 0.000
	+ 61 [v] gl 504 509 27 62-63 66.074 -39.510 -12.950 51.352 0.000
	+ 62 [o] gl 504 520 61 [none] 20.320 -11.903 -3.780 16.029 0.000
	+ 63 [o] gl 520 509 61 [none] 79.097 -47.231 -16.452 61.277 0.000
	+ 64 [o] gl 509 519 60 [none] 51.664 -30.406 -11.283 40.216 0.000
	+ 65 [o] u 503 0 46 [none] 2.618 -0.825 -0.999 2.252 0.109
	+ 66 [o] ubar 0 510 46 [none] 16.051 -3.427 -6.974 14.041 0.109
	+ 67 [o] gl 510 506 32 [none] 99.097 -20.008 -46.307 85.297 0.000
	+ 68 [o] gl 523 514 44 [none] 1.384 1.292 0.247 0.429 0.000
	+ 69 [o] gl 513 523 44 [none] 1.343 1.028 -0.862 0.061 0.000
	+ 70 [o] gl 501 513 42 [none] 2.142 1.418 -1.605 0.023 0.000
	+ 71 [o] gl 524 511 51 [none] 7.731 3.180 2.673 -6.520 0.000
	+ 72 [o] gl 515 524 51 [none] 30.806 14.000 8.852 -25.974 0.000
	+ 73 [o] gl 505 515 50 [none] 58.444 26.555 17.238 -49.126 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	+Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+------------------------------------------------------------------------
	+ Shower settings:
	+------------------------------------------------------------------------
	+ Master switches:
	+ ps_isr_active = F
	+ ps_fsr_active = T
	+ ps_tau_dec = F
	+ muli_active = F
	+ hadronization_active = T
	+ General settings:
	+ method = PYTHIA8
	+ shower_verbose = F
	+ ps_mass_cutoff = 1.000000000000E+00
	+ ps_max_n_flavors = 5
	+ [ISR off]
	+ FSR settings:
	+ ps_fsr_lambda = 2.900000000000E-01
	+ ps_fsr_alphas_running = T
	+ Matching Settings:
	+ mlm_matching = F
	+ ckkw_matching = F
	+ PYTHIA6 specific settings:
	+ ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	+========================================================================
	+========================================================================
	+ Event transform: hadronization
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_1_p1'
	+ RNG Stream generator
	+ Current position = [
	+ 521427311.0, 2587893192.0, 1737772007.0,
	+ 1186036700.0, 83139990.0, 4025248731.0,
	+ ]
	+ Beginning substream = [
	+ 1712487803.0, 521427311.0, 2587893192.0,
	+ 2004959789.0, 1186036700.0, 83139990.0,
	+ ]
	+ Initial stream = [
	+ 1712487803.0, 521427311.0, 2587893192.0,
	+ 2004959789.0, 1186036700.0, 83139990.0,
	+ ]
	+ Number of tries = 1
	+ Particle set:
	+------------------------------------------------------------------------
	+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	+ 1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	+ 2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	+ 3 [v] ubar 0 505 1-2 73 394.148 197.637 121.285 -318.720 0.000
	+ 4 [v] gl 506 502 1-2 53 15.776 -5.367 -6.339 13.413 0.000
	+ 5 [v] dbar 0 504 1-2 41 31.756 -20.332 -7.124 23.328 0.109
	+ 6 [v] gl 514 503 1-2 28 1.353 -0.347 -0.722 1.090 0.000
	+ 7 [v] d 512 0 1-2 49 10.129 -4.444 -4.425 7.948 0.109
	+ 8 [v] dbar 0 507 1-2 33 8.599 -4.823 -3.748 6.043 0.109
	+ 9 [v] d 507 0 1-2 32 37.553 -21.889 -9.332 29.050 0.109
	+ 10 [v] gl 511 501 1-2 70 0.731 0.526 0.329 -0.387 0.000
	+ 11 [v] gl 508 512 1-2 50 2.701 -0.872 -1.434 2.116 0.000
	+ 12 [v] gl 518 508 1-2 51 6.979 -3.177 -2.007 5.881 0.000
	+ 13 [v] gl 516 518 1-2 31 2.715 -1.000 -1.465 2.055 0.000
	+ 14 [v] gl 502 516 1-2 31 0.478 -0.034 -0.209 0.428 0.000
	+ 15 [v] u 519 0 1-2 37 116.385 -69.550 -25.558 89.750 0.000
	+ 16 [v] gl 504 520 1-2 40 20.320 -11.903 -3.780 16.029 0.000
	+ 17 [v] gl 520 509 1-2 39 79.097 -47.231 -16.452 61.277 0.000
	+ 18 [v] gl 509 519 1-2 38 51.664 -30.406 -11.283 40.216 0.000
	+ 19 [v] u 503 0 1-2 28 2.618 -0.825 -0.999 2.252 0.109
	+ 20 [v] ubar 0 510 1-2 55 16.051 -3.427 -6.974 14.041 0.109
	+ 21 [v] gl 510 506 1-2 54 99.097 -20.008 -46.307 85.297 0.000
	+ 22 [v] gl 523 514 1-2 68 1.384 1.292 0.247 0.429 0.000
	+ 23 [v] gl 513 523 1-2 29 1.343 1.028 -0.862 0.061 0.000
	+ 24 [v] gl 501 513 1-2 29 2.142 1.418 -1.605 0.023 0.000
	+ 25 [v] gl 524 511 1-2 71 7.731 3.180 2.673 -6.520 0.000
	+ 26 [v] gl 515 524 1-2 30 30.806 14.000 8.852 -25.974 0.000
	+ 27 [v] gl 505 515 1-2 30 58.444 26.555 17.238 -49.126 0.000
	+ 28 [v] u 1014 0 6,19 67 3.971 -1.172 -1.721 3.341 0.270
	+ 29 [v] gl 1001 1023 23-24 69 3.485 2.446 -2.468 0.084 0.068
	+ 30 [v] gl 1005 1024 26-27 72 89.250 40.554 26.090 -75.101 0.116
	+ 31 [v] gl 1002 1018 13-14 52 3.193 -1.035 -1.674 2.484 0.153
	+ 32 [v] d 507 0 9 34-36 37.553 -21.889 -9.332 29.050 0.109
	+ 33 [v] dbar 0 507 8 34-36 8.599 -4.823 -3.748 6.043 0.109
	+ 34 [r] omega 0 0 32-33 121-123 28.478 -16.323 -7.136 22.194 1.027
	+ 35 [r] k0 0 0 32-33 95 13.354 -7.601 -4.246 10.114 0.248
	+ 36 [r] k0 0 0 32-33 96 4.319 -2.787 -1.698 2.785 0.248
	+ 37 [v] u 519 0 15 42-48 116.385 -69.550 -25.558 89.750 0.000
	+ 38 [v] gl 509 519 18 42-48 51.664 -30.406 -11.283 40.216 0.000
	+ 39 [v] gl 520 509 17 42-48 79.097 -47.231 -16.452 61.277 0.000
	+ 40 [v] gl 504 520 16 42-48 20.320 -11.903 -3.780 16.029 0.000
	+ 41 [v] dbar 0 504 5 42-48 31.756 -20.332 -7.124 23.328 0.109
	+ 42 [o] pip 0 0 37-41 [none] 10.114 -6.098 -2.307 7.730 0.019
	+ 43 [o] pim 0 0 37-41 [none] 84.040 -49.726 -18.274 65.239 0.019
	+ 44 [r] pi0 0 0 37-41 124-125 54.428 -32.908 -11.005 41.932 0.018
	+ 45 [r] omega 0 0 37-41 126-128 62.091 -37.451 -13.997 47.499 0.603
	+ 46 [r] pi0 0 0 37-41 129-130 47.461 -27.835 -9.653 37.210 0.018
	+ 47 [r] rhop 0 0 37-41 97-98 15.196 -9.373 -3.312 11.475 0.440
	+ 48 [r] omega 0 0 37-41 131-133 25.892 -16.031 -5.649 19.516 0.656
	+ 49 [v] d 512 0 7 56-66 10.129 -4.444 -4.425 7.948 0.109
	+ 50 [v] gl 508 512 11 56-66 2.701 -0.872 -1.434 2.116 0.000
	+ 51 [v] gl 518 508 12 56-66 6.979 -3.177 -2.007 5.881 0.000
	+ 52 [v] gl 1002 1018 31 56-66 3.193 -1.035 -1.674 2.484 0.153
	+ 53 [v] gl 506 502 4 56-66 15.776 -5.367 -6.339 13.413 0.000
	+ 54 [v] gl 510 506 21 56-66 99.097 -20.008 -46.307 85.297 0.000
	+ 55 [v] ubar 0 510 20 56-66 16.051 -3.427 -6.974 14.041 0.109
	+ 56 [r] pi0 0 0 49-55 134-135 1.139 -0.588 -0.440 0.860 0.018
	+ 57 [o] pim 0 0 49-55 [none] 4.390 -1.654 -2.057 3.505 0.019
	+ 58 [o] pip 0 0 49-55 [none] 2.736 -1.577 -0.951 2.019 0.019
	+ 59 [o] pim 0 0 49-55 [none] 14.824 -6.078 -5.688 12.266 0.019
	+ 60 [o] pip 0 0 49-55 [none] 6.539 -1.950 -2.561 5.690 0.019
	+ 61 [r] kstar0 0 0 49-55 99-100 7.767 -1.939 -3.916 6.350 0.901
	+ 62 [r] kstarm 0 0 49-55 101-102 42.549 -9.087 -19.341 36.785 0.650
	+ 63 [r] rhop 0 0 49-55 103-104 12.677 -2.806 -6.099 10.728 0.537
	+ 64 [o] pim 0 0 49-55 [none] 5.452 -1.177 -2.388 4.755 0.019
	+ 65 [o] pip 0 0 49-55 [none] 8.687 -1.865 -3.655 7.656 0.019
	+ 66 [o] pim 0 0 49-55 [none] 47.166 -9.607 -22.062 40.566 0.019
	+ 67 [v] u 1014 0 28 74-94 3.971 -1.172 -1.721 3.341 0.270
	+ 68 [v] gl 523 514 22 74-94 1.384 1.292 0.247 0.429 0.000
	+ 69 [v] gl 1001 1023 29 74-94 3.485 2.446 -2.468 0.084 0.068
	+ 70 [v] gl 511 501 10 74-94 0.731 0.526 0.329 -0.387 0.000
	+ 71 [v] gl 524 511 25 74-94 7.731 3.180 2.673 -6.520 0.000
	+ 72 [v] gl 1005 1024 30 74-94 89.250 40.554 26.090 -75.101 0.116
	+ 73 [v] ubar 0 505 3 74-94 394.148 197.637 121.285 -318.720 0.000
	+ 74 [o] pip 0 0 67-73 [none] 0.875 0.338 -0.184 0.774 0.019
	+ 75 [r] etaprim 0 0 67-73 136-137 3.199 -0.573 -1.325 2.689 0.917
	+ 76 [r] k0 0 0 67-73 105 0.686 0.305 -0.302 -0.198 0.248
	+ 77 [o] km 0 0 67-73 [none] 0.994 0.607 -0.244 0.562 0.244
	+ 78 [o] pip 0 0 67-73 [none] 0.728 0.163 -0.664 -0.209 0.019
	+ 79 [o] pim 0 0 67-73 [none] 0.470 0.434 -0.103 0.047 0.019
	+ 80 [o] pip 0 0 67-73 [none] 0.188 -0.041 0.090 0.077 0.019
	+ 81 [r] Delta0 0 0 67-73 106-107 1.676 1.002 -0.403 -0.446 1.442
	+ 82 [r] rhom 0 0 67-73 108-109 1.439 0.734 0.359 -0.898 0.596
	+ 83 [r] Deltaba 0 0 67-73 110-111 4.093 2.242 0.802 -3.069 1.666
	+ 84 [r] k0 0 0 67-73 112 1.491 0.402 0.442 -1.272 0.248
	+ 85 [r] k0 0 0 67-73 113 36.983 17.160 10.544 -31.013 0.248
	+ 86 [o] pim 0 0 67-73 [none] 3.332 1.412 1.278 -2.730 0.019
	+ 87 [r] rho0 0 0 67-73 114-115 6.985 3.317 2.167 -5.705 0.546
	+ 88 [o] pip 0 0 67-73 [none] 46.895 21.610 13.650 -39.317 0.019
	+ 89 [r] rho0 0 0 67-73 116-117 38.716 19.439 12.146 -31.192 0.557
	+ 90 [o] pim 0 0 67-73 [none] 13.276 6.215 4.271 -10.926 0.019
	+ 91 [r] eta 0 0 67-73 138-140 42.684 21.185 13.092 -34.661 0.300
	+ 92 [r] rho0 0 0 67-73 118-119 127.042 63.779 38.927 -102.742 0.756
	+ 93 [o] pip 0 0 67-73 [none] 118.442 59.490 36.421 -95.724 0.019
	+ 94 [o] pim 0 0 67-73 [none] 50.506 25.244 15.470 -40.918 0.019
	+ 95 [r] kS0 0 0 35 141-142 13.354 -7.601 -4.246 10.114 0.248
	+ 96 [o] kL0 0 0 36 [none] 4.319 -2.787 -1.698 2.785 0.248
	+ 97 [o] pip 0 0 47 [none] 8.168 -5.029 -1.494 6.259 0.019
	+ 98 [r] pi0 0 0 47 143-144 7.028 -4.344 -1.818 5.215 0.018
	+ 99 [o] kp 0 0 61 [none] 3.124 -0.574 -1.467 2.651 0.244
	+ 100 [o] pim 0 0 61 [none] 4.643 -1.365 -2.449 3.699 0.019
	+ 101 [r] k0 0 0 62 120 32.352 -6.705 -14.742 28.002 0.248
	+ 102 [o] pim 0 0 62 [none] 10.196 -2.382 -4.598 8.782 0.019
	+ 103 [o] pip 0 0 63 [none] 7.027 -1.620 -3.087 6.100 0.019
	+ 104 [r] pi0 0 0 63 145-146 5.650 -1.186 -3.012 4.628 0.018
	+ 105 [r] kS0 0 0 76 147-148 0.686 0.305 -0.302 -0.198 0.248
	+ 106 [o] n 0 0 81 [none] 1.183 0.668 -0.185 -0.191 0.883
	+ 107 [r] pi0 0 0 81 149-150 0.493 0.334 -0.219 -0.255 0.018
	+ 108 [o] pim 0 0 82 [none] 1.282 0.744 0.342 -0.976 0.019
	+ 109 [r] pi0 0 0 82 151-152 0.157 -0.010 0.018 0.078 0.018
	+ 110 [o] nbar 0 0 83 [none] 3.280 1.982 0.778 -2.312 0.883
	+ 111 [o] pip 0 0 83 [none] 0.813 0.261 0.024 -0.757 0.019
	+ 112 [o] kL0 0 0 84 [none] 1.491 0.402 0.442 -1.272 0.248
	+ 113 [r] kS0 0 0 85 153-154 36.983 17.160 10.544 -31.013 0.248
	+ 114 [o] pip 0 0 87 [none] 3.251 1.304 1.246 -2.701 0.019
	+ 115 [o] pim 0 0 87 [none] 3.734 2.013 0.920 -3.004 0.019
	+ 116 [o] pip 0 0 89 [none] 13.153 6.325 4.223 -10.731 0.019
	+ 117 [o] pim 0 0 89 [none] 25.562 13.114 7.923 -20.461 0.019
	+ 118 [o] pip 0 0 92 [none] 42.115 21.117 12.551 -34.208 0.019
	+ 119 [o] pim 0 0 92 [none] 84.927 42.662 26.376 -68.534 0.019
	+ 120 [o] kL0 0 0 101 [none] 32.352 -6.705 -14.742 28.002 0.248
	+ 121 [o] pip 0 0 34 [none] 3.767 -2.312 -0.721 2.882 0.019
	+ 122 [o] pim 0 0 34 [none] 15.519 -8.669 -4.031 12.223 0.019
	+ 123 [r] pi0 0 0 34 155-156 9.192 -5.342 -2.384 7.089 0.018
	+ 124 [o] A 0 0 44 [none] 34.597 -20.966 -6.962 26.625 0.000
	+ 125 [o] A 0 0 44 [none] 19.831 -11.943 -4.044 15.307 0.000
	+ 126 [o] pip 0 0 45 [none] 3.861 -2.288 -0.938 2.961 0.019
	+ 127 [o] pim 0 0 45 [none] 34.953 -21.060 -7.717 26.807 0.019
	+ 128 [r] pi0 0 0 45 157-158 23.277 -14.102 -5.342 17.731 0.018
	+ 129 [o] A 0 0 46 [none] 44.462 -26.068 -9.014 34.872 0.000
	+ 130 [o] A 0 0 46 [none] 2.999 -1.767 -0.639 2.337 0.000
	+ 131 [o] pip 0 0 48 [none] 12.538 -7.753 -2.536 9.521 0.019
	+ 132 [o] pim 0 0 48 [none] 10.215 -6.450 -2.339 7.567 0.019
	+ 133 [r] pi0 0 0 48 159-160 3.139 -1.828 -0.775 2.428 0.018
	+ 134 [o] A 0 0 56 [none] 0.731 -0.434 -0.265 0.525 0.000
	+ 135 [o] A 0 0 56 [none] 0.409 -0.155 -0.175 0.335 0.000
	+ 136 [r] rho0 0 0 75 161-162 2.601 -0.505 -1.279 2.097 0.478
	+ 137 [o] A 0 0 75 [none] 0.597 -0.069 -0.046 0.592 0.000
	+ 138 [r] pi0 0 0 91 163-164 13.515 6.685 4.240 -10.953 0.018
	+ 139 [r] pi0 0 0 91 165-166 18.068 9.081 5.441 -14.642 0.018
	+ 140 [r] pi0 0 0 91 167-168 11.101 5.420 3.411 -9.066 0.018
	+ 141 [r] pi0 0 0 95 169-170 12.120 -6.897 -3.903 9.169 0.018
	+ 142 [r] pi0 0 0 95 171-172 1.235 -0.704 -0.343 0.945 0.018
	+ 143 [o] A 0 0 98 [none] 0.642 -0.426 -0.166 0.451 0.000
	+ 144 [o] A 0 0 98 [none] 6.386 -3.918 -1.652 4.765 0.000
	+ 145 [o] A 0 0 104 [none] 4.772 -0.991 -2.506 3.938 0.000
	+ 146 [o] A 0 0 104 [none] 0.878 -0.195 -0.506 0.691 0.000
	+ 147 [r] pi0 0 0 105 173-174 0.317 0.183 -0.195 0.105 0.018
	+ 148 [r] pi0 0 0 105 175-176 0.369 0.122 -0.107 -0.303 0.018
	+ 149 [o] A 0 0 107 [none] 0.424 0.325 -0.160 -0.220 0.000
	+ 150 [o] A 0 0 107 [none] 0.068 0.009 -0.058 -0.035 0.000
	+ 151 [o] A 0 0 109 [none] 0.119 -0.014 0.025 0.115 0.000
	+ 152 [o] A 0 0 109 [none] 0.038 0.004 -0.007 -0.037 0.000
	+ 153 [r] pi0 0 0 113 177-178 27.645 12.950 7.954 -23.092 0.018
	+ 154 [r] pi0 0 0 113 179-180 9.338 4.210 2.590 -7.921 0.018
	+ 155 [o] A 0 0 123 [none] 7.718 -4.523 -2.009 5.922 0.000
	+ 156 [o] A 0 0 123 [none] 1.474 -0.818 -0.375 1.168 0.000
	+ 157 [o] A 0 0 128 [none] 22.187 -13.420 -5.103 16.915 0.000
	+ 158 [o] A 0 0 128 [none] 1.090 -0.682 -0.239 0.815 0.000
	+ 159 [o] A 0 0 133 [none] 1.252 -0.727 -0.372 0.949 0.000
	+ 160 [o] A 0 0 133 [none] 1.887 -1.101 -0.403 1.479 0.000
	+ 161 [o] pip 0 0 136 [none] 0.242 0.085 -0.115 0.136 0.019
	+ 162 [o] pim 0 0 136 [none] 2.360 -0.590 -1.164 1.961 0.019
	+ 163 [o] A 0 0 138 [none] 5.461 2.734 1.758 -4.389 0.000
	+ 164 [o] A 0 0 138 [none] 8.054 3.951 2.482 -6.564 0.000
	+ 165 [o] A 0 0 139 [none] 10.687 5.423 3.182 -8.641 0.000
	+ 166 [o] A 0 0 139 [none] 7.382 3.657 2.259 -6.001 0.000
	+ 167 [o] A 0 0 140 [none] 4.948 2.389 1.581 -4.034 0.000
	+ 168 [o] A 0 0 140 [none] 6.153 3.031 1.830 -5.032 0.000
	+ 169 [o] A 0 0 141 [none] 2.675 -1.560 -0.881 1.987 0.000
	+ 170 [o] A 0 0 141 [none] 9.445 -5.337 -3.022 7.182 0.000
	+ 171 [o] A 0 0 142 [none] 0.240 -0.106 -0.110 0.186 0.000
	+ 172 [o] A 0 0 142 [none] 0.994 -0.599 -0.233 0.759 0.000
	+ 173 [o] A 0 0 147 [none] 0.235 0.189 -0.125 0.062 0.000
	+ 174 [o] A 0 0 147 [none] 0.082 -0.006 -0.070 0.043 0.000
	+ 175 [o] A 0 0 148 [none] 0.191 0.076 0.008 -0.175 0.000
	+ 176 [o] A 0 0 148 [none] 0.178 0.046 -0.115 -0.127 0.000
	+ 177 [o] A 0 0 153 [none] 18.676 8.708 5.339 -15.635 0.000
	+ 178 [o] A 0 0 153 [none] 8.970 4.242 2.615 -7.458 0.000
	+ 179 [o] A 0 0 154 [none] 2.290 0.980 0.643 -1.967 0.000
	+ 180 [o] A 0 0 154 [none] 7.048 3.230 1.947 -5.954 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	+Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+------------------------------------------------------------------------
	+ Shower settings:
	+------------------------------------------------------------------------
	+ Master switches:
	+ ps_isr_active = F
	+ ps_fsr_active = T
	+ ps_tau_dec = F
	+ muli_active = F
	+ hadronization_active = T
	+ General settings:
	+ method = PYTHIA8
	+ shower_verbose = F
	+ ps_mass_cutoff = 1.000000000000E+00
	+ ps_max_n_flavors = 5
	+ [ISR off]
	+ FSR settings:
	+ ps_fsr_lambda = 2.900000000000E-01
	+ ps_fsr_alphas_running = T
	+ Matching Settings:
	+ mlm_matching = F
	+ ckkw_matching = F
	+ PYTHIA6 specific settings:
	+ ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	+------------------------------------------------------------------------
	+ Hadronization settings:
	+------------------------------------------------------------------------
	+ Master switches:
	+ active = T
	+ General settings:
	+ hadron_method = PYTHIA8
	+ pT generation parameters
	+ enhanced_fraction = 1.000000000000E-02
	+ enhanced_width = 2.000000000000E+00
	+========================================================================
	+ Local variables:
	+------------------------------------------------------------------------
	+sqrts* = 1.00000E+03
	+sqrts_hat* => 1.00000E+03
	+n_in* => 2
	+n_out* => 84
	+n_tot* => 86
	+$process_id* => "pythia8_1_p1"
	+process_num_id* => [unknown integer]
	+sqme* => 5.04278E-02
	+sqme_ref* => 5.04278E-02
	+event_index* => 1
	+event_weight* => 1.00000E+00
	+event_weight_ref* => 1.00000E+00
	+event_excess* => 0.00000E+00
	+------------------------------------------------------------------------
	+ subevent:
	+ 1 prt(i:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02\| 0.0000000E+00\| 1)
	+ 2 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02\| 0.0000000E+00\| 2)
	+ 3 prt(o:211\| 1.0113590E+01;-6.0979292E+00,-2.3068828E+00, 7.7303800E+00\| 1.9479785E-02\| 3)
	+ 4 prt(o:-211\| 8.4039902E+01;-4.9725991E+01,-1.8273756E+01, 6.5238649E+01\| 1.9479785E-02\| 4)
	+ 5 prt(o:-211\| 4.3899719E+00;-1.6539083E+00,-2.0572400E+00, 3.5049572E+00\| 1.9479785E-02\| 5)
	+ 6 prt(o:211\| 2.7363905E+00;-1.5772713E+00,-9.5147913E-01, 2.0187263E+00\| 1.9479785E-02\| 6)
	+ 7 prt(o:-211\| 1.4824310E+01;-6.0780011E+00,-5.6881380E+00, 1.2265548E+01\| 1.9479785E-02\| 7)
	+ 8 prt(o:211\| 6.5388047E+00;-1.9503909E+00,-2.5613464E+00, 5.6896368E+00\| 1.9479785E-02\| 8)
	+ 9 prt(o:-211\| 5.4515287E+00;-1.1773822E+00,-2.3883897E+00, 4.7548976E+00\| 1.9479785E-02\| 9)
	+ 10 prt(o:211\| 8.6870902E+00;-1.8646192E+00,-3.6554241E+00, 7.6555291E+00\| 1.9479785E-02\| 10)
	+ 11 prt(o:-211\| 4.7166238E+01;-9.6071061E+00,-2.2061559E+01, 4.0566311E+01\| 1.9479785E-02\| 11)
	+ 12 prt(o:211\| 8.7542410E-01; 3.3813017E-01,-1.8410890E-01, 7.7373088E-01\| 1.9479785E-02\| 12)
	+ 13 prt(o:-321\| 9.9362455E-01; 6.0668187E-01,-2.4436729E-01, 5.6195333E-01\| 2.4371994E-01\| 13)
	+ 14 prt(o:211\| 7.2799291E-01; 1.6254703E-01,-6.6369766E-01,-2.0875289E-01\| 1.9479785E-02\| 14)
	+ 15 prt(o:-211\| 4.6976377E-01; 4.3411628E-01,-1.0282743E-01, 4.6559518E-02\| 1.9479785E-02\| 15)
	+ 16 prt(o:211\| 1.8772946E-01;-4.0912859E-02, 9.0482963E-02, 7.6821471E-02\| 1.9479785E-02\| 16)
	+ 17 prt(o:-211\| 3.3321947E+00; 1.4123984E+00, 1.2784484E+00,-2.7303374E+00\| 1.9479785E-02\| 17)
	+ 18 prt(o:211\| 4.6895496E+01; 2.1609917E+01, 1.3650255E+01,-3.9317300E+01\| 1.9479785E-02\| 18)
	+ 19 prt(o:-211\| 1.3276496E+01; 6.2150233E+00, 4.2711561E+00,-1.0925959E+01\| 1.9479785E-02\| 19)
	+ 20 prt(o:211\| 1.1844215E+02; 5.9489636E+01, 3.6421176E+01,-9.5723580E+01\| 1.9479785E-02\| 20)
	+ 21 prt(o:-211\| 5.0506255E+01; 2.5243810E+01, 1.5470435E+01,-4.0917943E+01\| 1.9479785E-02\| 21)
	+ 22 prt(o:130\| 4.3191353E+00;-2.7871461E+00,-1.6980484E+00, 2.7849170E+00\| 2.4761571E-01\| 22)
	+ 23 prt(o:211\| 8.1681659E+00;-5.0288077E+00,-1.4935747E+00, 6.2593755E+00\| 1.9479785E-02\| 23)
	+ 24 prt(o:321\| 3.1235191E+00;-5.7448239E-01,-1.4674577E+00, 2.6512619E+00\| 2.4371994E-01\| 24)
	+ 25 prt(o:-211\| 4.6433642E+00;-1.3646400E+00,-2.4485153E+00, 3.6991731E+00\| 1.9479785E-02\| 25)
	+ 26 prt(o:-211\| 1.0196417E+01;-2.3820963E+00,-4.5981725E+00, 8.7823608E+00\| 1.9479785E-02\| 26)
	+ 27 prt(o:211\| 7.0270768E+00;-1.6198427E+00,-3.0869827E+00, 6.0997521E+00\| 1.9479785E-02\| 27)
	+ 28 prt(o:2112\| 1.1830511E+00; 6.6793443E-01,-1.8478258E-01,-1.9114703E-01\| 8.8279178E-01\| 28)
	+ 29 prt(o:-211\| 1.2816533E+00; 7.4382158E-01, 3.4165614E-01,-9.7629707E-01\| 1.9479785E-02\| 29)
	+ 30 prt(o:-2112\| 3.2798944E+00; 1.9816153E+00, 7.7750790E-01,-2.3116222E+00\| 8.8279178E-01\| 30)
	+ 31 prt(o:211\| 8.1345963E-01; 2.6057901E-01, 2.4338299E-02,-7.5745826E-01\| 1.9479785E-02\| 31)
	+ 32 prt(o:130\| 1.4910003E+00; 4.0230525E-01, 4.4220872E-01,-1.2720330E+00\| 2.4761571E-01\| 32)
	+ 33 prt(o:211\| 3.2508235E+00; 1.3038623E+00, 1.2462409E+00,-2.7009628E+00\| 1.9479785E-02\| 33)
	+ 34 prt(o:-211\| 3.7337820E+00; 2.0131964E+00, 9.2034417E-01,-3.0036070E+00\| 1.9479785E-02\| 34)
	+ 35 prt(o:211\| 1.3153348E+01; 6.3246260E+00, 4.2231403E+00,-1.0731043E+01\| 1.9479785E-02\| 35)
	+ 36 prt(o:-211\| 2.5562326E+01; 1.3114208E+01, 7.9229234E+00,-2.0461130E+01\| 1.9479785E-02\| 36)
	+ 37 prt(o:211\| 4.2114878E+01; 2.1116966E+01, 1.2550599E+01,-3.4208182E+01\| 1.9479785E-02\| 37)
	+ 38 prt(o:-211\| 8.4927346E+01; 4.2662189E+01, 2.6376010E+01,-6.8533775E+01\| 1.9479785E-02\| 38)
	+ 39 prt(o:130\| 3.2352477E+01;-6.7049323E+00,-1.4742434E+01, 2.8002494E+01\| 2.4761571E-01\| 39)
	+ 40 prt(o:211\| 3.7672329E+00;-2.3120513E+00,-7.2146021E-01, 2.8820962E+00\| 1.9479785E-02\| 40)
	+ 41 prt(o:-211\| 1.5518609E+01;-8.6690195E+00,-4.0314266E+00, 1.2223070E+01\| 1.9479785E-02\| 41)
	+ 42 prt(o:22\| 3.4596799E+01;-2.0965690E+01,-6.9618312E+00, 2.6625387E+01\| 0.0000000E+00\| 42)
	+ 43 prt(o:22\| 1.9831211E+01;-1.1942722E+01,-4.0435328E+00, 1.5306801E+01\| 0.0000000E+00\| 43)
	+ 44 prt(o:211\| 3.8606340E+00;-2.2883098E+00,-9.3758570E-01, 2.9613488E+00\| 1.9479785E-02\| 44)
	+ 45 prt(o:-211\| 3.4953319E+01;-2.1060447E+01,-7.7168172E+00, 2.6807151E+01\| 1.9479785E-02\| 45)
	+ 46 prt(o:22\| 4.4462182E+01;-2.6068419E+01,-9.0140475E+00, 3.4872198E+01\| 0.0000000E+00\| 46)
	+ 47 prt(o:22\| 2.9987380E+00;-1.7667372E+00,-6.3864935E-01, 2.3373481E+00\| 0.0000000E+00\| 47)
	+ 48 prt(o:211\| 1.2538122E+01;-7.7533727E+00,-2.5356655E+00, 9.5205374E+00\| 1.9479785E-02\| 48)
	+ 49 prt(o:-211\| 1.0215289E+01;-6.4496085E+00,-2.3390549E+00, 7.5672994E+00\| 1.9479785E-02\| 49)
	+ 50 prt(o:22\| 7.3072686E-01;-4.3360547E-01,-2.6498317E-01, 5.2510185E-01\| 0.0000000E+00\| 50)
	+ 51 prt(o:22\| 4.0867001E-01;-1.5459155E-01,-1.7524614E-01, 3.3526322E-01\| 0.0000000E+00\| 51)
	+ 52 prt(o:22\| 5.9728587E-01;-6.8595735E-02,-4.5978371E-02, 5.9154968E-01\| 0.0000000E+00\| 52)
	+ 53 prt(o:22\| 6.4194690E-01;-4.2596364E-01,-1.6611101E-01, 4.5061949E-01\| 0.0000000E+00\| 53)
	+ 54 prt(o:22\| 6.3863341E+00;-3.9184141E+00,-1.6521880E+00, 4.7646164E+00\| 0.0000000E+00\| 54)
	+ 55 prt(o:22\| 4.7715117E+00;-9.9139040E-01,-2.5058248E+00, 3.9376784E+00\| 0.0000000E+00\| 55)
	+ 56 prt(o:22\| 8.7832420E-01;-1.9507881E-01,-5.0631084E-01, 6.9068588E-01\| 0.0000000E+00\| 56)
	+ 57 prt(o:22\| 4.2444068E-01; 3.2540992E-01,-1.6033508E-01,-2.2034277E-01\| 0.0000000E+00\| 57)
	+ 58 prt(o:22\| 6.8348643E-02; 8.9729238E-03,-5.8181619E-02,-3.4726400E-02\| 0.0000000E+00\| 58)
	+ 59 prt(o:22\| 1.1898178E-01;-1.4155885E-02, 2.5167306E-02, 1.1542479E-01\| 0.0000000E+00\| 59)
	+ 60 prt(o:22\| 3.8285723E-02; 4.2381727E-03,-7.4733211E-03,-3.7309301E-02\| 0.0000000E+00\| 60)
	+ 61 prt(o:22\| 7.7177196E+00;-4.5234388E+00,-2.0085654E+00, 5.9217701E+00\| 0.0000000E+00\| 61)
	+ 62 prt(o:22\| 1.4743379E+00;-8.1844573E-01,-3.7499908E-01, 1.1675592E+00\| 0.0000000E+00\| 62)
	+ 63 prt(o:22\| 2.2187128E+01;-1.3420243E+01,-5.1030500E+00, 1.6915218E+01\| 0.0000000E+00\| 63)
	+ 64 prt(o:22\| 1.0897363E+00;-6.8215241E-01,-2.3925294E-01, 8.1544544E-01\| 0.0000000E+00\| 64)
	+ 65 prt(o:22\| 1.2517601E+00;-7.2711018E-01,-3.7205485E-01, 9.4857227E-01\| 0.0000000E+00\| 65)
	+ 66 prt(o:22\| 1.8871889E+00;-1.1006150E+00,-4.0268162E-01, 1.4791808E+00\| 0.0000000E+00\| 66)
	+ 67 prt(o:211\| 2.4165378E-01; 8.4762311E-02,-1.1492570E-01, 1.3610363E-01\| 1.9479785E-02\| 67)
	+ 68 prt(o:-211\| 2.3597218E+00;-5.8954215E-01,-1.1638755E+00, 1.9612855E+00\| 1.9479785E-02\| 68)
	+ 69 prt(o:22\| 5.4613564E+00; 2.7335823E+00, 1.7578398E+00,-4.3890706E+00\| 0.0000000E+00\| 69)
	+ 70 prt(o:22\| 8.0536453E+00; 3.9510421E+00, 2.4824818E+00,-6.5641263E+00\| 0.0000000E+00\| 70)
	+ 71 prt(o:22\| 1.0686918E+01; 5.4233409E+00, 3.1822214E+00,-8.6412414E+00\| 0.0000000E+00\| 71)
	+ 72 prt(o:22\| 7.3815469E+00; 3.6573540E+00, 2.2588351E+00,-6.0007216E+00\| 0.0000000E+00\| 72)
	+ 73 prt(o:22\| 4.9479844E+00; 2.3888328E+00, 1.5814628E+00,-4.0342289E+00\| 0.0000000E+00\| 73)
	+ 74 prt(o:22\| 6.1525310E+00; 3.0309293E+00, 1.8295406E+00,-5.0318870E+00\| 0.0000000E+00\| 74)
	+ 75 prt(o:22\| 2.6749393E+00;-1.5596613E+00,-8.8067864E-01, 1.9867465E+00\| 0.0000000E+00\| 75)
	+ 76 prt(o:22\| 9.4445911E+00;-5.3373987E+00,-3.0219016E+00, 7.1819626E+00\| 0.0000000E+00\| 76)
	+ 77 prt(o:22\| 2.4046111E-01;-1.0578065E-01,-1.1001694E-01, 1.8581784E-01\| 0.0000000E+00\| 77)
	+ 78 prt(o:22\| 9.9446756E-01;-5.9859802E-01,-2.3295083E-01, 7.5919697E-01\| 0.0000000E+00\| 78)
	+ 79 prt(o:22\| 2.3462851E-01; 1.8882524E-01,-1.2473090E-01, 6.1949718E-02\| 0.0000000E+00\| 79)
	+ 80 prt(o:22\| 8.2321157E-02;-6.2573286E-03,-6.9993308E-02, 4.2878382E-02\| 0.0000000E+00\| 80)
	+ 81 prt(o:22\| 1.9122342E-01; 7.6083575E-02, 8.2167141E-03,-1.7524318E-01\| 0.0000000E+00\| 81)
	+ 82 prt(o:22\| 1.7775249E-01; 4.5929077E-02,-1.1509604E-01,-1.2743379E-01\| 0.0000000E+00\| 82)
	+ 83 prt(o:22\| 1.8675538E+01; 8.7078539E+00, 5.3394203E+00,-1.5634564E+01\| 0.0000000E+00\| 83)
	+ 84 prt(o:22\| 8.9695084E+00; 4.2422662E+00, 2.6146684E+00,-7.4577991E+00\| 0.0000000E+00\| 84)
	+ 85 prt(o:22\| 2.2898065E+00; 9.8030452E-01, 6.4268399E-01,-1.9670216E+00\| 0.0000000E+00\| 85)
	+ 86 prt(o:22\| 7.0478755E+00; 3.2295846E+00, 1.9472010E+00,-5.9540524E+00\| 0.0000000E+00\| 86)
	+========================================================================
	Index: trunk/share/tests/functional_tests/ref-output/process_log.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output/process_log.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output/process_log.ref (revision 8190)
	@@ -1,539 +1,541 @@
	###############################################################################
	Process [scattering]: 'process_log_1_p1'
	Run ID = ''
	Library name = 'process_log_lib'
	Process index = 1
	Process components:
	1: 'process_log_1_p1_i1': e-, e+ => m-, m+ [omega]
	------------------------------------------------------------------------
	Variable list: [not shown]
	###############################################################################
	Integral = 8.3556567814E+03
	Error = 3.2359019246E+00
	Accuracy = 1.8972317270E-02
	Chi2 = 5.2032955661E-01
	Efficiency = 7.8315602603E-01
	T(10k evt) = <time estimate>
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 800 8.3525258E+03 6.97E+00 0.08 0.02* 67.98
	2 800 8.3688100E+03 5.46E+00 0.07 0.02* 59.78
	3 800 8.3686236E+03 5.53E+00 0.07 0.02 78.45
	\|-----------------------------------------------------------------------------\|
	3 2400 8.3648733E+03 3.39E+00 0.04 0.02 78.45 2.06 3
	\|-----------------------------------------------------------------------------\|
	4 800 8.3602554E+03 5.63E+00 0.07 0.02 78.37
	5 800 8.3525628E+03 5.62E+00 0.07 0.02 78.30
	6 800 8.3541861E+03 5.56E+00 0.07 0.02* 78.32
	\|-----------------------------------------------------------------------------\|
	6 2400 8.3556568E+03 3.24E+00 0.04 0.02 78.32 0.52 3
	\|=============================================================================\|
	###############################################################################
	\| Phase-space chain (grove) weight history: (numbers in %)
	\| chain \| 1
	\|=============================================================================\|
	1 \| 100
	2 \| 100
	3 \| 100
	\|-----------------------------------------------------------------------------\|
	4 \| 100
	5 \| 100
	6 \| 100
	\|=============================================================================\|
	###############################################################################
	Call statistics (current run):
	total = 2400
	failed kin. = 0
	failed cuts = 0
	passed cuts = 0
	evaluated = 2400
	###############################################################################
	MC Integrator is VAMP
	------------------------------------------------------------------------
	VAMP history (global):
	Pass #1:
	------------------------------------------------------------------------------
	[vamp] it #calls integral average chi2 eff.
	[vamp] 1 800* 0.0000E+00(0.00E+00) 8.352526E+03(6.97E+00) 0.0 0.000
	[vamp] 2 800* 0.0000E+00(0.00E+00) 8.368810E+03(5.46E+00) 0.0 0.000
	[vamp] 3 800* 0.0000E+00(0.00E+00) 8.368624E+03(5.53E+00) 0.0 0.000
	------------------------------------------------------------------------------
	Channel histories: [undefined]
	Pass #2:
	------------------------------------------------------------------------------
	[vamp] it #calls integral average chi2 eff.
	[vamp] 1 800* 0.0000E+00(0.00E+00) 8.360255E+03(5.63E+00) 0.0 0.000
	[vamp] 2 800* 0.0000E+00(0.00E+00) 8.352563E+03(5.62E+00) 0.0 0.000
	[vamp] 3 800* 0.0000E+00(0.00E+00) 8.354186E+03(5.56E+00) 0.0 0.000
	------------------------------------------------------------------------------
	Channel histories: [undefined]
	------------------------------------------------------------------------
	Inequivalent channels:
	Channel 1: Mult. = 1 Symm. = 1 Invar.: TF
	Equivalence list:
	Equivalent channels: 1 1
	Permutation: 1 2
	Mode: 3 0
	------------------------------------------------------------------------
	Weights of channel chains (groves):
	1 1.0000000000
	###############################################################################
	Beam data (collision):
	e- (mass = 0.0000000E+00 GeV)
	e+ (mass = 0.0000000E+00 GeV)
	sqrts = 1.000000000000E+02 GeV
	###############################################################################
	No cuts used.
	------------------------------------------------------------------------
	No scale expression was given.
	------------------------------------------------------------------------
	No factorization scale expression was given.
	------------------------------------------------------------------------
	No renormalization scale expression was given.
	------------------------------------------------------------------------
	No weight expression was given.
	###############################################################################
	Summary of quantum-number states:
	+ sign: allowed and contributing
	no + : switched off at runtime
	------------------------------------------------------------------------
	Term #1
	1 [f(11) h(-1) / f(-11) h(-1) / f(13) h(-1) / f(-13) h(-1)]
	2 [f(11) h(-1) / f(-11) h(-1) / f(13) h(-1) / f(-13) h(1)]
	3 [f(11) h(-1) / f(-11) h(-1) / f(13) h(1) / f(-13) h(-1)]
	4 [f(11) h(-1) / f(-11) h(-1) / f(13) h(1) / f(-13) h(1)]
	+ 5 [f(11) h(-1) / f(-11) h(1) / f(13) h(-1) / f(-13) h(-1)]
	+ 6 [f(11) h(-1) / f(-11) h(1) / f(13) h(-1) / f(-13) h(1)]
	+ 7 [f(11) h(-1) / f(-11) h(1) / f(13) h(1) / f(-13) h(-1)]
	+ 8 [f(11) h(-1) / f(-11) h(1) / f(13) h(1) / f(-13) h(1)]
	+ 9 [f(11) h(1) / f(-11) h(-1) / f(13) h(-1) / f(-13) h(-1)]
	+ 10 [f(11) h(1) / f(-11) h(-1) / f(13) h(-1) / f(-13) h(1)]
	+ 11 [f(11) h(1) / f(-11) h(-1) / f(13) h(1) / f(-13) h(-1)]
	+ 12 [f(11) h(1) / f(-11) h(-1) / f(13) h(1) / f(-13) h(1)]
	13 [f(11) h(1) / f(-11) h(1) / f(13) h(-1) / f(-13) h(-1)]
	14 [f(11) h(1) / f(-11) h(1) / f(13) h(-1) / f(-13) h(1)]
	15 [f(11) h(1) / f(-11) h(1) / f(13) h(1) / f(-13) h(-1)]
	16 [f(11) h(1) / f(-11) h(1) / f(13) h(1) / f(-13) h(1)]
	###############################################################################
	Variable list:
	ee = 3.000000000000E-01
	me = 0.000000000000E+00
	mmu = 1.000000000000E+01
	mtau = 1.777000000000E+00
	particle = PDG(0)
	E_LEPTON = PDG(11)
	e- = PDG(11)
	e1 = PDG(11)
	e+ = PDG(-11)
	E1 = PDG(-11)
	MU_LEPTON = PDG(13)
	m- = PDG(13)
	e2 = PDG(13)
	mu- = PDG(13)
	m+ = PDG(-13)
	E2 = PDG(-13)
	mu+ = PDG(-13)
	TAU_LEPTON = PDG(15)
	t- = PDG(15)
	e3 = PDG(15)
	ta- = PDG(15)
	tau- = PDG(15)
	t+ = PDG(-15)
	E3 = PDG(-15)
	ta+ = PDG(-15)
	tau+ = PDG(-15)
	PHOTON = PDG(22)
	A = PDG(22)
	gamma = PDG(22)
	photon = PDG(22)
	charged = PDG(11, 13, 15, -11, -13, -15)
	neutral = PDG(22)
	colored = PDG()
	sqrts = 1.000000000000E+02
	luminosity = 0.000000000000E+00
	?sf_trace = false
	$sf_trace_file = ""
	?sf_allow_s_mapping = true
	$lhapdf_dir = ""
	$lhapdf_file = ""
	$lhapdf_photon_file = ""
	lhapdf_member = 0
	lhapdf_photon_scheme = 0
	$pdf_builtin_set = "CTEQ6L"
	?hoppet_b_matching = false
	isr_alpha = 0.000000000000E+00
	isr_q_max = 0.000000000000E+00
	isr_mass = 0.000000000000E+00
	isr_order = 3
	?isr_recoil = false
	?isr_keep_energy = false
	?isr_handler = false
	$isr_handler_mode = "trivial"
	epa_alpha = 0.000000000000E+00
	epa_x_min = 0.000000000000E+00
	epa_q_min = 0.000000000000E+00
	epa_q_max = 0.000000000000E+00
	epa_mass = 0.000000000000E+00
	?epa_recoil = false
	?epa_keep_energy = false
	?epa_handler = false
	$epa_handler_mode = "trivial"
	ewa_x_min = 0.000000000000E+00
	ewa_pt_max = 0.000000000000E+00
	ewa_mass = 0.000000000000E+00
	?ewa_recoil = false
	?ewa_keep_energy = false
	?circe1_photon1 = false
	?circe1_photon2 = false
	[undefined] circe1_sqrts = [unknown real]
	?circe1_generate = true
	?circe1_map = true
	circe1_mapping_slope = 2.000000000000E+00
	circe1_eps = 1.000000000000E-05
	circe1_ver = 0
	circe1_rev = 0
	$circe1_acc = "SBAND"
	circe1_chat = 0
	?circe1_with_radiation = false
	?circe2_polarized = true
	[undefined] $circe2_file = [unknown string]
	$circe2_design = "*"
	gaussian_spread1 = 0.000000000000E+00
	gaussian_spread2 = 0.000000000000E+00
	[undefined] $beam_events_file = [unknown string]
	?beam_events_warn_eof = true
	?energy_scan_normalize = false
	?logging = true
	[undefined] $job_id = [unknown string]
	[undefined] $compile_workspace = [unknown string]
	seed = 1
	$model_name = "QED"
	[undefined] process_num_id = [unknown integer]
	$method = "omega"
	?report_progress = true
	[user variable] ?me_verbose = false
	$restrictions = ""
	?omega_write_phs_output = false
	$omega_flags = ""
	?read_color_factors = true
	?slha_read_input = true
	?slha_read_spectrum = true
	?slha_read_decays = false
	$library_name = "process_log_lib"
	?alphas_is_fixed = true
	?alphas_from_lhapdf = false
	?alphas_from_pdf_builtin = false
	alphas_order = 0
	alphas_nf = 5
	?alphas_from_mz = false
	?alphas_from_lambda_qcd = false
	lambda_qcd = 2.000000000000E-01
	?fatal_beam_decay = true
	?helicity_selection_active = true
	helicity_selection_threshold = 1.000000000000E+10
	helicity_selection_cutoff = 1000
	$rng_method = "tao"
	?vis_diags = false
	?vis_diags_color = false
	?check_event_file = true
	$event_file_version = ""
	n_events = 0
	event_index_offset = 0
	?unweighted = true
	safety_factor = 1.000000000000E+00
	?negative_weights = false
	?resonance_history = false
	resonance_on_shell_limit = 4.000000000000E+00
	resonance_on_shell_turnoff = 0.000000000000E+00
	resonance_background_factor = 1.000000000000E+00
	?keep_beams = false
	?keep_remnants = true
	?recover_beams = true
	?update_event = false
	?update_sqme = false
	?update_weight = false
	?use_alphas_from_file = false
	?use_scale_from_file = false
	?allow_decays = true
	?auto_decays = false
	auto_decays_multiplicity = 2
	?auto_decays_radiative = false
	?decay_rest_frame = false
	?isotropic_decay = false
	?diagonal_decay = false
	[undefined] decay_helicity = [unknown integer]
	?polarized_events = false
	$polarization_mode = "helicity"
	?colorize_subevt = false
	tolerance = 0.000000000000E+00
	checkpoint = 0
	event_callback_interval = 0
	?pacify = false
	$out_file = ""
	?out_advance = true
	real_range = <real_range>
	real_precision = <real_precision>
	real_epsilon = <real_epsilon>
	real_tiny = <real_tiny>
	$integration_method = "vamp"
	threshold_calls = 10
	min_calls_per_channel = 10
	min_calls_per_bin = 10
	min_bins = 3
	max_bins = 20
	?stratified = true
	?use_vamp_equivalences = true
	?vamp_verbose = false
	?vamp_history_global = true
	?vamp_history_global_verbose = false
	?vamp_history_channels = false
	?vamp_history_channels_verbose = false
	$run_id = ""
	n_calls_test = 0
	?integration_timer = true
	?check_grid_file = true
	accuracy_goal = 0.000000000000E+00
	error_goal = 0.000000000000E+00
	relative_error_goal = 0.000000000000E+00
	integration_results_verbosity = 1
	error_threshold = 0.000000000000E+00
	channel_weights_power = 2.500000000000E-01
	[undefined] $integrate_workspace = [unknown string]
	$phs_method = "wood"
	?vis_channels = false
	?check_phs_file = true
	$phs_file = ""
	?phs_only = false
	phs_threshold_s = 5.000000000000E+01
	phs_threshold_t = 1.000000000000E+02
	phs_off_shell = 2
	phs_t_channel = 6
	phs_e_scale = 1.000000000000E+01
	phs_m_scale = 1.000000000000E+01
	phs_q_scale = 1.000000000000E+01
	?phs_keep_nonresonant = true
	?phs_step_mapping = true
	?phs_step_mapping_exp = true
	?phs_s_mapping = true
	?vis_history = false
	n_bins = 20
	?normalize_bins = false
	$obs_label = ""
	$obs_unit = ""
	$title = ""
	$description = ""
	$x_label = ""
	$y_label = ""
	graph_width_mm = 130
	graph_height_mm = 90
	?y_log = false
	?x_log = false
	[undefined] x_min = [unknown real]
	[undefined] x_max = [unknown real]
	[undefined] y_min = [unknown real]
	[undefined] y_max = [unknown real]
	$gmlcode_bg = ""
	$gmlcode_fg = ""
	[undefined] ?draw_histogram = [unknown logical]
	[undefined] ?draw_base = [unknown logical]
	[undefined] ?draw_piecewise = [unknown logical]
	[undefined] ?fill_curve = [unknown logical]
	[undefined] ?draw_curve = [unknown logical]
	[undefined] ?draw_errors = [unknown logical]
	[undefined] ?draw_symbols = [unknown logical]
	[undefined] $fill_options = [unknown string]
	[undefined] $draw_options = [unknown string]
	[undefined] $err_options = [unknown string]
	[undefined] $symbol = [unknown string]
	?analysis_file_only = false
	kt_algorithm = 0
	cambridge_algorithm = 1
	antikt_algorithm = 2
	genkt_algorithm = 3
	cambridge_for_passive_algorithm = 11
	genkt_for_passive_algorithm = 13
	ee_kt_algorithm = 50
	ee_genkt_algorithm = 53
	plugin_algorithm = 99
	undefined_jet_algorithm = 999
	jet_algorithm = 999
	jet_r = 0.000000000000E+00
	jet_p = 0.000000000000E+00
	jet_ycut = 0.000000000000E+00
	?keep_flavors_when_clustering = false
	$sample = ""
	$sample_normalization = "auto"
	?sample_pacify = false
	?sample_select = true
	sample_max_tries = 10000
	sample_split_n_evt = 0
	sample_split_n_kbytes = 0
	sample_split_index = 0
	$rescan_input_format = "raw"
	?read_raw = true
	?write_raw = true
	$extension_raw = "evx"
	$extension_default = "evt"
	$debug_extension = "debug"
	?debug_process = true
	?debug_transforms = true
	?debug_decay = true
	?debug_verbose = true
	$dump_extension = "pset.dat"
	?dump_compressed = false
	?dump_weights = false
	?dump_summary = false
	?dump_screen = false
	?hepevt_ensure_order = false
	$extension_hepevt = "hepevt"
	$extension_ascii_short = "short.evt"
	$extension_ascii_long = "long.evt"
	$extension_athena = "athena.evt"
	$extension_mokka = "mokka.evt"
	$lhef_version = "2.0"
	$lhef_extension = "lhe"
	?lhef_write_sqme_prc = true
	?lhef_write_sqme_ref = false
	?lhef_write_sqme_alt = true
	$extension_lha = "lha"
	$extension_hepmc = "hepmc"
	?hepmc_output_cross_section = false
	$extension_lcio = "slcio"
	$extension_stdhep = "hep"
	$extension_stdhep_up = "up.hep"
	$extension_stdhep_ev4 = "ev4.hep"
	$extension_hepevt_verb = "hepevt.verb"
	$extension_lha_verb = "lha.verb"
	?allow_shower = true
	?ps_fsr_active = false
	?ps_isr_active = false
	?ps_taudec_active = false
	?muli_active = false
	$shower_method = "WHIZARD"
	?shower_verbose = false
	$ps_PYTHIA_PYGIVE = ""
	+$ps_PYTHIA8_config = ""
	+$ps_PYTHIA8_config_file = ""
	ps_mass_cutoff = 1.000000000000E+00
	ps_fsr_lambda = 2.900000000000E-01
	ps_isr_lambda = 2.900000000000E-01
	ps_max_n_flavors = 5
	?ps_isr_alphas_running = true
	?ps_fsr_alphas_running = true
	ps_fixed_alphas = 0.000000000000E+00
	?ps_isr_pt_ordered = false
	?ps_isr_angular_ordered = true
	ps_isr_primordial_kt_width = 0.000000000000E+00
	ps_isr_primordial_kt_cutoff = 5.000000000000E+00
	ps_isr_z_cutoff = 9.990000000000E-01
	ps_isr_minenergy = 1.000000000000E+00
	ps_isr_tscalefactor = 1.000000000000E+00
	?ps_isr_only_onshell_emitted_partons = false
	?allow_hadronization = true
	?hadronization_active = false
	$hadronization_method = "PYTHIA6"
	hadron_enhanced_fraction = 1.000000000000E-02
	hadron_enhanced_width = 2.000000000000E+00
	?ps_tauola_photos = false
	?ps_tauola_transverse = false
	?ps_tauola_dec_rad_cor = true
	ps_tauola_dec_mode1 = 0
	ps_tauola_dec_mode2 = 0
	ps_tauola_mh = 1.250000000000E+02
	ps_tauola_mix_angle = 9.000000000000E+01
	?ps_tauola_pol_vector = false
	?mlm_matching = false
	mlm_Qcut_ME = 0.000000000000E+00
	mlm_Qcut_PS = 0.000000000000E+00
	mlm_ptmin = 0.000000000000E+00
	mlm_etamax = 0.000000000000E+00
	mlm_Rmin = 0.000000000000E+00
	mlm_Emin = 0.000000000000E+00
	mlm_nmaxMEjets = 0
	mlm_ETclusfactor = 2.000000000000E-01
	mlm_ETclusminE = 5.000000000000E+00
	mlm_etaclusfactor = 1.000000000000E+00
	mlm_Rclusfactor = 1.000000000000E+00
	mlm_Eclusfactor = 1.000000000000E+00
	?powheg_matching = false
	?powheg_use_singular_jacobian = false
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_grid_sampling_points = 500000
	powheg_pt_min = 1.000000000000E+00
	powheg_lambda = 2.000000000000E-01
	?powheg_rebuild_grids = false
	?powheg_test_sudakov = false
	?powheg_disable_sudakov = false
	?ckkw_matching = false
	?omega_openmp => false
	?openmp_is_active = false
	openmp_num_threads_default = 1
	openmp_num_threads = 1
	?openmp_logging = false
	?mpi_logging = false
	$born_me_method = ""
	$loop_me_method = ""
	$correlation_me_method = ""
	$real_tree_me_method = ""
	$dglap_me_method = ""
	?test_soft_limit = false
	?test_coll_limit = false
	?test_anti_coll_limit = false
	$select_alpha_regions = ""
	$virtual_selection = "Full"
	?virtual_collinear_resonance_aware = true
	blha_top_yukawa = -1.000000000000E+00
	$blha_ew_scheme = "alpha_qed"
	openloops_verbosity = 1
	?openloops_use_cms = true
	openloops_phs_tolerance = 7
	openloops_stability_log = 0
	?openloops_switch_off_muon_yukawa = false
	$openloops_extra_cmd = ""
	?openloops_use_collier = true
	?disable_subtraction = false
	fks_dij_exp1 = 1.000000000000E+00
	fks_dij_exp2 = 1.000000000000E+00
	fks_xi_min = 1.000000000000E-07
	fks_y_max = 1.000000000000E+00
	?vis_fks_regions = false
	fks_xi_cut = 1.000000000000E+00
	fks_delta_zero = 2.000000000000E+00
	fks_delta_i = 2.000000000000E+00
	$fks_mapping_type = "default"
	$resonances_exclude_particles = "default"
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = false
	?fixed_order_nlo_events = false
	?check_event_weights_against_xsection = false
	?keep_failed_events = false
	gks_multiplicity = 0
	$gosam_filter_lo = ""
	$gosam_filter_nlo = ""
	$gosam_symmetries = "family,generation"
	form_threads = 2
	form_workspace = 1000
	$gosam_fc = ""
	mult_call_real = 1.000000000000E+00
	mult_call_virt = 1.000000000000E+00
	mult_call_dglap = 1.000000000000E+00
	$dalitz_plot = ""
	$nlo_correction_type = "QCD"
	$exclude_gauge_splittings = "c:b:t:e2:e3"
	?nlo_use_born_scale = true
	?nlo_cut_all_sqmes = true
	?nlo_use_real_partition = false
	real_partition_scale = 1.000000000000E+01
	$fc = Fortran-compiler
	$fcflags = Fortran-flags
	?rebuild_library = true
	?recompile_library = false
	?rebuild_phase_space = true
	?rebuild_grids = true
	?powheg_rebuild_grids = true
	?rebuild_events = true
	[undefined] num_id(process_log_1_p1) = [unknown integer]
	[undefined] integral(process_log_1_p1) = [unknown real]
	[undefined] error(process_log_1_p1) = [unknown real]
	###############################################################################
	Index: trunk/share/tests/functional_tests/ref-output/show_4.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output/show_4.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output/show_4.ref (revision 8190)
	@@ -1,1140 +1,1146 @@
	?openmp_logging = false
	[user variable] foo = PDG(11, 13, 15)
	[user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00)
	#####################################################
	QED.ee => 3.028600000000E-01
	QED.me => 5.110000000000E-04
	QED.mmu => 1.057000000000E-01
	QED.mtau => 1.777000000000E+00
	[undefined] sqrts = [unknown real]
	luminosity = 0.000000000000E+00
	isr_alpha = 0.000000000000E+00
	isr_q_max = 0.000000000000E+00
	isr_mass = 0.000000000000E+00
	epa_alpha = 0.000000000000E+00
	epa_x_min = 0.000000000000E+00
	epa_q_min = 0.000000000000E+00
	epa_q_max = 0.000000000000E+00
	epa_mass = 0.000000000000E+00
	ewa_x_min = 0.000000000000E+00
	ewa_pt_max = 0.000000000000E+00
	ewa_mass = 0.000000000000E+00
	[undefined] circe1_sqrts = [unknown real]
	circe1_mapping_slope = 2.000000000000E+00
	circe1_eps = 1.000000000000E-05
	gaussian_spread1 = 0.000000000000E+00
	gaussian_spread2 = 0.000000000000E+00
	lambda_qcd = 2.000000000000E-01
	helicity_selection_threshold = 1.000000000000E+10
	safety_factor = 1.000000000000E+00
	resonance_on_shell_limit = 4.000000000000E+00
	resonance_on_shell_turnoff = 0.000000000000E+00
	resonance_background_factor = 1.000000000000E+00
	tolerance = 0.000000000000E+00
	real_epsilon* = <real_epsilon>
	real_tiny* = <real_tiny>
	accuracy_goal = 0.000000000000E+00
	error_goal = 0.000000000000E+00
	relative_error_goal = 0.000000000000E+00
	error_threshold = 0.000000000000E+00
	channel_weights_power = 2.500000000000E-01
	phs_threshold_s = 5.000000000000E+01
	phs_threshold_t = 1.000000000000E+02
	phs_e_scale = 1.000000000000E+01
	phs_m_scale = 1.000000000000E+01
	phs_q_scale = 1.000000000000E+01
	[undefined] x_min = [unknown real]
	[undefined] x_max = [unknown real]
	[undefined] y_min = [unknown real]
	[undefined] y_max = [unknown real]
	jet_r = 0.000000000000E+00
	jet_p = 0.000000000000E+00
	jet_ycut = 0.000000000000E+00
	ps_mass_cutoff = 1.000000000000E+00
	ps_fsr_lambda = 2.900000000000E-01
	ps_isr_lambda = 2.900000000000E-01
	ps_fixed_alphas = 0.000000000000E+00
	ps_isr_primordial_kt_width = 0.000000000000E+00
	ps_isr_primordial_kt_cutoff = 5.000000000000E+00
	ps_isr_z_cutoff = 9.990000000000E-01
	ps_isr_minenergy = 1.000000000000E+00
	ps_isr_tscalefactor = 1.000000000000E+00
	hadron_enhanced_fraction = 1.000000000000E-02
	hadron_enhanced_width = 2.000000000000E+00
	ps_tauola_mh = 1.250000000000E+02
	ps_tauola_mix_angle = 9.000000000000E+01
	mlm_Qcut_ME = 0.000000000000E+00
	mlm_Qcut_PS = 0.000000000000E+00
	mlm_ptmin = 0.000000000000E+00
	mlm_etamax = 0.000000000000E+00
	mlm_Rmin = 0.000000000000E+00
	mlm_Emin = 0.000000000000E+00
	mlm_ETclusfactor = 2.000000000000E-01
	mlm_ETclusminE = 5.000000000000E+00
	mlm_etaclusfactor = 1.000000000000E+00
	mlm_Rclusfactor = 1.000000000000E+00
	mlm_Eclusfactor = 1.000000000000E+00
	powheg_pt_min = 1.000000000000E+00
	powheg_lambda = 2.000000000000E-01
	blha_top_yukawa = -1.000000000000E+00
	fks_dij_exp1 = 1.000000000000E+00
	fks_dij_exp2 = 1.000000000000E+00
	fks_xi_min = 1.000000000000E-07
	fks_y_max = 1.000000000000E+00
	fks_xi_cut = 1.000000000000E+00
	fks_delta_zero = 2.000000000000E+00
	fks_delta_i = 2.000000000000E+00
	mult_call_real = 1.000000000000E+00
	mult_call_virt = 1.000000000000E+00
	mult_call_dglap = 1.000000000000E+00
	real_partition_scale = 1.000000000000E+01
	#####################################################
	QED.charged* = PDG(11, 13, 15, -11, -13, -15)
	#####################################################
	[user variable] foo = PDG(11, 13, 15)
	#####################################################
	[user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00)
	#####################################################
	$sf_trace_file = ""
	$lhapdf_dir = ""
	$lhapdf_file = ""
	$lhapdf_photon_file = ""
	$pdf_builtin_set = "CTEQ6L"
	$isr_handler_mode = "trivial"
	$epa_handler_mode = "trivial"
	$circe1_acc = "SBAND"
	[undefined] $circe2_file = [unknown string]
	$circe2_design = "*"
	[undefined] $beam_events_file = [unknown string]
	[undefined] $job_id = [unknown string]
	[undefined] $compile_workspace = [unknown string]
	$model_name = "QED"
	$method = "omega"
	$restrictions = ""
	$omega_flags = ""
	$library_name = "show_4_lib"
	$rng_method = "tao"
	$event_file_version = ""
	$polarization_mode = "helicity"
	$out_file = ""
	$integration_method = "vamp"
	$run_id = ""
	[undefined] $integrate_workspace = [unknown string]
	$phs_method = "default"
	$phs_file = ""
	$obs_label = ""
	$obs_unit = ""
	$title = ""
	$description = ""
	$x_label = ""
	$y_label = ""
	$gmlcode_bg = ""
	$gmlcode_fg = ""
	[undefined] $fill_options = [unknown string]
	[undefined] $draw_options = [unknown string]
	[undefined] $err_options = [unknown string]
	[undefined] $symbol = [unknown string]
	$sample = ""
	$sample_normalization = "auto"
	$rescan_input_format = "raw"
	$extension_raw = "evx"
	$extension_default = "evt"
	$debug_extension = "debug"
	$dump_extension = "pset.dat"
	$extension_hepevt = "hepevt"
	$extension_ascii_short = "short.evt"
	$extension_ascii_long = "long.evt"
	$extension_athena = "athena.evt"
	$extension_mokka = "mokka.evt"
	$lhef_version = "2.0"
	$lhef_extension = "lhe"
	$extension_lha = "lha"
	$extension_hepmc = "hepmc"
	$extension_lcio = "slcio"
	$extension_stdhep = "hep"
	$extension_stdhep_up = "up.hep"
	$extension_stdhep_ev4 = "ev4.hep"
	$extension_hepevt_verb = "hepevt.verb"
	$extension_lha_verb = "lha.verb"
	$shower_method = "WHIZARD"
	$ps_PYTHIA_PYGIVE = ""
	+$ps_PYTHIA8_config = ""
	+$ps_PYTHIA8_config_file = ""
	$hadronization_method = "PYTHIA6"
	$born_me_method = ""
	$loop_me_method = ""
	$correlation_me_method = ""
	$real_tree_me_method = ""
	$dglap_me_method = ""
	$select_alpha_regions = ""
	$virtual_selection = "Full"
	$blha_ew_scheme = "alpha_qed"
	$openloops_extra_cmd = ""
	$fks_mapping_type = "default"
	$resonances_exclude_particles = "default"
	$gosam_filter_lo = ""
	$gosam_filter_nlo = ""
	$gosam_symmetries = "family,generation"
	$gosam_fc = ""
	$dalitz_plot = ""
	$nlo_correction_type = "QCD"
	$exclude_gauge_splittings = "c:b:t:e2:e3"
	$fc => Fortran-compiler
	$fcflags => Fortran-flags
	#####################################################
	?sf_trace = false
	?sf_allow_s_mapping = true
	?hoppet_b_matching = false
	?isr_recoil = false
	?isr_keep_energy = false
	?isr_handler = false
	?epa_recoil = false
	?epa_keep_energy = false
	?epa_handler = false
	?ewa_recoil = false
	?ewa_keep_energy = false
	?circe1_photon1 = false
	?circe1_photon2 = false
	?circe1_generate = true
	?circe1_map = true
	?circe1_with_radiation = false
	?circe2_polarized = true
	?beam_events_warn_eof = true
	?energy_scan_normalize = false
	?logging => true
	?report_progress = true
	[user variable] ?me_verbose = false
	?omega_write_phs_output = false
	?read_color_factors = true
	?slha_read_input = true
	?slha_read_spectrum = true
	?slha_read_decays = false
	?alphas_is_fixed = true
	?alphas_from_lhapdf = false
	?alphas_from_pdf_builtin = false
	?alphas_from_mz = false
	?alphas_from_lambda_qcd = false
	?fatal_beam_decay = true
	?helicity_selection_active = true
	?vis_diags = false
	?vis_diags_color = false
	?check_event_file = true
	?unweighted = true
	?negative_weights = false
	?resonance_history = false
	?keep_beams = false
	?keep_remnants = true
	?recover_beams = true
	?update_event = false
	?update_sqme = false
	?update_weight = false
	?use_alphas_from_file = false
	?use_scale_from_file = false
	?allow_decays = true
	?auto_decays = false
	?auto_decays_radiative = false
	?decay_rest_frame = false
	?isotropic_decay = false
	?diagonal_decay = false
	?polarized_events = false
	?colorize_subevt = false
	?pacify = false
	?out_advance = true
	?stratified = true
	?use_vamp_equivalences = true
	?vamp_verbose = false
	?vamp_history_global = true
	?vamp_history_global_verbose = false
	?vamp_history_channels = false
	?vamp_history_channels_verbose = false
	?integration_timer = true
	?check_grid_file = true
	?vis_channels = false
	?check_phs_file = true
	?phs_only = false
	?phs_keep_nonresonant = true
	?phs_step_mapping = true
	?phs_step_mapping_exp = true
	?phs_s_mapping = true
	?vis_history = false
	?normalize_bins = false
	?y_log = false
	?x_log = false
	[undefined] ?draw_histogram = [unknown logical]
	[undefined] ?draw_base = [unknown logical]
	[undefined] ?draw_piecewise = [unknown logical]
	[undefined] ?fill_curve = [unknown logical]
	[undefined] ?draw_curve = [unknown logical]
	[undefined] ?draw_errors = [unknown logical]
	[undefined] ?draw_symbols = [unknown logical]
	?analysis_file_only = false
	?keep_flavors_when_clustering = false
	?sample_pacify = false
	?sample_select = true
	?read_raw = true
	?write_raw = true
	?debug_process = true
	?debug_transforms = true
	?debug_decay = true
	?debug_verbose = true
	?dump_compressed = false
	?dump_weights = false
	?dump_summary = false
	?dump_screen = false
	?hepevt_ensure_order = false
	?lhef_write_sqme_prc = true
	?lhef_write_sqme_ref = false
	?lhef_write_sqme_alt = true
	?hepmc_output_cross_section = false
	?allow_shower = true
	?ps_fsr_active = false
	?ps_isr_active = false
	?ps_taudec_active = false
	?muli_active = false
	?shower_verbose = false
	?ps_isr_alphas_running = true
	?ps_fsr_alphas_running = true
	?ps_isr_pt_ordered = false
	?ps_isr_angular_ordered = true
	?ps_isr_only_onshell_emitted_partons = false
	?allow_hadronization = true
	?hadronization_active = false
	?ps_tauola_photos = false
	?ps_tauola_transverse = false
	?ps_tauola_dec_rad_cor = true
	?ps_tauola_pol_vector = false
	?mlm_matching = false
	?powheg_matching = false
	?powheg_use_singular_jacobian = false
	?powheg_rebuild_grids = false
	?powheg_test_sudakov = false
	?powheg_disable_sudakov = false
	?ckkw_matching = false
	?omega_openmp => false
	?openmp_is_active* = false
	?openmp_logging = false
	?mpi_logging = false
	?test_soft_limit = false
	?test_coll_limit = false
	?test_anti_coll_limit = false
	?virtual_collinear_resonance_aware = true
	?openloops_use_cms = true
	?openloops_switch_off_muon_yukawa = false
	?openloops_use_collier = true
	?disable_subtraction = false
	?vis_fks_regions = false
	?combined_nlo_integration = false
	?fixed_order_nlo_events = false
	?check_event_weights_against_xsection = false
	?keep_failed_events = false
	?nlo_use_born_scale = true
	?nlo_cut_all_sqmes = true
	?nlo_use_real_partition = false
	?rebuild_library = true
	?recompile_library = false
	?rebuild_phase_space = true
	?rebuild_grids = true
	?powheg_rebuild_grids = true
	?rebuild_events = true
	#####################################################
	[undefined] sqrts = [unknown real]
	luminosity = 0.000000000000E+00
	?sf_trace = false
	$sf_trace_file = ""
	?sf_allow_s_mapping = true
	$lhapdf_dir = ""
	$lhapdf_file = ""
	$lhapdf_photon_file = ""
	lhapdf_member = 0
	lhapdf_photon_scheme = 0
	$pdf_builtin_set = "CTEQ6L"
	?hoppet_b_matching = false
	isr_alpha = 0.000000000000E+00
	isr_q_max = 0.000000000000E+00
	isr_mass = 0.000000000000E+00
	isr_order = 3
	?isr_recoil = false
	?isr_keep_energy = false
	?isr_handler = false
	$isr_handler_mode = "trivial"
	epa_alpha = 0.000000000000E+00
	epa_x_min = 0.000000000000E+00
	epa_q_min = 0.000000000000E+00
	epa_q_max = 0.000000000000E+00
	epa_mass = 0.000000000000E+00
	?epa_recoil = false
	?epa_keep_energy = false
	?epa_handler = false
	$epa_handler_mode = "trivial"
	ewa_x_min = 0.000000000000E+00
	ewa_pt_max = 0.000000000000E+00
	ewa_mass = 0.000000000000E+00
	?ewa_recoil = false
	?ewa_keep_energy = false
	?circe1_photon1 = false
	?circe1_photon2 = false
	[undefined] circe1_sqrts = [unknown real]
	?circe1_generate = true
	?circe1_map = true
	circe1_mapping_slope = 2.000000000000E+00
	circe1_eps = 1.000000000000E-05
	circe1_ver = 0
	circe1_rev = 0
	$circe1_acc = "SBAND"
	circe1_chat = 0
	?circe1_with_radiation = false
	?circe2_polarized = true
	[undefined] $circe2_file = [unknown string]
	$circe2_design = "*"
	gaussian_spread1 = 0.000000000000E+00
	gaussian_spread2 = 0.000000000000E+00
	[undefined] $beam_events_file = [unknown string]
	?beam_events_warn_eof = true
	?energy_scan_normalize = false
	?logging => true
	[undefined] $job_id = [unknown string]
	[undefined] $compile_workspace = [unknown string]
	seed = 0
	$model_name = "QED"
	[undefined] process_num_id = [unknown integer]
	$method = "omega"
	?report_progress = true
	$restrictions = ""
	?omega_write_phs_output = false
	$omega_flags = ""
	?read_color_factors = true
	?slha_read_input = true
	?slha_read_spectrum = true
	?slha_read_decays = false
	$library_name = "show_4_lib"
	?alphas_is_fixed = true
	?alphas_from_lhapdf = false
	?alphas_from_pdf_builtin = false
	alphas_order = 0
	alphas_nf = 5
	?alphas_from_mz = false
	?alphas_from_lambda_qcd = false
	lambda_qcd = 2.000000000000E-01
	?fatal_beam_decay = true
	?helicity_selection_active = true
	helicity_selection_threshold = 1.000000000000E+10
	helicity_selection_cutoff = 1000
	$rng_method = "tao"
	?vis_diags = false
	?vis_diags_color = false
	?check_event_file = true
	$event_file_version = ""
	n_events = 0
	event_index_offset = 0
	?unweighted = true
	safety_factor = 1.000000000000E+00
	?negative_weights = false
	?resonance_history = false
	resonance_on_shell_limit = 4.000000000000E+00
	resonance_on_shell_turnoff = 0.000000000000E+00
	resonance_background_factor = 1.000000000000E+00
	?keep_beams = false
	?keep_remnants = true
	?recover_beams = true
	?update_event = false
	?update_sqme = false
	?update_weight = false
	?use_alphas_from_file = false
	?use_scale_from_file = false
	?allow_decays = true
	?auto_decays = false
	auto_decays_multiplicity = 2
	?auto_decays_radiative = false
	?decay_rest_frame = false
	?isotropic_decay = false
	?diagonal_decay = false
	[undefined] decay_helicity = [unknown integer]
	?polarized_events = false
	$polarization_mode = "helicity"
	?colorize_subevt = false
	tolerance = 0.000000000000E+00
	checkpoint = 0
	event_callback_interval = 0
	?pacify = false
	$out_file = ""
	?out_advance = true
	real_range* = <real_range>
	real_precision* = <real_precision>
	real_epsilon* = <real_epsilon>
	real_tiny* = <real_tiny>
	$integration_method = "vamp"
	threshold_calls = 10
	min_calls_per_channel = 10
	min_calls_per_bin = 10
	min_bins = 3
	max_bins = 20
	?stratified = true
	?use_vamp_equivalences = true
	?vamp_verbose = false
	?vamp_history_global = true
	?vamp_history_global_verbose = false
	?vamp_history_channels = false
	?vamp_history_channels_verbose = false
	$run_id = ""
	n_calls_test = 0
	?integration_timer = true
	?check_grid_file = true
	accuracy_goal = 0.000000000000E+00
	error_goal = 0.000000000000E+00
	relative_error_goal = 0.000000000000E+00
	integration_results_verbosity = 1
	error_threshold = 0.000000000000E+00
	channel_weights_power = 2.500000000000E-01
	[undefined] $integrate_workspace = [unknown string]
	$phs_method = "default"
	?vis_channels = false
	?check_phs_file = true
	$phs_file = ""
	?phs_only = false
	phs_threshold_s = 5.000000000000E+01
	phs_threshold_t = 1.000000000000E+02
	phs_off_shell = 2
	phs_t_channel = 6
	phs_e_scale = 1.000000000000E+01
	phs_m_scale = 1.000000000000E+01
	phs_q_scale = 1.000000000000E+01
	?phs_keep_nonresonant = true
	?phs_step_mapping = true
	?phs_step_mapping_exp = true
	?phs_s_mapping = true
	?vis_history = false
	n_bins = 20
	?normalize_bins = false
	$obs_label = ""
	$obs_unit = ""
	$title = ""
	$description = ""
	$x_label = ""
	$y_label = ""
	graph_width_mm = 130
	graph_height_mm = 90
	?y_log = false
	?x_log = false
	[undefined] x_min = [unknown real]
	[undefined] x_max = [unknown real]
	[undefined] y_min = [unknown real]
	[undefined] y_max = [unknown real]
	$gmlcode_bg = ""
	$gmlcode_fg = ""
	[undefined] ?draw_histogram = [unknown logical]
	[undefined] ?draw_base = [unknown logical]
	[undefined] ?draw_piecewise = [unknown logical]
	[undefined] ?fill_curve = [unknown logical]
	[undefined] ?draw_curve = [unknown logical]
	[undefined] ?draw_errors = [unknown logical]
	[undefined] ?draw_symbols = [unknown logical]
	[undefined] $fill_options = [unknown string]
	[undefined] $draw_options = [unknown string]
	[undefined] $err_options = [unknown string]
	[undefined] $symbol = [unknown string]
	?analysis_file_only = false
	kt_algorithm* = 0
	cambridge_algorithm* = 1
	antikt_algorithm* = 2
	genkt_algorithm* = 3
	cambridge_for_passive_algorithm* = 11
	genkt_for_passive_algorithm* = 13
	ee_kt_algorithm* = 50
	ee_genkt_algorithm* = 53
	plugin_algorithm* = 99
	undefined_jet_algorithm* = 999
	jet_algorithm = 999
	jet_r = 0.000000000000E+00
	jet_p = 0.000000000000E+00
	jet_ycut = 0.000000000000E+00
	?keep_flavors_when_clustering = false
	$sample = ""
	$sample_normalization = "auto"
	?sample_pacify = false
	?sample_select = true
	sample_max_tries = 10000
	sample_split_n_evt = 0
	sample_split_n_kbytes = 0
	sample_split_index = 0
	$rescan_input_format = "raw"
	?read_raw = true
	?write_raw = true
	$extension_raw = "evx"
	$extension_default = "evt"
	$debug_extension = "debug"
	?debug_process = true
	?debug_transforms = true
	?debug_decay = true
	?debug_verbose = true
	$dump_extension = "pset.dat"
	?dump_compressed = false
	?dump_weights = false
	?dump_summary = false
	?dump_screen = false
	?hepevt_ensure_order = false
	$extension_hepevt = "hepevt"
	$extension_ascii_short = "short.evt"
	$extension_ascii_long = "long.evt"
	$extension_athena = "athena.evt"
	$extension_mokka = "mokka.evt"
	$lhef_version = "2.0"
	$lhef_extension = "lhe"
	?lhef_write_sqme_prc = true
	?lhef_write_sqme_ref = false
	?lhef_write_sqme_alt = true
	$extension_lha = "lha"
	$extension_hepmc = "hepmc"
	?hepmc_output_cross_section = false
	$extension_lcio = "slcio"
	$extension_stdhep = "hep"
	$extension_stdhep_up = "up.hep"
	$extension_stdhep_ev4 = "ev4.hep"
	$extension_hepevt_verb = "hepevt.verb"
	$extension_lha_verb = "lha.verb"
	?allow_shower = true
	?ps_fsr_active = false
	?ps_isr_active = false
	?ps_taudec_active = false
	?muli_active = false
	$shower_method = "WHIZARD"
	?shower_verbose = false
	$ps_PYTHIA_PYGIVE = ""
	+$ps_PYTHIA8_config = ""
	+$ps_PYTHIA8_config_file = ""
	ps_mass_cutoff = 1.000000000000E+00
	ps_fsr_lambda = 2.900000000000E-01
	ps_isr_lambda = 2.900000000000E-01
	ps_max_n_flavors = 5
	?ps_isr_alphas_running = true
	?ps_fsr_alphas_running = true
	ps_fixed_alphas = 0.000000000000E+00
	?ps_isr_pt_ordered = false
	?ps_isr_angular_ordered = true
	ps_isr_primordial_kt_width = 0.000000000000E+00
	ps_isr_primordial_kt_cutoff = 5.000000000000E+00
	ps_isr_z_cutoff = 9.990000000000E-01
	ps_isr_minenergy = 1.000000000000E+00
	ps_isr_tscalefactor = 1.000000000000E+00
	?ps_isr_only_onshell_emitted_partons = false
	?allow_hadronization = true
	?hadronization_active = false
	$hadronization_method = "PYTHIA6"
	hadron_enhanced_fraction = 1.000000000000E-02
	hadron_enhanced_width = 2.000000000000E+00
	?ps_tauola_photos = false
	?ps_tauola_transverse = false
	?ps_tauola_dec_rad_cor = true
	ps_tauola_dec_mode1 = 0
	ps_tauola_dec_mode2 = 0
	ps_tauola_mh = 1.250000000000E+02
	ps_tauola_mix_angle = 9.000000000000E+01
	?ps_tauola_pol_vector = false
	?mlm_matching = false
	mlm_Qcut_ME = 0.000000000000E+00
	mlm_Qcut_PS = 0.000000000000E+00
	mlm_ptmin = 0.000000000000E+00
	mlm_etamax = 0.000000000000E+00
	mlm_Rmin = 0.000000000000E+00
	mlm_Emin = 0.000000000000E+00
	mlm_nmaxMEjets = 0
	mlm_ETclusfactor = 2.000000000000E-01
	mlm_ETclusminE = 5.000000000000E+00
	mlm_etaclusfactor = 1.000000000000E+00
	mlm_Rclusfactor = 1.000000000000E+00
	mlm_Eclusfactor = 1.000000000000E+00
	?powheg_matching = false
	?powheg_use_singular_jacobian = false
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_grid_sampling_points = 500000
	powheg_pt_min = 1.000000000000E+00
	powheg_lambda = 2.000000000000E-01
	?powheg_rebuild_grids = false
	?powheg_test_sudakov = false
	?powheg_disable_sudakov = false
	?ckkw_matching = false
	?omega_openmp => false
	?openmp_is_active* = false
	openmp_num_threads_default* = 1
	openmp_num_threads = 1
	?openmp_logging = false
	?mpi_logging = false
	$born_me_method = ""
	$loop_me_method = ""
	$correlation_me_method = ""
	$real_tree_me_method = ""
	$dglap_me_method = ""
	?test_soft_limit = false
	?test_coll_limit = false
	?test_anti_coll_limit = false
	$select_alpha_regions = ""
	$virtual_selection = "Full"
	?virtual_collinear_resonance_aware = true
	blha_top_yukawa = -1.000000000000E+00
	$blha_ew_scheme = "alpha_qed"
	openloops_verbosity = 1
	?openloops_use_cms = true
	openloops_phs_tolerance = 7
	openloops_stability_log = 0
	?openloops_switch_off_muon_yukawa = false
	$openloops_extra_cmd = ""
	?openloops_use_collier = true
	?disable_subtraction = false
	fks_dij_exp1 = 1.000000000000E+00
	fks_dij_exp2 = 1.000000000000E+00
	fks_xi_min = 1.000000000000E-07
	fks_y_max = 1.000000000000E+00
	?vis_fks_regions = false
	fks_xi_cut = 1.000000000000E+00
	fks_delta_zero = 2.000000000000E+00
	fks_delta_i = 2.000000000000E+00
	$fks_mapping_type = "default"
	$resonances_exclude_particles = "default"
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = false
	?fixed_order_nlo_events = false
	?check_event_weights_against_xsection = false
	?keep_failed_events = false
	gks_multiplicity = 0
	$gosam_filter_lo = ""
	$gosam_filter_nlo = ""
	$gosam_symmetries = "family,generation"
	form_threads = 2
	form_workspace = 1000
	$gosam_fc = ""
	mult_call_real = 1.000000000000E+00
	mult_call_virt = 1.000000000000E+00
	mult_call_dglap = 1.000000000000E+00
	$dalitz_plot = ""
	$nlo_correction_type = "QCD"
	$exclude_gauge_splittings = "c:b:t:e2:e3"
	?nlo_use_born_scale = true
	?nlo_cut_all_sqmes = true
	?nlo_use_real_partition = false
	real_partition_scale = 1.000000000000E+01
	$fc => Fortran-compiler
	$fcflags => Fortran-flags
	?rebuild_library = true
	?recompile_library = false
	?rebuild_phase_space = true
	?rebuild_grids = true
	?powheg_rebuild_grids = true
	?rebuild_events = true
	#####################################################
	QED.ee => 3.028600000000E-01
	QED.me => 5.110000000000E-04
	QED.mmu => 1.057000000000E-01
	QED.mtau => 1.777000000000E+00
	QED.particle* = PDG(0)
	QED.E_LEPTON* = PDG(11)
	QED.e-* = PDG(11)
	QED.e1* = PDG(11)
	QED.e+* = PDG(-11)
	QED.E1* = PDG(-11)
	QED.MU_LEPTON* = PDG(13)
	QED.m-* = PDG(13)
	QED.e2* = PDG(13)
	QED.mu-* = PDG(13)
	QED.m+* = PDG(-13)
	QED.E2* = PDG(-13)
	QED.mu+* = PDG(-13)
	QED.TAU_LEPTON* = PDG(15)
	QED.t-* = PDG(15)
	QED.e3* = PDG(15)
	QED.ta-* = PDG(15)
	QED.tau-* = PDG(15)
	QED.t+* = PDG(-15)
	QED.E3* = PDG(-15)
	QED.ta+* = PDG(-15)
	QED.tau+* = PDG(-15)
	QED.PHOTON* = PDG(22)
	QED.A* = PDG(22)
	QED.gamma* = PDG(22)
	QED.photon* = PDG(22)
	QED.charged* = PDG(11, 13, 15, -11, -13, -15)
	QED.neutral* = PDG(22)
	QED.colored* = PDG()
	[undefined] sqrts = [unknown real]
	luminosity = 0.000000000000E+00
	?sf_trace = false
	$sf_trace_file = ""
	?sf_allow_s_mapping = true
	$lhapdf_dir = ""
	$lhapdf_file = ""
	$lhapdf_photon_file = ""
	lhapdf_member = 0
	lhapdf_photon_scheme = 0
	$pdf_builtin_set = "CTEQ6L"
	?hoppet_b_matching = false
	isr_alpha = 0.000000000000E+00
	isr_q_max = 0.000000000000E+00
	isr_mass = 0.000000000000E+00
	isr_order = 3
	?isr_recoil = false
	?isr_keep_energy = false
	?isr_handler = false
	$isr_handler_mode = "trivial"
	epa_alpha = 0.000000000000E+00
	epa_x_min = 0.000000000000E+00
	epa_q_min = 0.000000000000E+00
	epa_q_max = 0.000000000000E+00
	epa_mass = 0.000000000000E+00
	?epa_recoil = false
	?epa_keep_energy = false
	?epa_handler = false
	$epa_handler_mode = "trivial"
	ewa_x_min = 0.000000000000E+00
	ewa_pt_max = 0.000000000000E+00
	ewa_mass = 0.000000000000E+00
	?ewa_recoil = false
	?ewa_keep_energy = false
	?circe1_photon1 = false
	?circe1_photon2 = false
	[undefined] circe1_sqrts = [unknown real]
	?circe1_generate = true
	?circe1_map = true
	circe1_mapping_slope = 2.000000000000E+00
	circe1_eps = 1.000000000000E-05
	circe1_ver = 0
	circe1_rev = 0
	$circe1_acc = "SBAND"
	circe1_chat = 0
	?circe1_with_radiation = false
	?circe2_polarized = true
	[undefined] $circe2_file = [unknown string]
	$circe2_design = "*"
	gaussian_spread1 = 0.000000000000E+00
	gaussian_spread2 = 0.000000000000E+00
	[undefined] $beam_events_file = [unknown string]
	?beam_events_warn_eof = true
	?energy_scan_normalize = false
	?logging => true
	[undefined] $job_id = [unknown string]
	[undefined] $compile_workspace = [unknown string]
	seed = 0
	$model_name = "QED"
	[undefined] process_num_id = [unknown integer]
	$method = "omega"
	?report_progress = true
	[user variable] ?me_verbose = false
	$restrictions = ""
	?omega_write_phs_output = false
	$omega_flags = ""
	?read_color_factors = true
	?slha_read_input = true
	?slha_read_spectrum = true
	?slha_read_decays = false
	$library_name = "show_4_lib"
	?alphas_is_fixed = true
	?alphas_from_lhapdf = false
	?alphas_from_pdf_builtin = false
	alphas_order = 0
	alphas_nf = 5
	?alphas_from_mz = false
	?alphas_from_lambda_qcd = false
	lambda_qcd = 2.000000000000E-01
	?fatal_beam_decay = true
	?helicity_selection_active = true
	helicity_selection_threshold = 1.000000000000E+10
	helicity_selection_cutoff = 1000
	$rng_method = "tao"
	?vis_diags = false
	?vis_diags_color = false
	?check_event_file = true
	$event_file_version = ""
	n_events = 0
	event_index_offset = 0
	?unweighted = true
	safety_factor = 1.000000000000E+00
	?negative_weights = false
	?resonance_history = false
	resonance_on_shell_limit = 4.000000000000E+00
	resonance_on_shell_turnoff = 0.000000000000E+00
	resonance_background_factor = 1.000000000000E+00
	?keep_beams = false
	?keep_remnants = true
	?recover_beams = true
	?update_event = false
	?update_sqme = false
	?update_weight = false
	?use_alphas_from_file = false
	?use_scale_from_file = false
	?allow_decays = true
	?auto_decays = false
	auto_decays_multiplicity = 2
	?auto_decays_radiative = false
	?decay_rest_frame = false
	?isotropic_decay = false
	?diagonal_decay = false
	[undefined] decay_helicity = [unknown integer]
	?polarized_events = false
	$polarization_mode = "helicity"
	?colorize_subevt = false
	tolerance = 0.000000000000E+00
	checkpoint = 0
	event_callback_interval = 0
	?pacify = false
	$out_file = ""
	?out_advance = true
	real_range* = <real_range>
	real_precision* = <real_precision>
	real_epsilon* = <real_epsilon>
	real_tiny* = <real_tiny>
	$integration_method = "vamp"
	threshold_calls = 10
	min_calls_per_channel = 10
	min_calls_per_bin = 10
	min_bins = 3
	max_bins = 20
	?stratified = true
	?use_vamp_equivalences = true
	?vamp_verbose = false
	?vamp_history_global = true
	?vamp_history_global_verbose = false
	?vamp_history_channels = false
	?vamp_history_channels_verbose = false
	$run_id = ""
	n_calls_test = 0
	?integration_timer = true
	?check_grid_file = true
	accuracy_goal = 0.000000000000E+00
	error_goal = 0.000000000000E+00
	relative_error_goal = 0.000000000000E+00
	integration_results_verbosity = 1
	error_threshold = 0.000000000000E+00
	channel_weights_power = 2.500000000000E-01
	[undefined] $integrate_workspace = [unknown string]
	$phs_method = "default"
	?vis_channels = false
	?check_phs_file = true
	$phs_file = ""
	?phs_only = false
	phs_threshold_s = 5.000000000000E+01
	phs_threshold_t = 1.000000000000E+02
	phs_off_shell = 2
	phs_t_channel = 6
	phs_e_scale = 1.000000000000E+01
	phs_m_scale = 1.000000000000E+01
	phs_q_scale = 1.000000000000E+01
	?phs_keep_nonresonant = true
	?phs_step_mapping = true
	?phs_step_mapping_exp = true
	?phs_s_mapping = true
	?vis_history = false
	n_bins = 20
	?normalize_bins = false
	$obs_label = ""
	$obs_unit = ""
	$title = ""
	$description = ""
	$x_label = ""
	$y_label = ""
	graph_width_mm = 130
	graph_height_mm = 90
	?y_log = false
	?x_log = false
	[undefined] x_min = [unknown real]
	[undefined] x_max = [unknown real]
	[undefined] y_min = [unknown real]
	[undefined] y_max = [unknown real]
	$gmlcode_bg = ""
	$gmlcode_fg = ""
	[undefined] ?draw_histogram = [unknown logical]
	[undefined] ?draw_base = [unknown logical]
	[undefined] ?draw_piecewise = [unknown logical]
	[undefined] ?fill_curve = [unknown logical]
	[undefined] ?draw_curve = [unknown logical]
	[undefined] ?draw_errors = [unknown logical]
	[undefined] ?draw_symbols = [unknown logical]
	[undefined] $fill_options = [unknown string]
	[undefined] $draw_options = [unknown string]
	[undefined] $err_options = [unknown string]
	[undefined] $symbol = [unknown string]
	?analysis_file_only = false
	kt_algorithm* = 0
	cambridge_algorithm* = 1
	antikt_algorithm* = 2
	genkt_algorithm* = 3
	cambridge_for_passive_algorithm* = 11
	genkt_for_passive_algorithm* = 13
	ee_kt_algorithm* = 50
	ee_genkt_algorithm* = 53
	plugin_algorithm* = 99
	undefined_jet_algorithm* = 999
	jet_algorithm = 999
	jet_r = 0.000000000000E+00
	jet_p = 0.000000000000E+00
	jet_ycut = 0.000000000000E+00
	?keep_flavors_when_clustering = false
	$sample = ""
	$sample_normalization = "auto"
	?sample_pacify = false
	?sample_select = true
	sample_max_tries = 10000
	sample_split_n_evt = 0
	sample_split_n_kbytes = 0
	sample_split_index = 0
	$rescan_input_format = "raw"
	?read_raw = true
	?write_raw = true
	$extension_raw = "evx"
	$extension_default = "evt"
	$debug_extension = "debug"
	?debug_process = true
	?debug_transforms = true
	?debug_decay = true
	?debug_verbose = true
	$dump_extension = "pset.dat"
	?dump_compressed = false
	?dump_weights = false
	?dump_summary = false
	?dump_screen = false
	?hepevt_ensure_order = false
	$extension_hepevt = "hepevt"
	$extension_ascii_short = "short.evt"
	$extension_ascii_long = "long.evt"
	$extension_athena = "athena.evt"
	$extension_mokka = "mokka.evt"
	$lhef_version = "2.0"
	$lhef_extension = "lhe"
	?lhef_write_sqme_prc = true
	?lhef_write_sqme_ref = false
	?lhef_write_sqme_alt = true
	$extension_lha = "lha"
	$extension_hepmc = "hepmc"
	?hepmc_output_cross_section = false
	$extension_lcio = "slcio"
	$extension_stdhep = "hep"
	$extension_stdhep_up = "up.hep"
	$extension_stdhep_ev4 = "ev4.hep"
	$extension_hepevt_verb = "hepevt.verb"
	$extension_lha_verb = "lha.verb"
	?allow_shower = true
	?ps_fsr_active = false
	?ps_isr_active = false
	?ps_taudec_active = false
	?muli_active = false
	$shower_method = "WHIZARD"
	?shower_verbose = false
	$ps_PYTHIA_PYGIVE = ""
	+$ps_PYTHIA8_config = ""
	+$ps_PYTHIA8_config_file = ""
	ps_mass_cutoff = 1.000000000000E+00
	ps_fsr_lambda = 2.900000000000E-01
	ps_isr_lambda = 2.900000000000E-01
	ps_max_n_flavors = 5
	?ps_isr_alphas_running = true
	?ps_fsr_alphas_running = true
	ps_fixed_alphas = 0.000000000000E+00
	?ps_isr_pt_ordered = false
	?ps_isr_angular_ordered = true
	ps_isr_primordial_kt_width = 0.000000000000E+00
	ps_isr_primordial_kt_cutoff = 5.000000000000E+00
	ps_isr_z_cutoff = 9.990000000000E-01
	ps_isr_minenergy = 1.000000000000E+00
	ps_isr_tscalefactor = 1.000000000000E+00
	?ps_isr_only_onshell_emitted_partons = false
	?allow_hadronization = true
	?hadronization_active = false
	$hadronization_method = "PYTHIA6"
	hadron_enhanced_fraction = 1.000000000000E-02
	hadron_enhanced_width = 2.000000000000E+00
	?ps_tauola_photos = false
	?ps_tauola_transverse = false
	?ps_tauola_dec_rad_cor = true
	ps_tauola_dec_mode1 = 0
	ps_tauola_dec_mode2 = 0
	ps_tauola_mh = 1.250000000000E+02
	ps_tauola_mix_angle = 9.000000000000E+01
	?ps_tauola_pol_vector = false
	?mlm_matching = false
	mlm_Qcut_ME = 0.000000000000E+00
	mlm_Qcut_PS = 0.000000000000E+00
	mlm_ptmin = 0.000000000000E+00
	mlm_etamax = 0.000000000000E+00
	mlm_Rmin = 0.000000000000E+00
	mlm_Emin = 0.000000000000E+00
	mlm_nmaxMEjets = 0
	mlm_ETclusfactor = 2.000000000000E-01
	mlm_ETclusminE = 5.000000000000E+00
	mlm_etaclusfactor = 1.000000000000E+00
	mlm_Rclusfactor = 1.000000000000E+00
	mlm_Eclusfactor = 1.000000000000E+00
	?powheg_matching = false
	?powheg_use_singular_jacobian = false
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_grid_sampling_points = 500000
	powheg_pt_min = 1.000000000000E+00
	powheg_lambda = 2.000000000000E-01
	?powheg_rebuild_grids = false
	?powheg_test_sudakov = false
	?powheg_disable_sudakov = false
	?ckkw_matching = false
	?omega_openmp => false
	?openmp_is_active* = false
	openmp_num_threads_default* = 1
	openmp_num_threads = 1
	?openmp_logging = false
	?mpi_logging = false
	$born_me_method = ""
	$loop_me_method = ""
	$correlation_me_method = ""
	$real_tree_me_method = ""
	$dglap_me_method = ""
	?test_soft_limit = false
	?test_coll_limit = false
	?test_anti_coll_limit = false
	$select_alpha_regions = ""
	$virtual_selection = "Full"
	?virtual_collinear_resonance_aware = true
	blha_top_yukawa = -1.000000000000E+00
	$blha_ew_scheme = "alpha_qed"
	openloops_verbosity = 1
	?openloops_use_cms = true
	openloops_phs_tolerance = 7
	openloops_stability_log = 0
	?openloops_switch_off_muon_yukawa = false
	$openloops_extra_cmd = ""
	?openloops_use_collier = true
	?disable_subtraction = false
	fks_dij_exp1 = 1.000000000000E+00
	fks_dij_exp2 = 1.000000000000E+00
	fks_xi_min = 1.000000000000E-07
	fks_y_max = 1.000000000000E+00
	?vis_fks_regions = false
	fks_xi_cut = 1.000000000000E+00
	fks_delta_zero = 2.000000000000E+00
	fks_delta_i = 2.000000000000E+00
	$fks_mapping_type = "default"
	$resonances_exclude_particles = "default"
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = false
	?fixed_order_nlo_events = false
	?check_event_weights_against_xsection = false
	?keep_failed_events = false
	gks_multiplicity = 0
	$gosam_filter_lo = ""
	$gosam_filter_nlo = ""
	$gosam_symmetries = "family,generation"
	form_threads = 2
	form_workspace = 1000
	$gosam_fc = ""
	mult_call_real = 1.000000000000E+00
	mult_call_virt = 1.000000000000E+00
	mult_call_dglap = 1.000000000000E+00
	$dalitz_plot = ""
	$nlo_correction_type = "QCD"
	$exclude_gauge_splittings = "c:b:t:e2:e3"
	?nlo_use_born_scale = true
	?nlo_cut_all_sqmes = true
	?nlo_use_real_partition = false
	real_partition_scale = 1.000000000000E+01
	$fc => Fortran-compiler
	$fcflags => Fortran-flags
	?rebuild_library = true
	?recompile_library = false
	?rebuild_phase_space = true
	?rebuild_grids = true
	?powheg_rebuild_grids = true
	?rebuild_events = true
	[user variable] foo = PDG(11, 13, 15)
	[user variable] bar = ( 2.000000000000E+00, 3.000000000000E+00)
	\| WHIZARD run finished.
	\|=============================================================================\|
	Index: trunk/share/tests/functional_tests/ref-output/pythia6_1.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output/pythia6_1.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output/pythia6_1.ref (revision 8190)
	@@ -1,632 +1,641 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	?pacify = true
	SM.me => 0.00000E+00
	$method = "omega"
	\| Process library 'pythia6_1_lib': recorded process 'pythia6_1_p1'
	\| Process library 'pythia6_1_lib': compiling ...
	\| Process library 'pythia6_1_lib': writing makefile
	\| Process library 'pythia6_1_lib': removing old files
	\| Process library 'pythia6_1_lib': writing driver
	\| Process library 'pythia6_1_lib': creating source code
	\| Process library 'pythia6_1_lib': compiling sources
	\| Process library 'pythia6_1_lib': linking
	\| Process library 'pythia6_1_lib': loading
	\| Process library 'pythia6_1_lib': ... success.
	seed = 0
	$phs_method = "wood"
	$integration_method = "vamp"
	sqrts = 1.00000E+03
	openmp_num_threads = 1
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process pythia6_1_p1:
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e- (mass = 0.0000000E+00 GeV)
	\| e+ (mass = 0.0000000E+00 GeV)
	\| sqrts = 1.000000000000E+03 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'pythia6_1_p1.i1.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'pythia6_1_p1'
	\| Library name = 'pythia6_1_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'pythia6_1_p1_i1': e-, e+ => u, ubar [omega]
	\| ------------------------------------------------------------------------
	\| Phase space: 2 channels, 2 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Applying user-defined cuts.
	\| Starting integration for process 'pythia6_1_p1'
	\| Integrate: iterations = 3:1000:"g", 3:1000
	\| Integrator: 2 chains, 2 channels, 2 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 1000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 784 1.688E+02 1.42E+00 0.84 0.24 36.5
	2 784 1.680E+02 8.60E-01 0.51 0.14 36.2
	3 784 1.686E+02 7.93E-01 0.47 0.13 57.3
	\|-----------------------------------------------------------------------------\|
	3 2352 1.684E+02 5.39E-01 0.32 0.16 57.3 0.19 3
	\|-----------------------------------------------------------------------------\|
	4 784 1.684E+02 7.16E-01 0.43 0.12 56.9
	5 784 1.699E+02 7.15E-01 0.42 0.12 57.4
	6 784 1.691E+02 6.91E-01 0.41 0.11 57.1
	\|-----------------------------------------------------------------------------\|
	6 2352 1.691E+02 4.08E-01 0.24 0.12 57.1 1.00 3
	\|=============================================================================\|
	n_events = 1
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?allow_shower = true
	?ps_fsr_active = true
	$shower_method = "PYTHIA6"
	$sample = "pythia6_1a"
	\| Starting simulation for process 'pythia6_1_p1'
	\| Simulate: using integration grids from file 'pythia6_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 5.9120E-03
	\| Events: writing to ASCII file 'pythia6_1a.debug'
	\| Events: writing to raw file 'pythia6_1a.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 100.00 %
	\| Events: closing ASCII file 'pythia6_1a.debug'
	\| Events: closing raw file 'pythia6_1a.evx'
	?hadronization_active = true
	$sample = "pythia6_1b"
	\| Starting simulation for process 'pythia6_1_p1'
	\| Simulate: using integration grids from file 'pythia6_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| Simulate: activating hadronization
	\| Hadronization: Using PYTHIA6 interface for hadronization and decays
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 5.9120E-03
	\| Events: writing to ASCII file 'pythia6_1b.debug'
	\| Events: writing to raw file 'pythia6_1b.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 50.00 %
	\| Events: closing ASCII file 'pythia6_1b.debug'
	\| Events: closing raw file 'pythia6_1b.evx'
	\| WHIZARD run finished.
	\|=============================================================================\|
	Contents of pythia6_1a.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 8.05442E-03
	Squared matrix el. (prc) = 8.05442E-03
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_1_p1'
	TAO random-number generator:
	seed = 2
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 2 [i] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 3 [o] f(2)c(1 )
	E = 5.000000E+02
	P = -4.486758E+02 4.332604E+01 -2.163628E+02
	T = 0.000000000E+00
	Parents: 1 2
	Particle 4 [o] f(-2)c(-1 )
	E = 5.000000E+02
	P = 4.486758E+02 -4.332604E+01 2.163628E+02
	T = 0.000000000E+00
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_1_p1'
	TAO random-number generator:
	seed = 3
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	3 [r] u 1 0 1-2 19-35 500.000 -448.676 43.326 -216.363 0.000
	4 [r] ubar 0 1 1-2 5-18,36 500.000 448.676 -43.326 216.363 0.000
	5 [o] ubar 0 500 4 [none] 3.598 3.539 -0.010 -0.651 0.000
	6 [o] gl 500 501 4 [none] 18.931 18.353 3.640 -2.881 0.000
	7 [o] gl 501 502 4 [none] 2.844 2.782 0.545 -0.238 0.000
	8 [o] gl 502 503 4 [none] 10.566 9.349 4.466 -2.074 0.000
	9 [o] gl 503 504 4 [none] 1.456 0.975 0.224 1.057 0.000
	10 [o] gl 504 505 4 [none] 0.936 0.823 -0.208 0.394 0.000
	11 [o] gl 505 506 4 [none] 7.861 5.806 -3.168 4.248 0.000
	12 [o] gl 506 507 4 [none] 29.403 16.613 -13.860 19.911 0.000
	13 [o] gl 507 508 4 [none] 32.368 29.817 -2.297 12.384 0.000
	14 [o] gl 508 509 4 [none] 33.165 29.155 -3.404 15.438 0.000
	15 [o] gl 509 510 4 [none] 30.464 28.421 -4.391 10.052 0.000
	16 [o] gl 510 511 4 [none] 79.232 72.041 -12.976 30.323 0.000
	17 [o] gl 511 512 4 [none] 9.653 8.192 -1.742 4.800 0.000
	18 [o] u 512 0 4 [none] 33.686 30.023 1.213 15.225 0.109
	19 [o] u 513 0 3 [none] 174.391 -136.968 30.729 -103.478 0.000
	20 [o] gl 514 513 3 [none] 10.408 -7.285 2.280 -7.075 0.000
	21 [o] gl 515 514 3 [none] 4.885 -3.912 0.771 -2.823 0.000
	22 [o] gl 516 515 3 [none] 75.700 -62.488 21.256 -37.067 0.000
	23 [o] gl 517 516 3 [none] 24.164 -19.403 6.522 -12.842 0.000
	24 [o] gl 518 517 3 [none] 10.624 -9.607 1.388 -4.317 0.000
	25 [o] gl 519 518 3 [none] 66.832 -60.077 10.971 -27.145 0.000
	26 [o] gl 520 519 3 [none] 84.567 -75.655 15.140 -34.622 0.000
	27 [o] gl 521 520 3 [none] 16.031 -14.716 1.694 -6.130 0.000
	28 [o] gl 522 521 3 [none] 2.570 -1.997 0.649 -1.483 0.000
	29 [o] gl 523 522 3 [none] 6.795 -4.485 1.260 -4.947 0.000
	30 [o] gl 524 523 3 [none] 0.567 -0.439 0.261 0.245 0.000
	31 [o] gl 525 524 3 [none] 2.337 0.661 -0.929 2.040 0.000
	32 [o] gl 526 525 3 [none] 80.526 21.414 -51.139 58.401 0.000
	33 [o] gl 527 526 3 [none] 4.172 3.622 -2.008 0.511 0.000
	34 [o] gl 528 527 3 [none] 3.059 1.908 -2.001 1.310 0.000
	35 [o] gl 529 528 3 [none] 2.342 -2.119 -0.966 0.252 0.000
	36 [o] ubar 0 529 4 [none] 135.863 115.657 -3.912 71.182 0.109
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.00000E+03
	sqrts_hat* => 1.00000E+03
	n_in* => 2
	n_out* => 32
	n_tot* => 34
	$process_id* => "pythia6_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 8.05442E-03
	sqme_ref* => 8.05442E-03
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02\| 0.0000000E+00\| 1)
	2 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02\| 0.0000000E+00\| 2)
	3 prt(o:-2\| 3.5981565E+00; 3.5387192E+00,-1.0165755E-02,-6.5122481E-01\| 0.0000000E+00\| 3)
	4 prt(o:21\| 1.8931465E+01; 1.8353364E+01, 3.6404612E+00,-2.8812253E+00\| 0.0000000E+00\| 4)
	5 prt(o:21\| 2.8444402E+00; 2.7815606E+00, 5.4510118E-01,-2.3796155E-01\| 0.0000000E+00\| 5)
	6 prt(o:21\| 1.0566496E+01; 9.3488564E+00, 4.4662907E+00,-2.0741182E+00\| 0.0000000E+00\| 6)
	7 prt(o:21\| 1.4556114E+00; 9.7521782E-01, 2.2437720E-01, 1.0570759E+00\| 0.0000000E+00\| 7)
	8 prt(o:21\| 9.3576008E-01; 8.2277643E-01,-2.0795480E-01, 3.9425965E-01\| 0.0000000E+00\| 8)
	9 prt(o:21\| 7.8612368E+00; 5.8064385E+00,-3.1679474E+00, 4.2483438E+00\| 0.0000000E+00\| 9)
	10 prt(o:21\| 2.9403207E+01; 1.6613431E+01,-1.3859714E+01, 1.9911072E+01\| 0.0000000E+00\| 10)
	11 prt(o:21\| 3.2368084E+01; 2.9817197E+01,-2.2965608E+00, 1.2383593E+01\| 0.0000000E+00\| 11)
	12 prt(o:21\| 3.3165181E+01; 2.9155166E+01,-3.4037046E+00, 1.5437627E+01\| 0.0000000E+00\| 12)
	13 prt(o:21\| 3.0464463E+01; 2.8421113E+01,-4.3910330E+00, 1.0051999E+01\| 0.0000000E+00\| 13)
	14 prt(o:21\| 7.9231948E+01; 7.2040746E+01,-1.2975638E+01, 3.0322686E+01\| 0.0000000E+00\| 14)
	15 prt(o:21\| 9.6529594E+00; 8.1919784E+00,-1.7423528E+00, 4.7995125E+00\| 0.0000000E+00\| 15)
	16 prt(o:2\| 3.3685654E+01; 3.0022512E+01, 1.2133032E+00, 1.5224688E+01\| 1.0890000E-01\| 16)
	17 prt(o:2\| 1.7439138E+02;-1.3696831E+02, 3.0729056E+01,-1.0347831E+02\| 0.0000000E+00\| 17)
	18 prt(o:21\| 1.0407931E+01;-7.2849793E+00, 2.2797853E+00,-7.0750742E+00\| 0.0000000E+00\| 18)
	19 prt(o:21\| 4.8853210E+00;-3.9121574E+00, 7.7098767E-01,-2.8225812E+00\| 0.0000000E+00\| 19)
	20 prt(o:21\| 7.5700177E+01;-6.2487906E+01, 2.1256201E+01,-3.7066864E+01\| 0.0000000E+00\| 20)
	21 prt(o:21\| 2.4164393E+01;-1.9403045E+01, 6.5217246E+00,-1.2841606E+01\| 0.0000000E+00\| 21)
	22 prt(o:21\| 1.0623534E+01;-9.6070431E+00, 1.3880954E+00,-4.3171036E+00\| 0.0000000E+00\| 22)
	23 prt(o:21\| 6.6831783E+01;-6.0077150E+01, 1.0971284E+01,-2.7145059E+01\| 0.0000000E+00\| 23)
	24 prt(o:21\| 8.4567145E+01;-7.5655144E+01, 1.5140259E+01,-3.4621868E+01\| 0.0000000E+00\| 24)
	25 prt(o:21\| 1.6031420E+01;-1.4715815E+01, 1.6940283E+00,-6.1303751E+00\| 0.0000000E+00\| 25)
	26 prt(o:21\| 2.5702072E+00;-1.9967082E+00, 6.4877065E-01,-1.4826390E+00\| 0.0000000E+00\| 26)
	27 prt(o:21\| 6.7949685E+00;-4.4846834E+00, 1.2596295E+00,-4.9469733E+00\| 0.0000000E+00\| 27)
	28 prt(o:21\| 5.6681809E-01;-4.3944735E-01, 2.6073280E-01, 2.4533076E-01\| 0.0000000E+00\| 28)
	29 prt(o:21\| 2.3367903E+00; 6.6111797E-01,-9.2884236E-01, 2.0397950E+00\| 0.0000000E+00\| 29)
	30 prt(o:21\| 8.0526424E+01; 2.1414458E+01,-5.1139300E+01, 5.8401181E+01\| 0.0000000E+00\| 30)
	31 prt(o:21\| 4.1721997E+00; 3.6215907E+00,-2.0075707E+00, 5.1087212E-01\| 0.0000000E+00\| 31)
	32 prt(o:21\| 3.0594925E+00; 1.9080561E+00,-2.0009258E+00, 1.3100045E+00\| 0.0000000E+00\| 32)
	33 prt(o:21\| 2.3420615E+00;-2.1186265E+00,-9.6588011E-01, 2.5248665E-01\| 0.0000000E+00\| 33)
	34 prt(o:-2\| 1.3586329E+02; 1.1565672E+02,-3.9124982E+00, 7.1182454E+01\| 1.0890000E-01\| 34)
	========================================================================
	Contents of pythia6_1b.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 4.45831E-02
	Squared matrix el. (prc) = 4.45831E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_1_p1'
	TAO random-number generator:
	seed = 6
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 2 [i] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -5.000000E+02
	T = 0.000000000E+00
	Children: 3 4
	Particle 3 [o] f(2)c(1 )
	E = 5.000000E+02
	P = 2.184915E+01 3.539777E+02 3.524519E+02
	T = 0.000000000E+00
	Parents: 1 2
	Particle 4 [o] f(-2)c(-1 )
	E = 5.000000E+02
	P = -2.184915E+01 -3.539777E+02 -3.524519E+02
	T = 0.000000000E+00
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	3 [r] u 1 0 1-2 5-8 500.000 21.849 353.978 352.452 0.000
	4 [r] ubar 0 1 1-2 9-14 500.000 -21.849 -353.978 -352.452 0.000
	5 [o] u 500 0 3 [none] 466.568 19.606 330.454 328.789 0.000
	6 [o] gl 501 500 3 [none] 29.193 1.158 21.230 20.004 0.000
	7 [o] gl 502 501 3 [none] 3.377 0.864 2.345 2.270 0.000
	8 [o] gl 503 502 3 [none] 1.038 0.182 -0.680 0.762 0.000
	9 [o] gl 504 503 4 [none] 21.446 -5.574 -13.946 -15.310 0.000
	10 [o] gl 505 504 4 [none] 4.359 -0.248 -3.122 -3.033 0.000
	11 [o] gl 506 505 4 [none] 31.879 1.134 -23.196 -21.839 0.000
	12 [o] gl 507 506 4 [none] 103.768 -2.334 -71.831 -74.852 0.000
	13 [o] gl 508 507 4 [none] 145.063 -6.335 -102.969 -101.983 0.000
	14 [o] ubar 0 508 4 [none] 193.307 -8.454 -138.284 -134.810 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	========================================================================
	Event transform: hadronization
	------------------------------------------------------------------------
	Associated process: 'pythia6_1_p1'
	TAO random-number generator:
	seed = 9
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	3 [r] u 1 0 1-2 5-8 500.000 21.849 353.978 352.452 0.000
	4 [r] ubar 0 1 1-2 9-14 500.000 -21.849 -353.978 -352.452 0.000
	5 [r] u 500 0 3 15 466.568 19.606 330.454 328.789 0.000
	6 [r] gl 501 500 3 15 29.193 1.158 21.230 20.004 0.000
	7 [r] gl 502 501 3 15 3.377 0.864 2.345 2.270 0.000
	8 [r] gl 503 502 3 15 1.038 0.182 -0.680 0.762 0.000
	9 [r] gl 504 503 4 15 21.446 -5.574 -13.946 -15.310 0.000
	10 [r] gl 505 504 4 15 4.359 -0.248 -3.122 -3.033 0.000
	11 [r] gl 506 505 4 15 31.879 1.134 -23.196 -21.839 0.000
	12 [r] gl 507 506 4 15 103.768 -2.334 -71.831 -74.852 0.000
	13 [r] gl 508 507 4 15 145.063 -6.335 -102.969 -101.983 0.000
	14 [r] ubar 0 508 4 15 193.307 -8.454 -138.284 -134.810 0.000
	15 [r] hr3 0 0 5-14 16-43 1000.000 0.000 0.000 0.000 1000000.000
	16 [o] pip 0 0 15 [none] 67.753 2.389 48.075 47.681 0.019
	17 [r] omega 0 0 15 44-45 161.703 7.393 114.682 113.756 0.608
	18 [r] rho0 0 0 15 46-47 104.334 4.120 73.953 73.477 0.594
	19 [o] p 0 0 15 [none] 77.915 3.809 55.057 54.991 0.880
	20 [o] pim 0 0 15 [none] 2.775 0.076 2.094 1.815 0.019
	21 [r] Deltaba 0 0 15 48-49 57.701 2.058 40.981 40.550 1.415
	22 [r] kstarp 0 0 15 50-51 7.402 0.981 4.803 5.468 0.862
	23 [r] kstarm 0 0 15 52-53 15.006 -0.384 11.090 10.062 0.816
	24 [o] pip 0 0 15 [none] 0.837 0.591 0.484 0.313 0.019
	25 [r] rho0 0 0 15 54-55 2.293 0.102 0.410 2.120 0.586
	26 [o] pim 0 0 15 [none] 0.415 0.270 0.262 -0.104 0.019
	27 [o] pip 0 0 15 [none] 0.784 -0.050 0.711 0.295 0.019
	28 [r] k0 0 0 15 56 0.969 0.084 0.524 0.640 0.248
	29 [r] kstar0 0 0 15 57-58 1.366 -0.438 -0.462 -0.797 0.827
	30 [r] pi0 0 0 15 59-60 2.247 -0.061 -1.632 -1.538 0.018
	31 [r] eta 0 0 15 61-63 3.200 -1.234 -1.930 -2.166 0.300
	32 [r] kstar0 0 0 15 64-65 3.179 -1.110 -2.044 -1.930 0.973
	33 [r] kstarm 0 0 15 66-67 3.811 0.535 -2.812 -2.356 0.777
	34 [r] rhop 0 0 15 68-69 5.537 -0.779 -3.450 -4.190 0.603
	35 [r] omega 0 0 15 70-71 5.755 -0.732 -4.452 -3.484 0.617
	36 [o] pim 0 0 15 [none] 2.496 0.110 -1.407 -2.054 0.019
	37 [r] omega 0 0 15 72-74 11.091 -0.447 -8.115 -7.507 0.598
	38 [r] etaprim 0 0 15 75-76 15.497 -1.041 -10.563 -11.250 0.917
	39 [o] p 0 0 15 [none] 15.790 0.423 -11.076 -11.207 0.880
	40 [r] rhop 0 0 15 77-78 45.146 -0.608 -31.859 -31.969 0.858
	41 [o] pbar 0 0 15 [none] 83.872 -3.301 -58.266 -60.231 0.880
	42 [r] rhom 0 0 15 79-80 235.808 -9.578 -168.216 -164.974 0.716
	43 [r] pi0 0 0 15 81-82 65.319 -3.177 -46.845 -45.410 0.018
	44 [o] pim 0 0 17 [none] 106.685 4.542 75.717 75.019 0.019
	45 [o] pip 0 0 17 [none] 55.018 2.852 38.965 38.737 0.019
	46 [o] pim 0 0 18 [none] 38.078 1.443 26.753 27.058 0.019
	47 [o] pip 0 0 18 [none] 66.256 2.677 47.200 46.420 0.019
	48 [o] nbar 0 0 21 [none] 42.546 1.520 30.333 29.780 0.883
	49 [o] pim 0 0 21 [none] 15.155 0.538 10.648 10.770 0.019
	50 [r] k0 0 0 22 83 2.336 0.246 1.553 1.654 0.248
	51 [o] pip 0 0 22 [none] 5.066 0.734 3.250 3.814 0.019
	52 [r] k0 0 0 23 84 7.409 0.037 5.563 4.867 0.248
	53 [o] pim 0 0 23 [none] 7.597 -0.421 5.527 5.194 0.019
	54 [o] pim 0 0 25 [none] 0.835 -0.164 0.413 0.693 0.019
	55 [o] pip 0 0 25 [none] 1.458 0.267 -0.002 1.426 0.019
	56 [o] kL0 0 0 28 [none] 0.969 0.084 0.524 0.640 0.248
	57 [o] km 0 0 29 [none] 1.189 -0.527 -0.424 -0.845 0.244
	58 [o] pip 0 0 29 [none] 0.177 0.089 -0.038 0.048 0.019
	59 [o] A 0 0 30 [none] 0.910 0.030 -0.635 -0.651 0.000
	60 [o] A 0 0 30 [none] 1.337 -0.090 -0.996 -0.887 0.000
	61 [o] pip 0 0 31 [none] 0.651 -0.186 -0.418 -0.442 0.019
	62 [o] pim 0 0 31 [none] 1.653 -0.581 -1.029 -1.147 0.019
	63 [r] pi0 0 0 31 85-86 0.896 -0.467 -0.483 -0.577 0.018
	64 [o] kp 0 0 32 [none] 2.146 -1.042 -1.422 -1.120 0.244
	65 [o] pim 0 0 32 [none] 1.033 -0.068 -0.621 -0.810 0.019
	66 [o] km 0 0 33 [none] 1.716 0.095 -1.359 -0.919 0.244
	67 [r] pi0 0 0 33 87-88 2.095 0.440 -1.453 -1.437 0.018
	68 [o] pip 0 0 34 [none] 1.350 -0.260 -1.042 -0.806 0.019
	69 [r] pi0 0 0 34 89-90 4.187 -0.519 -2.408 -3.384 0.018
	70 [o] A 0 0 35 [none] 3.865 -0.761 -3.118 -2.153 0.000
	71 [r] pi0 0 0 35 91-92 1.890 0.029 -1.334 -1.332 0.018
	72 [o] pip 0 0 37 [none] 2.885 0.068 -2.146 -1.923 0.019
	73 [o] pim 0 0 37 [none] 7.148 -0.474 -5.271 -4.802 0.019
	74 [r] pi0 0 0 37 93-94 1.058 -0.041 -0.698 -0.782 0.018
	75 [o] A 0 0 38 [none] 3.958 -0.511 -2.702 -2.846 0.000
	76 [r] rho0 0 0 38 95-96 11.539 -0.530 -7.861 -8.404 0.444
	77 [o] pip 0 0 40 [none] 28.125 0.031 -19.939 -19.835 0.019
	78 [r] pi0 0 0 40 97-98 17.022 -0.639 -11.919 -12.134 0.018
	79 [o] pim 0 0 42 [none] 100.147 -3.697 -71.546 -69.978 0.019
	80 [r] pi0 0 0 42 99-100 135.662 -5.881 -96.670 -94.996 0.018
	81 [o] A 0 0 43 [none] 24.120 -1.223 -17.326 -16.736 0.000
	82 [o] A 0 0 43 [none] 41.199 -1.954 -29.519 -28.674 0.000
	83 [r] kS0 0 0 50 101-102 2.336 0.246 1.553 1.654 0.248
	84 [o] kL0 0 0 52 [none] 7.409 0.037 5.563 4.867 0.248
	85 [o] A 0 0 63 [none] 0.465 -0.201 -0.233 -0.349 0.000
	86 [o] A 0 0 63 [none] 0.431 -0.267 -0.250 -0.228 0.000
	87 [o] A 0 0 67 [none] 0.432 0.137 -0.309 -0.269 0.000
	88 [o] A 0 0 67 [none] 1.663 0.303 -1.145 -1.168 0.000
	89 [o] A 0 0 69 [none] 2.134 -0.290 -1.175 -1.758 0.000
	90 [o] A 0 0 69 [none] 2.053 -0.229 -1.233 -1.625 0.000
	91 [o] A 0 0 71 [none] 0.431 -0.007 -0.342 -0.263 0.000
	92 [o] A 0 0 71 [none] 1.459 0.036 -0.993 -1.068 0.000
	93 [o] A 0 0 74 [none] 1.009 -0.030 -0.691 -0.735 0.000
	94 [o] A 0 0 74 [none] 0.048 -0.011 -0.007 -0.047 0.000
	95 [o] pip 0 0 76 [none] 8.541 -0.303 -5.652 -6.395 0.019
	96 [o] pim 0 0 76 [none] 2.998 -0.227 -2.208 -2.009 0.019
	97 [o] A 0 0 78 [none] 15.168 -0.591 -10.596 -10.838 0.000
	98 [o] A 0 0 78 [none] 1.853 -0.048 -1.324 -1.296 0.000
	99 [o] A 0 0 80 [none] 49.156 -2.151 -34.984 -34.465 0.000
	100 [o] A 0 0 80 [none] 86.506 -3.731 -61.687 -60.532 0.000
	101 [r] pi0 0 0 83 103-104 1.011 0.177 0.521 0.838 0.018
	102 [r] pi0 0 0 83 105-106 1.325 0.070 1.032 0.816 0.018
	103 [o] A 0 0 101 [none] 0.064 0.037 0.013 0.050 0.000
	104 [o] A 0 0 101 [none] 0.947 0.140 0.508 0.787 0.000
	105 [o] A 0 0 102 [none] 0.805 0.010 0.665 0.453 0.000
	106 [o] A 0 0 102 [none] 0.520 0.059 0.367 0.363 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	------------------------------------------------------------------------
	Hadronization settings:
	------------------------------------------------------------------------
	Master switches:
	active = T
	General settings:
	hadron_method = PYTHIA6
	pT generation parameters
	enhanced_fraction = 1.000000000000E-02
	enhanced_width = 2.000000000000E+00
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.00000E+03
	sqrts_hat* => 1.00000E+03
	n_in* => 2
	n_out* => 59
	n_tot* => 61
	$process_id* => "pythia6_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 4.45831E-02
	sqme_ref* => 4.45831E-02
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02\| 0.0000000E+00\| 1)
	2 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02\| 0.0000000E+00\| 2)
	3 prt(o:211\| 6.7752556E+01; 2.3891356E+00, 4.8074775E+01, 4.7681206E+01\| 1.9479785E-02\| 3)
	4 prt(o:2212\| 7.7914542E+01; 3.8085326E+00, 5.5057434E+01, 5.4990631E+01\| 8.8035059E-01\| 4)
	5 prt(o:-211\| 2.7753159E+00; 7.5962113E-02, 2.0937170E+00, 1.8147941E+00\| 1.9479785E-02\| 5)
	6 prt(o:211\| 8.3724928E-01; 5.9094265E-01, 4.8409794E-01, 3.1295775E-01\| 1.9479785E-02\| 6)
	7 prt(o:-211\| 4.1461887E-01; 2.6960502E-01, 2.6244959E-01,-1.0422269E-01\| 1.9479785E-02\| 7)
	8 prt(o:211\| 7.8408749E-01;-4.9856152E-02, 7.1131321E-01, 2.9472240E-01\| 1.9479785E-02\| 8)
	9 prt(o:-211\| 2.4955128E+00; 1.0998237E-01,-1.4067875E+00,-2.0535231E+00\| 1.9479785E-02\| 9)
	10 prt(o:2212\| 1.5790441E+01; 4.2341680E-01,-1.1075863E+01,-1.1207303E+01\| 8.8035059E-01\| 10)
	11 prt(o:-2212\| 8.3872063E+01;-3.3011620E+00,-5.8265917E+01,-6.0231453E+01\| 8.8035059E-01\| 11)
	12 prt(o:-211\| 1.0668462E+02; 4.5416612E+00, 7.5717094E+01, 7.5019218E+01\| 1.9479785E-02\| 12)
	13 prt(o:211\| 5.5018023E+01; 2.8518062E+00, 3.8965338E+01, 3.8736714E+01\| 1.9479785E-02\| 13)
	14 prt(o:-211\| 3.8077985E+01; 1.4427316E+00, 2.6752782E+01, 2.7057728E+01\| 1.9479785E-02\| 14)
	15 prt(o:211\| 6.6255756E+01; 2.6769462E+00, 4.7200206E+01, 4.6419611E+01\| 1.9479785E-02\| 15)
	16 prt(o:-2112\| 4.2545575E+01; 1.5201810E+00, 3.0333361E+01, 2.9779513E+01\| 8.8279178E-01\| 16)
	17 prt(o:-211\| 1.5155095E+01; 5.3793658E-01, 1.0647626E+01, 1.0770149E+01\| 1.9479785E-02\| 17)
	18 prt(o:211\| 5.0662164E+00; 7.3424804E-01, 3.2502110E+00, 3.8136698E+00\| 1.9479785E-02\| 18)
	19 prt(o:-211\| 7.5974686E+00;-4.2093254E-01, 5.5265497E+00, 5.1944311E+00\| 1.9479785E-02\| 19)
	20 prt(o:-211\| 8.3514939E-01;-1.6432696E-01, 4.1292777E-01, 6.9316811E-01\| 1.9479785E-02\| 20)
	21 prt(o:211\| 1.4577678E+00; 2.6662253E-01,-2.4912953E-03, 1.4263637E+00\| 1.9479785E-02\| 21)
	22 prt(o:130\| 9.6918650E-01; 8.3986597E-02, 5.2392649E-01, 6.4038607E-01\| 2.4767543E-01\| 22)
	23 prt(o:-321\| 1.1893167E+00;-5.2737617E-01,-4.2357921E-01,-8.4456401E-01\| 2.4364096E-01\| 23)
	24 prt(o:211\| 1.7679940E-01; 8.9491333E-02,-3.8219321E-02, 4.8050253E-02\| 1.9479785E-02\| 24)
	25 prt(o:22\| 9.1004689E-01; 2.9828042E-02,-6.3525340E-01,-6.5095986E-01\| 0.0000000E+00\| 25)
	26 prt(o:22\| 1.3372752E+00;-9.0354572E-02,-9.9644759E-01,-8.8726164E-01\| 0.0000000E+00\| 26)
	27 prt(o:211\| 6.5086645E-01;-1.8624821E-01,-4.1761295E-01,-4.4165414E-01\| 1.9479785E-02\| 27)
	28 prt(o:-211\| 1.6526225E+00;-5.8081381E-01,-1.0286671E+00,-1.1472492E+00\| 1.9479785E-02\| 28)
	29 prt(o:321\| 2.1462661E+00;-1.0423096E+00,-1.4223049E+00,-1.1195789E+00\| 2.4364096E-01\| 29)
	30 prt(o:-211\| 1.0325733E+00;-6.7898842E-02,-6.2139753E-01,-8.0992762E-01\| 1.9479785E-02\| 30)
	31 prt(o:-321\| 1.7160673E+00; 9.4864764E-02,-1.3593096E+00,-9.1897992E-01\| 2.4364096E-01\| 31)
	32 prt(o:211\| 1.3501134E+00;-2.5963152E-01,-1.0424529E+00,-8.0573560E-01\| 1.9479785E-02\| 32)
	33 prt(o:22\| 3.8645398E+00;-7.6066921E-01,-3.1180708E+00,-2.1525995E+00\| 0.0000000E+00\| 33)
	34 prt(o:211\| 2.8853957E+00; 6.7911139E-02,-2.1455690E+00,-1.9230054E+00\| 1.9479785E-02\| 34)
	35 prt(o:-211\| 7.1476782E+00;-4.7407872E-01,-5.2709406E+00,-4.8023180E+00\| 1.9479785E-02\| 35)
	36 prt(o:22\| 3.9580033E+00;-5.1148662E-01,-2.7023879E+00,-2.8462732E+00\| 0.0000000E+00\| 36)
	37 prt(o:211\| 2.8124836E+01; 3.0564113E-02,-1.9939070E+01,-1.9834804E+01\| 1.9479785E-02\| 37)
	38 prt(o:-211\| 1.0014653E+02;-3.6971129E+00,-7.1545649E+01,-6.9977560E+01\| 1.9479785E-02\| 38)
	39 prt(o:22\| 2.4120117E+01;-1.2227444E+00,-1.7325810E+01,-1.6736225E+01\| 0.0000000E+00\| 39)
	40 prt(o:22\| 4.1199326E+01;-1.9544277E+00,-2.9519181E+01,-2.8673728E+01\| 0.0000000E+00\| 40)
	41 prt(o:130\| 7.4085094E+00; 3.6573913E-02, 5.5631143E+00, 4.8671098E+00\| 2.4767543E-01\| 41)
	42 prt(o:22\| 4.6543593E-01;-2.0064258E-01,-2.3308032E-01,-3.4935186E-01\| 0.0000000E+00\| 42)
	43 prt(o:22\| 4.3095062E-01;-2.6676186E-01,-2.5021025E-01,-2.2792845E-01\| 0.0000000E+00\| 43)
	44 prt(o:22\| 4.3192743E-01; 1.3737149E-01,-3.0857980E-01,-2.6920046E-01\| 0.0000000E+00\| 44)
	45 prt(o:22\| 1.6630444E+00; 3.0308739E-01,-1.1445485E+00,-1.1678456E+00\| 0.0000000E+00\| 45)
	46 prt(o:22\| 2.1343468E+00;-2.9008721E-01,-1.1745389E+00,-1.7583356E+00\| 0.0000000E+00\| 46)
	47 prt(o:22\| 2.0530369E+00;-2.2890787E-01,-1.2330842E+00,-1.6254430E+00\| 0.0000000E+00\| 47)
	48 prt(o:22\| 4.3136683E-01;-7.3449982E-03,-3.4153477E-01,-2.6339589E-01\| 0.0000000E+00\| 48)
	49 prt(o:22\| 1.4587527E+00; 3.6023236E-02,-9.9261611E-01,-1.0683516E+00\| 0.0000000E+00\| 49)
	50 prt(o:22\| 1.0091221E+00;-3.0201472E-02,-6.9077009E-01,-7.3501829E-01\| 0.0000000E+00\| 50)
	51 prt(o:22\| 4.8385686E-02;-1.0611881E-02,-7.4270713E-03,-4.6619752E-02\| 0.0000000E+00\| 51)
	52 prt(o:211\| 8.5410063E+00;-3.0274748E-01,-5.6522403E+00,-6.3945157E+00\| 1.9479785E-02\| 52)
	53 prt(o:-211\| 2.9975317E+00;-2.2703457E-01,-2.2083953E+00,-2.0092690E+00\| 1.9479785E-02\| 53)
	54 prt(o:22\| 1.5168333E+01;-5.9105937E-01,-1.0595742E+01,-1.0837861E+01\| 0.0000000E+00\| 54)
	55 prt(o:22\| 1.8532840E+00;-4.7869642E-02,-1.3237405E+00,-1.2961795E+00\| 0.0000000E+00\| 55)
	56 prt(o:22\| 4.9155944E+01;-2.1506598E+00,-3.4983867E+01,-3.4464628E+01\| 0.0000000E+00\| 56)
	57 prt(o:22\| 8.6505614E+01;-3.7305225E+00,-6.1686618E+01,-6.0531526E+01\| 0.0000000E+00\| 57)
	58 prt(o:22\| 6.3927727E-02; 3.7304558E-02, 1.3215972E-02, 5.0204206E-02\| 0.0000000E+00\| 58)
	59 prt(o:22\| 9.4719201E-01; 1.3951266E-01, 5.0777311E-01, 7.8732165E-01\| 0.0000000E+00\| 59)
	60 prt(o:22\| 8.0511798E-01; 1.0275793E-02, 6.6543508E-01, 4.5310652E-01\| 0.0000000E+00\| 60)
	61 prt(o:22\| 5.1957437E-01; 5.9375665E-02, 3.6662738E-01, 3.6334064E-01\| 0.0000000E+00\| 61)
	========================================================================
	Index: trunk/share/tests/functional_tests/ref-output/pythia8_2.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output/pythia8_2.ref (revision 0)
	+++ trunk/share/tests/functional_tests/ref-output/pythia8_2.ref (revision 8190)
	@@ -0,0 +1,1593 @@
	+?openmp_logging = false
	+?vis_history = false
	+?integration_timer = false
	+?pacify = true
	+SM.me => 0.00000E+00
	+$method = "omega"
	+\| Process library 'pythia8_2_lib': recorded process 'pythia8_2_p1'
	+\| Process library 'pythia8_2_lib': recorded process 'pythia8_2_p2'
	+\| Process library 'pythia8_2_lib': recorded process 'pythia8_2_p3'
	+\| Process library 'pythia8_2_lib': compiling ...
	+\| Process library 'pythia8_2_lib': writing makefile
	+\| Process library 'pythia8_2_lib': removing old files
	+\| Process library 'pythia8_2_lib': writing driver
	+\| Process library 'pythia8_2_lib': creating source code
	+\| Process library 'pythia8_2_lib': compiling sources
	+\| Process library 'pythia8_2_lib': linking
	+\| Process library 'pythia8_2_lib': loading
	+\| Process library 'pythia8_2_lib': ... success.
	+seed = 0
	+$phs_method = "wood"
	+$integration_method = "vamp"
	+sqrts = 1.00000E+03
	+openmp_num_threads = 1
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 0
	+\| Initializing integration for process pythia8_2_p1:
	+\| Beam structure: [any particles]
	+\| Beam data (collision):
	+\| e- (mass = 0.0000000E+00 GeV)
	+\| e+ (mass = 0.0000000E+00 GeV)
	+\| sqrts = 1.000000000000E+03 GeV
	+\| Phase space: generating configuration ...
	+\| Phase space: ... success.
	+\| Phase space: writing configuration file 'pythia8_2_p1.i1.phs'
	+\| ------------------------------------------------------------------------
	+\| Process [scattering]: 'pythia8_2_p1'
	+\| Library name = 'pythia8_2_lib'
	+\| Process index = 1
	+\| Process components:
	+\| 1: 'pythia8_2_p1_i1': e-, e+ => Z, H [omega]
	+\| ------------------------------------------------------------------------
	+\| Phase space: 1 channels, 2 dimensions
	+\| Phase space: found 1 channel, collected in 1 grove.
	+\| Phase space: Using 1 equivalence between channels.
	+\| Phase space: wood
	+Warning: No cuts have been defined.
	+\| Starting integration for process 'pythia8_2_p1'
	+\| Integrate: iterations = 1:1000
	+\| Integrator: 1 chains, 1 channels, 2 dimensions
	+\| Integrator: Using VAMP channel equivalences
	+\| Integrator: 1000 initial calls, 20 bins, stratified = T
	+\| Integrator: VAMP
	+\|=============================================================================\|
	+\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	+\|=============================================================================\|
	+ 1 800 1.286E+01 2.06E-02 0.16 0.05 69.0
	+\|-----------------------------------------------------------------------------\|
	+ 1 800 1.286E+01 2.06E-02 0.16 0.05 69.0
	+\|=============================================================================\|
	+error_threshold = 1.00000E-08
	+n_events = 1
	+?rebuild_events = true
	+?debug_decay = false
	+?debug_process = false
	+?debug_verbose = false
	+?sample_pacify = true
	+?allow_shower = true
	+?ps_fsr_active = true
	+$shower_method = "PYTHIA8"
	+$hadronization_method = "PYTHIA8"
	+$sample = "pythia8_2a"
	+\| Starting simulation for process 'pythia8_2_p1'
	+\| Simulate: using integration grids from file 'pythia8_2_p1.m1.vg'
	+\| Simulate: activating parton shower
	+\| Shower: Using PYTHIA8 shower
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 1
	+\| Simulation: requested number of events = 1
	+\| corr. to luminosity [fb-1] = 7.7772E-02
	+\| Events: writing to ASCII file 'pythia8_2a.debug'
	+\| Events: writing to raw file 'pythia8_2a.evx'
	+\| Events: generating 1 unweighted, unpolarized events ...
	+\| Events: event normalization mode '1'
	+\| ... event sample complete.
	+\| Events: actual unweighting efficiency = 100.00 %
	+\| Events: closing ASCII file 'pythia8_2a.debug'
	+\| Events: closing raw file 'pythia8_2a.evx'
	+$sample = "pythia8_2b"
	+?hadronization_active = true
	+\| Starting simulation for process 'pythia8_2_p1'
	+\| Simulate: using integration grids from file 'pythia8_2_p1.m1.vg'
	+\| Simulate: activating parton shower
	+\| Shower: Using PYTHIA8 shower
	+\| Simulate: activating hadronization
	+\| Hadronization: Using PYTHIA8 interface for hadronization and decays.
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 2
	+\| Simulation: requested number of events = 1
	+\| corr. to luminosity [fb-1] = 7.7772E-02
	+\| Events: writing to ASCII file 'pythia8_2b.debug'
	+\| Events: writing to raw file 'pythia8_2b.evx'
	+\| Events: generating 1 unweighted, unpolarized events ...
	+\| Events: event normalization mode '1'
	+\| ... event sample complete.
	+\| Events: actual unweighting efficiency = 33.33 %
	+\| Events: closing ASCII file 'pythia8_2b.debug'
	+\| Events: closing raw file 'pythia8_2b.evx'
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 3
	+\| Initializing integration for process pythia8_2_p2:
	+\| Beam structure: [any particles]
	+\| Beam data (decay):
	+\| Z (mass = 9.1188200E+01 GeV)
	+\| Phase space: generating configuration ...
	+\| Phase space: ... success.
	+\| Phase space: writing configuration file 'pythia8_2_p2.i1.phs'
	+\| ------------------------------------------------------------------------
	+\| Process [decay]: 'pythia8_2_p2'
	+\| Library name = 'pythia8_2_lib'
	+\| Process index = 2
	+\| Process components:
	+\| 1: 'pythia8_2_p2_i1': Z => e-, e+ [omega]
	+\| ------------------------------------------------------------------------
	+\| Phase space: 1 channels, 2 dimensions
	+\| Phase space: found 1 channel, collected in 1 grove.
	+\| Phase space: Using 1 equivalence between channels.
	+\| Phase space: wood
	+Warning: No cuts have been defined.
	+\| Starting integration for process 'pythia8_2_p2'
	+\| Integrate: iterations not specified, using default
	+\| Integrate: iterations = 1:100:""
	+\| Integrator: 1 chains, 1 channels, 2 dimensions
	+\| Integrator: Using VAMP channel equivalences
	+\| Integrator: 100 initial calls, 20 bins, stratified = T
	+\| Integrator: VAMP
	+\|=============================================================================\|
	+\| It Calls Integral[GeV] Error[GeV] Err[%] Acc Eff[%] Chi2 N[It] \|
	+\|=============================================================================\|
	+ 1 100 8.397E-02 0.00E+00 0.00 0.00 100.0
	+\|-----------------------------------------------------------------------------\|
	+ 1 100 8.397E-02 0.00E+00 0.00 0.00 100.0
	+\|=============================================================================\|
	+\| Unstable particle Z: computed branching ratios:
	+\| pythia8_2_p2: 1.0000000E+00 e-, e+
	+\| Total width = 8.3965692E-02 GeV (computed)
	+\| = 2.4430000E+00 GeV (preset)
	+\| Decay options: helicity treated exactly
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 4
	+\| Initializing integration for process pythia8_2_p3:
	+\| Beam structure: [any particles]
	+\| Beam data (decay):
	+\| H (mass = 1.2500000E+02 GeV)
	+\| Phase space: generating configuration ...
	+\| Phase space: ... success.
	+\| Phase space: writing configuration file 'pythia8_2_p3.i1.phs'
	+\| ------------------------------------------------------------------------
	+\| Process [decay]: 'pythia8_2_p3'
	+\| Library name = 'pythia8_2_lib'
	+\| Process index = 3
	+\| Process components:
	+\| 1: 'pythia8_2_p3_i1': H => b, bbar [omega]
	+\| ------------------------------------------------------------------------
	+\| Phase space: 1 channels, 2 dimensions
	+\| Phase space: found 1 channel, collected in 1 grove.
	+\| Phase space: Using 1 equivalence between channels.
	+\| Phase space: wood
	+Warning: No cuts have been defined.
	+\| Starting integration for process 'pythia8_2_p3'
	+\| Integrate: iterations not specified, using default
	+\| Integrate: iterations = 1:100:""
	+\| Integrator: 1 chains, 1 channels, 2 dimensions
	+\| Integrator: Using VAMP channel equivalences
	+\| Integrator: 100 initial calls, 20 bins, stratified = T
	+\| Integrator: VAMP
	+\|=============================================================================\|
	+\| It Calls Integral[GeV] Error[GeV] Err[%] Acc Eff[%] Chi2 N[It] \|
	+\|=============================================================================\|
	+ 1 100 4.312E-03 0.00E+00 0.00 0.00 100.0
	+\|-----------------------------------------------------------------------------\|
	+ 1 100 4.312E-03 0.00E+00 0.00 0.00 100.0
	+\|=============================================================================\|
	+\| Unstable particle H: computed branching ratios:
	+\| pythia8_2_p3: 1.0000000E+00 b, bbar
	+\| Total width = 4.3122140E-03 GeV (computed)
	+\| = 4.1430000E-03 GeV (preset)
	+\| Decay options: helicity treated exactly
	+$sample = "pythia8_2c"
	+\| Starting simulation for process 'pythia8_2_p1'
	+\| Simulate: using integration grids from file 'pythia8_2_p1.m1.vg'
	+\| Simulate: activating decays
	+\| Simulate: activating parton shower
	+\| Shower: Using PYTHIA8 shower
	+\| Simulate: using integration grids from file 'pythia8_2_p2.m1.vg'
	+\| Simulate: using integration grids from file 'pythia8_2_p3.m1.vg'
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 5
	+\| Simulation: requested number of events = 1
	+\| corr. to luminosity [fb-1] = 7.7772E-02
	+\| Events: writing to ASCII file 'pythia8_2c.debug'
	+\| Events: writing to raw file 'pythia8_2c.evx'
	+\| Events: generating 1 unweighted, unpolarized events ...
	+\| Events: event normalization mode '1'
	+\| ... event sample complete.
	+\| Events: actual unweighting efficiency = 100.00 %
	+\| Events: closing ASCII file 'pythia8_2c.debug'
	+\| Events: closing raw file 'pythia8_2c.evx'
	+$sample = "pythia8_2d"
	+?hadronization_active = true
	+\| Starting simulation for process 'pythia8_2_p1'
	+\| Simulate: using integration grids from file 'pythia8_2_p1.m1.vg'
	+\| Simulate: activating decays
	+\| Simulate: activating parton shower
	+\| Shower: Using PYTHIA8 shower
	+\| Simulate: activating hadronization
	+\| Hadronization: Using PYTHIA8 interface for hadronization and decays.
	+\| Simulate: using integration grids from file 'pythia8_2_p2.m1.vg'
	+\| Simulate: using integration grids from file 'pythia8_2_p3.m1.vg'
	+\| RNG: Initializing TAO random-number generator
	+\| RNG: Setting seed for random-number generator to 6
	+\| Simulation: requested number of events = 1
	+\| corr. to luminosity [fb-1] = 7.7772E-02
	+\| Events: writing to ASCII file 'pythia8_2d.debug'
	+\| Events: writing to raw file 'pythia8_2d.evx'
	+\| Events: generating 1 unweighted, unpolarized events ...
	+\| Events: event normalization mode '1'
	+\| ... event sample complete.
	+\| Events: actual unweighting efficiency = 50.00 %
	+\| Events: closing ASCII file 'pythia8_2d.debug'
	+\| Events: closing raw file 'pythia8_2d.evx'
	+\| There were no errors and 3 warning(s).
	+\| WHIZARD run finished.
	+\|=============================================================================\|
	+Contents of pythia8_2a.debug:
	+========================================================================
	+ Event #1
	+------------------------------------------------------------------------
	+ Unweighted = T
	+ Normalization = '1'
	+ Helicity handling = drop
	+ Keep correlations = F
	+------------------------------------------------------------------------
	+ Squared matrix el. (ref) = 2.43417E-03
	+ Squared matrix el. (prc) = 2.43417E-03
	+ Event weight (ref) = 1.00000E+00
	+ Event weight (prc) = 1.00000E+00
	+------------------------------------------------------------------------
	+ Selected MCI group = 1
	+ Selected term = 1
	+ Selected channel = 1
	+------------------------------------------------------------------------
	+ Passed selection = T
	+ Reweighting factor = 1.00000E+00
	+ Analysis flag = T
	+========================================================================
	+ Event transform: trivial (hard process)
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_2_p1'
	+ TAO random-number generator:
	+ seed = 2
	+ calls = 3
	+ Number of tries = 1
	+------------------------------------------------------------------------
	+ Particle set:
	+------------------------------------------------------------------------
	+ Particle 1 [i] f(11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 2 [i] f(-11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 -5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 3 [o] f(23)
	+ E = 4.963451E+02
	+ P = 4.672281E+02 1.282625E+02 -5.735730E+01
	+ T = 8.315287819E+03
	+ Parents: 1 2
	+ Particle 4 [o] f(25)
	+ E = 5.036549E+02
	+ P = -4.672281E+02 -1.282625E+02 5.735730E+01
	+ T = 1.562500000E+04
	+ Parents: 1 2
	+========================================================================
	+========================================================================
	+ Event transform: shower
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_2_p1'
	+ TAO random-number generator:
	+ seed = 3
	+ calls = 1
	+ Number of tries = 1
	+ Particle set:
	+------------------------------------------------------------------------
	+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	+ 1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	+ 2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	+ 3 [v] Z 0 0 1-2 5-6 496.345 467.228 128.263 -57.357 8315.288
	+ 4 [v] H 0 0 1-2 22-23 503.655 -467.228 -128.263 57.357 15625.000
	+ 5 [v] d 101 0 3 7-8 391.789 363.705 126.661 -71.930 0.109
	+ 6 [v] dbar 0 101 3 9 104.556 103.523 1.602 14.573 0.109
	+ 7 [v] d 104 0 5 10-11 356.913 332.027 114.434 -63.635 0.109
	+ 8 [v] gl 101 104 5 12 35.485 32.281 12.237 -8.210 0.000
	+ 9 [v] dbar 0 101 6 16-17 103.947 102.920 1.592 14.488 0.109
	+ 10 [o] d 105 0 7 [none] 325.115 302.338 104.106 -58.765 0.109
	+ 11 [v] gl 104 105 7 13-14 35.423 32.987 11.578 -5.709 0.000
	+ 12 [v] gl 101 104 8 15 31.860 28.983 10.987 -7.371 0.000
	+ 13 [o] gl 106 105 11 [none] 27.199 25.102 9.526 -4.349 0.000
	+ 14 [o] gl 104 106 11 [none] 18.509 17.241 5.598 -3.740 0.000
	+ 15 [v] gl 101 104 12 18 21.576 19.628 7.440 -4.992 0.000
	+ 16 [o] dbar 0 108 9 [none] 101.345 100.403 1.892 13.655 0.109
	+ 17 [v] gl 108 101 9 21 2.889 2.778 -0.201 0.767 0.000
	+ 18 [v] gl 101 104 15 19-20 21.289 19.367 7.341 -4.925 0.000
	+ 19 [o] gl 109 104 18 [none] 18.671 17.147 6.345 -3.783 0.000
	+ 20 [o] gl 101 109 18 [none] 2.834 2.427 0.981 -1.085 0.000
	+ 21 [o] gl 108 101 17 [none] 2.674 2.571 -0.186 0.710 0.000
	+ 22 [v] b 102 0 4 24-25 420.510 -387.710 -144.607 74.670 23.040
	+ 23 [v] bbar 0 102 4 26 83.145 -79.518 16.345 -17.312 23.040
	+ 24 [v] b 112 0 22 35 162.577 -146.069 -66.504 25.482 23.040
	+ 25 [v] gl 102 112 22 27-28 261.505 -245.059 -77.371 48.423 0.000
	+ 26 [v] bbar 0 102 23 29 79.573 -76.100 15.612 -16.547 23.040
	+ 27 [v] gl 114 112 25 30-31 252.080 -238.166 -71.184 41.877 0.000
	+ 28 [v] gl 102 114 25 32 13.039 -10.349 -5.444 5.767 0.000
	+ 29 [v] bbar 0 102 26 47 75.959 -72.643 14.870 -15.769 23.040
	+ 30 [v] gl 115 112 27 33-34 172.985 -164.561 -47.006 25.173 0.000
	+ 31 [v] gl 114 115 27 39-40 83.064 -76.755 -25.835 18.460 0.000
	+ 32 [v] gl 102 114 28 41 9.070 -7.199 -3.787 4.012 0.000
	+ 33 [v] gl 115 116 30 48-49 162.991 -154.253 -47.347 23.032 0.000
	+ 34 [v] gl 116 112 30 38 19.570 -18.869 -3.690 3.651 0.000
	+ 35 [v] b 112 0 24 36-37 153.001 -137.509 -62.473 23.972 23.040
	+ 36 [v] b 117 0 35 68 154.839 -139.275 -62.982 24.245 23.040
	+ 37 [v] gl 112 117 35 66-67 1.338 -1.296 -0.090 0.319 0.000
	+ 38 [v] gl 116 112 34 65 16.394 -15.807 -3.092 3.058 0.000
	+ 39 [v] gl 118 115 31 44 69.259 -63.542 -22.092 16.466 0.000
	+ 40 [v] gl 114 118 31 42-43 14.949 -14.121 -4.221 2.501 0.000
	+ 41 [v] gl 102 114 32 45-46 7.926 -6.291 -3.309 3.506 0.000
	+ 42 [v] gl 114 119 40 51-52 37.942 -35.223 -10.996 8.833 0.000
	+ 43 [o] gl 119 118 40 [none] 15.699 -14.397 -5.566 2.866 0.000
	+ 44 [v] gl 118 115 39 50 30.567 -28.044 -9.750 7.267 0.000
	+ 45 [v] gl 121 114 41 53 8.860 -7.362 -3.417 3.553 0.000
	+ 46 [v] gl 102 121 41 62 1.732 -1.483 0.646 -0.618 0.000
	+ 47 [o] bbar 0 102 29 [none] 73.293 -70.089 14.332 -15.198 23.040
	+ 48 [v] gl 122 116 33 63-64 157.248 -148.606 -46.074 22.811 0.000
	+ 49 [v] gl 115 122 33 54-55 8.482 -8.159 -2.147 0.872 0.000
	+ 50 [v] gl 118 115 44 56 27.828 -25.531 -8.876 6.616 0.000
	+ 51 [o] gl 123 119 42 [none] 12.170 -11.456 -3.423 2.274 0.000
	+ 52 [v] gl 114 123 42 59 26.923 -24.724 -8.017 7.021 0.000
	+ 53 [v] gl 121 114 45 57-58 7.708 -6.405 -2.973 3.091 0.000
	+ 54 [o] gl 124 122 49 [none] 3.346 -3.289 -0.457 0.414 0.000
	+ 55 [o] gl 115 124 49 [none] 15.720 -14.581 -5.066 2.974 0.000
	+ 56 [o] gl 118 115 50 [none] 17.244 -15.821 -5.500 4.100 0.000
	+ 57 [v] gl 121 125 53 60-61 11.639 -9.920 -4.479 4.122 0.000
	+ 58 [o] gl 125 114 53 [none] 4.073 -3.835 -0.878 1.057 0.000
	+ 59 [o] gl 114 123 52 [none] 18.920 -17.375 -5.634 4.934 0.000
	+ 60 [o] gl 126 125 57 [none] 10.471 -8.731 -4.198 3.976 0.000
	+ 61 [o] gl 121 126 57 [none] 1.418 -1.404 -0.187 0.056 0.000
	+ 62 [o] gl 102 121 46 [none] 1.481 -1.268 0.552 -0.529 0.000
	+ 63 [o] gl 122 127 48 [none] 130.438 -123.097 -38.664 19.143 0.000
	+ 64 [o] gl 127 116 48 [none] 28.071 -26.725 -7.648 3.903 0.000
	+ 65 [o] gl 116 112 38 [none] 15.133 -14.591 -2.854 2.823 0.000
	+ 66 [o] gl 112 128 37 [none] 9.479 -8.729 -3.259 1.741 0.000
	+ 67 [o] gl 128 117 37 [none] 0.674 -0.487 -0.463 -0.053 0.000
	+ 68 [o] b 117 0 36 [none] 146.024 -131.355 -59.349 22.876 23.040
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	+Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+------------------------------------------------------------------------
	+ Shower settings:
	+------------------------------------------------------------------------
	+ Master switches:
	+ ps_isr_active = F
	+ ps_fsr_active = T
	+ ps_tau_dec = F
	+ muli_active = F
	+ hadronization_active = F
	+ General settings:
	+ method = PYTHIA8
	+ shower_verbose = F
	+ ps_mass_cutoff = 1.000000000000E+00
	+ ps_max_n_flavors = 5
	+ [ISR off]
	+ FSR settings:
	+ ps_fsr_lambda = 2.900000000000E-01
	+ ps_fsr_alphas_running = T
	+ Matching Settings:
	+ mlm_matching = F
	+ ckkw_matching = F
	+ PYTHIA6 specific settings:
	+ ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	+========================================================================
	+ Local variables:
	+------------------------------------------------------------------------
	+sqrts* = 1.00000E+03
	+sqrts_hat* => 1.00000E+03
	+n_in* => 2
	+n_out* => 24
	+n_tot* => 26
	+$process_id* => "pythia8_2_p1"
	+process_num_id* => [unknown integer]
	+sqme* => 2.43417E-03
	+sqme_ref* => 2.43417E-03
	+event_index* => 1
	+event_weight* => 1.00000E+00
	+event_weight_ref* => 1.00000E+00
	+event_excess* => 0.00000E+00
	+------------------------------------------------------------------------
	+ subevent:
	+ 1 prt(i:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02\| 0.0000000E+00\| 1)
	+ 2 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02\| 0.0000000E+00\| 2)
	+ 3 prt(o:1\| 3.2511496E+02; 3.0233812E+02, 1.0410578E+02,-5.8764570E+01\| 1.0890000E-01\| 3)
	+ 4 prt(o:21\| 2.7198684E+01; 2.5101832E+01, 9.5263391E+00,-4.3491745E+00\| 0.0000000E+00\| 4)
	+ 5 prt(o:21\| 1.8508703E+01; 1.7240976E+01, 5.5979254E+00,-3.7395255E+00\| 0.0000000E+00\| 5)
	+ 6 prt(o:-1\| 1.0134498E+02; 1.0040250E+02, 1.8917857E+00, 1.3654851E+01\| 1.0890000E-01\| 6)
	+ 7 prt(o:21\| 1.8670592E+01; 1.7146920E+01, 6.3451543E+00,-3.7832748E+00\| 0.0000000E+00\| 7)
	+ 8 prt(o:21\| 2.8335017E+00; 2.4265764E+00, 9.8125662E-01,-1.0851700E+00\| 0.0000000E+00\| 8)
	+ 9 prt(o:21\| 2.6737213E+00; 2.5711510E+00,-1.8571952E-01, 7.0956063E-01\| 0.0000000E+00\| 9)
	+ 10 prt(o:21\| 1.5699310E+01;-1.4396805E+01,-5.5663823E+00, 2.8663126E+00\| 0.0000000E+00\| 10)
	+ 11 prt(o:-5\| 7.3293015E+01;-7.0088861E+01, 1.4331540E+01,-1.5198177E+01\| 2.3040000E+01\| 11)
	+ 12 prt(o:21\| 1.2170449E+01;-1.1455646E+01,-3.4231127E+00, 2.2738273E+00\| 0.0000000E+00\| 12)
	+ 13 prt(o:21\| 3.3457828E+00;-3.2885102E+00,-4.5670888E-01, 4.1398091E-01\| 0.0000000E+00\| 13)
	+ 14 prt(o:21\| 1.5719716E+01;-1.4580793E+01,-5.0658957E+00, 2.9743331E+00\| 0.0000000E+00\| 14)
	+ 15 prt(o:21\| 1.7244025E+01;-1.5820730E+01,-5.5003997E+00, 4.0995713E+00\| 0.0000000E+00\| 15)
	+ 16 prt(o:21\| 4.0731914E+00;-3.8346563E+00,-8.7751823E-01, 1.0565326E+00\| 0.0000000E+00\| 16)
	+ 17 prt(o:21\| 1.8919830E+01;-1.7374619E+01,-5.6338590E+00, 4.9337850E+00\| 0.0000000E+00\| 17)
	+ 18 prt(o:21\| 1.0471480E+01;-8.7305518E+00,-4.1976147E+00, 3.9761020E+00\| 0.0000000E+00\| 18)
	+ 19 prt(o:21\| 1.4180385E+00;-1.4044800E+00,-1.8734496E-01, 5.6311949E-02\| 0.0000000E+00\| 19)
	+ 20 prt(o:21\| 1.4808258E+00;-1.2681101E+00, 5.5230534E-01,-5.2886723E-01\| 0.0000000E+00\| 20)
	+ 21 prt(o:21\| 1.3043831E+02;-1.2309670E+02,-3.8663723E+01, 1.9143486E+01\| 0.0000000E+00\| 21)
	+ 22 prt(o:21\| 2.8070605E+01;-2.6725136E+01,-7.6479764E+00, 3.9031252E+00\| 0.0000000E+00\| 22)
	+ 23 prt(o:21\| 1.5133471E+01;-1.4591370E+01,-2.8538511E+00, 2.8230106E+00\| 0.0000000E+00\| 23)
	+ 24 prt(o:21\| 9.4789017E+00;-8.7289175E+00,-3.2594947E+00, 1.7410546E+00\| 0.0000000E+00\| 24)
	+ 25 prt(o:21\| 6.7417818E-01;-4.8680781E-01,-4.6333363E-01,-5.3444677E-02\| 0.0000000E+00\| 25)
	+ 26 prt(o:5\| 1.4602372E+02;-1.3135539E+02,-5.9349154E+01, 2.2876359E+01\| 2.3040000E+01\| 26)
	+========================================================================
	+Contents of pythia8_2b.debug:
	+========================================================================
	+ Event #1
	+------------------------------------------------------------------------
	+ Unweighted = T
	+ Normalization = '1'
	+ Helicity handling = drop
	+ Keep correlations = F
	+------------------------------------------------------------------------
	+ Squared matrix el. (ref) = 2.34324E-03
	+ Squared matrix el. (prc) = 2.34324E-03
	+ Event weight (ref) = 1.00000E+00
	+ Event weight (prc) = 1.00000E+00
	+------------------------------------------------------------------------
	+ Selected MCI group = 1
	+ Selected term = 1
	+ Selected channel = 1
	+------------------------------------------------------------------------
	+ Passed selection = T
	+ Reweighting factor = 1.00000E+00
	+ Analysis flag = T
	+========================================================================
	+ Event transform: trivial (hard process)
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_2_p1'
	+ TAO random-number generator:
	+ seed = 6
	+ calls = 3
	+ Number of tries = 1
	+------------------------------------------------------------------------
	+ Particle set:
	+------------------------------------------------------------------------
	+ Particle 1 [i] f(11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 2 [i] f(-11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 -5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 3 [o] f(23)
	+ E = 4.963451E+02
	+ P = -4.340495E+02 -1.922594E+02 -1.126082E+02
	+ T = 8.315287819E+03
	+ Parents: 1 2
	+ Particle 4 [o] f(25)
	+ E = 5.036549E+02
	+ P = 4.340495E+02 1.922594E+02 1.126082E+02
	+ T = 1.562500000E+04
	+ Parents: 1 2
	+========================================================================
	+========================================================================
	+ Event transform: shower
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_2_p1'
	+ TAO random-number generator:
	+ seed = 7
	+ calls = 1
	+ Number of tries = 1
	+ Particle set:
	+------------------------------------------------------------------------
	+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	+ 1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	+ 2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	+ 3 [v] Z 0 0 1-2 5-6 496.345 -434.049 -192.259 -112.608 8315.288
	+ 4 [v] H 0 0 1-2 16-17 503.655 434.049 192.259 112.608 15625.000
	+ 5 [v] c 101 0 3 7-8 264.125 -244.503 -62.719 -77.746 2.250
	+ 6 [v] cbar 0 101 3 9 232.220 -189.547 -129.540 -34.863 2.250
	+ 7 [o] c 103 0 5 [none] 187.067 -175.046 -39.730 -52.652 2.250
	+ 8 [v] gl 101 103 5 10-11 82.953 -74.269 -26.279 -25.978 0.000
	+ 9 [v] cbar 0 101 6 12 226.325 -184.735 -126.250 -33.978 2.250
	+ 10 [o] gl 105 103 8 [none] 69.790 -63.077 -21.702 -20.518 0.000
	+ 11 [v] gl 101 105 8 13-14 15.253 -12.898 -5.743 -5.773 0.000
	+ 12 [v] cbar 0 101 9 15 224.235 -183.030 -125.084 -33.665 2.250
	+ 13 [o] ubar 0 105 11 [none] 9.883 -7.900 -4.785 -3.500 0.109
	+ 14 [o] u 101 0 11 [none] 8.166 -7.279 -2.518 -2.692 0.109
	+ 15 [o] cbar 0 101 12 [none] 221.440 -180.748 -123.524 -33.246 2.250
	+ 16 [v] b 102 0 4 20 221.648 194.291 106.239 -8.310 23.040
	+ 17 [v] bbar 0 102 4 18-19 282.007 239.759 86.020 120.918 23.040
	+ 18 [v] bbar 0 109 17 29 266.361 225.214 81.441 116.497 23.040
	+ 19 [v] gl 109 102 17 23 19.839 18.221 6.592 4.257 0.000
	+ 20 [v] b 102 0 16 21-22 217.454 190.615 104.226 -8.145 23.040
	+ 21 [o] b 110 0 20 [none] 198.471 174.289 94.638 -5.881 23.040
	+ 22 [v] gl 102 110 20 24-25 20.227 17.468 10.001 -1.997 0.000
	+ 23 [v] gl 109 102 19 26 18.596 17.080 6.179 3.990 0.000
	+ 24 [v] gl 111 110 22 38 20.099 17.784 9.362 -0.260 0.000
	+ 25 [v] gl 102 111 22 33-34 3.163 2.471 1.647 -1.087 0.000
	+ 26 [v] gl 109 102 23 27-28 15.561 14.292 5.171 3.339 0.000
	+ 27 [v] gl 112 102 26 30-31 17.076 15.758 5.295 3.904 0.000
	+ 28 [v] gl 109 112 26 32 10.741 8.886 3.619 4.828 0.000
	+ 29 [o] bbar 0 109 18 [none] 254.105 214.862 77.698 111.104 23.040
	+ 30 [v] gl 113 102 27 35 1.273 1.185 0.026 0.466 0.000
	+ 31 [o] gl 112 113 27 [none] 18.425 16.743 6.152 4.616 0.000
	+ 32 [o] gl 109 112 28 [none] 8.118 6.716 2.735 3.649 0.000
	+ 33 [v] gl 114 111 25 36-37 1.308 0.855 0.467 -0.874 0.000
	+ 34 [o] gl 102 114 25 [none] 2.615 2.325 1.197 0.066 0.000
	+ 35 [o] gl 113 102 30 [none] 0.512 0.476 0.011 0.188 0.000
	+ 36 [o] gl 114 115 33 [none] 2.131 1.440 1.241 -0.964 0.000
	+ 37 [o] gl 115 111 33 [none] 1.581 1.542 0.345 0.059 0.000
	+ 38 [o] gl 111 110 24 [none] 17.695 15.657 8.242 -0.229 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	+Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+------------------------------------------------------------------------
	+ Shower settings:
	+------------------------------------------------------------------------
	+ Master switches:
	+ ps_isr_active = F
	+ ps_fsr_active = T
	+ ps_tau_dec = F
	+ muli_active = F
	+ hadronization_active = T
	+ General settings:
	+ method = PYTHIA8
	+ shower_verbose = F
	+ ps_mass_cutoff = 1.000000000000E+00
	+ ps_max_n_flavors = 5
	+ [ISR off]
	+ FSR settings:
	+ ps_fsr_lambda = 2.900000000000E-01
	+ ps_fsr_alphas_running = T
	+ Matching Settings:
	+ mlm_matching = F
	+ ckkw_matching = F
	+ PYTHIA6 specific settings:
	+ ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	+========================================================================
	+========================================================================
	+ Event transform: hadronization
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_2_p1'
	+ TAO random-number generator:
	+ seed = 9
	+ calls = 1
	+ Number of tries = 1
	+ Particle set:
	+------------------------------------------------------------------------
	+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	+ 1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	+ 2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	+ 3 [v] c 103 0 1-2 25-30 187.067 -175.046 -39.730 -52.652 2.250
	+ 4 [v] gl 105 103 1-2 25-30 69.790 -63.077 -21.702 -20.518 0.000
	+ 5 [v] ubar 0 105 1-2 25-30 9.883 -7.900 -4.785 -3.500 0.109
	+ 6 [v] u 101 0 1-2 19-24 8.166 -7.279 -2.518 -2.692 0.109
	+ 7 [v] cbar 0 101 1-2 19-24 221.440 -180.748 -123.524 -33.246 2.250
	+ 8 [v] b 110 0 1-2 17 198.471 174.289 94.638 -5.881 23.040
	+ 9 [v] bbar 0 109 1-2 18 254.105 214.862 77.698 111.104 23.040
	+ 10 [v] gl 112 113 1-2 36 18.425 16.743 6.152 4.616 0.000
	+ 11 [v] gl 109 112 1-2 18 8.118 6.716 2.735 3.649 0.000
	+ 12 [v] gl 102 114 1-2 34 2.615 2.325 1.197 0.066 0.000
	+ 13 [v] gl 113 102 1-2 35 0.512 0.476 0.011 0.188 0.000
	+ 14 [v] gl 114 115 1-2 33 2.131 1.440 1.241 -0.964 0.000
	+ 15 [v] gl 115 111 1-2 32 1.581 1.542 0.345 0.059 0.000
	+ 16 [v] gl 111 110 1-2 17 17.695 15.657 8.242 -0.229 0.000
	+ 17 [v] b 611 0 8,16 31 216.165 189.945 102.880 -6.110 26.661
	+ 18 [v] bbar 0 612 9,11 37 262.224 221.578 80.433 114.753 26.776
	+ 19 [r] pi0 0 0 6-7 65-66 4.159 -3.865 -1.038 -1.126 0.018
	+ 20 [o] pip 0 0 6-7 [none] 3.534 -3.008 -1.602 -0.924 0.019
	+ 21 [r] kstar0 0 0 6-7 49-50 26.194 -21.152 -14.799 -4.347 0.808
	+ 22 [r] kstarm 0 0 6-7 51-52 5.350 -4.453 -2.759 -0.627 0.789
	+ 23 [o] pip 0 0 6-7 [none] 15.706 -12.958 -8.521 -2.477 0.019
	+ 24 [r] dstarm 0 0 6-7 67-68 174.663 -142.592 -97.324 -26.437 4.041
	+ 25 [r] dstarp 0 0 3-5 69-70 165.716 -155.083 -35.230 -46.539 4.041
	+ 26 [r] Delta- 0 0 3-5 53-54 26.203 -24.298 -6.375 -7.356 1.443
	+ 27 [r] rhop 0 0 3-5 55-56 24.111 -21.694 -7.478 -7.350 0.739
	+ 28 [r] Deltaba 0 0 3-5 57-58 20.093 -18.183 -6.153 -5.816 1.395
	+ 29 [o] kp 0 0 3-5 [none] 21.288 -19.110 -6.522 -6.723 0.244
	+ 30 [o] km 0 0 3-5 [none] 9.329 -7.654 -4.459 -2.886 0.244
	+ 31 [v] b 611 0 17 38-48 216.165 189.945 102.880 -6.110 26.661
	+ 32 [v] gl 115 111 15 38-48 1.581 1.542 0.345 0.059 0.000
	+ 33 [v] gl 114 115 14 38-48 2.131 1.440 1.241 -0.964 0.000
	+ 34 [v] gl 102 114 12 38-48 2.615 2.325 1.197 0.066 0.000
	+ 35 [v] gl 113 102 13 38-48 0.512 0.476 0.011 0.188 0.000
	+ 36 [v] gl 112 113 10 38-48 18.425 16.743 6.152 4.616 0.000
	+ 37 [v] bbar 0 612 18 38-48 262.224 221.578 80.433 114.753 26.776
	+ 38 [r] bstarba 0 0 31-37 71-72 201.001 176.575 95.739 -5.334 28.358
	+ 39 [o] p 0 0 31-37 [none] 13.459 11.969 6.062 -0.528 0.880
	+ 40 [o] nbar 0 0 31-37 [none] 5.895 5.376 2.211 -0.273 0.883
	+ 41 [o] pim 0 0 31-37 [none] 0.536 0.106 0.491 0.127 0.019
	+ 42 [o] pip 0 0 31-37 [none] 3.550 3.043 1.816 0.155 0.019
	+ 43 [r] rhom 0 0 31-37 59-60 5.634 5.143 1.240 1.644 1.047
	+ 44 [o] pip 0 0 31-37 [none] 4.139 3.433 2.031 1.097 0.019
	+ 45 [r] rhom 0 0 31-37 61-62 9.472 8.731 2.883 2.134 0.620
	+ 46 [r] omega 0 0 31-37 73-75 14.432 12.106 4.041 6.693 0.622
	+ 47 [r] rhop 0 0 31-37 63-64 33.691 28.757 10.278 14.206 0.664
	+ 48 [r] b0 0 0 31-37 76-80 211.845 178.811 65.467 92.688 27.874
	+ 49 [o] kp 0 0 21 [none] 17.357 -14.063 -9.826 -2.593 0.244
	+ 50 [o] pim 0 0 21 [none] 8.837 -7.089 -4.973 -1.754 0.019
	+ 51 [o] km 0 0 22 [none] 2.297 -1.854 -1.171 -0.476 0.244
	+ 52 [r] pi0 0 0 22 81-82 3.053 -2.599 -1.588 -0.151 0.018
	+ 53 [o] n 0 0 26 [none] 19.212 -17.751 -4.714 -5.557 0.883
	+ 54 [o] pim 0 0 26 [none] 6.991 -6.547 -1.661 -1.799 0.019
	+ 55 [o] pip 0 0 27 [none] 21.151 -19.145 -6.459 -6.253 0.019
	+ 56 [r] pi0 0 0 27 83-84 2.960 -2.549 -1.019 -1.098 0.018
	+ 57 [o] pbar 0 0 28 [none] 12.933 -11.721 -3.946 -3.667 0.880
	+ 58 [o] A 0 0 28 [none] 7.159 -6.463 -2.207 -2.149 0.000
	+ 59 [o] pim 0 0 43 [none] 4.771 4.348 0.942 1.717 0.019
	+ 60 [r] pi0 0 0 43 85-86 0.863 0.795 0.298 -0.073 0.018
	+ 61 [o] pim 0 0 45 [none] 4.663 4.390 1.404 0.694 0.019
	+ 62 [r] pi0 0 0 45 87-88 4.808 4.340 1.479 1.441 0.018
	+ 63 [o] pip 0 0 47 [none] 5.233 4.584 1.389 2.102 0.019
	+ 64 [r] pi0 0 0 47 89-90 28.458 24.172 8.889 12.104 0.018
	+ 65 [o] A 0 0 19 [none] 3.598 -3.362 -0.865 -0.948 0.000
	+ 66 [o] A 0 0 19 [none] 0.561 -0.503 -0.173 -0.178 0.000
	+ 67 [r] dbar0 0 0 24 91-93 160.664 -131.183 -89.494 -24.319 3.478
	+ 68 [o] pim 0 0 24 [none] 13.999 -11.409 -7.830 -2.118 0.019
	+ 69 [r] dp 0 0 25 94-96 154.715 -144.782 -32.927 -43.440 3.495
	+ 70 [r] pi0 0 0 25 97-98 11.001 -10.301 -2.303 -3.099 0.018
	+ 71 [r] bbarM 0 0 38 99-101 199.029 174.831 94.818 -5.322 27.870
	+ 72 [o] A 0 0 38 [none] 1.972 1.743 0.921 -0.012 0.000
	+ 73 [o] pip 0 0 46 [none] 6.391 5.505 1.684 2.772 0.019
	+ 74 [o] pim 0 0 46 [none] 2.840 2.337 0.943 1.302 0.019
	+ 75 [r] pi0 0 0 46 102-103 5.202 4.265 1.413 2.619 0.018
	+ 76 [r] dp 0 0 48 104-106 48.428 40.906 14.322 21.525 3.495
	+ 77 [r] pi0 0 0 48 107-108 18.054 15.283 5.696 7.740 0.018
	+ 78 [o] pim 0 0 48 [none] 13.108 11.209 3.856 5.594 0.019
	+ 79 [r] rho0 0 0 48 109-110 65.524 55.099 21.072 28.503 1.069
	+ 80 [r] omega 0 0 48 111-113 66.731 56.314 20.521 29.326 0.640
	+ 81 [o] A 0 0 52 [none] 2.380 -1.998 -1.287 -0.115 0.000
	+ 82 [o] A 0 0 52 [none] 0.673 -0.601 -0.302 -0.036 0.000
	+ 83 [o] A 0 0 56 [none] 0.817 -0.676 -0.333 -0.316 0.000
	+ 84 [o] A 0 0 56 [none] 2.142 -1.873 -0.686 -0.782 0.000
	+ 85 [o] A 0 0 60 [none] 0.255 0.239 0.053 -0.072 0.000
	+ 86 [o] A 0 0 60 [none] 0.608 0.556 0.245 -0.001 0.000
	+ 87 [o] A 0 0 62 [none] 0.086 0.069 0.031 0.041 0.000
	+ 88 [o] A 0 0 62 [none] 4.722 4.271 1.448 1.400 0.000
	+ 89 [o] A 0 0 64 [none] 1.228 1.028 0.399 0.540 0.000
	+ 90 [o] A 0 0 64 [none] 27.230 23.144 8.491 11.565 0.000
	+ 91 [r] kS0 0 0 67 114-115 57.630 -47.114 -32.169 -8.150 0.248
	+ 92 [o] pim 0 0 67 [none] 90.203 -73.734 -50.048 -13.965 0.019
	+ 93 [o] pip 0 0 67 [none] 12.831 -10.335 -7.277 -2.204 0.019
	+ 94 [r] k0 0 0 69 116 84.657 -79.314 -17.642 -23.761 0.248
	+ 95 [o] pip 0 0 69 [none] 6.065 -5.721 -1.226 -1.590 0.019
	+ 96 [r] rho0 0 0 69 117-118 63.993 -59.747 -14.060 -18.089 0.510
	+ 97 [o] A 0 0 70 [none] 5.688 -5.302 -1.218 -1.659 0.000
	+ 98 [o] A 0 0 70 [none] 5.314 -4.998 -1.085 -1.439 0.000
	+ 99 [r] d0 0 0 71 119-121 70.641 61.844 33.924 -3.327 3.478
	+ 100 [o] pim 0 0 71 [none] 2.532 2.254 1.120 0.243 0.019
	+ 101 [r] pi0 0 0 71 122-123 125.856 110.733 59.774 -2.239 0.018
	+ 102 [o] A 0 0 75 [none] 4.673 3.855 1.247 2.328 0.000
	+ 103 [o] A 0 0 75 [none] 0.529 0.409 0.166 0.290 0.000
	+ 104 [o] km 0 0 76 [none] 12.748 10.786 3.615 5.733 0.244
	+ 105 [r] rhop 0 0 76 124-125 21.960 18.761 6.336 9.461 0.594
	+ 106 [o] pip 0 0 76 [none] 13.720 11.359 4.371 6.332 0.019
	+ 107 [o] A 0 0 77 [none] 14.950 12.682 4.681 6.384 0.000
	+ 108 [o] A 0 0 77 [none] 3.104 2.602 1.015 1.357 0.000
	+ 109 [o] pip 0 0 79 [none] 57.094 47.844 18.540 25.038 0.019
	+ 110 [o] pim 0 0 79 [none] 8.430 7.254 2.532 3.465 0.019
	+ 111 [o] pip 0 0 80 [none] 8.200 6.836 2.519 3.761 0.019
	+ 112 [o] pim 0 0 80 [none] 19.129 16.222 5.766 8.337 0.019
	+ 113 [r] pi0 0 0 80 126-127 39.402 33.257 12.236 17.228 0.018
	+ 114 [r] pi0 0 0 91 128-129 6.744 -5.496 -3.766 -1.038 0.018
	+ 115 [r] pi0 0 0 91 130-131 50.886 -41.618 -28.402 -7.112 0.018
	+ 116 [o] kL0 0 0 94 [none] 84.657 -79.314 -17.642 -23.761 0.248
	+ 117 [o] pip 0 0 96 [none] 57.009 -53.230 -12.662 -16.008 0.019
	+ 118 [o] pim 0 0 96 [none] 6.984 -6.517 -1.398 -2.081 0.019
	+ 119 [o] e+ 0 0 99 [none] 41.793 36.786 19.720 -2.152 0.000
	+ 120 [o] nue 0 0 99 [none] 6.043 5.087 3.259 -0.096 0.000
	+ 121 [o] km 0 0 99 [none] 22.805 19.971 10.945 -1.079 0.244
	+ 122 [o] A 0 0 101 [none] 107.392 94.484 51.013 -1.863 0.000
	+ 123 [o] A 0 0 101 [none] 18.464 16.249 8.761 -0.375 0.000
	+ 124 [o] pip 0 0 105 [none] 16.758 14.295 4.620 7.425 0.019
	+ 125 [r] pi0 0 0 105 132-133 5.201 4.466 1.716 2.036 0.018
	+ 126 [o] A 0 0 113 [none] 38.344 32.365 11.924 16.751 0.000
	+ 127 [o] A 0 0 113 [none] 1.058 0.891 0.313 0.478 0.000
	+ 128 [o] A 0 0 114 [none] 4.059 -3.270 -2.314 -0.652 0.000
	+ 129 [o] A 0 0 114 [none] 2.686 -2.226 -1.453 -0.386 0.000
	+ 130 [o] A 0 0 115 [none] 25.658 -20.981 -14.343 -3.522 0.000
	+ 131 [o] A 0 0 115 [none] 25.227 -20.637 -14.059 -3.589 0.000
	+ 132 [o] A 0 0 125 [none] 5.068 4.353 1.656 1.998 0.000
	+ 133 [o] A 0 0 125 [none] 0.133 0.113 0.060 0.038 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	+Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+------------------------------------------------------------------------
	+ Shower settings:
	+------------------------------------------------------------------------
	+ Master switches:
	+ ps_isr_active = F
	+ ps_fsr_active = T
	+ ps_tau_dec = F
	+ muli_active = F
	+ hadronization_active = T
	+ General settings:
	+ method = PYTHIA8
	+ shower_verbose = F
	+ ps_mass_cutoff = 1.000000000000E+00
	+ ps_max_n_flavors = 5
	+ [ISR off]
	+ FSR settings:
	+ ps_fsr_lambda = 2.900000000000E-01
	+ ps_fsr_alphas_running = T
	+ Matching Settings:
	+ mlm_matching = F
	+ ckkw_matching = F
	+ PYTHIA6 specific settings:
	+ ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	+------------------------------------------------------------------------
	+ Hadronization settings:
	+------------------------------------------------------------------------
	+ Master switches:
	+ active = T
	+ General settings:
	+ hadron_method = PYTHIA8
	+ pT generation parameters
	+ enhanced_fraction = 1.000000000000E-02
	+ enhanced_width = 2.000000000000E+00
	+========================================================================
	+ Local variables:
	+------------------------------------------------------------------------
	+sqrts* = 1.00000E+03
	+sqrts_hat* => 1.00000E+03
	+n_in* => 2
	+n_out* => 70
	+n_tot* => 72
	+$process_id* => "pythia8_2_p1"
	+process_num_id* => [unknown integer]
	+sqme* => 2.34324E-03
	+sqme_ref* => 2.34324E-03
	+event_index* => 1
	+event_weight* => 1.00000E+00
	+event_weight_ref* => 1.00000E+00
	+event_excess* => 0.00000E+00
	+------------------------------------------------------------------------
	+ subevent:
	+ 1 prt(i:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02\| 0.0000000E+00\| 1)
	+ 2 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02\| 0.0000000E+00\| 2)
	+ 3 prt(o:211\| 3.5336057E+00;-3.0078686E+00,-1.6016534E+00,-9.2429550E-01\| 1.9479785E-02\| 3)
	+ 4 prt(o:211\| 1.5705661E+01;-1.2958224E+01,-8.5205088E+00,-2.4766227E+00\| 1.9479785E-02\| 4)
	+ 5 prt(o:321\| 2.1287985E+01;-1.9110214E+01,-6.5219501E+00,-6.7229812E+00\| 2.4371994E-01\| 5)
	+ 6 prt(o:-321\| 9.3294203E+00;-7.6539118E+00,-4.4589728E+00,-2.8860974E+00\| 2.4371994E-01\| 6)
	+ 7 prt(o:2212\| 1.3459322E+01; 1.1968554E+01, 6.0619658E+00,-5.2848210E-01\| 8.8035059E-01\| 7)
	+ 8 prt(o:-2112\| 5.8949517E+00; 5.3760898E+00, 2.2114949E+00,-2.7315338E-01\| 8.8279178E-01\| 8)
	+ 9 prt(o:-211\| 5.3628286E-01; 1.0597674E-01, 4.9072002E-01, 1.2681603E-01\| 1.9479785E-02\| 9)
	+ 10 prt(o:211\| 3.5504648E+00; 3.0434731E+00, 1.8164783E+00, 1.5491634E-01\| 1.9479785E-02\| 10)
	+ 11 prt(o:211\| 4.1393968E+00; 3.4331971E+00, 2.0308200E+00, 1.0972938E+00\| 1.9479785E-02\| 11)
	+ 12 prt(o:321\| 1.7357332E+01;-1.4062575E+01,-9.8262819E+00,-2.5925684E+00\| 2.4371994E-01\| 12)
	+ 13 prt(o:-211\| 8.8368080E+00;-7.0894609E+00,-4.9730876E+00,-1.7543203E+00\| 1.9479785E-02\| 13)
	+ 14 prt(o:-321\| 2.2973266E+00;-1.8536630E+00,-1.1709635E+00,-4.7620126E-01\| 2.4371994E-01\| 14)
	+ 15 prt(o:2112\| 1.9211719E+01;-1.7751093E+01,-4.7139829E+00,-5.5573775E+00\| 8.8279178E-01\| 15)
	+ 16 prt(o:-211\| 6.9908656E+00;-6.5465812E+00,-1.6610121E+00,-1.7988984E+00\| 1.9479785E-02\| 16)
	+ 17 prt(o:211\| 2.1150838E+01;-1.9144738E+01,-6.4591970E+00,-6.2526984E+00\| 1.9479785E-02\| 17)
	+ 18 prt(o:-2212\| 1.2933433E+01;-1.1720632E+01,-3.9459145E+00,-3.6674080E+00\| 8.8035059E-01\| 18)
	+ 19 prt(o:22\| 7.1593017E+00;-6.4627986E+00,-2.2070811E+00,-2.1486338E+00\| 0.0000000E+00\| 19)
	+ 20 prt(o:-211\| 4.7711393E+00; 4.3483922E+00, 9.4216431E-01, 1.7170038E+00\| 1.9479785E-02\| 20)
	+ 21 prt(o:-211\| 4.6633926E+00; 4.3903201E+00, 1.4040730E+00, 6.9384368E-01\| 1.9479785E-02\| 21)
	+ 22 prt(o:211\| 5.2328440E+00; 4.5844092E+00, 1.3891448E+00, 2.1015816E+00\| 1.9479785E-02\| 22)
	+ 23 prt(o:22\| 3.5983845E+00;-3.3619499E+00,-8.6468513E-01,-9.4762002E-01\| 0.0000000E+00\| 23)
	+ 24 prt(o:22\| 5.6056378E-01;-5.0259024E-01,-1.7288977E-01,-1.7816827E-01\| 0.0000000E+00\| 24)
	+ 25 prt(o:-211\| 1.3999390E+01;-1.1408824E+01,-7.8303562E+00,-2.1184177E+00\| 1.9479785E-02\| 25)
	+ 26 prt(o:22\| 1.9715141E+00; 1.7431959E+00, 9.2085929E-01,-1.2407111E-02\| 0.0000000E+00\| 26)
	+ 27 prt(o:211\| 6.3906353E+00; 5.5045089E+00, 1.6838094E+00, 2.7723468E+00\| 1.9479785E-02\| 27)
	+ 28 prt(o:-211\| 2.8397683E+00; 2.3365975E+00, 9.4329228E-01, 1.3020430E+00\| 1.9479785E-02\| 28)
	+ 29 prt(o:-211\| 1.3107611E+01; 1.1208544E+01, 3.8555005E+00, 5.5940728E+00\| 1.9479785E-02\| 29)
	+ 30 prt(o:22\| 2.3795668E+00;-1.9983868E+00,-1.2867057E+00,-1.1479162E-01\| 0.0000000E+00\| 30)
	+ 31 prt(o:22\| 6.7309538E-01;-6.0066327E-01,-3.0160382E-01,-3.6002203E-02\| 0.0000000E+00\| 31)
	+ 32 prt(o:22\| 8.1731149E-01;-6.7604536E-01,-3.3318635E-01,-3.1614490E-01\| 0.0000000E+00\| 32)
	+ 33 prt(o:22\| 2.1424855E+00;-1.8733626E+00,-6.8554588E-01,-7.8152648E-01\| 0.0000000E+00\| 33)
	+ 34 prt(o:22\| 2.5492396E-01; 2.3856196E-01, 5.3346829E-02,-7.2308607E-02\| 0.0000000E+00\| 34)
	+ 35 prt(o:22\| 6.0763913E-01; 5.5609126E-01, 2.4492253E-01,-8.8391935E-04\| 0.0000000E+00\| 35)
	+ 36 prt(o:22\| 8.6230792E-02; 6.9265983E-02, 3.1088126E-02, 4.0884002E-02\| 0.0000000E+00\| 36)
	+ 37 prt(o:22\| 4.7221138E+00; 4.2712031E+00, 1.4478446E+00, 1.3996173E+00\| 0.0000000E+00\| 37)
	+ 38 prt(o:22\| 1.2278389E+00; 1.0282478E+00, 3.9872972E-01, 5.3973094E-01\| 0.0000000E+00\| 38)
	+ 39 prt(o:22\| 2.7230119E+01; 2.3144121E+01, 8.4906145E+00, 1.1564537E+01\| 0.0000000E+00\| 39)
	+ 40 prt(o:-211\| 9.0202807E+01;-7.3733598E+01,-5.0048483E+01,-1.3965415E+01\| 1.9479785E-02\| 40)
	+ 41 prt(o:211\| 1.2831443E+01;-1.0335492E+01,-7.2765323E+00,-2.2036636E+00\| 1.9479785E-02\| 41)
	+ 42 prt(o:211\| 6.0646251E+00;-5.7210926E+00,-1.2255919E+00,-1.5897238E+00\| 1.9479785E-02\| 42)
	+ 43 prt(o:22\| 5.6876331E+00;-5.3022242E+00,-1.2175342E+00,-1.6592769E+00\| 0.0000000E+00\| 43)
	+ 44 prt(o:22\| 5.3135842E+00;-4.9984664E+00,-1.0852306E+00,-1.4393696E+00\| 0.0000000E+00\| 44)
	+ 45 prt(o:-211\| 2.5324943E+00; 2.2538803E+00, 1.1202399E+00, 2.4317509E-01\| 1.9479785E-02\| 45)
	+ 46 prt(o:22\| 4.6734128E+00; 3.8553156E+00, 1.2473451E+00, 2.3284027E+00\| 0.0000000E+00\| 46)
	+ 47 prt(o:22\| 5.2855385E-01; 4.0934021E-01, 1.6609720E-01, 2.9020938E-01\| 0.0000000E+00\| 47)
	+ 48 prt(o:-321\| 1.2747900E+01; 1.0785939E+01, 3.6148123E+00, 5.7325283E+00\| 2.4371994E-01\| 48)
	+ 49 prt(o:211\| 1.3720493E+01; 1.1359159E+01, 4.3714342E+00, 6.3318669E+00\| 1.9479785E-02\| 49)
	+ 50 prt(o:22\| 1.4949917E+01; 1.2681938E+01, 4.6813761E+00, 6.3838222E+00\| 0.0000000E+00\| 50)
	+ 51 prt(o:22\| 3.1044572E+00; 2.6015255E+00, 1.0146025E+00, 1.3565771E+00\| 0.0000000E+00\| 51)
	+ 52 prt(o:211\| 5.7094031E+01; 4.7844238E+01, 1.8539933E+01, 2.5038145E+01\| 1.9479785E-02\| 52)
	+ 53 prt(o:-211\| 8.4297182E+00; 7.2542789E+00, 2.5317045E+00, 3.4650510E+00\| 1.9479785E-02\| 53)
	+ 54 prt(o:211\| 8.2001862E+00; 6.8360659E+00, 2.5193040E+00, 3.7609684E+00\| 1.9479785E-02\| 54)
	+ 55 prt(o:-211\| 1.9128554E+01; 1.6221636E+01, 5.7657077E+00, 8.3365002E+00\| 1.9479785E-02\| 55)
	+ 56 prt(o:130\| 8.4657031E+01;-7.9314085E+01,-1.7641802E+01,-2.3761484E+01\| 2.4761571E-01\| 56)
	+ 57 prt(o:211\| 5.7009189E+01;-5.3230130E+01,-1.2662241E+01,-1.6007781E+01\| 1.9479785E-02\| 57)
	+ 58 prt(o:-211\| 6.9839246E+00;-6.5169346E+00,-1.3977994E+00,-2.0812120E+00\| 1.9479785E-02\| 58)
	+ 59 prt(o:-11\| 4.1793218E+01; 3.6785662E+01, 1.9719508E+01,-2.1515545E+00\| 0.0000000E+00\| 59)
	+ 60 prt(o:12\| 6.0425359E+00; 5.0872434E+00, 3.2592998E+00,-9.5702190E-02\| 0.0000000E+00\| 60)
	+ 61 prt(o:-321\| 2.2804797E+01; 1.9971437E+01, 1.0944931E+01,-1.0794568E+00\| 2.4371994E-01\| 61)
	+ 62 prt(o:22\| 1.0739217E+02; 9.4484075E+01, 5.1013392E+01,-1.8632951E+00\| 0.0000000E+00\| 62)
	+ 63 prt(o:22\| 1.8463980E+01; 1.6249009E+01, 8.7605635E+00,-3.7522033E-01\| 0.0000000E+00\| 63)
	+ 64 prt(o:211\| 1.6758364E+01; 1.4295305E+01, 4.6196667E+00, 7.4247025E+00\| 1.9479785E-02\| 64)
	+ 65 prt(o:22\| 3.8344103E+01; 3.2365376E+01, 1.1923545E+01, 1.6750573E+01\| 0.0000000E+00\| 65)
	+ 66 prt(o:22\| 1.0583948E+00; 8.9119798E-01, 3.1282079E-01, 4.7760749E-01\| 0.0000000E+00\| 66)
	+ 67 prt(o:22\| 4.0586176E+00;-3.2701786E+00,-2.3137262E+00,-6.5190517E-01\| 0.0000000E+00\| 67)
	+ 68 prt(o:22\| 2.6856140E+00;-2.2257153E+00,-1.4525448E+00,-3.8578175E-01\| 0.0000000E+00\| 68)
	+ 69 prt(o:22\| 2.5658498E+01;-2.0981322E+01,-1.4343482E+01,-3.5223821E+00\| 0.0000000E+00\| 69)
	+ 70 prt(o:22\| 2.5227083E+01;-2.0636632E+01,-1.4058833E+01,-3.5894800E+00\| 0.0000000E+00\| 70)
	+ 71 prt(o:22\| 5.0681559E+00; 4.3534262E+00, 1.6562307E+00, 1.9976948E+00\| 0.0000000E+00\| 71)
	+ 72 prt(o:22\| 1.3322999E-01; 1.1265560E-01, 5.9996877E-02, 3.8201055E-02\| 0.0000000E+00\| 72)
	+========================================================================
	+Contents of pythia8_2c.debug:
	+========================================================================
	+ Event #1
	+------------------------------------------------------------------------
	+ Unweighted = T
	+ Normalization = '1'
	+ Helicity handling = drop
	+ Keep correlations = F
	+------------------------------------------------------------------------
	+ Squared matrix el. (ref) = 2.22586E-03
	+ Squared matrix el. (prc) = 2.22586E-03
	+ Event weight (ref) = 1.00000E+00
	+ Event weight (prc) = 1.00000E+00
	+------------------------------------------------------------------------
	+ Selected MCI group = 1
	+ Selected term = 1
	+ Selected channel = 1
	+------------------------------------------------------------------------
	+ Passed selection = T
	+ Reweighting factor = 1.00000E+00
	+ Analysis flag = T
	+========================================================================
	+ Event transform: trivial (hard process)
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_2_p1'
	+ TAO random-number generator:
	+ seed = 12
	+ calls = 3
	+ Number of tries = 1
	+------------------------------------------------------------------------
	+ Particle set:
	+------------------------------------------------------------------------
	+ Particle 1 [i] f(11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 2 [i] f(-11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 -5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 3 [o] f(23)
	+ E = 4.963451E+02
	+ P = -3.075785E+02 3.444355E+02 1.574893E+02
	+ T = 8.315287819E+03
	+ Parents: 1 2
	+ Particle 4 [o] f(25)
	+ E = 5.036549E+02
	+ P = 3.075785E+02 -3.444355E+02 -1.574893E+02
	+ T = 1.562500000E+04
	+ Parents: 1 2
	+========================================================================
	+========================================================================
	+ Event transform: partonic decays
	+========================================================================
	+ Associated process: 'pythia8_2_p1'
	+ TAO random-number generator:
	+ seed = 13
	+ calls = 3
	+ Number of tries = 1
	+------------------------------------------------------------------------
	+ Particle set:
	+------------------------------------------------------------------------
	+ Particle 1 [i] f(11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 2 [i] f(-11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 -5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 3 [r] f(23)
	+ E = 4.963451E+02
	+ P = -3.075785E+02 3.444355E+02 1.574893E+02
	+ T = 8.315287819E+03
	+ Parents: 1 2
	+ Children: 5 6
	+ Particle 4 [r] f(25)
	+ E = 5.036549E+02
	+ P = 3.075785E+02 -3.444355E+02 -1.574893E+02
	+ T = 1.562500000E+04
	+ Parents: 1 2
	+ Children: 7 8
	+ Particle 5 [o] f(11)
	+ E = 2.266848E+02
	+ P = -1.117798E+02 1.663207E+02 1.059656E+02
	+ T = 0.000000000E+00
	+ Parents: 3
	+ Particle 6 [o] f(-11)
	+ E = 2.696603E+02
	+ P = -1.957986E+02 1.781148E+02 5.152371E+01
	+ T = 0.000000000E+00
	+ Parents: 3
	+ Particle 7 [o] f(5)c(1 )
	+ E = 2.351212E+02
	+ P = 1.859474E+02 -1.400046E+02 -3.296392E+01
	+ T = 1.764000000E+01
	+ Parents: 4
	+ Particle 8 [o] f(-5)c(-1 )
	+ E = 2.685337E+02
	+ P = 1.216311E+02 -2.044309E+02 -1.245254E+02
	+ T = 1.764000000E+01
	+ Parents: 4
	+------------------------------------------------------------------------
	+ Variable list for simulation: [associated, not shown]
	+========================================================================
	+========================================================================
	+========================================================================
	+ Event transform: shower
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_2_p1'
	+ TAO random-number generator:
	+ seed = 16
	+ calls = 1
	+ Number of tries = 1
	+ Particle set:
	+------------------------------------------------------------------------
	+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	+ 1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	+ 2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	+ 3 [r] Z 0 0 1-2 5-6 496.345 -307.578 344.436 157.489 8315.288
	+ 4 [r] H 0 0 1-2 10-11 503.655 307.578 -344.436 -157.489 15625.000
	+ 5 [v] e- 0 0 3 9 226.685 -111.780 166.321 105.966 0.000
	+ 6 [v] e+ 0 0 3 7-8 269.660 -195.799 178.115 51.524 0.000
	+ 7 [o] e+ 0 0 6 [none] 269.659 -195.798 178.114 51.524 0.000
	+ 8 [o] A 0 0 6 [none] 0.001 -0.001 0.001 0.000 0.000
	+ 9 [o] e- 0 0 5 [none] 226.685 -111.780 166.321 105.966 0.000
	+ 10 [v] b 1 0 4 12-13 235.121 185.947 -140.005 -32.964 17.640
	+ 11 [v] bbar 0 1 4 14 268.534 121.631 -204.431 -124.525 17.640
	+ 12 [v] b 502 0 10 38 61.137 54.232 -20.501 -18.941 17.640
	+ 13 [v] gl 501 502 10 17 220.082 152.561 -154.614 -35.432 0.000
	+ 14 [v] bbar 0 501 11 15-16 222.436 100.785 -169.321 -103.116 17.640
	+ 15 [v] bbar 0 503 14 23 217.342 104.491 -168.498 -88.936 17.640
	+ 16 [v] gl 503 501 14 18-19 24.826 9.973 -14.685 -17.357 0.000
	+ 17 [v] gl 501 502 13 20 200.350 138.883 -140.752 -32.255 0.000
	+ 18 [v] gl 503 504 16 21-22 56.297 41.895 -35.680 -11.877 0.000
	+ 19 [v] gl 504 501 16 24-25 23.709 6.328 -17.770 -14.363 0.000
	+ 20 [v] gl 501 502 17 27-28 145.170 100.632 -101.986 -23.372 0.000
	+ 21 [v] gl 505 504 18 26 24.410 19.078 -13.035 -7.873 0.000
	+ 22 [v] gl 503 505 18 30-31 41.329 27.342 -29.974 -7.879 0.000
	+ 23 [v] bbar 0 503 15 32 207.900 99.967 -161.170 -85.061 17.640
	+ 24 [v] gl 506 501 19 29 15.570 2.492 -12.900 -8.355 0.000
	+ 25 [v] gl 504 506 19 45-46 15.012 9.207 -8.540 -8.225 0.000
	+ 26 [v] gl 505 504 21 48-49 17.538 13.707 -9.365 -5.656 0.000
	+ 27 [v] gl 507 502 20 36-37 77.329 55.757 -51.966 -13.056 0.000
	+ 28 [v] gl 501 507 20 41 68.566 44.991 -50.621 -10.705 0.000
	+ 29 [v] gl 506 501 24 39-40 14.845 2.376 -12.299 -7.966 0.000
	+ 30 [v] gl 508 505 22 50 18.813 13.647 -12.770 -2.144 0.000
	+ 31 [v] gl 503 508 22 35 41.544 22.808 -31.965 -13.563 0.000
	+ 32 [v] bbar 0 503 23 33-34 188.872 90.853 -146.409 -77.233 17.640
	+ 33 [v] bbar 0 509 32 71 176.957 84.613 -138.297 -70.785 17.640
	+ 34 [v] gl 509 503 32 69-70 27.168 14.615 -19.848 -11.427 0.000
	+ 35 [v] gl 503 508 31 53 26.291 14.434 -20.228 -8.584 0.000
	+ 36 [v] gl 507 510 27 57-58 66.417 47.653 -45.197 -9.885 0.000
	+ 37 [v] gl 510 502 27 59 13.434 10.367 -7.563 -3.975 0.000
	+ 38 [o] b 502 0 12 [none] 58.615 51.969 -19.708 -18.138 17.640
	+ 39 [v] gl 506 511 29 42-43 13.155 3.760 -10.036 -7.629 0.000
	+ 40 [v] gl 511 501 29 44 4.147 0.229 -4.077 -0.720 0.000
	+ 41 [v] gl 501 507 28 62 66.109 43.379 -48.807 -10.321 0.000
	+ 42 [v] gl 506 512 39 47 9.063 1.862 -8.183 -3.423 0.000
	+ 43 [v] gl 512 511 39 54-55 6.875 2.051 -4.589 -4.690 0.000
	+ 44 [v] gl 511 501 40 78-79 1.363 0.075 -1.341 -0.237 0.000
	+ 45 [v] gl 504 513 25 66-67 5.329 4.096 -2.484 -2.336 0.000
	+ 46 [v] gl 513 506 25 68 11.667 5.519 -7.848 -6.638 0.000
	+ 47 [v] gl 506 512 42 56 7.078 1.455 -6.391 -2.673 0.000
	+ 48 [v] gl 514 504 26 65 10.738 8.135 -5.668 -4.125 0.000
	+ 49 [v] gl 505 514 26 63-64 12.473 9.688 -7.548 -2.178 0.000
	+ 50 [v] gl 508 505 30 51-52 13.139 9.531 -8.919 -1.497 0.000
	+ 51 [o] gl 515 505 50 [none] 14.509 9.544 -10.763 -1.896 0.000
	+ 52 [v] gl 508 515 50 72-73 3.159 2.474 -1.641 -1.080 0.000
	+ 53 [v] gl 503 508 35 74 21.762 11.948 -16.744 -7.105 0.000
	+ 54 [o] gl 516 511 43 [none] 8.407 2.180 -5.950 -5.525 0.000
	+ 55 [o] gl 512 516 43 [none] 1.320 0.457 -1.215 -0.242 0.000
	+ 56 [o] gl 506 512 47 [none] 4.226 0.868 -3.815 -1.596 0.000
	+ 57 [v] gl 507 517 36 60-61 55.386 39.401 -38.088 -8.026 0.000
	+ 58 [o] gl 517 510 36 [none] 12.739 9.569 -8.070 -2.363 0.000
	+ 59 [o] gl 510 502 37 [none] 11.727 9.050 -6.602 -3.470 0.000
	+ 60 [o] dbar 0 517 57 [none] 18.372 13.138 -12.452 -3.127 0.109
	+ 61 [v] d 507 0 57 77 43.188 30.315 -30.194 -5.863 0.109
	+ 62 [v] gl 501 507 41 75-76 59.934 39.328 -44.248 -9.357 0.000
	+ 63 [o] gl 505 518 49 [none] 8.388 6.426 -5.259 -1.193 0.000
	+ 64 [o] gl 518 514 49 [none] 7.352 5.737 -4.014 -2.241 0.000
	+ 65 [o] gl 514 504 48 [none] 7.471 5.660 -3.943 -2.870 0.000
	+ 66 [o] gl 504 519 45 [none] 7.259 5.208 -3.771 -3.369 0.000
	+ 67 [o] gl 519 513 45 [none] 0.443 0.010 -0.309 -0.318 0.000
	+ 68 [o] gl 513 506 46 [none] 9.294 4.397 -6.252 -5.288 0.000
	+ 69 [o] gl 521 503 34 [none] 20.930 10.310 -16.054 -8.606 0.000
	+ 70 [o] gl 509 521 34 [none] 15.612 8.678 -11.213 -6.534 0.000
	+ 71 [o] bbar 0 509 33 [none] 167.583 80.239 -130.879 -67.073 17.640
	+ 72 [o] gl 522 515 52 [none] 3.257 2.345 -1.722 -1.465 0.000
	+ 73 [o] gl 508 522 52 [none] 4.199 2.488 -3.226 -1.018 0.000
	+ 74 [o] gl 503 508 53 [none] 17.464 9.588 -13.437 -5.702 0.000
	+ 75 [v] gl 501 523 62 80 60.832 40.037 -44.879 -9.135 0.000
	+ 76 [o] gl 523 507 62 [none] 5.526 3.809 -3.852 -1.090 0.000
	+ 77 [o] d 507 0 61 [none] 36.764 25.797 -25.711 -4.995 0.109
	+ 78 [o] gl 511 524 44 [none] 1.150 0.178 -0.947 -0.627 0.000
	+ 79 [o] gl 524 501 44 [none] 2.931 1.685 -2.398 -0.018 0.000
	+ 80 [o] gl 501 523 75 [none] 58.115 38.249 -42.874 -8.727 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	+Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+------------------------------------------------------------------------
	+ Shower settings:
	+------------------------------------------------------------------------
	+ Master switches:
	+ ps_isr_active = F
	+ ps_fsr_active = T
	+ ps_tau_dec = F
	+ muli_active = F
	+ hadronization_active = F
	+ General settings:
	+ method = PYTHIA8
	+ shower_verbose = F
	+ ps_mass_cutoff = 1.000000000000E+00
	+ ps_max_n_flavors = 5
	+ [ISR off]
	+ FSR settings:
	+ ps_fsr_lambda = 2.900000000000E-01
	+ ps_fsr_alphas_running = T
	+ Matching Settings:
	+ mlm_matching = F
	+ ckkw_matching = F
	+ PYTHIA6 specific settings:
	+ ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	+========================================================================
	+ Local variables:
	+------------------------------------------------------------------------
	+sqrts* = 1.00000E+03
	+sqrts_hat* => 1.00000E+03
	+n_in* => 2
	+n_out* => 28
	+n_tot* => 30
	+$process_id* => "pythia8_2_p1"
	+process_num_id* => [unknown integer]
	+sqme* => 2.22586E-03
	+sqme_ref* => 2.22586E-03
	+event_index* => 1
	+event_weight* => 1.00000E+00
	+event_weight_ref* => 1.00000E+00
	+event_excess* => 0.00000E+00
	+------------------------------------------------------------------------
	+ subevent:
	+ 1 prt(i:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02\| 0.0000000E+00\| 1)
	+ 2 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02\| 0.0000000E+00\| 2)
	+ 3 prt(o:-11\| 2.6965932E+02;-1.9579790E+02, 1.7811417E+02, 5.1523514E+01\| 0.0000000E+00\| 3)
	+ 4 prt(o:22\| 1.0178157E-03;-7.3903699E-04, 6.7208558E-04, 1.9512579E-04\| 0.0000000E+00\| 4)
	+ 5 prt(o:11\| 2.2668481E+02;-1.1177982E+02, 1.6632067E+02, 1.0596560E+02\| 0.0000000E+00\| 5)
	+ 6 prt(o:5\| 5.8615295E+01; 5.1968712E+01,-1.9707530E+01,-1.8137781E+01\| 1.7640000E+01\| 6)
	+ 7 prt(o:21\| 1.4509208E+01; 9.5439705E+00,-1.0762595E+01,-1.8963880E+00\| 0.0000000E+00\| 7)
	+ 8 prt(o:21\| 8.4071540E+00; 2.1797881E+00,-5.9499924E+00,-5.5250658E+00\| 0.0000000E+00\| 8)
	+ 9 prt(o:21\| 1.3204769E+00; 4.5710914E-01,-1.2148910E+00,-2.4238472E-01\| 0.0000000E+00\| 9)
	+ 10 prt(o:21\| 4.2257477E+00; 8.6833515E-01,-3.8153010E+00,-1.5957495E+00\| 0.0000000E+00\| 10)
	+ 11 prt(o:21\| 1.2738603E+01; 9.5687748E+00,-8.0699834E+00,-2.3634564E+00\| 0.0000000E+00\| 11)
	+ 12 prt(o:21\| 1.1726965E+01; 9.0496893E+00,-6.6019083E+00,-3.4698180E+00\| 0.0000000E+00\| 12)
	+ 13 prt(o:-1\| 1.8372244E+01; 1.3138011E+01,-1.2451753E+01,-3.1268124E+00\| 1.0890000E-01\| 13)
	+ 14 prt(o:21\| 8.3884108E+00; 6.4255456E+00,-5.2588622E+00,-1.1925471E+00\| 0.0000000E+00\| 14)
	+ 15 prt(o:21\| 7.3519496E+00; 5.7374187E+00,-4.0140378E+00,-2.2406898E+00\| 0.0000000E+00\| 15)
	+ 16 prt(o:21\| 7.4708799E+00; 5.6595948E+00,-3.9431156E+00,-2.8696469E+00\| 0.0000000E+00\| 16)
	+ 17 prt(o:21\| 7.2593651E+00; 5.2084554E+00,-3.7710985E+00,-3.3688560E+00\| 0.0000000E+00\| 17)
	+ 18 prt(o:21\| 4.4323737E-01; 1.0052389E-02,-3.0902228E-01,-3.1759021E-01\| 0.0000000E+00\| 18)
	+ 19 prt(o:21\| 9.2943073E+00; 4.3967656E+00,-6.2520874E+00,-5.2881002E+00\| 0.0000000E+00\| 19)
	+ 20 prt(o:21\| 2.0930353E+01; 1.0310149E+01,-1.6053813E+01,-8.6055555E+00\| 0.0000000E+00\| 20)
	+ 21 prt(o:21\| 1.5611688E+01; 8.6775614E+00,-1.1213043E+01,-6.5339423E+00\| 0.0000000E+00\| 21)
	+ 22 prt(o:-5\| 1.6758283E+02; 8.0239481E+01,-1.3087850E+02,-6.7073151E+01\| 1.7640000E+01\| 22)
	+ 23 prt(o:21\| 3.2573917E+00; 2.3454285E+00,-1.7217318E+00,-1.4646520E+00\| 0.0000000E+00\| 23)
	+ 24 prt(o:21\| 4.1993055E+00; 2.4879266E+00,-3.2260819E+00,-1.0182256E+00\| 0.0000000E+00\| 24)
	+ 25 prt(o:21\| 1.7463964E+01; 9.5879762E+00,-1.3436948E+01,-5.7016814E+00\| 0.0000000E+00\| 25)
	+ 26 prt(o:21\| 5.5259685E+00; 3.8087983E+00,-3.8523989E+00,-1.0901404E+00\| 0.0000000E+00\| 26)
	+ 27 prt(o:1\| 3.6764203E+01; 2.5796599E+01,-2.5711456E+01,-4.9954224E+00\| 1.0890000E-01\| 27)
	+ 28 prt(o:21\| 1.1496589E+00; 1.7848118E-01,-9.4714852E-01,-6.2671339E-01\| 0.0000000E+00\| 28)
	+ 29 prt(o:21\| 2.9311221E+00; 1.6851857E+00,-2.3981862E+00,-1.8130400E-02\| 0.0000000E+00\| 29)
	+ 30 prt(o:21\| 5.8114528E+01; 3.8248650E+01,-4.2874025E+01,-8.7268077E+00\| 0.0000000E+00\| 30)
	+========================================================================
	+Contents of pythia8_2d.debug:
	+========================================================================
	+ Event #1
	+------------------------------------------------------------------------
	+ Unweighted = T
	+ Normalization = '1'
	+ Helicity handling = drop
	+ Keep correlations = F
	+------------------------------------------------------------------------
	+ Squared matrix el. (ref) = 2.46579E-03
	+ Squared matrix el. (prc) = 2.46579E-03
	+ Event weight (ref) = 1.00000E+00
	+ Event weight (prc) = 1.00000E+00
	+------------------------------------------------------------------------
	+ Selected MCI group = 1
	+ Selected term = 1
	+ Selected channel = 1
	+------------------------------------------------------------------------
	+ Passed selection = T
	+ Reweighting factor = 1.00000E+00
	+ Analysis flag = T
	+========================================================================
	+ Event transform: trivial (hard process)
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_2_p1'
	+ TAO random-number generator:
	+ seed = 19
	+ calls = 3
	+ Number of tries = 1
	+------------------------------------------------------------------------
	+ Particle set:
	+------------------------------------------------------------------------
	+ Particle 1 [i] f(11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 2 [i] f(-11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 -5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 3 [o] f(23)
	+ E = 4.963451E+02
	+ P = -4.984482E+01 -4.853193E+02 -4.889900E+00
	+ T = 8.315287819E+03
	+ Parents: 1 2
	+ Particle 4 [o] f(25)
	+ E = 5.036549E+02
	+ P = 4.984482E+01 4.853193E+02 4.889900E+00
	+ T = 1.562500000E+04
	+ Parents: 1 2
	+========================================================================
	+========================================================================
	+ Event transform: partonic decays
	+========================================================================
	+ Associated process: 'pythia8_2_p1'
	+ TAO random-number generator:
	+ seed = 20
	+ calls = 3
	+ Number of tries = 1
	+------------------------------------------------------------------------
	+ Particle set:
	+------------------------------------------------------------------------
	+ Particle 1 [i] f(11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 2 [i] f(-11)
	+ E = 5.000000E+02
	+ P = 0.000000E+00 0.000000E+00 -5.000000E+02
	+ T = 0.000000000E+00
	+ Children: 3 4
	+ Particle 3 [r] f(23)
	+ E = 4.963451E+02
	+ P = -4.984482E+01 -4.853193E+02 -4.889900E+00
	+ T = 8.315287819E+03
	+ Parents: 1 2
	+ Children: 5 6
	+ Particle 4 [r] f(25)
	+ E = 5.036549E+02
	+ P = 4.984482E+01 4.853193E+02 4.889900E+00
	+ T = 1.562500000E+04
	+ Parents: 1 2
	+ Children: 7 8
	+ Particle 5 [o] f(11)
	+ E = 1.652463E+02
	+ P = -5.196004E+01 -1.548443E+02 -2.509479E+01
	+ T = 0.000000000E+00
	+ Parents: 3
	+ Particle 6 [o] f(-11)
	+ E = 3.310988E+02
	+ P = 2.115219E+00 -3.304750E+02 2.020489E+01
	+ T = 0.000000000E+00
	+ Parents: 3
	+ Particle 7 [o] f(5)c(1 )
	+ E = 3.461467E+02
	+ P = 1.423050E+01 3.410903E+02 5.705109E+01
	+ T = 1.764000000E+01
	+ Parents: 4
	+ Particle 8 [o] f(-5)c(-1 )
	+ E = 1.575081E+02
	+ P = 3.561432E+01 1.442290E+02 -5.216119E+01
	+ T = 1.764000000E+01
	+ Parents: 4
	+------------------------------------------------------------------------
	+ Variable list for simulation: [associated, not shown]
	+========================================================================
	+========================================================================
	+========================================================================
	+ Event transform: shower
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_2_p1'
	+ TAO random-number generator:
	+ seed = 23
	+ calls = 1
	+ Number of tries = 1
	+ Particle set:
	+------------------------------------------------------------------------
	+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	+ 1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	+ 2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	+ 3 [r] Z 0 0 1-2 5-6 496.345 -49.845 -485.319 -4.890 8315.288
	+ 4 [r] H 0 0 1-2 13-14 503.655 49.845 485.319 4.890 15625.000
	+ 5 [v] e- 0 0 3 7-8 165.246 -51.960 -154.844 -25.095 0.000
	+ 6 [v] e+ 0 0 3 9 331.099 2.115 -330.475 20.205 0.000
	+ 7 [v] e- 0 0 5 12 165.241 -51.957 -154.840 -25.094 0.000
	+ 8 [o] A 0 0 5 [none] 0.006 -0.003 -0.005 -0.000 0.000
	+ 9 [v] e+ 0 0 6 10-11 331.098 2.115 -330.474 20.205 0.000
	+ 10 [o] e+ 0 0 9 [none] 331.098 2.115 -330.474 20.205 0.000
	+ 11 [o] A 0 0 9 [none] 0.000 0.000 -0.000 -0.000 0.000
	+ 12 [o] e- 0 0 7 [none] 165.241 -51.957 -154.840 -25.094 0.000
	+ 13 [v] b 1 0 4 17 346.147 14.231 341.090 57.051 17.640
	+ 14 [v] bbar 0 1 4 15-16 157.508 35.614 144.229 -52.161 17.640
	+ 15 [v] bbar 0 502 14 20 158.282 32.774 147.493 -46.981 17.640
	+ 16 [v] gl 502 501 14 18-19 6.290 3.130 3.697 -4.012 0.000
	+ 17 [v] b 501 0 13 23 339.083 13.941 334.129 55.883 17.640
	+ 18 [v] gl 503 501 16 21-22 5.174 3.293 2.901 -2.741 0.000
	+ 19 [v] gl 502 503 16 32 26.448 5.047 24.444 -8.748 0.000
	+ 20 [o] bbar 0 502 15 [none] 132.950 27.564 123.845 -39.504 17.640
	+ 21 [v] gl 503 506 18 30-31 6.578 4.287 4.682 -1.725 0.000
	+ 22 [v] gl 506 501 18 24-25 1.476 -0.876 1.058 -0.541 0.000
	+ 23 [v] b 501 0 17 26 336.203 13.824 331.291 55.408 17.640
	+ 24 [v] gl 506 507 22 36-37 4.768 1.244 4.601 -0.111 0.000
	+ 25 [v] gl 507 501 22 27-28 5.637 -1.751 5.255 1.044 0.000
	+ 26 [v] b 501 0 23 29 327.275 13.454 322.492 53.935 17.640
	+ 27 [v] gl 507 508 25 42-43 1.735 -0.294 1.632 -0.509 0.000
	+ 28 [v] gl 508 501 25 33-34 12.864 -1.080 12.456 3.029 0.000
	+ 29 [v] b 501 0 26 35 318.313 13.077 313.660 52.458 17.640
	+ 30 [v] gl 509 506 21 38 8.596 5.057 6.607 -2.160 0.000
	+ 31 [o] gl 503 509 21 [none] 1.983 -0.007 1.773 -0.889 0.000
	+ 32 [o] gl 502 503 19 [none] 22.447 4.283 20.746 -7.425 0.000
	+ 33 [v] gl 508 511 28 39-40 13.724 -1.150 13.328 3.065 0.000
	+ 34 [v] gl 511 501 28 41 21.256 1.026 20.927 3.582 0.000
	+ 35 [o] b 501 0 29 [none] 296.196 12.121 291.860 48.841 17.640
	+ 36 [o] gl 512 507 24 [none] 1.206 0.242 1.042 -0.557 0.000
	+ 37 [o] gl 506 512 24 [none] 5.263 2.004 4.867 0.018 0.000
	+ 38 [o] gl 509 506 30 [none] 6.894 4.056 5.299 -1.732 0.000
	+ 39 [v] gl 508 513 33 44 7.237 -0.926 7.048 1.361 0.000
	+ 40 [o] gl 513 511 33 [none] 12.283 0.056 11.986 2.681 0.000
	+ 41 [o] gl 511 501 34 [none] 15.461 0.746 15.221 2.605 0.000
	+ 42 [o] gl 507 514 27 [none] 4.304 -0.639 4.256 0.064 0.000
	+ 43 [o] gl 514 508 27 [none] 0.084 0.006 -0.040 -0.074 0.000
	+ 44 [o] gl 508 513 39 [none] 4.584 -0.586 4.464 0.862 0.000
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	+Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+------------------------------------------------------------------------
	+ Shower settings:
	+------------------------------------------------------------------------
	+ Master switches:
	+ ps_isr_active = F
	+ ps_fsr_active = T
	+ ps_tau_dec = F
	+ muli_active = F
	+ hadronization_active = T
	+ General settings:
	+ method = PYTHIA8
	+ shower_verbose = F
	+ ps_mass_cutoff = 1.000000000000E+00
	+ ps_max_n_flavors = 5
	+ [ISR off]
	+ FSR settings:
	+ ps_fsr_lambda = 2.900000000000E-01
	+ ps_fsr_alphas_running = T
	+ Matching Settings:
	+ mlm_matching = F
	+ ckkw_matching = F
	+ PYTHIA6 specific settings:
	+ ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	+========================================================================
	+========================================================================
	+ Event transform: hadronization
	+------------------------------------------------------------------------
	+ Associated process: 'pythia8_2_p1'
	+ TAO random-number generator:
	+ seed = 25
	+ calls = 1
	+ Number of tries = 1
	+ Particle set:
	+------------------------------------------------------------------------
	+ Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	+ 1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	+ 2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	+ 3 [r] Z 0 0 1-2 5-8 496.345 -49.845 -485.319 -4.890 8315.288
	+ 4 [r] H 0 0 1-2 9-20 503.655 49.845 485.319 4.890 15625.000
	+ 5 [o] A 0 0 3 [none] 0.006 -0.003 -0.005 -0.000 0.000
	+ 6 [o] e+ 0 0 3 [none] 331.098 2.115 -330.474 20.205 0.000
	+ 7 [o] A 0 0 3 [none] 0.000 0.000 -0.000 -0.000 0.000
	+ 8 [o] e- 0 0 3 [none] 165.241 -51.957 -154.840 -25.094 0.000
	+ 9 [v] bbar 0 502 4 32 132.950 27.564 123.845 -39.504 17.640
	+ 10 [v] gl 503 509 4 30 1.983 -0.007 1.773 -0.889 0.000
	+ 11 [v] gl 502 503 4 31 22.447 4.283 20.746 -7.425 0.000
	+ 12 [v] b 501 0 4 21 296.196 12.121 291.860 48.841 17.640
	+ 13 [v] gl 512 507 4 27 1.206 0.242 1.042 -0.557 0.000
	+ 14 [v] gl 506 512 4 28 5.263 2.004 4.867 0.018 0.000
	+ 15 [v] gl 509 506 4 29 6.894 4.056 5.299 -1.732 0.000
	+ 16 [v] gl 513 511 4 23 12.283 0.056 11.986 2.681 0.000
	+ 17 [v] gl 511 501 4 21 15.461 0.746 15.221 2.605 0.000
	+ 18 [v] gl 507 514 4 26 4.304 -0.639 4.256 0.064 0.000
	+ 19 [v] gl 514 508 4 25 0.084 0.006 -0.040 -0.074 0.000
	+ 20 [v] gl 508 513 4 24 4.584 -0.586 4.464 0.862 0.000
	+ 21 [v] b 1011 0 12,17 22 311.657 12.867 307.081 51.446 18.872
	+ 22 [v] b 1011 0 21 33-47 311.657 12.867 307.081 51.446 18.872
	+ 23 [v] gl 513 511 16 33-47 12.283 0.056 11.986 2.681 0.000
	+ 24 [v] gl 508 513 20 33-47 4.584 -0.586 4.464 0.862 0.000
	+ 25 [v] gl 514 508 19 33-47 0.084 0.006 -0.040 -0.074 0.000
	+ 26 [v] gl 507 514 18 33-47 4.304 -0.639 4.256 0.064 0.000
	+ 27 [v] gl 512 507 13 33-47 1.206 0.242 1.042 -0.557 0.000
	+ 28 [v] gl 506 512 14 33-47 5.263 2.004 4.867 0.018 0.000
	+ 29 [v] gl 509 506 15 33-47 6.894 4.056 5.299 -1.732 0.000
	+ 30 [v] gl 503 509 10 33-47 1.983 -0.007 1.773 -0.889 0.000
	+ 31 [v] gl 502 503 11 33-47 22.447 4.283 20.746 -7.425 0.000
	+ 32 [v] bbar 0 502 9 33-47 132.950 27.564 123.845 -39.504 17.640
	+ 33 [r] bstarba 0 0 22-32 54-55 278.645 11.116 274.473 46.432 28.358
	+ 34 [r] pi0 0 0 22-32 56-57 25.051 0.643 24.664 4.334 0.018
	+ 35 [r] rhop 0 0 22-32 48-49 11.570 0.431 11.450 1.408 0.602
	+ 36 [o] pim 0 0 22-32 [none] 9.994 0.493 9.810 1.839 0.019
	+ 37 [o] pip 0 0 22-32 [none] 1.187 -0.156 1.030 0.552 0.019
	+ 38 [r] eta 0 0 22-32 58-60 2.846 -0.590 2.682 0.504 0.300
	+ 39 [r] rhom 0 0 22-32 50-51 4.868 0.800 4.705 -0.464 0.704
	+ 40 [r] pi0 0 0 22-32 61-62 1.496 0.724 1.301 0.032 0.018
	+ 41 [r] etaprim 0 0 22-32 63-65 2.227 0.116 1.995 -0.225 0.917
	+ 42 [r] rhop 0 0 22-32 52-53 6.654 3.239 5.583 -1.301 0.923
	+ 43 [r] omega 0 0 22-32 66-68 2.977 0.637 2.505 -1.257 0.602
	+ 44 [r] omega 0 0 22-32 69-71 5.217 1.096 4.826 -1.454 0.610
	+ 45 [o] pim 0 0 22-32 [none] 17.367 4.317 16.142 -4.735 0.019
	+ 46 [o] pip 0 0 22-32 [none] 4.837 0.849 4.427 -1.747 0.019
	+ 47 [r] bstar0 0 0 22-32 72-73 128.720 26.130 119.726 -39.029 28.358
	+ 48 [o] pip 0 0 35 [none] 2.088 0.246 2.068 0.050 0.019
	+ 49 [r] pi0 0 0 35 74-75 9.482 0.185 9.382 1.358 0.018
	+ 50 [o] pim 0 0 39 [none] 1.803 0.547 1.654 -0.444 0.019
	+ 51 [r] pi0 0 0 39 76-77 3.065 0.253 3.052 -0.020 0.018
	+ 52 [o] pip 0 0 42 [none] 3.460 1.537 3.084 -0.280 0.019
	+ 53 [r] pi0 0 0 42 78-79 3.194 1.702 2.499 -1.021 0.018
	+ 54 [r] bbarM 0 0 33 80-82 275.007 11.000 270.892 45.800 27.870
	+ 55 [o] A 0 0 33 [none] 3.638 0.116 3.581 0.632 0.000
	+ 56 [o] A 0 0 34 [none] 1.048 0.035 1.027 0.207 0.000
	+ 57 [o] A 0 0 34 [none] 24.003 0.609 23.637 4.127 0.000
	+ 58 [r] pi0 0 0 38 83-84 1.383 -0.225 1.355 0.099 0.018
	+ 59 [r] pi0 0 0 38 85-86 0.911 -0.225 0.837 0.247 0.018
	+ 60 [r] pi0 0 0 38 87-88 0.551 -0.140 0.491 0.158 0.018
	+ 61 [o] A 0 0 40 [none] 0.576 0.335 0.469 0.023 0.000
	+ 62 [o] A 0 0 40 [none] 0.919 0.389 0.833 0.009 0.000
	+ 63 [o] pip 0 0 41 [none] 0.275 0.043 0.233 -0.005 0.019
	+ 64 [o] pim 0 0 41 [none] 0.892 -0.065 0.870 -0.125 0.019
	+ 65 [r] eta 0 0 41 89-91 1.060 0.138 0.891 -0.095 0.300
	+ 66 [o] pip 0 0 43 [none] 1.228 0.131 1.162 -0.346 0.019
	+ 67 [o] pim 0 0 43 [none] 1.280 0.290 1.068 -0.628 0.019
	+ 68 [r] pi0 0 0 43 92-93 0.469 0.216 0.275 -0.282 0.018
	+ 69 [o] pip 0 0 44 [none] 3.810 0.655 3.590 -1.087 0.019
	+ 70 [o] pim 0 0 44 [none] 0.690 0.232 0.630 -0.076 0.019
	+ 71 [r] pi0 0 0 44 94-95 0.717 0.208 0.607 -0.291 0.018
	+ 72 [r] b0 0 0 47 96-98 127.393 25.835 118.486 -38.662 27.874
	+ 73 [o] A 0 0 47 [none] 1.326 0.295 1.240 -0.367 0.000
	+ 74 [o] A 0 0 49 [none] 7.459 0.186 7.375 1.106 0.000
	+ 75 [o] A 0 0 49 [none] 2.023 -0.001 2.007 0.252 0.000
	+ 76 [o] A 0 0 51 [none] 1.616 0.198 1.604 -0.029 0.000
	+ 77 [o] A 0 0 51 [none] 1.449 0.055 1.448 0.009 0.000
	+ 78 [o] A 0 0 53 [none] 0.347 0.154 0.279 -0.138 0.000
	+ 79 [o] A 0 0 53 [none] 2.847 1.548 2.220 -0.883 0.000
	+ 80 [r] dstar0 0 0 54 99-100 82.681 3.276 81.477 13.525 4.028
	+ 81 [r] d0 0 0 54 101-103 112.419 4.814 110.813 18.213 3.478
	+ 82 [r] kstarm 0 0 54 104-105 79.907 2.910 78.602 14.062 0.750
	+ 83 [o] A 0 0 58 [none] 1.100 -0.127 1.089 0.092 0.000
	+ 84 [o] A 0 0 58 [none] 0.283 -0.098 0.266 0.008 0.000
	+ 85 [o] A 0 0 59 [none] 0.731 -0.231 0.670 0.179 0.000
	+ 86 [o] A 0 0 59 [none] 0.180 0.006 0.167 0.068 0.000
	+ 87 [o] A 0 0 60 [none] 0.272 -0.126 0.218 0.104 0.000
	+ 88 [o] A 0 0 60 [none] 0.279 -0.014 0.273 0.053 0.000
	+ 89 [r] pi0 0 0 65 106-107 0.434 0.066 0.405 -0.048 0.018
	+ 90 [r] pi0 0 0 65 108-109 0.243 0.147 0.138 -0.012 0.018
	+ 91 [r] pi0 0 0 65 110-111 0.383 -0.074 0.348 -0.035 0.018
	+ 92 [o] A 0 0 68 [none] 0.376 0.166 0.198 -0.274 0.000
	+ 93 [o] A 0 0 68 [none] 0.093 0.051 0.077 -0.008 0.000
	+ 94 [o] A 0 0 71 [none] 0.505 0.199 0.404 -0.227 0.000
	+ 95 [o] A 0 0 71 [none] 0.212 0.009 0.202 -0.064 0.000
	+ 96 [r] dstarm 0 0 72 112-113 88.390 17.378 82.529 -26.375 4.041
	+ 97 [o] p 0 0 72 [none] 19.893 3.775 18.626 -5.803 0.880
	+ 98 [o] nbar 0 0 72 [none] 19.111 4.682 17.331 -6.485 0.883
	+ 99 [r] dbar0 0 0 80 114-115 76.212 3.033 75.094 12.503 3.478
	+ 100 [r] pi0 0 0 80 116-117 6.470 0.243 6.383 1.021 0.018
	+ 101 [o] e+ 0 0 81 [none] 4.378 0.318 4.338 0.493 0.000
	+ 102 [o] nue 0 0 81 [none] 36.434 1.855 35.850 6.223 0.000
	+ 103 [r] kstarm 0 0 81 118-119 71.607 2.641 70.624 11.497 0.586
	+ 104 [o] km 0 0 82 [none] 72.676 2.496 71.499 12.776 0.244
	+ 105 [r] pi0 0 0 82 120-121 7.231 0.414 7.102 1.286 0.018
	+ 106 [o] A 0 0 89 [none] 0.119 -0.029 0.104 -0.050 0.000
	+ 107 [o] A 0 0 89 [none] 0.316 0.095 0.301 0.002 0.000
	+ 108 [o] A 0 0 90 [none] 0.068 0.025 0.031 0.055 0.000
	+ 109 [o] A 0 0 90 [none] 0.175 0.121 0.107 -0.067 0.000
	+ 110 [o] A 0 0 91 [none] 0.032 0.019 0.015 0.021 0.000
	+ 111 [o] A 0 0 91 [none] 0.351 -0.093 0.334 -0.055 0.000
	+ 112 [r] dbar0 0 0 96 122-125 80.488 15.810 75.150 -24.028 3.478
	+ 113 [o] pim 0 0 96 [none] 7.902 1.568 7.379 -2.346 0.019
	+ 114 [r] a1m 0 0 99 126-127 23.916 0.952 23.591 3.693 0.902
	+ 115 [o] kp 0 0 99 [none] 52.296 2.081 51.504 8.810 0.244
	+ 116 [o] A 0 0 100 [none] 2.579 0.040 2.551 0.375 0.000
	+ 117 [o] A 0 0 100 [none] 3.891 0.203 3.832 0.647 0.000
	+ 118 [o] km 0 0 103 [none] 43.395 1.775 42.785 7.013 0.244
	+ 119 [r] pi0 0 0 103 128-129 28.212 0.866 27.839 4.484 0.018
	+ 120 [o] A 0 0 105 [none] 4.277 0.311 4.197 0.764 0.000
	+ 121 [o] A 0 0 105 [none] 2.954 0.103 2.906 0.523 0.000
	+ 122 [o] kp 0 0 112 [none] 29.175 5.837 27.078 -9.148 0.244
	+ 123 [o] pim 0 0 112 [none] 7.990 1.475 7.478 -2.394 0.019
	+ 124 [o] pim 0 0 112 [none] 31.717 5.877 29.758 -9.267 0.019
	+ 125 [o] pip 0 0 112 [none] 11.605 2.621 10.837 -3.219 0.019
	+ 126 [r] rho0 0 0 114 130-131 17.793 0.721 17.529 2.876 0.548
	+ 127 [o] pim 0 0 114 [none] 6.122 0.231 6.061 0.818 0.019
	+ 128 [o] A 0 0 119 [none] 24.158 0.721 23.833 3.882 0.000
	+ 129 [o] A 0 0 119 [none] 4.053 0.145 4.006 0.602 0.000
	+ 130 [o] pip 0 0 126 [none] 11.792 0.223 11.600 2.100 0.019
	+ 131 [o] pim 0 0 126 [none] 6.002 0.498 5.929 0.776 0.019
	+------------------------------------------------------------------------
	+Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	+Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	+------------------------------------------------------------------------
	+ Shower settings:
	+------------------------------------------------------------------------
	+ Master switches:
	+ ps_isr_active = F
	+ ps_fsr_active = T
	+ ps_tau_dec = F
	+ muli_active = F
	+ hadronization_active = T
	+ General settings:
	+ method = PYTHIA8
	+ shower_verbose = F
	+ ps_mass_cutoff = 1.000000000000E+00
	+ ps_max_n_flavors = 5
	+ [ISR off]
	+ FSR settings:
	+ ps_fsr_lambda = 2.900000000000E-01
	+ ps_fsr_alphas_running = T
	+ Matching Settings:
	+ mlm_matching = F
	+ ckkw_matching = F
	+ PYTHIA6 specific settings:
	+ ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	+------------------------------------------------------------------------
	+ Hadronization settings:
	+------------------------------------------------------------------------
	+ Master switches:
	+ active = T
	+ General settings:
	+ hadron_method = PYTHIA8
	+ pT generation parameters
	+ enhanced_fraction = 1.000000000000E-02
	+ enhanced_width = 2.000000000000E+00
	+========================================================================
	+ Local variables:
	+------------------------------------------------------------------------
	+sqrts* = 1.00000E+03
	+sqrts_hat* => 1.00000E+03
	+n_in* => 2
	+n_out* => 66
	+n_tot* => 68
	+$process_id* => "pythia8_2_p1"
	+process_num_id* => [unknown integer]
	+sqme* => 2.46579E-03
	+sqme_ref* => 2.46579E-03
	+event_index* => 1
	+event_weight* => 1.00000E+00
	+event_weight_ref* => 1.00000E+00
	+event_excess* => 0.00000E+00
	+------------------------------------------------------------------------
	+ subevent:
	+ 1 prt(i:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-5.0000000E+02\| 0.0000000E+00\| 1)
	+ 2 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 5.0000000E+02\| 0.0000000E+00\| 2)
	+ 3 prt(o:22\| 5.9931651E-03;-2.5814729E-03,-5.3994777E-03,-3.1570007E-04\| 0.0000000E+00\| 3)
	+ 4 prt(o:-11\| 3.3109783E+02; 2.1151968E+00,-3.3047400E+02, 2.0204838E+01\| 0.0000000E+00\| 4)
	+ 5 prt(o:22\| 3.7226409E-05; 7.8771217E-06,-3.5715098E-05,-6.9417730E-06\| 0.0000000E+00\| 5)
	+ 6 prt(o:11\| 1.6524128E+02;-5.1957445E+01,-1.5483984E+02,-2.5094415E+01\| 0.0000000E+00\| 6)
	+ 7 prt(o:-211\| 9.9939202E+00; 4.9312785E-01, 9.8098639E+00, 1.8391182E+00\| 1.9479785E-02\| 7)
	+ 8 prt(o:211\| 1.1868807E+00;-1.5619381E-01, 1.0298587E+00, 5.5154382E-01\| 1.9479785E-02\| 8)
	+ 9 prt(o:-211\| 1.7367432E+01; 4.3170854E+00, 1.6141669E+01,-4.7347138E+00\| 1.9479785E-02\| 9)
	+ 10 prt(o:211\| 4.8367750E+00; 8.4885170E-01, 4.4274584E+00,-1.7469904E+00\| 1.9479785E-02\| 10)
	+ 11 prt(o:211\| 2.0876591E+00; 2.4586159E-01, 2.0678178E+00, 5.0223025E-02\| 1.9479785E-02\| 11)
	+ 12 prt(o:-211\| 1.8029647E+00; 5.4748047E-01, 1.6535606E+00,-4.4407716E-01\| 1.9479785E-02\| 12)
	+ 13 prt(o:211\| 3.4599259E+00; 1.5369622E+00, 3.0839644E+00,-2.8021074E-01\| 1.9479785E-02\| 13)
	+ 14 prt(o:22\| 3.6377768E+00; 1.1583169E-01, 3.5805949E+00, 6.3193597E-01\| 0.0000000E+00\| 14)
	+ 15 prt(o:22\| 1.0480697E+00; 3.4684926E-02, 1.0268956E+00, 2.0671803E-01\| 0.0000000E+00\| 15)
	+ 16 prt(o:22\| 2.4002571E+01; 6.0871542E-01, 2.3637248E+01, 4.1271525E+00\| 0.0000000E+00\| 16)
	+ 17 prt(o:22\| 5.7633459E-01; 3.3476011E-01, 4.6856332E-01, 2.3358999E-02\| 0.0000000E+00\| 17)
	+ 18 prt(o:22\| 9.1936202E-01; 3.8926383E-01, 8.3284220E-01, 8.6057171E-03\| 0.0000000E+00\| 18)
	+ 19 prt(o:211\| 2.7527126E-01; 4.2527060E-02, 2.3337220E-01,-4.8320541E-03\| 1.9479785E-02\| 19)
	+ 20 prt(o:-211\| 8.9234138E-01;-6.4525912E-02, 8.7007458E-01,-1.2489989E-01\| 1.9479785E-02\| 20)
	+ 21 prt(o:211\| 1.2277232E+00; 1.3076434E-01, 1.1622396E+00,-3.4630099E-01\| 1.9479785E-02\| 21)
	+ 22 prt(o:-211\| 1.2802573E+00; 2.9022390E-01, 1.0679181E+00,-6.2841070E-01\| 1.9479785E-02\| 22)
	+ 23 prt(o:211\| 3.8098049E+00; 6.5542997E-01, 3.5895044E+00,-1.0867396E+00\| 1.9479785E-02\| 23)
	+ 24 prt(o:-211\| 6.9021149E-01; 2.3228016E-01, 6.3020296E-01,-7.6172658E-02\| 1.9479785E-02\| 24)
	+ 25 prt(o:22\| 1.3261798E+00; 2.9507179E-01, 1.2398920E+00,-3.6654226E-01\| 0.0000000E+00\| 25)
	+ 26 prt(o:22\| 7.4592911E+00; 1.8564813E-01, 7.3745270E+00, 1.1058527E+00\| 0.0000000E+00\| 26)
	+ 27 prt(o:22\| 2.0231174E+00;-6.0552518E-04, 2.0073552E+00, 2.5204887E-01\| 0.0000000E+00\| 27)
	+ 28 prt(o:22\| 1.6163529E+00; 1.9774673E-01, 1.6039402E+00,-2.9476131E-02\| 0.0000000E+00\| 28)
	+ 29 prt(o:22\| 1.4487544E+00; 5.4982391E-02, 1.4476803E+00, 9.3832289E-03\| 0.0000000E+00\| 29)
	+ 30 prt(o:22\| 3.4703726E-01; 1.5384395E-01, 2.7862170E-01,-1.3833600E-01\| 0.0000000E+00\| 30)
	+ 31 prt(o:22\| 2.8467922E+00; 1.5477959E+00, 2.2201897E+00,-8.8278631E-01\| 0.0000000E+00\| 31)
	+ 32 prt(o:22\| 1.1000047E+00;-1.2700083E-01, 1.0888102E+00, 9.1506219E-02\| 0.0000000E+00\| 32)
	+ 33 prt(o:22\| 2.8321223E-01;-9.7743823E-02, 2.6569375E-01, 7.8832267E-03\| 0.0000000E+00\| 33)
	+ 34 prt(o:22\| 7.3120510E-01;-2.3092996E-01, 6.7020777E-01, 1.7931480E-01\| 0.0000000E+00\| 34)
	+ 35 prt(o:22\| 1.8018822E-01; 5.7016939E-03, 1.6676449E-01, 6.8006545E-02\| 0.0000000E+00\| 35)
	+ 36 prt(o:22\| 2.7217549E-01;-1.2617511E-01, 2.1756654E-01, 1.0403912E-01\| 0.0000000E+00\| 36)
	+ 37 prt(o:22\| 2.7886940E-01;-1.3934280E-02, 2.7333787E-01, 5.3482582E-02\| 0.0000000E+00\| 37)
	+ 38 prt(o:22\| 3.7643591E-01; 1.6565003E-01, 1.9774035E-01,-2.7415838E-01\| 0.0000000E+00\| 38)
	+ 39 prt(o:22\| 9.2608910E-02; 5.0566055E-02, 7.7202991E-02,-7.6930147E-03\| 0.0000000E+00\| 39)
	+ 40 prt(o:22\| 5.0492728E-01; 1.9943659E-01, 4.0448075E-01,-2.2709454E-01\| 0.0000000E+00\| 40)
	+ 41 prt(o:22\| 2.1225546E-01; 8.7008856E-03, 2.0214932E-01,-6.4127431E-02\| 0.0000000E+00\| 41)
	+ 42 prt(o:2212\| 1.9892885E+01; 3.7747326E+00, 1.8625911E+01,-5.8028729E+00\| 8.8035059E-01\| 42)
	+ 43 prt(o:-2112\| 1.9110943E+01; 4.6822364E+00, 1.7331193E+01,-6.4847340E+00\| 8.8279178E-01\| 43)
	+ 44 prt(o:-11\| 4.3778762E+00; 3.1832435E-01, 4.3383859E+00, 4.9282616E-01\| 0.0000000E+00\| 44)
	+ 45 prt(o:12\| 3.6433680E+01; 1.8553411E+00, 3.5850299E+01, 6.2230854E+00\| 0.0000000E+00\| 45)
	+ 46 prt(o:-321\| 7.2676388E+01; 2.4956363E+00, 7.1499341E+01, 1.2776138E+01\| 2.4371994E-01\| 46)
	+ 47 prt(o:22\| 1.1861858E-01;-2.9412262E-02, 1.0369996E-01,-4.9513686E-02\| 0.0000000E+00\| 47)
	+ 48 prt(o:22\| 3.1565927E-01; 9.5058546E-02, 3.0100120E-01, 1.7100521E-03\| 0.0000000E+00\| 48)
	+ 49 prt(o:22\| 6.7703794E-02; 2.5116333E-02, 3.1263396E-02, 5.4548818E-02\| 0.0000000E+00\| 49)
	+ 50 prt(o:22\| 1.7506684E-01; 1.2142511E-01, 1.0690719E-01,-6.6896890E-02\| 0.0000000E+00\| 50)
	+ 51 prt(o:22\| 3.1561995E-02; 1.8919975E-02, 1.4578815E-02, 2.0631341E-02\| 0.0000000E+00\| 51)
	+ 52 prt(o:22\| 3.5094649E-01;-9.2942772E-02, 3.3385795E-01,-5.5353007E-02\| 0.0000000E+00\| 52)
	+ 53 prt(o:-211\| 7.9018149E+00; 1.5678568E+00, 7.3794446E+00,-2.3462355E+00\| 1.9479785E-02\| 53)
	+ 54 prt(o:321\| 5.2295712E+01; 2.0811094E+00, 5.1503865E+01, 8.8101420E+00\| 2.4371994E-01\| 54)
	+ 55 prt(o:22\| 2.5785891E+00; 3.9519416E-02, 2.5509206E+00, 3.7465235E-01\| 0.0000000E+00\| 55)
	+ 56 prt(o:22\| 3.8912420E+00; 2.0299586E-01, 3.8317396E+00, 6.4678296E-01\| 0.0000000E+00\| 56)
	+ 57 prt(o:-321\| 4.3395234E+01; 1.7751121E+00, 4.2785156E+01, 7.0129882E+00\| 2.4371994E-01\| 57)
	+ 58 prt(o:22\| 4.2768372E+00; 3.1115114E-01, 4.1965760E+00, 7.6372201E-01\| 0.0000000E+00\| 58)
	+ 59 prt(o:22\| 2.9541726E+00; 1.0307018E-01, 2.9057550E+00, 5.2258967E-01\| 0.0000000E+00\| 59)
	+ 60 prt(o:321\| 2.9175346E+01; 5.8369847E+00, 2.7077643E+01,-9.1481109E+00\| 2.4371994E-01\| 60)
	+ 61 prt(o:-211\| 7.9902483E+00; 1.4753427E+00, 7.4777843E+00,-2.3938866E+00\| 1.9479785E-02\| 61)
	+ 62 prt(o:-211\| 3.1716699E+01; 5.8766981E+00, 2.9757642E+01,-9.2669669E+00\| 1.9479785E-02\| 62)
	+ 63 prt(o:211\| 1.1605430E+01; 2.6209090E+00, 1.0836618E+01,-3.2194844E+00\| 1.9479785E-02\| 63)
	+ 64 prt(o:-211\| 6.1223092E+00; 2.3111023E-01, 6.0614537E+00, 8.1765314E-01\| 1.9479785E-02\| 64)
	+ 65 prt(o:22\| 2.4158274E+01; 7.2095042E-01, 2.3833377E+01, 3.8823408E+00\| 0.0000000E+00\| 65)
	+ 66 prt(o:22\| 4.0534465E+00; 1.4471431E-01, 4.0058866E+00, 6.0196288E-01\| 0.0000000E+00\| 66)
	+ 67 prt(o:211\| 1.1791645E+01; 2.2294350E-01, 1.1600173E+01, 2.0999252E+00\| 1.9479785E-02\| 67)
	+ 68 prt(o:-211\| 6.0018385E+00; 4.9803292E-01, 5.9289902E+00, 7.7564415E-01\| 1.9479785E-02\| 68)
	+========================================================================
	Index: trunk/share/tests/functional_tests/ref-output-quad/pythia6_3.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-quad/pythia6_3.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output-quad/pythia6_3.ref (revision 8190)
	@@ -1,748 +1,757 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	?pacify = true
	$method = "omega"
	\| Process library 'pythia6_3_lib': recorded process 'pythia6_3_p1'
	SM.me => 1.00000E+01
	\| Process library 'pythia6_3_lib': compiling ...
	\| Process library 'pythia6_3_lib': writing makefile
	\| Process library 'pythia6_3_lib': removing old files
	\| Process library 'pythia6_3_lib': writing driver
	\| Process library 'pythia6_3_lib': creating source code
	\| Process library 'pythia6_3_lib': compiling sources
	\| Process library 'pythia6_3_lib': linking
	\| Process library 'pythia6_3_lib': loading
	\| Process library 'pythia6_3_lib': ... success.
	seed = 0
	$phs_method = "wood"
	$integration_method = "vamp"
	sqrts = 5.00000E+02
	openmp_num_threads = 1
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process pythia6_3_p1:
	\| Beam structure: e-, e+ => circe1 => isr
	\| Beam data (collision):
	\| e- (mass = 1.0000000E+01 GeV)
	\| e+ (mass = 1.0000000E+01 GeV)
	\| sqrts = 5.000000000000E+02 GeV
	\| CIRCE1: activating generator mode
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'pythia6_3_p1.i1.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'pythia6_3_p1'
	\| Library name = 'pythia6_3_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'pythia6_3_p1_i1': e-, e+ => u, ubar [omega]
	\| ------------------------------------------------------------------------
	\| Phase space: 2 channels, 2 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Beam structure: circe1 => isr, none => none, isr
	\| Beam structure: 2 channels, 2 dimensions
	\| Applying user-defined cuts.
	\| Starting integration for process 'pythia6_3_p1'
	\| Integrate: iterations = 3:1000:"g", 3:1000
	\| Integrator: 2 chains, 2 channels, 4 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 1000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 1000 6.612E+02 2.37E+01 3.58 1.13 22.4
	2 1000 6.566E+02 1.27E+01 1.94 0.61 36.6
	3 1000 6.521E+02 1.09E+01 1.67 0.53 36.2
	\|-----------------------------------------------------------------------------\|
	3 3000 6.548E+02 7.81E+00 1.19 0.65 36.2 0.08 3
	\|-----------------------------------------------------------------------------\|
	4 1000 6.726E+02 1.02E+01 1.52 0.48 31.1
	5 1000 6.538E+02 1.15E+01 1.76 0.56 25.4
	6 1000 6.638E+02 1.10E+01 1.66 0.53 24.9
	\|-----------------------------------------------------------------------------\|
	6 3000 6.641E+02 6.28E+00 0.95 0.52 24.9 0.75 3
	\|=============================================================================\|
	n_events = 1
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?allow_shower = true
	?ps_fsr_active = true
	$shower_method = "PYTHIA6"
	$sample = "pythia6_3a"
	\| Starting simulation for process 'pythia6_3_p1'
	\| Simulate: using integration grids from file 'pythia6_3_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 1.5057E-03
	\| Events: writing to ASCII file 'pythia6_3a.debug'
	\| Events: writing to raw file 'pythia6_3a.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 12.50 %
	\| Events: closing ASCII file 'pythia6_3a.debug'
	\| Events: closing raw file 'pythia6_3a.evx'
	?hadronization_active = true
	$sample = "pythia6_3b"
	\| Starting simulation for process 'pythia6_3_p1'
	\| Simulate: using integration grids from file 'pythia6_3_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| Simulate: activating hadronization
	\| Hadronization: Using PYTHIA6 interface for hadronization and decays
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 1.5057E-03
	\| Events: writing to ASCII file 'pythia6_3b.debug'
	\| Events: writing to raw file 'pythia6_3b.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 50.00 %
	\| Events: closing ASCII file 'pythia6_3b.debug'
	\| Events: closing raw file 'pythia6_3b.evx'
	\| WHIZARD run finished.
	\|=============================================================================\|
	Partial contents of pythia6_3a.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.90020E+15
	Squared matrix el. (prc) = 2.90020E+15
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 2
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.497999E+02
	T = 1.000000000E+02
	Children: 3 4
	Particle 2 [b] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Children: 3 4
	Particle 3 [v] f(11)
	E = 2.476793E+02
	P = 0.000000E+00 0.000000E+00 2.474773E+02
	T = 1.000000000E+02
	Parents: 1 2
	Children: 5 7
	Particle 4 [v] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Parents: 1 2
	Children: 6 8
	Particle 5 [i] f(11)
	E = 1.817515E+02
	P = 0.000000E+00 0.000000E+00 1.814761E+02
	T = 1.000000000E+02
	Parents: 3
	Children: 9 10
	Particle 6 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Parents: 4
	Children: 9 10
	Particle 7 [x] f(22*)
	E = 6.600119E+01
	P = 0.000000E+00 0.000000E+00 6.600119E+01
	T = 0.000000000E+00
	Parents: 3
	Particle 8 [x] f(22*)
	E = 1.078487E-18
	P = 0.000000E+00 0.000000E+00 -1.078487E-18
	T = 0.000000000E+00
	Parents: 4
	Particle 9 [o] f(2)c(1 )
	E = 1.995369E+02
	P = -2.039220E+01 -1.860811E+02 6.908655E+01
	T = 0.000000000E+00
	Parents: 5 6
	Particle 10 [o] f(-2)c(-1 )
	E = 2.322146E+02
	P = 2.039220E+01 1.860811E+02 -1.374103E+02
	T = 0.000000000E+00
	Parents: 5 6
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 3
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 250.000 0.000 0.000 249.800 100.000
	2 [b] e+ 0 0 [none] 3-4 250.000 0.000 0.000 -249.800 100.000
	3 [r] e- 0 0 1-2 5,7 247.679 0.000 0.000 247.477 100.000
	4 [r] e+ 0 0 1-2 6,8 250.000 0.000 0.000 -249.800 100.000
	5 [i] e- 0 0 3 9-10 181.751 0.000 0.000 181.476 100.000
	6 [i] e+ 0 0 4 9-10 250.000 0.000 0.000 -249.800 100.000
	7 [x] A 0 0 3 [none] 66.001 0.000 0.000 66.001 0.000
	8 [x] A 0 0 4 [none] 0.000 0.000 0.000 -0.000 0.000
	9 [r] u 1 0 5-6 18-28 199.537 -20.392 -186.081 69.087 0.000
	10 [r] ubar 0 1 5-6 11-17 232.215 20.392 186.081 -137.410 0.000
	11 [o] ubar 0 500 10 [none] 17.843 0.835 15.020 -9.595 0.000
	12 [o] gl 500 501 10 [none] 6.033 -0.227 5.314 -2.848 0.000
	13 [o] gl 501 502 10 [none] 2.657 0.140 1.996 -1.748 0.000
	14 [o] gl 502 503 10 [none] 6.246 0.663 4.790 -3.953 0.000
	15 [o] gl 503 504 10 [none] 40.317 4.179 31.762 -24.479 0.000
	16 [o] gl 504 505 10 [none] 71.147 6.391 57.022 -42.066 0.000
	17 [o] gl 505 506 10 [none] 59.981 5.933 47.563 -36.058 0.000
	18 [o] gl 506 507 9 [none] 1.832 -1.515 -0.920 0.463 0.000
	19 [o] gl 507 508 9 [none] 0.982 -0.069 -0.980 -0.022 0.000
	20 [o] gl 508 509 9 [none] 2.047 -1.584 -0.573 -1.162 0.000
	21 [o] gl 509 510 9 [none] 9.757 -8.612 -1.045 -4.467 0.000
	22 [o] gl 510 511 9 [none] 31.752 -27.259 -1.888 -16.174 0.000
	23 [o] gl 511 512 9 [none] 1.144 -1.075 0.159 -0.360 0.000
	24 [o] gl 512 513 9 [none] 2.337 -1.921 -0.890 -0.990 0.000
	25 [o] gl 513 514 9 [none] 1.913 -1.459 -1.204 0.284 0.000
	26 [o] gl 514 515 9 [none] 8.200 2.070 -5.298 5.906 0.000
	27 [o] gl 515 516 9 [none] 84.278 13.921 -75.999 33.662 0.000
	28 [o] u 516 0 9 [none] 83.284 9.588 -74.829 35.285 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 431.751 0.000 0.000 -68.324
	Sum of beam remnant momenta: p(0:3) = 66.001 0.000 0.000 66.001
	Sum of outgoing momenta: p(0:3) = 431.751 0.000 0.000 -68.324
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 4.26311E+02
	n_in* => 2
	n_out* => 20
	n_tot* => 22
	$process_id* => "pythia6_3_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.90020E+15
	sqme_ref* => 2.90020E+15
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.4979992E+02\| 1.0000000E+02\| 1)
	2 prt(b:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.4979992E+02\| 1.0000000E+02\| 2)
	3 prt(i:11\|-1.8175146E+02; 0.0000000E+00, 0.0000000E+00,-1.8147615E+02\| 1.0000000E+02\| 3)
	4 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.4979992E+02\| 1.0000000E+02\| 4)
	5 prt(o:22\| 6.6001186E+01; 0.0000000E+00, 0.0000000E+00, 6.6001186E+01\| 0.0000000E+00\| 5)
	6 prt(o:22\| 0.0000000E+00; 0.0000000E+00, 0.0000000E+00, 0.0000000E+00\| 0.0000000E+00\| 6)
	7 prt(o:-2\| 1.7842986E+01; 8.3474008E-01, 1.5020147E+01,-9.5953388E+00\| 0.0000000E+00\| 7)
	8 prt(o:21\| 6.0328130E+00;-2.2713223E-01, 5.3135927E+00,-2.8476263E+00\| 0.0000000E+00\| 8)
	9 prt(o:21\| 2.6568014E+00; 1.3980505E-01, 1.9959941E+00,-1.7478718E+00\| 0.0000000E+00\| 9)
	10 prt(o:21\| 6.2463016E+00; 6.6337832E-01, 4.7903857E+00,-3.9532795E+00\| 0.0000000E+00\| 10)
	11 prt(o:21\| 4.0317049E+01; 4.1786752E+00, 3.1761580E+01,-2.4478668E+01\| 0.0000000E+00\| 11)
	12 prt(o:21\| 7.1147445E+01; 6.3911146E+00, 5.7022233E+01,-4.2066346E+01\| 0.0000000E+00\| 12)
	13 prt(o:21\| 5.9980521E+01; 5.9334024E+00, 4.7563120E+01,-3.6058387E+01\| 0.0000000E+00\| 13)
	14 prt(o:21\| 1.8318834E+00;-1.5147755E+00,-9.2039131E-01, 4.6274391E-01\| 0.0000000E+00\| 14)
	15 prt(o:21\| 9.8230697E-01;-6.9119092E-02,-9.7962112E-01,-2.2180735E-02\| 0.0000000E+00\| 15)
	16 prt(o:21\| 2.0466351E+00;-1.5841640E+00,-5.7292459E-01,-1.1622811E+00\| 0.0000000E+00\| 16)
	17 prt(o:21\| 9.7574846E+00;-8.6119316E+00,-1.0452071E+00,-4.4666187E+00\| 0.0000000E+00\| 17)
	18 prt(o:21\| 3.1752227E+01;-2.7258711E+01,-1.8878803E+00,-1.6174132E+01\| 0.0000000E+00\| 18)
	19 prt(o:21\| 1.1444326E+00;-1.0747120E+00, 1.5867029E-01,-3.5992183E-01\| 0.0000000E+00\| 19)
	20 prt(o:21\| 2.3372809E+00;-1.9209714E+00,-8.9001625E-01,-9.9026376E-01\| 0.0000000E+00\| 20)
	21 prt(o:21\| 1.9130859E+00;-1.4594352E+00,-1.2039139E+00, 2.8379220E-01\| 0.0000000E+00\| 21)
	22 prt(o:21\| 8.1998959E+00; 2.0703108E+00,-5.2979255E+00, 5.9062756E+00\| 0.0000000E+00\| 22)
	23 prt(o:21\| 8.4278039E+01; 1.3921476E+01,-7.5999107E+01, 3.3661790E+01\| 0.0000000E+00\| 23)
	24 prt(o:2\| 8.3284267E+01; 9.5880498E+00,-7.4828736E+01, 3.5284541E+01\| 0.0000000E+00\| 24)
	========================================================================
	Partial contents of pythia6_3b.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 1.51597E+33
	Squared matrix el. (prc) = 1.51597E+33
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 6
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.497999E+02
	T = 1.000000000E+02
	Children: 3 4
	Particle 2 [b] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Children: 3 4
	Particle 3 [v] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.497999E+02
	T = 1.000000000E+02
	Parents: 1 2
	Children: 5 7
	Particle 4 [v] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Parents: 1 2
	Children: 6 8
	Particle 5 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.497999E+02
	T = 1.000000000E+02
	Parents: 3
	Children: 9 10
	Particle 6 [i] f(-11)
	E = 2.448945E+02
	P = 0.000000E+00 0.000000E+00 -2.446903E+02
	T = 1.000000000E+02
	Parents: 4
	Children: 9 10
	Particle 7 [x] f(22*)
	E = 1.364034E-35
	P = 0.000000E+00 0.000000E+00 1.364034E-35
	T = 0.000000000E+00
	Parents: 3
	Particle 8 [x] f(22*)
	E = 5.109658E+00
	P = 0.000000E+00 0.000000E+00 -5.109658E+00
	T = 0.000000000E+00
	Parents: 4
	Particle 9 [o] f(2)c(1 )
	E = 2.482256E+02
	P = -2.281891E+02 5.891507E+01 7.794043E+01
	T = 0.000000000E+00
	Parents: 5 6
	Particle 10 [o] f(-2)c(-1 )
	E = 2.466689E+02
	P = 2.281891E+02 -5.891507E+01 -7.283078E+01
	T = 0.000000000E+00
	Parents: 5 6
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 7
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 250.000 0.000 0.000 249.800 100.000
	2 [b] e+ 0 0 [none] 3-4 250.000 0.000 0.000 -249.800 100.000
	3 [r] e- 0 0 1-2 5,7 250.000 0.000 0.000 249.800 100.000
	4 [r] e+ 0 0 1-2 6,8 250.000 0.000 0.000 -249.800 100.000
	5 [i] e- 0 0 3 9-10 250.000 0.000 0.000 249.800 100.000
	6 [i] e+ 0 0 4 9-10 244.895 0.000 0.000 -244.690 100.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 5.110 0.000 0.000 -5.110 0.000
	9 [r] u 1 0 5-6 18-24 248.226 -228.189 58.915 77.940 0.000
	10 [r] ubar 0 1 5-6 11-17,25-27 246.669 228.189 -58.915 -72.831 0.000
	11 [o] ubar 0 500 10 [none] 67.358 66.999 6.823 1.333 0.000
	12 [o] gl 500 501 10 [none] 11.047 10.915 1.575 -0.650 0.000
	13 [o] gl 501 502 10 [none] 11.146 11.016 1.691 -0.138 0.000
	14 [o] gl 502 503 10 [none] 21.965 21.568 3.720 -1.850 0.000
	15 [o] gl 503 504 10 [none] 12.944 11.841 2.560 -4.559 0.000
	16 [o] gl 504 505 10 [none] 3.236 2.996 -0.650 -1.036 0.000
	17 [o] d 505 0 10 [none] 115.190 79.737 -61.709 -55.701 0.109
	18 [o] u 506 0 9 [none] 103.404 -95.300 24.539 31.749 0.000
	19 [o] gl 507 506 9 [none] 91.903 -84.310 22.825 28.581 0.000
	20 [o] gl 508 507 9 [none] 25.417 -23.490 6.720 7.008 0.000
	21 [o] gl 509 508 9 [none] 5.099 -4.741 0.335 1.846 0.000
	22 [o] gl 510 509 9 [none] 3.435 -2.839 1.076 1.606 0.000
	23 [o] gl 511 510 9 [none] 6.122 -5.399 0.472 2.847 0.000
	24 [o] gl 512 511 9 [none] 0.284 -0.118 -0.149 0.211 0.000
	25 [o] gl 513 512 10 [none] 3.181 1.224 -2.448 -1.622 0.000
	26 [o] gl 514 513 10 [none] 5.206 4.057 -2.824 -1.633 0.000
	27 [o] dbar 0 514 10 [none] 7.959 5.843 -4.558 -2.883 0.109
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 494.895 0.000 0.000 5.110
	Sum of beam remnant momenta: p(0:3) = 5.110 0.000 0.000 -5.110
	Sum of outgoing momenta: p(0:3) = 494.895 0.000 0.000 5.110
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	========================================================================
	Event transform: hadronization
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 9
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 250.000 0.000 0.000 249.800 100.000
	2 [b] e+ 0 0 [none] 3-4 250.000 0.000 0.000 -249.800 100.000
	3 [r] e- 0 0 1-2 5,7 250.000 0.000 0.000 249.800 100.000
	4 [r] e+ 0 0 1-2 6,8 250.000 0.000 0.000 -249.800 100.000
	5 [i] e- 0 0 3 9-10 250.000 0.000 0.000 249.800 100.000
	6 [i] e+ 0 0 4 9-10 244.895 0.000 0.000 -244.690 100.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 5.110 0.000 0.000 -5.110 0.000
	9 [r] u 1 0 5-6 18-24 248.226 -228.189 58.915 77.940 0.000
	10 [r] ubar 0 1 5-6 11-17,25-27 246.669 228.189 -58.915 -72.831 0.000
	11 [r] ubar 0 500 10 28 67.358 66.999 6.823 1.333 0.000
	12 [r] gl 500 501 10 28 11.047 10.915 1.575 -0.650 0.000
	13 [r] gl 501 502 10 28 11.146 11.016 1.691 -0.138 0.000
	14 [r] gl 502 503 10 28 21.965 21.568 3.720 -1.850 0.000
	15 [r] gl 503 504 10 28 12.944 11.841 2.560 -4.559 0.000
	16 [r] gl 504 505 10 28 3.236 2.996 -0.650 -1.036 0.000
	17 [r] d 505 0 10 28 115.190 79.737 -61.709 -55.701 0.109
	18 [r] u 506 0 9 43 103.404 -95.300 24.539 31.749 0.000
	19 [r] gl 507 506 9 43 91.903 -84.310 22.825 28.581 0.000
	20 [r] gl 508 507 9 43 25.417 -23.490 6.720 7.008 0.000
	21 [r] gl 509 508 9 43 5.099 -4.741 0.335 1.846 0.000
	22 [r] gl 510 509 9 43 3.435 -2.839 1.076 1.606 0.000
	23 [r] gl 511 510 9 43 6.122 -5.399 0.472 2.847 0.000
	24 [r] gl 512 511 9 43 0.284 -0.118 -0.149 0.211 0.000
	25 [r] gl 513 512 10 43 3.181 1.224 -2.448 -1.622 0.000
	26 [r] gl 514 513 10 43 5.206 4.057 -2.824 -1.633 0.000
	27 [r] dbar 0 514 10 43 7.959 5.843 -4.558 -2.883 0.109
	28 [r] hr3 0 0 11-17 29-42 242.886 205.072 -45.988 -62.602 10905.245
	29 [r] eta 0 0 28 61-62 46.262 46.023 4.644 0.464 0.300
	30 [r] rhom 0 0 28 63-64 21.991 21.862 2.220 0.467 0.503
	31 [o] pip 0 0 28 [none] 12.532 12.297 2.130 -1.132 0.019
	32 [o] pim 0 0 28 [none] 7.483 7.385 1.188 0.176 0.019
	33 [r] Deltaba 0 0 28 65-66 13.176 12.996 1.548 -0.954 1.394
	34 [r] rhom 0 0 28 67-68 5.729 5.434 1.396 -0.884 0.559
	35 [r] Delta0 0 0 28 69-70 12.026 11.481 2.262 -2.494 1.474
	36 [r] etaprim 0 0 28 71-73 5.770 5.402 0.821 -1.585 0.917
	37 [o] nbar 0 0 28 [none] 4.121 2.740 -2.146 -1.998 0.883
	38 [r] lambda 0 0 28 74-75 11.162 8.411 -5.246 -5.008 1.245
	39 [o] kp 0 0 28 [none] 2.239 1.529 -1.059 -1.145 0.244
	40 [r] rhom 0 0 28 76-77 29.729 20.576 -16.048 -14.233 0.285
	41 [r] etaprim 0 0 28 78-79 31.117 21.617 -16.528 -15.063 0.917
	42 [r] omega 0 0 28 80-82 39.550 27.319 -21.169 -19.213 0.590
	43 [r] hr3 0 0 18-27 44-60 252.008 -205.072 45.988 67.712 14753.671
	44 [r] kstarp 0 0 43 83-84 91.144 -83.759 22.325 28.151 0.846
	45 [r] k0 0 0 43 85 58.028 -53.700 13.747 17.156 0.248
	46 [r] rho0 0 0 43 86-87 20.299 -18.491 5.060 6.610 0.852
	47 [r] k0 0 0 43 88 21.384 -19.668 4.678 6.950 0.248
	48 [o] km 0 0 43 [none] 16.013 -14.682 4.375 4.635 0.244
	49 [r] rhop 0 0 43 89-90 14.433 -13.298 3.323 4.490 0.281
	50 [o] pim 0 0 43 [none] 2.473 -2.072 0.941 0.958 0.019
	51 [r] rho0 0 0 43 91-92 6.532 -5.860 0.784 2.603 0.928
	52 [r] pi0 0 0 43 93-94 1.708 -1.657 0.307 0.240 0.018
	53 [r] omega 0 0 43 95-97 1.815 -1.187 0.286 1.092 0.611
	54 [r] rho0 0 0 43 98-99 1.669 -1.426 -0.231 0.021 0.700
	55 [o] pip 0 0 43 [none] 0.718 -0.237 -0.652 0.119 0.019
	56 [r] rhom 0 0 43 100-101 1.673 1.124 -1.001 -0.339 0.416
	57 [r] kstarp 0 0 43 102-103 3.822 3.212 -1.671 -0.818 0.829
	58 [r] k0 0 0 43 104 3.760 1.740 -2.527 -2.115 0.248
	59 [o] pim 0 0 43 [none] 2.447 1.809 -1.575 -0.463 0.019
	60 [o] pip 0 0 43 [none] 4.091 3.080 -2.180 -1.575 0.019
	61 [o] A 0 0 29 [none] 20.026 19.905 2.148 0.434 0.000
	62 [o] A 0 0 29 [none] 26.237 26.118 2.496 0.030 0.000
	63 [o] pim 0 0 30 [none] 5.683 5.631 0.750 -0.093 0.019
	64 [r] pi0 0 0 30 105-106 16.307 16.231 1.470 0.560 0.018
	65 [o] nbar 0 0 33 [none] 8.951 8.821 1.047 -0.563 0.883
	66 [o] pip 0 0 33 [none] 4.225 4.175 0.500 -0.391 0.019
	67 [o] pim 0 0 34 [none] 2.319 2.117 0.642 -0.679 0.019
	68 [r] pi0 0 0 34 107-108 3.410 3.317 0.754 -0.205 0.018
	69 [o] p 0 0 35 [none] 8.602 8.248 1.589 -1.601 0.880
	70 [o] pim 0 0 35 [none] 3.424 3.233 0.673 -0.893 0.019
	71 [o] pim 0 0 36 [none] 1.553 1.504 0.123 -0.338 0.019
	72 [o] pip 0 0 36 [none] 1.520 1.430 0.294 -0.401 0.019
	73 [r] eta 0 0 36 109-111 2.697 2.469 0.405 -0.846 0.300
	74 [o] p 0 0 38 [none] 10.131 7.615 -4.829 -4.522 0.880
	75 [o] pim 0 0 38 [none] 1.032 0.796 -0.418 -0.486 0.019
	76 [o] pim 0 0 40 [none] 2.712 1.835 -1.467 -1.348 0.019
	77 [r] pi0 0 0 40 112-113 27.016 18.741 -14.580 -12.885 0.018
	78 [o] A 0 0 41 [none] 3.573 2.496 -1.969 -1.630 0.000
	79 [r] rho0 0 0 41 114-115 27.544 19.121 -14.559 -13.433 0.680
	80 [o] pim 0 0 42 [none] 14.295 9.989 -7.402 -7.053 0.019
	81 [o] pip 0 0 42 [none] 16.070 11.021 -8.718 -7.794 0.019
	82 [r] pi0 0 0 42 116-117 9.185 6.308 -5.048 -4.367 0.018
	83 [r] k0 0 0 44 118 28.784 -26.473 7.060 8.809 0.248
	84 [o] pip 0 0 44 [none] 62.360 -57.285 15.265 19.341 0.019
	85 [o] kL0 0 0 45 [none] 58.028 -53.700 13.747 17.156 0.248
	86 [o] pim 0 0 46 [none] 13.730 -12.649 3.050 4.380 0.019
	87 [o] pip 0 0 46 [none] 6.570 -5.842 2.010 2.229 0.019
	88 [r] kS0 0 0 47 119-120 21.384 -19.668 4.678 6.950 0.248
	89 [o] pip 0 0 49 [none] 3.943 -3.670 0.721 1.240 0.019
	90 [r] pi0 0 0 49 121-122 10.490 -9.628 2.603 3.250 0.018
	91 [o] pim 0 0 51 [none] 5.906 -5.432 0.527 2.253 0.019
	92 [o] pip 0 0 51 [none] 0.626 -0.429 0.257 0.350 0.019
	93 [o] A 0 0 52 [none] 0.348 -0.326 0.062 0.102 0.000
	94 [o] A 0 0 52 [none] 1.360 -1.331 0.245 0.138 0.000
	95 [o] pip 0 0 53 [none] 0.528 -0.291 0.231 0.349 0.019
	96 [o] pim 0 0 53 [none] 0.159 -0.021 0.059 0.045 0.019
	97 [r] pi0 0 0 53 123-124 1.127 -0.874 -0.004 0.698 0.018
	98 [o] pip 0 0 54 [none] 1.127 -1.083 0.081 0.266 0.019
	99 [o] pim 0 0 54 [none] 0.542 -0.342 -0.312 -0.245 0.019
	100 [o] pim 0 0 56 [none] 0.321 0.026 -0.250 -0.142 0.019
	101 [r] pi0 0 0 56 125-126 1.352 1.098 -0.750 -0.198 0.018
	102 [r] k0 0 0 57 127 2.210 1.727 -1.221 -0.406 0.248
	103 [o] pip 0 0 57 [none] 1.612 1.485 -0.450 -0.412 0.019
	104 [r] kS0 0 0 58 128-129 3.760 1.740 -2.527 -2.115 0.248
	105 [o] A 0 0 64 [none] 15.071 14.997 1.380 0.547 0.000
	106 [o] A 0 0 64 [none] 1.237 1.234 0.091 0.014 0.000
	107 [o] A 0 0 68 [none] 1.147 1.101 0.304 -0.106 0.000
	108 [o] A 0 0 68 [none] 2.263 2.215 0.450 -0.100 0.000
	109 [r] pi0 0 0 73 130-131 0.659 0.614 0.164 -0.113 0.018
	110 [r] pi0 0 0 73 132-133 0.593 0.545 0.116 -0.153 0.018
	111 [r] pi0 0 0 73 134-135 1.445 1.310 0.125 -0.580 0.018
	112 [o] A 0 0 77 [none] 25.724 17.861 -13.859 -12.273 0.000
	113 [o] A 0 0 77 [none] 1.292 0.881 -0.721 -0.612 0.000
	114 [o] pim 0 0 79 [none] 26.658 18.540 -14.088 -12.977 0.019
	115 [o] pip 0 0 79 [none] 0.887 0.581 -0.471 -0.455 0.019
	116 [o] A 0 0 82 [none] 7.813 5.360 -4.330 -3.683 0.000
	117 [o] A 0 0 82 [none] 1.372 0.948 -0.718 -0.684 0.000
	118 [o] kL0 0 0 83 [none] 28.784 -26.473 7.060 8.809 0.248
	119 [o] pip 0 0 88 [none] 4.788 -4.345 1.169 1.629 0.019
	120 [o] pim 0 0 88 [none] 16.596 -15.323 3.509 5.321 0.019
	121 [o] A 0 0 90 [none] 7.131 -6.520 1.805 2.255 0.000
	122 [o] A 0 0 90 [none] 3.359 -3.108 0.798 0.995 0.000
	123 [o] A 0 0 97 [none] 0.132 -0.081 0.034 0.099 0.000
	124 [o] A 0 0 97 [none] 0.995 -0.793 -0.037 0.600 0.000
	125 [o] A 0 0 101 [none] 0.486 0.370 -0.288 -0.128 0.000
	126 [o] A 0 0 101 [none] 0.865 0.728 -0.462 -0.070 0.000
	127 [o] kL0 0 0 102 [none] 2.210 1.727 -1.221 -0.406 0.248
	128 [r] pi0 0 0 104 136-137 1.531 0.572 -0.991 -1.008 0.018
	129 [r] pi0 0 0 104 138-139 2.229 1.168 -1.536 -1.107 0.018
	130 [o] A 0 0 109 [none] 0.210 0.206 -0.010 -0.037 0.000
	131 [o] A 0 0 109 [none] 0.450 0.407 0.174 -0.077 0.000
	132 [o] A 0 0 110 [none] 0.538 0.516 0.072 -0.135 0.000
	133 [o] A 0 0 110 [none] 0.055 0.029 0.043 -0.018 0.000
	134 [o] A 0 0 111 [none] 0.766 0.722 0.070 -0.246 0.000
	135 [o] A 0 0 111 [none] 0.679 0.588 0.055 -0.334 0.000
	136 [o] A 0 0 128 [none] 1.499 0.561 -0.962 -1.004 0.000
	137 [o] A 0 0 128 [none] 0.032 0.011 -0.030 -0.004 0.000
	138 [o] A 0 0 129 [none] 0.802 0.470 -0.511 -0.402 0.000
	139 [o] A 0 0 129 [none] 1.426 0.698 -1.024 -0.706 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 494.895 0.000 0.000 5.110
	Sum of beam remnant momenta: p(0:3) = 5.110 0.000 0.000 -5.110
	Sum of outgoing momenta: p(0:3) = 494.895 0.000 0.000 5.110
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	------------------------------------------------------------------------
	Hadronization settings:
	------------------------------------------------------------------------
	Master switches:
	active = T
	General settings:
	hadron_method = PYTHIA6
	pT generation parameters
	enhanced_fraction = 1.000000000000E-02
	enhanced_width = 2.000000000000E+00
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 4.94868E+02
	n_in* => 2
	n_out* => 72
	n_tot* => 74
	$process_id* => "pythia6_3_p1"
	process_num_id* => [unknown integer]
	sqme* => 1.51597E+33
	sqme_ref* => 1.51597E+33
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.4979992E+02\| 1.0000000E+02\| 1)
	2 prt(b:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.4979992E+02\| 1.0000000E+02\| 2)
	3 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.4979992E+02\| 1.0000000E+02\| 3)
	4 prt(i:-11\|-2.4489452E+02; 0.0000000E+00, 0.0000000E+00, 2.4469026E+02\| 1.0000000E+02\| 4)
	5 prt(o:22\| 0.0000000E+00; 0.0000000E+00, 0.0000000E+00, 0.0000000E+00\| 0.0000000E+00\| 5)
	6 prt(o:22\| 5.1096577E+00; 0.0000000E+00, 0.0000000E+00,-5.1096577E+00\| 0.0000000E+00\| 6)
	7 prt(o:211\| 1.2531621E+01; 1.2296529E+01, 2.1295434E+00,-1.1324585E+00\| 1.9479785E-02\| 7)
	8 prt(o:-211\| 7.4828738E+00; 7.3845580E+00, 1.1879928E+00, 1.7577434E-01\| 1.9479785E-02\| 8)
	9 prt(o:-2112\| 4.1214294E+00; 2.7397986E+00,-2.1459327E+00,-1.9979652E+00\| 8.8279178E-01\| 9)
	10 prt(o:321\| 2.2393388E+00; 1.5293203E+00,-1.0592454E+00,-1.1446291E+00\| 2.4364096E-01\| 10)
	11 prt(o:-321\| 1.6013205E+01;-1.4682044E+01, 4.3746594E+00, 4.6345477E+00\| 2.4364096E-01\| 11)
	12 prt(o:-211\| 2.4731054E+00;-2.0718452E+00, 9.4143131E-01, 9.5808932E-01\| 1.9479785E-02\| 12)
	13 prt(o:211\| 7.1779684E-01;-2.3694793E-01,-6.5227059E-01, 1.1895910E-01\| 1.9479785E-02\| 13)
	14 prt(o:-211\| 2.4467917E+00; 1.8086867E+00,-1.5751709E+00,-4.6346396E-01\| 1.9479785E-02\| 14)
	15 prt(o:211\| 4.0911000E+00; 3.0796012E+00,-2.1802730E+00,-1.5748288E+00\| 1.9479785E-02\| 15)
	16 prt(o:22\| 2.0025542E+01; 1.9905284E+01, 2.1479626E+00, 4.3385614E-01\| 0.0000000E+00\| 16)
	17 prt(o:22\| 2.6236705E+01; 2.6117734E+01, 2.4955421E+00, 3.0240572E-02\| 0.0000000E+00\| 17)
	18 prt(o:-211\| 5.6834543E+00; 5.6312307E+00, 7.5016342E-01,-9.3109486E-02\| 1.9479785E-02\| 18)
	19 prt(o:-2112\| 8.9505589E+00; 8.8213168E+00, 1.0474988E+00,-5.6287654E-01\| 8.8279178E-01\| 19)
	20 prt(o:211\| 4.2249731E+00; 4.1746239E+00, 5.0039260E-01,-3.9120385E-01\| 1.9479785E-02\| 20)
	21 prt(o:-211\| 2.3185940E+00; 2.1174203E+00, 6.4211831E-01,-6.7868536E-01\| 1.9479785E-02\| 21)
	22 prt(o:2212\| 8.6022166E+00; 8.2479958E+00, 1.5892045E+00,-1.6008664E+00\| 8.8035059E-01\| 22)
	23 prt(o:-211\| 3.4239241E+00; 3.2331036E+00, 6.7270094E-01,-8.9347128E-01\| 1.9479785E-02\| 23)
	24 prt(o:-211\| 1.5527422E+00; 1.5040629E+00, 1.2253780E-01,-3.3809432E-01\| 1.9479785E-02\| 24)
	25 prt(o:211\| 1.5198640E+00; 1.4296104E+00, 2.9352092E-01,-4.0070736E-01\| 1.9479785E-02\| 25)
	26 prt(o:2212\| 1.0130568E+01; 7.6146515E+00,-4.8285146E+00,-4.5222332E+00\| 8.8035059E-01\| 26)
	27 prt(o:-211\| 1.0316440E+00; 7.9643641E-01,-4.1793115E-01,-4.8562549E-01\| 1.9479785E-02\| 27)
	28 prt(o:-211\| 2.7124880E+00; 1.8349027E+00,-1.4673701E+00,-1.3483577E+00\| 1.9479785E-02\| 28)
	29 prt(o:22\| 3.5728988E+00; 2.4960280E+00,-1.9692619E+00,-1.6301711E+00\| 0.0000000E+00\| 29)
	30 prt(o:-211\| 1.4294721E+01; 9.9894694E+00,-7.4021115E+00,-7.0525747E+00\| 1.9479785E-02\| 30)
	31 prt(o:211\| 1.6069930E+01; 1.1021458E+01,-8.7183619E+00,-7.7936378E+00\| 1.9479785E-02\| 31)
	32 prt(o:211\| 6.2359783E+01;-5.7285333E+01, 1.5265055E+01, 1.9341454E+01\| 1.9479785E-02\| 32)
	33 prt(o:130\| 5.8027972E+01;-5.3700157E+01, 1.3746985E+01, 1.7155508E+01\| 2.4767543E-01\| 33)
	34 prt(o:-211\| 1.3729692E+01;-1.2648951E+01, 3.0502550E+00, 4.3800620E+00\| 1.9479785E-02\| 34)
	35 prt(o:211\| 6.5695690E+00;-5.8420456E+00, 2.0099382E+00, 2.2294414E+00\| 1.9479785E-02\| 35)
	36 prt(o:211\| 3.9427828E+00;-3.6700220E+00, 7.2056016E-01, 1.2400757E+00\| 1.9479785E-02\| 36)
	37 prt(o:-211\| 5.9058750E+00;-5.4319775E+00, 5.2665437E-01, 2.2530282E+00\| 1.9479785E-02\| 37)
	38 prt(o:211\| 6.2573527E-01;-4.2851458E-01, 2.5732792E-01, 3.4960326E-01\| 1.9479785E-02\| 38)
	39 prt(o:22\| 3.4756378E-01;-3.2637635E-01, 6.2203487E-02, 1.0202836E-01\| 0.0000000E+00\| 39)
	40 prt(o:22\| 1.3604009E+00;-1.3310353E+00, 2.4508010E-01, 1.3773600E-01\| 0.0000000E+00\| 40)
	41 prt(o:211\| 5.2828019E-01;-2.9070562E-01, 2.3085640E-01, 3.4899247E-01\| 1.9479785E-02\| 41)
	42 prt(o:-211\| 1.5937692E-01;-2.1487724E-02, 5.8814503E-02, 4.4725274E-02\| 1.9479785E-02\| 42)
	43 prt(o:211\| 1.1271085E+00;-1.0833413E+00, 8.0855340E-02, 2.6594687E-01\| 1.9479785E-02\| 43)
	44 prt(o:-211\| 5.4210710E-01;-3.4242796E-01,-3.1177879E-01,-2.4482116E-01\| 1.9479785E-02\| 44)
	45 prt(o:-211\| 3.2094736E-01; 2.5893228E-02,-2.5044626E-01,-1.4189304E-01\| 1.9479785E-02\| 45)
	46 prt(o:211\| 1.6119600E+00; 1.4853242E+00,-4.5019223E-01,-4.1240046E-01\| 1.9479785E-02\| 46)
	47 prt(o:22\| 1.5070544E+01; 1.4997301E+01, 1.3795534E+00, 5.4688063E-01\| 0.0000000E+00\| 47)
	48 prt(o:22\| 1.2369045E+00; 1.2335014E+00, 9.0678969E-02, 1.3576795E-02\| 0.0000000E+00\| 48)
	49 prt(o:22\| 1.1474722E+00; 1.1014608E+00, 3.0377416E-01,-1.0581930E-01\| 0.0000000E+00\| 49)
	50 prt(o:22\| 2.2629432E+00; 2.2154583E+00, 4.5028338E-01,-9.9505431E-02\| 0.0000000E+00\| 50)
	51 prt(o:22\| 2.5723788E+01; 1.7860560E+01,-1.3859260E+01,-1.2273329E+01\| 0.0000000E+00\| 51)
	52 prt(o:22\| 1.2922375E+00; 8.8080071E-01,-7.2113573E-01,-6.1158078E-01\| 0.0000000E+00\| 52)
	53 prt(o:-211\| 2.6657779E+01; 1.8539776E+01,-1.4088362E+01,-1.2977383E+01\| 1.9479785E-02\| 53)
	54 prt(o:211\| 8.8661219E-01; 5.8114314E-01,-4.7086070E-01,-4.5515299E-01\| 1.9479785E-02\| 54)
	55 prt(o:22\| 7.8133118E+00; 5.3599097E+00,-4.3303383E+00,-3.6833924E+00\| 0.0000000E+00\| 55)
	56 prt(o:22\| 1.3717818E+00; 9.4812962E-01,-7.1800675E-01,-6.8359478E-01\| 0.0000000E+00\| 56)
	57 prt(o:130\| 2.8784223E+01;-2.6473359E+01, 7.0597236E+00, 8.8093925E+00\| 2.4767543E-01\| 57)
	58 prt(o:211\| 4.7878817E+00;-4.3454611E+00, 1.1690257E+00, 1.6293182E+00\| 1.9479785E-02\| 58)
	59 prt(o:-211\| 1.6595994E+01;-1.5322752E+01, 3.5087356E+00, 5.3206745E+00\| 1.9479785E-02\| 59)
	60 prt(o:22\| 7.1313202E+00;-6.5202231E+00, 1.8051243E+00, 2.2547604E+00\| 0.0000000E+00\| 60)
	61 prt(o:22\| 3.3590440E+00;-3.1075479E+00, 7.9771501E-01, 9.9497384E-01\| 0.0000000E+00\| 61)
	62 prt(o:22\| 1.3198987E-01;-8.1179741E-02, 3.3520700E-02, 9.8526843E-02\| 0.0000000E+00\| 62)
	63 prt(o:22\| 9.9495898E-01;-7.9316636E-01,-3.7149942E-02, 5.9954180E-01\| 0.0000000E+00\| 63)
	64 prt(o:22\| 4.8634108E-01; 3.7010472E-01,-2.8842775E-01,-1.2790455E-01\| 0.0000000E+00\| 64)
	65 prt(o:22\| 8.6526795E-01; 7.2825024E-01,-4.6204799E-01,-6.9655326E-02\| 0.0000000E+00\| 65)
	66 prt(o:130\| 2.2102768E+00; 1.7268158E+00,-1.2211702E+00,-4.0558440E-01\| 2.4767543E-01\| 66)
	67 prt(o:22\| 2.0971303E-01; 2.0627492E-01,-9.6013933E-03,-3.6579082E-02\| 0.0000000E+00\| 67)
	68 prt(o:22\| 4.4961915E-01; 4.0743670E-01, 1.7395976E-01,-7.6751000E-02\| 0.0000000E+00\| 68)
	69 prt(o:22\| 5.3778911E-01; 5.1555420E-01, 7.2492394E-02,-1.3478073E-01\| 0.0000000E+00\| 69)
	70 prt(o:22\| 5.5306076E-02; 2.9231810E-02, 4.3389074E-02,-1.7934648E-02\| 0.0000000E+00\| 70)
	71 prt(o:22\| 7.6595917E-01; 7.2197550E-01, 6.9608057E-02,-2.4616975E-01\| 0.0000000E+00\| 71)
	72 prt(o:22\| 6.7855289E-01; 5.8807813E-01, 5.5018935E-02,-3.3402253E-01\| 0.0000000E+00\| 72)
	73 prt(o:22\| 1.4987519E+00; 5.6069178E-01,-9.6163249E-01,-1.0035661E+00\| 0.0000000E+00\| 73)
	74 prt(o:22\| 3.2109828E-02; 1.1127925E-02,-2.9844876E-02,-4.0612440E-03\| 0.0000000E+00\| 74)
	75 prt(o:22\| 8.0240843E-01; 4.7024957E-01,-5.1137406E-01,-4.0152360E-01\| 0.0000000E+00\| 75)
	76 prt(o:22\| 1.4263967E+00; 6.9802824E-01,-1.0243845E+00,-7.0569151E-01\| 0.0000000E+00\| 76)
	========================================================================
	Index: trunk/share/tests/functional_tests/ref-output-quad/pythia6_4.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-quad/pythia6_4.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output-quad/pythia6_4.ref (revision 8190)
	@@ -1,699 +1,708 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	?pacify = true
	$method = "omega"
	\| Process library 'pythia6_4_lib': recorded process 'pythia6_4_p1'
	\| Process library 'pythia6_4_lib': recorded process 'pythia6_4_p2'
	\| Process library 'pythia6_4_lib': recorded process 'pythia6_4_p3'
	SM.me => 1.00000E+00
	isr_mass = 1.00000E+00
	\| Process library 'pythia6_4_lib': compiling ...
	\| Process library 'pythia6_4_lib': writing makefile
	\| Process library 'pythia6_4_lib': removing old files
	\| Process library 'pythia6_4_lib': writing driver
	\| Process library 'pythia6_4_lib': creating source code
	\| Process library 'pythia6_4_lib': compiling sources
	\| Process library 'pythia6_4_lib': linking
	\| Process library 'pythia6_4_lib': loading
	\| Process library 'pythia6_4_lib': ... success.
	seed = 0
	$phs_method = "wood"
	$integration_method = "vamp"
	sqrts = 1.00000E+03
	openmp_num_threads = 1
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process pythia6_4_p1:
	\| Beam structure: e-, e+ => circe1 => isr
	\| Beam data (collision):
	\| e- (mass = 1.0000000E+00 GeV)
	\| e+ (mass = 1.0000000E+00 GeV)
	\| sqrts = 1.000000000000E+03 GeV
	\| CIRCE1: activating generator mode
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'pythia6_4_p1.i1.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'pythia6_4_p1'
	\| Library name = 'pythia6_4_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'pythia6_4_p1_i1': e-, e+ => Z, H [omega]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 2 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: Using 1 equivalence between channels.
	\| Phase space: wood
	\| Beam structure: circe1 => isr, none => none, isr
	\| Beam structure: 1 channels, 2 dimensions
	Warning: No cuts have been defined.
	\| Starting integration for process 'pythia6_4_p1'
	\| Integrate: iterations = 3:1000:"g", 3:1000
	\| Integrator: 1 chains, 1 channels, 4 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 1000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 1000 1.729E+01 3.15E-01 1.82 0.58 13.5
	2 1000 1.683E+01 1.92E-01 1.14 0.36 24.5
	3 1000 1.722E+01 1.96E-01 1.14 0.36 20.9
	\|-----------------------------------------------------------------------------\|
	3 3000 1.706E+01 1.26E-01 0.74 0.40 20.9 1.28 3
	\|-----------------------------------------------------------------------------\|
	4 1000 1.704E+01 1.77E-01 1.04 0.33 20.7
	5 1000 1.691E+01 1.68E-01 0.99 0.31 20.5
	6 1000 1.719E+01 2.18E-01 1.27 0.40 18.0
	\|-----------------------------------------------------------------------------\|
	6 3000 1.702E+01 1.06E-01 0.62 0.34 18.0 0.53 3
	\|=============================================================================\|
	error_threshold = 1.00000E-08
	n_events = 1
	?rebuild_events = true
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?allow_shower = true
	?ps_fsr_active = true
	$shower_method = "PYTHIA6"
	$sample = "pythia6_4a"
	\| Starting simulation for process 'pythia6_4_p1'
	\| Simulate: using integration grids from file 'pythia6_4_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 5.8738E-02
	\| Events: writing to ASCII file 'pythia6_4a.debug'
	\| Events: writing to raw file 'pythia6_4a.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 16.67 %
	\| Events: closing ASCII file 'pythia6_4a.debug'
	\| Events: closing raw file 'pythia6_4a.evx'
	$sample = "pythia6_4b"
	?hadronization_active = true
	\| Starting simulation for process 'pythia6_4_p1'
	\| Simulate: using integration grids from file 'pythia6_4_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| Simulate: activating hadronization
	\| Hadronization: Using PYTHIA6 interface for hadronization and decays
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 5.8738E-02
	\| Events: writing to ASCII file 'pythia6_4b.debug'
	\| Events: writing to raw file 'pythia6_4b.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 11.11 %
	\| Events: closing ASCII file 'pythia6_4b.debug'
	\| Events: closing raw file 'pythia6_4b.evx'
	\| There were no errors and 1 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Partial contents of pythia6_4a.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 1.26826E+29
	Squared matrix el. (prc) = 1.26826E+29
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 2
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 4.999990E+02
	T = 1.000000000E+00
	Children: 3 4
	Particle 2 [b] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -4.999990E+02
	T = 1.000000000E+00
	Children: 3 4
	Particle 3 [v] f(11)
	E = 4.889225E+02
	P = 0.000000E+00 0.000000E+00 4.889215E+02
	T = 1.000000000E+00
	Parents: 1 2
	Children: 5 7
	Particle 4 [v] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -4.999990E+02
	T = 1.000000000E+00
	Parents: 1 2
	Children: 6 8
	Particle 5 [i] f(11)
	E = 4.889225E+02
	P = 0.000000E+00 0.000000E+00 4.889215E+02
	T = 1.000000000E+00
	Parents: 3
	Children: 9 10
	Particle 6 [i] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -4.999990E+02
	T = 1.000000000E+00
	Parents: 4
	Children: 9 10
	Particle 7 [x] f(22*)
	E = 9.238685E-26
	P = 0.000000E+00 0.000000E+00 9.238685E-26
	T = 0.000000000E+00
	Parents: 3
	Particle 8 [x] f(22*)
	E = 3.002344E-06
	P = 0.000000E+00 0.000000E+00 -3.002344E-06
	T = 0.000000000E+00
	Parents: 4
	Particle 9 [o] f(23)
	E = 4.877065E+02
	P = 2.139324E+02 3.349530E+02 2.675477E+02
	T = 8.315287819E+03
	Parents: 5 6
	Particle 10 [o] f(25)
	E = 5.012161E+02
	P = -2.139324E+02 -3.349530E+02 -2.786252E+02
	T = 1.562500000E+04
	Parents: 5 6
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 3
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 500.000 0.000 0.000 499.999 1.000
	2 [b] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -499.999 1.000
	3 [r] e- 0 0 1-2 5,7 488.923 0.000 0.000 488.922 1.000
	4 [r] e+ 0 0 1-2 6,8 500.000 0.000 0.000 -499.999 1.000
	5 [i] e- 0 0 3 9-10 488.923 0.000 0.000 488.922 1.000
	6 [i] e+ 0 0 4 9-10 500.000 0.000 0.000 -499.999 1.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 0.000 0.000 0.000 -0.000 0.000
	9 [r] Z 0 0 5-6 11-12 487.706 213.932 334.953 267.548 8315.288
	10 [r] H 0 0 5-6 13-14 501.216 -213.932 -334.953 -278.625 15625.000
	11 [r] nue 0 0 9 15 208.603 57.610 171.250 104.259 0.000
	12 [r] nuebar 0 0 9 16 279.103 156.322 163.703 163.289 0.000
	13 [r] tau- 0 0 10 17 321.895 -111.680 -261.425 -150.989 3.158
	14 [r] tau+ 0 0 10 18-19 179.321 -102.252 -73.528 -127.636 3.158
	15 [o] nue 0 0 11 [none] 208.603 57.610 171.250 104.259 0.000
	16 [o] nuebar 0 0 12 [none] 279.103 156.322 163.703 163.289 0.000
	17 [r] tau- 0 0 13 20-22 321.889 -111.678 -261.420 -150.986 3.158
	18 [r] tau+ 0 0 14 23-24 179.284 -102.225 -73.513 -127.615 3.158
	19 [o] A 0 0 14 [none] 0.043 -0.030 -0.019 -0.024 0.000
	20 [o] numubar 0 0 17 [none] 14.551 -5.197 -11.825 -6.700 0.000
	21 [o] mu- 0 0 17 [none] 174.208 -59.700 -141.787 -81.735 0.011
	22 [o] nutau 0 0 17 [none] 133.131 -46.781 -107.809 -62.551 0.000
	23 [o] nutauba 0 0 18 [none] 3.537 -1.902 -1.305 -2.681 0.000
	24 [o] pip 0 0 18 [none] 175.747 -100.322 -72.208 -124.934 0.019
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 988.923 0.000 0.000 -11.077
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 988.923 0.000 0.000 -11.077
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.00000E+03
	sqrts_hat* => 9.88860E+02
	n_in* => 2
	n_out* => 10
	n_tot* => 12
	$process_id* => "pythia6_4_p1"
	process_num_id* => [unknown integer]
	sqme* => 1.26826E+29
	sqme_ref* => 1.26826E+29
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-4.9999900E+02\| 1.0000000E+00\| 1)
	2 prt(b:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 4.9999900E+02\| 1.0000000E+00\| 2)
	3 prt(i:11\|-4.8892252E+02; 0.0000000E+00, 0.0000000E+00,-4.8892150E+02\| 1.0000000E+00\| 3)
	4 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 4.9999900E+02\| 1.0000000E+00\| 4)
	5 prt(o:22\| 0.0000000E+00; 0.0000000E+00, 0.0000000E+00, 0.0000000E+00\| 0.0000000E+00\| 5)
	6 prt(o:22\| 3.0023441E-06; 0.0000000E+00, 0.0000000E+00,-3.0023441E-06\| 0.0000000E+00\| 6)
	7 prt(o:12\| 2.0860337E+02; 5.7610220E+01, 1.7124978E+02, 1.0425901E+02\| 0.0000000E+00\| 7)
	8 prt(o:-12\| 2.7910310E+02; 1.5632217E+02, 1.6370318E+02, 1.6328866E+02\| 0.0000000E+00\| 8)
	9 prt(o:22\| 4.3097371E-02;-2.9784316E-02,-1.9454623E-02,-2.4326848E-02\| 0.0000000E+00\| 9)
	10 prt(o:-14\| 1.4550881E+01;-5.1974934E+00,-1.1824866E+01,-6.6997576E+00\| 0.0000000E+00\| 10)
	11 prt(o:13\| 1.7420764E+02;-5.9699936E+01,-1.4178703E+02,-8.1735224E+01\| 1.1164036E-02\| 11)
	12 prt(o:16\| 1.3313072E+02;-4.6780568E+01,-1.0780860E+02,-6.2551358E+01\| 0.0000000E+00\| 12)
	13 prt(o:-16\| 3.5365798E+00;-1.9022296E+00,-1.3052507E+00,-2.6805298E+00\| 0.0000000E+00\| 13)
	14 prt(o:211\| 1.7574714E+02;-1.0032238E+02,-7.2207754E+01,-1.2493397E+02\| 1.9479785E-02\| 14)
	========================================================================
	Partial contents of pythia6_4b.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 4.55387E+10
	Squared matrix el. (prc) = 4.55387E+10
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 6
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 4.999990E+02
	T = 1.000000000E+00
	Children: 3 4
	Particle 2 [b] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -4.999990E+02
	T = 1.000000000E+00
	Children: 3 4
	Particle 3 [v] f(11)
	E = 4.945513E+02
	P = 0.000000E+00 0.000000E+00 4.945503E+02
	T = 1.000000000E+00
	Parents: 1 2
	Children: 5 7
	Particle 4 [v] f(-11)
	E = 4.992909E+02
	P = 0.000000E+00 0.000000E+00 -4.992899E+02
	T = 1.000000000E+00
	Parents: 1 2
	Children: 6 8
	Particle 5 [i] f(11)
	E = 4.945513E+02
	P = 0.000000E+00 0.000000E+00 4.945503E+02
	T = 1.000000000E+00
	Parents: 3
	Children: 9 10
	Particle 6 [i] f(-11)
	E = 4.972005E+02
	P = 0.000000E+00 0.000000E+00 -4.971995E+02
	T = 1.000000000E+00
	Parents: 4
	Children: 9 10
	Particle 7 [x] f(22*)
	E = 2.004619E-12
	P = 0.000000E+00 0.000000E+00 2.004619E-12
	T = 0.000000000E+00
	Parents: 3
	Particle 8 [x] f(22*)
	E = 2.090446E+00
	P = 0.000000E+00 0.000000E+00 -2.090446E+00
	T = 0.000000000E+00
	Parents: 4
	Particle 9 [o] f(23)
	E = 4.923215E+02
	P = -2.803370E+02 -3.910835E+02 -5.029927E+01
	T = 8.315287819E+03
	Parents: 5 6
	Particle 10 [o] f(25)
	E = 4.994303E+02
	P = 2.803370E+02 3.910835E+02 4.765012E+01
	T = 1.562500000E+04
	Parents: 5 6
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 7
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 500.000 0.000 0.000 499.999 1.000
	2 [b] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -499.999 1.000
	3 [r] e- 0 0 1-2 5,7 494.551 0.000 0.000 494.550 1.000
	4 [r] e+ 0 0 1-2 6,8 499.291 0.000 0.000 -499.290 1.000
	5 [i] e- 0 0 3 9-10 494.551 0.000 0.000 494.550 1.000
	6 [i] e+ 0 0 4 9-10 497.200 0.000 0.000 -497.199 1.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 2.090 0.000 0.000 -2.090 0.000
	9 [r] Z 0 0 5-6 11-12 492.321 -280.337 -391.083 -50.299 8315.288
	10 [r] H 0 0 5-6 13-14 499.430 280.337 391.083 47.650 15625.000
	11 [r] d 500 0 9 23-28 374.021 -196.291 -318.215 -10.033 0.109
	12 [r] dbar 501 500 9 18-22,29-33 118.301 -84.046 -72.869 -40.266 0.109
	13 [r] tau- 0 0 10 15 380.186 242.184 292.944 -8.288 3.158
	14 [r] tau+ 0 0 10 16-17 119.245 38.153 98.140 55.938 3.158
	15 [r] tau- 0 0 13 34-35 380.186 242.184 292.944 -8.288 3.158
	16 [r] tau+ 0 0 14 36-38 119.182 38.133 98.088 55.909 3.158
	17 [o] A 0 0 14 [none] 0.063 0.020 0.052 0.030 0.000
	18 [o] dbar 502 501 12 [none] 36.573 -26.562 -20.363 -14.741 0.109
	19 [o] gl 503 502 12 [none] 16.471 -10.475 -11.515 -5.384 0.000
	20 [o] gl 504 503 12 [none] 38.090 -25.699 -25.009 -12.843 0.000
	21 [o] gl 505 504 12 [none] 5.932 -3.764 -4.247 -1.727 0.000
	22 [o] u 0 505 12 [none] 17.636 -11.855 -12.205 -4.627 0.109
	23 [o] d 506 0 11 [none] 260.323 -137.273 -221.067 -7.306 0.109
	24 [o] gl 507 506 11 [none] 61.399 -31.961 -52.410 -1.218 0.000
	25 [o] gl 508 507 11 [none] 13.328 -7.095 -11.282 -0.058 0.000
	26 [o] gl 509 508 11 [none] 4.456 -2.246 -3.848 0.029 0.000
	27 [o] gl 510 509 11 [none] 5.566 -2.710 -4.832 -0.533 0.000
	28 [o] gl 511 510 11 [none] 2.460 -1.216 -2.095 -0.428 0.000
	29 [o] gl 512 511 12 [none] 5.823 -2.817 -5.096 -0.051 0.000
	30 [o] gl 513 512 12 [none] 1.176 -0.897 -0.692 -0.319 0.000
	31 [o] gl 514 513 12 [none] 12.096 -8.229 -8.792 1.136 0.000
	32 [o] gl 515 514 12 [none] 0.463 -0.280 -0.269 -0.253 0.000
	33 [o] ubar 0 515 12 [none] 10.530 -7.257 -7.362 -1.978 0.109
	34 [o] nutau 0 0 15 [none] 241.141 154.242 185.293 -5.014 0.000
	35 [o] pim 0 0 15 [none] 139.044 87.943 107.651 -3.275 0.019
	36 [o] nue 0 0 16 [none] 74.915 24.101 61.663 35.058 0.000
	37 [o] e+ 0 0 16 [none] 7.721 2.726 6.401 3.348 0.000
	38 [o] nutauba 0 0 16 [none] 36.546 11.305 30.025 17.502 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 991.752 0.000 0.000 -2.649
	Sum of beam remnant momenta: p(0:3) = 2.090 0.000 0.000 -2.090
	Sum of outgoing momenta: p(0:3) = 991.752 0.000 0.000 -2.649
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	========================================================================
	Event transform: hadronization
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 9
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 500.000 0.000 0.000 499.999 1.000
	2 [b] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -499.999 1.000
	3 [r] e- 0 0 1-2 5,7 494.551 0.000 0.000 494.550 1.000
	4 [r] e+ 0 0 1-2 6,8 499.291 0.000 0.000 -499.290 1.000
	5 [i] e- 0 0 3 9-10 494.551 0.000 0.000 494.550 1.000
	6 [i] e+ 0 0 4 9-10 497.200 0.000 0.000 -497.199 1.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 2.090 0.000 0.000 -2.090 0.000
	9 [r] Z 0 0 5-6 11-12 492.321 -280.337 -391.083 -50.299 8315.288
	10 [r] H 0 0 5-6 13-14 499.430 280.337 391.083 47.650 15625.000
	11 [r] d 500 0 9 23-28 374.021 -196.291 -318.215 -10.033 0.109
	12 [r] dbar 501 500 9 18-22,29-33 118.301 -84.046 -72.869 -40.266 0.109
	13 [r] tau- 0 0 10 15 380.186 242.184 292.944 -8.288 3.158
	14 [r] tau+ 0 0 10 16-17 119.245 38.153 98.140 55.938 3.158
	15 [r] tau- 0 0 13 34-35 380.186 242.184 292.944 -8.288 3.158
	16 [r] tau+ 0 0 14 36-38 119.182 38.133 98.088 55.909 3.158
	17 [o] A 0 0 14 [none] 0.063 0.020 0.052 0.030 0.000
	18 [r] dbar 502 501 12 39 36.573 -26.562 -20.363 -14.741 0.109
	19 [r] gl 503 502 12 39 16.471 -10.475 -11.515 -5.384 0.000
	20 [r] gl 504 503 12 39 38.090 -25.699 -25.009 -12.843 0.000
	21 [r] gl 505 504 12 39 5.932 -3.764 -4.247 -1.727 0.000
	22 [r] u 0 505 12 39 17.636 -11.855 -12.205 -4.627 0.109
	23 [r] d 506 0 11 47 260.323 -137.273 -221.067 -7.306 0.109
	24 [r] gl 507 506 11 47 61.399 -31.961 -52.410 -1.218 0.000
	25 [r] gl 508 507 11 47 13.328 -7.095 -11.282 -0.058 0.000
	26 [r] gl 509 508 11 47 4.456 -2.246 -3.848 0.029 0.000
	27 [r] gl 510 509 11 47 5.566 -2.710 -4.832 -0.533 0.000
	28 [r] gl 511 510 11 47 2.460 -1.216 -2.095 -0.428 0.000
	29 [r] gl 512 511 12 47 5.823 -2.817 -5.096 -0.051 0.000
	30 [r] gl 513 512 12 47 1.176 -0.897 -0.692 -0.319 0.000
	31 [r] gl 514 513 12 47 12.096 -8.229 -8.792 1.136 0.000
	32 [r] gl 515 514 12 47 0.463 -0.280 -0.269 -0.253 0.000
	33 [r] ubar 0 515 12 47 10.530 -7.257 -7.362 -1.978 0.109
	34 [o] nutau 0 0 15 [none] 241.141 154.242 185.293 -5.014 0.000
	35 [o] pim 0 0 15 [none] 139.044 87.943 107.651 -3.275 0.019
	36 [o] nue 0 0 16 [none] 74.915 24.101 61.663 35.058 0.000
	37 [o] e+ 0 0 16 [none] 7.721 2.726 6.401 3.348 0.000
	38 [o] nutauba 0 0 16 [none] 36.546 11.305 30.025 17.502 0.000
	39 [r] hr3 0 0 18-22 40-46 114.702 -78.355 -73.338 -39.321 92.230
	40 [r] etaprim 0 0 39 57-59 18.165 -12.914 -10.923 -6.556 0.918
	41 [r] rho0 0 0 39 60-61 9.870 -6.846 -5.467 -4.461 0.770
	42 [o] pip 0 0 39 [none] 20.645 -14.648 -12.294 -7.777 0.019
	43 [r] rhom 0 0 39 62-63 9.208 -6.164 -6.099 -3.015 0.503
	44 [r] rhop 0 0 39 64-65 16.233 -10.640 -11.053 -5.262 0.426
	45 [r] rho0 0 0 39 66-67 10.824 -7.415 -7.110 -3.329 0.544
	46 [r] rho0 0 0 39 68-69 29.756 -19.729 -20.392 -8.921 0.802
	47 [r] hr3 0 0 23-33 48-56 377.620 -201.982 -317.745 -10.978 717.598
	48 [r] rhom 0 0 47 70-71 118.201 -62.025 -100.560 -3.382 0.713
	49 [o] pip 0 0 47 [none] 125.708 -67.002 -106.319 -3.101 0.019
	50 [r] rhom 0 0 47 72-73 84.526 -43.076 -72.699 -1.835 0.668
	51 [o] p 0 0 47 [none] 9.534 -5.556 -7.668 -0.601 0.880
	52 [r] rhom 0 0 47 74-75 7.325 -4.282 -5.883 -0.102 0.708
	53 [r] Deltaba 0 0 47 76-77 12.659 -6.637 -10.711 -0.408 1.331
	54 [r] rhop 0 0 47 78-79 9.098 -5.994 -6.777 0.473 0.680
	55 [o] pim 0 0 47 [none] 0.319 -0.155 -0.202 -0.131 0.019
	56 [r] rho0 0 0 47 80-81 10.248 -7.255 -6.927 -1.890 0.839
	57 [r] pi0 0 0 40 82-83 7.670 -5.456 -4.583 -2.834 0.018
	58 [r] pi0 0 0 40 84-85 2.486 -1.801 -1.493 -0.828 0.018
	59 [r] eta 0 0 40 86-88 8.010 -5.657 -4.846 -2.894 0.300
	60 [o] pip 0 0 41 [none] 6.232 -4.442 -3.140 -3.037 0.019
	61 [o] pim 0 0 41 [none] 3.639 -2.404 -2.327 -1.424 0.019
	62 [o] pim 0 0 43 [none] 4.729 -3.012 -3.370 -1.385 0.019
	63 [r] pi0 0 0 43 89-90 4.479 -3.152 -2.729 -1.630 0.018
	64 [o] pip 0 0 44 [none] 6.374 -3.987 -4.547 -2.009 0.019
	65 [r] pi0 0 0 44 91-92 9.858 -6.653 -6.506 -3.253 0.018
	66 [o] pim 0 0 45 [none] 9.214 -6.282 -6.009 -3.050 0.019
	67 [o] pip 0 0 45 [none] 1.610 -1.133 -1.101 -0.279 0.019
	68 [o] pim 0 0 46 [none] 24.468 -16.435 -16.664 -7.131 0.019
	69 [o] pip 0 0 46 [none] 5.289 -3.294 -3.728 -1.790 0.019
	70 [o] pim 0 0 48 [none] 52.846 -27.775 -44.944 -1.118 0.019
	71 [r] pi0 0 0 48 93-94 65.355 -34.250 -55.616 -2.264 0.018
	72 [o] pim 0 0 50 [none] 69.152 -35.282 -59.448 -1.782 0.019
	73 [r] pi0 0 0 50 95-96 15.374 -7.794 -13.251 -0.054 0.018
	74 [o] pim 0 0 52 [none] 6.557 -3.744 -5.380 0.074 0.019
	75 [r] pi0 0 0 52 97-98 0.769 -0.538 -0.503 -0.176 0.018
	76 [o] nbar 0 0 53 [none] 10.085 -5.187 -8.595 -0.238 0.883
	77 [r] pi0 0 0 53 99-100 2.574 -1.450 -2.116 -0.170 0.018
	78 [o] pip 0 0 54 [none] 2.469 -1.471 -1.973 -0.142 0.019
	79 [r] pi0 0 0 54 101-102 6.629 -4.523 -4.804 0.615 0.018
	80 [o] pip 0 0 56 [none] 5.139 -3.931 -3.154 -0.992 0.019
	81 [o] pim 0 0 56 [none] 5.110 -3.323 -3.773 -0.898 0.019
	82 [o] A 0 0 57 [none] 6.482 -4.645 -3.839 -2.388 0.000
	83 [o] A 0 0 57 [none] 1.187 -0.811 -0.744 -0.446 0.000
	84 [o] A 0 0 58 [none] 2.137 -1.582 -1.252 -0.705 0.000
	85 [o] A 0 0 58 [none] 0.348 -0.219 -0.242 -0.122 0.000
	86 [r] pi0 0 0 59 103-104 2.957 -2.059 -1.770 -1.164 0.018
	87 [r] pi0 0 0 59 105-106 2.502 -1.854 -1.487 -0.769 0.018
	88 [r] pi0 0 0 59 107-108 2.551 -1.744 -1.589 -0.962 0.018
	89 [o] A 0 0 63 [none] 0.128 -0.104 -0.061 -0.044 0.000
	90 [o] A 0 0 63 [none] 4.351 -3.048 -2.669 -1.586 0.000
	91 [o] A 0 0 65 [none] 4.368 -2.899 -2.928 -1.449 0.000
	92 [o] A 0 0 65 [none] 5.491 -3.754 -3.578 -1.804 0.000
	93 [o] A 0 0 71 [none] 47.380 -24.780 -40.350 -1.627 0.000
	94 [o] A 0 0 71 [none] 17.975 -9.470 -15.265 -0.637 0.000
	95 [o] A 0 0 73 [none] 2.167 -1.132 -1.847 -0.033 0.000
	96 [o] A 0 0 73 [none] 13.207 -6.662 -11.404 -0.020 0.000
	97 [o] A 0 0 75 [none] 0.740 -0.514 -0.496 -0.191 0.000
	98 [o] A 0 0 75 [none] 0.029 -0.023 -0.007 0.016 0.000
	99 [o] A 0 0 77 [none] 0.075 -0.058 -0.046 -0.000 0.000
	100 [o] A 0 0 77 [none] 2.499 -1.391 -2.069 -0.170 0.000
	101 [o] A 0 0 79 [none] 2.041 -1.366 -1.497 0.243 0.000
	102 [o] A 0 0 79 [none] 4.588 -3.157 -3.308 0.372 0.000
	103 [o] A 0 0 86 [none] 1.839 -1.250 -1.099 -0.782 0.000
	104 [o] A 0 0 86 [none] 1.118 -0.809 -0.671 -0.382 0.000
	105 [o] A 0 0 87 [none] 0.128 -0.074 -0.086 -0.058 0.000
	106 [o] A 0 0 87 [none] 2.374 -1.780 -1.401 -0.711 0.000
	107 [o] A 0 0 88 [none] 1.544 -1.031 -1.011 -0.546 0.000
	108 [o] A 0 0 88 [none] 1.007 -0.713 -0.577 -0.416 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 991.752 0.000 0.000 -2.649
	Sum of beam remnant momenta: p(0:3) = 2.090 0.000 0.000 -2.090
	Sum of outgoing momenta: p(0:3) = 991.752 0.000 0.000 -2.649
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	------------------------------------------------------------------------
	Hadronization settings:
	------------------------------------------------------------------------
	Master switches:
	active = T
	General settings:
	hadron_method = PYTHIA6
	pT generation parameters
	enhanced_fraction = 1.000000000000E-02
	enhanced_width = 2.000000000000E+00
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.00000E+03
	sqrts_hat* => 9.91748E+02
	n_in* => 2
	n_out* => 51
	n_tot* => 53
	$process_id* => "pythia6_4_p1"
	process_num_id* => [unknown integer]
	sqme* => 4.55387E+10
	sqme_ref* => 4.55387E+10
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-4.9999900E+02\| 1.0000000E+00\| 1)
	2 prt(b:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 4.9999900E+02\| 1.0000000E+00\| 2)
	3 prt(i:11\|-4.9455132E+02; 0.0000000E+00, 0.0000000E+00,-4.9455031E+02\| 1.0000000E+00\| 3)
	4 prt(i:-11\|-4.9720047E+02; 0.0000000E+00, 0.0000000E+00, 4.9719947E+02\| 1.0000000E+00\| 4)
	5 prt(o:22\| 2.0046190E-12; 0.0000000E+00, 0.0000000E+00, 2.0046190E-12\| 0.0000000E+00\| 5)
	6 prt(o:22\| 2.0904455E+00; 0.0000000E+00, 0.0000000E+00,-2.0904455E+00\| 0.0000000E+00\| 6)
	7 prt(o:22\| 6.2998339E-02; 1.9869673E-02, 5.1830919E-02, 2.9791653E-02\| 0.0000000E+00\| 7)
	8 prt(o:16\| 2.4114129E+02; 1.5424152E+02, 1.8529313E+02,-5.0135572E+00\| 0.0000000E+00\| 8)
	9 prt(o:-211\| 1.3904430E+02; 8.7942806E+01, 1.0765053E+02,-3.2746690E+00\| 1.9479785E-02\| 9)
	10 prt(o:12\| 7.4914701E+01; 2.4101359E+01, 6.1662566E+01, 3.5058023E+01\| 0.0000000E+00\| 10)
	11 prt(o:-11\| 7.7211259E+00; 2.7264437E+00, 6.4007861E+00, 3.3484665E+00\| 0.0000000E+00\| 11)
	12 prt(o:-16\| 3.6545907E+01; 1.1305031E+01, 3.0024614E+01, 1.7502061E+01\| 0.0000000E+00\| 12)
	13 prt(o:211\| 2.0644928E+01;-1.4648419E+01,-1.2293640E+01,-7.7771347E+00\| 1.9479785E-02\| 13)
	14 prt(o:211\| 1.2570846E+02;-6.7002237E+01,-1.0631878E+02,-3.1010114E+00\| 1.9479785E-02\| 14)
	15 prt(o:2212\| 9.5343062E+00;-5.5555299E+00,-7.6679167E+00,-6.0148564E-01\| 8.8035059E-01\| 15)
	16 prt(o:-211\| 3.1900906E-01;-1.5520136E-01,-2.0229933E-01,-1.3143255E-01\| 1.9479785E-02\| 16)
	17 prt(o:211\| 6.2316421E+00;-4.4418117E+00,-3.1404461E+00,-3.0367402E+00\| 1.9479785E-02\| 17)
	18 prt(o:-211\| 3.6386996E+00;-2.4038351E+00,-2.3266799E+00,-1.4243569E+00\| 1.9479785E-02\| 18)
	19 prt(o:-211\| 4.7289778E+00;-3.0115605E+00,-3.3697839E+00,-1.3852115E+00\| 1.9479785E-02\| 19)
	20 prt(o:211\| 6.3741091E+00;-3.9872367E+00,-4.5472004E+00,-2.0086559E+00\| 1.9479785E-02\| 20)
	21 prt(o:-211\| 9.2140612E+00;-6.2823415E+00,-6.0092813E+00,-3.0496173E+00\| 1.9479785E-02\| 21)
	22 prt(o:211\| 1.6100044E+00;-1.1325495E+00,-1.1009466E+00,-2.7907475E-01\| 1.9479785E-02\| 22)
	23 prt(o:-211\| 2.4467711E+01;-1.6434729E+01,-1.6664228E+01,-7.1311018E+00\| 1.9479785E-02\| 23)
	24 prt(o:211\| 5.2885494E+00;-3.2937817E+00,-3.7278021E+00,-1.7899076E+00\| 1.9479785E-02\| 24)
	25 prt(o:-211\| 5.2846122E+01;-2.7775352E+01,-4.4944105E+01,-1.1181943E+00\| 1.9479785E-02\| 25)
	26 prt(o:-211\| 6.9152455E+01;-3.5282488E+01,-5.9447575E+01,-1.7816862E+00\| 1.9479785E-02\| 26)
	27 prt(o:-211\| 6.5566506E+00;-3.7438701E+00,-5.3803481E+00, 7.4013587E-02\| 1.9479785E-02\| 27)
	28 prt(o:-2112\| 1.0085294E+01;-5.1867436E+00,-8.5948493E+00,-2.3795638E-01\| 8.8279178E-01\| 28)
	29 prt(o:211\| 2.4688726E+00;-1.4707713E+00,-1.9729478E+00,-1.4198951E-01\| 1.9479785E-02\| 29)
	30 prt(o:211\| 5.1386326E+00;-3.9313707E+00,-3.1538181E+00,-9.9187754E-01\| 1.9479785E-02\| 30)
	31 prt(o:-211\| 5.1095213E+00;-3.3233707E+00,-3.7731066E+00,-8.9811062E-01\| 1.9479785E-02\| 31)
	32 prt(o:22\| 6.4823383E+00;-4.6451307E+00,-3.8393853E+00,-2.3880100E+00\| 0.0000000E+00\| 32)
	33 prt(o:22\| 1.1872551E+00;-8.1063756E-01,-7.4375139E-01,-4.4640259E-01\| 0.0000000E+00\| 33)
	34 prt(o:22\| 2.1373103E+00;-1.5822013E+00,-1.2518597E+00,-7.0539481E-01\| 0.0000000E+00\| 34)
	35 prt(o:22\| 3.4826746E-01;-2.1906908E-01,-2.4160892E-01,-1.2216420E-01\| 0.0000000E+00\| 35)
	36 prt(o:22\| 1.2824808E-01;-1.0412208E-01,-6.0628649E-02,-4.3935494E-02\| 0.0000000E+00\| 36)
	37 prt(o:22\| 4.3508004E+00;-3.0481274E+00,-2.6687752E+00,-1.5861975E+00\| 0.0000000E+00\| 37)
	38 prt(o:22\| 4.3676843E+00;-2.8989430E+00,-2.9278532E+00,-1.4493004E+00\| 0.0000000E+00\| 38)
	39 prt(o:22\| 5.4907247E+00;-3.7540109E+00,-3.5780010E+00,-1.8037097E+00\| 0.0000000E+00\| 39)
	40 prt(o:22\| 4.7379654E+01;-2.4780199E+01,-4.0350057E+01,-1.6267413E+00\| 0.0000000E+00\| 40)
	41 prt(o:22\| 1.7975397E+01;-9.4696507E+00,-1.5265467E+01,-6.3728726E-01\| 0.0000000E+00\| 41)
	42 prt(o:22\| 2.1670130E+00;-1.1322046E+00,-1.8474185E+00,-3.3206772E-02\| 0.0000000E+00\| 42)
	43 prt(o:22\| 1.3207015E+01;-6.6615307E+00,-1.1403896E+01,-2.0449496E-02\| 0.0000000E+00\| 43)
	44 prt(o:22\| 7.3952436E-01;-5.1443072E-01,-4.9558194E-01,-1.9145720E-01\| 0.0000000E+00\| 44)
	45 prt(o:22\| 2.9202330E-02;-2.3443288E-02,-7.0163341E-03, 1.5936103E-02\| 0.0000000E+00\| 45)
	46 prt(o:22\| 7.4521866E-02;-5.8327332E-02,-4.6383477E-02,-6.1829434E-05\| 0.0000000E+00\| 46)
	47 prt(o:22\| 2.4994859E+00;-1.3914916E+00,-2.0693585E+00,-1.7010660E-01\| 0.0000000E+00\| 47)
	48 prt(o:22\| 2.0412160E+00;-1.3664479E+00,-1.4967530E+00, 2.4313264E-01\| 0.0000000E+00\| 48)
	49 prt(o:22\| 4.5875525E+00;-3.1569884E+00,-3.3076606E+00, 3.7208020E-01\| 0.0000000E+00\| 49)
	50 prt(o:22\| 1.8389161E+00;-1.2502079E+00,-1.0988299E+00,-7.8177054E-01\| 0.0000000E+00\| 50)
	51 prt(o:22\| 1.1183987E+00;-8.0875113E-01,-6.7140887E-01,-3.8203066E-01\| 0.0000000E+00\| 51)
	52 prt(o:22\| 1.2813832E-01;-7.4456848E-02,-8.6434829E-02,-5.8349173E-02\| 0.0000000E+00\| 52)
	53 prt(o:22\| 2.3738185E+00;-1.7796854E+00,-1.4009927E+00,-7.1060091E-01\| 0.0000000E+00\| 53)
	54 prt(o:22\| 1.5438090E+00;-1.0308652E+00,-1.0111100E+00,-5.4618668E-01\| 0.0000000E+00\| 54)
	55 prt(o:22\| 1.0071618E+00;-7.1290506E-01,-5.7747438E-01,-4.1552940E-01\| 0.0000000E+00\| 55)
	========================================================================
	Index: trunk/share/tests/functional_tests/ref-output-quad/powheg_1.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-quad/powheg_1.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output-quad/powheg_1.ref (revision 8190)
	@@ -1,718 +1,730 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	openmp_num_threads = 1
	?pacify = true
	seed = 0
	SM.wtop => 0.00000E+00
	SM.mtop => 1.75000E+02
	?use_vamp_equivalences = false
	$loop_me_method = "dummy"
	?alphas_is_fixed = false
	?alphas_from_mz = true
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = true
	?powheg_matching = true
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_grid_sampling_points = 1000
	powheg_pt_min = 1.00000E+00
	?powheg_use_singular_jacobian = false
	\| Process library 'powheg_1_lib': recorded process 'powheg_1_p1'
	sqrts = 5.00000E+02
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_1_lib': compiling ...
	\| Process library 'powheg_1_lib': writing makefile
	\| Process library 'powheg_1_lib': removing old files
	\| Process library 'powheg_1_lib': writing driver
	\| Process library 'powheg_1_lib': creating source code
	\| Process library 'powheg_1_lib': compiling sources
	\| Process library 'powheg_1_lib': linking
	\| Process library 'powheg_1_lib': loading
	\| Process library 'powheg_1_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process powheg_1_p1:
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e+ (mass = 5.1099700E-04 GeV)
	\| e- (mass = 5.1099700E-04 GeV)
	\| sqrts = 5.000000000000E+02 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p1.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p1.i3.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_1_p1'
	\| Library name = 'powheg_1_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'powheg_1_p1_i1': e+, e- => t, tbar [omega]
	\| 2: 'powheg_1_p1_i2': e+, e- => t, tbar, gl [omega], [real]
	\| 3: 'powheg_1_p1_i3': e+, e- => t, tbar [dummy], [virtual]
	\| 4: 'powheg_1_p1_i4': e+, e- => t, tbar [inactive], [subtraction]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| Using user-defined general scale.
	\| Starting integration for process 'powheg_1_p1'
	\| Integration hook: add POWHEG hook
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 1 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.673E+02 2.15E+01 4.60 0.46 45.8
	\|-----------------------------------------------------------------------------\|
	1 100 4.673E+02 2.15E+01 4.60 0.46 45.8
	\|=============================================================================\|
	n_events = 1
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?write_raw = false
	\| Starting simulation for process 'powheg_1_p1'
	\| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 2.1397E-03
	\| Events: writing to ASCII file 'powheg_1_p1.debug'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p1_1000.pg'
	\| Grid: Mean value of the grid: 1.663322017E-02
	\| Grid: Max value of the grid: 3.908545009E-02
	\| Grid: Mean/Max value of the grid: 4.255604100E-01
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 20.00 %
	\| Events: closing ASCII file 'powheg_1_p1.debug'
	n_events = 2
	\| Starting simulation for process 'powheg_1_p1'
	\| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 2
	\| corr. to luminosity [fb-1] = 4.2795E-03
	\| Events: writing to ASCII file 'powheg_1_p1.debug'
	\| Events: generating 2 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p1_1000.pg'
	\| Grid: Mean value of the grid: 1.663322017E-02
	\| Grid: Max value of the grid: 3.908545009E-02
	\| Grid: Mean/Max value of the grid: 4.255604100E-01
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 100.00 %
	\| Events: closing ASCII file 'powheg_1_p1.debug'
	?nlo_use_real_partition = true
	real_partition_scale = 5.00000E+00
	\| Process library 'powheg_1_lib': unloading
	\| Process library 'powheg_1_lib': open
	\| Process library 'powheg_1_lib': recorded process 'powheg_1_p2'
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_1_lib': compiling ...
	\| Process library 'powheg_1_lib': writing makefile
	\| Process library 'powheg_1_lib': removing old files
	\| Process library 'powheg_1_lib': writing driver
	\| Process library 'powheg_1_lib': creating source code
	\| Process library 'powheg_1_lib': compiling sources
	\| Process library 'powheg_1_lib': linking
	\| Process library 'powheg_1_lib': loading
	\| Process library 'powheg_1_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Initializing integration for process powheg_1_p2:
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e+ (mass = 5.1099700E-04 GeV)
	\| e- (mass = 5.1099700E-04 GeV)
	\| sqrts = 5.000000000000E+02 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p2.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p2.i3.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p2.i5.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_1_p2'
	\| Library name = 'powheg_1_lib'
	\| Process index = 2
	\| Process components:
	\| 1: 'powheg_1_p2_i1': e+, e- => t, tbar [omega]
	\| 2: 'powheg_1_p2_i2': e+, e- => t, tbar, gl [omega], [real]
	\| 3: 'powheg_1_p2_i3': e+, e- => t, tbar [dummy], [virtual]
	\| 4: 'powheg_1_p2_i4': e+, e- => t, tbar [inactive], [subtraction]
	\| 5: 'powheg_1_p2_i5': e+, e- => t, tbar, gl [omega], [real]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| Using user-defined general scale.
	\| Integration hook: add POWHEG hook
	\| Starting integration for process 'powheg_1_p2' part 'Combined'
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 1 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
	\|-----------------------------------------------------------------------------\|
	1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
	\|=============================================================================\|
	\| Starting integration for process 'powheg_1_p2' part 'real'
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 2 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
	\|-----------------------------------------------------------------------------\|
	1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
	\|=============================================================================\|
	\| Integrate: sum of all components
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 0 4.978E+02 2.90E+01 5.83 0.00 31.2
	\| NLO Correction: [O(alpha_s+1)/O(alpha_s)]
	\| ( 0.0000 +- 0.00000 ) %
	\|=============================================================================\|
	tolerance = 1.08355E+02
	\| expect: success
	\| Starting simulation for process 'powheg_1_p2'
	\| Simulate: using integration grids from file 'powheg_1_p2.m1.vg'
	\| Simulate: using integration grids from file 'powheg_1_p2.m2.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 4
	\| Simulation: requested number of events = 2
	\| corr. to luminosity [fb-1] = 4.0177E-03
	\| Events: writing to ASCII file 'powheg_1_p2.debug'
	\| Events: generating 2 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p2_1000.pg'
	\| Grid: Mean value of the grid: 1.508219495E-03
	\| Grid: Max value of the grid: 1.844004544E-02
	\| Grid: Mean/Max value of the grid: 8.179044351E-02
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 20.00 %
	\| Events: closing ASCII file 'powheg_1_p2.debug'
	\| Summary of value checks:
	\| Failures: 0 / Total: 1
	\| There were no errors and 2 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Contents of powheg_1_p1.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.80466E-02
	Squared matrix el. (prc) = 2.80466E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 9.608533E+01 -1.236770E+02 -8.571236E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -9.608533E+01 1.236770E+02 8.571236E+01
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 8
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [v] t 1 0 1-2 5-7 250.000 96.085 -123.677 -85.712 30625.000
	4 [v] tbar 0 1 1-2 5-7 250.000 -96.085 123.677 85.712 30625.000
	5 [o] t 2 0 3-4 [none] 160.932 104.618 -121.732 11.639 30625.000
	6 [o] tbar 0 1 3-4 [none] 244.520 -91.910 118.303 81.988 30625.000
	7 [o] gl 1 2 3-4 [none] 94.548 -12.708 3.430 -93.627 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 3
	n_tot* => 5
	$process_id* => "powheg_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.80466E-02
	sqme_ref* => 2.80466E-02
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 1.6093234E+02; 1.0461835E+02,-1.2173226E+02, 1.1639310E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.4451983E+02;-9.1909962E+01, 1.1830264E+02, 8.1987752E+01\| 3.0625000E+04\| 4)
	5 prt(o:21\| 9.4547831E+01;-1.2708391E+01, 3.4296182E+00,-9.3627062E+01\| 0.0000000E+00\| 5)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.76791E-02
	Squared matrix el. (prc) = 2.76791E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 1.688666E+02 3.093682E+01 -4.901007E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -1.688666E+02 -3.093682E+01 4.901007E+01
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 8
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 250.000 168.867 30.937 -49.010 30625.000
	4 [o] tbar 0 1 1-2 [none] 250.000 -168.867 -30.937 49.010 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.76791E-02
	sqme_ref* => 2.76791E-02
	event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.5000000E+02; 1.6886659E+02, 3.0936816E+01,-4.9010068E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.5000000E+02;-1.6886659E+02,-3.0936816E+01, 4.9010068E+01\| 3.0625000E+04\| 4)
	========================================================================
	Contents of powheg_1_p2.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 1.41607E-05
	Squared matrix el. (prc) = 1.41607E-05
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 2
	Selected term = 6
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	seed = 196611
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4 5
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4 5
	Particle 3 [o] f(6)c(1 )
	E = 2.219832E+02
	P = -7.125693E+01 -1.137429E+02 -2.522963E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-2 )
	E = 2.128305E+02
	P = 1.983915E+01 1.013308E+02 6.332695E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 5 [o] f(21)c(2 -1)
	E = 6.518630E+01
	P = 5.141778E+01 1.241207E+01 -3.809732E+01
	T = 0.000000000E+00
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	seed = 196612
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-5 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-5 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 221.983 -71.257 -113.743 -25.230 30625.000
	4 [o] tbar 0 2 1-2 [none] 212.831 19.839 101.331 63.327 30625.000
	5 [o] gl 2 1 1-2 [none] 65.186 51.418 12.412 -38.097 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 3
	n_tot* => 5
	$process_id* => "powheg_1_p2"
	process_num_id* => [unknown integer]
	sqme* => 1.41607E-05
	sqme_ref* => 1.41607E-05
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.2198318E+02;-7.1256929E+01,-1.1374290E+02,-2.5229632E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.1283052E+02; 1.9839145E+01, 1.0133083E+02, 6.3326954E+01\| 3.0625000E+04\| 4)
	5 prt(o:21\| 6.5186300E+01; 5.1417783E+01, 1.2412066E+01,-3.8097321E+01\| 0.0000000E+00\| 5)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 3.51646E-02
	Squared matrix el. (prc) = 3.51646E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	seed = 196611
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 1.143154E+02 2.823158E+00 -1.371095E+02
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -1.143154E+02 -2.823158E+00 1.371095E+02
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	seed = 196612
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 250.000 114.315 2.823 -137.110 30625.000
	4 [o] tbar 0 1 1-2 [none] 250.000 -114.315 -2.823 137.110 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p2"
	process_num_id* => [unknown integer]
	sqme* => 3.51646E-02
	sqme_ref* => 3.51646E-02
	event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.5000000E+02; 1.1431539E+02, 2.8231580E+00,-1.3710953E+02\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.5000000E+02;-1.1431539E+02,-2.8231580E+00, 1.3710953E+02\| 3.0625000E+04\| 4)
	========================================================================
	Contents of powheg_1_p1_1000.pg:
	3
	5 5 2
	2.530629306E-02 3.365662356E-02 2.917606728E-02 2.032378341E-02 1.640279341E-02 3.676895126E-02 3.908545009E-02 3.100081429E-02 2.758624989E-02 2.075435308E-02 2.184926020E-02 2.585981001E-02 2.428140005E-02 1.869552869E-02 1.052110830E-02 1.026072927E-02 1.131493579E-02 8.439667002E-03 6.062967308E-03 1.289002281E-03 1.045380067E-03 1.753781377E-03 1.601314412E-03 1.460208346E-03 5.505926972E-04 2.514689998E-02 3.495739832E-02 2.886328584E-02 2.828860676E-02 6.796007631E-03 3.768978983E-02 3.879497593E-02 2.947607204E-02 2.189014635E-02 1.692352080E-02 2.171460101E-02 2.407352156E-02 2.142085942E-02 1.201357659E-02 1.557410030E-02 1.031223753E-02 1.094206930E-02 9.348220246E-03 3.791168954E-03 2.417083375E-03 1.119303556E-03 1.532804571E-03 1.760727600E-03 1.192585495E-03 5.743801359E-04
	Contents of powheg_1_p2_1000.pg:
	3
	5 5 2
	1.843957322E-02 0.000000000E+00 3.840441758E-04 0.000000000E+00 0.000000000E+00 1.702819008E-02 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 1.628435672E-03 1.957292802E-04 3.584549890E-05 0.000000000E+00 2.651881828E-06 1.844004544E-02 0.000000000E+00 3.796757221E-04 0.000000000E+00 0.000000000E+00 1.703819508E-02 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 1.586894288E-03 2.098735104E-04 3.901739593E-05 0.000000000E+00 2.803502658E-06
	Index: trunk/share/tests/functional_tests/pythia8_1.sin
	===================================================================
	--- trunk/share/tests/functional_tests/pythia8_1.sin (revision 0)
	+++ trunk/share/tests/functional_tests/pythia8_1.sin (revision 8190)
	@@ -0,0 +1,49 @@
	+# SINDARIN input for WHIZARD self-test
	+
	+model = SM
	+
	+?logging = true
	+?openmp_logging = false
	+?vis_history = false
	+?integration_timer = false
	+?pacify = true
	+
	+me = 0
	+$method = "omega"
	+process pythia8_1_p1 = "e-", "e+" => "u", "ubar"
	+! process pythia8_1_p1 = "e-", "e+" => "W+", "W-"
	+
	+compile ()
	+
	+seed = 1234
	+$phs_method = "wood"
	+$integration_method = "vamp2"
	+$rng_method = "rng_stream"
	+iterations = 3:1000:"g", 3:1000
	+sqrts = 1000
	+cuts = all Pt > 100 [u:ubar]
	+
	+!!! Tests should be run single-threaded
	+openmp_num_threads = 1
	+
	+integrate (pythia8_1_p1)
	+
	+n_events = 1
	+sample_format = debug
	+?debug_decay = false
	+?debug_process = false
	+?debug_verbose = false
	+?sample_pacify = true
	+
	+?allow_shower = true
	+?ps_fsr_active = true
	+$shower_method = "PYTHIA8"
	+
	+$sample = "pythia8_1a"
	+simulate (pythia8_1_p1)
	+
	+?hadronization_active = true
	+$hadronization_method = "PYTHIA8"
	+
	+$sample = "pythia8_1b"
	+simulate (pythia8_1_p1)
	Index: trunk/share/tests/functional_tests/pythia8_2.sin
	===================================================================
	--- trunk/share/tests/functional_tests/pythia8_2.sin (revision 0)
	+++ trunk/share/tests/functional_tests/pythia8_2.sin (revision 8190)
	@@ -0,0 +1,57 @@
	+# SINDARIN input for WHIZARD self-test
	+
	+model = SM
	+
	+?logging = true
	+?openmp_logging = false
	+?vis_history = false
	+?integration_timer = false
	+?pacify = true
	+
	+me = 0
	+$method = "omega"
	+process pythia8_2_p1 = "e-", "e+" => "Z", "H"
	+process pythia8_2_p2 = "Z" => "e-", "e+"
	+process pythia8_2_p3 = "H" => "b", "bbar"
	+
	+compile ()
	+
	+seed = 0
	+$phs_method = "wood"
	+$integration_method = "vamp"
	+sqrts = 1000
	+
	+!!! Tests should be run single-threaded
	+openmp_num_threads = 1
	+
	+integrate (pythia8_2_p1) { iterations=1:1000 }
	+
	+error_threshold = 1e-8
	+
	+n_events = 1
	+?rebuild_events = true
	+sample_format = debug
	+?debug_decay = false
	+?debug_process = false
	+?debug_verbose = false
	+?sample_pacify = true
	+
	+?allow_shower = true
	+?ps_fsr_active = true
	+$shower_method = "PYTHIA8"
	+$hadronization_method = "PYTHIA8"
	+
	+$sample = "pythia8_2a"
	+simulate (pythia8_2_p1)
	+
	+$sample = "pythia8_2b"
	+simulate (pythia8_2_p1) {?hadronization_active = true}
	+
	+unstable Z (pythia8_2_p2)
	+unstable H (pythia8_2_p3)
	+
	+$sample = "pythia8_2c"
	+simulate (pythia8_2_p1)
	+
	+$sample = "pythia8_2d"
	+simulate (pythia8_2_p1) {?hadronization_active = true}
	Index: trunk/share/tests/functional_tests/ref-output-ext/pythia6_3.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-ext/pythia6_3.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output-ext/pythia6_3.ref (revision 8190)
	@@ -1,748 +1,757 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	?pacify = true
	$method = "omega"
	\| Process library 'pythia6_3_lib': recorded process 'pythia6_3_p1'
	SM.me => 1.00000E+01
	\| Process library 'pythia6_3_lib': compiling ...
	\| Process library 'pythia6_3_lib': writing makefile
	\| Process library 'pythia6_3_lib': removing old files
	\| Process library 'pythia6_3_lib': writing driver
	\| Process library 'pythia6_3_lib': creating source code
	\| Process library 'pythia6_3_lib': compiling sources
	\| Process library 'pythia6_3_lib': linking
	\| Process library 'pythia6_3_lib': loading
	\| Process library 'pythia6_3_lib': ... success.
	seed = 0
	$phs_method = "wood"
	$integration_method = "vamp"
	sqrts = 5.00000E+02
	openmp_num_threads = 1
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process pythia6_3_p1:
	\| Beam structure: e-, e+ => circe1 => isr
	\| Beam data (collision):
	\| e- (mass = 1.0000000E+01 GeV)
	\| e+ (mass = 1.0000000E+01 GeV)
	\| sqrts = 5.000000000000E+02 GeV
	\| CIRCE1: activating generator mode
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'pythia6_3_p1.i1.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'pythia6_3_p1'
	\| Library name = 'pythia6_3_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'pythia6_3_p1_i1': e-, e+ => u, ubar [omega]
	\| ------------------------------------------------------------------------
	\| Phase space: 2 channels, 2 dimensions
	\| Phase space: found 2 channels, collected in 2 groves.
	\| Phase space: Using 2 equivalences between channels.
	\| Phase space: wood
	\| Beam structure: circe1 => isr, none => none, isr
	\| Beam structure: 2 channels, 2 dimensions
	\| Applying user-defined cuts.
	\| Starting integration for process 'pythia6_3_p1'
	\| Integrate: iterations = 3:1000:"g", 3:1000
	\| Integrator: 2 chains, 2 channels, 4 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 1000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 1000 6.612E+02 2.37E+01 3.58 1.13 22.4
	2 1000 6.567E+02 1.27E+01 1.94 0.61 36.6
	3 1000 6.521E+02 1.09E+01 1.67 0.53 36.1
	\|-----------------------------------------------------------------------------\|
	3 3000 6.548E+02 7.81E+00 1.19 0.65 36.1 0.08 3
	\|-----------------------------------------------------------------------------\|
	4 1000 6.726E+02 1.02E+01 1.52 0.48 31.0
	5 1000 6.538E+02 1.15E+01 1.76 0.56 25.4
	6 1000 6.639E+02 1.11E+01 1.66 0.53 24.9
	\|-----------------------------------------------------------------------------\|
	6 3000 6.642E+02 6.28E+00 0.95 0.52 24.9 0.74 3
	\|=============================================================================\|
	n_events = 1
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?allow_shower = true
	?ps_fsr_active = true
	$shower_method = "PYTHIA6"
	$sample = "pythia6_3a"
	\| Starting simulation for process 'pythia6_3_p1'
	\| Simulate: using integration grids from file 'pythia6_3_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 1.5056E-03
	\| Events: writing to ASCII file 'pythia6_3a.debug'
	\| Events: writing to raw file 'pythia6_3a.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 12.50 %
	\| Events: closing ASCII file 'pythia6_3a.debug'
	\| Events: closing raw file 'pythia6_3a.evx'
	?hadronization_active = true
	$sample = "pythia6_3b"
	\| Starting simulation for process 'pythia6_3_p1'
	\| Simulate: using integration grids from file 'pythia6_3_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| Simulate: activating hadronization
	\| Hadronization: Using PYTHIA6 interface for hadronization and decays
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 1.5056E-03
	\| Events: writing to ASCII file 'pythia6_3b.debug'
	\| Events: writing to raw file 'pythia6_3b.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 50.00 %
	\| Events: closing ASCII file 'pythia6_3b.debug'
	\| Events: closing raw file 'pythia6_3b.evx'
	\| WHIZARD run finished.
	\|=============================================================================\|
	Partial contents of pythia6_3a.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.93612E+15
	Squared matrix el. (prc) = 2.93612E+15
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 2
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.497999E+02
	T = 1.000000000E+02
	Children: 3 4
	Particle 2 [b] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Children: 3 4
	Particle 3 [v] f(11)
	E = 2.476793E+02
	P = 0.000000E+00 0.000000E+00 2.474773E+02
	T = 1.000000000E+02
	Parents: 1 2
	Children: 5 7
	Particle 4 [v] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Parents: 1 2
	Children: 6 8
	Particle 5 [i] f(11)
	E = 1.816946E+02
	P = 0.000000E+00 0.000000E+00 1.814192E+02
	T = 1.000000000E+02
	Parents: 3
	Children: 9 10
	Particle 6 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Parents: 4
	Children: 9 10
	Particle 7 [x] f(22*)
	E = 6.605811E+01
	P = 0.000000E+00 0.000000E+00 6.605811E+01
	T = 0.000000000E+00
	Parents: 3
	Particle 8 [x] f(22*)
	E = 1.063882E-18
	P = 0.000000E+00 0.000000E+00 -1.063882E-18
	T = 0.000000000E+00
	Parents: 4
	Particle 9 [o] f(2)c(1 )
	E = 1.994960E+02
	P = -2.038944E+01 -1.860559E+02 6.903719E+01
	T = 0.000000000E+00
	Parents: 5 6
	Particle 10 [o] f(-2)c(-1 )
	E = 2.321986E+02
	P = 2.038944E+01 1.860559E+02 -1.374179E+02
	T = 0.000000000E+00
	Parents: 5 6
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 3
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 250.000 0.000 0.000 249.800 100.000
	2 [b] e+ 0 0 [none] 3-4 250.000 0.000 0.000 -249.800 100.000
	3 [r] e- 0 0 1-2 5,7 247.679 0.000 0.000 247.477 100.000
	4 [r] e+ 0 0 1-2 6,8 250.000 0.000 0.000 -249.800 100.000
	5 [i] e- 0 0 3 9-10 181.695 0.000 0.000 181.419 100.000
	6 [i] e+ 0 0 4 9-10 250.000 0.000 0.000 -249.800 100.000
	7 [x] A 0 0 3 [none] 66.058 0.000 0.000 66.058 0.000
	8 [x] A 0 0 4 [none] 0.000 0.000 0.000 -0.000 0.000
	9 [r] u 1 0 5-6 18-28 199.496 -20.389 -186.056 69.037 0.000
	10 [r] ubar 0 1 5-6 11-17 232.199 20.389 186.056 -137.418 0.000
	11 [o] ubar 0 500 10 [none] 17.841 0.835 15.017 -9.596 0.000
	12 [o] gl 500 501 10 [none] 6.032 -0.227 5.313 -2.848 0.000
	13 [o] gl 501 502 10 [none] 2.657 0.140 1.996 -1.748 0.000
	14 [o] gl 502 503 10 [none] 6.248 0.663 4.791 -3.955 0.000
	15 [o] gl 503 504 10 [none] 40.323 4.179 31.764 -24.485 0.000
	16 [o] gl 504 505 10 [none] 71.139 6.390 57.012 -42.067 0.000
	17 [o] gl 505 506 10 [none] 59.971 5.932 47.552 -36.057 0.000
	18 [o] gl 506 507 9 [none] 1.832 -1.515 -0.920 0.462 0.000
	19 [o] gl 507 508 9 [none] 0.982 -0.069 -0.980 -0.022 0.000
	20 [o] gl 508 509 9 [none] 2.047 -1.584 -0.573 -1.163 0.000
	21 [o] gl 509 510 9 [none] 9.757 -8.611 -1.046 -4.467 0.000
	22 [o] gl 510 511 9 [none] 31.749 -27.254 -1.890 -16.175 0.000
	23 [o] gl 511 512 9 [none] 1.145 -1.075 0.159 -0.360 0.000
	24 [o] gl 512 513 9 [none] 2.337 -1.921 -0.890 -0.991 0.000
	25 [o] gl 513 514 9 [none] 1.913 -1.459 -1.204 0.283 0.000
	26 [o] gl 514 515 9 [none] 8.198 2.070 -5.298 5.904 0.000
	27 [o] gl 515 516 9 [none] 84.260 13.920 -75.989 33.641 0.000
	28 [o] u 516 0 9 [none] 83.263 9.587 -74.816 35.262 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 431.695 0.000 0.000 -68.381
	Sum of beam remnant momenta: p(0:3) = 66.058 0.000 0.000 66.058
	Sum of outgoing momenta: p(0:3) = 431.695 0.000 0.000 -68.381
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 4.26244E+02
	n_in* => 2
	n_out* => 20
	n_tot* => 22
	$process_id* => "pythia6_3_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.93612E+15
	sqme_ref* => 2.93612E+15
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.4979992E+02\| 1.0000000E+02\| 1)
	2 prt(b:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.4979992E+02\| 1.0000000E+02\| 2)
	3 prt(i:11\|-1.8169462E+02; 0.0000000E+00, 0.0000000E+00,-1.8141923E+02\| 1.0000000E+02\| 3)
	4 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.4979992E+02\| 1.0000000E+02\| 4)
	5 prt(o:22\| 6.6058108E+01; 0.0000000E+00, 0.0000000E+00, 6.6058108E+01\| 0.0000000E+00\| 5)
	6 prt(o:22\| 0.0000000E+00; 0.0000000E+00, 0.0000000E+00, 0.0000000E+00\| 0.0000000E+00\| 6)
	7 prt(o:-2\| 1.7840634E+01; 8.3460447E-01, 1.5017223E+01,-9.5955541E+00\| 0.0000000E+00\| 7)
	8 prt(o:21\| 6.0324718E+00;-2.2699804E-01, 5.3129592E+00,-2.8480962E+00\| 0.0000000E+00\| 8)
	9 prt(o:21\| 2.6573876E+00; 1.3984694E-01, 1.9963137E+00,-1.7483945E+00\| 0.0000000E+00\| 9)
	10 prt(o:21\| 6.2479216E+00; 6.6348653E-01, 4.7913372E+00,-3.9546678E+00\| 0.0000000E+00\| 10)
	11 prt(o:21\| 4.0323145E+01; 4.1788996E+00, 3.1764352E+01,-2.4485072E+01\| 0.0000000E+00\| 11)
	12 prt(o:21\| 7.1138927E+01; 6.3899647E+00, 5.7011544E+01,-4.2066603E+01\| 0.0000000E+00\| 12)
	13 prt(o:21\| 5.9970744E+01; 5.9318769E+00, 4.7552315E+01,-3.6056627E+01\| 0.0000000E+00\| 13)
	14 prt(o:21\| 1.8317853E+00;-1.5147227E+00,-9.2045887E-01, 4.6239364E-01\| 0.0000000E+00\| 14)
	15 prt(o:21\| 9.8227009E-01;-6.9130408E-02,-9.7957930E-01,-2.2358821E-02\| 0.0000000E+00\| 15)
	16 prt(o:21\| 2.0468051E+00;-1.5841871E+00,-5.7297660E-01,-1.1625232E+00\| 0.0000000E+00\| 16)
	17 prt(o:21\| 9.7571594E+00;-8.6110771E+00,-1.0456541E+00,-4.4674509E+00\| 0.0000000E+00\| 17)
	18 prt(o:21\| 3.1749301E+01;-2.7254493E+01,-1.8895828E+00,-1.6175295E+01\| 0.0000000E+00\| 18)
	19 prt(o:21\| 1.1445548E+00;-1.0747946E+00, 1.5857305E-01,-3.6010679E-01\| 0.0000000E+00\| 19)
	20 prt(o:21\| 2.3373271E+00;-1.9208641E+00,-8.9002739E-01,-9.9057068E-01\| 0.0000000E+00\| 20)
	21 prt(o:21\| 1.9130354E+00;-1.4594063E+00,-1.2039558E+00, 2.8342240E-01\| 0.0000000E+00\| 21)
	22 prt(o:21\| 8.1983843E+00; 2.0701192E+00,-5.2980644E+00, 5.9041194E+00\| 0.0000000E+00\| 22)
	23 prt(o:21\| 8.4260032E+01; 1.3919781E+01,-7.5988726E+01, 3.3640843E+01\| 0.0000000E+00\| 23)
	24 prt(o:2\| 8.3262736E+01; 9.5870941E+00,-7.4815592E+01, 3.5261848E+01\| 0.0000000E+00\| 24)
	========================================================================
	Partial contents of pythia6_3b.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 1.50392E+33
	Squared matrix el. (prc) = 1.50392E+33
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 6
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.497999E+02
	T = 1.000000000E+02
	Children: 3 4
	Particle 2 [b] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Children: 3 4
	Particle 3 [v] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.497999E+02
	T = 1.000000000E+02
	Parents: 1 2
	Children: 5 7
	Particle 4 [v] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.497999E+02
	T = 1.000000000E+02
	Parents: 1 2
	Children: 6 8
	Particle 5 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.497999E+02
	T = 1.000000000E+02
	Parents: 3
	Children: 9 10
	Particle 6 [i] f(-11)
	E = 2.448851E+02
	P = 0.000000E+00 0.000000E+00 -2.446809E+02
	T = 1.000000000E+02
	Parents: 4
	Children: 9 10
	Particle 7 [x] f(22*)
	E = 1.372454E-35
	P = 0.000000E+00 0.000000E+00 1.372454E-35
	T = 0.000000000E+00
	Parents: 3
	Particle 8 [x] f(22*)
	E = 5.119062E+00
	P = 0.000000E+00 0.000000E+00 -5.119062E+00
	T = 0.000000000E+00
	Parents: 4
	Particle 9 [o] f(2)c(1 )
	E = 2.482222E+02
	P = -2.281888E+02 5.891499E+01 7.793054E+01
	T = 0.000000000E+00
	Parents: 5 6
	Particle 10 [o] f(-2)c(-1 )
	E = 2.466629E+02
	P = 2.281888E+02 -5.891499E+01 -7.281148E+01
	T = 0.000000000E+00
	Parents: 5 6
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 7
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 250.000 0.000 0.000 249.800 100.000
	2 [b] e+ 0 0 [none] 3-4 250.000 0.000 0.000 -249.800 100.000
	3 [r] e- 0 0 1-2 5,7 250.000 0.000 0.000 249.800 100.000
	4 [r] e+ 0 0 1-2 6,8 250.000 0.000 0.000 -249.800 100.000
	5 [i] e- 0 0 3 9-10 250.000 0.000 0.000 249.800 100.000
	6 [i] e+ 0 0 4 9-10 244.885 0.000 0.000 -244.681 100.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 5.119 0.000 0.000 -5.119 0.000
	9 [r] u 1 0 5-6 18-24 248.222 -228.189 58.915 77.931 0.000
	10 [r] ubar 0 1 5-6 11-17,25-27 246.663 228.189 -58.915 -72.811 0.000
	11 [o] ubar 0 500 10 [none] 67.357 66.997 6.823 1.338 0.000
	12 [o] gl 500 501 10 [none] 11.047 10.915 1.575 -0.649 0.000
	13 [o] gl 501 502 10 [none] 11.146 11.016 1.691 -0.137 0.000
	14 [o] gl 502 503 10 [none] 21.964 21.568 3.720 -1.849 0.000
	15 [o] gl 503 504 10 [none] 12.944 11.841 2.560 -4.558 0.000
	16 [o] gl 504 505 10 [none] 3.236 2.996 -0.650 -1.036 0.000
	17 [o] d 505 0 10 [none] 115.187 79.739 -61.708 -55.693 0.109
	18 [o] u 506 0 9 [none] 103.402 -95.300 24.538 31.745 0.000
	19 [o] gl 507 506 9 [none] 91.901 -84.310 22.825 28.578 0.000
	20 [o] gl 508 507 9 [none] 25.417 -23.490 6.720 7.007 0.000
	21 [o] gl 509 508 9 [none] 5.099 -4.741 0.335 1.846 0.000
	22 [o] gl 510 509 9 [none] 3.435 -2.839 1.076 1.606 0.000
	23 [o] gl 511 510 9 [none] 6.122 -5.399 0.472 2.847 0.000
	24 [o] gl 512 511 9 [none] 0.284 -0.118 -0.149 0.211 0.000
	25 [o] gl 513 512 10 [none] 3.181 1.224 -2.448 -1.622 0.000
	26 [o] gl 514 513 10 [none] 5.206 4.057 -2.824 -1.632 0.000
	27 [o] dbar 0 514 10 [none] 7.958 5.843 -4.558 -2.882 0.109
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 494.885 0.000 0.000 5.119
	Sum of beam remnant momenta: p(0:3) = 5.119 0.000 0.000 -5.119
	Sum of outgoing momenta: p(0:3) = 494.885 0.000 0.000 5.119
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	========================================================================
	Event transform: hadronization
	------------------------------------------------------------------------
	Associated process: 'pythia6_3_p1'
	TAO random-number generator:
	seed = 9
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 250.000 0.000 0.000 249.800 100.000
	2 [b] e+ 0 0 [none] 3-4 250.000 0.000 0.000 -249.800 100.000
	3 [r] e- 0 0 1-2 5,7 250.000 0.000 0.000 249.800 100.000
	4 [r] e+ 0 0 1-2 6,8 250.000 0.000 0.000 -249.800 100.000
	5 [i] e- 0 0 3 9-10 250.000 0.000 0.000 249.800 100.000
	6 [i] e+ 0 0 4 9-10 244.885 0.000 0.000 -244.681 100.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 5.119 0.000 0.000 -5.119 0.000
	9 [r] u 1 0 5-6 18-24 248.222 -228.189 58.915 77.931 0.000
	10 [r] ubar 0 1 5-6 11-17,25-27 246.663 228.189 -58.915 -72.811 0.000
	11 [r] ubar 0 500 10 28 67.357 66.997 6.823 1.338 0.000
	12 [r] gl 500 501 10 28 11.047 10.915 1.575 -0.649 0.000
	13 [r] gl 501 502 10 28 11.146 11.016 1.691 -0.137 0.000
	14 [r] gl 502 503 10 28 21.964 21.568 3.720 -1.849 0.000
	15 [r] gl 503 504 10 28 12.944 11.841 2.560 -4.558 0.000
	16 [r] gl 504 505 10 28 3.236 2.996 -0.650 -1.036 0.000
	17 [r] d 505 0 10 28 115.187 79.739 -61.708 -55.693 0.109
	18 [r] u 506 0 9 43 103.402 -95.300 24.538 31.745 0.000
	19 [r] gl 507 506 9 43 91.901 -84.310 22.825 28.578 0.000
	20 [r] gl 508 507 9 43 25.417 -23.490 6.720 7.007 0.000
	21 [r] gl 509 508 9 43 5.099 -4.741 0.335 1.846 0.000
	22 [r] gl 510 509 9 43 3.435 -2.839 1.076 1.606 0.000
	23 [r] gl 511 510 9 43 6.122 -5.399 0.472 2.847 0.000
	24 [r] gl 512 511 9 43 0.284 -0.118 -0.149 0.211 0.000
	25 [r] gl 513 512 10 43 3.181 1.224 -2.448 -1.622 0.000
	26 [r] gl 514 513 10 43 5.206 4.057 -2.824 -1.632 0.000
	27 [r] dbar 0 514 10 43 7.958 5.843 -4.558 -2.882 0.109
	28 [r] hr3 0 0 11-17 29-42 242.880 205.072 -45.988 -62.585 10904.722
	29 [r] eta 0 0 28 61-62 46.261 46.022 4.643 0.467 0.300
	30 [r] rhom 0 0 28 63-64 21.989 21.860 2.220 0.469 0.503
	31 [o] pip 0 0 28 [none] 12.531 12.296 2.129 -1.131 0.019
	32 [o] pim 0 0 28 [none] 7.484 7.385 1.188 0.176 0.019
	33 [r] Deltaba 0 0 28 65-66 13.176 12.996 1.548 -0.953 1.394
	34 [r] rhom 0 0 28 67-68 5.729 5.434 1.396 -0.884 0.559
	35 [r] Delta0 0 0 28 69-70 12.026 11.481 2.262 -2.494 1.474
	36 [r] etaprim 0 0 28 71-73 5.769 5.402 0.821 -1.585 0.917
	37 [o] nbar 0 0 28 [none] 4.121 2.740 -2.146 -1.998 0.883
	38 [r] lambda 0 0 28 74-75 11.162 8.411 -5.246 -5.007 1.245
	39 [o] kp 0 0 28 [none] 2.239 1.529 -1.059 -1.144 0.244
	40 [r] rhom 0 0 28 76-77 29.728 20.577 -16.048 -14.231 0.285
	41 [r] etaprim 0 0 28 78-79 31.116 21.617 -16.528 -15.060 0.917
	42 [r] omega 0 0 28 80-82 39.549 27.320 -21.169 -19.210 0.590
	43 [r] hr3 0 0 18-27 44-60 252.005 -205.072 45.988 67.704 14753.285
	44 [r] kstarp 0 0 43 83-84 91.143 -83.758 22.325 28.147 0.846
	45 [r] k0 0 0 43 85 58.028 -53.701 13.747 17.154 0.248
	46 [r] rho0 0 0 43 86-87 20.299 -18.491 5.060 6.609 0.852
	47 [r] k0 0 0 43 88 21.384 -19.668 4.678 6.949 0.248
	48 [o] km 0 0 43 [none] 16.013 -14.682 4.375 4.634 0.244
	49 [r] rhop 0 0 43 89-90 14.432 -13.297 3.323 4.489 0.281
	50 [o] pim 0 0 43 [none] 2.473 -2.072 0.941 0.958 0.019
	51 [r] rho0 0 0 43 91-92 6.531 -5.860 0.784 2.602 0.928
	52 [r] pi0 0 0 43 93-94 1.708 -1.657 0.307 0.240 0.018
	53 [r] omega 0 0 43 95-97 1.815 -1.187 0.286 1.092 0.611
	54 [r] rho0 0 0 43 98-99 1.669 -1.426 -0.231 0.021 0.700
	55 [o] pip 0 0 43 [none] 0.718 -0.237 -0.652 0.119 0.019
	56 [r] rhom 0 0 43 100-101 1.673 1.124 -1.001 -0.339 0.416
	57 [r] kstarp 0 0 43 102-103 3.822 3.212 -1.671 -0.818 0.829
	58 [r] k0 0 0 43 104 3.760 1.740 -2.527 -2.115 0.248
	59 [o] pim 0 0 43 [none] 2.447 1.809 -1.575 -0.463 0.019
	60 [o] pip 0 0 43 [none] 4.091 3.080 -2.180 -1.575 0.019
	61 [o] A 0 0 29 [none] 20.027 19.906 2.148 0.435 0.000
	62 [o] A 0 0 29 [none] 26.235 26.116 2.495 0.032 0.000
	63 [o] pim 0 0 30 [none] 5.683 5.630 0.750 -0.093 0.019
	64 [r] pi0 0 0 30 105-106 16.307 16.230 1.470 0.562 0.018
	65 [o] nbar 0 0 33 [none] 8.951 8.821 1.047 -0.562 0.883
	66 [o] pip 0 0 33 [none] 4.225 4.175 0.500 -0.391 0.019
	67 [o] pim 0 0 34 [none] 2.318 2.117 0.642 -0.678 0.019
	68 [r] pi0 0 0 34 107-108 3.411 3.317 0.754 -0.205 0.018
	69 [o] p 0 0 35 [none] 8.602 8.248 1.589 -1.600 0.880
	70 [o] pim 0 0 35 [none] 3.424 3.233 0.673 -0.893 0.019
	71 [o] pim 0 0 36 [none] 1.553 1.504 0.123 -0.338 0.019
	72 [o] pip 0 0 36 [none] 1.520 1.430 0.294 -0.401 0.019
	73 [r] eta 0 0 36 109-111 2.697 2.469 0.405 -0.846 0.300
	74 [o] p 0 0 38 [none] 10.130 7.615 -4.828 -4.522 0.880
	75 [o] pim 0 0 38 [none] 1.032 0.796 -0.418 -0.486 0.019
	76 [o] pim 0 0 40 [none] 2.712 1.835 -1.467 -1.348 0.019
	77 [r] pi0 0 0 40 112-113 27.016 18.742 -14.580 -12.883 0.018
	78 [o] A 0 0 41 [none] 3.573 2.496 -1.969 -1.630 0.000
	79 [r] rho0 0 0 41 114-115 27.543 19.121 -14.559 -13.430 0.680
	80 [o] pim 0 0 42 [none] 14.294 9.990 -7.402 -7.051 0.019
	81 [o] pip 0 0 42 [none] 16.069 11.022 -8.718 -7.792 0.019
	82 [r] pi0 0 0 42 116-117 9.185 6.308 -5.048 -4.366 0.018
	83 [r] k0 0 0 44 118 28.784 -26.474 7.060 8.808 0.248
	84 [o] pip 0 0 44 [none] 62.359 -57.285 15.265 19.339 0.019
	85 [o] kL0 0 0 45 [none] 58.028 -53.701 13.747 17.154 0.248
	86 [o] pim 0 0 46 [none] 13.730 -12.649 3.050 4.380 0.019
	87 [o] pip 0 0 46 [none] 6.569 -5.842 2.010 2.229 0.019
	88 [r] kS0 0 0 47 119-120 21.384 -19.668 4.678 6.949 0.248
	89 [o] pip 0 0 49 [none] 3.943 -3.670 0.721 1.240 0.019
	90 [r] pi0 0 0 49 121-122 10.490 -9.627 2.603 3.249 0.018
	91 [o] pim 0 0 51 [none] 5.906 -5.432 0.527 2.253 0.019
	92 [o] pip 0 0 51 [none] 0.626 -0.428 0.257 0.350 0.019
	93 [o] A 0 0 52 [none] 0.348 -0.326 0.062 0.102 0.000
	94 [o] A 0 0 52 [none] 1.360 -1.331 0.245 0.138 0.000
	95 [o] pip 0 0 53 [none] 0.528 -0.291 0.231 0.349 0.019
	96 [o] pim 0 0 53 [none] 0.159 -0.021 0.059 0.045 0.019
	97 [r] pi0 0 0 53 123-124 1.127 -0.874 -0.004 0.698 0.018
	98 [o] pip 0 0 54 [none] 1.127 -1.083 0.081 0.266 0.019
	99 [o] pim 0 0 54 [none] 0.542 -0.342 -0.312 -0.245 0.019
	100 [o] pim 0 0 56 [none] 0.321 0.026 -0.250 -0.142 0.019
	101 [r] pi0 0 0 56 125-126 1.352 1.098 -0.750 -0.197 0.018
	102 [r] k0 0 0 57 127 2.210 1.727 -1.221 -0.405 0.248
	103 [o] pip 0 0 57 [none] 1.612 1.485 -0.450 -0.412 0.019
	104 [r] kS0 0 0 58 128-129 3.760 1.740 -2.527 -2.115 0.248
	105 [o] A 0 0 64 [none] 15.070 14.997 1.380 0.548 0.000
	106 [o] A 0 0 64 [none] 1.237 1.233 0.091 0.014 0.000
	107 [o] A 0 0 68 [none] 1.147 1.101 0.304 -0.106 0.000
	108 [o] A 0 0 68 [none] 2.263 2.216 0.450 -0.099 0.000
	109 [r] pi0 0 0 73 130-131 0.659 0.614 0.164 -0.113 0.018
	110 [r] pi0 0 0 73 132-133 0.593 0.545 0.116 -0.153 0.018
	111 [r] pi0 0 0 73 134-135 1.444 1.310 0.125 -0.580 0.018
	112 [o] A 0 0 77 [none] 25.723 17.861 -13.859 -12.272 0.000
	113 [o] A 0 0 77 [none] 1.292 0.881 -0.721 -0.611 0.000
	114 [o] pim 0 0 79 [none] 26.657 18.540 -14.088 -12.975 0.019
	115 [o] pip 0 0 79 [none] 0.886 0.581 -0.471 -0.455 0.019
	116 [o] A 0 0 82 [none] 7.813 5.360 -4.331 -3.683 0.000
	117 [o] A 0 0 82 [none] 1.372 0.948 -0.718 -0.683 0.000
	118 [o] kL0 0 0 83 [none] 28.784 -26.474 7.060 8.808 0.248
	119 [o] pip 0 0 88 [none] 4.788 -4.345 1.169 1.629 0.019
	120 [o] pim 0 0 88 [none] 16.596 -15.323 3.509 5.320 0.019
	121 [o] A 0 0 90 [none] 7.131 -6.520 1.805 2.254 0.000
	122 [o] A 0 0 90 [none] 3.359 -3.108 0.798 0.995 0.000
	123 [o] A 0 0 97 [none] 0.132 -0.081 0.034 0.099 0.000
	124 [o] A 0 0 97 [none] 0.995 -0.793 -0.037 0.599 0.000
	125 [o] A 0 0 101 [none] 0.486 0.370 -0.288 -0.128 0.000
	126 [o] A 0 0 101 [none] 0.865 0.728 -0.462 -0.070 0.000
	127 [o] kL0 0 0 102 [none] 2.210 1.727 -1.221 -0.405 0.248
	128 [r] pi0 0 0 104 136-137 1.531 0.572 -0.991 -1.007 0.018
	129 [r] pi0 0 0 104 138-139 2.229 1.168 -1.536 -1.107 0.018
	130 [o] A 0 0 109 [none] 0.210 0.206 -0.010 -0.037 0.000
	131 [o] A 0 0 109 [none] 0.450 0.407 0.174 -0.077 0.000
	132 [o] A 0 0 110 [none] 0.538 0.516 0.072 -0.135 0.000
	133 [o] A 0 0 110 [none] 0.055 0.029 0.043 -0.018 0.000
	134 [o] A 0 0 111 [none] 0.766 0.722 0.070 -0.246 0.000
	135 [o] A 0 0 111 [none] 0.678 0.588 0.055 -0.334 0.000
	136 [o] A 0 0 128 [none] 1.499 0.561 -0.962 -1.003 0.000
	137 [o] A 0 0 128 [none] 0.032 0.011 -0.030 -0.004 0.000
	138 [o] A 0 0 129 [none] 0.802 0.470 -0.511 -0.401 0.000
	139 [o] A 0 0 129 [none] 1.426 0.698 -1.024 -0.706 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 494.885 0.000 0.000 5.119
	Sum of beam remnant momenta: p(0:3) = 5.119 0.000 0.000 -5.119
	Sum of outgoing momenta: p(0:3) = 494.885 0.000 0.000 5.119
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	------------------------------------------------------------------------
	Hadronization settings:
	------------------------------------------------------------------------
	Master switches:
	active = T
	General settings:
	hadron_method = PYTHIA6
	pT generation parameters
	enhanced_fraction = 1.000000000000E-02
	enhanced_width = 2.000000000000E+00
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 4.94859E+02
	n_in* => 2
	n_out* => 72
	n_tot* => 74
	$process_id* => "pythia6_3_p1"
	process_num_id* => [unknown integer]
	sqme* => 1.50392E+33
	sqme_ref* => 1.50392E+33
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.4979992E+02\| 1.0000000E+02\| 1)
	2 prt(b:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.4979992E+02\| 1.0000000E+02\| 2)
	3 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.4979992E+02\| 1.0000000E+02\| 3)
	4 prt(i:-11\|-2.4488512E+02; 0.0000000E+00, 0.0000000E+00, 2.4468086E+02\| 1.0000000E+02\| 4)
	5 prt(o:22\| 0.0000000E+00; 0.0000000E+00, 0.0000000E+00, 0.0000000E+00\| 0.0000000E+00\| 5)
	6 prt(o:22\| 5.1190622E+00; 0.0000000E+00, 0.0000000E+00,-5.1190622E+00\| 0.0000000E+00\| 6)
	7 prt(o:211\| 1.2530681E+01; 1.2295693E+01, 2.1293536E+00,-1.1314940E+00\| 1.9479785E-02\| 7)
	8 prt(o:-211\| 7.4835368E+00; 7.3852032E+00, 1.1880869E+00, 1.7625995E-01\| 1.9479785E-02\| 8)
	9 prt(o:-2112\| 4.1213079E+00; 2.7398599E+00,-2.1459217E+00,-1.9976423E+00\| 8.8279178E-01\| 9)
	10 prt(o:321\| 2.2392647E+00; 1.5293545E+00,-1.0592300E+00,-1.1444526E+00\| 2.4364096E-01\| 10)
	11 prt(o:-321\| 1.6013061E+01;-1.4682054E+01, 4.3747208E+00, 4.6339589E+00\| 2.4364096E-01\| 11)
	12 prt(o:-211\| 2.4729411E+00;-2.0717229E+00, 9.4137190E-01, 9.5798797E-01\| 1.9479785E-02\| 12)
	13 prt(o:211\| 7.1777862E-01;-2.3700953E-01,-6.5221914E-01, 1.1900854E-01\| 1.9479785E-02\| 13)
	14 prt(o:-211\| 2.4467750E+00; 1.8087005E+00,-1.5751762E+00,-4.6330359E-01\| 1.9479785E-02\| 14)
	15 prt(o:211\| 4.0910459E+00; 3.0796740E+00,-2.1802696E+00,-1.5745505E+00\| 1.9479785E-02\| 15)
	16 prt(o:22\| 2.0026531E+01; 1.9906239E+01, 2.1480479E+00, 4.3528147E-01\| 0.0000000E+00\| 16)
	17 prt(o:22\| 2.6234807E+01; 2.6115845E+01, 2.4953370E+00, 3.2070180E-02\| 0.0000000E+00\| 17)
	18 prt(o:-211\| 5.6825825E+00; 5.6303688E+00, 7.5007759E-01,-9.2712024E-02\| 1.9479785E-02\| 18)
	19 prt(o:-2112\| 8.9506348E+00; 8.8214396E+00, 1.0474669E+00,-5.6221671E-01\| 8.8279178E-01\| 19)
	20 prt(o:211\| 4.2249068E+00; 4.1745882E+00, 5.0036748E-01,-3.9090082E-01\| 1.9479785E-02\| 20)
	21 prt(o:-211\| 2.3183681E+00; 2.1172550E+00, 6.4206190E-01,-6.7848263E-01\| 1.9479785E-02\| 21)
	22 prt(o:2212\| 8.6024560E+00; 8.2483586E+00, 1.5891970E+00,-1.6002911E+00\| 8.8035059E-01\| 22)
	23 prt(o:-211\| 3.4238271E+00; 3.2330791E+00, 6.7266577E-01,-8.9321454E-01\| 1.9479785E-02\| 23)
	24 prt(o:-211\| 1.5527678E+00; 1.5041124E+00, 1.2253668E-01,-3.3799222E-01\| 1.9479785E-02\| 24)
	25 prt(o:211\| 1.5198510E+00; 1.4296278E+00, 2.9351524E-01,-4.0059995E-01\| 1.9479785E-02\| 25)
	26 prt(o:2212\| 1.0130369E+01; 7.6148263E+00,-4.8284883E+00,-4.5215193E+00\| 8.8035059E-01\| 26)
	27 prt(o:-211\| 1.0316100E+00; 7.9644702E-01,-4.1792307E-01,-4.8554291E-01\| 1.9479785E-02\| 27)
	28 prt(o:-211\| 2.7121648E+00; 1.8347827E+00,-1.4672275E+00,-1.3480260E+00\| 1.9479785E-02\| 28)
	29 prt(o:22\| 3.5730342E+00; 2.4962413E+00,-1.9693661E+00,-1.6300153E+00\| 0.0000000E+00\| 29)
	30 prt(o:-211\| 1.4294042E+01; 9.9895009E+00,-7.4018992E+00,-7.0513770E+00\| 1.9479785E-02\| 30)
	31 prt(o:211\| 1.6069427E+01; 1.1021664E+01,-8.7182583E+00,-7.7924244E+00\| 1.9479785E-02\| 31)
	32 prt(o:211\| 6.2358530E+01;-5.7284879E+01, 1.5264935E+01, 1.9338850E+01\| 1.9479785E-02\| 32)
	33 prt(o:130\| 5.8028447E+01;-5.3701213E+01, 1.3747274E+01, 1.7153576E+01\| 2.4767543E-01\| 33)
	34 prt(o:-211\| 1.3729673E+01;-1.2649085E+01, 3.0502674E+00, 4.3796081E+00\| 1.9479785E-02\| 34)
	35 prt(o:211\| 6.5694269E+00;-5.8419961E+00, 2.0099127E+00, 2.2291752E+00\| 1.9479785E-02\| 35)
	36 prt(o:211\| 3.9425909E+00;-3.6698975E+00, 7.2050479E-01, 1.2398662E+00\| 1.9479785E-02\| 36)
	37 prt(o:-211\| 5.9056482E+00;-5.4318526E+00, 5.2661586E-01, 2.2527437E+00\| 1.9479785E-02\| 37)
	38 prt(o:211\| 6.2567044E-01;-4.2847298E-01, 2.5731858E-01, 3.4954509E-01\| 1.9479785E-02\| 38)
	39 prt(o:22\| 3.4750803E-01;-3.2632382E-01, 6.2211220E-02, 1.0200177E-01\| 0.0000000E+00\| 39)
	40 prt(o:22\| 1.3603457E+00;-1.3309775E+00, 2.4512949E-01, 1.3766231E-01\| 0.0000000E+00\| 40)
	41 prt(o:211\| 5.2824567E-01;-2.9069234E-01, 2.3084437E-01, 3.4895923E-01\| 1.9479785E-02\| 41)
	42 prt(o:-211\| 1.5937125E-01;-2.1486518E-02, 5.8809300E-02, 4.4712467E-02\| 1.9479785E-02\| 42)
	43 prt(o:211\| 1.1269250E+00;-1.0831744E+00, 8.0839918E-02, 2.6585391E-01\| 1.9479785E-02\| 43)
	44 prt(o:-211\| 5.4212853E-01;-3.4240129E-01,-3.1180086E-01,-2.4487780E-01\| 1.9479785E-02\| 44)
	45 prt(o:-211\| 3.2092519E-01; 2.5889393E-02,-2.5043812E-01,-1.4185796E-01\| 1.9479785E-02\| 45)
	46 prt(o:211\| 1.6119430E+00; 1.4853360E+00,-4.5019054E-01,-4.1229357E-01\| 1.9479785E-02\| 46)
	47 prt(o:22\| 1.5070158E+01; 1.4996879E+01, 1.3795122E+00, 5.4793131E-01\| 0.0000000E+00\| 47)
	48 prt(o:22\| 1.2366052E+00; 1.2332024E+00, 9.0651626E-02, 1.3658241E-02\| 0.0000000E+00\| 48)
	49 prt(o:22\| 1.1474455E+00; 1.1014434E+00, 3.0376491E-01,-1.0573842E-01\| 0.0000000E+00\| 49)
	50 prt(o:22\| 2.2630965E+00; 2.2156161E+00, 4.5030912E-01,-9.9362118E-02\| 0.0000000E+00\| 50)
	51 prt(o:22\| 2.5723320E+01; 1.7861109E+01,-1.3859262E+01,-1.2271545E+01\| 0.0000000E+00\| 51)
	52 prt(o:22\| 1.2922120E+00; 8.8082910E-01,-7.2113538E-01,-6.1148638E-01\| 0.0000000E+00\| 52)
	53 prt(o:-211\| 2.6656891E+01; 1.8540072E+01,-1.4088157E+01,-1.2975359E+01\| 1.9479785E-02\| 53)
	54 prt(o:211\| 8.8649514E-01; 5.8110715E-01,-4.7081264E-01,-4.5502063E-01\| 1.9479785E-02\| 54)
	55 prt(o:22\| 7.8134836E+00; 5.3602932E+00,-4.3305092E+00,-3.6829978E+00\| 0.0000000E+00\| 55)
	56 prt(o:22\| 1.3716461E+00; 9.4808661E-01,-7.1794748E-01,-6.8344447E-01\| 0.0000000E+00\| 56)
	57 prt(o:130\| 2.8784102E+01;-2.6473571E+01, 7.0597805E+00, 8.8083155E+00\| 2.4767543E-01\| 57)
	58 prt(o:211\| 4.7876720E+00;-4.3453291E+00, 1.1689907E+00, 1.6290793E+00\| 1.9479785E-02\| 58)
	59 prt(o:-211\| 1.6595841E+01;-1.5322803E+01, 3.5087358E+00, 5.3200494E+00\| 1.9479785E-02\| 59)
	60 prt(o:22\| 7.1307803E+00;-6.5198202E+00, 1.8049787E+00, 2.2543345E+00\| 0.0000000E+00\| 60)
	61 prt(o:22\| 3.3590229E+00;-3.1075700E+00, 7.9770349E-01, 9.9484327E-01\| 0.0000000E+00\| 61)
	62 prt(o:22\| 1.3197249E-01;-8.1170274E-02, 3.3517353E-02, 9.8512489E-02\| 0.0000000E+00\| 62)
	63 prt(o:22\| 9.9492774E-01;-7.9315846E-01,-3.7167947E-02, 5.9949930E-01\| 0.0000000E+00\| 63)
	64 prt(o:22\| 4.8630881E-01; 3.7008631E-01,-2.8841249E-01,-1.2786954E-01\| 0.0000000E+00\| 64)
	65 prt(o:22\| 8.6531352E-01; 7.2829306E-01,-4.6207273E-01,-6.9609631E-02\| 0.0000000E+00\| 65)
	66 prt(o:130\| 2.2102857E+00; 1.7268553E+00,-1.2211795E+00,-4.0543653E-01\| 2.4767543E-01\| 66)
	67 prt(o:22\| 2.0971931E-01; 2.0628426E-01,-9.6011512E-03,-3.6562448E-02\| 0.0000000E+00\| 67)
	68 prt(o:22\| 4.4962554E-01; 4.0745002E-01, 1.7395911E-01,-7.6719211E-02\| 0.0000000E+00\| 68)
	69 prt(o:22\| 5.3778592E-01; 5.1556119E-01, 7.2490651E-02,-1.3474219E-01\| 0.0000000E+00\| 69)
	70 prt(o:22\| 5.5301990E-02; 2.9230655E-02, 4.3388173E-02,-1.7926109E-02\| 0.0000000E+00\| 70)
	71 prt(o:22\| 7.6595826E-01; 7.2199166E-01, 6.9603670E-02,-2.4612076E-01\| 0.0000000E+00\| 71)
	72 prt(o:22\| 6.7846105E-01; 5.8801710E-01, 5.5007826E-02,-3.3394525E-01\| 0.0000000E+00\| 72)
	73 prt(o:22\| 1.4986092E+00; 5.6068207E-01,-9.6156156E-01,-1.0034263E+00\| 0.0000000E+00\| 73)
	74 prt(o:22\| 3.2114863E-02; 1.1132152E-02,-2.9848766E-02,-4.0608905E-03\| 0.0000000E+00\| 74)
	75 prt(o:22\| 8.0243018E-01; 4.7028597E-01,-5.1139548E-01,-4.0149716E-01\| 0.0000000E+00\| 75)
	76 prt(o:22\| 1.4263871E+00; 6.9806751E-01,-1.0243908E+00,-7.0562408E-01\| 0.0000000E+00\| 76)
	========================================================================
	Index: trunk/share/tests/functional_tests/ref-output-ext/pythia6_4.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-ext/pythia6_4.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output-ext/pythia6_4.ref (revision 8190)
	@@ -1,699 +1,708 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	?pacify = true
	$method = "omega"
	\| Process library 'pythia6_4_lib': recorded process 'pythia6_4_p1'
	\| Process library 'pythia6_4_lib': recorded process 'pythia6_4_p2'
	\| Process library 'pythia6_4_lib': recorded process 'pythia6_4_p3'
	SM.me => 1.00000E+00
	isr_mass = 1.00000E+00
	\| Process library 'pythia6_4_lib': compiling ...
	\| Process library 'pythia6_4_lib': writing makefile
	\| Process library 'pythia6_4_lib': removing old files
	\| Process library 'pythia6_4_lib': writing driver
	\| Process library 'pythia6_4_lib': creating source code
	\| Process library 'pythia6_4_lib': compiling sources
	\| Process library 'pythia6_4_lib': linking
	\| Process library 'pythia6_4_lib': loading
	\| Process library 'pythia6_4_lib': ... success.
	seed = 0
	$phs_method = "wood"
	$integration_method = "vamp"
	sqrts = 1.00000E+03
	openmp_num_threads = 1
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process pythia6_4_p1:
	\| Beam structure: e-, e+ => circe1 => isr
	\| Beam data (collision):
	\| e- (mass = 1.0000000E+00 GeV)
	\| e+ (mass = 1.0000000E+00 GeV)
	\| sqrts = 1.000000000000E+03 GeV
	\| CIRCE1: activating generator mode
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'pythia6_4_p1.i1.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'pythia6_4_p1'
	\| Library name = 'pythia6_4_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'pythia6_4_p1_i1': e-, e+ => Z, H [omega]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 2 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: Using 1 equivalence between channels.
	\| Phase space: wood
	\| Beam structure: circe1 => isr, none => none, isr
	\| Beam structure: 1 channels, 2 dimensions
	Warning: No cuts have been defined.
	\| Starting integration for process 'pythia6_4_p1'
	\| Integrate: iterations = 3:1000:"g", 3:1000
	\| Integrator: 1 chains, 1 channels, 4 dimensions
	\| Integrator: Using VAMP channel equivalences
	\| Integrator: 1000 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 1000 1.729E+01 3.15E-01 1.82 0.58 13.5
	2 1000 1.684E+01 1.92E-01 1.14 0.36 24.5
	3 1000 1.722E+01 1.96E-01 1.14 0.36 20.9
	\|-----------------------------------------------------------------------------\|
	3 3000 1.707E+01 1.26E-01 0.74 0.40 20.9 1.28 3
	\|-----------------------------------------------------------------------------\|
	4 1000 1.705E+01 1.77E-01 1.04 0.33 20.7
	5 1000 1.691E+01 1.68E-01 0.99 0.31 20.5
	6 1000 1.719E+01 2.18E-01 1.27 0.40 18.0
	\|-----------------------------------------------------------------------------\|
	6 3000 1.703E+01 1.06E-01 0.62 0.34 18.0 0.53 3
	\|=============================================================================\|
	error_threshold = 1.00000E-08
	n_events = 1
	?rebuild_events = true
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?allow_shower = true
	?ps_fsr_active = true
	$shower_method = "PYTHIA6"
	$sample = "pythia6_4a"
	\| Starting simulation for process 'pythia6_4_p1'
	\| Simulate: using integration grids from file 'pythia6_4_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 5.8731E-02
	\| Events: writing to ASCII file 'pythia6_4a.debug'
	\| Events: writing to raw file 'pythia6_4a.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 16.67 %
	\| Events: closing ASCII file 'pythia6_4a.debug'
	\| Events: closing raw file 'pythia6_4a.evx'
	$sample = "pythia6_4b"
	?hadronization_active = true
	\| Starting simulation for process 'pythia6_4_p1'
	\| Simulate: using integration grids from file 'pythia6_4_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using PYTHIA6 shower
	\| Simulate: activating hadronization
	\| Hadronization: Using PYTHIA6 interface for hadronization and decays
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 5.8731E-02
	\| Events: writing to ASCII file 'pythia6_4b.debug'
	\| Events: writing to raw file 'pythia6_4b.evx'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 11.11 %
	\| Events: closing ASCII file 'pythia6_4b.debug'
	\| Events: closing raw file 'pythia6_4b.evx'
	\| There were no errors and 1 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Partial contents of pythia6_4a.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 1.26521E+29
	Squared matrix el. (prc) = 1.26521E+29
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 2
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 4.999990E+02
	T = 1.000000000E+00
	Children: 3 4
	Particle 2 [b] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -4.999990E+02
	T = 1.000000000E+00
	Children: 3 4
	Particle 3 [v] f(11)
	E = 4.889225E+02
	P = 0.000000E+00 0.000000E+00 4.889215E+02
	T = 1.000000000E+00
	Parents: 1 2
	Children: 5 7
	Particle 4 [v] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -4.999990E+02
	T = 1.000000000E+00
	Parents: 1 2
	Children: 6 8
	Particle 5 [i] f(11)
	E = 4.889225E+02
	P = 0.000000E+00 0.000000E+00 4.889215E+02
	T = 1.000000000E+00
	Parents: 3
	Children: 9 10
	Particle 6 [i] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -4.999990E+02
	T = 1.000000000E+00
	Parents: 4
	Children: 9 10
	Particle 7 [x] f(22*)
	E = 9.252542E-26
	P = 0.000000E+00 0.000000E+00 9.252542E-26
	T = 0.000000000E+00
	Parents: 3
	Particle 8 [x] f(22*)
	E = 3.005245E-06
	P = 0.000000E+00 0.000000E+00 -3.005245E-06
	T = 0.000000000E+00
	Parents: 4
	Particle 9 [o] f(23)
	E = 4.877064E+02
	P = 2.139297E+02 3.349488E+02 2.675548E+02
	T = 8.315287819E+03
	Parents: 5 6
	Particle 10 [o] f(25)
	E = 5.012161E+02
	P = -2.139297E+02 -3.349488E+02 -2.786323E+02
	T = 1.562500000E+04
	Parents: 5 6
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 3
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 500.000 0.000 0.000 499.999 1.000
	2 [b] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -499.999 1.000
	3 [r] e- 0 0 1-2 5,7 488.923 0.000 0.000 488.922 1.000
	4 [r] e+ 0 0 1-2 6,8 500.000 0.000 0.000 -499.999 1.000
	5 [i] e- 0 0 3 9-10 488.923 0.000 0.000 488.922 1.000
	6 [i] e+ 0 0 4 9-10 500.000 0.000 0.000 -499.999 1.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 0.000 0.000 0.000 -0.000 0.000
	9 [r] Z 0 0 5-6 11-12 487.706 213.930 334.949 267.555 8315.288
	10 [r] H 0 0 5-6 13-14 501.216 -213.930 -334.949 -278.632 15625.000
	11 [r] nue 0 0 9 15 208.602 57.609 171.247 104.262 0.000
	12 [r] nuebar 0 0 9 16 279.104 156.321 163.701 163.293 0.000
	13 [r] tau- 0 0 10 17 321.893 -111.678 -261.421 -150.992 3.158
	14 [r] tau+ 0 0 10 18-19 179.323 -102.252 -73.527 -127.640 3.158
	15 [o] nue 0 0 11 [none] 208.602 57.609 171.247 104.262 0.000
	16 [o] nuebar 0 0 12 [none] 279.104 156.321 163.701 163.293 0.000
	17 [r] tau- 0 0 13 20-22 321.887 -111.675 -261.417 -150.990 3.158
	18 [r] tau+ 0 0 14 23-24 179.286 -102.224 -73.513 -127.618 3.158
	19 [o] A 0 0 14 [none] 0.043 -0.030 -0.019 -0.024 0.000
	20 [o] numubar 0 0 17 [none] 14.550 -5.197 -11.824 -6.700 0.000
	21 [o] mu- 0 0 17 [none] 174.207 -59.699 -141.785 -81.737 0.011
	22 [o] nutau 0 0 17 [none] 133.130 -46.780 -107.807 -62.553 0.000
	23 [o] nutauba 0 0 18 [none] 3.537 -1.902 -1.305 -2.681 0.000
	24 [o] pip 0 0 18 [none] 175.749 -100.322 -72.207 -124.938 0.019
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 988.923 0.000 0.000 -11.077
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 988.923 0.000 0.000 -11.077
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.00000E+03
	sqrts_hat* => 9.88860E+02
	n_in* => 2
	n_out* => 10
	n_tot* => 12
	$process_id* => "pythia6_4_p1"
	process_num_id* => [unknown integer]
	sqme* => 1.26521E+29
	sqme_ref* => 1.26521E+29
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-4.9999900E+02\| 1.0000000E+00\| 1)
	2 prt(b:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 4.9999900E+02\| 1.0000000E+00\| 2)
	3 prt(i:11\|-4.8892252E+02; 0.0000000E+00, 0.0000000E+00,-4.8892150E+02\| 1.0000000E+00\| 3)
	4 prt(i:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 4.9999900E+02\| 1.0000000E+00\| 4)
	5 prt(o:22\| 0.0000000E+00; 0.0000000E+00, 0.0000000E+00, 0.0000000E+00\| 0.0000000E+00\| 5)
	6 prt(o:22\| 3.0052453E-06; 0.0000000E+00, 0.0000000E+00,-3.0052453E-06\| 0.0000000E+00\| 6)
	7 prt(o:12\| 2.0860226E+02; 5.7608662E+01, 1.7124734E+02, 1.0426165E+02\| 0.0000000E+00\| 7)
	8 prt(o:-12\| 2.7910413E+02; 1.5632108E+02, 1.6370148E+02, 1.6329317E+02\| 0.0000000E+00\| 8)
	9 prt(o:22\| 4.3097468E-02;-2.9784100E-02,-1.9454284E-02,-2.4327557E-02\| 0.0000000E+00\| 9)
	10 prt(o:-14\| 1.4550307E+01;-5.1972205E+00,-1.1824317E+01,-6.6996920E+00\| 0.0000000E+00\| 10)
	11 prt(o:13\| 1.7420667E+02;-5.9698720E+01,-1.4178523E+02,-8.1737160E+01\| 1.1164036E-02\| 11)
	12 prt(o:16\| 1.3312971E+02;-4.6779546E+01,-1.0780702E+02,-6.2552713E+01\| 0.0000000E+00\| 12)
	13 prt(o:-16\| 3.5370321E+00;-1.9024455E+00,-1.3054032E+00,-2.6808991E+00\| 0.0000000E+00\| 13)
	14 prt(o:211\| 1.7574931E+02;-1.0032203E+02,-7.2207396E+01,-1.2493752E+02\| 1.9479785E-02\| 14)
	========================================================================
	Partial contents of pythia6_4b.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 4.54035E+10
	Squared matrix el. (prc) = 4.54035E+10
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 6
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [b] f(11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 4.999990E+02
	T = 1.000000000E+00
	Children: 3 4
	Particle 2 [b] f(-11)
	E = 5.000000E+02
	P = 0.000000E+00 0.000000E+00 -4.999990E+02
	T = 1.000000000E+00
	Children: 3 4
	Particle 3 [v] f(11)
	E = 4.945513E+02
	P = 0.000000E+00 0.000000E+00 4.945503E+02
	T = 1.000000000E+00
	Parents: 1 2
	Children: 5 7
	Particle 4 [v] f(-11)
	E = 4.992909E+02
	P = 0.000000E+00 0.000000E+00 -4.992899E+02
	T = 1.000000000E+00
	Parents: 1 2
	Children: 6 8
	Particle 5 [i] f(11)
	E = 4.945513E+02
	P = 0.000000E+00 0.000000E+00 4.945503E+02
	T = 1.000000000E+00
	Parents: 3
	Children: 9 10
	Particle 6 [i] f(-11)
	E = 4.971980E+02
	P = 0.000000E+00 0.000000E+00 -4.971970E+02
	T = 1.000000000E+00
	Parents: 4
	Children: 9 10
	Particle 7 [x] f(22*)
	E = 2.008420E-12
	P = 0.000000E+00 0.000000E+00 2.008420E-12
	T = 0.000000000E+00
	Parents: 3
	Particle 8 [x] f(22*)
	E = 2.092899E+00
	P = 0.000000E+00 0.000000E+00 -2.092899E+00
	T = 0.000000000E+00
	Parents: 4
	Particle 9 [o] f(23)
	E = 4.923201E+02
	P = -2.803370E+02 -3.910834E+02 -5.028641E+01
	T = 8.315287819E+03
	Parents: 5 6
	Particle 10 [o] f(25)
	E = 4.994293E+02
	P = 2.803370E+02 3.910834E+02 4.763971E+01
	T = 1.562500000E+04
	Parents: 5 6
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 7
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 500.000 0.000 0.000 499.999 1.000
	2 [b] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -499.999 1.000
	3 [r] e- 0 0 1-2 5,7 494.551 0.000 0.000 494.550 1.000
	4 [r] e+ 0 0 1-2 6,8 499.291 0.000 0.000 -499.290 1.000
	5 [i] e- 0 0 3 9-10 494.551 0.000 0.000 494.550 1.000
	6 [i] e+ 0 0 4 9-10 497.198 0.000 0.000 -497.197 1.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 2.093 0.000 0.000 -2.093 0.000
	9 [r] Z 0 0 5-6 11-12 492.320 -280.337 -391.083 -50.286 8315.288
	10 [r] H 0 0 5-6 13-14 499.429 280.337 391.083 47.640 15625.000
	11 [r] d 500 0 9 23-28 374.023 -196.292 -318.217 -10.024 0.109
	12 [r] dbar 501 500 9 18-22,29-33 118.297 -84.045 -72.866 -40.262 0.109
	13 [r] tau- 0 0 10 15 380.189 242.186 292.946 -8.295 3.158
	14 [r] tau+ 0 0 10 16-17 119.240 38.151 98.137 55.935 3.158
	15 [r] tau- 0 0 13 34-35 380.189 242.186 292.946 -8.295 3.158
	16 [r] tau+ 0 0 14 36-38 119.177 38.131 98.085 55.905 3.158
	17 [o] A 0 0 14 [none] 0.063 0.020 0.052 0.030 0.000
	18 [o] dbar 502 501 12 [none] 36.571 -26.561 -20.362 -14.740 0.109
	19 [o] gl 503 502 12 [none] 16.471 -10.475 -11.514 -5.383 0.000
	20 [o] gl 504 503 12 [none] 38.088 -25.699 -25.008 -12.841 0.000
	21 [o] gl 505 504 12 [none] 5.932 -3.764 -4.247 -1.727 0.000
	22 [o] u 0 505 12 [none] 17.635 -11.855 -12.204 -4.626 0.109
	23 [o] d 506 0 11 [none] 260.325 -137.274 -221.069 -7.300 0.109
	24 [o] gl 507 506 11 [none] 61.400 -31.962 -52.411 -1.217 0.000
	25 [o] gl 508 507 11 [none] 13.328 -7.095 -11.282 -0.058 0.000
	26 [o] gl 509 508 11 [none] 4.456 -2.246 -3.848 0.030 0.000
	27 [o] gl 510 509 11 [none] 5.566 -2.710 -4.832 -0.532 0.000
	28 [o] gl 511 510 11 [none] 2.460 -1.216 -2.095 -0.428 0.000
	29 [o] gl 512 511 12 [none] 5.823 -2.817 -5.096 -0.051 0.000
	30 [o] gl 513 512 12 [none] 1.176 -0.897 -0.692 -0.319 0.000
	31 [o] gl 514 513 12 [none] 12.096 -8.230 -8.792 1.136 0.000
	32 [o] gl 515 514 12 [none] 0.463 -0.280 -0.269 -0.253 0.000
	33 [o] ubar 0 515 12 [none] 10.530 -7.257 -7.362 -1.977 0.109
	34 [o] nutau 0 0 15 [none] 241.142 154.242 185.294 -5.018 0.000
	35 [o] pim 0 0 15 [none] 139.047 87.944 107.652 -3.277 0.019
	36 [o] nue 0 0 16 [none] 74.912 24.100 61.661 35.056 0.000
	37 [o] e+ 0 0 16 [none] 7.721 2.726 6.401 3.348 0.000
	38 [o] nutauba 0 0 16 [none] 36.544 11.304 30.024 17.501 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 991.749 0.000 0.000 -2.647
	Sum of beam remnant momenta: p(0:3) = 2.093 0.000 0.000 -2.093
	Sum of outgoing momenta: p(0:3) = 991.749 0.000 0.000 -2.647
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	========================================================================
	Event transform: hadronization
	------------------------------------------------------------------------
	Associated process: 'pythia6_4_p1'
	TAO random-number generator:
	seed = 9
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [b] e- 0 0 [none] 3-4 500.000 0.000 0.000 499.999 1.000
	2 [b] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -499.999 1.000
	3 [r] e- 0 0 1-2 5,7 494.551 0.000 0.000 494.550 1.000
	4 [r] e+ 0 0 1-2 6,8 499.291 0.000 0.000 -499.290 1.000
	5 [i] e- 0 0 3 9-10 494.551 0.000 0.000 494.550 1.000
	6 [i] e+ 0 0 4 9-10 497.198 0.000 0.000 -497.197 1.000
	7 [x] A 0 0 3 [none] 0.000 0.000 0.000 0.000 0.000
	8 [x] A 0 0 4 [none] 2.093 0.000 0.000 -2.093 0.000
	9 [r] Z 0 0 5-6 11-12 492.320 -280.337 -391.083 -50.286 8315.288
	10 [r] H 0 0 5-6 13-14 499.429 280.337 391.083 47.640 15625.000
	11 [r] d 500 0 9 23-28 374.023 -196.292 -318.217 -10.024 0.109
	12 [r] dbar 501 500 9 18-22,29-33 118.297 -84.045 -72.866 -40.262 0.109
	13 [r] tau- 0 0 10 15 380.189 242.186 292.946 -8.295 3.158
	14 [r] tau+ 0 0 10 16-17 119.240 38.151 98.137 55.935 3.158
	15 [r] tau- 0 0 13 34-35 380.189 242.186 292.946 -8.295 3.158
	16 [r] tau+ 0 0 14 36-38 119.177 38.131 98.085 55.905 3.158
	17 [o] A 0 0 14 [none] 0.063 0.020 0.052 0.030 0.000
	18 [r] dbar 502 501 12 39 36.571 -26.561 -20.362 -14.740 0.109
	19 [r] gl 503 502 12 39 16.471 -10.475 -11.514 -5.383 0.000
	20 [r] gl 504 503 12 39 38.088 -25.699 -25.008 -12.841 0.000
	21 [r] gl 505 504 12 39 5.932 -3.764 -4.247 -1.727 0.000
	22 [r] u 0 505 12 39 17.635 -11.855 -12.204 -4.626 0.109
	23 [r] d 506 0 11 47 260.325 -137.274 -221.069 -7.300 0.109
	24 [r] gl 507 506 11 47 61.400 -31.962 -52.411 -1.217 0.000
	25 [r] gl 508 507 11 47 13.328 -7.095 -11.282 -0.058 0.000
	26 [r] gl 509 508 11 47 4.456 -2.246 -3.848 0.030 0.000
	27 [r] gl 510 509 11 47 5.566 -2.710 -4.832 -0.532 0.000
	28 [r] gl 511 510 11 47 2.460 -1.216 -2.095 -0.428 0.000
	29 [r] gl 512 511 12 47 5.823 -2.817 -5.096 -0.051 0.000
	30 [r] gl 513 512 12 47 1.176 -0.897 -0.692 -0.319 0.000
	31 [r] gl 514 513 12 47 12.096 -8.230 -8.792 1.136 0.000
	32 [r] gl 515 514 12 47 0.463 -0.280 -0.269 -0.253 0.000
	33 [r] ubar 0 515 12 47 10.530 -7.257 -7.362 -1.977 0.109
	34 [o] nutau 0 0 15 [none] 241.142 154.242 185.294 -5.018 0.000
	35 [o] pim 0 0 15 [none] 139.047 87.944 107.652 -3.277 0.019
	36 [o] nue 0 0 16 [none] 74.912 24.100 61.661 35.056 0.000
	37 [o] e+ 0 0 16 [none] 7.721 2.726 6.401 3.348 0.000
	38 [o] nutauba 0 0 16 [none] 36.544 11.304 30.024 17.501 0.000
	39 [r] hr3 0 0 18-22 40-46 114.698 -78.354 -73.336 -39.318 92.230
	40 [r] etaprim 0 0 39 57-59 18.165 -12.914 -10.923 -6.556 0.918
	41 [r] rho0 0 0 39 60-61 9.870 -6.845 -5.467 -4.461 0.770
	42 [o] pip 0 0 39 [none] 20.644 -14.648 -12.293 -7.776 0.019
	43 [r] rhom 0 0 39 62-63 9.208 -6.164 -6.099 -3.015 0.503
	44 [r] rhop 0 0 39 64-65 16.232 -10.640 -11.053 -5.261 0.426
	45 [r] rho0 0 0 39 66-67 10.824 -7.415 -7.110 -3.328 0.544
	46 [r] rho0 0 0 39 68-69 29.755 -19.728 -20.392 -8.920 0.802
	47 [r] hr3 0 0 23-33 48-56 377.622 -201.983 -317.748 -10.969 717.598
	48 [r] rhom 0 0 47 70-71 118.200 -62.025 -100.559 -3.379 0.713
	49 [o] pip 0 0 47 [none] 125.710 -67.003 -106.320 -3.098 0.019
	50 [r] rhom 0 0 47 72-73 84.528 -43.077 -72.700 -1.833 0.668
	51 [o] p 0 0 47 [none] 9.534 -5.556 -7.668 -0.601 0.880
	52 [r] rhom 0 0 47 74-75 7.325 -4.282 -5.883 -0.101 0.708
	53 [r] Deltaba 0 0 47 76-77 12.660 -6.637 -10.711 -0.408 1.331
	54 [r] rhop 0 0 47 78-79 9.098 -5.994 -6.778 0.473 0.680
	55 [o] pim 0 0 47 [none] 0.319 -0.155 -0.202 -0.131 0.019
	56 [r] rho0 0 0 47 80-81 10.248 -7.255 -6.927 -1.890 0.839
	57 [r] pi0 0 0 40 82-83 7.669 -5.456 -4.583 -2.834 0.018
	58 [r] pi0 0 0 40 84-85 2.486 -1.801 -1.493 -0.827 0.018
	59 [r] eta 0 0 40 86-88 8.010 -5.657 -4.846 -2.894 0.300
	60 [o] pip 0 0 41 [none] 6.231 -4.442 -3.140 -3.036 0.019
	61 [o] pim 0 0 41 [none] 3.638 -2.404 -2.327 -1.424 0.019
	62 [o] pim 0 0 43 [none] 4.729 -3.012 -3.370 -1.385 0.019
	63 [r] pi0 0 0 43 89-90 4.479 -3.152 -2.729 -1.630 0.018
	64 [o] pip 0 0 44 [none] 6.374 -3.987 -4.547 -2.008 0.019
	65 [r] pi0 0 0 44 91-92 9.858 -6.653 -6.506 -3.253 0.018
	66 [o] pim 0 0 45 [none] 9.214 -6.282 -6.009 -3.049 0.019
	67 [o] pip 0 0 45 [none] 1.610 -1.133 -1.101 -0.279 0.019
	68 [o] pim 0 0 46 [none] 24.467 -16.435 -16.664 -7.130 0.019
	69 [o] pip 0 0 46 [none] 5.288 -3.294 -3.728 -1.790 0.019
	70 [o] pim 0 0 48 [none] 52.847 -27.776 -44.945 -1.117 0.019
	71 [r] pi0 0 0 48 93-94 65.353 -34.249 -55.614 -2.262 0.018
	72 [o] pim 0 0 50 [none] 69.153 -35.283 -59.448 -1.780 0.019
	73 [r] pi0 0 0 50 95-96 15.375 -7.794 -13.252 -0.053 0.018
	74 [o] pim 0 0 52 [none] 6.557 -3.744 -5.380 0.074 0.019
	75 [r] pi0 0 0 52 97-98 0.769 -0.538 -0.503 -0.175 0.018
	76 [o] nbar 0 0 53 [none] 10.086 -5.187 -8.595 -0.238 0.883
	77 [r] pi0 0 0 53 99-100 2.574 -1.450 -2.116 -0.170 0.018
	78 [o] pip 0 0 54 [none] 2.469 -1.471 -1.973 -0.142 0.019
	79 [r] pi0 0 0 54 101-102 6.629 -4.524 -4.805 0.615 0.018
	80 [o] pip 0 0 56 [none] 5.139 -3.931 -3.154 -0.992 0.019
	81 [o] pim 0 0 56 [none] 5.109 -3.323 -3.773 -0.898 0.019
	82 [o] A 0 0 57 [none] 6.482 -4.645 -3.839 -2.388 0.000
	83 [o] A 0 0 57 [none] 1.187 -0.811 -0.744 -0.446 0.000
	84 [o] A 0 0 58 [none] 2.137 -1.582 -1.252 -0.705 0.000
	85 [o] A 0 0 58 [none] 0.348 -0.219 -0.242 -0.122 0.000
	86 [r] pi0 0 0 59 103-104 2.957 -2.059 -1.770 -1.164 0.018
	87 [r] pi0 0 0 59 105-106 2.502 -1.854 -1.487 -0.769 0.018
	88 [r] pi0 0 0 59 107-108 2.551 -1.744 -1.589 -0.962 0.018
	89 [o] A 0 0 63 [none] 0.128 -0.104 -0.061 -0.044 0.000
	90 [o] A 0 0 63 [none] 4.351 -3.048 -2.669 -1.586 0.000
	91 [o] A 0 0 65 [none] 4.368 -2.899 -2.928 -1.449 0.000
	92 [o] A 0 0 65 [none] 5.491 -3.754 -3.578 -1.804 0.000
	93 [o] A 0 0 71 [none] 47.378 -24.780 -40.349 -1.626 0.000
	94 [o] A 0 0 71 [none] 17.975 -9.469 -15.265 -0.637 0.000
	95 [o] A 0 0 73 [none] 2.167 -1.132 -1.847 -0.033 0.000
	96 [o] A 0 0 73 [none] 13.208 -6.662 -11.405 -0.020 0.000
	97 [o] A 0 0 75 [none] 0.739 -0.514 -0.496 -0.191 0.000
	98 [o] A 0 0 75 [none] 0.029 -0.023 -0.007 0.016 0.000
	99 [o] A 0 0 77 [none] 0.075 -0.058 -0.046 -0.000 0.000
	100 [o] A 0 0 77 [none] 2.500 -1.392 -2.069 -0.170 0.000
	101 [o] A 0 0 79 [none] 2.041 -1.367 -1.497 0.243 0.000
	102 [o] A 0 0 79 [none] 4.588 -3.157 -3.308 0.372 0.000
	103 [o] A 0 0 86 [none] 1.839 -1.250 -1.099 -0.782 0.000
	104 [o] A 0 0 86 [none] 1.118 -0.809 -0.671 -0.382 0.000
	105 [o] A 0 0 87 [none] 0.128 -0.074 -0.086 -0.058 0.000
	106 [o] A 0 0 87 [none] 2.374 -1.780 -1.401 -0.711 0.000
	107 [o] A 0 0 88 [none] 1.544 -1.031 -1.011 -0.546 0.000
	108 [o] A 0 0 88 [none] 1.007 -0.713 -0.577 -0.415 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 991.749 0.000 0.000 -2.647
	Sum of beam remnant momenta: p(0:3) = 2.093 0.000 0.000 -2.093
	Sum of outgoing momenta: p(0:3) = 991.749 0.000 0.000 -2.647
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	------------------------------------------------------------------------
	Hadronization settings:
	------------------------------------------------------------------------
	Master switches:
	active = T
	General settings:
	hadron_method = PYTHIA6
	pT generation parameters
	enhanced_fraction = 1.000000000000E-02
	enhanced_width = 2.000000000000E+00
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 1.00000E+03
	sqrts_hat* => 9.91746E+02
	n_in* => 2
	n_out* => 51
	n_tot* => 53
	$process_id* => "pythia6_4_p1"
	process_num_id* => [unknown integer]
	sqme* => 4.54035E+10
	sqme_ref* => 4.54035E+10
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(b:11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00,-4.9999900E+02\| 1.0000000E+00\| 1)
	2 prt(b:-11\|-5.0000000E+02; 0.0000000E+00, 0.0000000E+00, 4.9999900E+02\| 1.0000000E+00\| 2)
	3 prt(i:11\|-4.9455132E+02; 0.0000000E+00, 0.0000000E+00,-4.9455031E+02\| 1.0000000E+00\| 3)
	4 prt(i:-11\|-4.9719802E+02; 0.0000000E+00, 0.0000000E+00, 4.9719701E+02\| 1.0000000E+00\| 4)
	5 prt(o:22\| 2.0084199E-12; 0.0000000E+00, 0.0000000E+00, 2.0084199E-12\| 0.0000000E+00\| 5)
	6 prt(o:22\| 2.0928994E+00; 0.0000000E+00, 0.0000000E+00,-2.0928994E+00\| 0.0000000E+00\| 6)
	7 prt(o:22\| 6.2996019E-02; 1.9868673E-02, 5.1829525E-02, 2.9789839E-02\| 0.0000000E+00\| 7)
	8 prt(o:16\| 2.4114220E+02; 1.5424193E+02, 1.8529384E+02,-5.0179665E+00\| 0.0000000E+00\| 8)
	9 prt(o:-211\| 1.3904668E+02; 8.7944221E+01, 1.0765237E+02,-3.2772597E+00\| 1.9479785E-02\| 9)
	10 prt(o:12\| 7.4912017E+01; 2.4100200E+01, 6.1660959E+01, 3.5055909E+01\| 0.0000000E+00\| 10)
	11 prt(o:-11\| 7.7210551E+00; 2.7263870E+00, 6.4007931E+00, 3.3483358E+00\| 0.0000000E+00\| 11)
	12 prt(o:-16\| 3.6544316E+01; 1.1304376E+01, 3.0023603E+01, 1.7500896E+01\| 0.0000000E+00\| 12)
	13 prt(o:211\| 2.0644159E+01;-1.4648087E+01,-1.2293178E+01,-7.7764478E+00\| 1.9479785E-02\| 13)
	14 prt(o:211\| 1.2571043E+02;-6.7003344E+01,-1.0632049E+02,-3.0980170E+00\| 1.9479785E-02\| 14)
	15 prt(o:2212\| 9.5344372E+00;-5.5555999E+00,-7.6680459E+00,-6.0126917E-01\| 8.8035059E-01\| 15)
	16 prt(o:-211\| 3.1898831E-01;-1.5518975E-01,-2.0228455E-01,-1.3141864E-01\| 1.9479785E-02\| 16)
	17 prt(o:211\| 6.2312413E+00;-4.4416173E+00,-3.1402004E+00,-3.0364560E+00\| 1.9479785E-02\| 17)
	18 prt(o:-211\| 3.6384820E+00;-2.4037337E+00,-2.3265436E+00,-1.4241946E+00\| 1.9479785E-02\| 18)
	19 prt(o:-211\| 4.7288809E+00;-3.0115332E+00,-3.3697278E+00,-1.3850768E+00\| 1.9479785E-02\| 19)
	20 prt(o:211\| 6.3739070E+00;-3.9871513E+00,-4.5470784E+00,-2.0084605E+00\| 1.9479785E-02\| 20)
	21 prt(o:-211\| 9.2136890E+00;-6.2821587E+00,-6.0090580E+00,-3.0493097E+00\| 1.9479785E-02\| 21)
	22 prt(o:211\| 1.6100262E+00;-1.1325750E+00,-1.1009611E+00,-2.7903964E-01\| 1.9479785E-02\| 22)
	23 prt(o:-211\| 2.4467194E+01;-1.6434547E+01,-1.6663933E+01,-7.1304343E+00\| 1.9479785E-02\| 23)
	24 prt(o:211\| 5.2882159E+00;-3.2936018E+00,-3.7275915E+00,-1.7896915E+00\| 1.9479785E-02\| 24)
	25 prt(o:-211\| 5.2846967E+01;-2.7775843E+01,-4.4944827E+01,-1.1169403E+00\| 1.9479785E-02\| 25)
	26 prt(o:-211\| 6.9152668E+01;-3.5282671E+01,-5.9447764E+01,-1.7800181E+00\| 1.9479785E-02\| 26)
	27 prt(o:-211\| 6.5567386E+00;-3.7439124E+00,-5.3804239E+00, 7.4163262E-02\| 1.9479785E-02\| 27)
	28 prt(o:-2112\| 1.0085563E+01;-5.1868910E+00,-8.5950822E+00,-2.3770517E-01\| 8.8279178E-01\| 28)
	29 prt(o:211\| 2.4688578E+00;-1.4707604E+00,-1.9729420E+00,-1.4192569E-01\| 1.9479785E-02\| 29)
	30 prt(o:211\| 5.1385865E+00;-3.9313622E+00,-3.1537985E+00,-9.9173497E-01\| 1.9479785E-02\| 30)
	31 prt(o:-211\| 5.1094865E+00;-3.3233694E+00,-3.7730939E+00,-8.9797065E-01\| 1.9479785E-02\| 31)
	32 prt(o:22\| 6.4821375E+00;-4.6450513E+00,-3.8392662E+00,-2.3878110E+00\| 0.0000000E+00\| 32)
	33 prt(o:22\| 1.1871863E+00;-8.1060111E-01,-7.4371073E-01,-4.4635343E-01\| 0.0000000E+00\| 33)
	34 prt(o:22\| 2.1372792E+00;-1.5821990E+00,-1.2518403E+00,-7.0534009E-01\| 0.0000000E+00\| 34)
	35 prt(o:22\| 3.4825246E-01;-2.1906237E-01,-2.4160006E-01,-1.2215100E-01\| 0.0000000E+00\| 35)
	36 prt(o:22\| 1.2824962E-01;-1.0412488E-01,-6.0629540E-02,-4.3932128E-02\| 0.0000000E+00\| 36)
	37 prt(o:22\| 4.3506375E+00;-3.0480555E+00,-2.6686784E+00,-1.5860517E+00\| 0.0000000E+00\| 37)
	38 prt(o:22\| 4.3675043E+00;-2.8988566E+00,-2.9277423E+00,-1.4491545E+00\| 0.0000000E+00\| 38)
	39 prt(o:22\| 5.4905752E+00;-3.7539534E+00,-3.5779117E+00,-1.8035517E+00\| 0.0000000E+00\| 39)
	40 prt(o:22\| 4.7378392E+01;-2.4779587E+01,-4.0348998E+01,-1.6255630E+00\| 0.0000000E+00\| 40)
	41 prt(o:22\| 1.7974712E+01;-9.4693107E+00,-1.5264890E+01,-6.3683211E-01\| 0.0000000E+00\| 41)
	42 prt(o:22\| 2.1670759E+00;-1.1322390E+00,-1.8474722E+00,-3.3154655E-02\| 0.0000000E+00\| 42)
	43 prt(o:22\| 1.3207854E+01;-6.6619686E+00,-1.1404612E+01,-2.0141483E-02\| 0.0000000E+00\| 43)
	44 prt(o:22\| 7.3949085E-01;-5.1441214E-01,-4.9556064E-01,-1.9143279E-01\| 0.0000000E+00\| 44)
	45 prt(o:22\| 2.9204808E-02;-2.3444927E-02,-7.0173934E-03, 1.5937766E-02\| 0.0000000E+00\| 45)
	46 prt(o:22\| 7.4525013E-02;-5.8329151E-02,-4.6386251E-02,-5.8543561E-05\| 0.0000000E+00\| 46)
	47 prt(o:22\| 2.4995209E+00;-1.3915127E+00,-2.0693916E+00,-1.7004583E-01\| 0.0000000E+00\| 47)
	48 prt(o:22\| 2.0413455E+00;-1.3665287E+00,-1.4968464E+00, 2.4319067E-01\| 0.0000000E+00\| 48)
	49 prt(o:22\| 4.5876382E+00;-3.1570328E+00,-3.3077247E+00, 3.7219008E-01\| 0.0000000E+00\| 49)
	50 prt(o:22\| 1.8388047E+00;-1.2501496E+00,-1.0987650E+00,-7.8169331E-01\| 0.0000000E+00\| 50)
	51 prt(o:22\| 1.1183798E+00;-8.0874830E-01,-6.7139727E-01,-3.8200155E-01\| 0.0000000E+00\| 51)
	52 prt(o:22\| 1.2812538E-01;-7.4449446E-02,-8.6427349E-02,-5.8341287E-02\| 0.0000000E+00\| 52)
	53 prt(o:22\| 2.3738024E+00;-1.7796952E+00,-1.4009813E+00,-7.1054487E-01\| 0.0000000E+00\| 53)
	54 prt(o:22\| 1.5437562E+00;-1.0308430E+00,-1.0110789E+00,-5.4613664E-01\| 0.0000000E+00\| 54)
	55 prt(o:22\| 1.0071106E+00;-7.1287991E-01,-5.7744415E-01,-4.1549029E-01\| 0.0000000E+00\| 55)
	========================================================================
	Index: trunk/share/tests/functional_tests/ref-output-ext/powheg_1.ref
	===================================================================
	--- trunk/share/tests/functional_tests/ref-output-ext/powheg_1.ref (revision 8189)
	+++ trunk/share/tests/functional_tests/ref-output-ext/powheg_1.ref (revision 8190)
	@@ -1,718 +1,730 @@
	?openmp_logging = false
	?vis_history = false
	?integration_timer = false
	openmp_num_threads = 1
	?pacify = true
	seed = 0
	SM.wtop => 0.00000E+00
	SM.mtop => 1.75000E+02
	?use_vamp_equivalences = false
	$loop_me_method = "dummy"
	?alphas_is_fixed = false
	?alphas_from_mz = true
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = true
	?powheg_matching = true
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_grid_sampling_points = 1000
	powheg_pt_min = 1.00000E+00
	?powheg_use_singular_jacobian = false
	\| Process library 'powheg_1_lib': recorded process 'powheg_1_p1'
	sqrts = 5.00000E+02
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_1_lib': compiling ...
	\| Process library 'powheg_1_lib': writing makefile
	\| Process library 'powheg_1_lib': removing old files
	\| Process library 'powheg_1_lib': writing driver
	\| Process library 'powheg_1_lib': creating source code
	\| Process library 'powheg_1_lib': compiling sources
	\| Process library 'powheg_1_lib': linking
	\| Process library 'powheg_1_lib': loading
	\| Process library 'powheg_1_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 0
	\| Initializing integration for process powheg_1_p1:
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e+ (mass = 5.1099700E-04 GeV)
	\| e- (mass = 5.1099700E-04 GeV)
	\| sqrts = 5.000000000000E+02 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p1.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p1.i3.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_1_p1'
	\| Library name = 'powheg_1_lib'
	\| Process index = 1
	\| Process components:
	\| 1: 'powheg_1_p1_i1': e+, e- => t, tbar [omega]
	\| 2: 'powheg_1_p1_i2': e+, e- => t, tbar, gl [omega], [real]
	\| 3: 'powheg_1_p1_i3': e+, e- => t, tbar [dummy], [virtual]
	\| 4: 'powheg_1_p1_i4': e+, e- => t, tbar [inactive], [subtraction]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| Using user-defined general scale.
	\| Starting integration for process 'powheg_1_p1'
	\| Integration hook: add POWHEG hook
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 1 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.673E+02 2.15E+01 4.60 0.46 45.8
	\|-----------------------------------------------------------------------------\|
	1 100 4.673E+02 2.15E+01 4.60 0.46 45.8
	\|=============================================================================\|
	n_events = 1
	?debug_decay = false
	?debug_process = false
	?debug_verbose = false
	?sample_pacify = true
	?write_raw = false
	\| Starting simulation for process 'powheg_1_p1'
	\| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 1
	\| Simulation: requested number of events = 1
	\| corr. to luminosity [fb-1] = 2.1397E-03
	\| Events: writing to ASCII file 'powheg_1_p1.debug'
	\| Events: generating 1 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p1_1000.pg'
	\| Grid: Mean value of the grid: 1.663322016E-02
	\| Grid: Max value of the grid: 3.908545008E-02
	\| Grid: Mean/Max value of the grid: 4.255604101E-01
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 20.00 %
	\| Events: closing ASCII file 'powheg_1_p1.debug'
	n_events = 2
	\| Starting simulation for process 'powheg_1_p1'
	\| Simulate: using integration grids from file 'powheg_1_p1.m1.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 2
	\| Simulation: requested number of events = 2
	\| corr. to luminosity [fb-1] = 4.2795E-03
	\| Events: writing to ASCII file 'powheg_1_p1.debug'
	\| Events: generating 2 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p1_1000.pg'
	\| Grid: Mean value of the grid: 1.663322016E-02
	\| Grid: Max value of the grid: 3.908545008E-02
	\| Grid: Mean/Max value of the grid: 4.255604101E-01
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 100.00 %
	\| Events: closing ASCII file 'powheg_1_p1.debug'
	?nlo_use_real_partition = true
	real_partition_scale = 5.00000E+00
	\| Process library 'powheg_1_lib': unloading
	\| Process library 'powheg_1_lib': open
	\| Process library 'powheg_1_lib': recorded process 'powheg_1_p2'
	\| Integrate: current process library needs compilation
	\| Process library 'powheg_1_lib': compiling ...
	\| Process library 'powheg_1_lib': writing makefile
	\| Process library 'powheg_1_lib': removing old files
	\| Process library 'powheg_1_lib': writing driver
	\| Process library 'powheg_1_lib': creating source code
	\| Process library 'powheg_1_lib': compiling sources
	\| Process library 'powheg_1_lib': linking
	\| Process library 'powheg_1_lib': loading
	\| Process library 'powheg_1_lib': ... success.
	\| Integrate: compilation done
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 3
	\| Initializing integration for process powheg_1_p2:
	\| Beam structure: [any particles]
	\| Beam data (collision):
	\| e+ (mass = 5.1099700E-04 GeV)
	\| e- (mass = 5.1099700E-04 GeV)
	\| sqrts = 5.000000000000E+02 GeV
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p2.i1.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p2.i3.phs'
	\| Phase space: generating configuration ...
	\| Phase space: ... success.
	\| Phase space: writing configuration file 'powheg_1_p2.i5.phs'
	\| ------------------------------------------------------------------------
	\| Process [scattering]: 'powheg_1_p2'
	\| Library name = 'powheg_1_lib'
	\| Process index = 2
	\| Process components:
	\| 1: 'powheg_1_p2_i1': e+, e- => t, tbar [omega]
	\| 2: 'powheg_1_p2_i2': e+, e- => t, tbar, gl [omega], [real]
	\| 3: 'powheg_1_p2_i3': e+, e- => t, tbar [dummy], [virtual]
	\| 4: 'powheg_1_p2_i4': e+, e- => t, tbar [inactive], [subtraction]
	\| 5: 'powheg_1_p2_i5': e+, e- => t, tbar, gl [omega], [real]
	\| ------------------------------------------------------------------------
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 1 channels, 5 dimensions
	\| Phase space: found 1 channel, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	\| Phase space: 2 channels, 5 dimensions
	\| Phase space: found 2 channels, collected in 1 grove.
	\| Phase space: no equivalences between channels used.
	\| Phase space: wood
	Warning: No cuts have been defined.
	\| Using user-defined general scale.
	\| Integration hook: add POWHEG hook
	\| Starting integration for process 'powheg_1_p2' part 'Combined'
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 1 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
	\|-----------------------------------------------------------------------------\|
	1 100 4.056E+02 2.49E+01 6.15 0.62 40.9
	\|=============================================================================\|
	\| Starting integration for process 'powheg_1_p2' part 'real'
	\| Integrate: iterations = 1:100:"gw"
	\| Integrator: 1 chains, 2 channels, 5 dimensions
	\| Integrator: 100 initial calls, 20 bins, stratified = T
	\| Integrator: VAMP
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
	\|-----------------------------------------------------------------------------\|
	1 100 9.223E+01 1.48E+01 16.09 1.61 15.3
	\|=============================================================================\|
	\| Integrate: sum of all components
	\|=============================================================================\|
	\| It Calls Integral[fb] Error[fb] Err[%] Acc Eff[%] Chi2 N[It] \|
	\|=============================================================================\|
	1 0 4.978E+02 2.90E+01 5.83 0.00 31.2
	\| NLO Correction: [O(alpha_s+1)/O(alpha_s)]
	\| ( 0.0000 +- 0.00000 ) %
	\|=============================================================================\|
	tolerance = 1.08355E+02
	\| expect: success
	\| Starting simulation for process 'powheg_1_p2'
	\| Simulate: using integration grids from file 'powheg_1_p2.m1.vg'
	\| Simulate: using integration grids from file 'powheg_1_p2.m2.vg'
	\| Simulate: activating parton shower
	\| Shower: Using WHIZARD internal shower
	\| Simulate: applying POWHEG matching
	\| QCD alpha: using a running strong coupling
	\| RNG: Initializing TAO random-number generator
	\| RNG: Setting seed for random-number generator to 4
	\| Simulation: requested number of events = 2
	\| corr. to luminosity [fb-1] = 4.0177E-03
	\| Events: writing to ASCII file 'powheg_1_p2.debug'
	\| Events: generating 2 unweighted, unpolarized events ...
	\| Events: event normalization mode '1'
	\| POWHEG: using grids from file 'powheg_1_p2_1000.pg'
	\| Grid: Mean value of the grid: 1.508219499E-03
	\| Grid: Max value of the grid: 1.844004544E-02
	\| Grid: Mean/Max value of the grid: 8.179044371E-02
	\| ... event sample complete.
	\| Events: actual unweighting efficiency = 20.00 %
	\| Events: closing ASCII file 'powheg_1_p2.debug'
	\| Summary of value checks:
	\| Failures: 0 / Total: 1
	\| There were no errors and 2 warning(s).
	\| WHIZARD run finished.
	\|=============================================================================\|
	Contents of powheg_1_p1.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.80466E-02
	Squared matrix el. (prc) = 2.80466E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 9.608533E+01 -1.236770E+02 -8.571236E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -9.608533E+01 1.236770E+02 8.571236E+01
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 8
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [v] t 1 0 1-2 5-7 250.000 96.085 -123.677 -85.712 30625.000
	4 [v] tbar 0 1 1-2 5-7 250.000 -96.085 123.677 85.712 30625.000
	5 [o] t 2 0 3-4 [none] 160.932 104.618 -121.732 11.639 30625.000
	6 [o] tbar 0 1 3-4 [none] 244.520 -91.910 118.303 81.988 30625.000
	7 [o] gl 1 2 3-4 [none] 94.548 -12.708 3.430 -93.627 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 3
	n_tot* => 5
	$process_id* => "powheg_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.80466E-02
	sqme_ref* => 2.80466E-02
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 1.6093234E+02; 1.0461835E+02,-1.2173226E+02, 1.1639310E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.4451983E+02;-9.1909962E+01, 1.1830264E+02, 8.1987752E+01\| 3.0625000E+04\| 4)
	5 prt(o:21\| 9.4547831E+01;-1.2708391E+01, 3.4296182E+00,-9.3627062E+01\| 0.0000000E+00\| 5)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 2.76791E-02
	Squared matrix el. (prc) = 2.76791E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 7
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 1.688666E+02 3.093682E+01 -4.901007E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -1.688666E+02 -3.093682E+01 4.901007E+01
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p1'
	TAO random-number generator:
	seed = 8
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 250.000 168.867 30.937 -49.010 30625.000
	4 [o] tbar 0 1 1-2 [none] 250.000 -168.867 -30.937 49.010 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p1"
	process_num_id* => [unknown integer]
	sqme* => 2.76791E-02
	sqme_ref* => 2.76791E-02
	event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.5000000E+02; 1.6886659E+02, 3.0936816E+01,-4.9010068E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.5000000E+02;-1.6886659E+02,-3.0936816E+01, 4.9010068E+01\| 3.0625000E+04\| 4)
	========================================================================
	Contents of powheg_1_p2.debug:
	========================================================================
	Event #1
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 1.41607E-05
	Squared matrix el. (prc) = 1.41607E-05
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 2
	Selected term = 6
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	seed = 196611
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4 5
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4 5
	Particle 3 [o] f(6)c(1 )
	E = 2.219832E+02
	P = -7.125693E+01 -1.137429E+02 -2.522963E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-2 )
	E = 2.128305E+02
	P = 1.983915E+01 1.013308E+02 6.332695E+01
	T = 3.062500000E+04
	Parents: 1 2
	Particle 5 [o] f(21)c(2 -1)
	E = 6.518630E+01
	P = 5.141778E+01 1.241207E+01 -3.809732E+01
	T = 0.000000000E+00
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	seed = 196612
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-5 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-5 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 221.983 -71.257 -113.743 -25.230 30625.000
	4 [o] tbar 0 2 1-2 [none] 212.831 19.839 101.331 63.327 30625.000
	5 [o] gl 2 1 1-2 [none] 65.186 51.418 12.412 -38.097 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 3
	n_tot* => 5
	$process_id* => "powheg_1_p2"
	process_num_id* => [unknown integer]
	sqme* => 1.41607E-05
	sqme_ref* => 1.41607E-05
	event_index* => 1
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.2198318E+02;-7.1256929E+01,-1.1374290E+02,-2.5229632E+01\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.1283052E+02; 1.9839145E+01, 1.0133083E+02, 6.3326954E+01\| 3.0625000E+04\| 4)
	5 prt(o:21\| 6.5186300E+01; 5.1417783E+01, 1.2412066E+01,-3.8097321E+01\| 0.0000000E+00\| 5)
	========================================================================
	========================================================================
	Event #2
	------------------------------------------------------------------------
	Unweighted = T
	Normalization = '1'
	Helicity handling = drop
	Keep correlations = F
	------------------------------------------------------------------------
	Squared matrix el. (ref) = 3.51646E-02
	Squared matrix el. (prc) = 3.51646E-02
	Event weight (ref) = 1.00000E+00
	Event weight (prc) = 1.00000E+00
	------------------------------------------------------------------------
	Selected MCI group = 1
	Selected term = 1
	Selected channel = 1
	------------------------------------------------------------------------
	Passed selection = T
	Reweighting factor = 1.00000E+00
	Analysis flag = T
	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	seed = 196611
	calls = 6
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(-11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 2 [i] f(11)
	E = 2.500000E+02
	P = 0.000000E+00 0.000000E+00 -2.500000E+02
	T = 2.611179340E-07
	Children: 3 4
	Particle 3 [o] f(6)c(1 )
	E = 2.500000E+02
	P = 1.143154E+02 2.823158E+00 -1.371095E+02
	T = 3.062500000E+04
	Parents: 1 2
	Particle 4 [o] f(-6)c(-1 )
	E = 2.500000E+02
	P = -1.143154E+02 -2.823158E+00 1.371095E+02
	T = 3.062500000E+04
	Parents: 1 2
	========================================================================
	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'powheg_1_p2'
	TAO random-number generator:
	seed = 196612
	calls = 2
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e+ 0 0 [none] 3-4 250.000 0.000 0.000 250.000 0.000
	2 [i] e- 0 0 [none] 3-4 250.000 0.000 0.000 -250.000 0.000
	3 [o] t 1 0 1-2 [none] 250.000 114.315 2.823 -137.110 30625.000
	4 [o] tbar 0 1 1-2 [none] 250.000 -114.315 -2.823 137.110 30625.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 500.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 500.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================
	Local variables:
	------------------------------------------------------------------------
	sqrts* = 5.00000E+02
	sqrts_hat* => 5.00000E+02
	n_in* => 2
	n_out* => 2
	n_tot* => 4
	$process_id* => "powheg_1_p2"
	process_num_id* => [unknown integer]
	sqme* => 3.51646E-02
	sqme_ref* => 3.51646E-02
	event_index* => 2
	event_weight* => 1.00000E+00
	event_weight_ref* => 1.00000E+00
	event_excess* => 0.00000E+00
	------------------------------------------------------------------------
	subevent:
	1 prt(i:-11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00,-2.5000000E+02\| 2.6111793E-07\| 1)
	2 prt(i:11\|-2.5000000E+02; 0.0000000E+00, 0.0000000E+00, 2.5000000E+02\| 2.6111793E-07\| 2)
	3 prt(o:6\| 2.5000000E+02; 1.1431539E+02, 2.8231580E+00,-1.3710953E+02\| 3.0625000E+04\| 3)
	4 prt(o:-6\| 2.5000000E+02;-1.1431539E+02,-2.8231580E+00, 1.3710953E+02\| 3.0625000E+04\| 4)
	========================================================================
	Contents of powheg_1_p1_1000.pg:
	3
	5 5 2
	2.530629306E-02 3.365662356E-02 2.917606727E-02 2.032378341E-02 1.640279341E-02 3.676895126E-02 3.908545008E-02 3.100081428E-02 2.758624989E-02 2.075435308E-02 2.184926020E-02 2.585981001E-02 2.428140005E-02 1.869552869E-02 1.052110830E-02 1.026072927E-02 1.131493579E-02 8.439667000E-03 6.062967307E-03 1.289002281E-03 1.045380066E-03 1.753781377E-03 1.601314412E-03 1.460208345E-03 5.505926971E-04 2.514689998E-02 3.495739832E-02 2.886328584E-02 2.828860675E-02 6.796007630E-03 3.768978983E-02 3.879497593E-02 2.947607204E-02 2.189014635E-02 1.692352079E-02 2.171460101E-02 2.407352156E-02 2.142085942E-02 1.201357659E-02 1.557410030E-02 1.031223753E-02 1.094206930E-02 9.348220245E-03 3.791168953E-03 2.417083375E-03 1.119303556E-03 1.532804571E-03 1.760727599E-03 1.192585494E-03 5.743801358E-04
	Contents of powheg_1_p2_1000.pg:
	3
	5 5 2
	1.843957322E-02 0.000000000E+00 3.840441758E-04 0.000000000E+00 0.000000000E+00 1.702819017E-02 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 1.628435672E-03 1.957292802E-04 3.584549890E-05 0.000000000E+00 2.651881828E-06 1.844004544E-02 0.000000000E+00 3.796757220E-04 0.000000000E+00 0.000000000E+00 1.703819517E-02 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 0.000000000E+00 1.586894288E-03 2.098735103E-04 3.901739592E-05 0.000000000E+00 2.803502658E-06
	Index: trunk/share/tests/unit_tests/ref-output/shower_base_1.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/shower_base_1.ref (revision 8189)
	+++ trunk/share/tests/unit_tests/ref-output/shower_base_1.ref (revision 8190)
	@@ -1,60 +1,66 @@
	* Test output: shower_base_1
	* Purpose: setting ISR/FSR shower

	* Default settings

	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	------------------------------------------------------------------------

	* Switch on ISR/FSR showers, hadronization
	and MLM matching

	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = T
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = T
	General settings:
	method = PYTHIA6
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 4
	ISR settings:
	ps_isr_pt_ordered = F
	ps_isr_lambda = 2.900000000000E-01
	ps_isr_alphas_running = T
	ps_isr_primordial_kt_width = 0.000000000000E+00
	ps_isr_primordial_kt_cutoff = 5.000000000000E+00
	ps_isr_z_cutoff = 1.234000000000E-01
	ps_isr_minenergy = 1.000000000000E+00
	ps_isr_tscalefactor = 1.000000000000E+00
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = T
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = 'abcdefgh'
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	------------------------------------------------------------------------

	* Test output end: shower_base_1
	Index: trunk/share/tests/unit_tests/ref-output/shower_1.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/shower_1.ref (revision 8189)
	+++ trunk/share/tests/unit_tests/ref-output/shower_1.ref (revision 8190)
	@@ -1,82 +1,85 @@
	* Test output: shower_1
	* Purpose: Two-jet event with disabled shower

	* Initialize environment

	* Set up trivial transform

	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'shower_1p'
	TAO random-number generator:
	seed = 1
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(11)
	E = 5.000000000000E+02
	P = 0.000000000000E+00 0.000000000000E+00 5.000000000000E+02
	T = 0.000000000000E+00
	Children: 3 4
	Particle 2 [i] f(-11)
	E = 5.000000000000E+02
	P = 0.000000000000E+00 0.000000000000E+00 -5.000000000000E+02
	T = 0.000000000000E+00
	Children: 3 4
	Particle 3 [o] f(1)c(1 )
	E = 5.000000000000E+02
	P = 2.580135256785E+01 2.258244818219E+02 4.453510902822E+02
	T = 0.000000000000E+00
	Parents: 1 2
	Particle 4 [o] f(-1)c(-1 )
	E = 5.000000000000E+02
	P = -2.580135256785E+01 -2.258244818219E+02 -4.453510902822E+02
	T = 0.000000000000E+00
	Parents: 1 2
	========================================================================

	* Set up shower event transform

	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'shower_1p'
	TAO random-number generator:
	seed = 2
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	3 [o] d 1 0 1-2 [none] 500.000 25.801 225.824 445.351 0.000
	4 [o] dbar 0 1 1-2 [none] 500.000 -25.801 -225.824 -445.351 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================

	* Cleanup

	* Test output end: shower_1
	Index: trunk/share/tests/unit_tests/ref-output/pythia8_1.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/pythia8_1.ref (revision 0)
	+++ trunk/share/tests/unit_tests/ref-output/pythia8_1.ref (revision 8190)
	@@ -0,0 +1,9 @@
	+* Test output: pythia8_1
	+* Purpose: Construct and destruct a Pythia8 object.
	+
	+
	+* Construct Pythia8 object.
	+
	+
	+* Destruct Pythia8 object.
	+
	Index: trunk/share/tests/unit_tests/ref-output/whizard_lha_1.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/whizard_lha_1.ref (revision 0)
	+++ trunk/share/tests/unit_tests/ref-output/whizard_lha_1.ref (revision 8190)
	@@ -0,0 +1,11 @@
	+* Test output: whizard_lha_1
	+* Purpose: Construct LHAupWhizard object and initialize the beams.
	+
	+
	+* Set initialisation (Beams) and weighting strategy.
	+
	+
	+* Set process parameters for 5 different processes.
	+
	+
	+* Cleanup
	Index: trunk/share/tests/unit_tests/ref-output/shower_2.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/shower_2.ref (revision 8189)
	+++ trunk/share/tests/unit_tests/ref-output/shower_2.ref (revision 8190)
	@@ -1,113 +1,116 @@
	* Test output: shower_2
	* Purpose: Two-jet event with FSR shower

	* Initialize environment

	* Set up trivial transform

	========================================================================
	Event transform: trivial (hard process)
	------------------------------------------------------------------------
	Associated process: 'shower_2p'
	TAO random-number generator:
	seed = 1
	calls = 3
	Number of tries = 1
	------------------------------------------------------------------------
	Particle set:
	------------------------------------------------------------------------
	Particle 1 [i] f(11)
	E = 5.000000000000E+02
	P = 0.000000000000E+00 0.000000000000E+00 5.000000000000E+02
	T = 0.000000000000E+00
	Children: 3 4
	Particle 2 [i] f(-11)
	E = 5.000000000000E+02
	P = 0.000000000000E+00 0.000000000000E+00 -5.000000000000E+02
	T = 0.000000000000E+00
	Children: 3 4
	Particle 3 [o] f(1)c(1 )
	E = 5.000000000000E+02
	P = 2.580135256785E+01 2.258244818219E+02 4.453510902822E+02
	T = 0.000000000000E+00
	Parents: 1 2
	Particle 4 [o] f(-1)c(-1 )
	E = 5.000000000000E+02
	P = -2.580135256785E+01 -2.258244818219E+02 -4.453510902822E+02
	T = 0.000000000000E+00
	Parents: 1 2
	========================================================================

	* Set up shower event transform

	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	Associated process: 'shower_2p'
	TAO random-number generator:
	seed = 2
	calls = 1
	Number of tries = 1
	Particle set:
	------------------------------------------------------------------------
	Nr Status Flavor Col ACol Parents Children P(0) P(1) P(2) P(3) P^2
	1 [i] e- 0 0 [none] 3-4 500.000 0.000 0.000 500.000 0.000
	2 [i] e+ 0 0 [none] 3-4 500.000 0.000 0.000 -500.000 0.000
	3 [r] d 1 0 1-2 5-28 508.251 24.284 212.540 419.152 36867.610
	4 [r] dbar 0 1 1-2 5-28 491.749 -24.284 -212.540 -419.152 20366.169
	5 [o] gl 559 558 3-4 [none] 1.789 -0.157 -1.554 -0.871 0.000
	6 [o] d 548 0 3-4 [none] 90.025 36.056 31.125 76.392 0.000
	7 [o] gl 547 548 3-4 [none] 64.558 28.039 23.326 53.267 0.000
	8 [o] gl 549 547 3-4 [none] 22.246 11.835 7.444 17.303 0.000
	9 [o] gl 546 549 3-4 [none] 42.039 23.332 10.831 33.251 0.000
	10 [o] gl 551 546 3-4 [none] 7.155 -1.629 3.205 6.187 0.000
	11 [o] gl 501 555 3-4 [none] 4.077 0.344 0.985 3.941 0.000
	12 [o] gl 560 559 3-4 [none] 0.750 -0.083 -0.423 -0.614 0.000
	13 [o] gl 564 501 3-4 [none] 58.194 0.298 -10.595 -57.220 0.000
	14 [o] gl 558 566 3-4 [none] 29.336 5.867 -5.846 -28.142 0.000
	15 [o] gl 556 550 3-4 [none] 8.596 -1.457 3.419 7.752 0.000
	16 [o] gl 561 560 3-4 [none] 54.164 -10.128 -34.591 -40.431 0.000
	17 [o] gl 565 564 3-4 [none] 46.810 1.381 -8.286 -46.050 0.000
	18 [o] gl 563 565 3-4 [none] 33.719 2.053 -6.225 -33.076 0.000
	19 [o] gl 566 567 3-4 [none] 12.452 2.458 -2.163 -12.014 0.000
	20 [o] gl 567 563 3-4 [none] 35.204 7.370 -4.115 -34.177 0.000
	21 [o] gl 552 553 3-4 [none] 19.599 -5.929 10.490 15.457 0.000
	22 [o] gl 553 551 3-4 [none] 46.799 -13.124 26.685 36.137 0.000
	23 [o] gl 554 552 3-4 [none] 96.908 -27.392 50.183 78.247 0.000
	24 [o] gl 550 554 3-4 [none] 60.522 -17.694 32.281 48.039 0.000
	25 [o] gl 555 557 3-4 [none] 30.999 -6.025 9.046 29.032 0.000
	26 [o] gl 557 556 3-4 [none] 14.726 -2.073 3.519 14.148 0.000
	27 [o] dbar 0 562 3-4 [none] 50.190 -8.109 -31.141 -38.516 0.000
	28 [o] gl 562 561 3-4 [none] 169.142 -25.234 -107.601 -128.040 0.000
	------------------------------------------------------------------------
	Sum of incoming momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	Sum of beam remnant momenta: p(0:3) = 0.000 0.000 0.000 0.000
	Sum of outgoing momenta: p(0:3) = 1000.000 0.000 0.000 0.000
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = T
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	method = UNDEFINED
	shower_verbose = F
	ps_mass_cutoff = 1.000000000000E+00
	ps_max_n_flavors = 5
	[ISR off]
	FSR settings:
	ps_fsr_lambda = 2.900000000000E-01
	ps_fsr_alphas_running = T
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================

	* Cleanup

	* Test output end: shower_2
	Index: trunk/share/tests/unit_tests/ref-output/pythia8_2.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/pythia8_2.ref (revision 0)
	+++ trunk/share/tests/unit_tests/ref-output/pythia8_2.ref (revision 8190)
	@@ -0,0 +1,18 @@
	+* Test output: pythia8_2
	+* Purpose: Initialize Pythia8 with a LHA User Process object..
	+
	+
	+* Construct Pythia8 object.
	+
	+
	+* Read string 'Beam:frameType = 5' into Pythia8 allowing for LHA user processes.
	+
	+
	+* Setup LHA User Process object and let Pythia8 point to it.
	+
	+
	+* Initialize Pythia8.
	+
	+
	+* Destruct Pythia8 object.
	+
	Index: trunk/share/tests/unit_tests/ref-output/rt_data_1.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/rt_data_1.ref (revision 8189)
	+++ trunk/share/tests/unit_tests/ref-output/rt_data_1.ref (revision 8190)
	@@ -1,417 +1,419 @@
	* Test output: rt_data_1
	* Purpose: initialize global runtime data

	========================================================================
	Runtime data:
	========================================================================
	[undefined] sqrts = [unknown real]
	luminosity = 0.000000000000E+00
	?sf_trace = false
	$sf_trace_file = ""
	?sf_allow_s_mapping = true
	$lhapdf_dir = ""
	$lhapdf_file = ""
	$lhapdf_photon_file = ""
	lhapdf_member = 0
	lhapdf_photon_scheme = 0
	$pdf_builtin_set = "CTEQ6L"
	?hoppet_b_matching = false
	isr_alpha = 0.000000000000E+00
	isr_q_max = 0.000000000000E+00
	isr_mass = 0.000000000000E+00
	isr_order = 3
	?isr_recoil = false
	?isr_keep_energy = false
	?isr_handler = false
	$isr_handler_mode = "trivial"
	epa_alpha = 0.000000000000E+00
	epa_x_min = 0.000000000000E+00
	epa_q_min = 0.000000000000E+00
	epa_q_max = 0.000000000000E+00
	epa_mass = 0.000000000000E+00
	?epa_recoil = false
	?epa_keep_energy = false
	?epa_handler = false
	$epa_handler_mode = "trivial"
	ewa_x_min = 0.000000000000E+00
	ewa_pt_max = 0.000000000000E+00
	ewa_mass = 0.000000000000E+00
	?ewa_recoil = false
	?ewa_keep_energy = false
	?circe1_photon1 = false
	?circe1_photon2 = false
	[undefined] circe1_sqrts = [unknown real]
	?circe1_generate = true
	?circe1_map = true
	circe1_mapping_slope = 2.000000000000E+00
	circe1_eps = 1.000000000000E-05
	circe1_ver = 0
	circe1_rev = 0
	$circe1_acc = "SBAND"
	circe1_chat = 0
	?circe1_with_radiation = false
	?circe2_polarized = true
	[undefined] $circe2_file = [unknown string]
	$circe2_design = "*"
	gaussian_spread1 = 0.000000000000E+00
	gaussian_spread2 = 0.000000000000E+00
	[undefined] $beam_events_file = [unknown string]
	?beam_events_warn_eof = true
	?energy_scan_normalize = false
	?logging => false
	[undefined] $job_id = [unknown string]
	[undefined] $compile_workspace = [unknown string]
	seed = 0
	[undefined] $model_name = [unknown string]
	[undefined] process_num_id = [unknown integer]
	$method = "omega"
	?report_progress = true
	[user variable] ?me_verbose = false
	$restrictions = ""
	?omega_write_phs_output = false
	$omega_flags = ""
	?read_color_factors = true
	?slha_read_input = true
	?slha_read_spectrum = true
	?slha_read_decays = false
	[undefined] $library_name = [unknown string]
	?alphas_is_fixed = true
	?alphas_from_lhapdf = false
	?alphas_from_pdf_builtin = false
	alphas_order = 0
	alphas_nf = 5
	?alphas_from_mz = false
	?alphas_from_lambda_qcd = false
	lambda_qcd = 2.000000000000E-01
	?fatal_beam_decay = true
	?helicity_selection_active = true
	helicity_selection_threshold = 1.000000000000E+10
	helicity_selection_cutoff = 1000
	$rng_method = "tao"
	?vis_diags = false
	?vis_diags_color = false
	?check_event_file = true
	$event_file_version = ""
	n_events = 0
	event_index_offset = 0
	?unweighted = true
	safety_factor = 1.000000000000E+00
	?negative_weights = false
	?resonance_history = false
	resonance_on_shell_limit = 4.000000000000E+00
	resonance_on_shell_turnoff = 0.000000000000E+00
	resonance_background_factor = 1.000000000000E+00
	?keep_beams = false
	?keep_remnants = true
	?recover_beams = true
	?update_event = false
	?update_sqme = false
	?update_weight = false
	?use_alphas_from_file = false
	?use_scale_from_file = false
	?allow_decays = true
	?auto_decays = false
	auto_decays_multiplicity = 2
	?auto_decays_radiative = false
	?decay_rest_frame = false
	?isotropic_decay = false
	?diagonal_decay = false
	[undefined] decay_helicity = [unknown integer]
	?polarized_events = false
	$polarization_mode = "helicity"
	?colorize_subevt = false
	tolerance = 0.000000000000E+00
	checkpoint = 0
	event_callback_interval = 0
	?pacify = false
	$out_file = ""
	?out_advance = true
	real_range* = 307
	real_precision* = 15
	real_epsilon* = 1.000000000000E-16
	real_tiny* = 1.000000000000-300
	$integration_method = "vamp"
	threshold_calls = 10
	min_calls_per_channel = 10
	min_calls_per_bin = 10
	min_bins = 3
	max_bins = 20
	?stratified = true
	?use_vamp_equivalences = true
	?vamp_verbose = false
	?vamp_history_global = true
	?vamp_history_global_verbose = false
	?vamp_history_channels = false
	?vamp_history_channels_verbose = false
	$run_id = ""
	n_calls_test = 0
	?integration_timer = true
	?check_grid_file = true
	accuracy_goal = 0.000000000000E+00
	error_goal = 0.000000000000E+00
	relative_error_goal = 0.000000000000E+00
	integration_results_verbosity = 1
	error_threshold = 0.000000000000E+00
	channel_weights_power = 2.500000000000E-01
	[undefined] $integrate_workspace = [unknown string]
	$phs_method = "default"
	?vis_channels = false
	?check_phs_file = true
	$phs_file = ""
	?phs_only = false
	phs_threshold_s = 5.000000000000E+01
	phs_threshold_t = 1.000000000000E+02
	phs_off_shell = 2
	phs_t_channel = 6
	phs_e_scale = 1.000000000000E+01
	phs_m_scale = 1.000000000000E+01
	phs_q_scale = 1.000000000000E+01
	?phs_keep_nonresonant = true
	?phs_step_mapping = true
	?phs_step_mapping_exp = true
	?phs_s_mapping = true
	?vis_history = false
	n_bins = 20
	?normalize_bins = false
	$obs_label = ""
	$obs_unit = ""
	$title = ""
	$description = ""
	$x_label = ""
	$y_label = ""
	graph_width_mm = 130
	graph_height_mm = 90
	?y_log = false
	?x_log = false
	[undefined] x_min = [unknown real]
	[undefined] x_max = [unknown real]
	[undefined] y_min = [unknown real]
	[undefined] y_max = [unknown real]
	$gmlcode_bg = ""
	$gmlcode_fg = ""
	[undefined] ?draw_histogram = [unknown logical]
	[undefined] ?draw_base = [unknown logical]
	[undefined] ?draw_piecewise = [unknown logical]
	[undefined] ?fill_curve = [unknown logical]
	[undefined] ?draw_curve = [unknown logical]
	[undefined] ?draw_errors = [unknown logical]
	[undefined] ?draw_symbols = [unknown logical]
	[undefined] $fill_options = [unknown string]
	[undefined] $draw_options = [unknown string]
	[undefined] $err_options = [unknown string]
	[undefined] $symbol = [unknown string]
	?analysis_file_only = false
	kt_algorithm* = 0
	cambridge_algorithm* = 1
	antikt_algorithm* = 2
	genkt_algorithm* = 3
	cambridge_for_passive_algorithm* = 11
	genkt_for_passive_algorithm* = 13
	ee_kt_algorithm* = 50
	ee_genkt_algorithm* = 53
	plugin_algorithm* = 99
	undefined_jet_algorithm* = 999
	jet_algorithm = 999
	jet_r = 0.000000000000E+00
	jet_p = 0.000000000000E+00
	jet_ycut = 0.000000000000E+00
	?keep_flavors_when_clustering = false
	$sample = ""
	$sample_normalization = "auto"
	?sample_pacify = false
	?sample_select = true
	sample_max_tries = 10000
	sample_split_n_evt = 0
	sample_split_n_kbytes = 0
	sample_split_index = 0
	$rescan_input_format = "raw"
	?read_raw = true
	?write_raw = true
	$extension_raw = "evx"
	$extension_default = "evt"
	$debug_extension = "debug"
	?debug_process = true
	?debug_transforms = true
	?debug_decay = true
	?debug_verbose = true
	$dump_extension = "pset.dat"
	?dump_compressed = false
	?dump_weights = false
	?dump_summary = false
	?dump_screen = false
	?hepevt_ensure_order = false
	$extension_hepevt = "hepevt"
	$extension_ascii_short = "short.evt"
	$extension_ascii_long = "long.evt"
	$extension_athena = "athena.evt"
	$extension_mokka = "mokka.evt"
	$lhef_version = "2.0"
	$lhef_extension = "lhe"
	?lhef_write_sqme_prc = true
	?lhef_write_sqme_ref = false
	?lhef_write_sqme_alt = true
	$extension_lha = "lha"
	$extension_hepmc = "hepmc"
	?hepmc_output_cross_section = false
	$extension_lcio = "slcio"
	$extension_stdhep = "hep"
	$extension_stdhep_up = "up.hep"
	$extension_stdhep_ev4 = "ev4.hep"
	$extension_hepevt_verb = "hepevt.verb"
	$extension_lha_verb = "lha.verb"
	?allow_shower = true
	?ps_fsr_active = false
	?ps_isr_active = false
	?ps_taudec_active = false
	?muli_active = false
	$shower_method = "WHIZARD"
	?shower_verbose = false
	$ps_PYTHIA_PYGIVE = ""
	+$ps_PYTHIA8_config = ""
	+$ps_PYTHIA8_config_file = ""
	ps_mass_cutoff = 1.000000000000E+00
	ps_fsr_lambda = 2.900000000000E-01
	ps_isr_lambda = 2.900000000000E-01
	ps_max_n_flavors = 5
	?ps_isr_alphas_running = true
	?ps_fsr_alphas_running = true
	ps_fixed_alphas = 0.000000000000E+00
	?ps_isr_pt_ordered = false
	?ps_isr_angular_ordered = true
	ps_isr_primordial_kt_width = 0.000000000000E+00
	ps_isr_primordial_kt_cutoff = 5.000000000000E+00
	ps_isr_z_cutoff = 9.990000000000E-01
	ps_isr_minenergy = 1.000000000000E+00
	ps_isr_tscalefactor = 1.000000000000E+00
	?ps_isr_only_onshell_emitted_partons = false
	?allow_hadronization = true
	?hadronization_active = false
	$hadronization_method = "PYTHIA6"
	hadron_enhanced_fraction = 1.000000000000E-02
	hadron_enhanced_width = 2.000000000000E+00
	?ps_tauola_photos = false
	?ps_tauola_transverse = false
	?ps_tauola_dec_rad_cor = true
	ps_tauola_dec_mode1 = 0
	ps_tauola_dec_mode2 = 0
	ps_tauola_mh = 1.250000000000E+02
	ps_tauola_mix_angle = 9.000000000000E+01
	?ps_tauola_pol_vector = false
	?mlm_matching = false
	mlm_Qcut_ME = 0.000000000000E+00
	mlm_Qcut_PS = 0.000000000000E+00
	mlm_ptmin = 0.000000000000E+00
	mlm_etamax = 0.000000000000E+00
	mlm_Rmin = 0.000000000000E+00
	mlm_Emin = 0.000000000000E+00
	mlm_nmaxMEjets = 0
	mlm_ETclusfactor = 2.000000000000E-01
	mlm_ETclusminE = 5.000000000000E+00
	mlm_etaclusfactor = 1.000000000000E+00
	mlm_Rclusfactor = 1.000000000000E+00
	mlm_Eclusfactor = 1.000000000000E+00
	?powheg_matching = false
	?powheg_use_singular_jacobian = false
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_grid_sampling_points = 500000
	powheg_pt_min = 1.000000000000E+00
	powheg_lambda = 2.000000000000E-01
	?powheg_rebuild_grids = false
	?powheg_test_sudakov = false
	?powheg_disable_sudakov = false
	?ckkw_matching = false
	?omega_openmp = false
	?openmp_is_active* = false
	openmp_num_threads_default* = 1
	openmp_num_threads = 1
	?openmp_logging = true
	?mpi_logging = false
	$born_me_method = ""
	$loop_me_method = ""
	$correlation_me_method = ""
	$real_tree_me_method = ""
	$dglap_me_method = ""
	?test_soft_limit = false
	?test_coll_limit = false
	?test_anti_coll_limit = false
	$select_alpha_regions = ""
	$virtual_selection = "Full"
	?virtual_collinear_resonance_aware = true
	blha_top_yukawa = -1.000000000000E+00
	$blha_ew_scheme = "alpha_qed"
	openloops_verbosity = 1
	?openloops_use_cms = true
	openloops_phs_tolerance = 7
	openloops_stability_log = 0
	?openloops_switch_off_muon_yukawa = false
	$openloops_extra_cmd = ""
	?openloops_use_collier = true
	?disable_subtraction = false
	fks_dij_exp1 = 1.000000000000E+00
	fks_dij_exp2 = 1.000000000000E+00
	fks_xi_min = 1.000000000000E-07
	fks_y_max = 1.000000000000E+00
	?vis_fks_regions = false
	fks_xi_cut = 1.000000000000E+00
	fks_delta_zero = 2.000000000000E+00
	fks_delta_i = 2.000000000000E+00
	$fks_mapping_type = "default"
	$resonances_exclude_particles = "default"
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = false
	?fixed_order_nlo_events = false
	?check_event_weights_against_xsection = false
	?keep_failed_events = false
	gks_multiplicity = 0
	$gosam_filter_lo = ""
	$gosam_filter_nlo = ""
	$gosam_symmetries = "family,generation"
	form_threads = 2
	form_workspace = 1000
	$gosam_fc = ""
	mult_call_real = 1.000000000000E+00
	mult_call_virt = 1.000000000000E+00
	mult_call_dglap = 1.000000000000E+00
	$dalitz_plot = ""
	$nlo_correction_type = "QCD"
	$exclude_gauge_splittings = "c:b:t:e2:e3"
	?nlo_use_born_scale = true
	?nlo_cut_all_sqmes = true
	?nlo_use_real_partition = false
	real_partition_scale = 1.000000000000E+01
	$fc => "Fortran-compiler"
	$fcflags => "Fortran-flags"
	========================================================================
	iterations = 2:5000:"gw", 3:20000
	========================================================================
	Process library stack: [empty]
	========================================================================
	Beam structure: [any particles]
	========================================================================
	Cuts: [undefined]
	------------------------------------------------------------------------
	Scale: [undefined]
	------------------------------------------------------------------------
	Factorization scale: [undefined]
	------------------------------------------------------------------------
	Renormalization scale: [undefined]
	------------------------------------------------------------------------
	Weight: [undefined]
	========================================================================
	Event selection: [undefined]
	------------------------------------------------------------------------
	Event reweighting factor: [undefined]
	------------------------------------------------------------------------
	Event analysis: [undefined]
	------------------------------------------------------------------------
	Event callback: [undefined]
	========================================================================
	Process stack: [empty]
	========================================================================
	quit : F
	quit_code: 0
	========================================================================
	Logfile : 'rt_data.log'
	========================================================================

	* Test output end: rt_data_1
	Index: trunk/share/tests/unit_tests/ref-output/whizard_lha_2.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/whizard_lha_2.ref (revision 0)
	+++ trunk/share/tests/unit_tests/ref-output/whizard_lha_2.ref (revision 8190)
	@@ -0,0 +1,14 @@
	+* Test output: whizard_lha_2
	+* Purpose: Setup LHAupWhizard and set event record.
	+
	+
	+* Set initialisation (Beams) and weighting strategy.
	+
	+
	+* Set process parameters for 5 different processes.
	+
	+
	+* Set event record.
	+
	+
	+* Cleanup
	Index: trunk/share/tests/unit_tests/ref-output/dispatch_transforms_2.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/dispatch_transforms_2.ref (revision 8189)
	+++ trunk/share/tests/unit_tests/ref-output/dispatch_transforms_2.ref (revision 8190)
	@@ -1,160 +1,163 @@
	* Test output: dispatch_transforms_2
	* Purpose: configure event transform

	* Resonance insertion

	========================================================================
	Event transform: resonance insertion
	========================================================================
	Process library = 'foo_R'
	Component #1:
	Resonance history set: [incomplete]
	------------------------------------------------------------------------
	Subprocess instances: not allocated
	Selected: [none]
	On-shell limit = 0.00000E+00
	On-shell turnoff = 0.00000E+00
	Background factor = 1.00000E+00
	------------------------------------------------------------------------
	------------------------------------------------------------------------

	* ISR handler

	========================================================================
	Event transform: ISR/EPA handler
	========================================================================
	Insertion mode = 1: pair recoil
	ISR: Q_max = 1.000000000000E+02
	m = 5.110000000000E-04
	EPA: [inactive]
	Event:
	mode = --- ---
	Q_max = 0.000000000000E+00 0.000000000000E+00
	m = 0.000000000000E+00 0.000000000000E+00
	x = 0.000000000000E+00 0.000000000000E+00
	xb = 0.000000000000E+00 0.000000000000E+00
	sqrts = 0.000000000000E+00
	------------------------------------------------------------------------
	Lorentz boost (partons before radiation c.m. -> lab) =
	L00 = 1.000000000000E+00
	L0j = 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
	L10 = 0.000000000000E+00
	L1j = 1.000000000000E+00 0.000000000000E+00 0.000000000000E+00
	L20 = 0.000000000000E+00
	L2j = 0.000000000000E+00 1.000000000000E+00 0.000000000000E+00
	L30 = 0.000000000000E+00
	L3j = 0.000000000000E+00 0.000000000000E+00 1.000000000000E+00
	Lorentz transformation (collinear partons -> partons with recoil in c.m.) =
	L00 = 1.000000000000E+00
	L0j = 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
	L10 = 0.000000000000E+00
	L1j = 1.000000000000E+00 0.000000000000E+00 0.000000000000E+00
	L20 = 0.000000000000E+00
	L2j = 0.000000000000E+00 1.000000000000E+00 0.000000000000E+00
	L30 = 0.000000000000E+00
	L3j = 0.000000000000E+00 0.000000000000E+00 1.000000000000E+00
	Combined transformation (partons -> partons with recoil in lab frame) =
	L00 = 1.000000000000E+00
	L0j = 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
	L10 = 0.000000000000E+00
	L1j = 1.000000000000E+00 0.000000000000E+00 0.000000000000E+00
	L20 = 0.000000000000E+00
	L2j = 0.000000000000E+00 1.000000000000E+00 0.000000000000E+00
	L30 = 0.000000000000E+00
	L3j = 0.000000000000E+00 0.000000000000E+00 1.000000000000E+00
	------------------------------------------------------------------------
	------------------------------------------------------------------------

	* EPA handler

	========================================================================
	Event transform: ISR/EPA handler
	========================================================================
	Insertion mode = 1: pair recoil
	ISR: [inactive]
	EPA: Q_max = 1.000000000000E+02
	m = 5.110000000000E-04
	Event:
	mode = --- ---
	Q_max = 0.000000000000E+00 0.000000000000E+00
	m = 0.000000000000E+00 0.000000000000E+00
	x = 0.000000000000E+00 0.000000000000E+00
	xb = 0.000000000000E+00 0.000000000000E+00
	sqrts = 0.000000000000E+00
	------------------------------------------------------------------------
	Lorentz boost (partons before radiation c.m. -> lab) =
	L00 = 1.000000000000E+00
	L0j = 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
	L10 = 0.000000000000E+00
	L1j = 1.000000000000E+00 0.000000000000E+00 0.000000000000E+00
	L20 = 0.000000000000E+00
	L2j = 0.000000000000E+00 1.000000000000E+00 0.000000000000E+00
	L30 = 0.000000000000E+00
	L3j = 0.000000000000E+00 0.000000000000E+00 1.000000000000E+00
	Lorentz transformation (collinear partons -> partons with recoil in c.m.) =
	L00 = 1.000000000000E+00
	L0j = 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
	L10 = 0.000000000000E+00
	L1j = 1.000000000000E+00 0.000000000000E+00 0.000000000000E+00
	L20 = 0.000000000000E+00
	L2j = 0.000000000000E+00 1.000000000000E+00 0.000000000000E+00
	L30 = 0.000000000000E+00
	L3j = 0.000000000000E+00 0.000000000000E+00 1.000000000000E+00
	Combined transformation (partons -> partons with recoil in lab frame) =
	L00 = 1.000000000000E+00
	L0j = 0.000000000000E+00 0.000000000000E+00 0.000000000000E+00
	L10 = 0.000000000000E+00
	L1j = 1.000000000000E+00 0.000000000000E+00 0.000000000000E+00
	L20 = 0.000000000000E+00
	L2j = 0.000000000000E+00 1.000000000000E+00 0.000000000000E+00
	L30 = 0.000000000000E+00
	L3j = 0.000000000000E+00 0.000000000000E+00 1.000000000000E+00
	------------------------------------------------------------------------
	------------------------------------------------------------------------

	* Partonic decays

	========================================================================
	Event transform: partonic decays
	========================================================================
	------------------------------------------------------------------------
	Variable list for simulation: [associated, not shown]
	------------------------------------------------------------------------
	Final-state decay tree: [not configured]
	Selected MCI = [undefined]
	Selected term = [undefined]
	========================================================================
	Decay chain:
	========================================================================
	Evaluator (correlated trace of the decay chain):
	------------------------------------------------------------------------
	Interaction: [empty]
	Matrix-element multiplication
	Input interaction 1: [undefined]
	Input interaction 2: [undefined]
	========================================================================

	* Shower

	========================================================================
	Event transform: shower
	------------------------------------------------------------------------
	------------------------------------------------------------------------
	Shower settings:
	------------------------------------------------------------------------
	Master switches:
	ps_isr_active = F
	ps_fsr_active = F
	ps_tau_dec = F
	muli_active = F
	hadronization_active = F
	General settings:
	[ISR and FSR off]
	Matching Settings:
	mlm_matching = F
	ckkw_matching = F
	PYTHIA6 specific settings:
	ps_PYTHIA_PYGIVE = ''
	+ PYTHIA8 specific settings:
	+ ps_PYTHIA8_config = ''
	+ ps_PYTHIA8_config_file = ''
	========================================================================

	* Test output end: dispatch_transforms_2
	Index: trunk/share/tests/unit_tests/ref-output/rt_data_2.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/rt_data_2.ref (revision 8189)
	+++ trunk/share/tests/unit_tests/ref-output/rt_data_2.ref (revision 8190)
	@@ -1,481 +1,483 @@
	* Test output: rt_data_2
	* Purpose: initialize global runtime data and fill contents

	========================================================================
	Runtime data:
	========================================================================
	gy => 1.000000000000E+00
	ms => 1.250000000000E+02
	ff => 1.500000000000E+00
	mf* => 1.875000000000E+02
	particle* = PDG(0)
	SCALAR* = PDG(25)
	s* = PDG(25)
	FERMION* = PDG(6)
	f* = PDG(6)
	fbar* = PDG(-6)
	F* = PDG(-6)
	charged* = PDG(6, -6)
	neutral* = PDG(25)
	colored* = PDG(6, -6)
	sqrts = 1.000000000000E+03
	luminosity = 3.300000000000E+01
	?sf_trace = false
	$sf_trace_file = ""
	?sf_allow_s_mapping = true
	$lhapdf_dir = ""
	$lhapdf_file = ""
	$lhapdf_photon_file = ""
	lhapdf_member = 0
	lhapdf_photon_scheme = 0
	$pdf_builtin_set = "CTEQ6L"
	?hoppet_b_matching = false
	isr_alpha = 0.000000000000E+00
	isr_q_max = 0.000000000000E+00
	isr_mass = 0.000000000000E+00
	isr_order = 3
	?isr_recoil = false
	?isr_keep_energy = false
	?isr_handler = false
	$isr_handler_mode = "trivial"
	epa_alpha = 0.000000000000E+00
	epa_x_min = 0.000000000000E+00
	epa_q_min = 0.000000000000E+00
	epa_q_max = 0.000000000000E+00
	epa_mass = 0.000000000000E+00
	?epa_recoil = false
	?epa_keep_energy = false
	?epa_handler = false
	$epa_handler_mode = "trivial"
	ewa_x_min = 0.000000000000E+00
	ewa_pt_max = 0.000000000000E+00
	ewa_mass = 0.000000000000E+00
	?ewa_recoil = false
	?ewa_keep_energy = false
	?circe1_photon1 = false
	?circe1_photon2 = false
	[undefined] circe1_sqrts = [unknown real]
	?circe1_generate = true
	?circe1_map = true
	circe1_mapping_slope = 2.000000000000E+00
	circe1_eps = 1.000000000000E-05
	circe1_ver = 0
	circe1_rev = 0
	$circe1_acc = "SBAND"
	circe1_chat = 0
	?circe1_with_radiation = false
	?circe2_polarized = true
	[undefined] $circe2_file = [unknown string]
	$circe2_design = "*"
	gaussian_spread1 = 0.000000000000E+00
	gaussian_spread2 = 0.000000000000E+00
	[undefined] $beam_events_file = [unknown string]
	?beam_events_warn_eof = true
	?energy_scan_normalize = false
	?logging => false
	[undefined] $job_id = [unknown string]
	[undefined] $compile_workspace = [unknown string]
	seed = 0
	$model_name = "Test"
	[undefined] process_num_id = [unknown integer]
	$method = "omega"
	?report_progress = true
	[user variable] ?me_verbose = false
	$restrictions = ""
	?omega_write_phs_output = false
	$omega_flags = ""
	?read_color_factors = true
	?slha_read_input = true
	?slha_read_spectrum = true
	?slha_read_decays = false
	[undefined] $library_name = [unknown string]
	?alphas_is_fixed = true
	?alphas_from_lhapdf = false
	?alphas_from_pdf_builtin = false
	alphas_order = 0
	alphas_nf = 5
	?alphas_from_mz = false
	?alphas_from_lambda_qcd = false
	lambda_qcd = 2.000000000000E-01
	?fatal_beam_decay = true
	?helicity_selection_active = true
	helicity_selection_threshold = 1.000000000000E+10
	helicity_selection_cutoff = 1000
	$rng_method = "tao"
	?vis_diags = false
	?vis_diags_color = false
	?check_event_file = true
	$event_file_version = ""
	n_events = 0
	event_index_offset = 0
	?unweighted = true
	safety_factor = 1.000000000000E+00
	?negative_weights = false
	?resonance_history = false
	resonance_on_shell_limit = 4.000000000000E+00
	resonance_on_shell_turnoff = 0.000000000000E+00
	resonance_background_factor = 1.000000000000E+00
	?keep_beams = false
	?keep_remnants = true
	?recover_beams = true
	?update_event = false
	?update_sqme = false
	?update_weight = false
	?use_alphas_from_file = false
	?use_scale_from_file = false
	?allow_decays = true
	?auto_decays = false
	auto_decays_multiplicity = 2
	?auto_decays_radiative = false
	?decay_rest_frame = false
	?isotropic_decay = false
	?diagonal_decay = false
	[undefined] decay_helicity = [unknown integer]
	?polarized_events = false
	$polarization_mode = "helicity"
	?colorize_subevt = false
	tolerance = 0.000000000000E+00
	checkpoint = 0
	event_callback_interval = 0
	?pacify = false
	$out_file = ""
	?out_advance = true
	real_range* = 307
	real_precision* = 15
	real_epsilon* = 1.000000000000E-16
	real_tiny* = 1.000000000000-300
	$integration_method = "vamp"
	threshold_calls = 10
	min_calls_per_channel = 10
	min_calls_per_bin = 10
	min_bins = 3
	max_bins = 20
	?stratified = true
	?use_vamp_equivalences = true
	?vamp_verbose = false
	?vamp_history_global = true
	?vamp_history_global_verbose = false
	?vamp_history_channels = false
	?vamp_history_channels_verbose = false
	$run_id = "run1"
	n_calls_test = 0
	?integration_timer = true
	?check_grid_file = true
	accuracy_goal = 0.000000000000E+00
	error_goal = 0.000000000000E+00
	relative_error_goal = 0.000000000000E+00
	integration_results_verbosity = 1
	error_threshold = 0.000000000000E+00
	channel_weights_power = 2.500000000000E-01
	[undefined] $integrate_workspace = [unknown string]
	$phs_method = "default"
	?vis_channels = false
	?check_phs_file = true
	$phs_file = ""
	?phs_only = false
	phs_threshold_s = 5.000000000000E+01
	phs_threshold_t = 1.000000000000E+02
	phs_off_shell = 2
	phs_t_channel = 6
	phs_e_scale = 1.000000000000E+01
	phs_m_scale = 1.000000000000E+01
	phs_q_scale = 1.000000000000E+01
	?phs_keep_nonresonant = true
	?phs_step_mapping = true
	?phs_step_mapping_exp = true
	?phs_s_mapping = true
	?vis_history = false
	n_bins = 20
	?normalize_bins = false
	$obs_label = ""
	$obs_unit = ""
	$title = ""
	$description = ""
	$x_label = ""
	$y_label = ""
	graph_width_mm = 130
	graph_height_mm = 90
	?y_log = false
	?x_log = false
	[undefined] x_min = [unknown real]
	[undefined] x_max = [unknown real]
	[undefined] y_min = [unknown real]
	[undefined] y_max = [unknown real]
	$gmlcode_bg = ""
	$gmlcode_fg = ""
	[undefined] ?draw_histogram = [unknown logical]
	[undefined] ?draw_base = [unknown logical]
	[undefined] ?draw_piecewise = [unknown logical]
	[undefined] ?fill_curve = [unknown logical]
	[undefined] ?draw_curve = [unknown logical]
	[undefined] ?draw_errors = [unknown logical]
	[undefined] ?draw_symbols = [unknown logical]
	[undefined] $fill_options = [unknown string]
	[undefined] $draw_options = [unknown string]
	[undefined] $err_options = [unknown string]
	[undefined] $symbol = [unknown string]
	?analysis_file_only = false
	kt_algorithm* = 0
	cambridge_algorithm* = 1
	antikt_algorithm* = 2
	genkt_algorithm* = 3
	cambridge_for_passive_algorithm* = 11
	genkt_for_passive_algorithm* = 13
	ee_kt_algorithm* = 50
	ee_genkt_algorithm* = 53
	plugin_algorithm* = 99
	undefined_jet_algorithm* = 999
	jet_algorithm = 999
	jet_r = 0.000000000000E+00
	jet_p = 0.000000000000E+00
	jet_ycut = 0.000000000000E+00
	?keep_flavors_when_clustering = false
	$sample = ""
	$sample_normalization = "auto"
	?sample_pacify = false
	?sample_select = true
	sample_max_tries = 10000
	sample_split_n_evt = 0
	sample_split_n_kbytes = 0
	sample_split_index = 0
	$rescan_input_format = "raw"
	?read_raw = true
	?write_raw = true
	$extension_raw = "evx"
	$extension_default = "evt"
	$debug_extension = "debug"
	?debug_process = true
	?debug_transforms = true
	?debug_decay = true
	?debug_verbose = true
	$dump_extension = "pset.dat"
	?dump_compressed = false
	?dump_weights = false
	?dump_summary = false
	?dump_screen = false
	?hepevt_ensure_order = false
	$extension_hepevt = "hepevt"
	$extension_ascii_short = "short.evt"
	$extension_ascii_long = "long.evt"
	$extension_athena = "athena.evt"
	$extension_mokka = "mokka.evt"
	$lhef_version = "2.0"
	$lhef_extension = "lhe"
	?lhef_write_sqme_prc = true
	?lhef_write_sqme_ref = false
	?lhef_write_sqme_alt = true
	$extension_lha = "lha"
	$extension_hepmc = "hepmc"
	?hepmc_output_cross_section = false
	$extension_lcio = "slcio"
	$extension_stdhep = "hep"
	$extension_stdhep_up = "up.hep"
	$extension_stdhep_ev4 = "ev4.hep"
	$extension_hepevt_verb = "hepevt.verb"
	$extension_lha_verb = "lha.verb"
	?allow_shower = true
	?ps_fsr_active = false
	?ps_isr_active = false
	?ps_taudec_active = false
	?muli_active = false
	$shower_method = "WHIZARD"
	?shower_verbose = false
	$ps_PYTHIA_PYGIVE = ""
	+$ps_PYTHIA8_config = ""
	+$ps_PYTHIA8_config_file = ""
	ps_mass_cutoff = 1.000000000000E+00
	ps_fsr_lambda = 2.900000000000E-01
	ps_isr_lambda = 2.900000000000E-01
	ps_max_n_flavors = 5
	?ps_isr_alphas_running = true
	?ps_fsr_alphas_running = true
	ps_fixed_alphas = 0.000000000000E+00
	?ps_isr_pt_ordered = false
	?ps_isr_angular_ordered = true
	ps_isr_primordial_kt_width = 0.000000000000E+00
	ps_isr_primordial_kt_cutoff = 5.000000000000E+00
	ps_isr_z_cutoff = 9.990000000000E-01
	ps_isr_minenergy = 1.000000000000E+00
	ps_isr_tscalefactor = 1.000000000000E+00
	?ps_isr_only_onshell_emitted_partons = false
	?allow_hadronization = true
	?hadronization_active = false
	$hadronization_method = "PYTHIA6"
	hadron_enhanced_fraction = 1.000000000000E-02
	hadron_enhanced_width = 2.000000000000E+00
	?ps_tauola_photos = false
	?ps_tauola_transverse = false
	?ps_tauola_dec_rad_cor = true
	ps_tauola_dec_mode1 = 0
	ps_tauola_dec_mode2 = 0
	ps_tauola_mh = 1.250000000000E+02
	ps_tauola_mix_angle = 9.000000000000E+01
	?ps_tauola_pol_vector = false
	?mlm_matching = false
	mlm_Qcut_ME = 0.000000000000E+00
	mlm_Qcut_PS = 0.000000000000E+00
	mlm_ptmin = 0.000000000000E+00
	mlm_etamax = 0.000000000000E+00
	mlm_Rmin = 0.000000000000E+00
	mlm_Emin = 0.000000000000E+00
	mlm_nmaxMEjets = 0
	mlm_ETclusfactor = 2.000000000000E-01
	mlm_ETclusminE = 5.000000000000E+00
	mlm_etaclusfactor = 1.000000000000E+00
	mlm_Rclusfactor = 1.000000000000E+00
	mlm_Eclusfactor = 1.000000000000E+00
	?powheg_matching = false
	?powheg_use_singular_jacobian = false
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_grid_sampling_points = 500000
	powheg_pt_min = 1.000000000000E+00
	powheg_lambda = 2.000000000000E-01
	?powheg_rebuild_grids = false
	?powheg_test_sudakov = false
	?powheg_disable_sudakov = false
	?ckkw_matching = false
	?omega_openmp = false
	?openmp_is_active* = false
	openmp_num_threads_default* = 1
	openmp_num_threads = 1
	?openmp_logging = true
	?mpi_logging = false
	$born_me_method = ""
	$loop_me_method = ""
	$correlation_me_method = ""
	$real_tree_me_method = ""
	$dglap_me_method = ""
	?test_soft_limit = false
	?test_coll_limit = false
	?test_anti_coll_limit = false
	$select_alpha_regions = ""
	$virtual_selection = "Full"
	?virtual_collinear_resonance_aware = true
	blha_top_yukawa = -1.000000000000E+00
	$blha_ew_scheme = "alpha_qed"
	openloops_verbosity = 1
	?openloops_use_cms = true
	openloops_phs_tolerance = 7
	openloops_stability_log = 0
	?openloops_switch_off_muon_yukawa = false
	$openloops_extra_cmd = ""
	?openloops_use_collier = true
	?disable_subtraction = false
	fks_dij_exp1 = 1.000000000000E+00
	fks_dij_exp2 = 1.000000000000E+00
	fks_xi_min = 1.000000000000E-07
	fks_y_max = 1.000000000000E+00
	?vis_fks_regions = false
	fks_xi_cut = 1.000000000000E+00
	fks_delta_zero = 2.000000000000E+00
	fks_delta_i = 2.000000000000E+00
	$fks_mapping_type = "default"
	$resonances_exclude_particles = "default"
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = false
	?fixed_order_nlo_events = false
	?check_event_weights_against_xsection = false
	?keep_failed_events = false
	gks_multiplicity = 0
	$gosam_filter_lo = ""
	$gosam_filter_nlo = ""
	$gosam_symmetries = "family,generation"
	form_threads = 2
	form_workspace = 1000
	$gosam_fc = ""
	mult_call_real = 1.000000000000E+00
	mult_call_virt = 1.000000000000E+00
	mult_call_dglap = 1.000000000000E+00
	$dalitz_plot = ""
	$nlo_correction_type = "QCD"
	$exclude_gauge_splittings = "c:b:t:e2:e3"
	?nlo_use_born_scale = true
	?nlo_cut_all_sqmes = true
	?nlo_use_real_partition = false
	real_partition_scale = 1.000000000000E+01
	$fc => "Fortran-compiler"
	$fcflags => "Fortran-flags"
	========================================================================
	model "Test"
	! md5sum = 'DB28187ADA60804A3CFC14A025DED784'

	parameter gy = 1.000000000000E+00
	parameter ms = 1.250000000000E+02
	parameter ff = 1.500000000000E+00
	external mf = 1.875000000000E+02

	particle SCALAR 25
	name "s"
	spin 0
	mass ms
	particle FERMION 6
	name "f"
	anti "fbar" "F"
	tex_anti "\bar{f}"
	spin 1/2 isospin 1/2 charge 2/3 color 3
	mass mf

	vertex "fbar" "f" "s"
	vertex "s" "s" "s"
	========================================================================
	Process library stack: [empty]
	========================================================================
	Beam structure: [any particles]
	========================================================================
	Cuts:
	------------------------------------------------------------------------
	+ SEQUENCE <lexpr> = <lsinglet>
	+ SEQUENCE <lsinglet> = <lterm>
	\| + SEQUENCE <lterm> = <all_fun>
	\| \| + SEQUENCE <all_fun> = all <lexpr> <pargs1>
	\| \| \| + KEYWORD all = [keyword] all
	\| \| \| + SEQUENCE <lexpr> = <lsinglet>
	\| \| \| \| + SEQUENCE <lsinglet> = <lterm>
	\| \| \| \| \| + SEQUENCE <lterm> = <compared_expr>
	\| \| \| \| \| \| + SEQUENCE <compared_expr> = <expr> <comparison>
	\| \| \| \| \| \| \| + SEQUENCE <expr> = <term>
	\| \| \| \| \| \| \| \| + SEQUENCE <term> = <factor>
	\| \| \| \| \| \| \| \| \| + SEQUENCE <factor> = <variable>
	\| \| \| \| \| \| \| \| \| \| + IDENTIFIER <variable> = Pt
	\| \| \| \| \| \| \| + SEQUENCE <comparison> = '>' <expr>
	\| \| \| \| \| \| \| \| + KEYWORD '>' = [keyword] >
	\| \| \| \| \| \| \| \| + SEQUENCE <expr> = <term>
	\| \| \| \| \| \| \| \| \| + SEQUENCE <term> = <factor>
	\| \| \| \| \| \| \| \| \| \| + SEQUENCE <factor> = <integer_value>
	\| \| \| \| \| \| \| \| \| \| \| + SEQUENCE <integer_value> = <integer_literal>
	\| \| \| \| \| \| \| \| \| \| \| \| + INTEGER <integer_literal> = 100
	\| \| \| + ARGUMENTS <pargs1> = <pexpr>
	\| \| \| \| + SEQUENCE <pexpr> = <pterm>
	\| \| \| \| \| + SEQUENCE <pterm> = <pexpr_src>
	\| \| \| \| \| \| + SEQUENCE <pexpr_src> = <unspecified_prt>
	\| \| \| \| \| \| \| + SEQUENCE <unspecified_prt> = <cexpr>
	\| \| \| \| \| \| \| \| + SEQUENCE <cexpr> = <variable>
	\| \| \| \| \| \| \| \| \| + IDENTIFIER <variable> = s
	------------------------------------------------------------------------
	Scale: [undefined]
	------------------------------------------------------------------------
	Factorization scale: [undefined]
	------------------------------------------------------------------------
	Renormalization scale: [undefined]
	------------------------------------------------------------------------
	Weight: [undefined]
	========================================================================
	Event selection: [undefined]
	------------------------------------------------------------------------
	Event reweighting factor: [undefined]
	------------------------------------------------------------------------
	Event analysis: [undefined]
	------------------------------------------------------------------------
	Event sample formats = foo_fmt, bar_fmt
	------------------------------------------------------------------------
	Event callback: [undefined]
	========================================================================
	Process stack: [empty]
	========================================================================
	quit : F
	quit_code: 0
	========================================================================
	Logfile : ''
	========================================================================

	* Test output end: rt_data_2
	Index: trunk/share/tests/unit_tests/ref-output/rt_data_3.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/rt_data_3.ref (revision 8189)
	+++ trunk/share/tests/unit_tests/ref-output/rt_data_3.ref (revision 8190)
	@@ -1,1015 +1,1019 @@
	* Test output: rt_data_3
	* Purpose: initialize global runtime data and fill contents;
	* copy to local block and back

	* Init global data

	* Init and modify local data

	model associated = T
	library associated = T

	========================================================================
	Runtime data:
	========================================================================
	gy => 1.000000000000E+00
	ms => 1.500000000000E+02
	ff => 1.500000000000E+00
	mf* => 2.250000000000E+02
	particle* = PDG(0)
	SCALAR* = PDG(25)
	s* = PDG(25)
	FERMION* = PDG(6)
	f* = PDG(6)
	fbar* = PDG(-6)
	F* = PDG(-6)
	charged* = PDG(6, -6)
	neutral* = PDG(25)
	colored* = PDG(6, -6)
	$model_name = "Test"
	$fc => "Local compiler"
	$fcflags => "Fortran-flags"
	$integration_method = "midpoint"
	$phs_method = "single"
	$library_name = "library_2"
	sqrts = 1.000000000000E+03
	luminosity = 3.300000000000E+01
	?sf_trace = false
	$sf_trace_file = ""
	?sf_allow_s_mapping = true
	$lhapdf_dir = ""
	$lhapdf_file = ""
	$lhapdf_photon_file = ""
	lhapdf_member = 0
	lhapdf_photon_scheme = 0
	$pdf_builtin_set = "CTEQ6L"
	?hoppet_b_matching = false
	isr_alpha = 0.000000000000E+00
	isr_q_max = 0.000000000000E+00
	isr_mass = 0.000000000000E+00
	isr_order = 3
	?isr_recoil = false
	?isr_keep_energy = false
	?isr_handler = false
	$isr_handler_mode = "trivial"
	epa_alpha = 0.000000000000E+00
	epa_x_min = 0.000000000000E+00
	epa_q_min = 0.000000000000E+00
	epa_q_max = 0.000000000000E+00
	epa_mass = 0.000000000000E+00
	?epa_recoil = false
	?epa_keep_energy = false
	?epa_handler = false
	$epa_handler_mode = "trivial"
	ewa_x_min = 0.000000000000E+00
	ewa_pt_max = 0.000000000000E+00
	ewa_mass = 0.000000000000E+00
	?ewa_recoil = false
	?ewa_keep_energy = false
	?circe1_photon1 = false
	?circe1_photon2 = false
	[undefined] circe1_sqrts = [unknown real]
	?circe1_generate = true
	?circe1_map = true
	circe1_mapping_slope = 2.000000000000E+00
	circe1_eps = 1.000000000000E-05
	circe1_ver = 0
	circe1_rev = 0
	$circe1_acc = "SBAND"
	circe1_chat = 0
	?circe1_with_radiation = false
	?circe2_polarized = true
	[undefined] $circe2_file = [unknown string]
	$circe2_design = "*"
	gaussian_spread1 = 0.000000000000E+00
	gaussian_spread2 = 0.000000000000E+00
	[undefined] $beam_events_file = [unknown string]
	?beam_events_warn_eof = true
	?energy_scan_normalize = false
	?logging => false
	[undefined] $job_id = [unknown string]
	[undefined] $compile_workspace = [unknown string]
	seed = 0
	$model_name = "Test"
	[undefined] process_num_id = [unknown integer]
	$method = "omega"
	?report_progress = true
	[user variable] ?me_verbose = false
	$restrictions = ""
	?omega_write_phs_output = false
	$omega_flags = ""
	?read_color_factors = true
	?slha_read_input = true
	?slha_read_spectrum = true
	?slha_read_decays = false
	$library_name = "library_1"
	?alphas_is_fixed = true
	?alphas_from_lhapdf = false
	?alphas_from_pdf_builtin = false
	alphas_order = 0
	alphas_nf = 5
	?alphas_from_mz = false
	?alphas_from_lambda_qcd = false
	lambda_qcd = 2.000000000000E-01
	?fatal_beam_decay = true
	?helicity_selection_active = true
	helicity_selection_threshold = 1.000000000000E+10
	helicity_selection_cutoff = 1000
	$rng_method = "tao"
	?vis_diags = false
	?vis_diags_color = false
	?check_event_file = true
	$event_file_version = ""
	n_events = 0
	event_index_offset = 0
	?unweighted = true
	safety_factor = 1.000000000000E+00
	?negative_weights = false
	?resonance_history = false
	resonance_on_shell_limit = 4.000000000000E+00
	resonance_on_shell_turnoff = 0.000000000000E+00
	resonance_background_factor = 1.000000000000E+00
	?keep_beams = false
	?keep_remnants = true
	?recover_beams = true
	?update_event = false
	?update_sqme = false
	?update_weight = false
	?use_alphas_from_file = false
	?use_scale_from_file = false
	?allow_decays = true
	?auto_decays = false
	auto_decays_multiplicity = 2
	?auto_decays_radiative = false
	?decay_rest_frame = false
	?isotropic_decay = false
	?diagonal_decay = false
	[undefined] decay_helicity = [unknown integer]
	?polarized_events = false
	$polarization_mode = "helicity"
	?colorize_subevt = false
	tolerance = 0.000000000000E+00
	checkpoint = 0
	event_callback_interval = 0
	?pacify = false
	$out_file = ""
	?out_advance = true
	real_range* = 307
	real_precision* = 15
	real_epsilon* = 1.000000000000E-16
	real_tiny* = 1.000000000000-300
	$integration_method = "vamp"
	threshold_calls = 10
	min_calls_per_channel = 10
	min_calls_per_bin = 10
	min_bins = 3
	max_bins = 20
	?stratified = true
	?use_vamp_equivalences = true
	?vamp_verbose = false
	?vamp_history_global = true
	?vamp_history_global_verbose = false
	?vamp_history_channels = false
	?vamp_history_channels_verbose = false
	$run_id = "run1"
	n_calls_test = 0
	?integration_timer = true
	?check_grid_file = true
	accuracy_goal = 0.000000000000E+00
	error_goal = 0.000000000000E+00
	relative_error_goal = 0.000000000000E+00
	integration_results_verbosity = 1
	error_threshold = 0.000000000000E+00
	channel_weights_power = 2.500000000000E-01
	[undefined] $integrate_workspace = [unknown string]
	$phs_method = "default"
	?vis_channels = false
	?check_phs_file = true
	$phs_file = ""
	?phs_only = false
	phs_threshold_s = 5.000000000000E+01
	phs_threshold_t = 1.000000000000E+02
	phs_off_shell = 2
	phs_t_channel = 6
	phs_e_scale = 1.000000000000E+01
	phs_m_scale = 1.000000000000E+01
	phs_q_scale = 1.000000000000E+01
	?phs_keep_nonresonant = true
	?phs_step_mapping = true
	?phs_step_mapping_exp = true
	?phs_s_mapping = true
	?vis_history = false
	n_bins = 20
	?normalize_bins = false
	$obs_label = ""
	$obs_unit = ""
	$title = ""
	$description = ""
	$x_label = ""
	$y_label = ""
	graph_width_mm = 130
	graph_height_mm = 90
	?y_log = false
	?x_log = false
	[undefined] x_min = [unknown real]
	[undefined] x_max = [unknown real]
	[undefined] y_min = [unknown real]
	[undefined] y_max = [unknown real]
	$gmlcode_bg = ""
	$gmlcode_fg = ""
	[undefined] ?draw_histogram = [unknown logical]
	[undefined] ?draw_base = [unknown logical]
	[undefined] ?draw_piecewise = [unknown logical]
	[undefined] ?fill_curve = [unknown logical]
	[undefined] ?draw_curve = [unknown logical]
	[undefined] ?draw_errors = [unknown logical]
	[undefined] ?draw_symbols = [unknown logical]
	[undefined] $fill_options = [unknown string]
	[undefined] $draw_options = [unknown string]
	[undefined] $err_options = [unknown string]
	[undefined] $symbol = [unknown string]
	?analysis_file_only = false
	kt_algorithm* = 0
	cambridge_algorithm* = 1
	antikt_algorithm* = 2
	genkt_algorithm* = 3
	cambridge_for_passive_algorithm* = 11
	genkt_for_passive_algorithm* = 13
	ee_kt_algorithm* = 50
	ee_genkt_algorithm* = 53
	plugin_algorithm* = 99
	undefined_jet_algorithm* = 999
	jet_algorithm = 999
	jet_r = 0.000000000000E+00
	jet_p = 0.000000000000E+00
	jet_ycut = 0.000000000000E+00
	?keep_flavors_when_clustering = false
	$sample = ""
	$sample_normalization = "auto"
	?sample_pacify = false
	?sample_select = true
	sample_max_tries = 10000
	sample_split_n_evt = 0
	sample_split_n_kbytes = 0
	sample_split_index = 0
	$rescan_input_format = "raw"
	?read_raw = true
	?write_raw = true
	$extension_raw = "evx"
	$extension_default = "evt"
	$debug_extension = "debug"
	?debug_process = true
	?debug_transforms = true
	?debug_decay = true
	?debug_verbose = true
	$dump_extension = "pset.dat"
	?dump_compressed = false
	?dump_weights = false
	?dump_summary = false
	?dump_screen = false
	?hepevt_ensure_order = false
	$extension_hepevt = "hepevt"
	$extension_ascii_short = "short.evt"
	$extension_ascii_long = "long.evt"
	$extension_athena = "athena.evt"
	$extension_mokka = "mokka.evt"
	$lhef_version = "2.0"
	$lhef_extension = "lhe"
	?lhef_write_sqme_prc = true
	?lhef_write_sqme_ref = false
	?lhef_write_sqme_alt = true
	$extension_lha = "lha"
	$extension_hepmc = "hepmc"
	?hepmc_output_cross_section = false
	$extension_lcio = "slcio"
	$extension_stdhep = "hep"
	$extension_stdhep_up = "up.hep"
	$extension_stdhep_ev4 = "ev4.hep"
	$extension_hepevt_verb = "hepevt.verb"
	$extension_lha_verb = "lha.verb"
	?allow_shower = true
	?ps_fsr_active = false
	?ps_isr_active = false
	?ps_taudec_active = false
	?muli_active = false
	$shower_method = "WHIZARD"
	?shower_verbose = false
	$ps_PYTHIA_PYGIVE = ""
	+$ps_PYTHIA8_config = ""
	+$ps_PYTHIA8_config_file = ""
	ps_mass_cutoff = 1.000000000000E+00
	ps_fsr_lambda = 2.900000000000E-01
	ps_isr_lambda = 2.900000000000E-01
	ps_max_n_flavors = 5
	?ps_isr_alphas_running = true
	?ps_fsr_alphas_running = true
	ps_fixed_alphas = 0.000000000000E+00
	?ps_isr_pt_ordered = false
	?ps_isr_angular_ordered = true
	ps_isr_primordial_kt_width = 0.000000000000E+00
	ps_isr_primordial_kt_cutoff = 5.000000000000E+00
	ps_isr_z_cutoff = 9.990000000000E-01
	ps_isr_minenergy = 1.000000000000E+00
	ps_isr_tscalefactor = 1.000000000000E+00
	?ps_isr_only_onshell_emitted_partons = false
	?allow_hadronization = true
	?hadronization_active = false
	$hadronization_method = "PYTHIA6"
	hadron_enhanced_fraction = 1.000000000000E-02
	hadron_enhanced_width = 2.000000000000E+00
	?ps_tauola_photos = false
	?ps_tauola_transverse = false
	?ps_tauola_dec_rad_cor = true
	ps_tauola_dec_mode1 = 0
	ps_tauola_dec_mode2 = 0
	ps_tauola_mh = 1.250000000000E+02
	ps_tauola_mix_angle = 9.000000000000E+01
	?ps_tauola_pol_vector = false
	?mlm_matching = false
	mlm_Qcut_ME = 0.000000000000E+00
	mlm_Qcut_PS = 0.000000000000E+00
	mlm_ptmin = 0.000000000000E+00
	mlm_etamax = 0.000000000000E+00
	mlm_Rmin = 0.000000000000E+00
	mlm_Emin = 0.000000000000E+00
	mlm_nmaxMEjets = 0
	mlm_ETclusfactor = 2.000000000000E-01
	mlm_ETclusminE = 5.000000000000E+00
	mlm_etaclusfactor = 1.000000000000E+00
	mlm_Rclusfactor = 1.000000000000E+00
	mlm_Eclusfactor = 1.000000000000E+00
	?powheg_matching = false
	?powheg_use_singular_jacobian = false
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_grid_sampling_points = 500000
	powheg_pt_min = 1.000000000000E+00
	powheg_lambda = 2.000000000000E-01
	?powheg_rebuild_grids = false
	?powheg_test_sudakov = false
	?powheg_disable_sudakov = false
	?ckkw_matching = false
	?omega_openmp = false
	?openmp_is_active* = false
	openmp_num_threads_default* = 1
	openmp_num_threads = 1
	?openmp_logging = true
	?mpi_logging = false
	$born_me_method = ""
	$loop_me_method = ""
	$correlation_me_method = ""
	$real_tree_me_method = ""
	$dglap_me_method = ""
	?test_soft_limit = false
	?test_coll_limit = false
	?test_anti_coll_limit = false
	$select_alpha_regions = ""
	$virtual_selection = "Full"
	?virtual_collinear_resonance_aware = true
	blha_top_yukawa = -1.000000000000E+00
	$blha_ew_scheme = "alpha_qed"
	openloops_verbosity = 1
	?openloops_use_cms = true
	openloops_phs_tolerance = 7
	openloops_stability_log = 0
	?openloops_switch_off_muon_yukawa = false
	$openloops_extra_cmd = ""
	?openloops_use_collier = true
	?disable_subtraction = false
	fks_dij_exp1 = 1.000000000000E+00
	fks_dij_exp2 = 1.000000000000E+00
	fks_xi_min = 1.000000000000E-07
	fks_y_max = 1.000000000000E+00
	?vis_fks_regions = false
	fks_xi_cut = 1.000000000000E+00
	fks_delta_zero = 2.000000000000E+00
	fks_delta_i = 2.000000000000E+00
	$fks_mapping_type = "default"
	$resonances_exclude_particles = "default"
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = false
	?fixed_order_nlo_events = false
	?check_event_weights_against_xsection = false
	?keep_failed_events = false
	gks_multiplicity = 0
	$gosam_filter_lo = ""
	$gosam_filter_nlo = ""
	$gosam_symmetries = "family,generation"
	form_threads = 2
	form_workspace = 1000
	$gosam_fc = ""
	mult_call_real = 1.000000000000E+00
	mult_call_virt = 1.000000000000E+00
	mult_call_dglap = 1.000000000000E+00
	$dalitz_plot = ""
	$nlo_correction_type = "QCD"
	$exclude_gauge_splittings = "c:b:t:e2:e3"
	?nlo_use_born_scale = true
	?nlo_cut_all_sqmes = true
	?nlo_use_real_partition = false
	real_partition_scale = 1.000000000000E+01
	$fc => "Fortran-compiler"
	$fcflags => "Fortran-flags"
	========================================================================
	model "Test"
	! md5sum = 'DB28187ADA60804A3CFC14A025DED784'

	parameter gy = 1.000000000000E+00
	parameter ms = 1.500000000000E+02
	parameter ff = 1.500000000000E+00
	external mf = 2.250000000000E+02

	particle SCALAR 25
	name "s"
	spin 0
	mass ms
	particle FERMION 6
	name "f"
	anti "fbar" "F"
	tex_anti "\bar{f}"
	spin 1/2 isospin 1/2 charge 2/3 color 3
	mass mf

	vertex "fbar" "f" "s"
	vertex "s" "s" "s"
	========================================================================
	Process library stack:
	------------------------------------------------------------------------
	Process library: library_2
	external = F
	makefile exists = F
	driver exists = F
	code status = o

	Process definition list: [empty]
	------------------------------------------------------------------------
	Process library: library_1
	external = F
	makefile exists = F
	driver exists = F
	code status = o

	Process definition list: [empty]
	========================================================================
	Beam structure: s, s => pdf_builtin
	========================================================================
	Cuts:
	------------------------------------------------------------------------
	+ SEQUENCE <lexpr> = <lsinglet>
	+ SEQUENCE <lsinglet> = <lterm>
	\| + SEQUENCE <lterm> = <all_fun>
	\| \| + SEQUENCE <all_fun> = all <lexpr> <pargs1>
	\| \| \| + KEYWORD all = [keyword] all
	\| \| \| + SEQUENCE <lexpr> = <lsinglet>
	\| \| \| \| + SEQUENCE <lsinglet> = <lterm>
	\| \| \| \| \| + SEQUENCE <lterm> = <compared_expr>
	\| \| \| \| \| \| + SEQUENCE <compared_expr> = <expr> <comparison>
	\| \| \| \| \| \| \| + SEQUENCE <expr> = <term>
	\| \| \| \| \| \| \| \| + SEQUENCE <term> = <factor>
	\| \| \| \| \| \| \| \| \| + SEQUENCE <factor> = <variable>
	\| \| \| \| \| \| \| \| \| \| + IDENTIFIER <variable> = Pt
	\| \| \| \| \| \| \| + SEQUENCE <comparison> = '>' <expr>
	\| \| \| \| \| \| \| \| + KEYWORD '>' = [keyword] >
	\| \| \| \| \| \| \| \| + SEQUENCE <expr> = <term>
	\| \| \| \| \| \| \| \| \| + SEQUENCE <term> = <factor>
	\| \| \| \| \| \| \| \| \| \| + SEQUENCE <factor> = <integer_value>
	\| \| \| \| \| \| \| \| \| \| \| + SEQUENCE <integer_value> = <integer_literal>
	\| \| \| \| \| \| \| \| \| \| \| \| + INTEGER <integer_literal> = 100
	\| \| \| + ARGUMENTS <pargs1> = <pexpr>
	\| \| \| \| + SEQUENCE <pexpr> = <pterm>
	\| \| \| \| \| + SEQUENCE <pterm> = <pexpr_src>
	\| \| \| \| \| \| + SEQUENCE <pexpr_src> = <unspecified_prt>
	\| \| \| \| \| \| \| + SEQUENCE <unspecified_prt> = <cexpr>
	\| \| \| \| \| \| \| \| + SEQUENCE <cexpr> = <variable>
	\| \| \| \| \| \| \| \| \| + IDENTIFIER <variable> = s
	------------------------------------------------------------------------
	Scale: [undefined]
	------------------------------------------------------------------------
	Factorization scale: [undefined]
	------------------------------------------------------------------------
	Renormalization scale: [undefined]
	------------------------------------------------------------------------
	Weight: [undefined]
	========================================================================
	Event selection: [undefined]
	------------------------------------------------------------------------
	Event reweighting factor: [undefined]
	------------------------------------------------------------------------
	Event analysis: [undefined]
	------------------------------------------------------------------------
	Event sample formats = foo_fmt, bar_fmt
	------------------------------------------------------------------------
	Event callback: NOP
	========================================================================
	Process stack: [empty]
	========================================================================
	[Processes from context environment:]
	========================================================================
	Process stack: [empty]
	========================================================================
	quit : F
	quit_code: 0
	========================================================================
	Logfile : ''
	========================================================================

	* Restore global data

	model associated = T
	library associated = T

	========================================================================
	Runtime data:
	========================================================================
	gy => 1.000000000000E+00
	ms => 1.250000000000E+02
	ff => 1.500000000000E+00
	mf* => 1.875000000000E+02
	particle* = PDG(0)
	SCALAR* = PDG(25)
	s* = PDG(25)
	FERMION* = PDG(6)
	f* = PDG(6)
	fbar* = PDG(-6)
	F* = PDG(-6)
	charged* = PDG(6, -6)
	neutral* = PDG(25)
	colored* = PDG(6, -6)
	sqrts = 1.000000000000E+03
	luminosity = 3.300000000000E+01
	?sf_trace = false
	$sf_trace_file = ""
	?sf_allow_s_mapping = true
	$lhapdf_dir = ""
	$lhapdf_file = ""
	$lhapdf_photon_file = ""
	lhapdf_member = 0
	lhapdf_photon_scheme = 0
	$pdf_builtin_set = "CTEQ6L"
	?hoppet_b_matching = false
	isr_alpha = 0.000000000000E+00
	isr_q_max = 0.000000000000E+00
	isr_mass = 0.000000000000E+00
	isr_order = 3
	?isr_recoil = false
	?isr_keep_energy = false
	?isr_handler = false
	$isr_handler_mode = "trivial"
	epa_alpha = 0.000000000000E+00
	epa_x_min = 0.000000000000E+00
	epa_q_min = 0.000000000000E+00
	epa_q_max = 0.000000000000E+00
	epa_mass = 0.000000000000E+00
	?epa_recoil = false
	?epa_keep_energy = false
	?epa_handler = false
	$epa_handler_mode = "trivial"
	ewa_x_min = 0.000000000000E+00
	ewa_pt_max = 0.000000000000E+00
	ewa_mass = 0.000000000000E+00
	?ewa_recoil = false
	?ewa_keep_energy = false
	?circe1_photon1 = false
	?circe1_photon2 = false
	[undefined] circe1_sqrts = [unknown real]
	?circe1_generate = true
	?circe1_map = true
	circe1_mapping_slope = 2.000000000000E+00
	circe1_eps = 1.000000000000E-05
	circe1_ver = 0
	circe1_rev = 0
	$circe1_acc = "SBAND"
	circe1_chat = 0
	?circe1_with_radiation = false
	?circe2_polarized = true
	[undefined] $circe2_file = [unknown string]
	$circe2_design = "*"
	gaussian_spread1 = 0.000000000000E+00
	gaussian_spread2 = 0.000000000000E+00
	[undefined] $beam_events_file = [unknown string]
	?beam_events_warn_eof = true
	?energy_scan_normalize = false
	?logging => false
	[undefined] $job_id = [unknown string]
	[undefined] $compile_workspace = [unknown string]
	seed = 0
	$model_name = "Test"
	[undefined] process_num_id = [unknown integer]
	$method = "omega"
	?report_progress = true
	[user variable] ?me_verbose = false
	$restrictions = ""
	?omega_write_phs_output = false
	$omega_flags = ""
	?read_color_factors = true
	?slha_read_input = true
	?slha_read_spectrum = true
	?slha_read_decays = false
	$library_name = "library_1"
	?alphas_is_fixed = true
	?alphas_from_lhapdf = false
	?alphas_from_pdf_builtin = false
	alphas_order = 0
	alphas_nf = 5
	?alphas_from_mz = false
	?alphas_from_lambda_qcd = false
	lambda_qcd = 2.000000000000E-01
	?fatal_beam_decay = true
	?helicity_selection_active = true
	helicity_selection_threshold = 1.000000000000E+10
	helicity_selection_cutoff = 1000
	$rng_method = "tao"
	?vis_diags = false
	?vis_diags_color = false
	?check_event_file = true
	$event_file_version = ""
	n_events = 0
	event_index_offset = 0
	?unweighted = true
	safety_factor = 1.000000000000E+00
	?negative_weights = false
	?resonance_history = false
	resonance_on_shell_limit = 4.000000000000E+00
	resonance_on_shell_turnoff = 0.000000000000E+00
	resonance_background_factor = 1.000000000000E+00
	?keep_beams = false
	?keep_remnants = true
	?recover_beams = true
	?update_event = false
	?update_sqme = false
	?update_weight = false
	?use_alphas_from_file = false
	?use_scale_from_file = false
	?allow_decays = true
	?auto_decays = false
	auto_decays_multiplicity = 2
	?auto_decays_radiative = false
	?decay_rest_frame = false
	?isotropic_decay = false
	?diagonal_decay = false
	[undefined] decay_helicity = [unknown integer]
	?polarized_events = false
	$polarization_mode = "helicity"
	?colorize_subevt = false
	tolerance = 0.000000000000E+00
	checkpoint = 0
	event_callback_interval = 0
	?pacify = false
	$out_file = ""
	?out_advance = true
	real_range* = 307
	real_precision* = 15
	real_epsilon* = 1.000000000000E-16
	real_tiny* = 1.000000000000-300
	$integration_method = "vamp"
	threshold_calls = 10
	min_calls_per_channel = 10
	min_calls_per_bin = 10
	min_bins = 3
	max_bins = 20
	?stratified = true
	?use_vamp_equivalences = true
	?vamp_verbose = false
	?vamp_history_global = true
	?vamp_history_global_verbose = false
	?vamp_history_channels = false
	?vamp_history_channels_verbose = false
	$run_id = "run1"
	n_calls_test = 0
	?integration_timer = true
	?check_grid_file = true
	accuracy_goal = 0.000000000000E+00
	error_goal = 0.000000000000E+00
	relative_error_goal = 0.000000000000E+00
	integration_results_verbosity = 1
	error_threshold = 0.000000000000E+00
	channel_weights_power = 2.500000000000E-01
	[undefined] $integrate_workspace = [unknown string]
	$phs_method = "default"
	?vis_channels = false
	?check_phs_file = true
	$phs_file = ""
	?phs_only = false
	phs_threshold_s = 5.000000000000E+01
	phs_threshold_t = 1.000000000000E+02
	phs_off_shell = 2
	phs_t_channel = 6
	phs_e_scale = 1.000000000000E+01
	phs_m_scale = 1.000000000000E+01
	phs_q_scale = 1.000000000000E+01
	?phs_keep_nonresonant = true
	?phs_step_mapping = true
	?phs_step_mapping_exp = true
	?phs_s_mapping = true
	?vis_history = false
	n_bins = 20
	?normalize_bins = false
	$obs_label = ""
	$obs_unit = ""
	$title = ""
	$description = ""
	$x_label = ""
	$y_label = ""
	graph_width_mm = 130
	graph_height_mm = 90
	?y_log = false
	?x_log = false
	[undefined] x_min = [unknown real]
	[undefined] x_max = [unknown real]
	[undefined] y_min = [unknown real]
	[undefined] y_max = [unknown real]
	$gmlcode_bg = ""
	$gmlcode_fg = ""
	[undefined] ?draw_histogram = [unknown logical]
	[undefined] ?draw_base = [unknown logical]
	[undefined] ?draw_piecewise = [unknown logical]
	[undefined] ?fill_curve = [unknown logical]
	[undefined] ?draw_curve = [unknown logical]
	[undefined] ?draw_errors = [unknown logical]
	[undefined] ?draw_symbols = [unknown logical]
	[undefined] $fill_options = [unknown string]
	[undefined] $draw_options = [unknown string]
	[undefined] $err_options = [unknown string]
	[undefined] $symbol = [unknown string]
	?analysis_file_only = false
	kt_algorithm* = 0
	cambridge_algorithm* = 1
	antikt_algorithm* = 2
	genkt_algorithm* = 3
	cambridge_for_passive_algorithm* = 11
	genkt_for_passive_algorithm* = 13
	ee_kt_algorithm* = 50
	ee_genkt_algorithm* = 53
	plugin_algorithm* = 99
	undefined_jet_algorithm* = 999
	jet_algorithm = 999
	jet_r = 0.000000000000E+00
	jet_p = 0.000000000000E+00
	jet_ycut = 0.000000000000E+00
	?keep_flavors_when_clustering = false
	$sample = ""
	$sample_normalization = "auto"
	?sample_pacify = false
	?sample_select = true
	sample_max_tries = 10000
	sample_split_n_evt = 0
	sample_split_n_kbytes = 0
	sample_split_index = 0
	$rescan_input_format = "raw"
	?read_raw = true
	?write_raw = true
	$extension_raw = "evx"
	$extension_default = "evt"
	$debug_extension = "debug"
	?debug_process = true
	?debug_transforms = true
	?debug_decay = true
	?debug_verbose = true
	$dump_extension = "pset.dat"
	?dump_compressed = false
	?dump_weights = false
	?dump_summary = false
	?dump_screen = false
	?hepevt_ensure_order = false
	$extension_hepevt = "hepevt"
	$extension_ascii_short = "short.evt"
	$extension_ascii_long = "long.evt"
	$extension_athena = "athena.evt"
	$extension_mokka = "mokka.evt"
	$lhef_version = "2.0"
	$lhef_extension = "lhe"
	?lhef_write_sqme_prc = true
	?lhef_write_sqme_ref = false
	?lhef_write_sqme_alt = true
	$extension_lha = "lha"
	$extension_hepmc = "hepmc"
	?hepmc_output_cross_section = false
	$extension_lcio = "slcio"
	$extension_stdhep = "hep"
	$extension_stdhep_up = "up.hep"
	$extension_stdhep_ev4 = "ev4.hep"
	$extension_hepevt_verb = "hepevt.verb"
	$extension_lha_verb = "lha.verb"
	?allow_shower = true
	?ps_fsr_active = false
	?ps_isr_active = false
	?ps_taudec_active = false
	?muli_active = false
	$shower_method = "WHIZARD"
	?shower_verbose = false
	$ps_PYTHIA_PYGIVE = ""
	+$ps_PYTHIA8_config = ""
	+$ps_PYTHIA8_config_file = ""
	ps_mass_cutoff = 1.000000000000E+00
	ps_fsr_lambda = 2.900000000000E-01
	ps_isr_lambda = 2.900000000000E-01
	ps_max_n_flavors = 5
	?ps_isr_alphas_running = true
	?ps_fsr_alphas_running = true
	ps_fixed_alphas = 0.000000000000E+00
	?ps_isr_pt_ordered = false
	?ps_isr_angular_ordered = true
	ps_isr_primordial_kt_width = 0.000000000000E+00
	ps_isr_primordial_kt_cutoff = 5.000000000000E+00
	ps_isr_z_cutoff = 9.990000000000E-01
	ps_isr_minenergy = 1.000000000000E+00
	ps_isr_tscalefactor = 1.000000000000E+00
	?ps_isr_only_onshell_emitted_partons = false
	?allow_hadronization = true
	?hadronization_active = false
	$hadronization_method = "PYTHIA6"
	hadron_enhanced_fraction = 1.000000000000E-02
	hadron_enhanced_width = 2.000000000000E+00
	?ps_tauola_photos = false
	?ps_tauola_transverse = false
	?ps_tauola_dec_rad_cor = true
	ps_tauola_dec_mode1 = 0
	ps_tauola_dec_mode2 = 0
	ps_tauola_mh = 1.250000000000E+02
	ps_tauola_mix_angle = 9.000000000000E+01
	?ps_tauola_pol_vector = false
	?mlm_matching = false
	mlm_Qcut_ME = 0.000000000000E+00
	mlm_Qcut_PS = 0.000000000000E+00
	mlm_ptmin = 0.000000000000E+00
	mlm_etamax = 0.000000000000E+00
	mlm_Rmin = 0.000000000000E+00
	mlm_Emin = 0.000000000000E+00
	mlm_nmaxMEjets = 0
	mlm_ETclusfactor = 2.000000000000E-01
	mlm_ETclusminE = 5.000000000000E+00
	mlm_etaclusfactor = 1.000000000000E+00
	mlm_Rclusfactor = 1.000000000000E+00
	mlm_Eclusfactor = 1.000000000000E+00
	?powheg_matching = false
	?powheg_use_singular_jacobian = false
	powheg_grid_size_xi = 5
	powheg_grid_size_y = 5
	powheg_grid_sampling_points = 500000
	powheg_pt_min = 1.000000000000E+00
	powheg_lambda = 2.000000000000E-01
	?powheg_rebuild_grids = false
	?powheg_test_sudakov = false
	?powheg_disable_sudakov = false
	?ckkw_matching = false
	?omega_openmp = false
	?openmp_is_active* = false
	openmp_num_threads_default* = 1
	openmp_num_threads = 1
	?openmp_logging = true
	?mpi_logging = false
	$born_me_method = ""
	$loop_me_method = ""
	$correlation_me_method = ""
	$real_tree_me_method = ""
	$dglap_me_method = ""
	?test_soft_limit = false
	?test_coll_limit = false
	?test_anti_coll_limit = false
	$select_alpha_regions = ""
	$virtual_selection = "Full"
	?virtual_collinear_resonance_aware = true
	blha_top_yukawa = -1.000000000000E+00
	$blha_ew_scheme = "alpha_qed"
	openloops_verbosity = 1
	?openloops_use_cms = true
	openloops_phs_tolerance = 7
	openloops_stability_log = 0
	?openloops_switch_off_muon_yukawa = false
	$openloops_extra_cmd = ""
	?openloops_use_collier = true
	?disable_subtraction = false
	fks_dij_exp1 = 1.000000000000E+00
	fks_dij_exp2 = 1.000000000000E+00
	fks_xi_min = 1.000000000000E-07
	fks_y_max = 1.000000000000E+00
	?vis_fks_regions = false
	fks_xi_cut = 1.000000000000E+00
	fks_delta_zero = 2.000000000000E+00
	fks_delta_i = 2.000000000000E+00
	$fks_mapping_type = "default"
	$resonances_exclude_particles = "default"
	alpha_power = 2
	alphas_power = 0
	?combined_nlo_integration = false
	?fixed_order_nlo_events = false
	?check_event_weights_against_xsection = false
	?keep_failed_events = false
	gks_multiplicity = 0
	$gosam_filter_lo = ""
	$gosam_filter_nlo = ""
	$gosam_symmetries = "family,generation"
	form_threads = 2
	form_workspace = 1000
	$gosam_fc = ""
	mult_call_real = 1.000000000000E+00
	mult_call_virt = 1.000000000000E+00
	mult_call_dglap = 1.000000000000E+00
	$dalitz_plot = ""
	$nlo_correction_type = "QCD"
	$exclude_gauge_splittings = "c:b:t:e2:e3"
	?nlo_use_born_scale = true
	?nlo_cut_all_sqmes = true
	?nlo_use_real_partition = false
	real_partition_scale = 1.000000000000E+01
	$fc => "Fortran-compiler"
	$fcflags => "Fortran-flags"
	========================================================================
	model "Test"
	! md5sum = 'DB28187ADA60804A3CFC14A025DED784'

	parameter gy = 1.000000000000E+00
	parameter ms = 1.250000000000E+02
	parameter ff = 1.500000000000E+00
	external mf = 1.875000000000E+02

	particle SCALAR 25
	name "s"
	spin 0
	mass ms
	particle FERMION 6
	name "f"
	anti "fbar" "F"
	tex_anti "\bar{f}"
	spin 1/2 isospin 1/2 charge 2/3 color 3
	mass mf

	vertex "fbar" "f" "s"
	vertex "s" "s" "s"
	========================================================================
	Process library stack:
	------------------------------------------------------------------------
	Process library: library_2
	external = F
	makefile exists = F
	driver exists = F
	code status = o

	Process definition list: [empty]
	------------------------------------------------------------------------
	Process library: library_1
	external = F
	makefile exists = F
	driver exists = F
	code status = o

	Process definition list: [empty]
	========================================================================
	Beam structure: s, s => pdf_builtin
	========================================================================
	Cuts:
	------------------------------------------------------------------------
	+ SEQUENCE <lexpr> = <lsinglet>
	+ SEQUENCE <lsinglet> = <lterm>
	\| + SEQUENCE <lterm> = <all_fun>
	\| \| + SEQUENCE <all_fun> = all <lexpr> <pargs1>
	\| \| \| + KEYWORD all = [keyword] all
	\| \| \| + SEQUENCE <lexpr> = <lsinglet>
	\| \| \| \| + SEQUENCE <lsinglet> = <lterm>
	\| \| \| \| \| + SEQUENCE <lterm> = <compared_expr>
	\| \| \| \| \| \| + SEQUENCE <compared_expr> = <expr> <comparison>
	\| \| \| \| \| \| \| + SEQUENCE <expr> = <term>
	\| \| \| \| \| \| \| \| + SEQUENCE <term> = <factor>
	\| \| \| \| \| \| \| \| \| + SEQUENCE <factor> = <variable>
	\| \| \| \| \| \| \| \| \| \| + IDENTIFIER <variable> = Pt
	\| \| \| \| \| \| \| + SEQUENCE <comparison> = '>' <expr>
	\| \| \| \| \| \| \| \| + KEYWORD '>' = [keyword] >
	\| \| \| \| \| \| \| \| + SEQUENCE <expr> = <term>
	\| \| \| \| \| \| \| \| \| + SEQUENCE <term> = <factor>
	\| \| \| \| \| \| \| \| \| \| + SEQUENCE <factor> = <integer_value>
	\| \| \| \| \| \| \| \| \| \| \| + SEQUENCE <integer_value> = <integer_literal>
	\| \| \| \| \| \| \| \| \| \| \| \| + INTEGER <integer_literal> = 100
	\| \| \| + ARGUMENTS <pargs1> = <pexpr>
	\| \| \| \| + SEQUENCE <pexpr> = <pterm>
	\| \| \| \| \| + SEQUENCE <pterm> = <pexpr_src>
	\| \| \| \| \| \| + SEQUENCE <pexpr_src> = <unspecified_prt>
	\| \| \| \| \| \| \| + SEQUENCE <unspecified_prt> = <cexpr>
	\| \| \| \| \| \| \| \| + SEQUENCE <cexpr> = <variable>
	\| \| \| \| \| \| \| \| \| + IDENTIFIER <variable> = s
	------------------------------------------------------------------------
	Scale: [undefined]
	------------------------------------------------------------------------
	Factorization scale: [undefined]
	------------------------------------------------------------------------
	Renormalization scale: [undefined]
	------------------------------------------------------------------------
	Weight: [undefined]
	========================================================================
	Event selection: [undefined]
	------------------------------------------------------------------------
	Event reweighting factor: [undefined]
	------------------------------------------------------------------------
	Event analysis: [undefined]
	------------------------------------------------------------------------
	Event sample formats = foo_fmt, bar_fmt
	------------------------------------------------------------------------
	Event callback: [undefined]
	========================================================================
	Process stack: [empty]
	========================================================================
	quit : F
	quit_code: 0
	========================================================================
	Logfile : ''
	========================================================================

	* Cleanup

	* Test output end: rt_data_3
	Index: trunk/share/tests/Makefile.am
	===================================================================
	--- trunk/share/tests/Makefile.am (revision 8189)
	+++ trunk/share/tests/Makefile.am (revision 8190)
	@@ -1,1374 +1,1377 @@
	## Makefile.am -- Makefile for WHIZARD tests
	##
	## Process this file with automake to produce Makefile.in
	##
	########################################################################
	#
	# Copyright (C) 1999-2018 by
	# Wolfgang Kilian <kilian@physik.uni-siegen.de>
	# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
	# Juergen Reuter <juergen.reuter@desy.de>
	# with contributions from
	# cf. main AUTHORS file
	#
	# WHIZARD is free software; you can redistribute it and/or modify it
	# under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 2, or (at your option)
	# any later version.
	#
	# WHIZARD is distributed in the hope that it will be useful, but
	# WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	# GNU General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with this program; if not, write to the Free Software
	# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
	#
	########################################################################

	EXTRA_DIST = \
	$(TESTSUITE_MACROS) $(TESTSUITES_M4) $(TESTSUITES_SIN) \
	$(TESTSUITE_TOOLS) \
	$(REF_OUTPUT_FILES) \
	cascades2_lexer_1.fds \
	cascades2_1.fds \
	cascades2_2.fds \
	functional_tests/structure_2_inc.sin functional_tests/testproc_3.phs \
	functional_tests/user_cuts.f90 \
	functional_tests/susyhit.in \
	ext_tests_nmssm/nmssm.slha

	TESTSUITE_MACROS = testsuite.m4
	TESTSUITE_TOOLS = \
	check-debug-output.py \
	check-debug-output-hadro.py \
	check-hepmc-weights.py \
	compare-integrals.py \
	compare-integrals-multi.py \
	compare-methods.py \
	compare-histograms.py

	REF_OUTPUT_FILES = \
	extra_integration_results.dat \
	$(REF_OUTPUT_FILES_BASE) $(REF_OUTPUT_FILES_DOUBLE) \
	$(REF_OUTPUT_FILES_PREC) $(REF_OUTPUT_FILES_EXT) \
	$(REF_OUTPUT_FILES_QUAD)

	REF_OUTPUT_FILES_BASE = \
	unit_tests/ref-output/analysis_1.ref \
	unit_tests/ref-output/pdg_arrays_1.ref \
	unit_tests/ref-output/pdg_arrays_2.ref \
	unit_tests/ref-output/pdg_arrays_3.ref \
	unit_tests/ref-output/pdg_arrays_4.ref \
	unit_tests/ref-output/pdg_arrays_5.ref \
	unit_tests/ref-output/expressions_1.ref \
	unit_tests/ref-output/expressions_2.ref \
	unit_tests/ref-output/expressions_3.ref \
	unit_tests/ref-output/expressions_4.ref \
	unit_tests/ref-output/su_algebra_1.ref \
	unit_tests/ref-output/su_algebra_2.ref \
	unit_tests/ref-output/su_algebra_3.ref \
	unit_tests/ref-output/su_algebra_4.ref \
	unit_tests/ref-output/bloch_vectors_1.ref \
	unit_tests/ref-output/bloch_vectors_2.ref \
	unit_tests/ref-output/bloch_vectors_3.ref \
	unit_tests/ref-output/bloch_vectors_4.ref \
	unit_tests/ref-output/bloch_vectors_5.ref \
	unit_tests/ref-output/bloch_vectors_6.ref \
	unit_tests/ref-output/bloch_vectors_7.ref \
	unit_tests/ref-output/polarization_1.ref \
	unit_tests/ref-output/polarization_2.ref \
	unit_tests/ref-output/beam_1.ref \
	unit_tests/ref-output/beam_2.ref \
	unit_tests/ref-output/beam_3.ref \
	unit_tests/ref-output/md5_1.ref \
	unit_tests/ref-output/cputime_1.ref \
	unit_tests/ref-output/cputime_2.ref \
	unit_tests/ref-output/lexer_1.ref \
	unit_tests/ref-output/parse_1.ref \
	unit_tests/ref-output/color_1.ref \
	unit_tests/ref-output/color_2.ref \
	unit_tests/ref-output/os_interface_1.ref \
	unit_tests/ref-output/evaluator_1.ref \
	unit_tests/ref-output/evaluator_2.ref \
	unit_tests/ref-output/evaluator_3.ref \
	unit_tests/ref-output/evaluator_4.ref \
	unit_tests/ref-output/format_1.ref \
	unit_tests/ref-output/sorting_1.ref \
	unit_tests/ref-output/grids_1.ref \
	unit_tests/ref-output/grids_2.ref \
	unit_tests/ref-output/grids_3.ref \
	unit_tests/ref-output/grids_4.ref \
	unit_tests/ref-output/grids_5.ref \
	unit_tests/ref-output/solver_1.ref \
	unit_tests/ref-output/state_matrix_1.ref \
	unit_tests/ref-output/state_matrix_2.ref \
	unit_tests/ref-output/state_matrix_3.ref \
	unit_tests/ref-output/state_matrix_4.ref \
	unit_tests/ref-output/state_matrix_5.ref \
	unit_tests/ref-output/state_matrix_6.ref \
	unit_tests/ref-output/state_matrix_7.ref \
	unit_tests/ref-output/interaction_1.ref \
	unit_tests/ref-output/xml_1.ref \
	unit_tests/ref-output/xml_2.ref \
	unit_tests/ref-output/xml_3.ref \
	unit_tests/ref-output/xml_4.ref \
	unit_tests/ref-output/sm_qcd_1.ref \
	unit_tests/ref-output/sm_physics_1.ref \
	unit_tests/ref-output/sm_physics_2.ref \
	unit_tests/ref-output/models_1.ref \
	unit_tests/ref-output/models_2.ref \
	unit_tests/ref-output/models_3.ref \
	unit_tests/ref-output/models_4.ref \
	unit_tests/ref-output/models_5.ref \
	unit_tests/ref-output/models_6.ref \
	unit_tests/ref-output/models_7.ref \
	unit_tests/ref-output/models_8.ref \
	unit_tests/ref-output/models_9.ref \
	unit_tests/ref-output/auto_components_1.ref \
	unit_tests/ref-output/auto_components_2.ref \
	unit_tests/ref-output/auto_components_3.ref \
	unit_tests/ref-output/radiation_generator_1.ref \
	unit_tests/ref-output/radiation_generator_2.ref \
	unit_tests/ref-output/radiation_generator_3.ref \
	unit_tests/ref-output/radiation_generator_4.ref \
	unit_tests/ref-output/particles_1.ref \
	unit_tests/ref-output/particles_2.ref \
	unit_tests/ref-output/particles_3.ref \
	unit_tests/ref-output/particles_4.ref \
	unit_tests/ref-output/particles_5.ref \
	unit_tests/ref-output/particles_6.ref \
	unit_tests/ref-output/particles_7.ref \
	unit_tests/ref-output/particles_8.ref \
	unit_tests/ref-output/particles_9.ref \
	unit_tests/ref-output/beam_structures_1.ref \
	unit_tests/ref-output/beam_structures_2.ref \
	unit_tests/ref-output/beam_structures_3.ref \
	unit_tests/ref-output/beam_structures_4.ref \
	unit_tests/ref-output/beam_structures_5.ref \
	unit_tests/ref-output/beam_structures_6.ref \
	unit_tests/ref-output/sf_aux_1.ref \
	unit_tests/ref-output/sf_aux_2.ref \
	unit_tests/ref-output/sf_aux_3.ref \
	unit_tests/ref-output/sf_aux_4.ref \
	unit_tests/ref-output/sf_mappings_1.ref \
	unit_tests/ref-output/sf_mappings_2.ref \
	unit_tests/ref-output/sf_mappings_3.ref \
	unit_tests/ref-output/sf_mappings_4.ref \
	unit_tests/ref-output/sf_mappings_5.ref \
	unit_tests/ref-output/sf_mappings_6.ref \
	unit_tests/ref-output/sf_mappings_7.ref \
	unit_tests/ref-output/sf_mappings_8.ref \
	unit_tests/ref-output/sf_mappings_9.ref \
	unit_tests/ref-output/sf_mappings_10.ref \
	unit_tests/ref-output/sf_mappings_11.ref \
	unit_tests/ref-output/sf_mappings_12.ref \
	unit_tests/ref-output/sf_mappings_13.ref \
	unit_tests/ref-output/sf_mappings_14.ref \
	unit_tests/ref-output/sf_mappings_15.ref \
	unit_tests/ref-output/sf_mappings_16.ref \
	unit_tests/ref-output/sf_base_1.ref \
	unit_tests/ref-output/sf_base_2.ref \
	unit_tests/ref-output/sf_base_3.ref \
	unit_tests/ref-output/sf_base_4.ref \
	unit_tests/ref-output/sf_base_5.ref \
	unit_tests/ref-output/sf_base_6.ref \
	unit_tests/ref-output/sf_base_7.ref \
	unit_tests/ref-output/sf_base_8.ref \
	unit_tests/ref-output/sf_base_9.ref \
	unit_tests/ref-output/sf_base_10.ref \
	unit_tests/ref-output/sf_base_11.ref \
	unit_tests/ref-output/sf_base_12.ref \
	unit_tests/ref-output/sf_base_13.ref \
	unit_tests/ref-output/sf_base_14.ref \
	unit_tests/ref-output/sf_pdf_builtin_1.ref \
	unit_tests/ref-output/sf_pdf_builtin_2.ref \
	unit_tests/ref-output/sf_pdf_builtin_3.ref \
	unit_tests/ref-output/sf_lhapdf5_1.ref \
	unit_tests/ref-output/sf_lhapdf5_2.ref \
	unit_tests/ref-output/sf_lhapdf5_3.ref \
	unit_tests/ref-output/sf_lhapdf6_1.ref \
	unit_tests/ref-output/sf_lhapdf6_2.ref \
	unit_tests/ref-output/sf_lhapdf6_3.ref \
	unit_tests/ref-output/sf_isr_1.ref \
	unit_tests/ref-output/sf_isr_2.ref \
	unit_tests/ref-output/sf_isr_3.ref \
	unit_tests/ref-output/sf_isr_4.ref \
	unit_tests/ref-output/sf_isr_5.ref \
	unit_tests/ref-output/sf_epa_1.ref \
	unit_tests/ref-output/sf_epa_2.ref \
	unit_tests/ref-output/sf_epa_3.ref \
	unit_tests/ref-output/sf_epa_4.ref \
	unit_tests/ref-output/sf_epa_5.ref \
	unit_tests/ref-output/sf_ewa_1.ref \
	unit_tests/ref-output/sf_ewa_2.ref \
	unit_tests/ref-output/sf_ewa_3.ref \
	unit_tests/ref-output/sf_ewa_4.ref \
	unit_tests/ref-output/sf_ewa_5.ref \
	unit_tests/ref-output/sf_circe1_1.ref \
	unit_tests/ref-output/sf_circe1_2.ref \
	unit_tests/ref-output/sf_circe1_3.ref \
	unit_tests/ref-output/sf_circe2_1.ref \
	unit_tests/ref-output/sf_circe2_2.ref \
	unit_tests/ref-output/sf_circe2_3.ref \
	unit_tests/ref-output/sf_gaussian_1.ref \
	unit_tests/ref-output/sf_gaussian_2.ref \
	unit_tests/ref-output/sf_beam_events_1.ref \
	unit_tests/ref-output/sf_beam_events_2.ref \
	unit_tests/ref-output/sf_beam_events_3.ref \
	unit_tests/ref-output/sf_escan_1.ref \
	unit_tests/ref-output/sf_escan_2.ref \
	unit_tests/ref-output/phs_base_1.ref \
	unit_tests/ref-output/phs_base_2.ref \
	unit_tests/ref-output/phs_base_3.ref \
	unit_tests/ref-output/phs_base_4.ref \
	unit_tests/ref-output/phs_base_5.ref \
	unit_tests/ref-output/phs_none_1.ref \
	unit_tests/ref-output/phs_single_1.ref \
	unit_tests/ref-output/phs_single_2.ref \
	unit_tests/ref-output/phs_single_3.ref \
	unit_tests/ref-output/phs_single_4.ref \
	unit_tests/ref-output/phs_rambo_1.ref \
	unit_tests/ref-output/phs_rambo_2.ref \
	unit_tests/ref-output/phs_rambo_3.ref \
	unit_tests/ref-output/phs_rambo_4.ref \
	unit_tests/ref-output/resonances_1.ref \
	unit_tests/ref-output/resonances_2.ref \
	unit_tests/ref-output/resonances_3.ref \
	unit_tests/ref-output/resonances_4.ref \
	unit_tests/ref-output/resonances_5.ref \
	unit_tests/ref-output/resonances_6.ref \
	unit_tests/ref-output/resonances_7.ref \
	unit_tests/ref-output/phs_tree_1.ref \
	unit_tests/ref-output/phs_tree_2.ref \
	unit_tests/ref-output/phs_forest_1.ref \
	unit_tests/ref-output/phs_forest_2.ref \
	unit_tests/ref-output/phs_wood_1.ref \
	unit_tests/ref-output/phs_wood_2.ref \
	unit_tests/ref-output/phs_wood_3.ref \
	unit_tests/ref-output/phs_wood_4.ref \
	unit_tests/ref-output/phs_wood_5.ref \
	unit_tests/ref-output/phs_wood_6.ref \
	unit_tests/ref-output/phs_wood_vis_1.ref \
	unit_tests/ref-output/phs_fks_generator_1.ref \
	unit_tests/ref-output/phs_fks_generator_2.ref \
	unit_tests/ref-output/phs_fks_generator_3.ref \
	unit_tests/ref-output/phs_fks_generator_4.ref \
	unit_tests/ref-output/phs_fks_generator_5.ref \
	unit_tests/ref-output/phs_fks_generator_6.ref \
	unit_tests/ref-output/phs_fks_generator_7.ref \
	unit_tests/ref-output/fks_regions_1.ref \
	unit_tests/ref-output/fks_regions_2.ref \
	unit_tests/ref-output/fks_regions_3.ref \
	unit_tests/ref-output/fks_regions_4.ref \
	unit_tests/ref-output/fks_regions_5.ref \
	unit_tests/ref-output/fks_regions_6.ref \
	unit_tests/ref-output/fks_regions_7.ref \
	unit_tests/ref-output/fks_regions_8.ref \
	unit_tests/ref-output/real_subtraction_1.ref \
	unit_tests/ref-output/prc_recola_1.ref \
	unit_tests/ref-output/prc_recola_2.ref \
	unit_tests/ref-output/rng_base_1.ref \
	unit_tests/ref-output/rng_base_2.ref \
	unit_tests/ref-output/rng_tao_1.ref \
	unit_tests/ref-output/rng_tao_2.ref \
	unit_tests/ref-output/rng_stream_1.ref \
	unit_tests/ref-output/rng_stream_2.ref \
	unit_tests/ref-output/rng_stream_3.ref \
	unit_tests/ref-output/selectors_1.ref \
	unit_tests/ref-output/selectors_2.ref \
	unit_tests/ref-output/vegas_1.ref \
	unit_tests/ref-output/vegas_2.ref \
	unit_tests/ref-output/vegas_3.ref \
	unit_tests/ref-output/vegas_4.ref \
	unit_tests/ref-output/vegas_5.ref \
	unit_tests/ref-output/vegas_6.ref \
	unit_tests/ref-output/vamp2_1.ref \
	unit_tests/ref-output/vamp2_2.ref \
	unit_tests/ref-output/vamp2_3.ref \
	unit_tests/ref-output/vamp2_4.ref \
	unit_tests/ref-output/vamp2_5.ref \
	unit_tests/ref-output/mci_base_1.ref \
	unit_tests/ref-output/mci_base_2.ref \
	unit_tests/ref-output/mci_base_3.ref \
	unit_tests/ref-output/mci_base_4.ref \
	unit_tests/ref-output/mci_base_5.ref \
	unit_tests/ref-output/mci_base_6.ref \
	unit_tests/ref-output/mci_base_7.ref \
	unit_tests/ref-output/mci_base_8.ref \
	unit_tests/ref-output/mci_none_1.ref \
	unit_tests/ref-output/mci_midpoint_1.ref \
	unit_tests/ref-output/mci_midpoint_2.ref \
	unit_tests/ref-output/mci_midpoint_3.ref \
	unit_tests/ref-output/mci_midpoint_4.ref \
	unit_tests/ref-output/mci_midpoint_5.ref \
	unit_tests/ref-output/mci_midpoint_6.ref \
	unit_tests/ref-output/mci_midpoint_7.ref \
	unit_tests/ref-output/mci_vamp_1.ref \
	unit_tests/ref-output/mci_vamp_2.ref \
	unit_tests/ref-output/mci_vamp_3.ref \
	unit_tests/ref-output/mci_vamp_4.ref \
	unit_tests/ref-output/mci_vamp_5.ref \
	unit_tests/ref-output/mci_vamp_6.ref \
	unit_tests/ref-output/mci_vamp_7.ref \
	unit_tests/ref-output/mci_vamp_8.ref \
	unit_tests/ref-output/mci_vamp_9.ref \
	unit_tests/ref-output/mci_vamp_10.ref \
	unit_tests/ref-output/mci_vamp_11.ref \
	unit_tests/ref-output/mci_vamp_12.ref \
	unit_tests/ref-output/mci_vamp_13.ref \
	unit_tests/ref-output/mci_vamp_14.ref \
	unit_tests/ref-output/mci_vamp_15.ref \
	unit_tests/ref-output/mci_vamp_16.ref \
	unit_tests/ref-output/mci_vamp2_1.ref \
	unit_tests/ref-output/mci_vamp2_2.ref \
	unit_tests/ref-output/mci_vamp2_3.ref \
	unit_tests/ref-output/integration_results_1.ref \
	unit_tests/ref-output/integration_results_2.ref \
	unit_tests/ref-output/integration_results_3.ref \
	unit_tests/ref-output/integration_results_4.ref \
	unit_tests/ref-output/integration_results_5.ref \
	unit_tests/ref-output/prclib_interfaces_1.ref \
	unit_tests/ref-output/prclib_interfaces_2.ref \
	unit_tests/ref-output/prclib_interfaces_3.ref \
	unit_tests/ref-output/prclib_interfaces_4.ref \
	unit_tests/ref-output/prclib_interfaces_5.ref \
	unit_tests/ref-output/prclib_interfaces_6.ref \
	unit_tests/ref-output/prclib_interfaces_7.ref \
	unit_tests/ref-output/particle_specifiers_1.ref \
	unit_tests/ref-output/particle_specifiers_2.ref \
	unit_tests/ref-output/process_libraries_1.ref \
	unit_tests/ref-output/process_libraries_2.ref \
	unit_tests/ref-output/process_libraries_3.ref \
	unit_tests/ref-output/process_libraries_4.ref \
	unit_tests/ref-output/process_libraries_5.ref \
	unit_tests/ref-output/process_libraries_6.ref \
	unit_tests/ref-output/process_libraries_7.ref \
	unit_tests/ref-output/process_libraries_8.ref \
	unit_tests/ref-output/prclib_stacks_1.ref \
	unit_tests/ref-output/prclib_stacks_2.ref \
	unit_tests/ref-output/slha_1.ref \
	unit_tests/ref-output/slha_2.ref \
	unit_tests/ref-output/prc_test_1.ref \
	unit_tests/ref-output/prc_test_2.ref \
	unit_tests/ref-output/prc_test_3.ref \
	unit_tests/ref-output/prc_test_4.ref \
	unit_tests/ref-output/prc_template_me_1.ref \
	unit_tests/ref-output/prc_template_me_2.ref \
	unit_tests/ref-output/prc_omega_1.ref \
	unit_tests/ref-output/prc_omega_2.ref \
	unit_tests/ref-output/prc_omega_3.ref \
	unit_tests/ref-output/prc_omega_4.ref \
	unit_tests/ref-output/prc_omega_5.ref \
	unit_tests/ref-output/prc_omega_6.ref \
	unit_tests/ref-output/prc_omega_diags_1.ref \
	unit_tests/ref-output/parton_states_1.ref \
	unit_tests/ref-output/subevt_expr_1.ref \
	unit_tests/ref-output/subevt_expr_2.ref \
	unit_tests/ref-output/processes_1.ref \
	unit_tests/ref-output/processes_2.ref \
	unit_tests/ref-output/processes_3.ref \
	unit_tests/ref-output/processes_4.ref \
	unit_tests/ref-output/processes_5.ref \
	unit_tests/ref-output/processes_6.ref \
	unit_tests/ref-output/processes_7.ref \
	unit_tests/ref-output/processes_8.ref \
	unit_tests/ref-output/processes_9.ref \
	unit_tests/ref-output/processes_10.ref \
	unit_tests/ref-output/processes_11.ref \
	unit_tests/ref-output/processes_12.ref \
	unit_tests/ref-output/processes_13.ref \
	unit_tests/ref-output/processes_14.ref \
	unit_tests/ref-output/processes_15.ref \
	unit_tests/ref-output/processes_16.ref \
	unit_tests/ref-output/processes_17.ref \
	unit_tests/ref-output/processes_18.ref \
	unit_tests/ref-output/processes_19.ref \
	unit_tests/ref-output/process_stacks_1.ref \
	unit_tests/ref-output/process_stacks_2.ref \
	unit_tests/ref-output/process_stacks_3.ref \
	unit_tests/ref-output/process_stacks_4.ref \
	unit_tests/ref-output/cascades_1.ref \
	unit_tests/ref-output/cascades_2.ref \
	unit_tests/ref-output/cascades2_lexer_1.ref \
	unit_tests/ref-output/cascades2_1.ref \
	unit_tests/ref-output/cascades2_2.ref \
	unit_tests/ref-output/event_transforms_1.ref \
	unit_tests/ref-output/recoil_kinematics_1.ref \
	unit_tests/ref-output/recoil_kinematics_2.ref \
	unit_tests/ref-output/recoil_kinematics_3.ref \
	unit_tests/ref-output/recoil_kinematics_4.ref \
	unit_tests/ref-output/recoil_kinematics_5.ref \
	unit_tests/ref-output/resonance_insertion_1.ref \
	unit_tests/ref-output/resonance_insertion_2.ref \
	unit_tests/ref-output/resonance_insertion_3.ref \
	unit_tests/ref-output/resonance_insertion_4.ref \
	unit_tests/ref-output/resonance_insertion_5.ref \
	unit_tests/ref-output/resonance_insertion_6.ref \
	unit_tests/ref-output/isr_handler_1.ref \
	unit_tests/ref-output/isr_handler_2.ref \
	unit_tests/ref-output/isr_handler_3.ref \
	unit_tests/ref-output/epa_handler_1.ref \
	unit_tests/ref-output/epa_handler_2.ref \
	unit_tests/ref-output/epa_handler_3.ref \
	unit_tests/ref-output/decays_1.ref \
	unit_tests/ref-output/decays_2.ref \
	unit_tests/ref-output/decays_3.ref \
	unit_tests/ref-output/decays_4.ref \
	unit_tests/ref-output/decays_5.ref \
	unit_tests/ref-output/decays_6.ref \
	unit_tests/ref-output/shower_1.ref \
	unit_tests/ref-output/shower_2.ref \
	unit_tests/ref-output/shower_base_1.ref \
	unit_tests/ref-output/events_1.ref \
	unit_tests/ref-output/events_2.ref \
	unit_tests/ref-output/events_3.ref \
	unit_tests/ref-output/events_4.ref \
	unit_tests/ref-output/events_5.ref \
	unit_tests/ref-output/events_6.ref \
	unit_tests/ref-output/events_7.ref \
	unit_tests/ref-output/hep_events_1.ref \
	unit_tests/ref-output/eio_data_1.ref \
	unit_tests/ref-output/eio_data_2.ref \
	unit_tests/ref-output/eio_base_1.ref \
	unit_tests/ref-output/eio_direct_1.ref \
	unit_tests/ref-output/eio_raw_1.ref \
	unit_tests/ref-output/eio_raw_2.ref \
	unit_tests/ref-output/eio_checkpoints_1.ref \
	unit_tests/ref-output/eio_lhef_1.ref \
	unit_tests/ref-output/eio_lhef_2.ref \
	unit_tests/ref-output/eio_lhef_3.ref \
	unit_tests/ref-output/eio_lhef_4.ref \
	unit_tests/ref-output/eio_lhef_5.ref \
	unit_tests/ref-output/eio_lhef_6.ref \
	unit_tests/ref-output/eio_stdhep_1.ref \
	unit_tests/ref-output/eio_stdhep_2.ref \
	unit_tests/ref-output/eio_stdhep_3.ref \
	unit_tests/ref-output/eio_stdhep_4.ref \
	unit_tests/ref-output/eio_hepmc_1.ref \
	unit_tests/ref-output/eio_hepmc_2.ref \
	unit_tests/ref-output/eio_lcio_1.ref \
	unit_tests/ref-output/eio_lcio_2.ref \
	unit_tests/ref-output/eio_ascii_1.ref \
	unit_tests/ref-output/eio_ascii_2.ref \
	unit_tests/ref-output/eio_ascii_3.ref \
	unit_tests/ref-output/eio_ascii_4.ref \
	unit_tests/ref-output/eio_ascii_5.ref \
	unit_tests/ref-output/eio_ascii_6.ref \
	unit_tests/ref-output/eio_ascii_7.ref \
	unit_tests/ref-output/eio_ascii_8.ref \
	unit_tests/ref-output/eio_ascii_9.ref \
	unit_tests/ref-output/eio_ascii_10.ref \
	unit_tests/ref-output/eio_weights_1.ref \
	unit_tests/ref-output/eio_weights_2.ref \
	unit_tests/ref-output/eio_weights_3.ref \
	unit_tests/ref-output/eio_dump_1.ref \
	unit_tests/ref-output/iterations_1.ref \
	unit_tests/ref-output/iterations_2.ref \
	unit_tests/ref-output/rt_data_1.ref \
	unit_tests/ref-output/rt_data_2.ref \
	unit_tests/ref-output/rt_data_3.ref \
	unit_tests/ref-output/rt_data_4.ref \
	unit_tests/ref-output/rt_data_5.ref \
	unit_tests/ref-output/rt_data_6.ref \
	unit_tests/ref-output/rt_data_7.ref \
	unit_tests/ref-output/rt_data_8.ref \
	unit_tests/ref-output/rt_data_9.ref \
	unit_tests/ref-output/rt_data_10.ref \
	unit_tests/ref-output/rt_data_11.ref \
	unit_tests/ref-output/dispatch_1.ref \
	unit_tests/ref-output/dispatch_2.ref \
	unit_tests/ref-output/dispatch_7.ref \
	unit_tests/ref-output/dispatch_8.ref \
	unit_tests/ref-output/dispatch_10.ref \
	unit_tests/ref-output/dispatch_11.ref \
	unit_tests/ref-output/dispatch_rng_1.ref \
	unit_tests/ref-output/dispatch_phs_1.ref \
	unit_tests/ref-output/dispatch_phs_2.ref \
	unit_tests/ref-output/dispatch_mci_1.ref \
	unit_tests/ref-output/dispatch_transforms_1.ref \
	unit_tests/ref-output/dispatch_transforms_2.ref \
	unit_tests/ref-output/process_configurations_1.ref \
	unit_tests/ref-output/process_configurations_2.ref \
	unit_tests/ref-output/event_streams_1.ref \
	unit_tests/ref-output/event_streams_2.ref \
	unit_tests/ref-output/event_streams_3.ref \
	unit_tests/ref-output/event_streams_4.ref \
	unit_tests/ref-output/compilations_1.ref \
	unit_tests/ref-output/compilations_2.ref \
	unit_tests/ref-output/compilations_3.ref \
	unit_tests/ref-output/compilations_static_1.ref \
	unit_tests/ref-output/compilations_static_2.ref \
	unit_tests/ref-output/integrations_1.ref \
	unit_tests/ref-output/integrations_2.ref \
	unit_tests/ref-output/integrations_3.ref \
	unit_tests/ref-output/integrations_4.ref \
	unit_tests/ref-output/integrations_5.ref \
	unit_tests/ref-output/integrations_6.ref \
	unit_tests/ref-output/integrations_7.ref \
	unit_tests/ref-output/integrations_8.ref \
	unit_tests/ref-output/integrations_9.ref \
	unit_tests/ref-output/integrations_history_1.ref \
	unit_tests/ref-output/restricted_subprocesses_1.ref \
	unit_tests/ref-output/restricted_subprocesses_2.ref \
	unit_tests/ref-output/restricted_subprocesses_3.ref \
	unit_tests/ref-output/restricted_subprocesses_4.ref \
	unit_tests/ref-output/restricted_subprocesses_5.ref \
	unit_tests/ref-output/restricted_subprocesses_6.ref \
	unit_tests/ref-output/simulations_1.ref \
	unit_tests/ref-output/simulations_2.ref \
	unit_tests/ref-output/simulations_3.ref \
	unit_tests/ref-output/simulations_4.ref \
	unit_tests/ref-output/simulations_5.ref \
	unit_tests/ref-output/simulations_6.ref \
	unit_tests/ref-output/simulations_7.ref \
	unit_tests/ref-output/simulations_8.ref \
	unit_tests/ref-output/simulations_9.ref \
	unit_tests/ref-output/simulations_10.ref \
	unit_tests/ref-output/simulations_11.ref \
	unit_tests/ref-output/simulations_12.ref \
	unit_tests/ref-output/simulations_13.ref \
	unit_tests/ref-output/simulations_14.ref \
	unit_tests/ref-output/simulations_15.ref \
	unit_tests/ref-output/commands_1.ref \
	unit_tests/ref-output/commands_2.ref \
	unit_tests/ref-output/commands_3.ref \
	unit_tests/ref-output/commands_4.ref \
	unit_tests/ref-output/commands_5.ref \
	unit_tests/ref-output/commands_6.ref \
	unit_tests/ref-output/commands_7.ref \
	unit_tests/ref-output/commands_8.ref \
	unit_tests/ref-output/commands_9.ref \
	unit_tests/ref-output/commands_10.ref \
	unit_tests/ref-output/commands_11.ref \
	unit_tests/ref-output/commands_12.ref \
	unit_tests/ref-output/commands_13.ref \
	unit_tests/ref-output/commands_14.ref \
	unit_tests/ref-output/commands_15.ref \
	unit_tests/ref-output/commands_16.ref \
	unit_tests/ref-output/commands_17.ref \
	unit_tests/ref-output/commands_18.ref \
	unit_tests/ref-output/commands_19.ref \
	unit_tests/ref-output/commands_20.ref \
	unit_tests/ref-output/commands_21.ref \
	unit_tests/ref-output/commands_22.ref \
	unit_tests/ref-output/commands_23.ref \
	unit_tests/ref-output/commands_24.ref \
	unit_tests/ref-output/commands_25.ref \
	unit_tests/ref-output/commands_26.ref \
	unit_tests/ref-output/commands_27.ref \
	unit_tests/ref-output/commands_28.ref \
	unit_tests/ref-output/commands_29.ref \
	unit_tests/ref-output/commands_30.ref \
	unit_tests/ref-output/commands_31.ref \
	unit_tests/ref-output/commands_32.ref \
	unit_tests/ref-output/commands_33.ref \
	unit_tests/ref-output/commands_34.ref \
	unit_tests/ref-output/jets_1.ref \
	unit_tests/ref-output/hepmc_interface_1.ref \
	unit_tests/ref-output/lcio_interface_1.ref \
	unit_tests/ref-output/ttv_formfactors_1.ref \
	unit_tests/ref-output/ttv_formfactors_2.ref \
	unit_tests/ref-output/blha_1.ref \
	unit_tests/ref-output/blha_2.ref \
	unit_tests/ref-output/blha_3.ref \
	+ unit_tests/ref-output/whizard_lha_1.ref \
	functional_tests/ref-output/pack_1.ref \
	functional_tests/ref-output/structure_1.ref \
	functional_tests/ref-output/structure_2.ref \
	functional_tests/ref-output/structure_3.ref \
	functional_tests/ref-output/structure_4.ref \
	functional_tests/ref-output/structure_5.ref \
	functional_tests/ref-output/structure_6.ref \
	functional_tests/ref-output/structure_7.ref \
	functional_tests/ref-output/structure_8.ref \
	functional_tests/ref-output/vars.ref \
	functional_tests/ref-output/extpar.ref \
	functional_tests/ref-output/testproc_1.ref \
	functional_tests/ref-output/testproc_2.ref \
	functional_tests/ref-output/testproc_3.ref \
	functional_tests/ref-output/testproc_4.ref \
	functional_tests/ref-output/testproc_5.ref \
	functional_tests/ref-output/testproc_6.ref \
	functional_tests/ref-output/testproc_7.ref \
	functional_tests/ref-output/testproc_8.ref \
	functional_tests/ref-output/testproc_9.ref \
	functional_tests/ref-output/testproc_10.ref \
	functional_tests/ref-output/testproc_11.ref \
	functional_tests/ref-output/testproc_12.ref \
	functional_tests/ref-output/template_me_1.ref \
	functional_tests/ref-output/template_me_2.ref \
	functional_tests/ref-output/susyhit.ref \
	functional_tests/ref-output/restrictions.ref \
	functional_tests/ref-output/process_log.ref \
	functional_tests/ref-output/static_1.ref \
	functional_tests/ref-output/static_2.ref \
	functional_tests/ref-output/libraries_1.ref \
	functional_tests/ref-output/libraries_2.ref \
	functional_tests/ref-output/libraries_4.ref \
	functional_tests/ref-output/job_id_1.ref \
	functional_tests/ref-output/job_id_2.ref \
	functional_tests/ref-output/job_id_3.ref \
	functional_tests/ref-output/job_id_4.ref \
	functional_tests/ref-output/rebuild_2.ref \
	functional_tests/ref-output/rebuild_3.ref \
	functional_tests/ref-output/rebuild_4.ref \
	functional_tests/ref-output/fatal.ref \
	functional_tests/ref-output/model_change_1.ref \
	functional_tests/ref-output/model_change_2.ref \
	functional_tests/ref-output/model_scheme_1.ref \
	functional_tests/ref-output/model_test.ref \
	functional_tests/ref-output/cuts.ref \
	functional_tests/ref-output/user_cuts.ref \
	functional_tests/ref-output/user_prc_threshold_1.ref \
	functional_tests/ref-output/user_prc_threshold_2.ref \
	functional_tests/ref-output/qedtest_1.ref \
	functional_tests/ref-output/qedtest_2.ref \
	functional_tests/ref-output/qedtest_5.ref \
	functional_tests/ref-output/qedtest_6.ref \
	functional_tests/ref-output/qedtest_7.ref \
	functional_tests/ref-output/qedtest_8.ref \
	functional_tests/ref-output/qedtest_9.ref \
	functional_tests/ref-output/qedtest_10.ref \
	functional_tests/ref-output/qcdtest_4.ref \
	functional_tests/ref-output/qcdtest_5.ref \
	functional_tests/ref-output/qcdtest_6.ref \
	functional_tests/ref-output/beam_setup_1.ref \
	functional_tests/ref-output/beam_setup_2.ref \
	functional_tests/ref-output/beam_setup_3.ref \
	functional_tests/ref-output/beam_setup_4.ref \
	functional_tests/ref-output/observables_1.ref \
	functional_tests/ref-output/event_weights_1.ref \
	functional_tests/ref-output/event_weights_2.ref \
	functional_tests/ref-output/event_eff_1.ref \
	functional_tests/ref-output/event_eff_2.ref \
	functional_tests/ref-output/event_dump_1.ref \
	functional_tests/ref-output/event_dump_2.ref \
	functional_tests/ref-output/reweight_1.ref \
	functional_tests/ref-output/reweight_2.ref \
	functional_tests/ref-output/reweight_3.ref \
	functional_tests/ref-output/reweight_4.ref \
	functional_tests/ref-output/reweight_5.ref \
	functional_tests/ref-output/reweight_6.ref \
	functional_tests/ref-output/reweight_7.ref \
	functional_tests/ref-output/reweight_8.ref \
	functional_tests/ref-output/analyze_1.ref \
	functional_tests/ref-output/analyze_2.ref \
	functional_tests/ref-output/analyze_3.ref \
	functional_tests/ref-output/analyze_4.ref \
	functional_tests/ref-output/analyze_5.ref \
	functional_tests/ref-output/colors.ref \
	functional_tests/ref-output/colors_hgg.ref \
	functional_tests/ref-output/alphas.ref \
	functional_tests/ref-output/jets_xsec.ref \
	functional_tests/ref-output/shower_err_1.ref \
	functional_tests/ref-output/parton_shower_1.ref \
	functional_tests/ref-output/pythia6_1.ref \
	functional_tests/ref-output/pythia6_2.ref \
	functional_tests/ref-output/hadronize_1.ref \
	functional_tests/ref-output/mlm_matching_fsr.ref \
	functional_tests/ref-output/mlm_pythia6_isr.ref \
	functional_tests/ref-output/hepmc_1.ref \
	functional_tests/ref-output/hepmc_2.ref \
	functional_tests/ref-output/hepmc_3.ref \
	functional_tests/ref-output/hepmc_4.ref \
	functional_tests/ref-output/hepmc_5.ref \
	functional_tests/ref-output/hepmc_6.ref \
	functional_tests/ref-output/hepmc_7.ref \
	functional_tests/ref-output/hepmc_9.ref \
	functional_tests/ref-output/hepmc_10.ref \
	functional_tests/ref-output/lhef_1.ref \
	functional_tests/ref-output/lhef_2.ref \
	functional_tests/ref-output/lhef_3.ref \
	functional_tests/ref-output/lhef_4.ref \
	functional_tests/ref-output/lhef_5.ref \
	functional_tests/ref-output/lhef_6.ref \
	functional_tests/ref-output/lhef_9.ref \
	functional_tests/ref-output/lhef_10.ref \
	functional_tests/ref-output/lhef_11.ref \
	functional_tests/ref-output/select_1.ref \
	functional_tests/ref-output/select_2.ref \
	functional_tests/ref-output/stdhep_1.ref \
	functional_tests/ref-output/stdhep_2.ref \
	functional_tests/ref-output/stdhep_3.ref \
	functional_tests/ref-output/stdhep_4.ref \
	functional_tests/ref-output/stdhep_5.ref \
	functional_tests/ref-output/stdhep_6.ref \
	functional_tests/ref-output/lcio_1.ref \
	functional_tests/ref-output/lcio_3.ref \
	functional_tests/ref-output/lcio_4.ref \
	functional_tests/ref-output/lcio_5.ref \
	functional_tests/ref-output/fatal_beam_decay.ref \
	functional_tests/ref-output/smtest_1.ref \
	functional_tests/ref-output/smtest_3.ref \
	functional_tests/ref-output/smtest_4.ref \
	functional_tests/ref-output/smtest_5.ref \
	functional_tests/ref-output/smtest_6.ref \
	functional_tests/ref-output/smtest_7.ref \
	functional_tests/ref-output/smtest_9.ref \
	functional_tests/ref-output/smtest_10.ref \
	functional_tests/ref-output/smtest_11.ref \
	functional_tests/ref-output/smtest_12.ref \
	functional_tests/ref-output/smtest_13.ref \
	functional_tests/ref-output/smtest_14.ref \
	functional_tests/ref-output/smtest_15.ref \
	functional_tests/ref-output/sm_cms_1.ref \
	functional_tests/ref-output/resonances_5.ref \
	functional_tests/ref-output/resonances_6.ref \
	functional_tests/ref-output/resonances_7.ref \
	functional_tests/ref-output/resonances_8.ref \
	functional_tests/ref-output/resonances_9.ref \
	functional_tests/ref-output/resonances_12.ref \
	functional_tests/ref-output/ufo_1.ref \
	functional_tests/ref-output/ufo_2.ref \
	functional_tests/ref-output/ufo_3.ref \
	functional_tests/ref-output/nlo_1.ref \
	functional_tests/ref-output/nlo_2.ref \
	functional_tests/ref-output/nlo_6.ref \
	functional_tests/ref-output/real_partition_1.ref \
	functional_tests/ref-output/fks_res_2.ref \
	functional_tests/ref-output/openloops_1.ref \
	functional_tests/ref-output/openloops_2.ref \
	functional_tests/ref-output/openloops_4.ref \
	functional_tests/ref-output/openloops_5.ref \
	functional_tests/ref-output/openloops_6.ref \
	functional_tests/ref-output/openloops_7.ref \
	functional_tests/ref-output/openloops_8.ref \
	functional_tests/ref-output/openloops_9.ref \
	functional_tests/ref-output/openloops_10.ref \
	functional_tests/ref-output/recola_1.ref \
	functional_tests/ref-output/recola_2.ref \
	functional_tests/ref-output/recola_3.ref \
	functional_tests/ref-output/recola_4.ref \
	functional_tests/ref-output/recola_5.ref \
	functional_tests/ref-output/recola_6.ref \
	functional_tests/ref-output/recola_7.ref \
	functional_tests/ref-output/recola_8.ref \
	functional_tests/ref-output/nlo_decay_1.ref \
	functional_tests/ref-output/mssmtest_1.ref \
	functional_tests/ref-output/mssmtest_2.ref \
	functional_tests/ref-output/mssmtest_3.ref \
	functional_tests/ref-output/spincor_1.ref \
	functional_tests/ref-output/show_1.ref \
	functional_tests/ref-output/show_2.ref \
	functional_tests/ref-output/show_3.ref \
	functional_tests/ref-output/show_4.ref \
	functional_tests/ref-output/show_5.ref \
	functional_tests/ref-output/method_ovm_1.ref \
	functional_tests/ref-output/multi_comp_4.ref \
	functional_tests/ref-output/flvsum_1.ref \
	functional_tests/ref-output/br_redef_1.ref \
	functional_tests/ref-output/decay_err_1.ref \
	functional_tests/ref-output/decay_err_2.ref \
	functional_tests/ref-output/decay_err_3.ref \
	functional_tests/ref-output/polarized_1.ref \
	functional_tests/ref-output/circe1_1.ref \
	functional_tests/ref-output/circe1_2.ref \
	functional_tests/ref-output/circe1_3.ref \
	functional_tests/ref-output/circe1_6.ref \
	functional_tests/ref-output/circe1_10.ref \
	functional_tests/ref-output/circe1_errors_1.ref \
	functional_tests/ref-output/circe2_1.ref \
	functional_tests/ref-output/circe2_2.ref \
	functional_tests/ref-output/circe2_3.ref \
	functional_tests/ref-output/isr_1.ref \
	functional_tests/ref-output/epa_1.ref \
	functional_tests/ref-output/epa_2.ref \
	functional_tests/ref-output/isr_epa_1.ref \
	functional_tests/ref-output/ep_3.ref \
	functional_tests/ref-output/ewa_4.ref \
	functional_tests/ref-output/gaussian_1.ref \
	functional_tests/ref-output/gaussian_2.ref \
	functional_tests/ref-output/beam_events_1.ref \
	functional_tests/ref-output/beam_events_4.ref \
	functional_tests/ref-output/energy_scan_1.ref \
	functional_tests/ref-output/cascades2_phs_1.ref

	# Reference files that depend on the numerical precision
	REF_OUTPUT_FILES_DOUBLE = \
	functional_tests/ref-output-double/qedtest_3.ref \
	functional_tests/ref-output-double/qedtest_4.ref \
	functional_tests/ref-output-double/qcdtest_1.ref \
	functional_tests/ref-output-double/qcdtest_2.ref \
	functional_tests/ref-output-double/qcdtest_3.ref \
	functional_tests/ref-output-double/smtest_2.ref \
	functional_tests/ref-output-double/smtest_8.ref \
	functional_tests/ref-output-double/observables_2.ref \
	functional_tests/ref-output-double/colors_2.ref \
	functional_tests/ref-output-double/resonances_1.ref \
	functional_tests/ref-output-double/resonances_2.ref \
	functional_tests/ref-output-double/resonances_3.ref \
	functional_tests/ref-output-double/resonances_4.ref \
	functional_tests/ref-output-double/resonances_10.ref \
	functional_tests/ref-output-double/resonances_11.ref \
	functional_tests/ref-output-double/beam_setup_5.ref \
	functional_tests/ref-output-double/nlo_3.ref \
	functional_tests/ref-output-double/nlo_4.ref \
	functional_tests/ref-output-double/nlo_5.ref \
	functional_tests/ref-output-double/fks_res_1.ref \
	functional_tests/ref-output-double/fks_res_3.ref \
	functional_tests/ref-output-double/openloops_3.ref \
	functional_tests/ref-output-double/powheg_1.ref \
	functional_tests/ref-output-double/defaultcuts.ref \
	functional_tests/ref-output-double/parton_shower_2.ref \
	functional_tests/ref-output-double/helicity.ref \
	functional_tests/ref-output-double/lhef_7.ref \
	functional_tests/ref-output-double/hepmc_8.ref \
	functional_tests/ref-output-double/lcio_2.ref \
	functional_tests/ref-output-double/multi_comp_1.ref \
	functional_tests/ref-output-double/multi_comp_2.ref \
	functional_tests/ref-output-double/multi_comp_3.ref \
	functional_tests/ref-output-double/pdf_builtin.ref \
	functional_tests/ref-output-double/lhapdf5.ref \
	functional_tests/ref-output-double/lhapdf6.ref \
	functional_tests/ref-output-double/ep_1.ref \
	functional_tests/ref-output-double/ep_2.ref \
	functional_tests/ref-output-double/circe1_4.ref \
	functional_tests/ref-output-double/circe1_5.ref \
	functional_tests/ref-output-double/circe1_7.ref \
	functional_tests/ref-output-double/circe1_8.ref \
	functional_tests/ref-output-double/circe1_9.ref \
	functional_tests/ref-output-double/circe1_photons_1.ref \
	functional_tests/ref-output-double/circe1_photons_2.ref \
	functional_tests/ref-output-double/circe1_photons_3.ref \
	functional_tests/ref-output-double/circe1_photons_4.ref \
	functional_tests/ref-output-double/circe1_photons_5.ref \
	functional_tests/ref-output-double/isr_2.ref \
	functional_tests/ref-output-double/isr_3.ref \
	functional_tests/ref-output-double/isr_4.ref \
	functional_tests/ref-output-double/isr_5.ref \
	functional_tests/ref-output-double/pythia6_3.ref \
	functional_tests/ref-output-double/pythia6_4.ref \
	functional_tests/ref-output-double/tauola_1.ref \
	functional_tests/ref-output-double/tauola_2.ref \
	functional_tests/ref-output-double/mlm_matching_isr.ref \
	functional_tests/ref-output-double/ewa_1.ref \
	functional_tests/ref-output-double/ewa_2.ref \
	functional_tests/ref-output-double/ewa_3.ref \
	functional_tests/ref-output-double/ilc.ref \
	functional_tests/ref-output-double/beam_events_2.ref \
	functional_tests/ref-output-double/beam_events_3.ref

	REF_OUTPUT_FILES_PREC = \
	functional_tests/ref-output-prec/qedtest_3.ref \
	functional_tests/ref-output-prec/qedtest_4.ref \
	functional_tests/ref-output-prec/qcdtest_1.ref \
	functional_tests/ref-output-prec/qcdtest_2.ref \
	functional_tests/ref-output-prec/qcdtest_3.ref \
	functional_tests/ref-output-prec/smtest_2.ref \
	functional_tests/ref-output-prec/smtest_8.ref \
	functional_tests/ref-output-prec/colors_2.ref \
	functional_tests/ref-output-prec/beam_setup_5.ref \
	functional_tests/ref-output-prec/nlo_3.ref \
	functional_tests/ref-output-prec/nlo_4.ref \
	functional_tests/ref-output-prec/fks_res_1.ref \
	functional_tests/ref-output-prec/fks_res_3.ref \
	functional_tests/ref-output-prec/openloops_3.ref \
	functional_tests/ref-output-prec/defaultcuts.ref \
	functional_tests/ref-output-prec/parton_shower_2.ref \
	functional_tests/ref-output-prec/helicity.ref \
	functional_tests/ref-output-prec/lhef_7.ref \
	functional_tests/ref-output-prec/multi_comp_1.ref \
	functional_tests/ref-output-prec/multi_comp_2.ref \
	functional_tests/ref-output-prec/multi_comp_3.ref \
	functional_tests/ref-output-prec/pdf_builtin.ref \
	functional_tests/ref-output-prec/lhapdf5.ref \
	functional_tests/ref-output-prec/lhapdf6.ref \
	functional_tests/ref-output-prec/ep_1.ref \
	functional_tests/ref-output-prec/ep_2.ref \
	functional_tests/ref-output-prec/ilc.ref \
	functional_tests/ref-output-prec/circe1_9.ref \
	functional_tests/ref-output-prec/circe1_photons_1.ref \
	functional_tests/ref-output-prec/circe1_photons_2.ref \
	functional_tests/ref-output-prec/circe1_photons_3.ref \
	functional_tests/ref-output-prec/circe1_photons_4.ref \
	functional_tests/ref-output-prec/circe1_photons_5.ref \
	functional_tests/ref-output-prec/ewa_1.ref

	REF_OUTPUT_FILES_EXT = \
	functional_tests/ref-output-ext/observables_2.ref \
	functional_tests/ref-output-ext/resonances_1.ref \
	functional_tests/ref-output-ext/resonances_2.ref \
	functional_tests/ref-output-ext/resonances_3.ref \
	functional_tests/ref-output-ext/resonances_4.ref \
	functional_tests/ref-output-ext/resonances_10.ref \
	functional_tests/ref-output-ext/resonances_11.ref \
	functional_tests/ref-output-ext/circe1_4.ref \
	functional_tests/ref-output-ext/circe1_5.ref \
	functional_tests/ref-output-ext/circe1_7.ref \
	functional_tests/ref-output-ext/circe1_8.ref \
	functional_tests/ref-output-ext/isr_2.ref \
	functional_tests/ref-output-ext/isr_3.ref \
	functional_tests/ref-output-ext/isr_4.ref \
	functional_tests/ref-output-ext/isr_5.ref \
	functional_tests/ref-output-ext/nlo_5.ref \
	functional_tests/ref-output-ext/powheg_1.ref \
	functional_tests/ref-output-ext/pythia6_3.ref \
	functional_tests/ref-output-ext/pythia6_4.ref \
	functional_tests/ref-output-ext/tauola_1.ref \
	functional_tests/ref-output-ext/tauola_2.ref \
	functional_tests/ref-output-ext/ewa_2.ref \
	functional_tests/ref-output-ext/ewa_3.ref \
	functional_tests/ref-output-ext/beam_events_2.ref \
	functional_tests/ref-output-ext/beam_events_3.ref \
	functional_tests/ref-output-ext/mlm_matching_isr.ref \
	functional_tests/ref-output-ext/hepmc_8.ref \
	functional_tests/ref-output-ext/lcio_2.ref

	REF_OUTPUT_FILES_QUAD = \
	functional_tests/ref-output-quad/observables_2.ref \
	functional_tests/ref-output-quad/resonances_1.ref \
	functional_tests/ref-output-quad/resonances_2.ref \
	functional_tests/ref-output-quad/resonances_3.ref \
	functional_tests/ref-output-quad/resonances_4.ref \
	functional_tests/ref-output-quad/resonances_10.ref \
	functional_tests/ref-output-quad/resonances_11.ref \
	functional_tests/ref-output-quad/circe1_4.ref \
	functional_tests/ref-output-quad/circe1_5.ref \
	functional_tests/ref-output-quad/circe1_7.ref \
	functional_tests/ref-output-quad/circe1_8.ref \
	functional_tests/ref-output-quad/isr_2.ref \
	functional_tests/ref-output-quad/isr_3.ref \
	functional_tests/ref-output-quad/isr_4.ref \
	functional_tests/ref-output-quad/isr_5.ref \
	functional_tests/ref-output-quad/nlo_5.ref \
	functional_tests/ref-output-quad/powheg_1.ref \
	functional_tests/ref-output-quad/pythia6_3.ref \
	functional_tests/ref-output-quad/pythia6_4.ref \
	functional_tests/ref-output-quad/tauola_1.ref \
	functional_tests/ref-output-quad/tauola_2.ref \
	functional_tests/ref-output-quad/ewa_2.ref \
	functional_tests/ref-output-quad/ewa_3.ref \
	functional_tests/ref-output-quad/beam_events_2.ref \
	functional_tests/ref-output-quad/beam_events_3.ref \
	functional_tests/ref-output-quad/mlm_matching_isr.ref \
	functional_tests/ref-output-quad/hepmc_8.ref \
	functional_tests/ref-output-quad/lcio_2.ref

	TESTSUITES_M4 = \
	$(MISC_TESTS_M4) \
	$(EXT_MSSM_M4) \
	$(EXT_NMSSM_M4)

	TESTSUITES_SIN = \
	$(MISC_TESTS_SIN) \
	$(EXT_ILC_SIN) \
	$(EXT_MSSM_SIN) \
	$(EXT_NMSSM_SIN) \
	$(EXT_SHOWER_SIN) \
	$(EXT_NLO_SIN)

	MISC_TESTS_M4 =

	MISC_TESTS_SIN = \
	functional_tests/empty.sin \
	functional_tests/fatal.sin \
	functional_tests/pack_1.sin \
	functional_tests/defaultcuts.sin \
	functional_tests/cuts.sin \
	functional_tests/model_change_1.sin \
	functional_tests/model_change_2.sin \
	functional_tests/model_scheme_1.sin \
	functional_tests/model_test.sin \
	functional_tests/structure_1.sin \
	functional_tests/structure_2.sin \
	functional_tests/structure_3.sin \
	functional_tests/structure_4.sin \
	functional_tests/structure_5.sin \
	functional_tests/structure_6.sin \
	functional_tests/structure_7.sin \
	functional_tests/structure_8.sin \
	functional_tests/vars.sin \
	functional_tests/extpar.sin \
	functional_tests/testproc_1.sin \
	functional_tests/testproc_2.sin \
	functional_tests/testproc_3.sin \
	functional_tests/testproc_4.sin \
	functional_tests/testproc_5.sin \
	functional_tests/testproc_6.sin \
	functional_tests/testproc_7.sin \
	functional_tests/testproc_8.sin \
	functional_tests/testproc_9.sin \
	functional_tests/testproc_10.sin \
	functional_tests/testproc_11.sin \
	functional_tests/testproc_12.sin \
	functional_tests/template_me_1.sin \
	functional_tests/template_me_2.sin \
	functional_tests/libraries_1.sin \
	functional_tests/libraries_2.sin \
	functional_tests/libraries_3.sin \
	functional_tests/libraries_4.sin \
	functional_tests/job_id_1.sin \
	functional_tests/job_id_2.sin \
	functional_tests/job_id_3.sin \
	functional_tests/job_id_4.sin \
	functional_tests/rebuild_1.sin \
	functional_tests/rebuild_2.sin \
	functional_tests/rebuild_3.sin \
	functional_tests/rebuild_4.sin \
	functional_tests/rebuild_5.sin \
	functional_tests/qedtest_1.sin \
	functional_tests/qedtest_2.sin \
	functional_tests/qedtest_3.sin \
	functional_tests/qedtest_4.sin \
	functional_tests/qedtest_5.sin \
	functional_tests/qedtest_6.sin \
	functional_tests/qedtest_7.sin \
	functional_tests/qedtest_8.sin \
	functional_tests/qedtest_9.sin \
	functional_tests/qedtest_10.sin \
	functional_tests/beam_setup_1.sin \
	functional_tests/beam_setup_2.sin \
	functional_tests/beam_setup_3.sin \
	functional_tests/beam_setup_4.sin \
	functional_tests/beam_setup_5.sin \
	functional_tests/qcdtest_1.sin \
	functional_tests/qcdtest_2.sin \
	functional_tests/qcdtest_3.sin \
	functional_tests/qcdtest_4.sin \
	functional_tests/qcdtest_5.sin \
	functional_tests/qcdtest_6.sin \
	functional_tests/observables_1.sin \
	functional_tests/observables_2.sin \
	functional_tests/event_weights_1.sin \
	functional_tests/event_weights_2.sin \
	functional_tests/event_eff_1.sin \
	functional_tests/event_eff_2.sin \
	functional_tests/event_dump_1.sin \
	functional_tests/event_dump_2.sin \
	functional_tests/reweight_1.sin \
	functional_tests/reweight_2.sin \
	functional_tests/reweight_3.sin \
	functional_tests/reweight_4.sin \
	functional_tests/reweight_5.sin \
	functional_tests/reweight_6.sin \
	functional_tests/reweight_7.sin \
	functional_tests/reweight_8.sin \
	functional_tests/analyze_1.sin \
	functional_tests/analyze_2.sin \
	functional_tests/analyze_3.sin \
	functional_tests/analyze_4.sin \
	functional_tests/analyze_5.sin \
	functional_tests/colors.sin \
	functional_tests/colors_2.sin \
	functional_tests/colors_hgg.sin \
	functional_tests/alphas.sin \
	functional_tests/jets_xsec.sin \
	functional_tests/lhef_1.sin \
	functional_tests/lhef_2.sin \
	functional_tests/lhef_3.sin \
	functional_tests/lhef_4.sin \
	functional_tests/lhef_5.sin \
	functional_tests/lhef_6.sin \
	functional_tests/lhef_7.sin \
	functional_tests/lhef_8.sin \
	functional_tests/lhef_9.sin \
	functional_tests/lhef_10.sin \
	functional_tests/lhef_11.sin \
	functional_tests/select_1.sin \
	functional_tests/select_2.sin \
	functional_tests/shower_err_1.sin \
	functional_tests/parton_shower_1.sin \
	functional_tests/parton_shower_2.sin \
	functional_tests/pythia6_1.sin \
	functional_tests/pythia6_2.sin \
	functional_tests/pythia6_3.sin \
	functional_tests/pythia6_4.sin \
	+ functional_tests/pythia8_1.sin \
	+ functional_tests/pythia8_2.sin \
	functional_tests/hadronize_1.sin \
	functional_tests/tauola_1.sin \
	functional_tests/tauola_2.sin \
	functional_tests/mlm_matching_fsr.sin \
	functional_tests/mlm_matching_isr.sin \
	functional_tests/mlm_pythia6_isr.sin \
	functional_tests/hepmc_1.sin \
	functional_tests/hepmc_2.sin \
	functional_tests/hepmc_3.sin \
	functional_tests/hepmc_4.sin \
	functional_tests/hepmc_5.sin \
	functional_tests/hepmc_6.sin \
	functional_tests/hepmc_7.sin \
	functional_tests/hepmc_8.sin \
	functional_tests/hepmc_9.sin \
	functional_tests/hepmc_10.sin \
	functional_tests/stdhep_1.sin \
	functional_tests/stdhep_2.sin \
	functional_tests/stdhep_3.sin \
	functional_tests/stdhep_4.sin \
	functional_tests/stdhep_5.sin \
	functional_tests/stdhep_6.sin \
	functional_tests/lcio_1.sin \
	functional_tests/lcio_2.sin \
	functional_tests/lcio_3.sin \
	functional_tests/lcio_4.sin \
	functional_tests/lcio_5.sin \
	functional_tests/fatal_beam_decay.sin \
	functional_tests/smtest_1.sin \
	functional_tests/smtest_2.sin \
	functional_tests/smtest_3.sin \
	functional_tests/smtest_4.sin \
	functional_tests/smtest_5.sin \
	functional_tests/smtest_6.sin \
	functional_tests/smtest_7.sin \
	functional_tests/smtest_8.sin \
	functional_tests/smtest_9.sin \
	functional_tests/smtest_10.sin \
	functional_tests/smtest_11.sin \
	functional_tests/smtest_12.sin \
	functional_tests/smtest_13.sin \
	functional_tests/smtest_14.sin \
	functional_tests/smtest_15.sin \
	functional_tests/resonances_1.sin \
	functional_tests/resonances_2.sin \
	functional_tests/resonances_3.sin \
	functional_tests/resonances_4.sin \
	functional_tests/resonances_5.sin \
	functional_tests/resonances_6.sin \
	functional_tests/resonances_7.sin \
	functional_tests/resonances_8.sin \
	functional_tests/resonances_9.sin \
	functional_tests/resonances_10.sin \
	functional_tests/resonances_11.sin \
	functional_tests/resonances_12.sin \
	functional_tests/sm_cms_1.sin \
	functional_tests/ufo_1.sin \
	functional_tests/ufo_2.sin \
	functional_tests/ufo_3.sin \
	functional_tests/nlo_1.sin \
	functional_tests/nlo_2.sin \
	functional_tests/nlo_3.sin \
	functional_tests/nlo_4.sin \
	functional_tests/nlo_5.sin \
	functional_tests/nlo_6.sin \
	functional_tests/nlo_decay_1.sin \
	functional_tests/real_partition_1.sin \
	functional_tests/fks_res_1.sin \
	functional_tests/fks_res_2.sin \
	functional_tests/fks_res_3.sin \
	functional_tests/openloops_1.sin \
	functional_tests/openloops_2.sin \
	functional_tests/openloops_3.sin \
	functional_tests/openloops_4.sin \
	functional_tests/openloops_5.sin \
	functional_tests/openloops_6.sin \
	functional_tests/openloops_7.sin \
	functional_tests/openloops_8.sin \
	functional_tests/openloops_9.sin \
	functional_tests/openloops_10.sin \
	functional_tests/recola_1.sin \
	functional_tests/recola_2.sin \
	functional_tests/recola_3.sin \
	functional_tests/recola_4.sin \
	functional_tests/recola_5.sin \
	functional_tests/recola_6.sin \
	functional_tests/recola_7.sin \
	functional_tests/recola_8.sin \
	functional_tests/powheg_1.sin \
	functional_tests/mssmtest_1.sin \
	functional_tests/mssmtest_2.sin \
	functional_tests/mssmtest_3.sin \
	functional_tests/spincor_1.sin \
	functional_tests/show_1.sin \
	functional_tests/show_2.sin \
	functional_tests/show_3.sin \
	functional_tests/show_4.sin \
	functional_tests/show_5.sin \
	functional_tests/method_ovm_1.sin \
	functional_tests/multi_comp_1.sin \
	functional_tests/multi_comp_2.sin \
	functional_tests/multi_comp_3.sin \
	functional_tests/multi_comp_4.sin \
	functional_tests/flvsum_1.sin \
	functional_tests/br_redef_1.sin \
	functional_tests/decay_err_1.sin \
	functional_tests/decay_err_2.sin \
	functional_tests/decay_err_3.sin \
	functional_tests/polarized_1.sin \
	functional_tests/pdf_builtin.sin \
	functional_tests/lhapdf5.sin \
	functional_tests/lhapdf6.sin \
	functional_tests/ep_1.sin \
	functional_tests/ep_2.sin \
	functional_tests/ep_3.sin \
	functional_tests/circe1_1.sin \
	functional_tests/circe1_2.sin \
	functional_tests/circe1_3.sin \
	functional_tests/circe1_4.sin \
	functional_tests/circe1_5.sin \
	functional_tests/circe1_6.sin \
	functional_tests/circe1_7.sin \
	functional_tests/circe1_8.sin \
	functional_tests/circe1_9.sin \
	functional_tests/circe1_10.sin \
	functional_tests/circe1_photons_1.sin \
	functional_tests/circe1_photons_2.sin \
	functional_tests/circe1_photons_3.sin \
	functional_tests/circe1_photons_4.sin \
	functional_tests/circe1_photons_5.sin \
	functional_tests/circe1_errors_1.sin \
	functional_tests/circe2_1.sin \
	functional_tests/circe2_2.sin \
	functional_tests/circe2_3.sin \
	functional_tests/isr_1.sin \
	functional_tests/isr_2.sin \
	functional_tests/isr_3.sin \
	functional_tests/isr_4.sin \
	functional_tests/isr_5.sin \
	functional_tests/epa_1.sin \
	functional_tests/epa_2.sin \
	functional_tests/isr_epa_1.sin \
	functional_tests/ewa_1.sin \
	functional_tests/ewa_2.sin \
	functional_tests/ewa_3.sin \
	functional_tests/ewa_4.sin \
	functional_tests/ilc.sin \
	functional_tests/gaussian_1.sin \
	functional_tests/gaussian_2.sin \
	functional_tests/beam_events_1.sin \
	functional_tests/beam_events_2.sin \
	functional_tests/beam_events_3.sin \
	functional_tests/beam_events_4.sin \
	functional_tests/energy_scan_1.sin \
	functional_tests/susyhit.sin \
	functional_tests/restrictions.sin \
	functional_tests/helicity.sin \
	functional_tests/process_log.sin \
	functional_tests/static_1.sin \
	functional_tests/static_1.exe.sin \
	functional_tests/static_2.sin \
	functional_tests/static_2.exe.sin \
	functional_tests/user_cuts.sin \
	functional_tests/user_prc_threshold_1.sin \
	functional_tests/cascades2_phs_1.sin \
	functional_tests/user_prc_threshold_2.sin

	EXT_MSSM_M4 = \
	ext_tests_mssm/mssm_ext-ee.m4 \
	ext_tests_mssm/mssm_ext-ee2.m4 \
	ext_tests_mssm/mssm_ext-en.m4 \
	ext_tests_mssm/mssm_ext-tn.m4 \
	ext_tests_mssm/mssm_ext-uu.m4 \
	ext_tests_mssm/mssm_ext-uu2.m4 \
	ext_tests_mssm/mssm_ext-uuckm.m4 \
	ext_tests_mssm/mssm_ext-dd.m4 \
	ext_tests_mssm/mssm_ext-dd2.m4 \
	ext_tests_mssm/mssm_ext-ddckm.m4 \
	ext_tests_mssm/mssm_ext-bb.m4 \
	ext_tests_mssm/mssm_ext-bt.m4 \
	ext_tests_mssm/mssm_ext-tt.m4 \
	ext_tests_mssm/mssm_ext-ug.m4 \
	ext_tests_mssm/mssm_ext-dg.m4 \
	ext_tests_mssm/mssm_ext-aa.m4 \
	ext_tests_mssm/mssm_ext-wa.m4 \
	ext_tests_mssm/mssm_ext-za.m4 \
	ext_tests_mssm/mssm_ext-ww.m4 \
	ext_tests_mssm/mssm_ext-wz.m4 \
	ext_tests_mssm/mssm_ext-zz.m4 \
	ext_tests_mssm/mssm_ext-gg.m4 \
	ext_tests_mssm/mssm_ext-ga.m4 \
	ext_tests_mssm/mssm_ext-gw.m4 \
	ext_tests_mssm/mssm_ext-gz.m4

	EXT_NMSSM_M4 = \
	ext_tests_nmssm/nmssm_ext-aa.m4 \
	ext_tests_nmssm/nmssm_ext-bb1.m4 \
	ext_tests_nmssm/nmssm_ext-bb2.m4 \
	ext_tests_nmssm/nmssm_ext-bt.m4 \
	ext_tests_nmssm/nmssm_ext-dd1.m4 \
	ext_tests_nmssm/nmssm_ext-dd2.m4 \
	ext_tests_nmssm/nmssm_ext-ee1.m4 \
	ext_tests_nmssm/nmssm_ext-ee2.m4 \
	ext_tests_nmssm/nmssm_ext-en.m4 \
	ext_tests_nmssm/nmssm_ext-ga.m4 \
	ext_tests_nmssm/nmssm_ext-gg.m4 \
	ext_tests_nmssm/nmssm_ext-gw.m4 \
	ext_tests_nmssm/nmssm_ext-gz.m4 \
	ext_tests_nmssm/nmssm_ext-qg.m4 \
	ext_tests_nmssm/nmssm_ext-tn.m4 \
	ext_tests_nmssm/nmssm_ext-tt1.m4 \
	ext_tests_nmssm/nmssm_ext-tt2.m4 \
	ext_tests_nmssm/nmssm_ext-uu1.m4 \
	ext_tests_nmssm/nmssm_ext-uu2.m4 \
	ext_tests_nmssm/nmssm_ext-wa.m4 \
	ext_tests_nmssm/nmssm_ext-ww1.m4 \
	ext_tests_nmssm/nmssm_ext-ww2.m4 \
	ext_tests_nmssm/nmssm_ext-wz.m4 \
	ext_tests_nmssm/nmssm_ext-za.m4 \
	ext_tests_nmssm/nmssm_ext-zz1.m4 \
	ext_tests_nmssm/nmssm_ext-zz2.m4

	EXT_MSSM_SIN = $(EXT_MSSM_M4:.m4=.sin)
	EXT_NMSSM_SIN = $(EXT_NMSSM_M4:.m4=.sin)

	EXT_ILC_SIN = \
	ext_tests_ilc/ilc_ext.sin

	EXT_SHOWER_SIN = \
	ext_tests_shower/shower_1_norad.sin \
	ext_tests_shower/shower_2_aall.sin \
	ext_tests_shower/shower_3_bb.sin \
	ext_tests_shower/shower_3_jj.sin \
	ext_tests_shower/shower_3_qqqq.sin \
	ext_tests_shower/shower_3_tt.sin \
	ext_tests_shower/shower_3_z_nu.sin \
	ext_tests_shower/shower_3_z_tau.sin \
	ext_tests_shower/shower_4_ee.sin \
	ext_tests_shower/shower_5.sin \
	ext_tests_shower/shower_6.sin

	EXT_NLO_SIN = \
	ext_tests_nlo/nlo_decay_tbw.sin \
	ext_tests_nlo/nlo_tt.sin \
	ext_tests_nlo/nlo_tt_powheg.sin \
	ext_tests_nlo/nlo_tt_powheg_sudakov.sin \
	ext_tests_nlo/nlo_uu.sin \
	ext_tests_nlo/nlo_uu_powheg.sin \
	ext_tests_nlo/nlo_qq_powheg.sin \
	ext_tests_nlo/nlo_threshold.sin \
	ext_tests_nlo/nlo_threshold_factorized.sin \
	ext_tests_nlo/nlo_methods_gosam.sin \
	ext_tests_nlo/nlo_jets.sin \
	ext_tests_nlo/nlo_settings.sin \
	ext_tests_nlo/nlo_eejj.sin \
	ext_tests_nlo/nlo_eejjj.sin \
	ext_tests_nlo/nlo_ee4j.sin \
	ext_tests_nlo/nlo_ee5j.sin \
	ext_tests_nlo/nlo_eebb.sin \
	ext_tests_nlo/nlo_eebbj.sin \
	ext_tests_nlo/nlo_eebbjj.sin \
	ext_tests_nlo/nlo_ee4b.sin \
	ext_tests_nlo/nlo_eett.sin \
	ext_tests_nlo/nlo_eettj.sin \
	ext_tests_nlo/nlo_eettjj.sin \
	ext_tests_nlo/nlo_eettjjj.sin \
	ext_tests_nlo/nlo_eettbb.sin \
	ext_tests_nlo/nlo_eetta.sin \
	ext_tests_nlo/nlo_eettaa.sin \
	ext_tests_nlo/nlo_eettaj.sin \
	ext_tests_nlo/nlo_eettajj.sin \
	ext_tests_nlo/nlo_eettaz.sin \
	ext_tests_nlo/nlo_eettah.sin \
	ext_tests_nlo/nlo_eettz.sin \
	ext_tests_nlo/nlo_eettzj.sin \
	ext_tests_nlo/nlo_eettzjj.sin \
	ext_tests_nlo/nlo_eettzz.sin \
	ext_tests_nlo/nlo_eettwjj.sin \
	ext_tests_nlo/nlo_eettww.sin \
	ext_tests_nlo/nlo_eetth.sin \
	ext_tests_nlo/nlo_eetthj.sin \
	ext_tests_nlo/nlo_eetthjj.sin \
	ext_tests_nlo/nlo_eetthh.sin \
	ext_tests_nlo/nlo_eetthz.sin \
	ext_tests_nlo/nlo_ee4t.sin \
	ext_tests_nlo/nlo_ee4tj.sin

	all-local: $(TESTSUITES_SIN)

	if M4_AVAILABLE
	SUFFIXES = .m4 .sin
	.m4.sin:
	case "$@" in \
	/) \
	mkdir -p `sed 's,/.[^/]*$$,,g' <<< "$@"` ;; \
	esac
	$(M4) $(srcdir)/$(TESTSUITE_MACROS) $< > $@
	endif M4_AVAILABLE
	Index: trunk/share/models/SM_hadrons.mdl
	===================================================================
	--- trunk/share/models/SM_hadrons.mdl (revision 8189)
	+++ trunk/share/models/SM_hadrons.mdl (revision 8190)
	@@ -1,1581 +1,2767 @@
	########################################################################
	-# Standard Model with trivial CKM matrix
	+# Standard Model with trivial CKM matrix, PDG codes from
	+# 43. Monte Carlo Particle Numbering Scheme (Revised October 2017)
	model "SM_hadrons"

	# Independent parameters
	### DO NOT CHANGE THE ORDER OF THESE PARAMETERS
	parameter GF = 1.16639E-5 # Fermi constant
	-parameter mZ = 91.1882 # Z-boson mass
	-parameter mW = 80.419 # W-boson mass
	+parameter mZ = 91.1882 # Z-boson mass
	+parameter mW = 80.419 # W-boson mass
	parameter mH = 125 # Higgs mass
	parameter alphas = 0.1178 # Strong coupling constant (Z point)
	-parameter me = 0.000510997 # electron mass
	-parameter mmu = 0.105658389 # muon mass
	+parameter me = 0.000510997 # electron mass
	+parameter mmu = 0.105658389 # muon mass
	parameter mtau = 1.77705 # tau-lepton mass
	-parameter ms = 0.095 # s-quark mass
	-parameter mc = 1.2 # c-quark mass
	-parameter mb = 4.2 # b-quark mass
	-parameter mtop = 173.1 # t-quark mass
	+parameter ms = 0.095 # s-quark mass
	+parameter mc = 1.2 # c-quark mass
	+parameter mb = 4.2 # b-quark mass
	+parameter mtop = 173.1 # t-quark mass
	parameter wtop = 1.523 # t-quark width
	parameter wZ = 2.443 # Z-boson width
	parameter wW = 2.049 # W-boson width
	parameter wH = 0.004143


	- # Higgs width
	+ # Higgs width
	parameter khgaz = 0.000 # anomaly Higgs couplings K factors
	parameter khgaga = 0.000 # anomaly Higgs couplings K factors
	-parameter khgg = 0.000 # anomaly Higgs couplings K factors
	+parameter khgg = 0.000 # anomaly Higgs couplings K factors
	parameter xi0 = 0.000 # R_xi parameter for Z-boson
	parameter xipm = 0.000 # R_xi parameter for W-boson

	# Dependent parameters
	derived v = 1 / sqrt (sqrt (2.) * GF) # v (Higgs vev)
	derived cw = mW / mZ # cos(theta-W)
	derived sw = sqrt (1-cw**2) # sin(theta-W)
	derived ee = 2 * sw * mW / v # em-coupling (GF scheme)
	derived alpha_em_i = 4 * pi / ee**2 # inverse fine structure const

	########################################################################
	# Particle content

	# The quarks
	particle D_QUARK 1 parton
	- spin 1/2 charge -1/3 isospin -1/2 color 3
	+ spin 1/2 charge -1/3 isospin -1/2 color 3
	name d down
	- anti dbar D "d~"
	+ anti dbar D "d~"
	tex_anti "\bar{d}"
	particle U_QUARK 2 parton
	spin 1/2 charge 2/3 isospin 1/2 color 3
	name u up
	- anti ubar U "u~"
	+ anti ubar U "u~"
	tex_anti "\bar{u}"
	particle S_QUARK 3 like D_QUARK
	name s strange
	- anti sbar S "s~"
	+ anti sbar S "s~"
	tex_anti "\bar{s}"
	mass ms
	particle C_QUARK 4 like U_QUARK
	name c charm
	- anti cbar C "c~"
	+ anti cbar C "c~"
	tex_anti "\bar{c}"
	mass mc
	particle B_QUARK 5 like D_QUARK
	name b bottom
	- anti bbar B "b~"
	+ anti bbar B "b~"
	tex_anti "\bar{b}"
	mass mb
	particle T_QUARK 6 like U_QUARK
	name t top
	- anti tbar T "t~"
	+ anti tbar T "t~"
	tex_anti "\bar{t}"
	mass mtop width wtop

	# The leptons
	particle E_LEPTON 11
	- spin 1/2 charge -1 isospin -1/2
	+ spin 1/2 charge -1 isospin -1/2
	name "e-" e1 electron e
	- anti "e+" E1 positron
	+ anti "e+" E1 positron
	tex_name "e^-"
	tex_anti "e^+"
	mass me
	particle E_NEUTRINO 12 left
	spin 1/2 isospin 1/2
	- name nue n1 "nu_e" ve "e-neutrino"
	- anti nuebar N1 "ve~"
	+ name nue n1 "nu_e" ve "e-neutrino"
	+ anti nuebar N1 "ve~"
	tex_name "\nu_e"
	tex_anti "\bar\nu_e"
	particle MU_LEPTON 13 like E_LEPTON
	- name "mu-" e2 mu muon
	- anti "mu+" E2
	+ name "mu-" e2 mu muon
	+ anti "mu+" E2
	tex_name "\mu^-"
	tex_anti "\mu^+"
	mass mmu
	particle MU_NEUTRINO 14 like E_NEUTRINO
	- name numu "nu_mu" n2 vm "mu-neutrino"
	+ name numu "nu_mu" n2 vm "mu-neutrino"
	anti numubar N2 "vm~"
	tex_name "\nu_\mu"
	tex_anti "\bar\nu_\mu"
	particle TAU_LEPTON 15 like E_LEPTON
	- name "tau-" e3 tau "ta-" tauon
	- anti "tau+" E3 "ta+"
	+ name "tau-" e3 tau "ta-" tauon
	+ anti "tau+" E3 "ta+"
	tex_name "\tau^-"
	tex_anti "\tau^+"
	mass mtau
	particle TAU_NEUTRINO 16 like E_NEUTRINO
	- name nutau "nu_tau" n3 vt "tau_neutrino"
	- anti nutaubar N3 "vt~"
	+ name nutau "nu_tau" n3 vt "tau_neutrino"
	+ anti nutaubar N3 "vt~"
	tex_name "\nu_\tau"
	tex_anti "\bar\nu_\tau"

	# The vector bosons
	particle GLUON 21 parton gauge
	spin 1 color 8
	name gl g G gluon
	particle PHOTON 22 gauge
	spin 1
	- name A gamma photon
	+ name A gamma photon
	tex_name "\gamma"
	particle Z_BOSON 23 gauge
	spin 1
	name Z
	mass mZ width wZ
	particle W_BOSON 24 gauge
	spin 1 charge 1
	- name "W+" Wp
	+ name "W+" Wp
	anti "W-" Wm
	tex_name "W^+"
	tex_anti "W^-"
	mass mW width wW

	# The Higgs
	particle HIGGS 25
	spin 0
	name H h Higgs
	mass mH width wH

	-# Diquarks
	+# Diquarks
	particle DD1 1103
	spin 1
	name dd1
	tex_name "(dd)_1"
	particle UD0 2101
	spin 0
	name ud0
	tex_name "(ud)_0"
	particle UD1 2103
	spin 1
	name ud1
	tex_name "(ud)_1"
	particle UU1 2203
	spin 1
	name uu1
	tex_name "(uu)_1"
	particle SD0 3101
	spin 0
	name sd0
	tex_name "(sd)_0"
	particle SD1 3103
	spin 1
	name sd1
	tex_name "(sd)_1"
	particle SU0 3201
	spin 0
	name su0
	tex_name "(su)_0"
	particle SU1 3203
	spin 1
	name su1
	tex_name "(su)_1"
	particle SS1 3303
	spin 1
	name ss1
	tex_name "(ss)_1"
	+particle CD0 4101
	+ spin 1
	+ name cd0
	+ tex_name "(cd)_0"
	+particle CD1 4103
	+ spin 1
	+ name cd1
	+ tex_name "(cd)_1"
	+particle CU0 4201
	+ spin 1
	+ name cu0
	+ tex_name "(cu)_0"
	+particle CU1 4203
	+ spin 1
	+ name cu1
	+ tex_name "(cu)_1"
	+particle CS0 4301
	+ spin 1
	+ name cs0
	+ tex_name "(cs)_0"
	+particle CS1 4303
	+ spin 1
	+ name cs1
	+ tex_name "(cs)_1"
	+particle CC1 4403
	+ spin 1
	+ name cc1
	+ tex_name "(cc)_1"
	+particle BD0 5101
	+ spin 1
	+ name bd0
	+ tex_name "(bd)_0"
	+particle BD1 5203
	+ spin 1
	+ name bd1
	+ tex_name "(bd)_1"
	+particle BU0 5201
	+ spin 1
	+ name bu0
	+ tex_name "(bu)_0"
	+particle BU1 5203
	+ spin 1
	+ name bu1
	+ tex_name "(bu)_1"
	+particle BS0 5301
	+ spin 1
	+ name bs0
	+ tex_name "(bs)_0"
	+particle BS1 5303
	+ spin 1
	+ name bs1
	+ tex_name "(bs)_1"
	+particle BC0 5401
	+ spin 1
	+ name bc0
	+ tex_name "(bc)_0"
	+particle BC1 5403
	+ spin 1
	+ name bc1
	+ tex_name "(bc)_1"
	+particle BB1 5503
	+ spin 1
	+ name bb1
	+ tex_name "(bb)_1"
	+
	### diquarks containing b or c quarks are omitted

	-# Light I=0 Mesons
	+# Light I=0 Mesons
	particle PI0 111
	- spin 0
	+ spin 0
	name pi0
	tex_name "\pi^0"
	particle A00 10111 like PI0
	name a00
	tex_name "a_0^0"
	particle A20 115
	spin 2
	name a20
	tex_name "a_2^0"
	particle RHO316900 117
	spin 3
	name rho316900
	tex_name "\rho_3(1690)^0"
	particle A420400 119
	spin 4
	name a420400
	- tex_name "a_4(2040)^0"
	+ tex_name "a_4(2040)^0"
	particle RHO319900 9000117 like RHO316900
	name rho319900
	tex_name "\rho_3(1990)^0"
	particle RHO322500 9010117 like RHO316900
	name rho322500
	- tex_name "\rho_3(2250)^0"
	+ tex_name "\rho_3(2250)^0"
	particle PIP 211
	- spin 0 charge 1
	+ spin 0 charge 1
	name pip "pi+"
	anti pim "pi-"
	tex_name "\pi^+"
	tex_anti "\pi^-"
	particle A0P 10211 like PIP
	name a0p "a0+"
	anti a0m "a0-"
	tex_name "a_0^+"
	tex_anti "a_0^-"
	+particle PI18000 901011 like PI0
	+ name pi18000 "pi(1800)0"
	+ tex_name "\pi(1800)^0"
	+particle PI1800P 9010211 like PIP
	+ name pi1800p "pi(1800)+"
	+ anti pi1800m "pi(1800)-"
	+ tex_name "\pi(1800)^+"
	+ tex_anti "\pi(1800)^-"
	particle RHO0 113
	- spin 1
	+ spin 1
	name rho0
	tex_name "\rho^0"
	particle RHOP 213
	- spin 1 charge 1
	+ spin 1 charge 1
	name rhop "rho+"
	anti rhom "rho-"
	tex_name "\rho^+"
	- tex_anti "\rho^-"
	-particle B10 10113 like RHO0
	+ tex_anti "\rho^-"
	+particle B10 10113 like RHO0
	name b10
	tex_name "b_1^0"
	particle PI216700 10115 like A20
	name pi216700
	tex_name "\pi_2(1670)^0"
	-particle A217000 100115 like A20
	+particle A217000 9000115 like A20
	name a217000
	- tex_name "a_2(1700)^0"
	-particle PI221000 9000115 like A20
	+ tex_name "a_2(1700)^0"
	+particle PI221000 9010115 like A20
	name pi221000
	- tex_name "\pi_2(2100)^0"
	-particle RHO14500 100113 like RHO0
	+ tex_name "\pi_2(2100)^0"
	+particle RHO14500 100113 like RHO0
	name rho14500
	tex_name "\rho(1450)^0"
	particle RHO1450P 100213 like RHOP
	name rho1450p "rho1450+"
	anti rho1450m "rho1450-"
	tex_name "\rho(1450)^+"
	tex_anti "\rho(1450)^-"
	-particle A10 20113 like RHO0
	+particle A10 20113 like RHO0
	name a10
	tex_name "a_1^0"
	-particle RHO17000 30113 like RHO0
	+particle RHO17000 30113 like RHO0
	name rho17000
	- tex_name "\rho(1700)^0"
	-particle A116400 9020113 like RHO0
	+ tex_name "\rho(1700)^0"
	+particle A116400 9020113 like RHO0
	name a116400
	- tex_name "a_1(1640)^0"
	+ tex_name "a_1(1640)^0"
	particle B1P 10213 like RHOP
	name b1p "b1+"
	anti b1m "b1-"
	tex_name "b_1^+"
	tex_anti "b_1^-"
	particle A1P 20213 like RHOP
	name a1p "a1+"
	anti a1m "a1-"
	tex_name "a_1^+"
	tex_anti "a_1^-"
	particle RHO1700P 30213 like RHOP
	name rho1700p "rho1700+"
	anti rho1700m "rho1700-"
	tex_name "\rho(1700)^+"
	- tex_anti "\rho(1700)^-"
	+ tex_anti "\rho(1700)^-"
	particle A11640P 9020213 like RHOP
	name a11640p "a11640+"
	anti a11640m "a11640-"
	tex_name "a_1(1640)^+"
	tex_anti "a_1(1640)^-"
	particle RHO1900P 9030213 like RHOP
	name rho1900p "rho1900+"
	anti rho1900m "rho1900-"
	tex_name "\rho(1900)^+"
	tex_anti "\rho(1900)^-"
	particle RHO2150P 9040213 like RHOP
	name rho2150p "rho2150+"
	anti rho2150m "rho2150-"
	tex_name "\rho(2150)^+"
	- tex_anti "\rho(2150)^-"
	+ tex_anti "\rho(2150)^-"
	particle A2P 215
	spin 2
	name a2p "a2+"
	anti a2m "a2-"
	tex_name "a_2^+"
	tex_anti "a_2^-"
	particle RHO31690P 217
	spin 3
	name rho31690p "rho31690+"
	anti rho31690m "rho31690-"
	tex_name "\rho_3(1690)^+"
	tex_anti "\rho_3(1690)^-"
	particle A42040P 219
	spin 4
	name a42040p "a42040+"
	anti a42040m "a42040-"
	tex_name "a_4(2040)^+"
	- tex_anti "a_4(2040)^-"
	+ tex_anti "a_4(2040)^-"
	particle RHO31990P 9000217 like RHO31690P
	name rho31990p "rho31990+"
	anti rho31990m "rho31990-"
	tex_name "\rho_3(1990)^+"
	tex_anti "\rho_3(1990)^-"
	particle RHO322500P 9010217 like RHO31690P
	name rho32250p "rho32250+"
	anti rho32250m "rho32250-"
	tex_name "\rho_3(2250)^+"
	- tex_anti "\rho_3(2250)^-"
	+ tex_anti "\rho_3(2250)^-"
	particle PI21670P 10215 like A2P
	name pi21670p "pi21670+"
	anti pi21670m "pi21670-"
	tex_name "\pi_2(1670)^+"
	tex_anti "\pi_2(1670)^-"
	-particle A21700P 100215 like A2P
	+particle A21700P 9000215 like A2P
	name a21700p "a21700+"
	anti a21700m "a21700-"
	tex_name "a_2(1700)^+"
	- tex_anti "a_2(1700)^-"
	+ tex_anti "a_2(1700)^-"
	particle A0980 9000111 like PI0
	name a0980
	tex_name "a_0(980)^0"
	particle A0980P 9000211 like PIP
	name a0980p "a0980+"
	anti a0980m "a0980-"
	tex_name "a_0(980)^+"
	tex_anti "a_0(980)^-"
	-particle PI114000 9000113 like RHO0
	+particle PI114000 9000113 like RHO0
	name pi114000
	tex_name "\pi_1(1400)^0"
	particle PI1400P 9000213 like RHOP
	name pi11400p "pi11400+"
	anti pi11400m "pi11400-"
	tex_name "\pi_1(1400)^+"
	tex_anti "\pi_1(1400)^-"
	-particle PI22100P 9000215 like RHOP
	- name pi11400p "pi11400+"
	- anti pi11400m "pi11400-"
	- tex_name "\pi_1(1400)^+"
	- tex_anti "\pi_1(1400)^-"
	-particle PI116000 9010113 like RHO0
	+particle PI22100P 9010215 like RHOP
	+ name pi22100p "pi22100+"
	+ anti pi22100m "pi22100-"
	+ tex_name "\pi_2(2100)^+"
	+ tex_anti "\pi_2(2100)^-"
	+particle PI116000 9010113 like RHO0
	name pi116000
	tex_name "\pi_1(1600)^0"
	-particle RHO19000 9030113 like RHO0
	+particle RHO19000 9030113 like RHO0
	name rho19000
	tex_name "\rho(1900)^0"
	-particle RHO2150 9040113 like RHO0
	+particle RHO2150 9040113 like RHO0
	name rho2150
	- tex_name "\rho(2150)^0"
	+ tex_name "\rho(2150)^0"
	particle PI11600P 9010213 like RHOP
	name pi11600p "pi11600+"
	anti pi11600m "pi11600-"
	tex_name "\pi_1(1600)^+"
	- tex_anti "\pi_1(1600)^-"
	+ tex_anti "\pi_1(1600)^-"
	particle PI1300 100111 like PI0
	name pi1300
	tex_name "\pi(1300)^0"
	particle PI1300P 100211 like PIP
	name pi1300p "pi1300+"
	anti pi1300m "pi1300-"
	tex_name "\pi(1300)^+"
	tex_anti "\pi(1300)^-"
	particle PI1800 200111 like PI0
	name pi1300
	tex_name "\pi(1300)^0"
	particle PI1300P 100211 like PIP
	name pi1300p "pi1800+"
	anti pi1300m "pi1800-"
	tex_name "\pi(1800)^+"
	tex_anti "\pi(1800)^-"

	# Light I=0 Mesons (uu/dd/ss admixtures)
	particle ETA 221
	spin 0
	name eta
	tex_name "\eta"
	-particle F0600 9000221 like ETA
	- name f0600
	- tex_name "f_0(600)"
	+particle F0500 9000221 like ETA
	+ name f0500
	+ tex_name "f_0(500)"
	particle F0980 9010221 like ETA
	name f0980
	tex_name "f_0(980)"
	-particle F01500 9020221 like ETA
	+particle F01405 9020221 like ETA
	+ name f01405
	+ tex_name "f_0(1405)"
	+particle F01500 9030221 like ETA
	name f01500
	tex_name "f_0(1500)"
	-particle F02020 9030221 like ETA
	+particle F01760 9040221 like ETA
	+ name f01760
	+ tex_name "f_0(1760)"
	+particle F02020 9050221 like ETA
	name f02020
	tex_name "f_0(2020)"
	-particle F02100 9040221 like ETA
	+particle F02100 9060221 like ETA
	name f02100
	tex_name "f_0(2100)"
	-particle F02200 9050221 like ETA
	+particle F02200 9070221 like ETA
	name f02200
	tex_name "f_0(2200)"
	-particle ETA2225 9060221 like ETA
	- name eta2225
	- tex_name "\eta(2225)"
	-particle F02330 9070221 like ETA
	- name f02330
	- tex_name "f_0(2330)"
	particle ETA1295 100221 like ETA
	name ETA1295
	tex_name "\eta(1295)"
	-particle F1370 10221 like ETA
	+particle F01370 10221 like ETA
	name f1370
	tex_name "f_0(1370)"
	particle ETA1760 200221 like ETA
	name ETA1760
	- tex_name "\eta(1760)"
	+ tex_name "\eta(1760)"
	+particle ETA2225 9080221 like ETA
	+ name ETA2225
	+ tex_name "\eta(2225)"
	particle F20 221 like ETA
	name f20
	tex_name "f_2^0"
	particle OMEGA 223
	spin 1
	name omega omega782
	tex_name "\omega(782)"
	particle H10 10223 like OMEGA
	- name h10 h1170
	+ name h10 h1170
	tex_name "h_1(1170)"
	particle F10 20223 like OMEGA
	- name f10 f11285
	+ name f10 f11285
	tex_name "f_1(1285)"
	-particle OMEGA1420 100223 like OMEGA
	- name omega1420
	+particle OMEGA1420 1000223 like OMEGA
	+ name omega1420
	tex_name "\omega(1420)"
	particle F11510 9000223 like OMEGA
	name f11510
	tex_name "f_1(1510)"
	particle H11595 9010223 like OMEGA
	- name h11595
	+ name h11595
	tex_name "h_1(1595)"
	particle OMEGA1650 30223 like OMEGA
	name omega1650
	tex_name "\omega(1650)"
	particle F2 225
	spin 2
	name f2 F2 f21270 F21270
	tex_name "f_2(1270)"
	particle F21430 9000225 like F2
	name f21430 F21430
	tex_name "f_2(1430)"
	particle F21565 9010225 like F2
	name f21565 F21565
	tex_name "f_2(1565)"
	particle F21640 9020225 like F2
	name f21640 F21640
	tex_name "f_2(1640)"
	particle ETA21645 10225 like F2
	name ETA21645
	tex_name "\eta_2(1645)"
	particle F21810 9030225 like F2
	name f21810 F21810
	tex_name "f_2(1810)"
	particle F21910 9040225 like F2
	name f21910 F21910
	tex_name "f_2(1910)"
	-particle F22150 9050225 like F2
	+particle F21950 9050225 like F2
	+ name f21950 F21950
	+ tex_name "f_2(1950)"
	+particle F22010 9060225 like F2
	+ name f22010 F22010
	+ tex_name "f_2(2010)"
	+particle F22150 9070225 like F2
	name f22150 F22150
	tex_name "f_2(2150)"
	-particle F22300 9060225 like F2
	+particle F22300 9080225 like F2
	name f22300 F22300
	tex_name "f_2(2300)"
	-particle F22340 9070225 like F2
	+particle F22340 9090225 like F2
	name f22340 F22340
	tex_name "f_2(2340)"
	particle F21950 100225 like F2
	name f21950 F21950
	- tex_name "f_2(1950)"
	+ tex_name "f_2(1950)"
	particle OMEGA3 227
	spin 3
	name omega3 OMEGA3 omega31670 OMEGA31670
	tex_name "\omega_3(1670)"
	particle F4 229
	spin 4
	- name f4 F4 f42050 F42050
	+ name f4 F4 f42050 F42050
	tex_name "f_4(2050)"
	-particle F42300 9000229 like F42050
	+particle F42220 9000229 like F42050
	+ name f42220 F42220
	+ tex_name "f_J(2220)"
	+particle F42300 9010229 like F42050
	name f42300 F42300
	tex_name "f_4(2300)"
	particle ETAPRIME 331
	spin 0
	name etaprime etap958 etaprime958
	tex_name "\eta'(958)"
	particle F01710 10331 like ETAPRIME
	name f01710 f00prime
	tex_name "f_0(1710)"
	particle ETA1440 100331 like ETA
	name eta1440
	- tex_name "\eta(1440)"
	+ tex_name "\eta(1440)"
	particle phi 333
	spin 1
	name phi phi1020
	tex_name "\phi(1020)"
	particle h10p 10333 like phi
	name h10p h11380
	tex_name "h_1(1380)"
	particle f10p 20333 like phi
	name f10p f11420
	tex_name "f_1(1420)"
	particle PHI1680 100333 like phi
	name phi1680 PHI1680
	tex_name "\phi(1680)"
	particle F2p 335
	spin 2
	name F2p F2prime F2p1525 F21525
	tex_name "f'_2(1525)"
	particle PHI31850 337
	spin 3
	name phi3 PHI3 phi31850 PHI31850
	- tex_name "\phi_3(1850)"
	+ tex_name "\phi_3(1850)"
	particle ETA21870 10335 like F2p
	name eta21870 ETA21870
	tex_name "\eta_2(1870)"
	-particle F22010 100335 like F2p
	- name f22010 F22010
	- tex_name "f_2(2010)"
	particle FJ2220 9000339
	spin 4
	name fj2220 FJ2220
	tex_name "f_J(2220)"

	# Strange Mesons
	particle K0 311
	spin 0
	name k0 "K0"
	tex_name "K^0"
	-particle K0STAR0 10311 like K0
	- name k0star0 "K0*0" k0star14300
	+particle K0star7000 9000311 like K0
	+ name k0star7000 "K0*(700)0"
	+ tex_name "K_0^*(700)^0"
	+particle K0star14300 10311 like K0
	+ name k0star14300 "K0*(1430)0"
	tex_name "K_0^*(1430)^0"
	particle K14600 100311 like K0
	name k14600 k146000
	tex_name "K(1460)^0"
	-particle K18300 200311 like K0
	- name k18300 k183000
	- tex_name "K(1830)^0"
	-particle K0star19500 9000311 like K0
	- name k0star19500 "K01950*0"
	- tex_name "K_0^*(1950)^0"
	+particle K0star1830 9010311 like K0
	+ name k0star18300 "K01830*0"
	+ tex_name "K_0^*(1830)^0"
	+particle K0star19500 9020311 like K0
	+ name k0star19500 "K01950*0"
	+ tex_name "K_0^*(1950)^0"
	particle KL0 130
	spin 0
	name kL0 "K_L0"
	tex_name "K_L^0"
	particle KS0 310
	spin 0
	name kS0 "K_S0"
	tex_name "K_S^0"
	particle KSTAR0 313
	spin 1
	name kstar0 "K*0" kstar892
	tex_name "K^*(892)^0"
	particle K10 10313 like KSTAR0
	name k10 "K10" k112700
	tex_name "K_1^(1270)^0"
	particle K1STAR0 20313 like KSTAR0
	name k1star0 "K1*0" k114000
	- tex_name "K_1(1400)^0}"
	+ tex_name "K_1(1400)^0"
	particle KSTAR16800 30313 like KSTAR0
	- name kstar16800
	- tex_name "K^*(1680)^0}"
	+ name kstar16800
	+ tex_name "K^*(1680)^0}"
	particle K114100 100313 like KSTAR0
	name k114100
	- tex_name "K^*(1400)^0}"
	+ tex_name "K^*(1410)^0}"
	particle K116500 9000313 like KSTAR0
	name k116500
	- tex_name "K_1(1650)^0"
	+ tex_name "K_1(1650)^0"
	particle K2STAR0 315
	spin 2
	name k2star0 "K20" k2star14300 "K214300"
	- tex_name "K_2^*(1430)^0"
	+ tex_name "K_2^*(1430)^0"
	particle K217700 10315 like K2STAR0
	name k217700 K217700
	tex_name "K_2(1770)^0"
	particle K218200 20315 like K2STAR0
	name k218200 K218200
	- tex_name "K_2(1820)^0"
	+ tex_name "K_2(1820)^0"
	particle K2STAR19800 100315 like K2STAR0
	name k2star19800 "K2*19800"
	tex_name "K_2^*(1980)^0"
	particle K215800 9000315 like K2STAR0
	name k215800 K215800
	tex_name "K_2(1580)^0"
	-particle K222500 9010315 like K2STAR0
	+particle K219800 9010315 like K2STAR0
	+ name k219800 K219800
	+ tex_name "K_2(1980)^0"
	+particle K222500 9020315 like K2STAR0
	name k222500 K222500
	- tex_name "K_2(2250)^0"
	+ tex_name "K_2(2250)^0"
	particle K3STAR0 317
	spin 3
	name k3star0 "K30" k3star17800 "K317800"
	tex_name "K_3^*(1780)^0"
	particle K323200 9010317
	spin 3
	name k323200 K323200
	tex_name "K_3(2320)^0"
	particle K4STAR0 319
	spin 4
	name k4star0 "K40" k4star20450 "K420450"
	tex_name "K_4^*(2045)^0"
	particle K425000 9000319
	spin 4
	name k425000 K425000
	- tex_name "K_4(2500)^0"
	+ tex_name "K_4(2500)^0"
	particle KP 321
	- spin 0 charge 1
	+ spin 0 charge 1
	name kp "K+"
	anti km "K-"
	tex_name "K^+"
	tex_anti "K^-"
	+particle K0star700p 9000321 like KP
	+ name k0star700p "K*700+"
	+ anti k0star700m "K*700-"
	+ tex_name "K_0^*(700)^+"
	+ tex_name "K_0^*(700)^-"
	particle K0STARP 10321 like KP
	name k0starp "K0*+" k0star1430p
	anti k0starm "K0*-" k0star1430m
	tex_name "K_0^*(1430)^+"
	tex_anti "K_0^*(1430)^-"
	particle K1460p 100321 like KP
	name K1460p "K1460+"
	anti K1460m "K1460-"
	tex_name "K(1460)^+"
	tex_anti "K(1460)^-"
	-particle K1830p 200321 like KP
	+particle K1830p 9010321 like KP
	name K1830p "K1830+"
	anti K1830m "K1830-"
	tex_name "K(1830)^+"
	tex_anti "K(1830)^-"
	-particle K0star1950p 9000321 like KP
	- name k0star1950p "K0*1950+"
	- anti k0star1950m "K0*1950-"
	+particle K0star1950p 9020321 like KP
	+ name k0star1950p "K0*1950+"
	+ anti k0star1950m "K0*1950-"
	tex_name "K_0^*(1950)^+"
	- tex_anti "K_0^*(1950)^-"
	+ tex_anti "K_0^*(1950)^-"
	particle KSTARP 323
	- spin 1 charge 1
	+ spin 1 charge 1
	name kstarp "K*+"
	anti kstarm "K*-"
	tex_name "K^*(892)+"
	tex_anti "K^*(892)-"
	particle K1P 10323 like KSTARP
	name k1p "K1+" k11270p "K11270+"
	anti k1m "K1-" k11270m "K11270-"
	tex_name "K_1^(1270)+"
	tex_anti "K_1^(1270)-"
	particle K1STARP 20323 like KSTARP
	name k1starp "K1*+" k11400p "K11400+"
	anti k1starm "K1*-" k11400m "K11400-"
	tex_name "K_1(1400)^+"
	tex_anti "K_1(1400)^-"
	particle KSTAR1680P 30323 like KSTARP
	name kstar11680p "K*1680+"
	anti kstar11680m "K*1680-"
	tex_name "K^*(1680)^+"
	- tex_anti "K^*(1680)^-"
	+ tex_anti "K^*(1680)^-"
	particle K11410P 100323 like KSTARP
	name k11410p "K11410+"
	anti k11410m "K11410-"
	tex_name "K^*(1410)^+"
	tex_anti "K^*(1410)^-"
	particle K11650P 9000323 like KSTARP
	spin 1 charge 1
	name k11650p "K11650+"
	anti k11650m "K11650-"
	tex_name "K^*(1650)^+"
	- tex_anti "K^*(1650)^-"
	+ tex_anti "K^*(1650)^-"
	particle K2STARP 325
	- spin 2 charge 1
	+ spin 2 charge 1
	name k2starp "K2+" k2star1430p "K21430+"
	anti k2starm "K2-" k2star1430m "K21430-"
	tex_name "K_2^*(1430)^+"
	tex_anti "K_2^*(1430)^-"
	particle K21770P 10325 like K2STARP
	name k21770p "K21770+"
	anti k21770m "K21770-"
	tex_name "K_2(1770)^+"
	tex_anti "K_2(1770)^-"
	particle K21820P 20325 like K2STARP
	name k21820p "K21820+"
	anti k21820m "K21820-"
	tex_name "K_2(1820)^+"
	- tex_anti "K_2(1820)^-"
	+ tex_anti "K_2(1820)^-"
	particle K2STAR1980P 100325 like K2STARP
	name k2star1980p "K2*1980+"
	anti k2star1770m "K2*1980-"
	tex_name "K_2^*(1980)^+"
	tex_anti "K_2^*(1980)^-"
	particle K21580P 9000325 like K2STARP
	name k21580p "K21580+"
	anti k21580m "K21580-"
	tex_name "K_2(1580)^+"
	- tex_anti "K_2(1580)^-"
	-particle K22250P 9010325 like K2STARP
	+ tex_anti "K_2(1580)^-"
	+particle K21980P 9010325 like K2STARP
	+ name k21980p "K21980+"
	+ anti k21980m "K21980-"
	+ tex_name "K_2(1980)^+"
	+ tex_anti "K_2(1980)^-"
	+particle K22250P 9020325 like K2STARP
	name k22250p "K22250+"
	anti k22250m "K22250-"
	tex_name "K_2(2250)^+"
	tex_anti "K_2(2250)^-"
	particle K3STARP 327
	spin 2 charge 1
	name k3starp "K3p" "K3star+" "K3+"
	anti k3starm "K3m" "K3star-" "K3-"
	tex_name "K_3^*(1780)^+"
	tex_anti "K_3^*(1780)^-"
	particle K32320P 9010327 like K3STARP
	name k32320p "K32320+"
	anti k32320m "K32320-"
	tex_name "K_3(2320)^+"
	- tex_anti "K_3(2320)^-"
	+ tex_anti "K_3(2320)^-"
	particle K4STARP 329
	spin 2 charge 1
	name k4starp "K4p" "K4star+" "K4+"
	anti k4starm "K4m" "K4star-" "K4-"
	tex_name "K_4^*(2045)^+"
	tex_anti "K_4^*(2045)^-"
	particle K42500P 9000329 like K4STARP
	name k42500p "K42500+"
	anti k42500m "K42500-"
	tex_name "K_4(2500)^+"
	- tex_anti "K_4(2500)^-"
	+ tex_anti "K_4(2500)^-"

	# Charm Mesons
	particle DP 411
	spin 0 charge 1
	name dp "D+"
	anti dm "D-"
	tex_name "D^+"
	tex_anti "D^-"
	particle D0STARP 10411 like DP
	name d0starp "D0*+"
	anti d0starm "D0*-"
	tex_name "D_0^{*+}"
	tex_anti "D_0^{*-}"
	+particle ETAC2S 100411 like DP
	+ name etac2s "ETAC(2S)"
	+ tex_name "\eta_c(2S)"
	particle D0STARP 415 like DP
	name d2starp "D2*+"
	anti d2starm "D2*-"
	tex_name "D_2^{*+}"
	tex_anti "D_2^{*-}"
	particle D0 421
	spin 0 charge 0
	name d0 "D0"
	anti dbar0 "Dbar0"
	tex_name "D^0"
	tex_anti "\bar{D}^0"
	particle D0STAR0 10421 like D0
	name d0star0 "D0*0"
	anti dbar0star0 "D0*bar0"
	tex_name "D_0^{*0}"
	tex_anti "\bar{D}_0^{*0}"
	particle D2STAR0 425
	- spin 2
	+ spin 2
	name d2star0 "D2*0" d2star24600
	anti dbar2star0 "D2*bar0" d2star24600bar
	tex_name "D_2^*(2460)^0"
	tex_anti "\bar{D}_2^*(2460)^0"
	particle Dsp 431
	spin 0 charge 1
	name dsp "D_s+"
	anti dsm "D_s-"
	tex_name "D_s^+"
	tex_anti "D_s^-"
	particle D0starsp 10431 like Dsp
	name d0starsp "D0s*+"
	anti d0starsm "D0s*-"
	- tex_name "D_{s0}^{*+}"
	- tex_anti "D_{s0}^{*-}"
	+ tex_name "D_{s0}(2317)^{*+}"
	+ tex_anti "D_{s0}(2317)^{*-}"
	particle D2starsp 435
	spin 2 charge 1
	name d2starsp "Ds2*+"
	anti d2starsm "Ds2*-"
	- tex_name "D_{s2}^{*+}"
	- tex_anti "D_{s2}^{*-}"
	+ tex_name "D_{s2}(2573)^{*+}"
	+ tex_anti "D_{s2}(2573)^{*-}"
	particle DSTARp 413
	- spin 1 charge 1
	+ spin 1 charge 1
	name dstarp "D*+" dstar2010p
	anti dstarm "D*-" dstar2010m
	tex_name "D^*(2010)^+"
	tex_anti "D^*(2010)^-"
	particle D1p 10413 like DSTARp
	name d1p "D1+" d12420p
	anti d1m "D1-" d12420m
	tex_name "D_1(2420)^{+}"
	tex_anti "D_1(2420)^{-}"
	particle DSTAR1p 20413 like DSTARp
	name d1starp "D1*+"
	anti d1starm "D1*-"
	tex_name "D_1^{*+}"
	tex_anti "D_1^{*-}"
	particle D2STARp 415
	spin 2 charge 1
	name d2starp "D2*+" d22460p
	anti d2starm "D2*-" d22460m
	tex_name "D_2^*(2460)^+"
	tex_anti "D_2^*(2460)^-"
	particle DSTAR0 423
	spin 1 charge 0
	name dstar0 "D*0" dstar20070
	tex_name "D^*(2007)^0"
	particle D10 10423 like DSTAR0
	name d10 "D10" d124200
	tex_name "D_1(2420)^{0}"
	particle D1STAR0 20423 like DSTAR0
	name d1star0 "D1*0"
	tex_name "D_1^{*0}"
	particle DSTARsP 433
	- spin 1 charge 1
	+ spin 1 charge 1
	name dstarsp "D*_s+"
	anti dstarsm "D*_s-"
	tex_name "D_s^{*+}"
	tex_anti "D_s^{*-}"
	particle D1sP 10433 like DSTARsP
	name d1sp "D_s1+"
	anti d1sm "D_s1-"
	tex_name "D_{s1}(2536)^{+}"
	tex_anti "D_{s1}(2536)^{-}"
	particle D1STARsP 20433 like DSTARsP
	name d1starsp "D*_s1+"
	anti d1starsm "D*_s1-"
	- tex_name "D_{s1}^{*+}"
	- tex_anti "D_{s1}^{*-}"
	+ tex_name "D_{s1}(2460)^{*+}"
	+ tex_anti "D_{s1}(2460)^{*-}"

	# Bottom Mesons
	particle B0 511
	spin 0
	name b0 "B0"
	anti bbar0 "Bbar0"
	tex_name "B^0"
	tex_anti "\bar{B}^0"
	particle B0star0 10511 like B0
	name b0star0 "B0*0"
	anti bbar0star0 "Bbar0*0"
	tex_name "B_0^{*0}"
	- tex_anti "\bar{B}_0^{*0}"
	+ tex_anti "\bar{B}_0^{*0}"
	particle BSTAR0 513
	spin 1
	name bstar0 "Bstar0"
	anti bstarbar0 "Bstarbar0"
	tex_name "B^{*0}"
	tex_anti "\bar{B}^{*0}"
	particle B1L0 10513 like BSTAR0
	name b1l0 B1L0
	anti b1l0bar B1L0bar
	tex_name "B_1(L)^0"
	tex_anti "\bar{B}_1(L)^{0}"
	particle B1H0 20513 like BSTAR0
	name b1h0 B1H0
	anti b1h0bar B1H0bar
	tex_name "B_1(H)^0"
	tex_anti "\bar{B}_1(H)^{0}"
	particle B2STAR0 515
	spin 2
	name b2star0 "B2star0"
	anti b2starbar0 "B2starbar0"
	tex_name "B_2^{*0}"
	- tex_anti "\bar{B}_2^{*0}"
	+ tex_anti "\bar{B}_2^{*0}"
	particle BP 521
	spin 0
	name bP "B+"
	anti bbarM "Bbar-"
	tex_name "B^{+}"
	tex_anti "\bar{B}^{-}"
	particle B0starP 10521 like BP
	name b0starP "B0*+"
	anti bbarstarm "Bbar*-"
	tex_name "B_0^{*+}"
	- tex_anti "\bar{B}_0^{*-}"
	+ tex_anti "\bar{B}_0^{*-}"
	particle BSTARP 523
	spin 1
	name bstarP "B*+"
	anti bstarbarM "B*bar-"
	tex_name "B^{*+}"
	tex_anti "\bar{B}^{*-}"
	particle B1LP 10523 like BSTARP
	name b1lp "B1L+"
	anti b1lm "B1L-"
	tex_name "B_1(L)^+"
	tex_anti "\bar{B}_1(L)^-"
	particle B1HP 20523 like BSTARP
	name b1hp "B1H+"
	anti b1hm "B1H-"
	tex_name "B_1(H)^+"
	- tex_anti "\bar{B}_1(H)^-"
	+ tex_anti "\bar{B}_1(H)^-"
	particle B2STARP 525
	spin 2
	name b2starP "B2*+"
	anti b2starbarM "B2*bar-"
	tex_name "B_2^{*+}"
	tex_anti "\bar{B}_2^{*-}"
	particle BS0 531
	spin 0
	name bs0 BS0
	anti bsbar0 "BSbar0"
	tex_name "B^0_s"
	tex_anti "\bar{B}^0_s"
	particle BS0 10531
	spin 0
	name bs0 "BS0"
	anti bsbar0 "BSbar0"
	tex_name "B^{0}_s"
	- tex_anti "\bar{B}^{0}_s"
	+ tex_anti "\bar{B}^{0}_s"
	particle BSTARS0 533
	spin 1
	name bstars0 "B*S0"
	anti bstarsbar0 "B*Sbar0"
	tex_name "B^{*0}_s"
	tex_anti "\bar{B}^{*0}_s"
	particle BS1L0 10533 like BSTARS0
	name bs1l0 BS1L0
	anti bs1lbar0 BS1LBAR0
	tex_name "B_{s1}(L)^0"
	tex_anti "\bar{B}_{s1}(L)^0"
	particle BS1H0 20533 like BSTARS0
	name bs1h0 BS1H0
	anti bs1hbar0 BS1HBAR0
	tex_name "B_{s1}(H)^0"
	tex_anti "\bar{B}_{s1}(H)^0"
	particle BSTARS0 535
	spin 2
	name bstars20 "B*S20"
	anti bstarsbar0 "B*Sbar0"
	tex_name "B_{s2}^{*0}"
	- tex_anti "\bar{B}_{s2}^{*0}"
	+ tex_anti "\bar{B}_{s2}^{*0}"
	particle BCP 541
	spin 0
	name bcP "Bc+"
	anti bcM "Bc-"
	tex_name "B^{+}_c"
	tex_anti "\bar{B}^{-}_c"
	particle BSTARCP 10541
	spin 0
	name bstarcP "B*c+"
	anti bstarcM "B*c-"
	tex_name "B^{*+}_{c0}"
	- tex_anti "\bar{B}^{*-}_{c0}"
	+ tex_anti "\bar{B}^{*-}_{c0}"
	particle BCSTARP 543
	spin 1
	name bstarcP "B*c+"
	anti bstarcbarM "B*cbar-"
	tex_name "B^{*+}_c"
	tex_anti "\bar{B}^{*-}_c"
	particle BC1LP 10543
	spin 1
	name bc1lP "BC1L+"
	anti bc1lM "BC1L-"
	tex_name "B_{c1}(L)^+"
	tex_anti "\bar{B}_{c1}(L)^-"
	particle BC1HP 20543 like BC1LP
	name bc1hP "BC1H+"
	anti bc1hM "BC1H-"
	tex_name "B_{c1}(H)^+"
	tex_anti "\bar{B}_{c1}(H)^-"
	particle BC2STARP 545
	spin 2
	name b2starcP "B2*c+"
	anti b2starcbarM "B2*cbar-"
	tex_name "B^{*+}_{c2}"
	- tex_anti "\bar{B}^{*-}_{c2}"
	+ tex_anti "\bar{B}^{*-}_{c2}"

	# CC MESONS
	particle ETAC 441
	spin 0 charge 0
	name etac "eta_c" etac1s
	tex_name "\eta_c(1S)"
	particle CHI0C 10441 like ETAC
	name chic0 "chic_0" chic01p
	tex_name "\chi_{c0}(1P)"
	particle ETAC2S 100441 like ETAC
	- name etac2s "eta_c2s"
	+ name etac2s "eta_c2s"
	tex_name "\eta_c(2S)"
	particle JPSI 443
	spin 1 charge 0
	name jpsi "J/Psi" jpsi1s
	tex_name "J/\psi(1S)"
	particle H10c 10443 like JPSI
	name h10c hc1p
	tex_name "h_c(1P)"
	particle CHI10c 20443 like JPSI
	- name chic1 chic1p
	+ name chic1 chic1p
	tex_name "\chi_{c1}(1P)"
	particle PSIPRIME 100443 like JPSI
	name psiprime
	tex_name "\psi(2S)"
	particle PSI3770 30443 like JPSI
	name psi3770
	tex_name "\psi(3770)"
	particle PSI4040 9000443 like JPSI
	name psi4040
	tex_name "\psi(4040)"
	particle PSI4160 9010443 like JPSI
	name psi4160
	tex_name "\psi(4160)"
	particle PSI4415 9020443 like JPSI
	name psi4415
	- tex_name "\psi(4415)"
	-particle CHI2C 445
	+ tex_name "\psi(4415)"
	+particle CHI2C 445
	spin 2
	name chi2c "chi2_c" chic21p
	tex_name "\chi_{c2}(1P)"
	-particle PSI3836 9000445 like CHI2C
	- name psi3836
	- tex_name "\psi(3836)"
	+particle PSI3930 100445 like CHI2C
	+ name psi3930
	+ tex_name "\chi_{c2}(3930)"

	# BB MESONS
	particle ETAB1S 551
	spin 0
	name etab etab1s
	tex_name "\eta_b(1S)"
	-particle CHIB01P 10551
	+particle CHIB01P 10551
	spin 0
	name chib01p chib0
	tex_name "\chi_{b0}(1P)"
	particle ETAB2S 100551 like ETAB1S
	- name etab2s
	+ name etab2s
	tex_name "\eta_b(2S)"
	particle CHIB02P 110551 like CHIB01P
	- name chib02p
	+ name chib02p
	tex_name "\chi_{b0}(2P)"
	particle ETAB3S 200551 like ETAB1S
	- name etab3s
	+ name etab3s
	tex_name "\eta_b(3S)"
	particle CHIB03P 210551 like CHIB01P
	- name chib03p
	- tex_name "\chi_{b0}(3P)"
	+ name chib03p
	+ tex_name "\chi_{b0}(3P)"
	particle UPSILON1S 553
	spin 1
	- name upsilon upsilon1s
	+ name upsilon upsilon1s
	tex_name "\Upsilon(1S)"
	particle HB1P 10553
	spin 1
	name hb1p
	tex_name "h_b(1P)"
	particle CHIB11P 20553
	spin 1
	name chib11p
	tex_name "\chi_{b1}(1P)"
	particle UPSILON11D 30553 like UPSILON1S
	name upsilon11d
	tex_name "\Upsilon_1(1D)"
	particle UPSILON2S 100553 like UPSILON1S
	- name upsilonprime upsilon2s
	+ name upsilonprime upsilon2s
	tex_name "\Upsilon(2S)"
	particle HB2P 110553 like HB1P
	name hb2p
	tex_name "h_b(2P)"
	particle CHIB12P 120553 like CHIB11P
	name chib12p
	tex_name "\chi_{b1}(2P)"
	particle UPSILON11D 130553 like UPSILON1S
	name upsilon12d
	tex_name "\Upsilon_1(2D)"
	particle UPSILON3S 200553 like UPSILON1S
	- name upsilon3s
	+ name upsilon3s
	tex_name "\Upsilon(3S)"
	particle HB3P 210553 like HB1P
	name hb3p
	tex_name "h_b(3P)"
	particle CHIB13P 220553 like CHIB11P
	name chib13p
	tex_name "\chi_{b1}(3P)"
	particle UPSILON4S 300553 like UPSILON1S
	- name upsilon4s
	+ name upsilon4s
	tex_name "\Upsilon(4S)"
	particle UPSILON10860 9000553 like UPSILON1S
	- name upsilon10860
	+ name upsilon10860
	tex_name "\Upsilon(10860)"
	particle UPSILON11020 9010553 like UPSILON1S
	- name upsilon11020
	+ name upsilon11020
	tex_name "\Upsilon(11020)"
	particle CHIB21P 555
	spin 2
	name chib21p
	tex_name "\chi_{b2}(1P)"
	particle ETAB21D 10555
	spin 2
	name etab21d
	tex_name "\eta_{b2}(1D)"
	particle UPSILON21D 20555
	spin 2
	name upsilon21d
	tex_name "\Upsilon_2(1D)"
	particle CHIB22P 100555 like CHIB21P
	name chib22p
	tex_name "\chi_{b2}(2P)"
	particle ETAB22D 110555 like ETAB21D
	name etab22d
	tex_name "\eta_{b2}(2D)"
	particle UPSILON22D 120555 like UPSILON21D
	name upsilon22d
	tex_name "\Upsilon_2(2D)"
	particle CHIB23P 200555 like CHIB21P
	name chib23p
	- tex_name "\chi_{b2}(3P)"
	+ tex_name "\chi_{b2}(3P)"
	particle UPSILON31D 557
	spin 3
	name upsilon31d
	tex_name "\Upsilon_3(1D)"
	particle UPSILON32D 100557 like UPSILON31D
	name upsilon32d
	- tex_name "\Upsilon_3(2D)"
	+ tex_name "\Upsilon_3(2D)"

	-# Light Baryons
	+# Light Baryons
	particle PROTON 2212
	spin 1/2 charge 1
	name p "p+"
	anti pbar "p-"
	tex_name "p"
	tex_anti "\bar{p}"
	particle NEUTRON 2112
	spin 1/2 charge 0
	name n "n0"
	anti nbar "nbar0"
	tex_name "n"
	- tex_anti "\bar{n}"
	+ tex_anti "\bar{n}"
	particle DELTAM 1114
	spin 1/2 charge -1
	name "Delta-" Deltam
	anti "Deltabar+" Deltabarp
	tex_name "\Delta^-"
	tex_anti "\bar{\Delta}^+"
	particle DELTA0 2114
	spin 1/2 charge 0
	name "Delta0"
	anti "Deltabar0"
	tex_name "\Delta^0"
	tex_anti "\bar{\Delta}^0"
	particle DELTAP 2214
	spin 1/2 charge 1
	name "Delta+" "Deltap"
	anti "Deltabar-" "Deltabarm"
	tex_name "\Delta^+"
	tex_anti "\bar{\Delta}^-"
	particle DELTAPP 2224
	spin 1/2 charge 2
	name "Delta++" Deltapp
	anti "Deltabar--" Deltabarmm
	tex_name "\Delta^{++}"
	tex_anti "\bar{\Delta}^{--}"

	# Strange Baryons
	particle LAMBDA0 3122
	spin 1/2
	name lambda lambda0
	anti lambdabar lambdabar0
	tex_name "\Lambda"
	tex_anti "\bar{\Lambda}"
	particle SIGMA0 3212
	spin 1/2
	name sigma sigma0
	anti sigmabar sigmabar0
	tex_name "\Sigma^0"
	tex_name "\bar{\Sigma}^0"
	particle SIGMAP 3222
	spin 1/2 charge 1
	name sigmap
	anti sigmabarm
	tex_name "\Sigma^+"
	tex_anti "\bar{\Sigma}^-"
	particle SIGMAM 3112
	spin 1/2 charge -1
	name sigmam
	anti sigmabarp
	tex_name "\Sigma^-"
	tex_anti "\bar{\Sigma}^+"
	particle SIGMASTAR0 3214
	spin 3/2
	name sigmastar0
	anti sigmastarbar0
	tex_name "\Sigma^{*0}"
	tex_anti "\bar{\Sigma}^{*0}"
	particle SIGMASTARP 3224
	spin 3/2 charge 1
	name sigmastarp
	anti sigmabarstarm
	tex_name "\Sigma^{*+}"
	tex_anti "\bar{\Sigma}^{*-}"
	particle SIGMASTARM 3114
	spin 3/2 charge -1
	name sigmastarm
	anti sigmabarstarp
	tex_name "\Sigma^{*-}"
	tex_anti "\bar{\Sigma}^{*+}"
	particle XIM 3312
	spin 1/2 charge -1
	name "xi-" xim
	anti "xi+" xip
	tex_name "\Xi^-"
	tex_anti "\bar{\Xi}^+"
	particle XISTARM 3314
	spin 3/2 charge -1
	name "xistar-" xistarm
	anti "xistar+" xistarp
	tex_name "\Xi^{*-}"
	tex_anti "\bar{\Xi}^{*+}"
	particle XI0 3322
	spin 1/2
	name xi0
	anti xibar0
	tex_name "\Xi^{0}"
	tex_anti "\bar{\Xi}^{0}"
	particle XISTAR0 3324
	spin 1/2
	name xistar0
	anti xistarbar0
	tex_name "\Xi^{*0}"
	tex_anti "\bar{\Xi}^{*0}"
	particle OMEGAM 3334
	spin 3/2 charge -1
	name "omega-" omegam
	anti "omega+" omegap
	tex_name "\Omega^-"
	tex_anti "\bar{\Omega}^+"

	# Charm Baryons
	particle LAMBDACP 4122
	spin 1/2 charge 1
	name "lambdac+" lambdacp
	anti "lambdac-" lambdacm
	tex_name "\Lambda_c^+"
	tex_anti "\bar{\Lambda_c}^{-}"
	particle LAMBDACP2593 14122
	spin 1/2 charge 1
	name "lambdac(2593)+" lambdacp2593
	anti "lambdac(2593)-" lambdacm2593
	tex_name "\Lambda_c^+(2593)"
	tex_anti "\bar{\Lambda_c}^{-}(2593)"
	particle LAMBDACP2625 4124
	spin 3/2 charge 1
	name "lambdac(2625)+" lambdacp2625
	anti "lambdac(2625)-" lambdacm2625
	tex_name "\Lambda_c^+(2625)"
	tex_anti "\bar{\Lambda_c}^{-}(2625)"
	particle SIGMAC0 4112
	spin 1/2 charge 0
	name sigmac sigmac0
	anti sigmacbar sigmacbar0
	tex_name "\Sigma_c^0"
	tex_name "\bar{\Sigma_c}^0"
	particle SIGMASTARC0 4114
	spin 3/2 charge 0
	name sigmastarc sigmastarc0
	anti sigmastarcbar sigmastarcbar0
	tex_name "\Sigma_c^{*0}"
	tex_name "\bar{\Sigma_c}^{*0}"
	particle SIGMACP 4212
	spin 1/2 charge 1
	name "sigmac+" sigmacp
	anti "sigmacbar-" sigmacbarm
	tex_name "\Sigma_c^+"
	tex_anti "\bar{\Sigma_c}^-"
	particle SIGMACPP 4222
	spin 1/2 charge 2
	name "sigmac++" sigmacpp
	anti "sigmacbar--" sigmacbarmm
	tex_name "\Sigma_c^{++}"
	tex_anti "\bar{\Sigma_c}^{--}"
	particle SIGMASTARCP 4214
	spin 3/2 charge 1
	name "sigmastarc+" sigmastarcp
	anti "sigmastarcbar-" sigmastarcbarm
	tex_name "\Sigma_c^{*+}"
	tex_anti "\bar{\Sigma_c}^{*-}"
	particle SIGMASTARCPP 4224
	spin 3/2 charge 2
	name "sigmastarc++" sigmastarcpp
	anti "sigmastarcbar--" sigmastarcbarmm
	tex_name "\Sigma_c^{*++}"
	tex_anti "\bar{\Sigma_c}^{*--}"
	particle XIC0 4132
	spin 1/2 charge 0
	name xic0 xic
	anti xicbar0 xicbar
	tex_name "\Xi_c^{0}"
	tex_anti "\bar{\Xi_c}^{0}"
	particle XIPRIMEC0 4312
	spin 1/2 charge 0
	name xiprimec0 xiprimec
	anti xiprimecbar0 xiprimecbar
	tex_name "\Xi'_c^{0}"
	tex_anti "\bar{\Xi'_c}^{0}"
	particle XISTARC0 4314
	spin 3/2 charge 0
	name xistarc0 xistarc
	anti xistarcbar0 xistarcbar
	tex_name "\Xi_c^{*0}"
	tex_anti "\bar{\Xi_c}^{*0}"
	particle XICP 4232
	spin 1/2 charge 1
	name "xic+" xicp
	anti "xic-" xicm
	tex_name "\Xi_c^+"
	tex_anti "\bar{\Xi_c}^-"
	particle XIPRIMECP 4322
	spin 1/2 charge 1
	name "xiprimec+" xiprimecp
	anti "xiprimec-" xiprimecm
	tex_name "\Xi'_c^+"
	tex_anti "\bar{\Xi'_c}^-"
	particle XISTARCP 4324
	spin 3/2 charge 1
	name "xistarc+" xistarcp
	anti "xistarc-" xistarcm
	tex_name "\Xi_c^{*+}"
	tex_anti "\bar{\Xi_c}^{*-}"
	particle OMEGAC0 4332
	spin 1/2 charge 0
	name omegac omegac0
	anti omegacbar omegacbar0
	tex_name "\Omega_c^0"
	tex_anti "\bar{\Omega_c}^0"
	particle OMEGASTARC0 4334
	spin 3/2 charge 0
	name omegastarc omegastarc0
	anti omegastarcbar omegastarcbar0
	tex_name "\Omega_c^{*0}"
	tex_anti "\bar{\Omega_c}^{*0}"
	particle XICCP 4412
	spin 1/2 charge 1
	name xiccp "xicc+"
	anti xiccm "xicc-"
	tex_name "\Xi_{cc}^+"
	tex_anti "\bar{\Xi}_{cc}^-"
	particle XICCPP 4422
	spin 1/2 charge 2
	name xiccpp "xicc++"
	anti xiccmm "xicc--"
	tex_name "\Xi_{cc}^{++}"
	tex_anti "\bar{\Xi}_{cc}^{--}"
	particle XISTARCCP 4414
	spin 3/2 charge 1
	name xistarccp "xi*cc+"
	anti xistarccm "xi*cc-"
	tex_name "\Xi_{cc}^{*+}"
	tex_anti "\bar{\Xi}_{cc}^{*-}"
	particle XISTARCCPP 4424
	spin 3/2 charge 2
	name xistarccpp "xi*cc++"
	anti xistarccmm "xi*cc--"
	tex_name "\Xi_{cc}^{*++}"
	tex_anti "\bar{\Xi}_{cc}^{*--}"
	particle OMEGACCP 4432
	spin 1/2 charge 1
	name omegaccp "omegacc+"
	anti omegaccm "omegacc-"
	tex_name "\Omega_{cc}^+"
	tex_anti "\bar{\Omega}_{cc}^-"
	particle OMEGASTARCCP 4434
	spin 3/2 charge 1
	name omegastarccp "omegacc+"
	anti omegaccm "omegacc-"
	tex_name "\Omega_{cc}^{*+}"
	tex_anti "\bar{\Omega}_{cc}^{*-}"
	particle OMEGACCCPP 4444
	spin 1/2 charge 2
	name omegacccpp "omegaccc++"
	anti omegacccmm "omegaccc--"
	tex_name "\Omega_{ccc}^{++}"
	tex_anti "\bar{\Omega}_{ccc}^{--}"

	# Bottom baryons
	particle SIGMABM 5112
	- spin 1/2 charge -1
	- name sigmabm "sigmab-"
	+ spin 1/2 charge -1
	+ name sigmabm "sigmab-"
	anti sigmabbarp "sigmabbar+"
	tex_name "\Sigma_b^-"
	tex_anti "\bar{\Sigma_b}^+"
	particle LAMBDAB 5122
	spin 1/2
	name lambdab lambdab0
	anti lambdabbar lambdabbar0
	tex_name "\Lambda_b^0"
	tex_anti "\bar{\Lambda_b}^0"
	particle SIGMASTARBM 5114
	- spin 3/2 charge -1
	+ spin 3/2 charge -1
	name sigmastarbm "sigma*b-"
	anti sigmastarbbarp "sigma*bbar+"
	tex_name "\Sigma_b^{*-}"
	tex_anti "\bar{\Sigma_b}^{*+}"
	particle XIBM 5132
	spin 1/2 charge -1
	name "xib-" xibm
	anti "xib+" xibp
	tex_name "\Xi^-_b"
	tex_anti "\bar{\Xi}^+_b"
	particle SIGMAB0 5212
	spin 1/2 charge 0
	name sigmab sigmab0
	anti sigmabbar sigmabbar0
	tex_name "\Sigma_b^0"
	tex_name "\bar{\Sigma_b}^0"
	particle SIGMASTARB0 5214
	spin 3/2 charge 0
	name sigmastarb sigmastarb0 "sigma*b"
	anti sigmastarbbar sigmastarbbar0 "sigma*bar0"
	tex_name "\Sigma_b^{*0}"
	tex_name "\bar{\Sigma_b}^{*0}"
	particle SIGMABP 5222
	- spin 1/2 charge 1
	+ spin 1/2 charge 1
	name sigmabp "sigmab+"
	anti sigmabbarm "sigmabbar-"
	tex_name "\Sigma_b^+"
	tex_anti "\bar{\Sigma_b}^-"
	particle SIGMASTARBP 5224
	- spin 3/2 charge 1
	+ spin 3/2 charge 1
	name sigmastarbp "sigma*b+"
	anti sigmastarbbarm "sigma*bbar-"
	tex_name "\Sigma_b^{*+}"
	tex_anti "\bar{\Sigma_b}^{*-}"
	particle XIB0 5232
	spin 1/2 charge 0
	name xib0 xib
	anti xibbar0 xibbar
	tex_name "\Xi_b^{0}"
	tex_anti "\bar{\Xi_b}^{0}"
	particle XIPRIMEBM 5312
	- spin 3/2 charge -1
	+ spin 3/2 charge -1
	name xiprimebm "xiprimeb-"
	anti xiprimebbarp "xiprimebbar+"
	tex_name "\Xi'_b^{-}"
	tex_anti "\bar{\Xi'_b}^{+}"
	particle XISTARBM 5314
	- spin 3/2 charge -1
	+ spin 3/2 charge -1
	name xistarbm "xi*b-"
	anti xistarbbarp "xi*bbar+"
	tex_name "\Xi_b^{*-}"
	tex_anti "\bar{\Xi_b}^{*+}"
	particle XIPRIMEB0 5322
	spin 1/2 charge 0
	name xiprimeb0 xiprimeb
	anti xiprimebbar0 xiprimebbar
	tex_name "\Xi'_b^{0}"
	tex_anti "\bar{\Xi'_b}^{0}"
	particle XISTARB0 5324
	spin 3/2 charge 0
	name xistarb0 xistarb "xi*0"
	anti xistarbbar0 xistarbbar "xi*bar0"
	tex_name "\Xi_b^{*0}"
	tex_anti "\bar{\Xi_b}^{*0}"
	particle OMEGABM 5332
	spin 1/2 charge -1
	name omegabm "omegabm-"
	anti omegabbarp "omegabbar+"
	tex_name "\Omega_b^-"
	tex_anti "\bar{\Omega_b}^+"
	particle OMEGASTARBM 5334
	spin 3/2 charge -1
	name omegastarbm "omegastarb-"
	anti omegastarbbarp "omegastarbbar+"
	tex_name "\Omega_b^{*-}"
	tex_anti "\bar{\Omega_b}^{*+}"
	particle XIBC0 5142
	spin 1/2 charge 0
	name xibc0 xibc
	anti xibcbar0 xibcbar
	tex_name "\Xi_{bc}^0"
	tex_anti "\bar{\Xi}_{bc}^0"
	particle XIBCP 5242
	spin 1/2 charge 1
	name xibcp "xibc+"
	anti xibcm "xibc-"
	tex_name "\Xi_{bc}^+"
	- tex_anti "\bar{\Xi}_{bc}^-"
	+ tex_anti "\bar{\Xi}_{bc}^-"
	particle XIBCPRIME0 5412
	spin 3/2 charge 0
	name xibcprime0 xibcprime
	anti xibcprimebar0 xibcprimebar
	tex_name "\Xi_{bc}^{'0}"
	tex_anti "\bar{\Xi}_{bc}^{'0}"
	particle XIBCPRIMEP 5422
	spin 3/2 charge 1
	name xibcprimep "xibcprime+"
	anti xibcprimem "xibcprime-"
	tex_name "\Xi_{bc}^{'+}"
	tex_anti "\bar{\Xi}_{bc}^{'-}"
	particle XIBCSTAR0 5414
	spin 3/2 charge 0
	name xibcstar0 "xibc*0"
	anti xibcstarbar0 "xibc*bar0"
	tex_name "\Xi_{bc}^{*0}"
	tex_anti "\bar{\Xi}_{bc}^{*0}"
	particle XIBCSTARP 5424
	spin 3/2 charge 1
	name xibcstarp "xibc*+"
	anti xibcstarm "xibc*-"
	tex_name "\Xi_{bc}^{*+}"
	tex_anti "\bar{\Xi}_{bc}^{*-}"
	particle OMEGABC0 5342
	spin 1/2 charge 0
	name omegabc0 omegabc
	anti omegabcbar0 omegabcbar
	tex_name "\Omega_{bc}^0"
	tex_anti "\bar{\Omega}_{bc}^0"
	particle OMEGABCPRIME0 5432
	spin 3/2 charge 0
	name omegabcprime0 omegabcprime
	anti omegabcprimebar0 omegabcprimebar
	tex_name "\Omega_{bc}^{'0}"
	tex_anti "\bar{\Omega}_{bc}^{'0}"
	particle OMEGABCSTAR0 5434
	spin 3/2 charge 0
	name omegabcstar0 "omegabc*"
	anti omegabcstarbar0 "omegabc*bar"
	tex_name "\Omega_{bc}^{*0}"
	- tex_anti "\bar{\Omega}_{bc}^{*0}"
	+ tex_anti "\bar{\Omega}_{bc}^{*0}"
	particle OMEGABCCP 5442
	spin 1/2 charge 1
	name omegabccp "omegabcc+"
	anti omegabccm "omegabcc-"
	tex_name "\Omega_{bcc}^+"
	tex_anti "\bar{Omega}_{bcc}^-"
	particle OMEGABCCSTARP 5444
	spin 3/2 charge 1
	name omegabccstarp "omegabcc*+"
	anti omegabccstarm "omegabcc*-"
	tex_name "\Omega_{bcc}^{*+}"
	- tex_anti "\bar{Omega}_{bcc}^{*-}"
	+ tex_anti "\bar{Omega}_{bcc}^{*-}"
	particle SIGMABBM 5512
	spin 1/2 charge -1
	name sigmabbm "sigmabb-"
	anti sigmabbp "sigmabb+"
	tex_name "\Sigma_{bb}^-"
	tex_anti "\bar{\Sigma}_{bb}^+"
	particle SIGMABB0 5522
	spin 1/2 charge 0
	- name sigmabb0
	- anti sigmabbbar0
	+ name sigmabb0
	+ anti sigmabbbar0
	tex_name "\Sigma_{bb}^0"
	tex_anti "\bar{\Sigma}_{bb}^0"
	particle SIGMABBSTARM 5514
	spin 3/2 charge -1
	name sigmabbstarm "sigmabb*-"
	anti sigmabbstarp "sigmabb*+"
	tex_name "\Sigma_{bb}^{*-}"
	tex_anti "\bar{\Sigma}_{bb}^{*+}"
	particle SIGMABBSTAR0 5524
	spin 3/2 charge 0
	name sigmabbstar0 "sigmabb*0"
	anti sigmabbstarbar0 "sigmabb*bar0"
	tex_name "\Sigma_{bb}^{*0}"
	- tex_anti "\bar{\Sigma}_{bb}^{*0}"
	+ tex_anti "\bar{\Sigma}_{bb}^{*0}"
	particle OMEGABBM 5532
	spin 1/2 charge -1
	name omegabbm "omegabb-"
	anti omegabbp "omegabb+"
	tex_name "\Omega_{bb}^-"
	tex_anti "\bar{\Omega}_{bb}^+"
	particle OMEGABB0 5534
	spin 1/2 charge 0
	- name omegabb0
	- anti omegabbbar0
	+ name omegabb0
	+ anti omegabbbar0
	tex_name "\Omega_{bb}^0"
	- tex_anti "\bar{\Omega}_{bb}^0"
	+ tex_anti "\bar{\Omega}_{bb}^0"
	particle OMEGABBC0 5542
	spin 1/2 charge 0
	name omegabbc0
	anti omegabbcbar0
	tex_name "\Omega_{bbc}^0"
	tex_anti "\bar{\Omega}_{bbc}^0"
	particle OMEGABBCSTAR0 5544
	spin 1/2 charge 0
	name omegabbcstar0 "omegabbc*0"
	anti omegabbcstarbar0 "omegabbc*bar0"
	tex_name "\Omega_{bbc}^{*0}"
	- tex_anti "\bar{\Omega}_{bbc}^{*0}"
	+ tex_anti "\bar{\Omega}_{bbc}^{*0}"
	particle OMEGABBBM 5554
	spin 1/2 charge -1
	name omegabbbm "omegabbb-"
	anti omegabbbp "omegabbb+"
	tex_name "\Omega_{bbb}^-"
	tex_anti "\bar{\Omega}_{bbb}^+"

	# Beam remnants for proton colliders
	particle HADRON_REMNANT 90
	name hr
	tex_name "had_r"
	particle HADRON_REMNANT_SINGLET 91
	name hr1
	tex_name "had_r^{(1)}"
	particle HADRON_REMNANT_TRIPLET 92
	color 3
	name hr3
	tex_name "had_r^{(3)}"
	anti hr3bar
	tex_anti "had_r^{(\bar 3)}"
	particle HADRON_REMNANT_OCTET 93
	color 8
	name hr8
	tex_name "had_r^{(8)}"
	particle PYTHIA_SHOWER_SYSTEM 94
	name cmshower
	tex_name "CM_{Py}"
	+
	+# Additional entries from PYTHIA8 database, 28. August 2018
	+particle BPRIME 7
	+ spin 1/2 charge 0 color 3
	+ name "b'"
	+ anti "b'bar"
	+
	+particle TPRIME 8
	+ spin 1/2 charge 0 color 3
	+ name "t'"
	+ anti "t'bar"
	+
	+particle TAUPRIMEMINUS 17
	+ spin 1/2 charge -1
	+ name "tau'-"
	+ anti "tau'+"
	+
	+particle NUPRIME_TAU 18
	+ spin 1/2 charge 0
	+ name "nu'_tau"
	+ anti "nu'_taubar"
	+
	+particle ZPRIME0 32
	+ spin 1 charge 0
	+ name "Z'0"
	+
	+particle ZPRIMEPRIME0 33
	+ spin 1 charge 0
	+ name "Z''0"
	+
	+particle WPRIMEPLUS 34
	+ spin 1 charge 1
	+ name "W'+"
	+ anti "W'-"
	+
	+particle H0 35
	+ spin 0 charge 0
	+ name "H0"
	+
	+particle A0 36
	+ spin 0 charge 0
	+ name "A0"
	+
	+particle HPLUS 37
	+ spin 0 charge 1
	+ name "H+"
	+ anti "H-"
	+
	+particle GRAVITON 39
	+ spin 2 charge 0
	+ name "Graviton"
	+
	+particle BLACKHOLE 40
	+ charge 0
	+ name "BlackHole"
	+
	+particle R0 41
	+ spin 1 charge 0
	+ name "R0"
	+ anti "Rbar0"
	+
	+particle LQ_UE 42
	+ spin 0 charge 0 color 3
	+ name "LQ_ue"
	+ anti "LQ_uebar"
	+
	+particle H_3 45
	+ spin 0 charge 0
	+ name "H_3"
	+
	+particle A_2 46
	+ spin 0 charge 0
	+ name "A_2"
	+
	+particle DMS0 51
	+ spin 0 charge 0
	+ name "DM(s=0)"
	+ anti "DMbar(s=0)"
	+
	+particle DMS12 52
	+ spin 1/2 charge 0
	+ name "DM(s=1/2)"
	+ anti "DMbar(s=1/2)"
	+
	+particle DMS1 53
	+ spin 1 charge 0
	+ name "DM(s=1)"
	+ anti "DMbar(s=1)"
	+
	+particle DMMEDS0 54
	+ spin 0 charge 0
	+ name "DMmed(s=0)"
	+ anti "DMmedbar(s=0)"
	+
	+particle DMMEDS1 55
	+ spin 1 charge 0
	+ name "DMmed(s=1)"
	+ anti "DMmedbar(s=1)"
	+
	+particle DM1 56
	+ spin 0 charge 0
	+ name "DM?1"
	+ anti "DMbar?1"
	+
	+particle DM2 57
	+ spin 0 charge 0
	+ name "DM?2"
	+ anti "DMbar?1"
	+
	+particle DM3 58
	+ spin 0 charge 0
	+ name "DM?3"
	+ anti "DMbar?3"
	+
	+particle DM4 59
	+ spin 0 charge 0
	+ name "DM?4"
	+ anti "DMbar?4"
	+
	+particle DM5 60
	+spin 0 charge 0
	+name "DM?5"
	+anti "DMbar?5"
	+
	+particle SPECFLAV 81
	+charge 0
	+name "specflav"
	+
	+particle RNDMFLAVQ 82
	+charge 0
	+name "rndmflavq"
	+anti "rndmflavqbar"
	+
	+particle RNDMFLAVG 83
	+charge 0
	+name "rndmflavg"
	+anti "rndmflavgbar"
	+
	+particle REGGEON 110
	+charge 0
	+name "Reggeon"
	+
	+particle POMERON 990
	+charge 0
	+name "Pomeron"
	+
	+particle LAMBDA15200 3124
	+spin 3/2 charge 0
	+name "Lambda(1520)0"
	+anti "Lambda(1520)bar0"
	+
	+particle BD_1 5103
	+ spin 1 charge 0 color 3
	+ name "bd_1"
	+ anti "bd_1bar"
	+
	+particle LAMBDA14050 13122
	+ spin 1/2 charge 0
	+ name "Lambda(1405)0"
	+ anti "Lambda(1405)bar0"
	+
	+particle LAMBDA16000 23122
	+ spin 1/2 charge 0
	+ name "Lambda(1600)0"
	+ anti "Lambda(1600)bar0"
	+
	+particle LAMBDA16700 33122
	+ spin 1/2 charge 0
	+ name "Lambda(1670)0"
	+ anti "Lambda(1670)bar0"
	+
	+particle TILDED_L 1000001
	+ spin 0 charge 0 color 3
	+ name "~d_L"
	+ anti "~d_Lbar"
	+
	+particle TILDEU_L 1000002
	+ spin 0 charge 0 color 3
	+ name "~u_L"
	+ anti "~u_Lbar"
	+
	+particle TILDES_L 1000003
	+ spin 0 charge 0 color 3
	+ name "~s_L"
	+ anti "~s_Lbar"
	+
	+particle TILDEC_L 1000004
	+ spin 0 charge 0 color 3
	+ name "~c_L"
	+ anti "~c_Lbar"
	+
	+particle TILDEB_1 1000005
	+ spin 0 charge 0 color 3
	+ name "~b_1"
	+ anti "~b_1bar"
	+
	+particle TILDET_1 1000006
	+ spin 0 charge 0 color 3
	+ name "~t_1"
	+ anti "~t_1bar"
	+
	+particle TILDEE_LMINUS 1000011
	+ spin 0 charge -1
	+ name "~e_L-"
	+ anti "~e_L+"
	+
	+particle TILDENU_EL 1000012
	+ spin 0 charge 0
	+ name "~nu_eL"
	+ anti "~nu_eLbar"
	+
	+particle TILDEMU_LMINUS 1000013
	+ spin 0 charge -1
	+ name "~mu_L-"
	+ anti "~mu_L+"
	+
	+particle TILDENU_MUL 1000014
	+ spin 0 charge 0
	+ name "~nu_muL"
	+ anti "~nu_muLbar"
	+
	+particle TILDETAU_1MINUS 1000015
	+ spin 0 charge -1
	+ name "~tau_1-"
	+ anti "~tau_1+"
	+
	+particle TILDENU_TAUL 1000016
	+ spin 0 charge 0
	+ name "~nu_tauL"
	+ anti "~nu_tauLbar"
	+
	+particle TILDEG 1000021
	+ spin 1/2 charge 0 color 8
	+ name "~g"
	+
	+particle TILDECHI_10 1000022
	+ spin 1/2 charge 0
	+ name "~chi_10"
	+
	+particle TILDECHI_20 1000023
	+ spin 1/2 charge 0
	+ name "~chi_20"
	+
	+particle TILDECHI_1PLUS 1000024
	+ spin 1/2 charge 1
	+ name "~chi_1+"
	+ anti "~chi_1-"
	+
	+particle TILDECHI_30 1000025
	+ spin 1/2 charge 0
	+ name "~chi_30"
	+
	+particle TILDECHI_40 1000035
	+ spin 1/2 charge 0
	+ name "~chi_40"
	+
	+particle TILDECHI_2PLUS 1000037
	+ spin 1/2 charge 1
	+ name "~chi_2+"
	+ anti "~chi_2-"
	+
	+particle TILDEGRAVITINO 1000039
	+ spin 3/2 charge 0
	+ name "~Gravitino"
	+
	+particle TILDECHI_50 1000045
	+ spin 1/2 charge 0
	+ name "~chi_50"
	+
	+particle R0TILDEB_DBAR 1000512
	+ spin 1/2 charge 0
	+ name "R0(~b dbar)"
	+ anti "R0(~bbar d)"
	+
	+particle RMINUSTILDEB_UBAR 1000522
	+ spin 1/2 charge -1
	+ name "R-(~b ubar)"
	+ anti "R+(~bbar u)"
	+
	+particle R0TILDEB_SBAR 1000532
	+ spin 1/2 charge 0
	+ name "R0(~b sbar)"
	+ anti "R0(~bbar s)"
	+
	+particle RMINUSTILDEB_CBAR 1000542
	+ spin 1/2 charge -1
	+ name "R-(~b cbar)"
	+ anti "R+(~bbar c)"
	+
	+particle R0TILDEB_BBAR 1000552
	+ spin 1/2 charge 0
	+ name "R0(~b bbar)"
	+ anti "R0(~bbar b)"
	+
	+particle RPLUSTILDET_DBAR 1000612
	+ spin 1/2 charge 1
	+ name "R+(~t dbar)"
	+ anti "R-(~tbar d)"
	+
	+particle R0TILDET_UBAR 1000622
	+ spin 1/2 charge 0
	+ name "R0(~t ubar)"
	+ anti "R0(~tbar u)"
	+
	+particle RPLUSTILDET_SBAR 1000632
	+ spin 1/2 charge 1
	+ name "R+(~t sbar)"
	+ anti "R-(~tbar s)"
	+
	+particle R0TILDET_CBAR 1000642
	+ spin 1/2 charge 0
	+ name "R0(~t cbar)"
	+ anti "R0(~tbar c)"
	+
	+particle RPLUSTILDET_BBAR 1000652
	+ spin 1/2 charge 1
	+ name "R+(~t bbar)"
	+ anti "R-(~tbar b)"
	+
	+particle R0TILDEG_G 1000993
	+ spin 1 charge 0
	+ name "R0(~g g)"
	+
	+particle RMINUSTILDEB_DD1 1005113
	+ spin 1 charge -1
	+ name "R-(~b dd1)"
	+ anti "Rbar+(~b dd1)"
	+
	+particle R0TILDEB_UD0 1005211
	+ spin 0 charge 0
	+ name "R0(~b ud0)"
	+ anti "Rbar0(~b ud0)"
	+
	+particle R0TILDEB_UD1 1005213
	+ spin 1 charge 0
	+ name "R0(~b ud1)"
	+ anti "Rbar0(~b ud1)"
	+
	+particle RPLUSTILDEB_UU1 1005223
	+ spin 1 charge 1
	+ name "R+(~b uu1)"
	+ anti "Rbar-(~b uu1)"
	+
	+particle RMINUSTILDEB_SD0 1005311
	+ spin 0 charge -1
	+ name "R-(~b sd0)"
	+ anti "Rbar+(~b sd0)"
	+
	+particle RMINUSTILDEB_SD1 1005313
	+ spin 1 charge -1
	+ name "R-(~b sd1)"
	+ anti "Rbar+(~b sd1)"
	+
	+particle R0TILDEB_SU0 1005321
	+ spin 0 charge 0
	+ name "R0(~b su0)"
	+ anti "Rbar0(~b su0)"
	+
	+particle R0TILDEB_SU1 1005323
	+ spin 1 charge 0
	+ name "R0(~b su1)"
	+ anti "Rbar0(~b su1)"
	+
	+particle RMINUSTILDEB_SS1 1005333
	+ spin 1 charge -1
	+ name "R-(~b ss1)"
	+ anti "Rbar+(~b ss1)"
	+
	+particle R0TILDET_DD1 1006113
	+ spin 1 charge 0
	+ name "R0(~t dd1)"
	+ anti "Rbar0(~t dd1)"
	+
	+particle RPLUSTILDET_UD0 1006211
	+ spin 0 charge 1
	+ name "R+(~t ud0)"
	+ anti "Rbar-(~t ud0)"
	+
	+particle RPLUSTILDET_UD1 1006213
	+ spin 1 charge 1
	+ name "R+(~t ud1)"
	+ anti "Rbar-(~t ud1)"
	+
	+particle RPLUSPLUSTILDET_UU1 1006223
	+ spin 1 charge 2
	+ name "R++(~t uu1)"
	+ anti "Rbar--(~t uu1)"
	+
	+particle RMINUSTILDET_SD0 1006311
	+ spin 0 charge 0
	+ name "R-(~t sd0)"
	+ anti "Rbar+(~t sd0)"
	+
	+particle RMINUSTILDET_SD1 1006313
	+ spin 1 charge 0
	+ name "R-(~t sd1)"
	+ anti "Rbar+(~t sd1)"
	+
	+particle R0TILDET_SU0 1006321
	+ spin 0 charge 1
	+ name "R0(~t su0)"
	+ anti "Rbar0(~t su0)"
	+
	+particle R0TILDET_SU1 1006323
	+ spin 1 charge 1
	+ name "R0(~t su1)"
	+ anti "Rbar0(~t su1)"
	+
	+particle R0TILDET_SS1 1006333
	+ spin 1 charge 0
	+ name "R0(~t ss1)"
	+ anti "Rbar0(~t ss1)"
	+
	+particle RTEMPTILDEG_Q 1009002
	+ spin 1/2 charge 0 color 3
	+ name "Rtemp(~g q)"
	+ anti "Rtemp(~g qbar)"
	+
	+particle R0TILDEG_D_DBAR 1009113
	+ spin 1 charge 0
	+ name "R0(~g d dbar)"
	+
	+particle RPLUSTILDEG_U_DBAR 1009213
	+ spin 1 charge 1
	+ name "R+(~g u dbar)"
	+ anti "R-(~g d ubar)"
	+
	+particle R0TILDEG_U_UBAR 1009223
	+ spin 1 charge 0
	+ name "R0(~g u ubar)"
	+
	+particle R0TILDEG_D_SBAR 1009313
	+ spin 1 charge 0
	+ name "R0(~g d sbar)"
	+ anti "R0(~g s dbar)"
	+
	+particle RPLUSTILDEG_U_SBAR 1009323
	+ spin 1 charge 1
	+ name "R+(~g u sbar)"
	+ anti "R-(~g s ubar)"
	+
	+particle R0TILDEG_S_SBAR 1009333
	+ spin 1 charge 0
	+ name "R0(~g s sbar)"
	+
	+particle RPLUSTILDEG_C_DBAR 1009413
	+ spin 1 charge 1
	+ name "R+(~g c dbar)"
	+ anti "R-(~g d cbar)"
	+
	+particle R0TILDEG_C_UBAR 1009423
	+ spin 1 charge 0
	+ name "R0(~g c ubar)"
	+ anti "R0(~g u cbar)"
	+
	+particle RPLUSTILDEG_C_SBAR 1009433
	+ spin 1 charge 1
	+ name "R+(~g c sbar)"
	+ anti "R-(~g s cbar)"
	+
	+particle R0TILDEG_C_CBAR 1009443
	+ spin 1 charge 0
	+ name "R0(~g c cbar)"
	+
	+particle R0TILDEG_D_BBAR 1009513
	+ spin 1 charge 0
	+ name "R0(~g d bbar)"
	+ anti "R0(~g b dbar)"
	+
	+particle RPLUSTILDEG_U_BBAR 1009523
	+ spin 1 charge 1
	+ name "R+(~g u bbar)"
	+ anti "R-(~g b ubar)"
	+
	+particle R0TILDEG_S_BBAR 1009533
	+ spin 1 charge 0
	+ name "R0(~g s bbar)"
	+ anti "R0(~g b sbar)"
	+
	+particle RPLUSTILDEG_C_BBAR 1009543
	+ spin 1 charge 1
	+ name "R+(~g c bbar)"
	+ anti "R-(~g b cbar)"
	+
	+particle R0TILDEG_B_BBAR 1009553
	+ spin 1 charge 0
	+ name "R0(~g b bbar)"
	+
	+particle RMINUSTILDEG_DDD 1091114
	+ spin 3/2 charge -1
	+ name "R-(~g ddd)"
	+ anti "Rbar+(~g ddd)"
	+
	+particle R0TILDEG_UDD 1092114
	+ spin 3/2 charge 0
	+ name "R0(~g udd)"
	+ anti "Rbar0(~g udd)"
	+
	+particle RPLUSTILDEG_UUD 1092214
	+ spin 3/2 charge 1
	+ name "R+(~g uud)"
	+ anti "Rbar-(~g uud)"
	+
	+particle RPLUSPLUSTILDEG_UUU 1092224
	+ spin 3/2 charge 2
	+ name "R++(~g uuu)"
	+ anti "Rbar--(~g uuu)"
	+
	+particle RMINUSTILDEG_SDD 1093114
	+ spin 3/2 charge -1
	+ name "R-(~g sdd)"
	+ anti "Rbar+(~g sdd)"
	+
	+particle R0TILDEG_SUD 1093214
	+ spin 3/2 charge 0
	+ name "R0(~g sud)"
	+ anti "Rbar0(~g sud)"
	+
	+particle RPLUSTILDEG_SUU 1093224
	+ spin 3/2 charge 1
	+ name "R+(~g suu)"
	+ anti "Rbar-(~g suu)"
	+
	+particle RMINUSTILDEG_SSD 1093314
	+ spin 3/2 charge -1
	+ name "R-(~g ssd)"
	+ anti "Rbar+(~g ssd)"
	+
	+particle R0TILDEG_SSU 1093324
	+ spin 3/2 charge 0
	+ name "R0(~g ssu)"
	+ anti "Rbar0(~g ssu)"
	+
	+particle RMINUSTILDEG_SSS 1093334
	+ spin 3/2 charge -1
	+ name "R-(~g sss)"
	+ anti "Rbar+(~g sss)"
	+
	+particle R0TILDEG_CDD 1094114
	+ spin 3/2 charge 0
	+ name "R0(~g cdd)"
	+ anti "Rbar0(~g cdd)"
	+
	+particle RPLUSTILDEG_CUD 1094214
	+ spin 3/2 charge 1
	+ name "R+(~g cud)"
	+ anti "Rbar-(~g cud)"
	+
	+particle RPLUSPLUSTILDEG_CUU 1094224
	+ spin 3/2 charge 2
	+ name "R++(~g cuu)"
	+ anti "Rbar--(~g cuu)"
	+
	+particle R0TILDEG_CSD 1094314
	+ spin 3/2 charge 0
	+ name "R0(~g csd)"
	+ anti "Rbar0(~g csd)"
	+
	+particle RPLUSTILDEG_CSU 1094324
	+ spin 3/2 charge 1
	+ name "R+(~g csu)"
	+ anti "Rbar-(~g csu)"
	+
	+particle R0TILDEG_CSS 1094334
	+ spin 3/2 charge 0
	+ name "R0(~g css)"
	+ anti "Rbar0(~g css)"
	+
	+particle RMINUSTILDEG_BDD 1095114
	+ spin 3/2 charge -1
	+ name "R-(~g bdd)"
	+ anti "Rbar+(~g bdd)"
	+
	+particle R0TILDEG_BUD 1095214
	+ spin 3/2 charge 0
	+ name "R0(~g bud)"
	+ anti "Rbar0(~g bud)"
	+
	+particle RPLUSTILDEG_BUU 1095224
	+ spin 3/2 charge 1
	+ name "R+(~g buu)"
	+ anti "Rbar-(~g buu)"
	+
	+particle RMINUSTILDEG_BSD 1095314
	+ spin 3/2 charge -1
	+ name "R-(~g bsd)"
	+ anti "Rbar+(~g bsd)"
	+
	+particle R0TILDEG_BSU 1095324
	+ spin 3/2 charge 0
	+ name "R0(~g bsu)"
	+ anti "Rbar0(~g bsu)"
	+
	+particle RMINUSTILDEG_BSS 1095334
	+ spin 3/2 charge -1
	+ name "R-(~g bss)"
	+ anti "Rbar+(~g bss)"
	+
	+particle TILDED_R 2000001
	+ spin 0 charge 0 color 3
	+ name "~d_R"
	+ anti "~d_Rbar"
	+
	+particle TILDEU_R 2000002
	+ spin 0 charge 0 color 3
	+ name "~u_R"
	+ anti "~u_Rbar"
	+
	+particle TILDES_R 2000003
	+ spin 0 charge 0 color 3
	+ name "~s_R"
	+ anti "~s_Rbar"
	+
	+particle TILDEC_R 2000004
	+ spin 0 charge 0 color 3
	+ name "~c_R"
	+ anti "~c_Rbar"
	+
	+particle TILDEB_2 2000005
	+ spin 0 charge 0 color 3
	+ name "~b_2"
	+ anti "~b_2bar"
	+
	+particle TILDET_2 2000006
	+ spin 0 charge 0 color 3
	+ name "~t_2"
	+ anti "~t_2bar"
	+
	+particle TILDEE_RMINUS 2000011
	+ spin 0 charge -1
	+ name "~e_R-"
	+ anti "~e_R+"
	+
	+particle TILDENU_ER 2000012
	+ spin 0 charge 0
	+ name "~nu_eR"
	+ anti "~nu_eRbar"
	+
	+particle TILDEMU_RMINUS 2000013
	+ spin 0 charge -1
	+ name "~mu_R-"
	+ anti "~mu_R+"
	+
	+particle TILDENU_MUR 2000014
	+ spin 0 charge 0
	+ name "~nu_muR"
	+ anti "~nu_muRbar"
	+
	+particle TILDETAU_2MINUS 2000015
	+ spin 0 charge -1
	+ name "~tau_2-"
	+ anti "~tau_2+"
	+
	+particle TILDENU_TAUR 2000016
	+ spin 0 charge 0
	+ name "~nu_tauR"
	+ anti "~nu_tauRbar"
	+
	+particle PI_TC0 3000111
	+ spin 0 charge 0
	+ name "pi_tc0"
	+
	+particle RHO_TC0 3000113
	+ spin 1 charge 0
	+ name "rho_tc0"
	+
	+particle PI_TCPLUS 3000211
	+ spin 0 charge 1
	+ name "pi_tc+"
	+ anti "pi_tc-"
	+
	+particle RHO_TCPLUS 3000213
	+ spin 1 charge 1
	+ name "rho_tc+"
	+ anti "rho_tc-"
	+
	+particle PIPRIME_TC0 3000221
	+ spin 0 charge 0
	+ name "pi'_tc0"
	+
	+particle OMEGA_TC 3000223
	+ spin 1 charge 0
	+ name "omega_tc"
	+
	+particle ETA_TC0 3000331
	+ spin 0 charge 0 color 8
	+ name "eta_tc0"
	+
	+particle V8_TC 3100021
	+ spin 0 charge 0 color 8
	+ name "V8_tc"
	+
	+particle PI_22_1_TC 3100111
	+ spin 0 charge 0
	+ name "pi_22_1_tc"
	+
	+particle RHO_11_TC 3100113
	+ spin 1 charge 0 color 8
	+ name "rho_11_tc"
	+
	+particle PI_22_8_TC 3200111
	+ spin 0 charge 0 color 8
	+ name "pi_22_8_tc"
	+
	+particle RHO_12_TC 3200113
	+ spin 1 charge 0 color 8
	+ name "rho_12_tc"
	+
	+particle RHO_21_TC 3300113
	+ spin 1 charge 0 color 8
	+ name "rho_21_tc"
	+
	+particle RHO_22_TC 3400113
	+ spin 1 charge 0 color 8
	+ name "rho_22_tc"
	+
	+particle DSTAR 4000001
	+ spin 1/2 charge 0 color 3
	+ name "d*"
	+ anti "d*bar"
	+
	+particle USTAR 4000002
	+ spin 1/2 charge 0 color 3
	+ name "u*"
	+ anti "u*bar"
	+
	+particle SSTAR 4000003
	+ spin 1/2 charge 0 color 3
	+ name "s*"
	+ anti "s*bar"
	+
	+particle CSTAR 4000004
	+ spin 1/2 charge 0 color 3
	+ name "c*"
	+ anti "c*bar"
	+
	+particle BSTAR 4000005
	+ spin 1/2 charge 0 color 3
	+ name "b*"
	+ anti "b*bar"
	+
	+particle TSTAR 4000006
	+ spin 1/2 charge 0 color 3
	+ name "t*"
	+ anti "t*bar"
	+
	+particle ESTARMINUS 4000011
	+ spin 1/2 charge -1
	+ name "e*-"
	+ anti "e*bar+"
	+
	+particle NUSTAR_E0 4000012
	+ spin 1/2 charge 0
	+ name "nu*_e0"
	+ anti "nu*_ebar0"
	+
	+particle MUSTARMINUS 4000013
	+ spin 1/2 charge -1
	+ name "mu*-"
	+ anti "mu*bar+"
	+
	+particle NUSTAR_MU0 4000014
	+ spin 1/2 charge 0
	+ name "nu*_mu0"
	+ anti "nu*_mubar0"
	+
	+particle TAUSTARMINUS 4000015
	+ spin 1/2 charge -1
	+ name "tau*-"
	+ anti "tau*bar+"
	+
	+particle NUSTAR_TAU0 4000016
	+ spin 1/2 charge 0
	+ name "nu*_tau0"
	+ anti "nu*_taubar0"
	+
	+particle DV 4900001
	+ spin 1/2 charge 0 color 3
	+ name "Dv"
	+ anti "Dvbar"
	+
	+particle UV 4900002
	+ spin 1/2 charge 0 color 3
	+ name "Uv"
	+ anti "Uvbar"
	+
	+particle SV 4900003
	+ spin 1/2 charge 0 color 3
	+ name "Sv"
	+ anti "Svbar"
	+
	+particle CV 4900004
	+ spin 1/2 charge 0 color 3
	+ name "Cv"
	+ anti "Cvbar"
	+
	+particle BV 4900005
	+ spin 1/2 charge 0 color 3
	+ name "Bv"
	+ anti "Bvbar"
	+
	+particle TV 4900006
	+ spin 1/2 charge 0 color 3
	+ name "Tv"
	+ anti "Tvbar"
	+
	+particle EV 4900011
	+ spin 1/2 charge -1
	+ name "Ev"
	+ anti "Evbar"
	+
	+particle NUEV 4900012
	+ spin 1/2 charge 0
	+ name "nuEv"
	+ anti "nuEvbar"
	+
	+particle MUV 4900013
	+ spin 1/2 charge -1
	+ name "MUv"
	+ anti "MUvbar"
	+
	+particle NUMUV 4900014
	+ spin 1/2 charge 0
	+ name "nuMUv"
	+ anti "nuMUvbar"
	+
	+particle TAUV 4900015
	+ spin 1/2 charge -1
	+ name "TAUv"
	+ anti "TAUvbar"
	+
	+particle NUTAUV 4900016
	+ spin 1/2 charge 0
	+ name "nuTAUv"
	+ anti "nuTAUvbar"
	+
	+particle GV 4900021
	+ spin 1 charge 0
	+ name "gv"
	+
	+particle GAMMAV 4900022
	+ spin 1 charge 0
	+ name "gammav"
	+
	+particle ZV 4900023
	+ spin 1 charge 0
	+ name "Zv"
	+
	+particle QV 4900101
	+ spin 0 charge 0
	+ name "qv"
	+ anti "qvbar"
	+
	+particle PIVDIAG 4900111
	+ spin 0 charge 0
	+ name "pivDiag"
	+
	+particle RHOVDIAG 4900113
	+ spin 1 charge 0
	+ name "rhovDiag"
	+
	+particle PIVUP 4900211
	+ spin 0 charge 0
	+ name "pivUp"
	+ anti "pivDn"
	+
	+particle RHOVUP 4900213
	+ spin 1 charge 0
	+ name "rhovUp"
	+ anti "rhovDn"
	+
	+particle GGV 4900991
	+ spin 0 charge 0
	+ name "ggv"
	+
	+particle Z_KK 5000023
	+ spin 1 charge 0
	+ name "Z_KK"
	+
	+particle GRAVITON 5000039
	+ spin 2 charge 0
	+ name "Graviton"
	+
	+particle KKGLUONSTAR 5100021
	+ spin 1 charge 0 color 8
	+ name "KKgluon*"
	+
	+particle GRAVITONSTAR 5100039
	+ spin 2 charge 0
	+ name "Graviton*"
	+
	+particle NU_RE 9900012
	+ spin 1/2 charge 0
	+ name "nu_Re"
	+
	+particle NU_RMU 9900014
	+ spin 1/2 charge 0
	+ name "nu_Rmu"
	+
	+particle NU_RTAU 9900016
	+ spin 1/2 charge 0
	+ name "nu_Rtau"
	+
	+particle GAM_DIFF0 9900020
	+ spin 1 charge 0
	+ name "gam_diff0"
	+
	+particle Z_R0 9900023
	+ spin 1 charge 0
	+ name "Z_R0"
	+
	+particle W_RPLUS 9900024
	+ spin 1 charge 1
	+ name "W_R+"
	+ anti "W_R-"
	+
	+particle H_LPLUSPLUS 9900041
	+ spin 0 charge 2
	+ name "H_L++"
	+ anti "H_L--"
	+
	+particle H_RPLUSPLUS 9900042
	+ spin 0 charge 2
	+ name "H_R++"
	+ anti "H_R--"
	+
	+particle RHO_DIFF0 9900110
	+ charge 0
	+ name "rho_diff0"
	+
	+particle PI_DIFFRPLUS 9900210
	+ charge 1
	+ name "pi_diffr+"
	+ anti "pi_diffr-"
	+
	+particle OMEGA_DI 9900220
	+ charge 0
	+ name "omega_di"
	+
	+particle PHI_DIFF 9900330
	+ charge 0
	+ name "phi_diff"
	+
	+particle JPSI_DI 9900440
	+ charge 0
	+ name "J/psi_di"
	+
	+particle N_DIFFR0 9902110
	+ charge 0
	+ name "n_diffr0"
	+ anti "n_diffrbar0"
	+
	+particle P_DIFFRPLUS 9902210
	+ charge 1
	+ name "p_diffr+"
	+ anti "p_diffrbar-"
	+
	+particle JPSI3S18 9940003
	+ spin 1 charge 0 color 8
	+ name "J/psi[3S1(8)]"
	+
	+particle CHI_2C3S18 9940005
	+ spin 1 charge 0 color 8
	+ name "chi_2c[3S1(8)]"
	+
	+particle CHI_0C3S18 9940011
	+ spin 1 charge 0 color 8
	+ name "chi_0c[3S1(8)]"
	+
	+particle CHI_1C3S18 9940023
	+ spin 1 charge 0 color 8
	+ name "chi_1c[3S1(8)]"
	+
	+particle PSI2S3S18 9940103
	+ spin 1 charge 0 color 8
	+ name "psi(2S)[3S1(8)]"
	+
	+particle JPSI1S08 9941003
	+ spin 0 charge 0 color 8
	+ name "J/psi[1S0(8)]"
	+
	+particle PSI2S1S08 9941103
	+ spin 0 charge 0 color 8
	+ name "psi(2S)[1S0(8)]"
	+
	+particle JPSI3PJ8 9942003
	+ spin 1 charge 0 color 8
	+ name "J/psi[3PJ(8)]"
	+
	+particle PSI37703PJ8 9942033
	+ spin 1 charge 0 color 8
	+ name "psi(3770)[3PJ(8)]"
	+
	+particle PSI2S3PJ8 9942103
	+ spin 1 charge 0 color 8
	+ name "psi(2S)[3PJ(8)]"
	+
	+particle UPSILON3S18 9950003
	+ spin 1 charge 0 color 8
	+ name "Upsilon[3S1(8)]"
	+
	+particle CHI_2B3S18 9950005
	+ spin 1 charge 0 color 8
	+ name "chi_2b[3S1(8)]"
	+
	+particle CHI_0B3S18 9950011
	+ spin 1 charge 0 color 8
	+ name "chi_0b[3S1(8)]"
	+
	+particle CHI_1B3S18 9950023
	+ spin 1 charge 0 color 8
	+ name "chi_1b[3S1(8)]"
	+
	+particle UPSILON2S3S18 9950103
	+ spin 1 charge 0 color 8
	+ name "Upsilon(2S)[3S1(8)]"
	+
	+particle UPSILON3S3S18 9950203
	+ spin 1 charge 0 color 8
	+ name "Upsilon(3S)[3S1(8)]"
	+
	+particle UPSILON1S08 9951003
	+ spin 0 charge 0 color 8
	+ name "Upsilon[1S0(8)]"
	+
	+particle UPSILON2S1S08 9951103
	+ spin 0 charge 0 color 8
	+ name "Upsilon(2S)[1S0(8)]"
	+
	+particle UPSILON3S1S08 9951203
	+ spin 0 charge 0 color 8
	+ name "Upsilon(3S)[1S0(8)]"
	+
	+particle UPSILON3PJ8 9952003
	+ spin 1 charge 0 color 8
	+ name "Upsilon[3PJ(8)]"
	+
	+particle UPSILON2S3PJ8 9952103
	+ spin 1 charge 0 color 8
	+ name "Upsilon(2S)[3PJ(8)]"
	+
	+particle UPSILON3S3PJ8 9952203
	+ spin 1 charge 0 color 8
	+ name "Upsilon(3S)[3PJ(8)]"
	+
	+particle HE4 1000020040
	+ spin 0 charge 2
	+ name "4He"
	+ anti "4Hebar"
	+
	+particle LI6 1000030060
	+ spin 0 charge 3
	+ name "6Li"
	+ anti "6Libar"
	+
	+particle C12 1000060120
	+ spin 0 charge 6
	+ name "12C"
	+ anti "12Cbar"
	+
	+particle O16 1000080160
	+ spin 0 charge 8
	+ name "16O"
	+ anti "16Obar"
	+
	+particle CU63 1000290630
	+ spin 1/2 charge 29
	+ name "63Cu"
	+ anti "63Cubar"
	+
	+particle XE129 1000541290
	+ spin 1/2 charge 54
	+ name "129Xe"
	+ anti "129Xebar"
	+
	+particle AU197 1000791970
	+ spin 1/2 charge 79
	+ name "197Au"
	+ anti "197Aubar"
	+
	+particle PB208 1000822080
	+ spin 0 charge 82
	+ name "208Pb"
	+ anti "208Pbbar"
	Index: trunk/tests/unit_tests/pythia8.sh
	===================================================================
	--- trunk/tests/unit_tests/pythia8.sh (revision 0)
	+++ trunk/tests/unit_tests/pythia8.sh (revision 8190)
	@@ -0,0 +1,10 @@
	+#!/bin/sh
	+### Check WHIZARD module pythia8
	+echo "Running script $0"
	+if test -f PYTHIA8_FLAG; then
	+ exec ./run_whizard_ut.sh --check pythia8
	+else
	+ echo "\|=============================================================================\|"
	+ echo "No Pythia8 available, test skipped"
	+ exit 77
	+fi
	Index: trunk/tests/unit_tests/whizard_lha.sh
	===================================================================
	--- trunk/tests/unit_tests/whizard_lha.sh (revision 0)
	+++ trunk/tests/unit_tests/whizard_lha.sh (revision 8190)
	@@ -0,0 +1,10 @@
	+#!/bin/sh
	+### Check WHIZARD module whizard_lha
	+echo "Running script $0"
	+if test -f PYTHIA8_FLAG; then
	+ exec ./run_whizard_ut.sh --check whizard_lha
	+else
	+ echo "\|=============================================================================\|"
	+ echo "No Pythia8 available, test skipped"
	+ exit 77
	+fi
	Index: trunk/tests/unit_tests/Makefile.am
	===================================================================
	--- trunk/tests/unit_tests/Makefile.am (revision 8189)
	+++ trunk/tests/unit_tests/Makefile.am (revision 8190)
	@@ -1,411 +1,419 @@
	## Makefile.am -- Makefile for executable WHIZARD test scripts
	##
	## Process this file with automake to produce Makefile.in
	##
	########################################################################
	#
	# Copyright (C) 1999-2018 by
	# Wolfgang Kilian <kilian@physik.uni-siegen.de>
	# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
	# Juergen Reuter <juergen.reuter@desy.de>
	# with contributions from
	# cf. main AUTHORS file
	#
	# WHIZARD is free software; you can redistribute it and/or modify it
	# under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 2, or (at your option)
	# any later version.
	#
	# WHIZARD is distributed in the hope that it will be useful, but
	# WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	# GNU General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with this program; if not, write to the Free Software
	# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
	#
	########################################################################

	WHIZARD_UT_DRIVER = run_whizard_ut.sh

	UNIT_TESTS = \
	analysis.run \
	pdg_arrays.run \
	expressions.run \
	beams.run \
	su_algebra.run \
	bloch_vectors.run \
	polarizations.run \
	md5.run \
	cputime.run \
	lexers.run \
	parser.run \
	color.run \
	os_interface.run \
	evaluators.run \
	formats.run \
	sorting.run \
	grids.run \
	solver.run \
	state_matrices.run \
	interactions.run \
	xml.run \
	sm_qcd.run \
	sm_physics.run \
	models.run \
	auto_components.run \
	radiation_generator.run \
	blha.run \
	particles.run \
	beam_structures.run \
	sf_aux.run \
	sf_mappings.run \
	sf_base.run \
	sf_pdf_builtin.run \
	sf_isr.run \
	sf_epa.run \
	sf_ewa.run \
	sf_circe1.run \
	sf_circe2.run \
	sf_gaussian.run \
	sf_beam_events.run \
	sf_escan.run \
	phs_base.run \
	phs_none.run \
	phs_single.run \
	phs_rambo.run \
	resonances.run \
	phs_trees.run \
	phs_forests.run \
	phs_wood.run \
	phs_fks_generator.run \
	fks_regions.run \
	real_subtraction.run \
	rng_base.run \
	rng_tao.run \
	rng_stream.run \
	selectors.run \
	vegas.run \
	vamp2.run \
	mci_base.run \
	mci_none.run \
	mci_midpoint.run \
	mci_vamp.run \
	mci_vamp2.run \
	integration_results.run \
	prclib_interfaces.run \
	particle_specifiers.run \
	process_libraries.run \
	prclib_stacks.run \
	slha_interface.run \
	prc_test.run \
	prc_template_me.run \
	parton_states.run \
	subevt_expr.run \
	processes.run \
	process_stacks.run \
	cascades.run \
	cascades2_lexer.run \
	cascades2.run \
	event_transforms.run \
	resonance_insertion.run \
	recoil_kinematics.run \
	isr_handler.run \
	epa_handler.run \
	decays.run \
	shower.run \
	shower_base.run \
	events.run \
	hep_events.run \
	+ whizard_lha.run \
	+ pythia8.run \
	eio_data.run \
	eio_base.run \
	eio_direct.run \
	eio_raw.run \
	eio_checkpoints.run \
	eio_lhef.run \
	eio_stdhep.run \
	eio_ascii.run \
	eio_weights.run \
	eio_dump.run \
	iterations.run \
	rt_data.run \
	dispatch.run \
	dispatch_rng.run \
	dispatch_mci.run \
	dispatch_phs.run \
	dispatch_transforms.run \
	process_configurations.run \
	event_streams.run \
	integrations.run \
	ttv_formfactors.run \
	restricted_subprocesses.run \
	simulations.run

	XFAIL_UNIT_TESTS =

	UNIT_TESTS_REQ_GAMELAN = \
	commands.run

	UNIT_TESTS_REQ_EV_ANA = \
	phs_wood_vis.run \
	prc_omega_diags.run \
	integrations_history.run

	UNIT_TESTS_REQ_FASTJET = \
	jets.run

	UNIT_TESTS_REQ_HEPMC = \
	hepmc.run \
	eio_hepmc.run

	UNIT_TESTS_REQ_LCIO = \
	lcio.run \
	eio_lcio.run

	UNIT_TESTS_REQ_OCAML = \
	prc_omega.run \
	compilations.run \
	compilations_static.run

	UNIT_TESTS_REQ_RECOLA = \
	prc_recola.run

	UNIT_TESTS_REQ_LHAPDF5 = \
	sf_lhapdf5.run
	UNIT_TESTS_REQ_LHAPDF6 = \
	sf_lhapdf6.run

	TEST_DRIVERS_RUN = \
	$(UNIT_TESTS) \
	$(UNIT_TESTS_REQ_GAMELAN) \
	$(UNIT_TESTS_REQ_HEPMC) \
	$(UNIT_TESTS_REQ_LCIO) \
	$(UNIT_TESTS_REQ_FASTJET) \
	$(UNIT_TESTS_REQ_LHAPDF5) \
	$(UNIT_TESTS_REQ_LHAPDF6) \
	$(UNIT_TESTS_REQ_OCAML) \
	$(UNIT_TESTS_REQ_RECOLA)
	TEST_DRIVERS_SH = $(TEST_DRIVERS_RUN:.run=.sh)

	########################################################################

	TESTS =
	XFAIL_TESTS =
	TESTS_SRC =

	UNIT_TESTS += $(UNIT_TESTS_REQ_GAMELAN)
	UNIT_TESTS += $(UNIT_TESTS_REQ_FASTJET)
	UNIT_TESTS += $(UNIT_TESTS_REQ_HEPMC)
	UNIT_TESTS += $(UNIT_TESTS_REQ_LCIO)
	UNIT_TESTS += $(UNIT_TESTS_REQ_LHAPDF5)
	UNIT_TESTS += $(UNIT_TESTS_REQ_LHAPDF6)
	UNIT_TESTS += $(UNIT_TESTS_REQ_OCAML)
	UNIT_TESTS += $(UNIT_TESTS_REQ_EV_ANA)
	UNIT_TESTS += $(UNIT_TESTS_REQ_RECOLA)

	TESTS += $(UNIT_TESTS)
	XFAIL_TESTS += $(XFAIL_UNIT_TESTS)


	EXTRA_DIST = $(TEST_DRIVERS_SH)
	$(TESTS_SRC)

	########################################################################
	# Force building the whizard_ut executable in the main src directory.
	# This depends on the unit-test libraries which will be built recursively.

	WHIZARD_UT = ../../src/whizard_ut

	$(TEST_DRIVERS_RUN): $(WHIZARD_UT)

	$(WHIZARD_UT):
	$(MAKE) -C ../../src check

	########################################################################

	VPATH = $(srcdir)

	SUFFIXES = .sh .run

	.sh.run:
	@rm -f $@
	@cp $< $@
	@chmod +x $@

	sf_beam_events.run: test_beam_events.dat
	test_beam_events.dat: $(top_builddir)/share/beam-sim/test_beam_events.dat
	cp $< $@

	cascades2_lexer.run: cascades2_lexer_1.fds
	cascades2_lexer_1.fds: $(top_srcdir)/share/tests/cascades2_lexer_1.fds
	cp $< $@
	cascades2.run: cascades2_1.fds cascades2_2.fds
	cascades2_1.fds: $(top_srcdir)/share/tests/cascades2_1.fds
	cp $< $@
	cascades2_2.fds: $(top_srcdir)/share/tests/cascades2_2.fds
	cp $< $@



	commands.run: sps1ap_decays.slha
	sps1ap_decays.slha: $(top_builddir)/share/susy/sps1ap_decays.slha
	cp $< $@

	WT_OCAML_NATIVE_EXT=opt

	if MPOST_AVAILABLE
	$(UNIT_TESTS_REQ_GAMELAN): gamelan.sty
	gamelan.sty: $(top_builddir)/src/gamelan/gamelan.sty
	cp $< $@

	$(top_builddir)/src/gamelan/gamelan.sty:
	$(MAKE) -C $(top_builddir)/src/gamelan gamelan.sty
	endif

	if OCAML_AVAILABLE

	UFO_TAG_FILE = __init__.py
	UFO_MODELPATH = ../models/UFO

	models.run: $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)

	$(UFO_MODELPATH)/SM/$(UFO_TAG_FILE): $(top_srcdir)/omega/tests/UFO/SM/$(UFO_TAG_FILE)
	$(MAKE) -C $(UFO_MODELPATH)/SM all

	endif

	BUILT_SOURCES = \
	TESTFLAG \
	HEPMC_FLAG \
	LCIO_FLAG \
	FASTJET_FLAG \
	LHAPDF5_FLAG \
	LHAPDF6_FLAG \
	GAMELAN_FLAG \
	EVENT_ANALYSIS_FLAG \
	OCAML_FLAG \
	RECOLA_FLAG \
	PYTHIA6_FLAG \
	+ PYTHIA8_FLAG \
	STATIC_FLAG \
	ref-output \
	err-output

	# If this file is found in the working directory, WHIZARD
	# will use the paths for the uninstalled version (source/build tree),
	# otherwise it uses the installed version
	TESTFLAG:
	touch $@

	FASTJET_FLAG:
	if FASTJET_AVAILABLE
	touch $@
	endif

	HEPMC_FLAG:
	if HEPMC_AVAILABLE
	touch $@
	endif

	LCIO_FLAG:
	if LCIO_AVAILABLE
	touch $@
	endif

	LHAPDF5_FLAG:
	if LHAPDF5_AVAILABLE
	touch $@
	endif

	LHAPDF6_FLAG:
	if LHAPDF6_AVAILABLE
	touch $@
	endif

	GAMELAN_FLAG:
	if MPOST_AVAILABLE
	touch $@
	endif

	OCAML_FLAG:
	if OCAML_AVAILABLE
	touch $@
	endif

	RECOLA_FLAG:
	if RECOLA_AVAILABLE
	touch $@
	endif

	PYTHIA6_FLAG:
	if PYTHIA6_AVAILABLE
	touch $@
	endif

	+PYTHIA8_FLAG:
	+if PYTHIA8_AVAILABLE
	+ touch $@
	+endif
	+
	EVENT_ANALYSIS_FLAG:
	if EVENT_ANALYSIS_AVAILABLE
	touch $@
	endif

	STATIC_FLAG:
	if STATIC_AVAILABLE
	touch $@
	endif

	# The reference output files are in the source directory. Copy them here.
	ref-output: $(top_srcdir)/share/tests/unit_tests/ref-output
	mkdir -p ref-output
	for f in $</*.ref; do cp $$f $@; done

	# The output files from self tests go here.
	err-output:
	mkdir -p err-output

	## installcheck runs the test scripts with the TESTFLAG removed.
	## NOTE: disabled for unit tests, because whizard_ut will not be installed.
	installcheck-local:
	#installcheck-local: notestflag check-am
	notestflag:
	rm -f TESTFLAG
	.PHONY: notestflag

	### Remove DWARF debug information on MAC OS X
	clean-macosx:
	-rm -rf compilations_static_1.dSYM
	-rm -rf compilations_static_2.dSYM
	.PHONY: clean-macosx

	## Remove generated files
	clean-local: clean-macosx
	rm -f gamelan.sty
	rm -f TESTFLAG GAMELAN_FLAG
	rm -f OCAML_FLAG FASTJET_FLAG HEPMC_FLAG LCIO_FLAG RECOLA_FLAG
	- rm -f EVENT_ANALYSIS_FLAG PYTHIA6_FLAG LHAPDF5_FLAG
	+ rm -f EVENT_ANALYSIS_FLAG PYTHIA6_FLAG PYTHIA8_FLAG LHAPDF5_FLAG
	rm -f LHAPDF6_FLAG STATIC_FLAG static_1.exe
	rm -f .run .log slha_test.out
	rm -f core*
	rm -f .f90 .c .$(FC_MODULE_EXT) .o *.la
	rm -f *.makefile
	rm -f *.grid output.rcl
	rm -rf err-output
	rm -rf ref-output
	rm -f .sin .hbc *_fks_regions.out
	rm -f .phs .vg .vgb .evt .evx .lhe .hepmc .dat .debug .mdl
	rm -f .tmp .hepevt .hepevt.verb .lha .lha.verb .slcio
	rm -f prc_omega_diags_1_p_i1_diags.out prc_omega_diags_1_p_i1_diags.toc
	rm -f .hep .up.hep .hep.out .[1-9] .[1-9][0-9] .[1-9][0-9][0-9]
	rm -f .tex .mp .mpx .t[1-9] .t[1-9][0-9] .t[1-9][0-9][0-9]
	rm -f .ltp .aux .dvi .ps .pdf so_test.
	rm -f *.tbl sps1ap_decays.slha bar structure_6[a-b].out
	rm -f *.fds
	rm -f .vg2 .vegas *.grids grids_2_test
	rm -rf output_cll
	rm -rf *.dSYM
	if FC_SUBMODULES
	rm -f *.smod
	endif

	## Remove backup files
	maintainer-clean-local: maintainer-clean-fc
	-rm -f *~
	.PHONY: maintainer-clean-local
	Index: trunk/tests/functional_tests/pythia8_2.sh
	===================================================================
	--- trunk/tests/functional_tests/pythia8_2.sh (revision 0)
	+++ trunk/tests/functional_tests/pythia8_2.sh (revision 8190)
	@@ -0,0 +1,20 @@
	+#!/bin/sh
	+### Check WHIZARD for a simple test process
	+echo "Running script $0"
	+if test -f OCAML_FLAG -a -f PYTHIA8_FLAG; then
	+ ./run_whizard.sh @script@ --no-logging
	+ script=`basename @script@`
	+ echo "Contents of ${script}a.debug:" >> $script.log
	+ cat ${script}a.debug >> $script.log
	+ echo "Contents of ${script}b.debug:" >> $script.log
	+ cat ${script}b.debug >> $script.log
	+ echo "Contents of ${script}c.debug:" >> $script.log
	+ cat ${script}c.debug >> $script.log
	+ echo "Contents of ${script}d.debug:" >> $script.log
	+ cat ${script}d.debug >> $script.log
	+ diff ref-output/$script.ref $script.log
	+else
	+ echo "\|=============================================================================\|"
	+ echo "No O'Mega matrix elements available and/or PYTHIA6 disabled, test skipped"
	+ exit 77
	+fi
	Index: trunk/tests/functional_tests/Makefile.am
	===================================================================
	--- trunk/tests/functional_tests/Makefile.am (revision 8189)
	+++ trunk/tests/functional_tests/Makefile.am (revision 8190)
	@@ -1,741 +1,755 @@
	## Makefile.am -- Makefile for executable WHIZARD test scripts
	##
	## Process this file with automake to produce Makefile.in
	##
	########################################################################
	#
	# Copyright (C) 1999-2018 by
	# Wolfgang Kilian <kilian@physik.uni-siegen.de>
	# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
	# Juergen Reuter <juergen.reuter@desy.de>
	# with contributions from
	# cf. main AUTHORS file
	#
	# WHIZARD is free software; you can redistribute it and/or modify it
	# under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 2, or (at your option)
	# any later version.
	#
	# WHIZARD is distributed in the hope that it will be useful, but
	# WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	# GNU General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with this program; if not, write to the Free Software
	# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
	#
	########################################################################

	WHIZARD_DRIVER = run_whizard.sh

	TESTS_DEFAULT = \
	empty.run \
	fatal.run \
	structure_1.run \
	structure_2.run \
	structure_3.run \
	structure_4.run \
	structure_5.run \
	structure_6.run \
	structure_7.run \
	structure_8.run \
	vars.run \
	extpar.run \
	testproc_1.run \
	testproc_2.run \
	testproc_3.run \
	testproc_4.run \
	testproc_5.run \
	testproc_6.run \
	testproc_7.run \
	testproc_8.run \
	testproc_9.run \
	testproc_10.run \
	testproc_11.run \
	testproc_12.run \
	template_me_1.run \
	template_me_2.run \
	model_scheme_1.run \
	rebuild_1.run \
	rebuild_4.run \
	susyhit.run \
	helicity.run \
	libraries_4.run \
	job_id_1.run \
	pack_1.run

	XFAIL_TESTS_DEFAULT =

	TESTS_REQ_FASTJET = \
	analyze_4.run

	TESTS_REQ_OCAML = \
	libraries_1.run \
	libraries_2.run \
	libraries_3.run \
	rebuild_2.run \
	rebuild_3.run \
	rebuild_5.run \
	defaultcuts.run \
	cuts.run \
	model_change_1.run \
	model_change_2.run \
	model_test.run \
	job_id_2.run \
	job_id_3.run \
	job_id_4.run \
	qedtest_1.run \
	qedtest_2.run \
	qedtest_3.run \
	qedtest_4.run \
	qedtest_5.run \
	qedtest_6.run \
	qedtest_7.run \
	qedtest_8.run \
	qedtest_9.run \
	qedtest_10.run \
	beam_setup_1.run \
	beam_setup_2.run \
	beam_setup_3.run \
	beam_setup_4.run \
	beam_setup_5.run \
	qcdtest_1.run \
	qcdtest_2.run \
	qcdtest_3.run \
	qcdtest_4.run \
	qcdtest_5.run \
	qcdtest_6.run \
	observables_1.run \
	observables_2.run \
	event_weights_1.run \
	event_weights_2.run \
	event_eff_1.run \
	event_eff_2.run \
	event_dump_1.run \
	event_dump_2.run \
	reweight_1.run \
	reweight_2.run \
	reweight_3.run \
	reweight_4.run \
	reweight_5.run \
	reweight_6.run \
	reweight_7.run \
	reweight_8.run \
	analyze_1.run \
	analyze_2.run \
	analyze_5.run \
	colors.run \
	colors_2.run \
	colors_hgg.run \
	alphas.run \
	jets_xsec.run \
	lhef_1.run \
	lhef_2.run \
	lhef_3.run \
	lhef_4.run \
	lhef_5.run \
	lhef_6.run \
	lhef_7.run \
	lhef_8.run \
	lhef_9.run \
	lhef_10.run \
	lhef_11.run \
	stdhep_1.run \
	stdhep_2.run \
	stdhep_3.run \
	stdhep_4.run \
	stdhep_5.run \
	stdhep_6.run \
	select_1.run \
	select_2.run \
	fatal_beam_decay.run \
	smtest_1.run \
	smtest_2.run \
	smtest_3.run \
	smtest_4.run \
	smtest_5.run \
	smtest_6.run \
	smtest_7.run \
	smtest_8.run \
	smtest_9.run \
	smtest_10.run \
	smtest_11.run \
	smtest_12.run \
	smtest_13.run \
	smtest_14.run \
	smtest_15.run \
	resonances_1.run \
	resonances_2.run \
	resonances_3.run \
	resonances_4.run \
	resonances_5.run \
	resonances_6.run \
	resonances_7.run \
	resonances_8.run \
	resonances_9.run \
	resonances_10.run \
	resonances_11.run \
	resonances_12.run \
	mssmtest_1.run \
	mssmtest_2.run \
	mssmtest_3.run \
	sm_cms_1.run \
	ufo_1.run \
	ufo_2.run \
	ufo_3.run \
	nlo_1.run \
	nlo_2.run \
	nlo_3.run \
	nlo_4.run \
	nlo_5.run \
	nlo_6.run \
	nlo_decay_1.run \
	real_partition_1.run \
	fks_res_1.run \
	fks_res_2.run \
	fks_res_3.run \
	openloops_1.run \
	openloops_2.run \
	openloops_3.run \
	openloops_4.run \
	openloops_5.run \
	openloops_6.run \
	openloops_7.run \
	openloops_8.run \
	openloops_9.run \
	openloops_10.run \
	recola_1.run \
	recola_2.run \
	recola_3.run \
	recola_4.run \
	recola_5.run \
	recola_6.run \
	recola_7.run \
	recola_8.run \
	powheg_1.run \
	spincor_1.run \
	show_1.run \
	show_2.run \
	show_3.run \
	show_4.run \
	show_5.run \
	method_ovm_1.run \
	multi_comp_1.run \
	multi_comp_2.run \
	multi_comp_3.run \
	multi_comp_4.run \
	flvsum_1.run \
	br_redef_1.run \
	decay_err_1.run \
	decay_err_2.run \
	decay_err_3.run \
	polarized_1.run \
	pdf_builtin.run \
	ep_1.run \
	ep_2.run \
	ep_3.run \
	circe1_1.run \
	circe1_2.run \
	circe1_3.run \
	circe1_4.run \
	circe1_5.run \
	circe1_6.run \
	circe1_7.run \
	circe1_8.run \
	circe1_9.run \
	circe1_10.run \
	circe1_photons_1.run \
	circe1_photons_2.run \
	circe1_photons_3.run \
	circe1_photons_4.run \
	circe1_photons_5.run \
	circe1_errors_1.run \
	circe2_1.run \
	circe2_2.run \
	circe2_3.run \
	ewa_1.run \
	ewa_2.run \
	ewa_3.run \
	ewa_4.run \
	isr_1.run \
	isr_2.run \
	isr_3.run \
	isr_4.run \
	isr_5.run \
	epa_1.run \
	epa_2.run \
	isr_epa_1.run \
	ilc.run \
	gaussian_1.run \
	gaussian_2.run \
	beam_events_1.run \
	beam_events_2.run \
	beam_events_3.run \
	beam_events_4.run \
	energy_scan_1.run \
	restrictions.run \
	process_log.run \
	shower_err_1.run \
	parton_shower_1.run \
	parton_shower_2.run \
	hadronize_1.run \
	mlm_matching_fsr.run \
	user_cuts.run \
	user_prc_threshold_1.run \
	cascades2_phs_1.run \
	user_prc_threshold_2.run

	XFAIL_TESTS_REQ_OCAML = \
	colors_hgg.run \
	hadronize_1.run \
	user_cuts.run

	TESTS_REQ_HEPMC = \
	hepmc_1.run \
	hepmc_2.run \
	hepmc_3.run \
	hepmc_4.run \
	hepmc_5.run \
	hepmc_6.run \
	hepmc_7.run \
	hepmc_8.run \
	hepmc_9.run \
	hepmc_10.run
	XFAIL_TESTS_REQ_HEPMC =

	TESTS_REQ_LCIO = \
	lcio_1.run \
	lcio_2.run \
	lcio_3.run \
	lcio_4.run \
	lcio_5.run
	XFAIL_TESTS_REQ_LCIO =

	TESTS_REQ_LHAPDF5 = \
	lhapdf5.run
	TESTS_REQ_LHAPDF6 = \
	lhapdf6.run
	XFAIL_TESTS_REQ_LHAPDF5 =
	XFAIL_TESTS_REQ_LHAPDF6 =

	TESTS_STATIC = \
	static_1.run \
	static_2.run
	XFAIL_TESTS_STATIC =

	TESTS_REQ_PYTHIA6 = \
	pythia6_1.run \
	pythia6_2.run \
	pythia6_3.run \
	pythia6_4.run \
	tauola_1.run \
	tauola_2.run \
	isr_5.run \
	mlm_pythia6_isr.run \
	mlm_matching_isr.run
	XFAIL_TESTS_REQ_PYTHIA6 =

	+TESTS_REQ_PYTHIA8 =
	+# pythia8_1.run \
	+# pythia8_2.run
	+XFAIL_TESTS_REQ_PYTHIA8 =
	+
	TESTS_REQ_EV_ANA = \
	analyze_3.run
	XFAIL_TESTS_REQ_EV_ANA =

	TESTS_REQ_GAMELAN = \
	analyze_3.run

	TEST_DRIVERS_RUN = \
	$(TESTS_DEFAULT) \
	$(TESTS_REQ_OCAML) \
	$(TESTS_REQ_LHAPDF5) \
	$(TESTS_REQ_LHAPDF6) \
	$(TESTS_REQ_HEPMC) \
	$(TESTS_REQ_LCIO) \
	$(TESTS_REQ_FASTJET) \
	$(TESTS_REQ_PYTHIA6) \
	$(TESTS_REQ_EV_ANA) \
	$(TESTS_STATIC)

	TEST_DRIVERS_SH = $(TEST_DRIVERS_RUN:.run=.sh)

	########################################################################

	TESTS =
	XFAIL_TESTS =
	TESTS_SRC =

	TESTS += $(TESTS_DEFAULT)
	XFAIL_TESTS += $(XFAIL_TESTS_DEFAULT)

	TESTS += $(TESTS_REQ_OCAML)
	XFAIL_TESTS += $(XFAIL_TESTS_REQ_OCAML)

	TESTS += $(TESTS_REQ_HEPMC)
	XFAIL_TESTS += $(XFAIL_TESTS_REQ_HEPMC)

	TESTS += $(TESTS_REQ_LCIO)
	XFAIL_TESTS += $(XFAIL_TESTS_REQ_LCIO)

	TESTS += $(TESTS_REQ_FASTJET)
	XFAIL_TESTS += $(XFAIL_TESTS_REQ_FASTJET)

	TESTS += $(TESTS_REQ_LHAPDF5)
	XFAIL_TESTS += $(XFAIL_TESTS_REQ_LHAPDF5)

	TESTS += $(TESTS_REQ_LHAPDF6)
	XFAIL_TESTS += $(XFAIL_TESTS_REQ_LHAPDF6)

	TESTS += $(TESTS_REQ_PYTHIA6)
	XFAIL_TESTS += $(XFAIL_TESTS_REQ_PYTHIA6)

	+TESTS += $(TESTS_REQ_PYTHIA8)
	+XFAIL_TESTS += $(XFAIL_TESTS_REQ_PYTHIA8)
	+
	TESTS += $(TESTS_REQ_EV_ANA)
	XFAIL_TESTS += $(XFAIL_TESTS_REQ_EV_ANA)

	TESTS += $(TESTS_STATIC)
	XFAIL_TESTS += $(XFAIL_TESTS_STATIC)


	EXTRA_DIST = $(TEST_DRIVERS_SH) \
	$(TESTS_SRC)

	########################################################################

	VPATH = $(srcdir)

	SUFFIXES = .sh .run

	.sh.run:
	@rm -f $@
	@if test -f $(top_builddir)/share/tests/functional_tests/$*.sin; then \
	$(SED) 's\|@script@\|$(top_builddir)/share/tests/functional_tests/$*\|g' $< > $@; \
	elif test -f $(top_srcdir)/share/tests/functional_tests/$*.sin; then \
	$(SED) 's\|@script@\|$(top_srcdir)/share/tests/functional_tests/$*\|g' $< > $@; \
	else \
	echo "$*.sin not found!" 1>&2; \
	exit 2; \
	fi
	@chmod +x $@

	structure_2.run: structure_2_inc.sin
	structure_2_inc.sin: $(top_builddir)/share/tests/functional_tests/structure_2_inc.sin
	cp $< $@

	testproc_3.run: testproc_3.phs
	testproc_3.phs: $(top_builddir)/share/tests/functional_tests/testproc_3.phs
	cp $< $@

	static_1.run: static_1.exe.sin
	static_1.exe.sin: $(top_builddir)/share/tests/functional_tests/static_1.exe.sin
	cp $< $@
	static_2.run: static_2.exe.sin
	static_2.exe.sin: $(top_builddir)/share/tests/functional_tests/static_2.exe.sin
	cp $< $@

	susyhit.run: susyhit.in
	user_cuts.run: user_cuts.f90
	user_cuts.f90: $(top_builddir)/share/tests/functional_tests/user_cuts.f90
	cp $< $@

	model_test.run: tdefs.$(FC_MODULE_EXT) tglue.$(FC_MODULE_EXT) \
	threeshl.$(FC_MODULE_EXT) tscript.$(FC_MODULE_EXT)
	tdefs.mod: $(top_builddir)/src/models/threeshl_bundle/tdefs.$(FC_MODULE_EXT)
	cp $< $@
	tglue.mod: $(top_builddir)/src/models/threeshl_bundle/tglue.$(FC_MODULE_EXT)
	cp $< $@
	tscript.mod: $(top_builddir)/src/models/threeshl_bundle/tscript.$(FC_MODULE_EXT)
	cp $< $@
	threeshl.mod: $(top_builddir)/src/models/threeshl_bundle/threeshl.$(FC_MODULE_EXT)
	cp $< $@

	WT_OCAML_NATIVE_EXT=opt

	if OCAML_AVAILABLE
	OMEGA_QED = $(top_builddir)/omega/bin/omega_QED.$(WT_OCAML_NATIVE_EXT)
	OMEGA_QCD = $(top_builddir)/omega/bin/omega_QCD.$(WT_OCAML_NATIVE_EXT)
	OMEGA_MSSM = $(top_builddir)/omega/bin/omega_MSSM.$(WT_OCAML_NATIVE_EXT)

	omega_MSSM.$(WT_OMEGA_CACHE_SUFFIX): $(OMEGA_MSSM)
	$(OMEGA_MSSM) -initialize .

	UFO_TAG_FILE = __init__.py
	UFO_MODELPATH = ../models/UFO

	ufo_1.run: ufo_1_SM/$(UFO_TAG_FILE)
	ufo_2.run: ufo_2_SM/$(UFO_TAG_FILE)
	ufo_3.run: ufo_3_models/ufo_3_SM/$(UFO_TAG_FILE)

	ufo_1_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
	mkdir -p ufo_1_SM
	cp $(UFO_MODELPATH)/SM/*.py ufo_1_SM
	ufo_2_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
	mkdir -p ufo_2_SM
	cp $(UFO_MODELPATH)/SM/*.py ufo_2_SM
	ufo_3_models/ufo_3_SM/$(UFO_TAG_FILE): $(UFO_MODELPATH)/SM/$(UFO_TAG_FILE)
	mkdir -p ufo_3_models/ufo_3_SM
	cp $(UFO_MODELPATH)/SM/*.py ufo_3_models/ufo_3_SM

	$(UFO_MODELPATH)/SM/$(UFO_TAG_FILE): $(top_srcdir)/omega/tests/UFO/SM/$(UFO_TAG_FILE)
	$(MAKE) -C $(UFO_MODELPATH)/SM all

	endif OCAML_AVAILABLE

	if MPOST_AVAILABLE
	$(TESTS_REQ_GAMELAN): gamelan.sty
	gamelan.sty: $(top_builddir)/src/gamelan/gamelan.sty
	cp $< $@

	$(top_builddir)/src/gamelan/gamelan.sty:
	$(MAKE) -C $(top_builddir)/src/gamelan gamelan.sty
	endif

	noinst_PROGRAMS =

	if OCAML_AVAILABLE
	noinst_PROGRAMS += resonances_1_count
	resonances_1_count_SOURCES = resonances_1_count.f90
	resonances_1.run: resonances_1_count

	noinst_PROGRAMS += resonances_2_count
	resonances_2_count_SOURCES = resonances_2_count.f90
	resonances_2.run: resonances_2_count

	noinst_PROGRAMS += resonances_3_count
	resonances_3_count_SOURCES = resonances_3_count.f90
	resonances_3.run: resonances_3_count

	noinst_PROGRAMS += resonances_4_count
	resonances_4_count_SOURCES = resonances_4_count.f90
	resonances_4.run: resonances_4_count

	noinst_PROGRAMS += resonances_9_count
	resonances_9_count_SOURCES = resonances_9_count.f90
	resonances_9.run: resonances_9_count

	noinst_PROGRAMS += resonances_10_count
	resonances_10_count_SOURCES = resonances_10_count.f90
	resonances_10.run: resonances_10_count

	noinst_PROGRAMS += resonances_11_count
	resonances_11_count_SOURCES = resonances_11_count.f90
	resonances_11.run: resonances_11_count

	noinst_PROGRAMS += epa_2_count
	epa_2_count_SOURCES = epa_2_count.f90
	epa_2.run: epa_2_count

	noinst_PROGRAMS += isr_epa_1_count
	isr_epa_1_count_SOURCES = isr_epa_1_count.f90
	isr_epa_1.run: isr_epa_1_count

	endif

	if HEPMC_AVAILABLE
	TESTS_SRC += $(hepmc_6_rd_SOURCES)
	noinst_PROGRAMS += hepmc_6_rd
	if HEPMC_IS_VERSION3
	hepmc_6_rd_SOURCES = hepmc_6_v3_rd.cpp
	else
	hepmc_6_rd_SOURCES = hepmc_6_v2_rd.cpp
	endif
	hepmc_6_rd_CXXFLAGS = $(HEPMC_INCLUDES) $(AM_CXXFLAGS)
	hepmc_6_rd_LDADD = $(LDFLAGS_HEPMC)
	hepmc_6.run: hepmc_6_rd
	endif

	if LCIO_AVAILABLE
	TESTS_SRC += $(lcio_rd_SOURCES)
	noinst_PROGRAMS += lcio_rd
	lcio_rd_SOURCES = lcio_rd.cpp
	lcio_rd_CXXFLAGS = $(LCIO_INCLUDES) $(AM_CXXFLAGS)
	lcio_rd_LDADD = $(LDFLAGS_LCIO)
	lcio_1.run: lcio_rd
	lcio_2.run: lcio_rd
	lcio_3.run: lcio_rd
	lcio_4.run: lcio_rd
	lcio_5.run: lcio_rd
	endif

	stdhep_4.run: stdhep_rd
	stdhep_5.run: stdhep_rd
	stdhep_6.run: stdhep_rd
	polarized_1.run: stdhep_rd
	tauola_1.run: stdhep_rd
	tauola_2.run: stdhep_rd
	stdhep_rd: $(top_builddir)/src/xdr/stdhep_rd
	cp $< $@

	susyhit.in: $(top_builddir)/share/tests/functional_tests/susyhit.in
	cp $< $@

	BUILT_SOURCES = \
	TESTFLAG \
	HEPMC_FLAG \
	LCIO_FLAG \
	FASTJET_FLAG \
	LHAPDF5_FLAG \
	LHAPDF6_FLAG \
	GAMELAN_FLAG \
	MPI_FLAG \
	EVENT_ANALYSIS_FLAG \
	OCAML_FLAG \
	PYTHIA6_FLAG \
	+ PYTHIA8_FLAG \
	OPENLOOPS_FLAG \
	RECOLA_FLAG \
	GZIP_FLAG \
	STATIC_FLAG \
	ref-output

	# If this file is found in the working directory, WHIZARD
	# will use the paths for the uninstalled version (source/build tree),
	# otherwise it uses the installed version
	TESTFLAG:
	touch $@

	FASTJET_FLAG:
	if FASTJET_AVAILABLE
	touch $@
	endif

	HEPMC_FLAG:
	if HEPMC_AVAILABLE
	touch $@
	endif

	LCIO_FLAG:
	if LCIO_AVAILABLE
	touch $@
	endif

	LHAPDF5_FLAG:
	if LHAPDF5_AVAILABLE
	touch $@
	endif

	LHAPDF6_FLAG:
	if LHAPDF6_AVAILABLE
	touch $@
	endif

	GAMELAN_FLAG:
	if MPOST_AVAILABLE
	touch $@
	endif

	MPI_FLAG:
	if FC_USE_MPI
	touch $@
	endif

	OCAML_FLAG:
	if OCAML_AVAILABLE
	touch $@
	endif

	PYTHIA6_FLAG:
	if PYTHIA6_AVAILABLE
	touch $@
	endif

	+PYTHIA8_FLAG:
	+if PYTHIA8_AVAILABLE
	+ touch $@
	+endif
	+
	OPENLOOPS_FLAG:
	if OPENLOOPS_AVAILABLE
	touch $@
	endif

	RECOLA_FLAG:
	if RECOLA_AVAILABLE
	touch $@
	endif

	EVENT_ANALYSIS_FLAG:
	if EVENT_ANALYSIS_AVAILABLE
	touch $@
	endif

	GZIP_FLAG:
	if GZIP_AVAILABLE
	touch $@
	endif

	STATIC_FLAG:
	if STATIC_AVAILABLE
	touch $@
	endif

	# The reference output files are in the source directory. Copy them here.
	if FC_QUAD
	ref-output: $(top_srcdir)/share/tests/functional_tests/ref-output
	mkdir -p ref-output
	for f in $</*.ref; do cp $$f $@; done
	for f in $</../ref-output-prec/*.ref; do cp $$f $@; done
	for f in $</../ref-output-quad/*.ref; do cp $$f $@; done
	else
	if FC_EXT
	ref-output: $(top_srcdir)/share/tests/functional_tests/ref-output
	mkdir -p ref-output
	for f in $</*.ref; do cp $$f $@; done
	for f in $</../ref-output-prec/*.ref; do cp $$f $@; done
	for f in $</../ref-output-ext/*.ref; do cp $$f $@; done
	else
	ref-output: $(top_srcdir)/share/tests/functional_tests/ref-output
	mkdir -p ref-output
	for f in $</*.ref; do cp $$f $@; done
	for f in $</../ref-output-double/*.ref; do cp $$f $@; done
	endif
	endif

	## installcheck runs the test scripts with the TESTFLAG removed.
	installcheck-local: notestflag check-am
	notestflag:
	rm -f TESTFLAG
	.PHONY: notestflag

	### Remove DWARF debug information on MAC OS X
	clean-macosx:
	-rm -rf hepmc_6_rd.dSYM
	-rm -rf lcio_rd.dSYM
	-rm -rf static_1.exe.dSYM
	-rm -rf static_2.exe.dSYM
	.PHONY: clean-macosx

	## Remove generated files
	clean-local: clean-macosx
	rm -f gamelan.sty
	rm -f TESTFLAG GAMELAN_FLAG MPI_FLAG RECOLA_FLAG
	rm -f OCAML_FLAG OPENLOOPS_FLAG FASTJET_FLAG HEPMC_FLAG LCIO_FLAG
	rm -f EVENT_ANALYSIS_FLAG PYTHIA6_FLAG LHAPDF5_FLAG
	rm -f LHAPDF6_FLAG
	rm -f GZIP_FLAG STATIC_FLAG static_1.exe static_2.exe
	rm -f .run .log slha_test.out
	rm -f core* stdhep_rd
	rm -f .f90 .f90.in .c .$(FC_MODULE_EXT) .o .la
	rm -f *_count.out
	rm -f *.makefile
	rm -f *.grid
	rm -rf err-output
	rm -rf ref-output
	rm -f .sin .hbc *_fks_regions.out
	rm -f .olc .olp *.olp_parameters output.rcl
	rm -f .phs .vg .vg2 .pg .vgb .evt .evx .lhe .hepmc .dat .debug .fds
	rm -f .tmp .hepevt .hepevt.verb .lha .lha.verb .slcio
	rm -f prc_omega_diags_1_p_i1_diags.out prc_omega_diags_1_p_i1_diags.toc
	rm -rf pack_1.1 pack_1.2 pack_1.3 pack_1.4
	rm -rf pack_1.1.tgz pack_1.2.tgz pack_1.3.tgz pack_1.4.tgz
	rm -f .hep .up.hep .[1-9] .[1-9][0-9] *.[1-9][0-9][0-9]
	rm -f .tex .mp .mpx .t[1-9] .t[1-9][0-9] .t[1-9][0-9][0-9]
	rm -f .ltp .aux .dvi .ps .pdf so_test.
	rm -f *.tbl sps1ap_decays.slha bar structure_6[a-b].out
	rm -f slhaspectrum.in suspect2.out suspect2_lha.out
	rm -f susyhit.in susyhit_slha.out suspect2_lha.in
	rm -rf job_id_3_x.8001 job_id_4_x.8001
	rm -rf ufo_1_SM ufo_2_SM ufo_3_models
	rm -f ufo_1_SM.ufo.mdl ufo_2_SM.ufo.mdl ufo_3_SM.ufo.mdl
	rm -f *.$(WT_OMEGA_CACHE_SUFFIX)
	rm -rf output_cll
	rm -rf *.dSYM
	if FC_SUBMODULES
	rm -f *.smod
	endif

	## Remove backup files
	maintainer-clean-local: maintainer-clean-fc
	-rm -f *~
	.PHONY: maintainer-clean-local
	Index: trunk/tests/functional_tests/pythia8_1.sh
	===================================================================
	--- trunk/tests/functional_tests/pythia8_1.sh (revision 0)
	+++ trunk/tests/functional_tests/pythia8_1.sh (revision 8190)
	@@ -0,0 +1,16 @@
	+#!/bin/sh
	+### Check WHIZARD for a simple test process
	+echo "Running script $0"
	+if test -f OCAML_FLAG -a -f PYTHIA8_FLAG; then
	+ ./run_whizard.sh @script@ --no-logging
	+ script=`basename @script@`
	+ echo "Contents of ${script}a.debug:" >> $script.log
	+ cat ${script}a.debug >> $script.log
	+ echo "Contents of ${script}b.debug:" >> $script.log
	+ cat ${script}b.debug >> $script.log
	+ diff ref-output/$script.ref $script.log
	+else
	+ echo "\|=============================================================================\|"
	+ echo "No O'Mega matrix elements available and/or PYTHIA8 disabled, test skipped"
	+ exit 77
	+fi
	Index: trunk/INSTALL
	===================================================================
	--- trunk/INSTALL (revision 8189)
	+++ trunk/INSTALL (revision 8190)
	@@ -1,372 +1,371 @@
	#-------------------------------------------------------------
	# Installing WHIZARD
	#-------------------------------------------------------------

	Although it is possible to build the WHIZARD libraries from this directory,
	we recommend that you create a separate build directory and work from there.

	#-------------------------------------------------------------
	# Installing from a source code tar ball
	#-------------------------------------------------------------

	WHIZARD is Free Software and the sources can be obtained from
	the HepForge repository:

	http://projects.hepforge.org/whizard

	The command

	gzip -cd whizard-2.X.X.tgz \| tar xf -

	will unpack the sources in a subdirectory whizard-2.X.X,
	where X.X is the current version (and sub-version) number.

	Prerequisites are:

	- Make
	- Objective Caml compiler (version 3.12 or higher)
	- Fortran 2003/2008 compiler
	- C/C++ (for PYTHIA8/FastJet/HepMC/LHAPDF/LCIO interfaces)

	The Objective Caml (OCaml) compiler is available from
	http://pauillac.inria.fr/ocaml/

	#-------------------------------------------------------------
	# Specific problems with some FORTRAN compilers
	#-------------------------------------------------------------

	Note for NAG users: For several versions of NAG, the standard debugging
	flag -g is referencing for historical reasons to the upsf90
	debugger which is no longer supported. If you want to use debugging
	information set the -g90 flag referring to the dbx90 or gdb
	debuggers.

	#-------------------------------------------------------------
	# External libraries and programs
	#-------------------------------------------------------------

	The following external libraries and programs can be linked to
	WHIZARD:

	-- PYTHIA8 for hadronization and showering. It is available
	from http://home.thep.lu.se/~torbjorn/Pythia.html
	- [not yet functional]

	-- LHAPDF for proton, pion and photon structure functions.
	You can get it from: http://projects.hepforge.org/lhapdf

	-- HOPPET for perturbative evolution and matching of PDFs.
	You can get it from: http://projects.hepforge.org/hoppet

	-- FastJet for jet clustering.
	You can get it from: http://fastjet.fr/

	-- GoSAM/Ninja/FORM/Qgraf for NLO matrix elements.
	You can get GoSAM/Ninja from: http://gosam.hepforge.org/
	You can get Qgraf from: http://cfif.ist.utl.pt/~paulo/qgraf.html
	You can get FORM from: http://www.nikhef.nl/~form/

	-- OpenLoops for NLO matrix elements.
	Available from: http://openloops.hepforge.org/

	-- Recola for NLO matrix elements.
	Available from: http://recola.hepforge.org/

	-- LoopTools for one-loop functions (for the top threshold)
	You can get it from: http://www.feynarts.de/looptools/

	-- HepMC for the corresponding event file standard.
	Available from: http://lcgapp.cern.ch/project/simu/HepMC

	-- LCIO for the corresponding file standard.
	Available from: http://lcio.desy.de/

	-- Other external programs like PYTHIA and HERWIG for parton
	showering and hadronization can be included in a standard
	way by passing LHEF or HepMC event files to them.

	-- ROOT and DELPHES can be interfaced via event file and
	ASCII histogram file output

	-- An interface to SARAH exists and is included in the
	SARAH program: https://sarah.hepforge.org/

	-- An interface to FeynRules exists and is included in the
	FeynRules program: http://feynrules.irmp.ucl.ac.be

	-- Parallelisation with MPI requires a at least MPI-3 capable MPI library.
	You can get OpenMPI from https://www.open-mpi.org/.

	#-------------------------------------------------------------
	# platform specific issues
	#-------------------------------------------------------------

	MAC OS X:

	WHIZARD has been tested and partially developed under MAC OS X
	Darwin 9.6.X-9.8.X (Leopard) and Darwin 10.0.X-10.6.X (Snow
	Leopard), Darwin 10.7.X (Lion), Darwin 10.8.X (Mountain Lion),
	Darwin 10.9.X (Maverick), Darwin 10.10.X (Yosemite), Darwin
	10.11.X (El Capitan) as well as Darwin 10.12.X (Sierra) and
	10.13.X (High Sierra). The single pass linker here forces to
	explicitly include static C++ libraries when externally linking
	PYTHIA8, HepMC, FastJet, LHAPDF or LCIO. The necessary flags
	are automatically taken care of by the configure script.

	Darwin >= 10.11: The security measures of the new
	Darwin systems do not allow e.g. environment variables passed
	to subprocesses. This does not change anything for the installed
	WHIZARD, but the testsuite (make check) will not work probably even
	after make install has been executed. make distcheck will not work on
	Darwin >= 10.11. There is also the option to disable the System Integrity
	Protocol (SIP) of El Capitan by booting in Recovery Mode (use Command R
	while booting), open a terminal and type 'csrutil disable'. However, we
	do not recommend to do so unless you know exactly what you are doing.

	#-------------------------------------------------------------
	# installing from a source code tar ball
	#-------------------------------------------------------------

	Unwind the source code tar ball in some relevant directory.
	Autoconf and automake will already have been run.
	Determine where the files will be installed.
	We recommend that you create a separate build directory that is NOT in
	the source code directory tree.

	cd <build_directory>
	<source_code_directory>/configure --prefix=<install_dir>
	(Note that files will be installed under /usr/local if you do not
	specify a prefix.)
	make
	(Build temporary copies of libraries and executables.)
	make check [optional]
	(Perform sanity checks and standard tests)
	make install
	(Copy libraries, headers, executables, etc. to relevant
	subdirectories under <install_dir>.)

	#-------------------------------------------------------------
	# configure options
	#-------------------------------------------------------------

	A variety of options can be given to configure. Below is a list
	of the options that you are likely to find most useful.
	Defaults for the options are specified in brackets.

	Configuration:
	-h, --help display this help and exit
	--help=short display options specific to this package
	--help=recursive display the short help of all the included packages
	-V, --version display version information and exit
	-q, --quiet, --silent do not print `checking...' messages
	--cache-file=FILE cache test results in FILE [disabled]
	-C, --config-cache alias for `--cache-file=config.cache'
	-n, --no-create do not create output files
	--srcdir=DIR find the sources in DIR [configure dir or `..']

	Installation directories:
	--prefix=PREFIX install architecture-independent files in PREFIX
	[/usr/local]
	--exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
	[PREFIX]

	By default, `make install' will install all the files in
	`/usr/local/bin', `/usr/local/lib' etc. You can specify
	an installation prefix other than `/usr/local' using `--prefix',
	for instance `--prefix=$HOME'.

	For better control, use the options below.

	Fine tuning of the installation directories:
	--bindir=DIR user executables [EPREFIX/bin]
	--sbindir=DIR system admin executables [EPREFIX/sbin]
	--libexecdir=DIR program executables [EPREFIX/libexec]
	--sysconfdir=DIR read-only single-machine data [PREFIX/etc]
	--sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
	--localstatedir=DIR modifiable single-machine data [PREFIX/var]
	--libdir=DIR object code libraries [EPREFIX/lib]
	--includedir=DIR C header files [PREFIX/include]
	--oldincludedir=DIR C header files for non-gcc [/usr/include]
	--datarootdir=DIR read-only arch.-independent data root [PREFIX/share]
	--datadir=DIR read-only architecture-independent data [DATAROOTDIR]
	--infodir=DIR info documentation [DATAROOTDIR/info]
	--localedir=DIR locale-dependent data [DATAROOTDIR/locale]
	--mandir=DIR man documentation [DATAROOTDIR/man]
	--docdir=DIR documentation root [DATAROOTDIR/doc/whizard]
	--htmldir=DIR html documentation [DOCDIR]
	--dvidir=DIR dvi documentation [DOCDIR]
	--pdfdir=DIR pdf documentation [DOCDIR]
	--psdir=DIR ps documentation [DOCDIR]

	Program names:
	--program-prefix=PREFIX prepend PREFIX to installed program names
	--program-suffix=SUFFIX append SUFFIX to installed program names
	--program-transform-name=PROGRAM run sed PROGRAM on installed program names

	System types:
	--build=BUILD configure for building on BUILD [guessed]
	--host=HOST cross-compile to build programs to run on HOST [BUILD]

	Optional Features:
	--disable-option-checking ignore unrecognized --enable/--with options
	--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
	--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
	--enable-silent-rules less verbose build output (undo: "make V=1")
	--disable-silent-rules verbose build output (undo: "make V=0")
	--enable-shared[=PKGS] build shared libraries [default=yes]
	--enable-static[=PKGS] build static libraries [default=yes]
	--enable-fast-install[=PKGS]
	optimize for fast installation [default=yes]
	--enable-dependency-tracking
	do not reject slow dependency extractors
	--disable-dependency-tracking
	speeds up one-time build
	--disable-libtool-lock avoid locking (might break parallel builds)
	--enable-distribution build the distribution incl. all docu (developers
	only) [[no]]
	--enable-dl enable libdl for creating/loading process libraries
	on-the-fly [[yes]]
	--disable-noweb disable the noweb programs, even if available [[no]]
	--disable-noweb-force force to disable the noweb programs, even if
	available, which is for distribution testing
	purposes only. The default never has any effect.
	[[no]]
	--enable-fc-openmp use OpenMP for the Fortran code [[no]]
	--enable-fc-profiling use profiling for the Fortran code [[no]]
	--enable-fc-impure compile Omega libraries impure [[no]]
	--enable-fc-mpi use OpenMPI/MPICH for the Fortran code [[no]]
	--disable-ocaml disable the OCaml parts, even if OCaml available
	[[no]]
	--enable-default-UFO-dir=directory
	Read precomputed model tables from this directory,
	which will be populated by an administrator at
	install time [default=$datadir/UFO, enabled].
	--enable-lhapdf enable LHAPDF for structure functions [[yes]]
	--enable-hepmc enable HepMC for handling event data [[yes]]
	--enable-lcio enable LCIO for binary event files [[yes]]
	--enable-pythia6 enable internal PYTHIA6 for hadronization [[yes]]
	--enable-pythia8 enable PYTHIA8 for shower and hadronization [[no]]
	--enable-hoppet enable HOPPET for b quark pdf matching [[no]]
	--enable-fastjet enable FastJet for handling event data [[no]]
	--enable-gosam (experimental) enable GoSAM for external NLO matrix elements
	[[no]]
	--enable-openloops (experimental) enable OpenLoops for NLO matrix elements
	[[no]]
	--enable-recola (experimental) enable Recola for NLO matrix elements
	[[no]]
	--enable-looptools enable LoopTools loop integral library [[no]]
	--enable-optimization-for-parameter-files
	enable (useless) optimization for parameter file
	[[no]]

	Optional Packages:
	--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
	--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
	--with-pic try to use only PIC/non-PIC objects [default=use
	both]
	--with-aix-soname=aix\|svr4\|both
	shared library versioning (aka "SONAME") variant to
	provide on AIX, [default=aix].
	--with-gnu-ld assume the C compiler uses GNU ld [default=no]
	--with-sysroot=DIR Search for dependent libraries within DIR
	(or the compiler's sysroot if not specified).
	--with-precision=single\|double\|quadruple\|extended\|real32\|real64\|real128
	request a floating point precision other than
	double precision. Note that only single and
	double are guaranteed to be provided by all
	Fortran compilers.
	--with-mpi-lib=mpich\|openmpi request an external MPI library.
	--with-pythia8=dir assume the given directory for PYTHIA8
	--with-fastjet=dir assume the given directory for FastJet
	--with-gosam=dir assume the given directory for GoSam
	--with-golem=dir assume the given directory for Golem
	--with-form=dir assume the given directory for Form
	--with-qgraf=dir assume the given directory for QGRAF
	--with-ninja=dir assume the given directory for Ninja
	--with-samurai=dir assume the given directory for Samurai
	--with-openloops=dir assume the given directory for OpenLoops
	--with-recola=dir assume the given directory for Recola

	Some influential environment variables:
	CC C compiler command
	CFLAGS C compiler flags
	LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
	nonstandard directory <lib dir>
	LIBS libraries to pass to the linker, e.g. -l<library>
	CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I<include dir> if
	you have headers in a nonstandard directory <include dir>
	LT_SYS_LIBRARY_PATH
	User-defined run-time library search path.
	CPP C preprocessor
	FC Fortran compiler command
	FCFLAGS Fortran compiler flags
	F77 Fortran 77 compiler command
	FFLAGS Fortran 77 compiler flags
	CXX C++ compiler command
	CXXFLAGS C++ compiler flags
	CXXCPP C++ preprocessor

	#-------------------------------------------------------------
	# building from svn (developper version)
	#-------------------------------------------------------------

	You will need current versions of automake and autoconf. On some machines,
	you will need to build them. See building autotools below. Furthermore,
	you need to have noweb to be installed for the developer version from the
	svn repository. To build the documentations, LaTeX, MetaPost and OcamlWeb
	are also necessary tools. Although the first two are quite standard, you
	can get them from http://www.tug.org/texlive/. Follow the instructions there.
	OcamlWeb is available from http://www.lri.fr/~filliatr/ocamlweb/.

	The check out can be done in that way:

	svn co http://whizard.hepforge.org/svn/trunk <checkout_dir>

	cd <checkout_dir>
	./build_master.sh
	autoreconf

	Now continue with directions as if you unpacked a source code tarball.

	#-------------------------------------------------------------
	# building autotools
	#-------------------------------------------------------------

	If you do not have at least autoconf 2.65 and automake 1.10, you will
	need to build autoconf and automake. On some platforms, you may also
	need to build m4 and texinfo.

	Download the relevant tarballs from gnu.org
	(http://www.gnu.org/software/autoconf/, http://www.gnu.org/software/automake/).
	Untar them in a common source code tree.
	Decide whether you want to install them in /usr/local or your own
	install directory. If you use your own install directory, use

	--prefix=<install_dir>

	with configure.

	For each autotool package:

	<source_code_dir>/configure [--prefix=<install_dir>]
	make
	make install

	Make sure that <install_dir>/bin is before /usr/bin in your path.

	#-------------------------------------------------------------
	# getting and installing noweb
	#-------------------------------------------------------------

	Noweb can be accessed from here:

	http://www.cs.tufts.edu/~nr/noweb/

	Untar the source code. Go to the src/ subdirectory of the unpacked noweb
	source code. Follow the instructions from the INSTALL file. You have to
	specify binary, install and TeX paths explicitly, unfortunately. After a
	make install
	you probably have to copy the binaries into a directory which is in your
	executable path.

	#-------------------------------------------------------------
	Index: trunk/.gitlab-ci.yml
	===================================================================
	--- trunk/.gitlab-ci.yml (revision 8189)
	+++ trunk/.gitlab-ci.yml (revision 8190)
	@@ -1,525 +1,525 @@
	stages:
	- build
	- deploy
	- daily
	- weekly
	- weekly-applications
	- weekly-report

	variables:
	NAGFOR_OPTIONS: "-w=all -gline -C=all -nan -f2008"
	GFORTRAN_OPTIONS: "-fbacktrace -fcheck=array-temps,bounds,do,mem,pointer"
	JOBS: "-j2"

	.default_template: &default_definition
	stage: build
	before_script:
	- ./build_master.sh
	- autoreconf
	- mkdir build \|\| true
	- cd build
	except:
	- production
	- schedules
	- /^.xfail.$/
	artifacts:
	expire_in: 3 weeks
	when: always
	paths:
	- build/configure.log
	- build/make.log
	- build/make-install.log
	- build/circe2/tests/test-suite.log
	- build/omega/tests/test-suite.log
	- build/vamp/tests/test-suite.log
	- build/tests/unit_tests/test-suite.log
	- build/tests/unit_tests/err-output/*
	- build/tests/functional_tests/test-suite.log

	.docker_template: &docker_definition
	variables:
	GIT_SSL_NO_VERIFY: "1"
	tags:
	- docker

	# SMALL TEST SUITE (BRANCHES)

	-gfortran-5.4.0-fully:
	+gfortran-5.5.0-fully:
	<<: *default_definition
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-tools
	script:
	- export LD_LIBRARY_PATH=/home/whizard/OpenLoops/lib:$LD_LIBRARY_PATH
	- - ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" --enable-hoppet --enable-fastjet --enable-openloops > configure.log
	+ - ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" --enable-hoppet --enable-fastjet --enable-openloops --enable-pythia8 > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	<<: *docker_definition

	nagfor-6:
	<<: *default_definition
	script:
	- ../configure FC=nagfor FCFLAGS="$NAGFOR_OPTIONS" F77=nagfor --disable-static --prefix="`pwd`/install" --enable-distribution > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	tags:
	- nagfor
	- latex

	ifort-17:
	<<: *default_definition
	script:
	- source /opt/intel/2017/bin/compilervars.sh intel64
	- ../configure FC=ifort2017 FCFLAGS="-O1" F77=ifort2017 --disable-static --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	tags:
	- ifort

	# BIG TEST SUITE (MASTER + TESTING BRANCHES)

	.extra_template: &extra_definition
	<<: *default_definition
	only:
	- master
	- /^testing.*$/

	.distcheck_template: &distcheck_script
	script:
	- ../configure FC=gfortran FCFLAGS="-O2 $GFORTRAN_OPTIONS" F77=gfortran --enable-distribution --enable-static --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 DISTCHECK_CONFIGURE_FLAGS='FC=gfortran F77=gfortran --enable-distribution --disable-noweb-force' distcheck > make-distcheck.log

	.distcheck_template: &distcheck_definition
	<<: *default_definition
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-4.9.4
	<<: *distcheck_script
	<<: *docker_definition
	only:
	- master
	- /^testing.*$/
	artifacts:
	expire_in: 3 weeks
	when: always
	paths:
	- build/configure.log
	- build/make.log
	- build/make-install.log
	- build/circe2/tests/test-suite.log
	- build/omega/tests/test-suite.log
	- build/vamp/tests/test-suite.log
	- build/tests/unit_tests/test-suite.log
	- build/tests/unit_tests/err-output/*
	- build/tests/functional_tests/test-suite.log
	- "build/whizard*.tar.gz"
	- build/make-distcheck.log
	after_script:
	- find . -type f -exec chmod 644 {} +
	- find . -type d -exec chmod 755 {} +
	- rm whizard*/ -rf

	distcheck.static.gfortran-4.9.4:
	<<: *distcheck_definition

	gfortran-4.9.4:
	<<: *extra_definition
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-4.9.4
	script:
	- ../configure FC=gfortran FCFLAGS="-O2 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	<<: *docker_definition

	gfortran-4.8.5:
	<<: *extra_definition
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-4.8.5
	script:
	- ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	<<: *docker_definition

	gfortran-6.4.0:
	<<: *extra_definition
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-6.4.0
	script:
	- ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	<<: *docker_definition

	gfortran-7.3.0:
	<<: *extra_definition
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-7.3.0
	script:
	- ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	<<: *docker_definition

	gfortran-8.2.0:
	<<: *extra_definition
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-8.2.0
	script:
	- ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	<<: *docker_definition


	osx.gfortran:
	<<: *extra_definition
	script:
	- ../configure FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --prefix="`pwd`/install" --enable-distribution --enable-hepmc --enable-lcio --enable-lhapdf --enable-hoppet --enable-fastjet --enable-looptools LOOPTOOLS_DIR=/usr/local/lib --enable-gosam --enable-openloops --enable-recola --enable-pythia8 > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	tags:
	- osx

	disabled.static.nagfor-6:
	<<: *extra_definition
	script:
	- ../configure --disable-lhapdf --disable-hepmc --disable-lcio --disable-pythia8 --disable-fastjet --disable-hoppet --disable-gosam --disable-openloops --disable-looptools --disable-pythia6 --enable-distribution FC=nagfor FCFLAGS="$NAGFOR_OPTIONS" F77=nagfor --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	tags:
	- nagfor
	- latex

	extended.gfortran-5.4.0-fully:
	<<: *extra_definition
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-tools
	script:
	- export LD_LIBRARY_PATH=/home/whizard/OpenLoops/lib:$LD_LIBRARY_PATH
	- - ../configure --with-precision=extended FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" --enable-hoppet --enable-fastjet --enable-openloops > configure.log
	+ - ../configure --with-precision=extended FC=gfortran FCFLAGS="-O0 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" --enable-hoppet --enable-fastjet --enable-openloops --enable-pythia8 > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	<<: *docker_definition

	openmp.gfortran-5.5.0:
	<<: *extra_definition
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-5.5.0
	script:
	- ../configure --enable-fc-openmp FC=gfortran FCFLAGS="-O1 $GFORTRAN_OPTIONS" F77=gfortran --disable-static --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	<<: *docker_definition

	mpi.gfortran-5.5.0:
	<<: *extra_definition
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-5.5.0-openmpi-2.1.1
	script:
	- ../configure --enable-fc-mpi FC=mpifort FCFLAGS="-O1 $GFORTRAN_OPTIONS" F77=mpifort --disable-static --prefix="`pwd`/install" > configure.log
	- sed -i.bak 's/mpirun="mpirun -np 1"/mpirun="mpirun -np 1 --allow-run-as-root"/' tests/functional_tests/run_whizard.sh
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	<<: *docker_definition

	parallel.gfortran-5.5.0:
	<<: *extra_definition
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-5.5.0-openmpi-2.1.1
	script:
	- ../configure --enable-fc-openmp --enable-fc-mpi FC=mpifort FCFLAGS="-O1 $GFORTRAN_OPTIONS" F77=mpifort --disable-static --prefix="`pwd`/install" > configure.log
	- sed -i.bak 's/mpirun="mpirun -np 1"/mpirun="mpirun -np 1 --allow-run-as-root"/' tests/functional_tests/run_whizard.sh
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	<<: *docker_definition


	quadruple.ifort-17:
	<<: *extra_definition
	script:
	- source /opt/intel/2017/bin/compilervars.sh intel64
	- ../configure --with-precision=quadruple FC=ifort2017 FCFLAGS="-O1" F77=ifort2017 --disable-static --prefix="`pwd`/install" --enable-fastjet --enable-openloops > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	tags:
	- ifort

	ifort-18:
	<<: *extra_definition
	script:
	- source /opt/intel/2018/bin/compilervars.sh intel64
	- ../configure FC=ifort2018 F77=ifort2018 --disable-static --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	tags:
	- ifort

	# DEPLOY (MASTER)

	.deploy_template: &deploy_definition
	stage: deploy
	tags:
	- deployment
	only:
	- master
	before_script:
	- eval `ssh-agent -s`
	- ssh-add /scratch/vrothe/id_rsa /scratch/vrothe/id_rsa_runner_wgs
	except:
	- production
	- schedules
	- /^.xfail.$/

	notify slack:
	<<: *deploy_definition
	when: on_failure
	script:
	- echo "Build on \`$CI_BUILD_REF_NAME\` failed! Commit \`$(git log -1 --oneline)\` See pipeline of https://gitlab.tp.nt.uni-siegen.de/whizard/development/commit/$CI_BUILD_REF" \| slacktee.sh -a "danger" -p --config /scratch/vrothe/gitlab/.slacktee

	deploy to production:
	<<: *deploy_definition
	environment: production
	script:
	- export GIT_SSH=/scratch/vrothe/gitlab/ssh.sh
	- git remote set-url --push origin git@gitlab.tp.nt.uni-siegen.de:whizard/development.git
	- git checkout production
	- git merge master --ff-only
	- git push

	deploy to svn:
	<<: *deploy_definition
	environment: svn
	script:
	- svn co --config-dir /scratch/vrothe/gitlab/.subversion/ --config-option="config:tunnels:ssh=ssh -o UserKnownHostsFile=/scratch/vrothe/gitlab/known_hosts" svn+ssh://vcs@phab.hepforge.org/source/whizardsvn/trunk trunk
	- cp .git trunk/ -r
	- cd trunk
	- git status
	- git checkout -- .
	- git clean -d -f
	- svn diff --config-dir /scratch/vrothe/gitlab/.subversion/ > ../svndiff.log \|\| true
	- svn status --config-dir /scratch/vrothe/gitlab/.subversion/ \| grep "^?" \| grep -v '.git$' \| awk '{print $2}' >\| ../svn-add-files.log \|\| true
	- svn status --config-dir /scratch/vrothe/gitlab/.subversion/ \| grep "^\!" \| grep -v '.git$' \| awk '{print $2}' >\| ../svn-del-files.log \|\| true
	- if test -s ../svn-add-files.log ; then cat ../svn-add-files.log \| xargs svn add --config-dir /scratch/vrothe/gitlab/.subversion/ ; fi
	- if test -s ../svn-del-files.log ; then cat ../svn-del-files.log \| xargs svn rm --config-dir /scratch/vrothe/gitlab/.subversion/ ; fi
	- git log --format="%h %s" -n 1 HEAD > svn-commit.msg
	- svn commit --config-dir /scratch/vrothe/gitlab/.subversion/ --config-option="config:tunnels:ssh=ssh -o UserKnownHostsFile=/scratch/vrothe/gitlab/known_hosts" --file=svn-commit.msg
	artifacts:
	paths:
	- svndiff.log
	- svn-add-files.log
	- svn-del-files.log

	# NIGHTLY BUILD (DAILY)
	build whizard tarball:
	stage: daily
	environment: nightly
	only:
	refs:
	- schedules
	variables:
	- $type == "nightly"
	before_script:
	- ./build_master.sh
	- autoreconf
	- mkdir build \|\| true
	- cd build
	script:
	- ../configure --enable-distribution FC=nagfor FCFLAGS="$NAGFOR_OPTIONS" F77=nagfor > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 dist > make-dist.log
	- mv "$(ls whizard-.tar.gz)" "$(basename $(ls whizard-.tar.gz) .tar.gz)-$(date -Idate)-$(git rev-parse --short HEAD).tar.gz"
	- ssh whizard@beryllium 'cd tarballs && (for f in $(ls -t1 *.tar.gz \| tail -n +5); do rm -f "${f}"; done)'
	- rsync whizard*.tar.gz whizard@beryllium:~/tarballs
	- ssh whizard@beryllium 'cd tarballs && ln -sf $(ls -t1 *.tar.gz \| head -n 2 \| tail -n 1) whizard-nightly-latest.tar.gz'
	artifacts:
	expire_in: 3 weeks
	when: always
	paths:
	- configure.log
	- make.log
	- make-dist.log
	tags:
	- jenkins2
	- nagfor
	- latex

	# WHIZARD IMAGE (WEEKLY)
	build whizard image:
	stage: weekly
	script:
	- git clone https://${GITLAB_USER}:${GITLAB_PASSWORD}@gitlab.tp.nt.uni-siegen.de/whizard/docker.git
	- docker build -t gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-master -f docker/whizard-master/Dockerfile .
	- docker login -u ${GITLAB_USER} -p ${GITLAB_PASSWORD} gitlab.tp.nt.uni-siegen.de:4567
	- docker push gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-master
	- docker login -u ${DOCKER_USER} -p ${DOCKER_PASSWORD}
	- docker tag gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-master whizard/whizard-weekly:master
	- docker push whizard/whizard-weekly:master
	tags:
	- whizard
	only:
	refs:
	- schedules
	variables:
	- $type == "weekly"

	# GCC TRUNK IMAGE (WEEKLY)

	build gcc-trunk image:
	stage: weekly
	script:
	- git clone https://${GITLAB_USER}:${GITLAB_PASSWORD}@gitlab.tp.nt.uni-siegen.de/whizard/docker.git
	- cd docker/whizard-gcc-trunk
	- wget http://mirrors.ctan.org/install/fonts/doublestroke.tds.zip
	- docker build --no-cache=true -t gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-trunk .
	- docker login -u ${GITLAB_USER} -p ${GITLAB_PASSWORD} gitlab.tp.nt.uni-siegen.de:4567
	- docker push gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-trunk
	tags:
	- whizard
	only:
	refs:
	- schedules
	variables:
	- $type == "weekly"

	# SUBPACKAGES (WEEKLY)

	.subpackage_template: &subpackage_definition
	<<: *distcheck_definition
	stage: weekly
	only:
	refs:
	- schedules
	variables:
	- $type == "weekly"
	except:

	circe1.distcheck.static.gfortran-4.9.4:
	<<: *subpackage_definition
	before_script:
	- ./build_master.sh CIRCE1
	- autoreconf
	- mkdir -p build
	- cd build

	circe2.distcheck.static.gfortran-4.9.4:
	<<: *subpackage_definition
	before_script:
	- ./build_master.sh CIRCE2
	- autoreconf
	- mkdir -p build
	- cd build

	vamp.distcheck.static.gfortran-4.9.4:
	<<: *subpackage_definition
	before_script:
	- ./build_master.sh VAMP
	- autoreconf
	- mkdir -p build
	- cd build

	omega.distcheck.static.gfortran-4.9.4:
	<<: *subpackage_definition
	before_script:
	- ./build_master.sh OMEGA
	- autoreconf
	- mkdir -p build
	- cd build
	script:
	- ../configure FC=gfortran FCFLAGS="-O2 $GFORTRAN_OPTIONS" F77=gfortran --enable-distribution --enable-static --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	- make $JOBS -s V=0 extra-distcheck > make-distcheck.log

	whizard.distcheck.static.gfortran-4.9.4:
	<<: *subpackage_definition
	before_script:
	- ./build_master.sh
	- autoreconf
	- mkdir -p build
	- cd build
	script:
	- ../configure FC=gfortran FCFLAGS="-O2 $GFORTRAN_OPTIONS" F77=gfortran --enable-distribution --enable-static --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check
	- make $JOBS -s V=0 extra-distcheck > make-distcheck.log



	# EXAMPLES (WEEKLY)

	.examples_template: &examples_definition
	stage: weekly-applications
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-master
	only:
	refs:
	- schedules
	variables:
	- $type == "weekly"
	before_script:
	- source /home/whizard/GoSam/local/bin/gosam_setup_env.sh
	- cd ~/whizard/share/examples
	<<: *docker_definition

	run matching examples:
	<<: *examples_definition
	script:
	- for s in Matching.sin ; do whizard $s; done

	run NLO examples:
	<<: *examples_definition
	script:
	- for s in NLOOpenLoops.sin ; do whizard $s; done
	# - for s in NLOGoSam.sin ; do whizard $s; done

	run collider examples:
	<<: *examples_definition
	script:
	- for s in HERA_DIS.sin LEP_cc10.sin LEP_higgs.sin W-endpoint.sin Z-lineshape.sin ; do whizard $s; done

	run other examples:
	<<: *examples_definition
	script:
	- for s in Zprime.sin casc_dec.sin circe1.sin eeww_polarized.sin fourjetsLO.sin ; do whizard $s; done

	build whizard with gcc-trunk:
	<<: *default_definition
	<<: *docker_definition
	stage: weekly-applications
	image: gitlab.tp.nt.uni-siegen.de:4567/whizard/development:whizard-gcc-trunk
	only:
	refs:
	- schedules
	variables:
	- $type == "weekly"
	except:
	dependencies:
	script:
	- ../configure --disable-static --prefix="`pwd`/install" > configure.log
	- make $JOBS -s V=0 > make.log
	- make $JOBS -s V=0 install > make-install.log
	- make $JOBS -s V=0 check

	notify slack weekly:
	stage: weekly-report
	tags:
	- deployment
	only:
	refs:
	- schedules
	variables:
	- $type == "weekly"
	before_script:
	- eval `ssh-agent -s`
	- ssh-add /scratch/vrothe/id_rsa /scratch/vrothe/id_rsa_runner_wgs
	when: on_failure
	script:
	- echo "Weekly build on \`$CI_BUILD_REF_NAME\` failed! Commit \`$(git log -1 --oneline)\`. See pipeline of https://gitlab.tp.nt.uni-siegen.de/whizard/development/commit/$CI_BUILD_REF" \| slacktee.sh -a "warning" -p --config /scratch/vrothe/gitlab/.slacktee
	Index: trunk/m4/aux.m4
	===================================================================
	--- trunk/m4/aux.m4 (revision 8189)
	+++ trunk/m4/aux.m4 (revision 8190)
	@@ -1,332 +1,332 @@
	dnl aux.m4 -- Auxiliary macros for WHIZARD's configure.ac
	dnl

	dnl Horizontal line for readability:
	AC_DEFUN([WO_HLINE],
	[AC_MSG_NOTICE([--------------------------------------------------------------])])

	dnl Message at the beginning of a configure section
	AC_DEFUN([WO_CONFIGURE_SECTION],
	[WO_HLINE()
	AC_MSG_NOTICE([--- ]$1[ ---])
	AC_MSG_NOTICE([])
	])


	dnl Define a variable and export it
	dnl WO_SET(variable, value)
	AC_DEFUN([WO_SET],
	[$1=$2
	AC_SUBST($1)])

	dnl Add a list of names to the list of output or executable files
	dnl WO_OUTFILES(subdir, files)
	AC_DEFUN([WO_OUTFILES],
	[for file in $2; do
	OUTFILES="$OUTFILES $1/$file";
	done])

	dnl WO_EXECUTABLES(subdir, files)
	AC_DEFUN([WO_EXECUTABLES],
	[for file in $2; do
	OUTFILES="$OUTFILES $1/$file";
	EXECUTABLES="$EXECUTABLES $1/$file"
	done])

	dnl Add a list of names to the list of automake-controlled files
	AC_DEFUN([WO_AUTOMAKE],
	[for file in $2; do
	AUTOMAKEFILES="$AUTOMAKEFILES $1/$file";
	done])

	dnl This adds a package which resides in a subdirectory of 'src'
	dnl The `variable' is inserted into AC_SUBST; it will refer to
	enl the package subdirectory in Makefiles. The package
	dnl resides in src/XXX and and optionally has a Makefile (or similar).
	dnl WO_PACKAGE(variable, identifier [,Makefiles [,Executables]])
	AC_DEFUN([WO_PACKAGE],
	[WO_SET($1,src/$2)
	ifelse($#, 3,
	[WO_OUTFILES($$1, $3)
	WO_AUTOMAKE($$1, $3)])
	ifelse($#, 4,
	[WO_OUTFILES($$1, $3)
	WO_EXECUTABLES($$1, $4)])
	])

	dnl This is like WO_PACKAGE, but it calls AC_ARG_ENABLE in addition.
	dnl If the package `id' is disabled or the 'file' is not found,
	dnl the variable `var' is set to "no".
	dnl WO_PACKAGE_ENABLE(var, id, help, file [,Makefiles [,Executables]])
	AC_DEFUN([WO_PACKAGE_ENABLE],
	[AC_ARG_ENABLE($2,[$3])
	if test "$enable_$2" = "no"; then
	AC_MSG_CHECKING([for src/$2/$4])
	WO_SET($1, no)
	AC_MSG_RESULT([(disabled)])
	else
	AC_CHECK_FILE(src/$2/$4, enable_$2=yes, enable_$2=no)
	if test "$enable_$2" = "no"; then
	WO_SET($1, no)
	else
	ifelse($#, 4, [WO_PACKAGE($1, $2)])
	ifelse($#, 5, [WO_PACKAGE($1, $2, $5)])
	ifelse($#, 6, [WO_PACKAGE($1, $2, $5, $6)])
	fi
	fi
	])

	dnl The same, but disabled by default.
	dnl If the package `id' is disabled or the 'file' is not found,
	dnl the variable `var' is set to "no".
	dnl WO_PACKAGE_DISABLE(var, id, help, file [,Makefiles [,Executables]])
	AC_DEFUN([WO_PACKAGE_DISABLE],
	[AC_ARG_ENABLE($2,[$3])
	if test "$enable_$2" = "yes"; then
	AC_CHECK_FILE(src/$2/$4, enable_$2=yes, enable_$2=no)
	if test "$enable_$2" = "no"; then
	WO_SET($1, no)
	else
	ifelse($#, 4, [WO_PACKAGE($1, $2)])
	ifelse($#, 5, [WO_PACKAGE($1, $2, $5)])
	ifelse($#, 6, [WO_PACKAGE($1, $2, $5, $6)])
	fi
	else
	enable_$2="no"
	AC_MSG_CHECKING([for src/$2/$4])
	WO_SET($1, no)
	AC_MSG_RESULT([(disabled)])
	fi
	])


	dnl Extension of AC_PATH_PROG: Search for libraries for which the name
	dnl is not exactly known (because it may have the version number in it)
	dnl Set output variables $var, $var_DIR, $var_LIB accordingly
	dnl WO_PATH_LIB(var, id, name-list, path)
	AC_DEFUN([WO_PATH_LIB],
	[AC_CACHE_CHECK(for $3, wo_cv_path_$1,
	[case "$$1" in
	/*)
	wo_cv_path_$1="$$1" # User-supplied path
	;;
	*)
	IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
	ac_dummy=$4
	for ac_dir in $ac_dummy; do
	test -z "$ac_dir" && ac_dir=.
	unset wo_cv_path_$1
	ac_pwd=`pwd`
	if test -d "$ac_dir"; then
	cd $ac_dir
	for ac_word in $3; do
	test -f "$ac_word" && wo_cv_path_$1="$ac_dir/$ac_word"
	done
	cd $ac_pwd
	fi
	if test -n "$wo_cv_path_$1"; then
	break
	fi
	done
	IFS="$ac_save_ifs"
	if test -z "$wo_cv_path_$1"; then
	wo_cv_path_$1="no"
	fi
	;;
	esac
	])
	$1=$wo_cv_path_$1
	if test "$$1" != "no"; then
	$1_DIR=`echo $$1 \| sed -e 's\|/lib$2.*\.a$\|\|'`
	$1_LIB=`echo $$1 \| sed -e 's\|^./lib$$2.$\.a$\|\1\|'`
	fi
	AC_SUBST($1)
	AC_SUBST($1_DIR)
	AC_SUBST($1_LIB)
	])

	dnl WHIZARD summary
	AC_DEFUN([WO_SUMMARY],[dnl
	WO_VERSION=AC_PACKAGE_VERSION()
	function echo_summary () {
	echo "\|=============================================================================\|"
	echo "\| \|"
	echo "\| WW WW WW WW WW WWWWWW WW WWWWW WWWW \|"
	echo "\| WW WW WW WW WW WW WW WWWW WW WW WW WW \|"
	echo "\| WW WW WW WW WWWWWWW WW WW WW WW WWWWW WW WW \|"
	echo "\| WWWW WWWW WW WW WW WW WWWWWWWW WW WW WW WW \|"
	echo "\| WW WW WW WW WW WWWWWW WW WW WW WW WWWW \|"
	echo "\| \|"
	echo "\| \|"
	echo "\| W \|"
	echo "\| sW \|"
	echo "\| WW \|"
	echo "\| sWW \|"
	echo "\| WWW \|"
	echo "\| wWWW \|"
	echo "\| wWWWW \|"
	echo "\| WW WW \|"
	echo "\| WW WW \|"
	echo "\| wWW WW \|"
	echo "\| wWW WW \|"
	echo "\| WW WW \|"
	echo "\| WW WW \|"
	echo "\| WW WW \|"
	echo "\| WW WW \|"
	echo "\| WW WW \|"
	echo "\| WW WW \|"
	echo "\| wwwwww WW WW \|"
	echo "\| WWWWWww WW WW \|"
	echo "\| WWWWWwwwww WW WW \|"
	echo "\| wWWWwwwwwWW WW \|"
	echo "\| wWWWWWWWWWWwWWW WW \|"
	echo "\| wWWWWW wW WWWWWWW \|"
	echo "\| WWWW wW WW wWWWWWWWwww \|"
	echo "\| WWWW wWWWWWWWwwww \|"
	echo "\| WWWW WWWW WWw \|"
	echo "\| WWWWww WWWW \|"
	echo "\| WWWwwww WWWW \|"
	echo "\| wWWWWwww wWWWWW \|"
	echo "\| WwwwwwwwwWWW \|"
	echo "\| \|"
	echo "\| \|"
	echo "\| \|"
	echo "\| by: Wolfgang Kilian, Thorsten Ohl, Juergen Reuter \|"
	echo "\| with contributions from Christian Speckner \|"
	echo "\| Contact: <whizard@desy.de> \|"
	echo "\| \|"
	echo "\| if you use WHIZARD please cite: \|"
	echo "\| W. Kilian, T. Ohl, J. Reuter, Eur.Phys.J.C71 (2011) 1742 \|"
	echo "\| @<:@arXiv: 0708.4233 @<:@hep-ph@:>@@:>@ \|"
	echo "\| M. Moretti, T. Ohl, J. Reuter, arXiv: hep-ph/0102195 \|"
	echo "\| \|"
	echo "\|=============================================================================\|"
	echo "**************************************************************"
	echo "--------------------------------------------------------------"
	echo "--- AC_PACKAGE_NAME() CONFIGURATION SUMMARY ---"
	echo "**************************************************************"
	echo "Package name: AC_PACKAGE_NAME()"
	echo "Version: AC_PACKAGE_VERSION()"
	echo "Date: $PACKAGE_DATE"
	echo "Status: $PACKAGE_STATUS"
	echo "**************************************************************"
	echo "--- Compilers ---"
	echo "--------------------------------------------------------------"
	echo "Fortran compiler: --- $FC_VENDOR ---"
	echo " Version: --- $FC_VERSION ---"
	echo " Flags: --- $FCFLAGS ---"
	echo " float precision: --- $FC_PRECISION ---"
	if test "$FC_OPENMP_OFF" = "!" ; then
	echo " OpenMP: --- on with max. $FC_OPENMP_DEFAULT_MAX_THREADS threads"
	elif test "$FC_OPENMP_ON" = "!" ; then
	echo " OpenMP: --- off ---"
	fi
	if test "$MPI_AVAILABLE" = "yes" ; then
	echo " MPI: --- on ---"
	echo " MPI Library: --- $MPI_LIBRARY, v$MPI_VERSION ---"
	else
	echo " MPI: --- off ---"
	fi
	echo "--------------------------------------------------------------"
	echo " OCaml compiler: --- $OCAMLOPT ---"
	echo " Version: --- $OCAMLVERSION ---"
	echo " Flags: --- $OCAMLFLAGS ---"
	echo "--------------------------------------------------------------"
	echo " C++ compiler: --- $CXX --- @<:@interfaces only@:>@"
	echo " Flags: --- $CXXFLAGS ---"
	echo "**************************************************************"
	echo "--- Internal and shipped packages ---"
	echo "--------------------------------------------------------------"
	echo "VAMP (multi-channel adapative integrator) : yes, v$WO_VERSION"
	if test "$OCAMLOPT" != "no" ; then
	echo "O'Mega (matrix element generator) : yes, v$WO_VERSION"
	else
	echo "O'Mega (matrix element generator) : no"
	fi
	echo "CIRCE1 (lepton beam spectra, parameterized): yes, v$WO_VERSION"
	echo "CIRCE2 (lepton beam spectra, sampled) : yes, v$WO_VERSION"
	if test "$OCAMLOPT" != "no" ; then
	echo " incl. tools for generating new spectra : yes"
	else
	echo " incl. tools for generating new spectra : no"
	fi
	echo "--------------------------------------------------------------"
	if test "$PYTHIA6_AVAILABLE_FLAG" = ".true." ; then
	echo "PYTHIA6 (parton showering & hadronization) : yes, v6.427"
	echo "TAUOLA (tau decays) : yes"
	else
	echo "PYTHIA6 (parton showering & hadronization) : no"
	echo "TAUOLA (tau decays) : no"
	fi
	echo "StdHEP (event format) : yes, v5.06.01"
	echo "--------------------------------------------------------------"
	echo "--- External packages ---"
	echo "--------------------------------------------------------------"
	if test "$HEPMC_AVAILABLE_FLAG" = "yes" ; then
	echo "HepMC (event format): yes, v$HEPMC_VERSION"
	else
	echo "HepMC (event format): no"
	fi
	if test "$LCIO_AVAILABLE_FLAG" = "yes" ; then
	echo "LCIO (event format) : yes, v$LCIO_VERSION"
	else
	echo "LCIO (event format) : no"
	fi
	if test "$LHAPDF5_AVAILABLE_FLAG" = ".true." ; then
	echo "LHAPDF (PDF sets) : yes, v$LHAPDF_FULL_VERSION"
	elif test "$LHAPDF6_AVAILABLE_FLAG" = ".true." ; then
	echo "LHAPDF (PDF sets) : yes, v$LHAPDF_FULL_VERSION"
	echo " PDF set path: $LHAPDF_PDFSETS_PATH"
	else
	echo "LHAPDF (PDF sets) : no"
	fi
	if test "$HOPPET_AVAILABLE_FLAG" = ".true." ; then
	echo "HOPPET (PDF match.) : yes, v$HOPPET_VERSION"
	else
	echo "HOPPET (PDF match.) : no"
	fi
	if test "$FASTJET_AVAILABLE_FLAG" = "yes" ; then
	echo "FastJet (clustering): yes, v$FASTJET_VERSION"
	else
	echo "FastJet (clustering): no"
	fi
	if test "$PYTHIA8_AVAILABLE_FLAG" = ".true." ; then
	- echo "PYTHIA8 (QCD) : yes, v$PYTHIA8_VERSION @<:@not yet functional@:>@"
	+ echo "PYTHIA8 (QCD) : yes, v$PYTHIA8_VERSION"
	else
	echo "PYTHIA8 (QCD) : no"
	fi
	if test "$GOSAM_AVAILABLE_FLAG" = ".true." ; then
	echo "GoSam (OLP) : yes, v$GOSAM_VERSION"
	else
	echo "GoSam (OLP) : no"
	fi
	if test "$OPENLOOPS_AVAILABLE_FLAG" = ".true." ; then
	echo "OpenLoops (OLP) : yes, v$OPENLOOPS_VERSION"
	echo " path : $OPENLOOPS_DIR"
	else
	echo "OpenLoops (OLP) : no"
	fi
	if test "$RECOLA_AVAILABLE_FLAG" = ".true." ; then
	echo "RECOLA (OLP) : yes, v$RECOLA_VERSION"
	echo " path : $RECOLA_DIR"
	else
	echo "RECOLA (OLP) : no"
	fi
	if test "$LOOPTOOLS_AVAILABLE_FLAG" = ".true." ; then
	echo "LoopTools : yes"
	else
	echo "LoopTools : no"
	fi
	echo "--------------------------------------------------------------"
	if test "$SIP_ACTIVE" = "yes" ; then
	echo "**************************************************************"
	echo "* MAC OS X Darwin system with *"
	echo "* Security Integrity Protection (SIP) enabled. *"
	echo "* 'make check' will not work, and most likely also *"
	echo "* 'make installcheck' will not work. The installed *"
	echo "* WHIZARD will work as intended. *"
	echo "**************************************************************"
	fi
	}
	echo_summary \| tee config-summary.log
	])
	Index: trunk/ChangeLog
	===================================================================
	--- trunk/ChangeLog (revision 8189)
	+++ trunk/ChangeLog (revision 8190)
	@@ -1,1795 +1,1798 @@
	ChangeLog -- Summary of changes to the WHIZARD package

	Use svn log to see detailed changes.

	Version 2.6.5

	2018-11-30
	RELEASE: version 2.6.5

	+2018-11-02
	+ PYTHIA8 interface
	+
	2018-10-29
	Flat phase space parametrization with RAMBO (on diet) implemented

	2018-10-17
	Revise extended test suite

	2018-09-27
	Process container for RECOLA processes

	2018-09-15
	Fixes by M. Berggren for PYTHIA6 interface

	2018-09-14
	First fixes after HepForge modernization
	##################################################################

	2018-08-23
	RELEASE: version 2.6.4

	2018-08-09
	Infrastructure to check colored subevents

	2018-07-10
	Infrastructure for running WHIZARD in batch mode

	2018-07-04
	MPI available from distribution tarball

	2018-06-03
	Support Intel Fortran Compiler under MAC OS X

	2018-05-07
	FKS slicing parameter delta_i (initial state) implementend

	2018-05-03
	Refactor structure function assignment for NLO

	2018-05-02
	FKS slicing parameter xi_cut, delta_0 implemented

	2018-04-20
	Workspace subdirectory for process integration (grid/phs files)
	Packing/unpacking of files at job end/start
	Exporting integration results from scan loops

	2018-04-13
	Extended QCD NLO test suite

	2018-04-09
	Bugfix for Higgs Singlet Extension model

	2018-04-06
	Workspace subdirectory for process generation and compilation
	--job-id option for creating job-specific names

	2018-03-20
	Bug fix for color flow matching in hadron collisions
	with identical initial state quarks

	2018-03-08
	Structure functions quantum numbers correctly assigned for NLO

	2018-02-24
	Configure setup includes 'pgfortran' and 'flang'

	2018-02-21
	Include spin-correlated matrix elements in interactions

	2018-02-15
	Separate module for QED ISR structure functions

	##################################################################

	2018-02-10
	RELEASE: version 2.6.3

	2018-02-08
	Improvements in memory management for PS generation

	2018-01-31
	Partial refactoring: quantum number assigment NLO
	Initial-state QCD splittings for hadron collisions

	2018-01-25
	Bug fix for weighted events with VAMP2

	2018-01-17
	Generalized interface for Recola versions 1.3+ and 2.1+

	2018-01-15
	Channel equivalences also for VAMP2 integrator

	2018-01-12
	Fix for OCaml compiler 4.06 (and newer)

	2017-12-19
	RECOLA matrix elements with flavor sums can be integrated

	2017-12-18
	Bug fix for segmentation fault in empty resonance histories

	2017-12-16
	Fixing a bug in PYTHIA6 PYHEPC routine by omitting CMShowers
	from transferral between PYTHIA and WHIZARD event records

	2017-12-15
	Event index for multiple processes in event file correct

	##################################################################

	2017-12-13
	RELEASE: version 2.6.2

	2017-12-07
	User can set offset in event numbers

	2017-11-29
	Possibility to have more than one RECOLA process in one file

	2017-11-23
	Transversal/mixed (and unitarized) dim-8 operators

	2017-11-16
	epa_q_max replaces epa_e_max (trivial factor 2)

	2017-11-15
	O'Mega matrix element compilation silent now

	2017-11-14
	Complete expanded P-wave form factor for top threshold

	2017-11-10
	Incoming particles can be accessed in SINDARIN

	2017-11-08
	Improved handling of resonance insertion, additional parameters

	2017-11-04
	Added Higgs-electron coupling (SM_Higgs)

	##################################################################

	2017-11-03
	RELEASE: version 2.6.1

	2017-10-20
	More than 5 NLO components possible at same time

	2017-10-19
	Gaussian cutoff for shower resonance matching

	2017-10-12
	Alternative (more efficient) method to generate
	phase space file

	2017-10-11
	Bug fix for shower resonance histories for processes
	with multiple components

	2017-09-25
	Bugfix for process libraries in shower resonance histories

	2017-09-21
	Correctly generate pT distribution for EPA remnants

	2017-09-20
	Set branching ratios for unstable particles also by hand

	2017-09-14
	Correctly generate pT distribution for ISR photons

	##################################################################

	2017-09-08
	RELEASE: version 2.6.0

	2017-09-05
	Bug fix for initial state NLO QCD flavor structures
	Real and virtual NLO QCD hadron collider processes
	work with internal interactions

	2017-09-04
	Fully validated MPI integration and event generation

	2017-09-01
	Resonance histories for shower: full support
	Bug fix in O'Mega model constraints
	O'Mega allows to output a parsable form of the DAG

	2017-08-24
	Resonance histories in events for transferral
	to parton shower (e.g. in ee -> jjjj)

	2017-08-01
	Alpha version of HepMC v3 interface
	(not yet really functional)

	2017-07-31
	Beta version for RECOLA OLP support

	2017-07-06
	Radiation generator fix for LHC processes

	2017-06-30
	Fix bug for NLO with structure
	functions and/or polarization

	2017-06-23
	Collinear limit for QED corrections works

	2017-06-17
	POWHEG grids generated already during integration

	2017-06-12
	Soft limit for QED corrections works

	2017-05-16
	Beta version of full MPI parallelization (VAMP2)
	Check consistency of POWHEG grid files
	Logfile config-summary.log for configure summary

	2017-05-12
	Allow polarization in top threshold

	2017-05-09
	Minimal demand automake 1.12.2
	Silent rules for make procedures

	2017-05-07
	Major fix for POWHEG damping
	Correctly initialize FKS ISR phasespace

	##################################################################

	2017-05-06
	RELEASE: version 2.5.0

	2017-05-05
	Full UFO support (SM-like models)
	Fixed-beam ISR FKS phase space

	2017-04-26
	QED splittings in radiation generator

	2017-04-10
	Retire deprecated O'Mega vertex cache files

	##################################################################

	2017-03-24
	RELEASE: version 2.4.1

	2017-03-16
	Distinguish resonance charge in phase space channels
	Keep track of resonance histories in phase space
	Complex mass scheme default for OpenLoops amplitudes

	2017-03-13
	Fix helicities for polarized OpenLoops calculations

	2017-03-09
	Possibility to advance RNG state in rng_stream

	2017-03-04
	General setup for partitioning real emission
	phase space

	2017-03-06
	Bugfix on rescan command for converting event files

	2017-02-27
	Alternative multi-channel VEGAS implementation
	VAMP2: serial backbone for MPI setup
	Smoothstep top threshold matching

	2017-02-25
	Single-beam structure function with
	s-channel mapping supported
	Safeguard against invalid process libraries

	2017-02-16
	Radiation generator for photon emission

	2017-02-10
	Fixes for NLO QCD processes (color correlations)

	2017-01-16
	LCIO variable takes precedence over LCIO_DIR

	2017-01-13
	Alternative random number generator
	rng_stream (cf. L'Ecuyer et al.)

	2017-01-01
	Fix for multi-flavor BLHA tree
	matrix elements

	2016-12-31
	Grid path option for VAMP grids

	2016-12-28
	Alpha version of Recola OLP support

	2016-12-27
	Dalitz plots for FKS phase space

	2016-12-14
	NLO multi-flavor events possible

	2016-12-09
	LCIO event header information added

	2016-12-02
	Alpha version of RECOLA interface
	Bugfix for generator status in LCIO

	##################################################################

	2016-11-28
	RELEASE: version 2.4.0

	2016-11-24
	Bugfix for OpenLoops interface: EW scheme
	is set by WHIZARD
	Bugfixes for top threshold implementation

	2016-11-11
	Refactoring of dispatching

	2016-10-18
	Bug fix for LCIO output

	2016-10-10
	First implementation for collinear soft terms

	2016-10-06
	First full WHIZARD models from UFO files

	2016-10-05
	WHIZARD does not support legacy gcc 4.7.4 any longer

	2016-09-30
	Major refactoring of process core and NLO components

	2016-09-23
	WHIZARD homogeneous entity: discarding subconfigures
	for CIRCE1/2, O'Mega, VAMP subpackages; these are
	reconstructable by script projectors

	2016-09-06
	Introduce main configure summary

	2016-08-26
	Fix memory leak in event generation

	##################################################################

	2016-08-25
	RELEASE: version 2.3.1

	2016-08-19
	Bug fix for EW-scheme dependence of gluino propagators

	2016-08-01
	Beta version of complex mass scheme support

	2016-07-26
	Fix bug in POWHEG damping for the matching

	##################################################################

	2016-07-21
	RELEASE: version 2.3.0

	2016-07-20
	UFO file support (alpha version) in O'Mega

	2016-07-13
	New (more) stable of WHIZARD GUI
	Support for EW schemes for OpenLoops
	Factorized NLO top decays for threshold model

	2016-06-15
	Passing factorization scale to PYTHIA6
	Adding charge and neutral observables

	2016-06-14
	Correcting angular distribution/tweaked kinematics in
	non-collinear structure functions splittings

	2016-05-10
	Include (Fortran) TAUOLA/PHOTOS for tau decays via PYTHIA6
	(backwards validation of LC CDR/TDR samples)

	2016-04-27
	Within OpenLoops virtuals: support for Collier library

	2016-04-25
	O'Mega vertex tables only loaded at first usage

	2016-04-21
	New CJ15 PDF parameterizations added

	2016-04-21
	Support for hadron collisions at NLO QCD

	2016-04-05
	Support for different (parameter) schemes in model files

	2016-03-31
	Correct transferral of lifetime/vertex from PYTHIA/TAUOLA
	into the event record

	2016-03-21
	New internal implementation of polarization
	via Bloch vectors, remove pointer constructions

	2016-03-13
	Extension of cascade syntax for processes:
	exclude propagators/vertices etc. possible

	2016-02-24
	Full support for OpenLoops QCD NLO matrix
	elements, inclusion in test suite

	2016-02-12
	Substantial progress on QCD NLO support

	2016-02-02
	Automated resonance mapping for FKS subtraction

	2015-12-17
	New BSM model WZW for diphoton resonances

	##################################################################

	2015-11-22
	RELEASE: version 2.2.8

	2015-11-21
	Bugfix for fixed-order NLO events

	2015-11-20
	Anomalous FCNC top-charm vertices

	2015-11-19
	StdHEP output via HEPEVT/HEPEV4 supported

	2015-11-18
	Full set of electroweak dim-6 operators included

	2015-10-22
	Polarized one-loop amplitudes supported

	2015-10-21
	Fixes for event formats for showered events

	2015-10-14
	Callback mechanism for event output

	2015-09-22
	Bypass matrix elements in pure event sample rescans
	StdHep frozen final version v5.06.01 included internally

	2015-09-21
	configure option --with-precision to
	demand 64bit, 80bit, or 128bit Fortran
	and bind C precision types

	2015-09-07
	More extensive tests of NLO
	infrastructure and POWHEG matching

	2015-09-01
	NLO decay infrastructure
	User-defined squared matrix elements
	Inclusive FastJet algorithm plugin
	Numerical improvement for small boosts

	##################################################################

	2015-08-11
	RELEASE: version 2.2.7
	-
	+
	2015-08-10
	Infrastructure for damped POWHEG
	Massive emitters in POWHEG
	Born matrix elements via BLHA
	GoSam filters via SINDARIN
	Minor running coupling bug fixes
	Fixed-order NLO events

	2015-08-06
	CT14 PDFs included (LO, NLO, NNLL)

	2015-07-07
	Revalidation of ILC WHIZARD-PYTHIA event chain
	Extended test suite for showered events
	Alpha version of massive FSR for POWHEG
	-
	+
	2015-06-09
	Fix memory leak in interaction for long cascades
	Catch mismatch between beam definition and CIRCE2 spectrum
	-
	+
	2015-06-08
	Automated POWHEG matching: beta version
	Infrastructure for GKS matching
	Alpha version of fixed-order NLO events
	CIRCE2 polarization averaged spectra with
	explicitly polarized beams
	-
	+
	2015-05-12
	Abstract matching type: OO structure for matching/merging
	-
	+
	2015-05-07
	Bug fix in event record WHIZARD-PYTHIA6 transferral
	Gaussian beam spectra for lepton colliders
	-
	+
	##################################################################

	2015-05-02
	RELEASE: version 2.2.6

	2015-05-01
	Models for (unitarized) tensor resonances in VBS
	-
	+
	2015-04-28
	Bug fix in channel weights for event generation.
	-
	+
	2015-04-18
	Improved event record transfer WHIZARD/PYTHIA6

	2015-03-19
	POWHEG matching: alpha version
	-
	+
	##################################################################
	-
	+
	2015-02-27
	RELEASE: version 2.2.5

	2015-02-26
	Abstract types for quantum numbers
	-
	+
	2015-02-25
	Read-in of StdHEP events, self-tests

	2015-02-22
	Bugfix for mother-daughter relations in
	showered/hadronized events

	2015-02-20
	Projection on polarization in intermediate states

	2015-02-13
	Correct treatment of beam remnants in
	event formats (also LC remnants)

	##################################################################

	2015-02-06
	RELEASE: version 2.2.4

	2015-02-06
	Bugfix in event output

	2015-02-05
	LCIO event format supported

	2015-01-30
	Including state matrices in WHIZARD's internal IO
	Versioning for WHIZARD's internal IO
	Libtool update from 2.4.3 to 2.4.5
	LCIO event output (beta version)

	2015-01-27
	Progress on NLO integration
	Fixing a bug for multiple processes in a single
	event file when using beam event files

	2015-01-19
	Bug fix for spin correlations evaluated in the rest
	frame of the mother particle

	2015-01-17
	Regression fix for statically linked processes
	from SARAH and FeynRules

	2015-01-10
	NLO: massive FKS emitters supported (experimental)

	2015-01-06
	MMHT2014 PDF sets included

	2015-01-05
	Handling mass degeneracies in auto_decays

	2014-12-19
	Fixing bug in rescan of event files

	##################################################################

	2014-11-30
	RELEASE: version 2.2.3

	2014-11-29
	Beta version of LO continuum/NLL-threshold
	matched top threshold model for e+e- physics

	2014-11-28
	More internal refactoring: disentanglement of module
	dependencies

	2014-11-21
	OVM: O'Mega Virtual Machine, bytecode instructions
	instead of compiled Fortran code

	2014-11-01
	Higgs Singlet extension model included

	2014-10-18
	Internal restructuring of code; half-way
	WHIZARD main code file disassembled

	2014-07-09
	Alpha version of NLO infrastructure

	##################################################################

	2014-07-06
	RELEASE: version 2.2.2

	2014-07-05
	CIRCE2: correlated LC beam spectra and
	GuineaPig Interface to LC machine parameters

	2014-07-01
	Reading LHEF for decayed/factorized/showered/
	hadronized events

	2014-06-25
	Configure support for GoSAM/Ninja/Form/QGraf

	2014-06-22
	LHAPDF6 interface

	2014-06-18
	Module for automatic generation of
	radiation and loop infrastructure code

	2014-06-11
	Improved internal directory structure

	##################################################################

	2014-06-03
	RELEASE: version 2.2.1

	2014-05-30
	Extensions of internal PDG arrays

	2014-05-26
	FastJet interface

	2014-05-24
	CJ12 PDFs included

	2014-05-20
	Regression fix for external models (via SARAH
	or FeynRules)

	##################################################################

	2014-05-18
	RELEASE: version 2.2.0

	2014-04-11
	Multiple components: inclusive process definitions,
	syntax: process A + B + ...

	2014-03-13
	Improved PS mappings for e+e- ISR
	ILC TDR and CLIC spectra included in CIRCE1

	2014-02-23
	New models: AltH w\ Higgs for exclusion purposes,
	SM_rx for Dim 6-/Dim-8 operators, SSC for
	general strong interactions (w/ Higgs), and
	NoH_rx (w\ Higgs)

	2014-02-14
	Improved s-channel mapping, new on-shell
	production mapping (e.g. Drell-Yan)

	2014-02-03
	PRE-RELEASE: version 2.2.0_beta

	2014-01-26
	O'Mega: Feynman diagram generation possible (again)

	2013-12-16
	HOPPET interface for b parton matching

	2013-11-15
	PRE-RELEASE: version 2.2.0_alpha-4

	2013-10-27
	LHEF standards 1.0/2.0/3.0 implemented

	2013-10-15
	PRE-RELEASE: version 2.2.0_alpha-3

	2013-10-02
	PRE-RELEASE: version 2.2.0_alpha-2

	2013-09-25
	PRE-RELEASE: version 2.2.0_alpha-1

	2013-09-12
	PRE-RELEASE: version 2.2.0_alpha

	2013-09-03
	General 2HDM implemented

	2013-08-18
	Rescanning/recalculating events

	2013-06-07
	Reconstruction of complete event
	from 4-momenta possible

	2013-05-06
	Process library stacks

	2013-05-02
	Process stacks

	2013-04-29
	Single-particle phase space module

	2013-04-26
	Abstract interface for random
	number generator

	2013-04-24
	More object-orientation on modules
	Midpoint-rule integrator

	2013-04-05
	Object-oriented integration and
	event generation

	2013-03-12
	Processes recasted object-oriented:
	MEs, scales, structure functions
	First infrastructure for general Lorentz
	structures

	2013-01-17
	Object-orientated reworking of library and
	process core, more variable internal structure,
	unit tests

	2012-12-14
	Update Pythia version to 6.4.27

	2012-12-04
	Fix the phase in HAZ vertices

	2012-11-21
	First O'Mega unit tests, some infrastructure

	2012-11-13
	Bugfix in anom. HVV Lorentz structures

	##################################################################

	2012-09-18
	RELEASE: version 2.1.1

	2012-09-11
	Model MSSM_Hgg with Hgg and HAA vertices

	2012-09-10
	First version of implementation of multiple
	interactions in WHIZARD

	2012-09-05
	Infrastructure for internal CKKW matching

	2012-09-02
	C, C++, Python API

	2012-07-19
	Fixing particle numbering in HepMC format

	##################################################################

	2012-06-15
	RELEASE: version 2.1.0

	2012-06-14
	Analytical and kT-ordered shower officially
	released
	PYTHIA interface officially released

	2012-05-09
	Intrisince PDFs can be used for showering

	2012-05-04
	Anomalous Higgs couplings a la hep-ph/9902321

	##################################################################

	2012-03-19
	RELEASE: version 2.0.7

	2012-03-15
	Run IDs are available now
	More event variables in analysis
	Modified raw event format (compatibility mode exists)

	2012-03-12
	Bugfix in decay-integration order
	MLM matching steered completely internally now

	2012-03-09
	Special phase space mapping for narrow resonances
	decaying to 4-particle final states with far off-shell
	intermediate states
	Running alphas from PDF collaborations with
	builtin PDFs

	2012-02-16
	Bug fix in cascades decay infrastructure

	2012-02-04
	WHIZARD documentation compatible with TeXLive 2011

	2012-02-01
	Bug fix in FeynRules interface with --prefix flag

	2012-01-29
	Bug fix with name clash of O'Mega variable names

	2012-01-27
	Update internal PYTHIA to version 6.4.26
	Bug fix in LHEF output

	2012-01-21
	Catching stricter automake 1.11.2 rules

	2011-12-23
	Bug fix in decay cascade setup

	2011-12-20
	Bug fix in helicity selection rules

	2011-12-16
	Accuracy goal reimplemented

	2011-12-14
	WHIZARD compatible with TeXLive 2011

	2011-12-09
	Option --user-target added

	##################################################################

	2011-12-07
	RELEASE: version 2.0.6

	2011-12-07
	Bug fixes in SM_top_anom
	Added missing entries to HepMC format

	2011-12-06
	Allow to pass options to O'Mega
	Bug fix for HEPEVT block for showered/hadronized events

	2011-12-01
	Reenabled user plug-in for external code for
	cuts, structure functions, routines etc.

	2011-11-29
	Changed model SM_Higgs for Higgs phenomenology

	2011-11-25
	Supporting a Y, (B-L) Z' model

	2011-11-23
	Make WHIZARD compatible for MAC OS X Lion/XCode 4

	2011-09-25
	WHIZARD paper published: Eur.Phys.J. C71 (2011) 1742

	2011-08-16
	Model SM_QCD: QCD with one EW insertion

	2011-07-19
	Explicit output channel for dvips avoids printing

	2011-07-10
	Test suite for WHIZARD unit tests

	2011-07-01
	Commands for matrix element tests
	More OpenMP parallelization of kinematics
	Added unit tests

	2011-06-23
	Conversion of CIRCE2 from F77 to F90, major
	clean-up

	2011-06-14
	Conversion of CIRCE1 from F77 to F90

	2011-06-10
	OpenMP parallelization of channel kinematics
	(by Matthias Trudewind)

	2011-05-31
	RELEASE: version 1.97

	2011-05-24
	Minor bug fixes: update grids and elsif statement.

	##################################################################

	2011-05-10
	RELEASE: version 2.0.5

	2011-05-09
	Fixed bug in final state flavor sums
	Minor improvements on phase-space setup

	2011-05-05
	Minor bug fixes

	2011-04-15
	WHIZARD as a precompiled 64-bit binary available

	2011-04-06
	Wall clock instead of cpu time for time estimates

	2011-04-05
	Major improvement on the phase space setup

	2011-04-02
	OpenMP parallelization for helicity loop in O'Mega
	matrix elements

	2011-03-31
	Tools for relocating WHIZARD and use in batch
	environments

	2011-03-29
	Completely static builds possible, profiling options

	2011-03-28
	Visualization of integration history

	2011-03-27
	Fixed broken K-matrix implementation

	2011-03-23
	Including the GAMELAN manual in the distribution

	2011-01-26
	WHIZARD analysis can handle hadronized event files

	2011-01-17
	MSTW2008 and CT10 PDF sets included

	2010-12-23
	Inclusion of NMSSM with Hgg couplings

	2010-12-21
	Advanced options for integration passes

	2010-11-16
	WHIZARD supports CTEQ6 and possibly other PDFs
	directly; data files included in the distribution

	##################################################################

	2010-10-26
	RELEASE: version 2.0.4

	2010-10-06
	Bug fix in MSSM implementation

	2010-10-01
	Update to libtool 2.4

	2010-09-29
	Support for anomalous top couplings (form factors etc.)
	Bug fix for running gauge Yukawa SUSY couplings

	2010-09-28
	RELEASE: version 1.96

	2010-09-21
	Beam remnants and pT spectra for lepton collider re-enabled
	Restructuring subevt class

	2010-09-16
	Shower and matching are disabled by default
	PYTHIA as a conditional on these two options

	2010-09-14
	Possibility to read in beam spectra re-enabled (e.g. Guinea
	Pig)

	2010-09-13
	Energy scan as (pseudo-) structure functions re-implemented

	2010-09-10
	CIRCE2 included again in WHIZARD 2 and validated

	2010-09-02
	Re-implementation of asymmetric beam energies and collision
	angles, e-p collisions work, inclusion of a HERA DIS test
	case

	##################################################################

	2010-10-18
	RELEASE: version 2.0.3

	2010-08-08
	Bug in CP-violating anomalous triple TGCs fixed

	2010-08-06
	Solving backwards compatibility problem with O'Caml 3.12.0

	2010-07-12
	Conserved quantum numbers speed up O'Mega code generation

	2010-07-07
	Attaching full ISR/FSR parton shower and MPI/ISR
	module
	Added SM model containing Hgg, HAA, HAZ vertices

	2010-07-02
	Matching output available as LHEF and STDHEP

	2010-06-30
	Various bug fixes, missing files, typos

	2010-06-26
	CIRCE1 completely re-enabled
	Chaining structure functions supported

	2010-06-25
	Partial support for conserved quantum numbers in
	O'Mega

	2010-06-21
	Major upgrade of the graphics package: error bars,
	smarter SINDARIN steering, documentation, and all that...

	2010-06-17
	MLM matching with PYTHIA shower included

	2010-06-16
	Added full CIRCE1 and CIRCE2 versions including
	full documentation and miscellanea to the trunk

	2010-06-12
	User file management supported, improved variable
	and command structure

	2010-05-24
	Improved handling of variables in local command lists

	2010-05-20
	PYTHIA interface re-enabled

	2010-05-19
	ASCII file formats for interfacing ROOT and gnuplot in
	data analysis

	##################################################################

	2010-05-18
	RELEASE: version 2.0.2

	2010-05-14
	Reimplementation of visualization of phase space
	channels
	Minor bug fixes

	2010-05-12
	Improved phase space - elimination of redundancies

	2010-05-08
	Interface for polarization completed: polarized beams etc.

	2010-05-06
	Full quantum numbers appear in process log
	Integration results are usable as user variables
	Communication with external programs

	2010-05-05
	Split module commands into commands, integration,
	simulation modules

	2010-05-04
	FSR+ISR for the first time connected to the WHIZARD 2 core

	##################################################################

	2010-04-25
	RELEASE: version 2.0.1

	2010-04-23
	Automatic compile and integrate if simulate is called
	Minor bug fixes in O'Mega

	2010-04-21
	Checkpointing for event generation
	Flush statements to use WHIZARD inside a pipe

	2010-04-20
	Reimplementation of signal handling in WGIZARD 2.0

	2010-04-19
	VAMP is now a separately configurable and installable unit of
	WHIZARD, included VAMP self-checks
	Support again compilation in quadruple precision

	2010-04-06
	Allow for logarithmic plots in GAMELAN, reimplement the
	possibility to set the number of bins

	2010-04-15
	Improvement on time estimates for event generation

	##################################################################

	2010-04-12
	RELEASE: version 2.0.0

	2010-04-09
	Per default, the code for the amplitudes is subdivided to allow
	faster compiler optimization
	More advanced and unified and straightforward command language
	syntax
	Final bug fixes

	2010-04-07
	Improvement on SINDARIN syntax; printf, sprintf function
	thorugh a C interface

	2010-04-05
	Colorizing DAGs instead of model vertices: speed boost
	in colored code generation

	2010-03-31
	Generalized options for normalization of weighted and
	unweighted events
	Grid and weight histories added again to log files
	Weights can be used in analyses

	2010-03-28
	Cascade decays completely implemented including color and
	spin correlations

	2010-03-07
	Added new WHIZARD header with logo

	2010-03-05
	Removed conflict in O'Mega amplitudes between flavour sums
	and cascades
	StdHEP interface re-implemented

	2010-03-03
	RELEASE: version 2.0.0rc3
	Several bug fixes for preventing abuse in input files
	OpenMP support for amplitudes
	Reimplementation of WHIZARD 1 HEPEVT ASCII event formats
	FeynRules interface successfully passed MSSM test

	2010-02-26
	Eliminating ghost gluons from multi-gluon amplitudes

	2010-02-25
	RELEASE: version 1.95
	HEPEVT format from WHIZARD 1 re-implemented in WHIZARD 2

	2010-02-23
	Running alpha_s implemented in the FeynRules interface

	2010-02-19
	MSSM (semi-) automatized self-tests finalized

	2010-02-17
	RELEASE: version 1.94

	2010-02-16
	Closed memory corruption in WHIZARD 1
	Fixed problems of old MadGraph and CompHep drivers
	with modern compilers
	Uncolored vertex selection rules for colored amplitudes in
	O'Mega

	2010-02-15
	Infrastructure for color correlation computation in O'Mega
	finished
	Forbidden processes are warned about, but treated as non-fatal

	2010-02-14
	Color correlation computation in O'Mega finalized

	2010-02-10
	Improving phase space mappings for identical particles in
	initial and final states
	Introduction of more extended multi-line error message

	2010-02-08
	First O'Caml code for computation of color correlations in
	O'Mega

	2010-02-07
	First MLM matching with e+ e- -> jets

	##################################################################

	2010-02-06
	RELEASE: version 2.0.0rc2

	2010-02-05
	Reconsidered the Makefile structure and more extended tests
	Catch a crash between WHIZARD and O'Mega for forbidden processes
	Tensor products of arbitrary color structures in jet definitions

	2010-02-04
	Color correlation computation in O'Mega finalized

	##################################################################

	2010-02-03
	RELEASE: version 2.0.0rc1

	##################################################################

	2010-01-31
	Reimplemented numerical helicity selection rules
	Phase space functionality of version 1 restored and improved

	2009-12-05
	NMSSM validated with FeynRules in WHIZARD 1 (Felix Braam)

	2009-12-04
	RELEASE: version 2.0.0alpha

	##################################################################

	2009-04-16
	RELEASE: version 1.93

	2009-04-15
	Clean-up of Makefiles and configure scripts
	Reconfiguration of BSM model implementation
	extended supersymmetric models

	2008-12-23
	New model NMSSM (Felix Braam)
	SLHA2 added
	Bug in LHAPDF interface fixed

	2008-08-16
	Bug fixed in K matrix implementation
	Gravitino option in the MSSM added

	2008-03-20
	Improved color and flavor sums

	##################################################################

	2008-03-12
	RELEASE: version 1.92
	LHEF (Les Houches Event File) format added
	Fortran 2003 command-line interface (if supported by the compiler)
	Automated interface to colored models
	More bug fixes and workarounds for compiler compatibility

	##################################################################

	2008-03-06
	RELEASE: version 1.91
	New model K-matrix (resonances and anom. couplings in WW scattering)
	EWA spectrum
	Energy-scan pseudo spectrum
	Preliminary parton shower module (only from final-state quarks)
	Cleanup and improvements of configure process
	Improvements for O'Mega parameter files
	Quadruple precision works again
	More plotting options: lines, symbols, errors
	Documentation with PDF bookmarks enabled
	Various bug fixes

	2007-11-29
	New model UED

	##################################################################

	2007-11-23
	RELEASE: version 1.90
	O'Mega now part of the WHIZARD tree
	Madgraph/CompHEP disabled by default (but still usable)
	Support for LHAPDF (preliminary)
	Added new models: SMZprime, SM_km, Template
	Improved compiler recognition and compatibility
	Minor bug fixes

	##################################################################

	2006-06-15
	RELEASE: version 1.51
	Support for anomaly-type Higgs couplings (to gluon and photon/Z)
	Support for spin 3/2 and spin 2
	New models: Little Higgs (4 versions), toy models for extra dimensions
	and gravitinos
	Fixes to the whizard.nw source documentation to run through LaTeX
	Intel 9.0 bug workaround (deallocation of some arrays)

	2006-05-15
	O'Mega RELEASE: version 0.11
	merged JRR's O'Mega extensions

	##################################################################

	2006-02-07
	RELEASE: version 1.50
	To avoid confusion: Mention outdated manual example in BUGS file
	O'Mega becomes part of the WHIZARD generator

	2006-02-02 [bug fix update]
	Bug fix: spurious error when writing event files for weighted events
	Bug fix: 'r' option for omega produced garbage for some particle names
	Workaround for ifort90 bug (crash when compiling whizard_event)
	Workaround for ifort90 bug (crash when compiling hepevt_common)

	2006-01-27
	Added process definition files for MSSM 2->2 processes
	Included beam recoil for EPA (T.Barklow)
	Updated STDHEP byte counts (for STDHEP 5.04.02)
	Fixed STDHEP compatibility (avoid linking of incomplete .so libs)
	Fixed issue with comphep requiring Xlibs on Opteron
	Fixed issue with ifort 8.x on Opteron (compiling 'signal' interface)
	Fixed color-flow code: was broken for omega with option 'c' and 'w'
	Workaround hacks for g95 compatibility

	2005-11-07
	O'Mega RELEASE: version 0.10
	O'Mega, merged JRR's and WK's color hack for WHiZard
	O'Mega, EXPERIMENTAL: cache fusion tables (required for colors
	a la JRR/WK)
	O'Mega, make JRR's MSSM official

	##################################################################

	2005-10-25
	RELEASE: version 1.43
	Minor fixes in MSSM couplings (Higgs/3rd gen squarks).
	This should be final, since the MSSM results agree now completely
	with Madgraph and Sherpa
	User-defined lower and upper limits for split event file count
	Allow for counters (events, bytes) exceeding $2^{31}$
	Revised checksum treatment and implementation (now MD5)
	Bug fix: missing process energy scale in raw event file

	##################################################################

	2005-09-30
	RELEASE: version 1.42
	Graphical display of integration history ('make history')
	Allow for switching off signals even if supported (configure option)

	2005-09-29
	Revised phase space generation code, in particular for flavor sums
	Negative cut and histogram codes use initial beams instead of
	initial parton momenta. This allows for computing, e.g., E_miss
	Support constant-width and zero-width options for O'Mega
	Width options now denoted by w:X (X=f,c,z). f option obsolescent
	Bug fix: colorized code: flipped indices could screw up result
	Bug fix: O'Mega with 'c' and 'w:f' option together (still some problem)
	Bug fix: dvips on systems where dvips defaults to lpr
	Bug fix: integer overflow if too many events are requested

	2005-07-29
	Allow for 2 -> 1 processes (if structure functions are on)

	2005-07-26
	Fixed and expanded the 'test' matrix element:
	Unit matrix element with option 'u' / default: normalized phase space

	##################################################################

	2005-07-15
	RELEASE: version 1.41
	Bug fix: no result for particle decay processes with width=0
	Bug fix: line breaks in O'Mega files with color decomposition

	2005-06-02
	New self-tests (make test-QED / test-QCD / test-SM)
	check lists of 2->2 processes
	Bug fix: HELAS calling convention for wwwwxx and jwwwxx (4W-Vertex)

	2005-05-25
	Revised Makefile structure
	Eliminated obsolete references to ISAJET/SUSY (superseded by SLHA)

	2005-05-19
	Support for color in O'Mega (using color flow decomposition)
	New model QCD
	Parameter file changes that correspond to replaced SM module in O'Mega
	Bug fixes in MSSM (O'Mega) parameter file

	2005-05-18
	New event file formats, useful for LHC applications:
	ATHENA and Les Houches Accord (external fragmentation)
	Naive (i.e., leading 1/N) color factor now implemented both for
	incoming and outgoing partons

	2005-01-26
	include missing HELAS files for bundle
	pgf90 compatibility issues [note: still internal error in pgf90]

	##################################################################

	2004-12-13
	RELEASE: version 1.40
	compatibility fix: preprocessor marks in helas code now commented out
	minor bug fix: format string in madgraph source

	2004-12-03
	support for arbitray beam energies and directions
	allow for pT kick in structure functions
	bug fix: rounding error could result in zero cross section
	(compiler-dependent)

	2004-10-07
	simulate decay processes
	list fraction (of total width/cross section) instead of efficiency
	in process summary
	new cut/analysis parameters AA, AAD, CTA: absolute polar angle

	2004-10-04
	Replaced Madgraph I by Madgraph II. Main improvement: model no
	longer hardcoded
	introduced parameter reset_seed_each_process (useful for debugging)
	bug fix: color initialization for some processes was undefined

	2004-09-21
	don't compile unix_args module if it is not required

	##################################################################

	2004-09-20
	RELEASE: version 1.30
	g95 compatibility issues resolved
	some (irrelevant) memory leaks closed
	removed obsolete warning in circe1
	manual update (essentially) finished

	2004-08-03
	O'Mega RELEASE: version 0.9
	O'Mega, src/trie.mli, src/trie.ml: make interface compatible with
	the O'Caml 3.08 library (remains compatible with older
	versions). Implementation of unused functions still
	incomplete.

	2004-07-26
	minor fixes and improvements in make process

	2004-06-29
	workarounds for new Intel compiler bugs ...
	no rebuild of madgraph/comphep executables after 'make clean'
	bug fix in phase space routine:
	wrong energy for massive initial particles
	bug fix in (new) model interface: name checks for antiparticles
	pre-run checks for comphep improved
	ww-strong model file extended
	Model files particle name fixes, chep SM vertices included

	2004-06-22
	O'Mega RELEASE: version 0.8
	O'Mega MSSM: sign of W+/W-/A and W+/W-/Z couplings

	2004-05-05
	Fixed bug in PDFLIB interface: p+pbar was initialized as p+p (ThO)
	NAG compiler: set number of continuation lines to 200 as default
	Extended format for cross section summary; appears now in whizard.out
	Fixed 'bundle' feature

	2004-04-28
	Fixed compatibility with revised O'Mega SM_ac model
	Fixed problem with x=0 or x=1 when calling PDFLIB (ThO)
	Fixed bug in comphep module: Vtb was overlooked

	##################################################################

	2004-04-15
	RELEASE: version 1.28
	Fixed bug: Color factor was missing for O'Mega processes with
	four quarks and more
	Manual partially updated

	2004-04-08
	Support for grid files in binary format
	New default value show_histories=F (reduce output file size)
	Revised phase space switches: removed annihilation_lines,
	removed s_channel_resonance, changed meaning of
	extra_off_shell_lines, added show_deleted_channels
	Bug fixed which lead to omission of some phase space channels
	Color flow guessed only if requested by guess_color_flow

	2004-03-10
	New model interface: Only one model name specified in whizard.prc
	All model-dependent files reside in conf/models (modellib removed)

	2004-03-03
	Support for input/output in SUSY Les Houches Accord format
	Split event files if requested
	Support for overall time limit
	Support for CIRCE and CIRCE2 generator mode
	Support for reading beam events from file

	2004-02-05
	Fixed compiler problems with Intel Fortran 7.1 and 8.0
	Support for catching signals

	##################################################################

	2003-08-06
	RELEASE: version 1.27
	User-defined PDF libraries as an alternative to the standard PDFLIB

	2003-07-23
	Revised phase space module: improved mappings for massless particles,
	equivalences of phase space channels are exploited
	Improved mapping for PDF (hadron colliders)
	Madgraph module: increased max number of color flows from 250 to 1000

	##################################################################

	2003-06-23
	RELEASE: version 1.26
	CIRCE2 support
	Fixed problem with 'TC' integer kind [Intel compiler complained]

	2003-05-28
	Support for drawing histograms of grids
	Bug fixes for MSSM definitions

	##################################################################

	2003-05-22
	RELEASE: version 1.25
	Experimental MSSM support with ISAJET interface
	Improved capabilities of generating/analyzing weighted events
	Optional drawing phase space diagrams using FeynMF

	##################################################################

	2003-01-31
	RELEASE: version 1.24
	A few more fixes and workarounds (Intel and Lahey compiler)

	2003-01-15
	Fixes and workarounds needed for WHIZARD to run with Intel compiler
	Command-line option interface for the Lahey compiler

	Bug fix: problem with reading whizard.phs

	##################################################################

	2002-12-10
	RELEASE: version 1.23

	Command-line options (on some systems)

	Allow for initial particles in the event record, ordered:
	[beams, initials] - [remnants] - outgoing partons

	Support for PYTHIA 6.2: Les Houches external process interface
	String pythia_parameters can be up to 1000 characters long
	Select color flow states in (internal) analysis
	Bug fix in color flow content of raw event files

	Support for transversal polarization of fermion beams
	Cut codes: PHI now for absolute azimuthal angle, DPHI for distance
	'Test' matrix elements optionally respect polarization

	User-defined code can be inserted for spectra, structure functions
	and fragmentation

	Time limits can be specified for adaptation and simulation
	User-defined file names and file directory
	Initial weights in input file no longer supported

	Bug fix in MadGraph (wave function counter could overflow)

	Bug fix: Gamelan (graphical analysis) was not built if noweb absent

	##################################################################

	2002-03-16
	RELEASE: version 1.22
	Allow for beam remnants in the event record

	2002-03-01
	Handling of aliases in whizard.prc fixed (aliases are whole tokens)

	2002-02-28
	Optimized phase space handling routines
	(total execution time reduced by 20-60%, depending on process)

	##################################################################

	2002-02-26
	RELEASE: version 1.21
	Fixed ISR formula (ISR was underestimated in previous versions).
	New version includes ISR in leading-log approximation up to
	third order. Parameter ISR_sqrts renamed to ISR_scale.

	##################################################################

	2002-02-19
	RELEASE: version 1.20
	New process-generating method 'test' (dummy matrix element)
	Compatibility with autoconf 2.50 and current O'Mega version

	2002-02-05
	Prevent integration channels from being dropped (optionally)
	New internal mapping for structure functions improves performance
	Old whizard.phx file deleted after recompiling (could cause trouble)

	2002-01-24
	Support for user-defined cuts and matrix element reweighting
	STDHEP output now written by write_events_format=20 (was 3)

	2002-01-16
	Improved structure function handling; small changes in user interface:
	new parameter structured_beams in &process_input
	parameter fixed_energy in &beam_input removed
	Support for multiple initial states
	Eta-phi (cone) cut possible (hadron collider applications)
	Fixed bug: Whizard library was not always recompiled when necessary
	Fixed bug: Default cuts were insufficient in some cases
	Fixed bug: Unusable phase space mappings generated in some cases

	2001-12-06
	Reorganized document source

	2001-12-05
	Preliminary CIRCE2 support (no functionality yet)

	2001-11-27
	Intel compiler support (does not yet work because of compiler bugs)
	New cut and analysis mode cos-theta* and related
	Fixed circular jetset_interface dependency warning
	Some broadcast routines removed (parallel support disabled anyway)
	Minor shifts in cleanup targets (Makefiles)
	Modified library search, check for pdflib8*

	2001-08-06
	Fixed bug: I/O unit number could be undefined when reading phase space
	Fixed bug: Unitialized variable could cause segfault when
	event generation was disabled
	Fixed bug: Undefined subroutine in CIRCE replacement module
	Enabled feature: TGCs in O'Mega (not yet CompHEP!) matrix elements
	(CompHEP model sm-GF #5, O'Mega model SM_ac)
	Fixed portability issue: Makefile did rely on PWD environment variable
	Fixed portability issue: PYTHIA library search ambiguity resolved

	2001-08-01
	Default whizard.prc and whizard.in depend on activated modules
	Fixed bug: TEX=latex was not properly enabled when making plots

	2001-07-20
	Fixed output settings in PERL script calls
	Cache enabled in various configure checks

	2001-07-13
	Support for multiple processes in a single WHIZARD run. The
	integrations are kept separate, but the generated events are mixed
	The whizard.evx format has changed (incompatible), including now
	the color flow information for PYTHIA fragmentation
	Output files are now process-specific, except for the event file
	Phase space file whizard.phs (if present) is used only as input,
	program-generated phase space is now in whizard.phx

	2001-07-10
	Bug fix: Undefined parameters in parameters_SM_ac.f90 removed

	2001-07-04
	Bug fix: Compiler options for the case OMEGA is disabled
	Small inconsistencies in whizard.out format fixed

	2001-07-01
	Workaround for missing PDFLIB dummy routines in PYTHIA library

	##################################################################

	2001-06-30
	RELEASE: version 1.13
	Default path /cern/pro/lib in configure script

	2001-06-20
	New fragmentation option: Interface for PYTHIA with full color flow
	information, beam remnants etc.

	2001-06-18
	Severe bug fixed in madgraph interface: 3-gluon coupling was missing
	Enabled color flow information in madgraph

	2001-06-11
	VAMP interface module rewritten
	Revised output format: Multiple VAMP iterations count as one WHIZARD
	iteration in integration passes 1 and 3
	Improved message and error handling
	Bug fix in VAMP: handle exceptional cases in rebinning_weights

	2001-05-31
	new parameters for grid adaptation: accuracy_goal and efficiency_goal

	##################################################################

	2001-05-29
	RELEASE: version 1.12
	bug fixes (compilation problems): deleted/modified unused functions

	2001-05-16
	diagram selection improved and documented

	2001-05-06
	allow for disabling packages during configuration

	2001-05-03
	slight changes in whizard.out format; manual extended

	##################################################################

	2001-04-20
	RELEASE: version 1.11
	fixed some configuration and compilation problems (PDFLIB etc.)

	2001-04-18
	linked PDFLIB: support for quark/gluon structure functions

	2001-04-05
	parameter interface written by PERL script
	SM_ac model file: fixed error in continuation line

	2001-03-13
	O'Mega, O'Caml 3.01: incompatible changes
	O'Mega, src/trie.mli: add covariance annotation to T.t
	This breaks O'Caml 3.00, but is required for O'Caml 3.01.
	O'Mega, many instances: replace `sig include Module.T end' by
	`Module.T', since the bug is fixed in O'Caml 3.01

	2001-02-28
	O'Mega, src/model.mli:
	new field Model.vertices required for model functors, will
	retire Model.fuse2, Model.fuse3, Model.fusen soon.

	##################################################################

	2001-03-27
	RELEASE: version 1.10
	reorganized the modules as libraries
	linked PYTHIA: support for parton fragmentation

	2000-12-14
	fixed some configuration problems (if noweb etc. are absent)

	##################################################################

	2000-12-01
	RELEASE of first public version: version 1.00beta

File Metadata

Mime Type: application/octet-stream
Expires: Fri, May 3, 8:25 PM (1 d, 23 h)
Storage Engine: chunks
Storage Format: Chunks
Storage Handle: dYCG_A_Ktgl1
Default Alt Text: (4 MB)

Offset	End	Complete
0	4194304	Yes
4194304	4870867	Yes

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions