No OneTemporary
Actions

Size

827 KB

Subscribers

None

View Options

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

	Index: trunk/vamp/share/doc/Makefile.am
	===================================================================
	--- trunk/vamp/share/doc/Makefile.am (revision 8883)
	+++ trunk/vamp/share/doc/Makefile.am (revision 8884)
	@@ -1,174 +1,174 @@
	# Makefile.am --
	########################################################################
	##
	## Process this file with automake to produce Makefile.in
	#
	# Copyright (C) 1999-2023 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.
	#
	########################################################################


	WEBS = \
	prelude.nw divisions.nw vamp.nw vampi.nw \
	vamp_test.nw vamp_test0.nw application.nw \
	vamp_kinds.nw constants.nw exceptions.nw \
	tao_random_numbers.nw specfun.nw vamp_stat.nw histograms.nw \
	utils.nw linalg.nw products.nw kinematics.nw coordinates.nw \
	mpi90.nw postlude.nw

	if DISTRIBUTION
	PDFS = vamp.pdf preview.pdf preview2.pdf
	else
	PDFS =
	endif

	LATEX_STYLES = \
	feynmp.sty feynmp.mp \
	noweb.sty emp.sty flex.cls thohacks.sty thophys.sty

	-TEX_FLAGS = "$$TEXINPUTS:$(top_srcdir)/vamp/share/doc"
	-MP_FLAGS = "$$MPINPUTS:$(top_srcdir)/vamp/share/doc"
	+TEX_FLAGS = "$(top_srcdir)/vamp/share/doc:$$TEXINPUTS"
	+MP_FLAGS = "$(top_srcdir)/vamp/share/doc:$$MPINPUTS"

	EXTRA_DIST = \
	tex-comments.sh \
	vegas.d vamp.d \
	$(LATEX_STYLES)

	dist_doc_DATA = $(PDFS)

	if NOWEB_AVAILABLE
	pdf-local: vamp.pdf preview.pdf preview2.pdf
	else
	pdf-local: preview.pdf preview2.pdf
	endif

	VPATH = $(srcdir):$(top_builddir)/vamp/src:$(top_srcdir)/vamp/src

	if NOWEB_AVAILABLE

	vamp.tex: $(WEBS)
	@if $(AM_V_P); then :; else echo " NOWEAVE " $@; fi
	$(AM_V_at)$(NOWEAVE) -filter ./tex-comments -delay -index \
	`for i in $^; do case $$i in *.nw) echo $$i;; esac done` \
	\| $(CPIF) $@

	vamp.tex: tex-comments

	endif NOWEB_AVAILABLE

	tex-comments: tex-comments.sh
	cp $< $@
	chmod +x $@

	preview.pdf: vegas.data vamp.data

	vegas.data: vegas.d
	cp $< $@

	vamp.data: vamp.d
	cp $< $@

	SUFFIXES = .tex .pdf

	MPOST_LATEX = TEX=$(LATEX) TEXINPUTS=$(TEX_FLAGS) $(MPOST)

	if DISTRIBUTION
	if PDFLATEX_AVAILABLE
	if CONTEXT_AVAILABLE
	.tex.pdf:
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; else \
	echo " PDFLATEX " $<; TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; fi
	if MAKEINDEX_AVAILABLE
	@if $(AM_V_P); then $(MAKEINDEX) -o $.ind $.idx; else \
	echo " MAKEINDEX " $.ind $.idx; $(MAKEINDEX) -q -o $.ind $.idx; fi
	endif MAKEINDEX_AVAILABLE
	if MPOST_AVAILABLE
	@if $(AM_V_P); then test -r $.mp && $(MPOST_LATEX) $; else \
	echo " METAPOST " $.mp; test -r $.mp && $(MPOST_LATEX) $* >/dev/null; fi
	@if $(AM_V_P); then test -r $pics.mp && MPINPUTS=$(MP_FLAGS) $(MPOST) $pics; else \
	echo " METAPOST " $*pics.mp; \
	test -r $pics.mp && MPINPUTS=$(MP_FLAGS) $(MPOST) $pics > /dev/null; fi
	endif MPOST_AVAILABLE
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; else \
	echo " PDFLATEX " $<; TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; fi
	@if $(AM_V_P); then \
	if grep -s 'Rerun to get cross-references right.' $*.log; then \
	TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; \
	fi; else \
	if grep -s 'Rerun to get cross-references right.' $*.log >/dev/null; then \
	echo " PDFLATEX " $< "(for cross-references)"; \
	TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; \
	fi; \
	fi
	endif CONTEXT_AVAILABLE
	endif PDFLATEX_AVAILABLE
	endif DISTRIBUTION

	## Cleanup tasks
	mostlyclean-latex:
	-rm -f .data .mpx .[1-9] .t[1-9] vamp.mp preview.mp \
	.out .log .aux .idx .ilg .ind .rcs .toc \
	tex-comments vamp.tex
	-test "$(srcdir)" != "." && rm -f vamp.pdf \
	preview.pdf preview2.pdf
	clean-latex:
	maintainer-clean-latex:
	-rm -f vamp.pdf preview.pdf preview2.pdf
	if NOWEB_AVAILABLE
	mostlyclean-vamp:
	-test "$(srcdir)" != "." && rm -f vamp.pdf \
	preview.pdf preview2.pdf
	maintainer-clean-vamp:
	else
	mostlyclean-vamp:
	maintainer-clean-vamp:
	endif
	.PHONY: mostlyclean-latex clean-latex maintainer-clean-latex
	.PHONY: mostlyclean-vamp maintainer-clean-vamp

	## Remove backup files
	maintainer-clean-backup:
	-rm -f *~
	.PHONY: maintainer-clean-backup

	## Register additional clean targets
	mostlyclean-local: mostlyclean-latex mostlyclean-vamp
	clean-local: clean-latex
	maintainer-clean-local: maintainer-clean-latex maintainer-clean-vamp \
	maintainer-clean-backup

	if !DISTRIBUTION
	install-data-hook:
	-$(INSTALL) -m 644 vamp.pdf $(DESTDIR)$(datarootdir)/doc/vamp
	-$(INSTALL) -m 644 preview.pdf $(DESTDIR)$(datarootdir)/doc/vamp
	-$(INSTALL) -m 644 preview2.pdf $(DESTDIR)$(datarootdir)/doc/vamp

	uninstall-hook:
	-rm -f $(DESTDIR)/$(datarootdir)/doc/vamp/vamp.pdf
	-rm -f $(DESTDIR)/$(datarootdir)/doc/vamp/preview.pdf
	-rm -f $(DESTDIR)/$(datarootdir)/doc/vamp/preview2.pdf
	endif

	########################################################################
	## The End.
	########################################################################

	Index: trunk/src/matrix_elements/matrix_elements.nw
	===================================================================
	--- trunk/src/matrix_elements/matrix_elements.nw (revision 8883)
	+++ trunk/src/matrix_elements/matrix_elements.nw (revision 8884)
	@@ -1,11575 +1,11575 @@
	% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: matrix elements and process libraries
	\chapter{Matrix Element Handling}
	\includemodulegraph{matrix_elements}

	In this chapter, we support internal and external matrix elements:
	initialization, automatic generation where necessary, and numerical
	evaluation. We provide the interface for code generation and linking.
	Matrix-element code is organized in processes and process libraries.
	\begin{description}
	\item[process\_constants]
	A record of static process properties, for easy transfer between
	various \whizard\ modules.
	\item[prclib\_interfaces]
	This module deals with matrix-element code which is accessible via
	external libraries (Fortran libraries or generic C-compatible
	libraries) and must either be generated by the program or provided
	by the user explicitly.

	The module defines and uses an abstract type [[prc_writer_t]] and two
	abstract extensions, one for a Fortran module and one for a C-compatible
	library. The implementation provides the specific methods for writing the
	appropriate parts in external matrix element code.
	\item[prc\_core\_def]
	This module defines the abstract types [[prc_core_def_t]] and
	[[prc_driver_t]]. The implementation of the former provides the
	configuration for processes of a certain class, while the latter accesses
	the corresponding matrix element, in particular those generated by the
	appropriate [[prc_writer_t]] object.
	\item[process\_libraries]
	This module combines the functionality of
	the previous module with the means for holding processes definitions
	(the internal counterpart of appropriate declarations in the user
	interface), for handling matrix elements which do not need external
	code, and for accessing the matrix elements by the procedures for
	matrix-element evaluation, integration and event generation.
	\item[prclib\_stacks]
	Collect process libraries.
	\item[test\_me] This module provides a test implementation for the abstract
	types in the [[prc_core_def]] module. The implementation is intended for
	self-tests of several later modules. The implementation is internal, i.e.,
	no external code has is generated.
	\end{description}
	All data structures which are specific for a particular way of
	generating code or evaluating matrix element are kept abstract and
	thus generic. Later modules such as [[prc_omega]] provide
	implementations, in the form of type extensions for the various
	abstract types.

	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process data block}

	We define a simple transparent type that contains universal constant
	process data. We will reference objects of this type for the
	phase-space setup, for interfacing with process libraries, for
	implementing matrix-element generation, and in the master
	process-handling module.
	<<[[process_constants.f90]]>>=
	<<File header>>

	module process_constants

	<<Use kinds>>
	<<Use strings>>
	use pdg_arrays

	<<Standard module head>>

	<<Process constants: public>>

	<<Process constants: types>>

	interface
	<<Process constants: sub interfaces>>
	end interface

	end module process_constants
	@ %def process_constants
	@
	<<[[process_constants_sub.f90]]>>=
	<<File header>>

	submodule (process_constants) process_constants_s

	use io_units, only: given_output_unit, free_unit
	use format_utils, only: write_integer_array
	use md5, only: md5sum

	implicit none

	contains

	<<Process constants: procedures>>

	end submodule process_constants_s

	@ %def process_constants_s
	@
	The data type is just a block of public objects, only elementary
	types, no type-bound procedures.
	<<Process constants: public>>=
	public :: process_constants_t
	<<Process constants: types>>=
	type :: process_constants_t
	type(string_t) :: id
	type(string_t) :: model_name
	character(32) :: md5sum = ""
	logical :: openmp_supported = .false.
	integer :: n_in = 0
	integer :: n_out = 0
	integer :: n_flv = 0
	integer :: n_hel = 0
	integer :: n_col = 0
	integer :: n_cin = 0
	integer :: n_cf = 0
	integer, dimension(:,:), allocatable :: flv_state
	integer, dimension(:,:), allocatable :: hel_state
	integer, dimension(:,:,:), allocatable :: col_state
	logical, dimension(:,:), allocatable :: ghost_flag
	complex(default), dimension(:), allocatable :: color_factors
	integer, dimension(:,:), allocatable :: cf_index
	integer, dimension(:), allocatable :: eqv_flv_index
	integer, dimension(:), allocatable :: eqv_hel_index
	contains
	<<Process constants: process constants: TBP>>
	end type process_constants_t

	@ %def process_constants_t
	@
	<<Process constants: process constants: TBP>>=
	procedure :: get_n_tot => process_constants_get_n_tot
	<<Process constants: sub interfaces>>=
	elemental module function process_constants_get_n_tot (prc_const) result (n_tot)
	integer :: n_tot
	class(process_constants_t), intent(in) :: prc_const
	end function process_constants_get_n_tot
	<<Process constants: procedures>>=
	elemental module function process_constants_get_n_tot (prc_const) result (n_tot)
	integer :: n_tot
	class(process_constants_t), intent(in) :: prc_const
	n_tot = prc_const%n_in + prc_const%n_out
	end function process_constants_get_n_tot

	@ %def process_constants_get_n_tot
	@
	<<Process constants: process constants: TBP>>=
	procedure :: get_flv_state => process_constants_get_flv_state
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_get_flv_state (prc_const, flv_state)
	class(process_constants_t), intent(in) :: prc_const
	integer, dimension(:,:), allocatable, intent(out) :: flv_state
	end subroutine process_constants_get_flv_state
	<<Process constants: procedures>>=
	module subroutine process_constants_get_flv_state (prc_const, flv_state)
	class(process_constants_t), intent(in) :: prc_const
	integer, dimension(:,:), allocatable, intent(out) :: flv_state
	allocate (flv_state (size (prc_const%flv_state, 1), &
	size (prc_const%flv_state, 2)))
	flv_state = prc_const%flv_state
	end subroutine process_constants_get_flv_state

	@ %def process_constants_get_flv_state
	@
	<<Process constants: process constants: TBP>>=
	procedure :: get_n_flv => process_constants_get_n_flv
	<<Process constants: sub interfaces>>=
	module function process_constants_get_n_flv (data) result (n_flv)
	integer :: n_flv
	class(process_constants_t), intent(in) :: data
	end function process_constants_get_n_flv
	<<Process constants: procedures>>=
	module function process_constants_get_n_flv (data) result (n_flv)
	integer :: n_flv
	class(process_constants_t), intent(in) :: data
	n_flv = data%n_flv
	end function process_constants_get_n_flv

	@ %def process_constants_get_n_flv
	@
	<<Process constants: process constants: TBP>>=
	procedure :: get_n_hel => process_constants_get_n_hel
	<<Process constants: sub interfaces>>=
	module function process_constants_get_n_hel (data) result (n_hel)
	integer :: n_hel
	class(process_constants_t), intent(in) :: data
	end function process_constants_get_n_hel
	<<Process constants: procedures>>=
	module function process_constants_get_n_hel (data) result (n_hel)
	integer :: n_hel
	class(process_constants_t), intent(in) :: data
	n_hel = data%n_hel
	end function process_constants_get_n_hel

	@ %def process_constants_get_n_flv
	@
	<<Process constants: process constants: TBP>>=
	procedure :: get_hel_state => process_constants_get_hel_state
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_get_hel_state (prc_const, hel_state)
	class(process_constants_t), intent(in) :: prc_const
	integer, dimension(:,:), allocatable, intent(out) :: hel_state
	end subroutine process_constants_get_hel_state
	<<Process constants: procedures>>=
	module subroutine process_constants_get_hel_state (prc_const, hel_state)
	class(process_constants_t), intent(in) :: prc_const
	integer, dimension(:,:), allocatable, intent(out) :: hel_state
	allocate (hel_state (size (prc_const%hel_state, 1), &
	size (prc_const%hel_state, 2)))
	hel_state = prc_const%hel_state
	end subroutine process_constants_get_hel_state

	@ %def process_constants_get_hel_state
	@
	<<Process constants: process constants: TBP>>=
	procedure :: get_col_state => process_constants_get_col_state
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_get_col_state (prc_const, col_state)
	class(process_constants_t), intent(in) :: prc_const
	integer, dimension(:,:,:), allocatable, intent(out) :: col_state
	end subroutine process_constants_get_col_state
	<<Process constants: procedures>>=
	module subroutine process_constants_get_col_state (prc_const, col_state)
	class(process_constants_t), intent(in) :: prc_const
	integer, dimension(:,:,:), allocatable, intent(out) :: col_state
	allocate (col_state (size (prc_const%col_state, 1), &
	size (prc_const%col_state, 2), size (prc_const%col_state, 3)))
	col_state = prc_const%col_state
	end subroutine process_constants_get_col_state

	@ %def process_constants_get_col_state
	@
	<<Process constants: process constants: TBP>>=
	procedure :: get_ghost_flag => process_constants_get_ghost_flag
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_get_ghost_flag (prc_const, ghost_flag)
	class(process_constants_t), intent(in) :: prc_const
	logical, dimension(:,:), allocatable, intent(out) :: ghost_flag
	end subroutine process_constants_get_ghost_flag
	<<Process constants: procedures>>=
	module subroutine process_constants_get_ghost_flag (prc_const, ghost_flag)
	class(process_constants_t), intent(in) :: prc_const
	logical, dimension(:,:), allocatable, intent(out) :: ghost_flag
	allocate (ghost_flag (size (prc_const%ghost_flag, 1), &
	size (prc_const%ghost_flag, 2)))
	ghost_flag = prc_const%ghost_flag
	end subroutine process_constants_get_ghost_flag

	@ %def process_constants_get_ghost_flag
	@
	<<Process constants: process constants: TBP>>=
	procedure :: get_color_factors => process_constants_get_color_factors
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_get_color_factors (prc_const, col_facts)
	class(process_constants_t), intent(in) :: prc_const
	complex(default), dimension(:), allocatable, intent(out) :: col_facts
	end subroutine process_constants_get_color_factors
	<<Process constants: procedures>>=
	module subroutine process_constants_get_color_factors (prc_const, col_facts)
	class(process_constants_t), intent(in) :: prc_const
	complex(default), dimension(:), allocatable, intent(out) :: col_facts
	allocate (col_facts (size (prc_const%color_factors)))
	col_facts = prc_const%color_factors
	end subroutine process_constants_get_color_factors

	@ %def process_constants_get_color_factors
	@
	<<Process constants: process constants: TBP>>=
	procedure :: get_cf_index => process_constants_get_cf_index
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_get_cf_index (prc_const, cf_index)
	class(process_constants_t), intent(in) :: prc_const
	integer, intent(out), dimension(:,:), allocatable :: cf_index
	end subroutine process_constants_get_cf_index
	<<Process constants: procedures>>=
	module subroutine process_constants_get_cf_index (prc_const, cf_index)
	class(process_constants_t), intent(in) :: prc_const
	integer, intent(out), dimension(:,:), allocatable :: cf_index
	allocate (cf_index (size (prc_const%cf_index, 1), &
	size (prc_const%cf_index, 2)))
	cf_index = prc_const%cf_index
	end subroutine process_constants_get_cf_index

	@ %def process_constants_get_cf_index
	@
	<<Process constants: process constants: TBP>>=
	procedure :: set_flv_state => process_constants_set_flv_state
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_set_flv_state (prc_const, flv_state)
	class(process_constants_t), intent(inout) :: prc_const
	integer, intent(in), dimension(:,:), allocatable :: flv_state
	end subroutine process_constants_set_flv_state
	<<Process constants: procedures>>=
	module subroutine process_constants_set_flv_state (prc_const, flv_state)
	class(process_constants_t), intent(inout) :: prc_const
	integer, intent(in), dimension(:,:), allocatable :: flv_state
	if (allocated (prc_const%flv_state)) deallocate (prc_const%flv_state)
	allocate (prc_const%flv_state (size (flv_state, 1), &
	size (flv_state, 2)))
	prc_const%flv_state = flv_state
	prc_const%n_flv = size (flv_state, 2)
	end subroutine process_constants_set_flv_state

	@ %def process_constants_set_flv_state
	@
	<<Process constants: process constants: TBP>>=
	procedure :: set_col_state => process_constants_set_col_state
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_set_col_state (prc_const, col_state)
	class(process_constants_t), intent(inout) :: prc_const
	integer, intent(in), dimension(:,:,:), allocatable :: col_state
	end subroutine process_constants_set_col_state
	<<Process constants: procedures>>=
	module subroutine process_constants_set_col_state (prc_const, col_state)
	class(process_constants_t), intent(inout) :: prc_const
	integer, intent(in), dimension(:,:,:), allocatable :: col_state
	allocate (prc_const%col_state (size (col_state, 1), &
	size (col_state, 2), size (col_state, 3)))
	prc_const%col_state = col_state
	end subroutine process_constants_set_col_state

	@ %def process_constants_set_col_state
	@
	<<Process constants: process constants: TBP>>=
	procedure :: set_cf_index => process_constants_set_cf_index
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_set_cf_index (prc_const, cf_index)
	class(process_constants_t), intent(inout) :: prc_const
	integer, dimension(:,:), intent(in), allocatable :: cf_index
	end subroutine process_constants_set_cf_index
	<<Process constants: procedures>>=
	module subroutine process_constants_set_cf_index (prc_const, cf_index)
	class(process_constants_t), intent(inout) :: prc_const
	integer, dimension(:,:), intent(in), allocatable :: cf_index
	allocate (prc_const%cf_index (size (cf_index, 1), &
	size (cf_index, 2)))
	prc_const%cf_index = cf_index
	end subroutine process_constants_set_cf_index

	@ %def process_constants_set_cf_index
	@
	<<Process constants: process constants: TBP>>=
	procedure :: set_color_factors => process_constants_set_color_factors
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_set_color_factors (prc_const, color_factors)
	class(process_constants_t), intent(inout) :: prc_const
	complex(default), dimension(:), intent(in), allocatable :: color_factors
	end subroutine process_constants_set_color_factors
	<<Process constants: procedures>>=
	module subroutine process_constants_set_color_factors (prc_const, color_factors)
	class(process_constants_t), intent(inout) :: prc_const
	complex(default), dimension(:), intent(in), allocatable :: color_factors
	allocate (prc_const%color_factors (size (color_factors)))
	prc_const%color_factors = color_factors
	end subroutine process_constants_set_color_factors

	@ %def process_constants_set_color_factors
	@
	<<Process constants: process constants: TBP>>=
	procedure :: set_ghost_flag => process_constants_set_ghost_flag
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_set_ghost_flag (prc_const, ghost_flag)
	class(process_constants_t), intent(inout) :: prc_const
	logical, dimension(:,:), allocatable, intent(in) :: ghost_flag
	end subroutine process_constants_set_ghost_flag
	<<Process constants: procedures>>=
	module subroutine process_constants_set_ghost_flag (prc_const, ghost_flag)
	class(process_constants_t), intent(inout) :: prc_const
	logical, dimension(:,:), allocatable, intent(in) :: ghost_flag
	allocate (prc_const%ghost_flag (size (ghost_flag, 1), &
	size (ghost_flag, 2)))
	prc_const%ghost_flag = ghost_flag
	end subroutine process_constants_set_ghost_flag
	@ %def process_constants_set_ghost_flag
	@
	<<Process constants: process constants: TBP>>=
	procedure :: get_pdg_in => process_constants_get_pdg_in
	<<Process constants: sub interfaces>>=
	module function process_constants_get_pdg_in (prc_const) result (pdg_in)
	type(pdg_array_t), dimension(:), allocatable :: pdg_in
	class(process_constants_t), intent(in) :: prc_const
	end function process_constants_get_pdg_in
	<<Process constants: procedures>>=
	module function process_constants_get_pdg_in (prc_const) result (pdg_in)
	type(pdg_array_t), dimension(:), allocatable :: pdg_in
	class(process_constants_t), intent(in) :: prc_const
	type(pdg_array_t) :: pdg_tmp
	integer :: i
	allocate (pdg_in (prc_const%n_in))
	do i = 1, prc_const%n_in
	pdg_tmp = prc_const%flv_state(i,:)
	pdg_in(i) = sort_abs (pdg_tmp, unique = .true.)
	end do
	end function process_constants_get_pdg_in

	@ %def process_constants_get_pdg_in
	@
	<<Process constants: process constants: TBP>>=
	procedure :: compute_md5sum => process_constants_compute_md5sum
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_compute_md5sum (prc_const, include_id)
	class(process_constants_t), intent(inout) :: prc_const
	logical, intent(in) :: include_id
	end subroutine process_constants_compute_md5sum
	<<Process constants: procedures>>=
	module subroutine process_constants_compute_md5sum (prc_const, include_id)
	class(process_constants_t), intent(inout) :: prc_const
	logical, intent(in) :: include_id
	integer :: unit
	unit = prc_const%fill_unit_for_md5sum (include_id)
	rewind (unit)
	prc_const%md5sum = md5sum (unit)
	close (unit)
	end subroutine process_constants_compute_md5sum

	@ %process_constants_compute_md5sum
	@
	<<Process constants: process constants: TBP>>=
	procedure :: fill_unit_for_md5sum => process_constants_fill_unit_for_md5sum
	<<Process constants: sub interfaces>>=
	module function process_constants_fill_unit_for_md5sum &
	(prc_const, include_id) result (unit)
	integer :: unit
	class(process_constants_t), intent(in) :: prc_const
	logical, intent(in) :: include_id
	end function process_constants_fill_unit_for_md5sum
	<<Process constants: procedures>>=
	module function process_constants_fill_unit_for_md5sum &
	(prc_const, include_id) result (unit)
	integer :: unit
	class(process_constants_t), intent(in) :: prc_const
	logical, intent(in) :: include_id
	integer :: i, j, k
	unit = free_unit ()
	open (unit, status="scratch", action="readwrite")
	if (include_id) write (unit, '(A)') char (prc_const%id)
	write (unit, '(A)') char (prc_const%model_name)
	write (unit, '(L1)') prc_const%openmp_supported
	write (unit, '(I0)') prc_const%n_in
	write (unit, '(I0)') prc_const%n_out
	write (unit, '(I0)') prc_const%n_flv
	write (unit, '(I0)') prc_const%n_hel
	write (unit, '(I0)') prc_const%n_col
	write (unit, '(I0)') prc_const%n_cin
	write (unit, '(I0)') prc_const%n_cf
	do i = 1, size (prc_const%flv_state, dim=1)
	do j = 1, size (prc_const%flv_state, dim=2)
	write (unit, '(I0)') prc_const%flv_state (i, j)
	end do
	end do
	do i = 1, size (prc_const%hel_state, dim=1)
	do j = 1, size (prc_const%hel_state, dim=2)
	write (unit, '(I0)') prc_const%hel_state (i, j)
	end do
	end do
	do i = 1, size (prc_const%col_state, dim=1)
	do j = 1, size (prc_const%col_state, dim=2)
	do k = 1, size (prc_const%col_state, dim=3)
	write (unit, '(I0)') prc_const%col_state (i, j, k)
	end do
	end do
	end do
	do i = 1, size (prc_const%ghost_flag, dim=1)
	do j = 1, size (prc_const%ghost_flag, dim=2)
	write (unit, '(L1)') prc_const%ghost_flag (i, j)
	end do
	end do
	do i = 1, size (prc_const%color_factors)
	write (unit, '(F0.0,F0.0)') real (prc_const%color_factors(i)), &
	aimag (prc_const%color_factors(i))
	end do
	do i = 1, size (prc_const%cf_index, dim=1)
	do j = 1, size (prc_const%cf_index, dim=2)
	write (unit, '(I0)') prc_const%cf_index(i, j)
	end do
	end do
	end function process_constants_fill_unit_for_md5sum

	@ %def process_constants_fill_unit_for_md5sum
	@
	<<Process constants: process constants: TBP>>=
	procedure :: write => process_constants_write
	<<Process constants: sub interfaces>>=
	module subroutine process_constants_write (prc_const, unit)
	class(process_constants_t), intent(in) :: prc_const
	integer, intent(in), optional :: unit
	end subroutine process_constants_write
	<<Process constants: procedures>>=
	module subroutine process_constants_write (prc_const, unit)
	class(process_constants_t), intent(in) :: prc_const
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	write (u, "(1x,A,A)") "Process data of id: ", char (prc_const%id)
	write (u, "(1x,A,A)") "Associated model: ", char (prc_const%model_name)
	write (u, "(1x,A,I0)") "n_in: ", prc_const%n_in
	write (u, "(1x,A,I0)") "n_out: ", prc_const%n_out
	write (u, "(1x,A,I0)") "n_flv: ", prc_const%n_flv
	write (u, "(1x,A,I0)") "n_hel: ", prc_const%n_hel
	write (u, "(1x,A,I0)") "n_col: ", prc_const%n_col
	write (u, "(1x,A,I0)") "n_cin: ", prc_const%n_cin
	write (u, "(1x,A,I0)") "n_cf: ", prc_const%n_cf
	write (u, "(1x,A)") "Flavors: "
	do i = 1, prc_const%n_flv
	write (u, "(1x,A,I0)") "i_flv: ", i
	call write_integer_array (prc_const%flv_state (:,i))
	end do
	end subroutine process_constants_write

	@ %def process_constants_write
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process library interface}

	The module [[prclib_interfaces]] handles external matrix-element code.


	\subsection{Overview}
	The top-level data structure is the [[prclib_driver_t]] data type.
	The associated type-bound procedures deal with the generation of
	external code, compilation and linking, and accessing the active
	external library.

	An object of type [[prclib_driver_t]] consists of the following parts:
	\begin{enumerate}
	\item\ Metadata that identify name and status of the library driver,
	etc.
	\item\ An array of process records ([[prclib_driver_record_t]]), one
	for each external matrix element.
	\item\ A record of type [[dlaccess_t]] which handles the
	operating-system part of linking a dynamically loadable library.
	\item\ A collection of procedure pointers which have a counterpart in
	the external library interface. Given the unique identifier of a
	matrix element, the procedures retrieve generic matrix-element
	information such as the particle content and helicity combination
	tables. There is also a procedure which returns pointers to the
	more specific procedures that a matrix element provides, called
	\emph{features}.
	\end{enumerate}

	The process records of type [[prclib_driver_record_t]] handle the
	individual matrix elements. Each record identifies a process by name
	([[id]]), names the physics model to be loaded for this process, lists
	the features that the associated matrix-element code provides, and
	holds a [[writer]] object which handles all operations that depend on
	the process type. The numbering of process records is identical to
	the numbering of matrix-element codes in the external library.

	The writer object is of abstract type [[prc_writer_t]]. The module
	defines two basic, also abstract, extensions:
	[[prc_writer_f_module_t]] and [[prc_writer_c_lib_t]]. The first
	version is for matrix-element code that is available in form of
	Fortran modules. The writer contains type-bound procedures which
	create appropriate [[use]] directives and [[C]]-compatible wrapper
	functions for the given set of Fortran modules and their features.
	The second version is for matrix-element code that is available in
	form of a C-compatible library (this includes Fortran libraries with
	proper C bindings). The writer needs not write wrapper function, but
	explicit interface blocks for the matrix-element features.

	Each matrix-element variant is encoded in an appropriate extension of
	[[prc_writer_t]]. For instance, \oMega\ matrix elements provide an
	implementation [[omega_writer_t]] which extends
	[[prc_writer_f_module_t]].

	\subsection{Workflow}
	We expect that the functionality provided by this module is called in
	the following order:
	\begin{enumerate}
	\item
	The caller initializes the [[prclib_driver_t]] object and fills the
	array of [[prclib_record_t]] entries with the appropriate process
	data and process-specific writer objects.
	\item
	It calls the [[generate_makefile]] method to set up an appropriate
	makefile in the current directory. The makefile will handle source
	generation, compilation and linking both for the individual matrix
	elements (unless this has to be done manually) and for the common
	external driver code which interfaces those matrix element.
	\item
	The [[generate_driver_code]] writes the common driver as source code
	to file.
	\item
	The methods [[make_source]], [[make_compile]], and [[make_link]]
	individually perform the corresponding steps in building the
	library. Wherever possible, they simply use the generated makefile.
	By calling [[make]], we make sure that we can avoid
	unnecessary recompilation. For the
	compilation and linking steps, the makefile will employ [[libtool]].
	\item
	The [[load]] method loads the library procedures into the
	corresponding procedure pointers, using the [[dlopen]] mechanism via
	the [[dlaccess]] subobject.
	\end{enumerate}

	\subsection{The module}
	<<[[prclib_interfaces.f90]]>>=
	<<File header>>

	module prclib_interfaces

	use, intrinsic :: iso_c_binding !NODEP!

	use kinds
	<<Use strings>>
	use os_interface

	<<Standard module head>>

	<<Prclib interfaces: public>>

	<<Prclib interfaces: types>>

	<<Prclib interfaces: interfaces>>

	interface
	<<Prclib interfaces: sub interfaces>>
	end interface

	contains

	<<Prclib interfaces: main procedures>>

	end module prclib_interfaces
	@ %def prclib_interfaces
	@
	<<[[prclib_interfaces_sub.f90]]>>=
	<<File header>>

	submodule (prclib_interfaces) prclib_interfaces_s

	use io_units
	use system_defs, only: TAB
	use string_utils, only: lower_case
	use diagnostics

	implicit none

	contains

	<<Prclib interfaces: procedures>>

	end submodule prclib_interfaces_s

	@ %def prclib_interfaces_s
	@
	\subsection{Writers}
	External matrix element code provides externally visible procedures,
	which we denote as \emph{features}. The features consist of
	informational subroutines and functions which are mandatory (universal
	features) and matrix-element specific subroutines and functions
	(specific features). The driver interfaces the
	generic features directly, while it returns the specific features in
	form of bind(C) procedure pointers to the caller. For instance,
	function [[n_in]] is generic, while the matrix matrix-element value
	itself is specific.

	To implement these tasks, the driver needs [[use]] directives for
	Fortran module procedures, interface blocks for other external stuff,
	wrapper code, and Makefile snippets.

	\subsubsection{Generic writer}
	In the [[prc_writer_t]] data type, we collect the procedures which
	implement the writing tasks. The type is abstract. The
	concrete implementations are defined by an extension which is specific
	for the process type.

	The MD5 sum stored here should be the MD5 checksum of the current process
	component, which can be calculated once the process is configured completely.
	It can be used by implementations which work with external files, such as
	\oMega.
	<<Prclib interfaces: public>>=
	public :: prc_writer_t
	<<Prclib interfaces: types>>=
	type, abstract :: prc_writer_t
	character(32) :: md5sum = ""
	contains
	<<Prclib interfaces: prc writer: TBP>>
	end type prc_writer_t

	@ %def prc_writer_t
	@ In any case, it is useful to have a string representation of the
	writer type. This must be implemented by all extensions.
	<<Prclib interfaces: prc writer: TBP>>=
	procedure(get_const_string), nopass, deferred :: type_name
	<<Prclib interfaces: interfaces>>=
	abstract interface
	function get_const_string () result (string)
	import
	type(string_t) :: string
	end function get_const_string
	end interface

	@ %def get_const_string
	@ Return the name of a procedure that implements a given feature, as
	it is provided by the external matrix-element code. For a reasonable
	default, we take the feature name unchanged. Due to a bug of bind(C)
	features with submodules in gfortran 7/8/9 (and maybe together with
	MPI) this needs to be in the module, not the submodule.
	<<Prclib interfaces: prc writer: TBP>>=
	procedure, nopass :: get_procname => prc_writer_get_procname
	<<Prclib interfaces: main procedures>>=
	function prc_writer_get_procname (feature) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: feature
	name = feature
	end function prc_writer_get_procname

	@ %def prc_writer_get_procname
	@ Return the name of a procedure that implements a given feature with
	the bind(C) property, so it can be accessed via a C procedure pointer and
	handled by dlopen. We need this for all special features of a matrix
	element, since the interface has to return a C function pointer for it.
	For a default implementation, we prefix the external procedure name by
	the process ID. Due to a bug of bind(C) features with submodules in
	gfortran 7/8/9 (and maybe together with MPI) this needs to be in the
	module, not the submodule.
	<<Prclib interfaces: prc writer: TBP>>=
	procedure :: get_c_procname => prc_writer_get_c_procname
	<<Prclib interfaces: main procedures>>=
	function prc_writer_get_c_procname (writer, id, feature) result (name)
	class(prc_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id, feature
	type(string_t) :: name
	name = id // "_" // feature
	end function prc_writer_get_c_procname

	@ %def get_c_procname
	@ Common signature of code-writing procedures. The procedure may
	use the process ID, and the feature name.
	(Not necessarily all of them.)
	<<Prclib interfaces: interfaces>>=
	abstract interface
	subroutine write_code_file (writer, id)
	import
	class(prc_writer_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine write_code_file
	end interface

	abstract interface
	subroutine write_code (writer, unit, id)
	import
	class(prc_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	end subroutine write_code
	end interface

	abstract interface
	subroutine write_code_os &
	(writer, unit, id, os_data, verbose, testflag)
	import
	class(prc_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	end subroutine write_code_os
	end interface

	abstract interface
	subroutine write_feature_code (writer, unit, id, feature)
	import
	class(prc_writer_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	end subroutine write_feature_code
	end interface

	@ %def write_code write_feature_code
	@ There must be a procedure which writes an interface block for a
	given feature. If the external matrix element is implemented as a
	Fortran module, this is required only for the specific features which
	are returned as procedure pointers.
	<<Prclib interfaces: prc writer: TBP>>=
	procedure(write_feature_code), deferred :: write_interface
	@ %def write_interface
	@ There must also be a procedure which writes Makefile code which is
	specific for the current process, but not the feature.
	<<Prclib interfaces: prc writer: TBP>>=
	procedure(write_code_os), deferred :: write_makefile_code
	@ %def write_makefile_code
	@ This procedure writes code process-specific source-code file
	(which need not be Fortran). It is called before [[make]] [[source]] is
	called. It may be a no-op, if the source code is
	generated by Make instead.
	<<Prclib interfaces: prc writer: TBP>>=
	procedure(write_code_file), deferred :: write_source_code
	@ %def write_source_code
	@ This procedure is executed, once for each process, before (after)
	[[make]] [[compile]] is called, respectively.
	<<Prclib interfaces: prc writer: TBP>>=
	procedure(write_code_file), deferred :: before_compile
	procedure(write_code_file), deferred :: after_compile
	@ %def before_compile
	@ %def after_compile
	@
	\subsubsection{Writer for Fortran-module matrix elements}
	If the matrix element is available as a Fortran module, we have
	specific requirements: (i) the features are imported via [[use]]
	directives, (ii) the specific features require bind(C) wrappers.

	The type is still abstract, all methods must be implemented explicitly
	for a specific matrix-element variant.
	<<Prclib interfaces: public>>=
	public :: prc_writer_f_module_t
	<<Prclib interfaces: types>>=
	type, extends (prc_writer_t), abstract :: prc_writer_f_module_t
	contains
	<<Prclib interfaces: prc writer f module: TBP>>
	end type prc_writer_f_module_t

	@ %def prc_writer_f_module_t
	@ Return the name of the Fortran module. As a default implementation,
	we take the process ID unchanged. Due to a bug of bind(C) features
	with submodules in gfortran 7/8/9 (and maybe together with MPI) this
	needs to be in the module, not the submodule.
	<<Prclib interfaces: prc writer f module: TBP>>=
	procedure, nopass :: get_module_name => prc_writer_get_module_name
	<<Prclib interfaces: main procedures>>=
	function prc_writer_get_module_name (id) result (name)
	type(string_t) :: name
	type(string_t), intent(in) :: id
	name = id
	end function prc_writer_get_module_name

	@ %def prc_writer_get_module_name
	@ Write a [[use]] directive that associates the driver reference with
	the procedure in the matrix element code. By default, we use the C
	name for this.
	<<Prclib interfaces: prc writer f module: TBP>>=
	procedure :: write_use_line => prc_writer_write_use_line
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prc_writer_write_use_line (writer, unit, id, feature)
	class(prc_writer_f_module_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t) :: id, feature
	end subroutine prc_writer_write_use_line
	<<Prclib interfaces: procedures>>=
	module subroutine prc_writer_write_use_line (writer, unit, id, feature)
	class(prc_writer_f_module_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t) :: id, feature
	write (unit, "(2x,9A)") "use ", char (writer%get_module_name (id)), &
	", only: ", char (writer%get_c_procname (id, feature)), &
	" => ", char (writer%get_procname (feature))
	end subroutine prc_writer_write_use_line

	@ %def prc_writer_write_use_line
	@ Write a wrapper routine for a feature. This also associates a C
	name the module procedure. The details depend on the writer variant.
	<<Prclib interfaces: prc writer f module: TBP>>=
	procedure(prc_write_wrapper), deferred :: write_wrapper
	<<Prclib interfaces: interfaces>>=
	abstract interface
	subroutine prc_write_wrapper (writer, unit, id, feature)
	import
	class(prc_writer_f_module_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	end subroutine prc_write_wrapper
	end interface

	@ %def prc_write_wrapper
	@ This is used for testing only: initialize the writer with a specific MD5 sum
	string.
	<<Prclib interfaces: prc writer: TBP>>=
	procedure :: init_test => prc_writer_init_test
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prc_writer_init_test (writer)
	class(prc_writer_t), intent(out) :: writer
	end subroutine prc_writer_init_test
	<<Prclib interfaces: procedures>>=
	module subroutine prc_writer_init_test (writer)
	class(prc_writer_t), intent(out) :: writer
	writer%md5sum = "1234567890abcdef1234567890abcdef"
	end subroutine prc_writer_init_test

	@ %def prc_writer_init_test
	@
	\subsubsection{Writer for C-library matrix elements}
	This applies if the matrix element is available as a C library or a Fortran
	library with bind(C) compatible interface. We can use the basic
	version.

	The type is still abstract, all methods must be implemented explicitly
	for a specific matrix-element variant.
	<<Prclib interfaces: public>>=
	public :: prc_writer_c_lib_t
	<<Prclib interfaces: types>>=
	type, extends (prc_writer_t), abstract :: prc_writer_c_lib_t
	contains
	<<Prclib interfaces: prc writer c lib: TBP>>
	end type prc_writer_c_lib_t

	@ %def prc_writer_c_lib_t
	@
	\subsection{Process records in the library driver}
	A process record holds the process (component) [[ID]], the physics
	[[model_name]], and the array of [[feature]]s that are
	implemented by the corresponding matrix element code.

	The [[writer]] component holds procedures. The procedures write
	source code for the current record, either for the driver or for the
	Makefile.
	<<Prclib interfaces: types>>=
	type :: prclib_driver_record_t
	type(string_t) :: id
	type(string_t) :: model_name
	type(string_t), dimension(:), allocatable :: feature
	class(prc_writer_t), pointer :: writer => null ()
	contains
	<<Prclib interfaces: prclib driver record: TBP>>
	end type prclib_driver_record_t

	@ %def prclib_driver_record
	@ Output routine. We indent the output, so it smoothly integrates
	into the output routine for the whole driver.

	Note: the pointer [[writer]] is introduced as a workaround for a NAG compiler
	bug.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: write => prclib_driver_record_write
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_record_write (object, unit)
	class(prclib_driver_record_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine prclib_driver_record_write
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_record_write (object, unit)
	class(prclib_driver_record_t), intent(in) :: object
	integer, intent(in) :: unit
	integer :: j
	class(prc_writer_t), pointer :: writer
	write (unit, "(3x,A,2x,'[',A,']')") &
	char (object%id), char (object%model_name)
	if (allocated (object%feature)) then
	writer => object%writer
	write (unit, "(5x,A,A)", advance="no") &
	char (writer%type_name ()), ":"
	do j = 1, size (object%feature)
	write (unit, "(1x,A)", advance="no") &
	char (object%feature(j))
	end do
	write (unit, *)
	end if
	end subroutine prclib_driver_record_write

	@ %def prclib_driver_record_write
	@ Get the C procedure name for a feature. Due to a bug of bind(C)
	features with submodules in gfortran 7/8/9 (and maybe together with
	MPI) this needs to be in the module, not the submodule.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: get_c_procname => prclib_driver_record_get_c_procname
	<<Prclib interfaces: main procedures>>=
	function prclib_driver_record_get_c_procname (record, feature) result (name)
	type(string_t) :: name
	class(prclib_driver_record_t), intent(in) :: record
	type(string_t), intent(in) :: feature
	name = record%writer%get_c_procname (record%id, feature)
	end function prclib_driver_record_get_c_procname

	@ %def prclib_driver_record_get_c_procname
	@ Write a USE directive for a given feature. Applies only if the
	record corresponds to a Fortran module.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: write_use_line => prclib_driver_record_write_use_line
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_record_write_use_line (record, unit, feature)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	type(string_t), intent(in) :: feature
	end subroutine prclib_driver_record_write_use_line
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_record_write_use_line (record, unit, feature)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	type(string_t), intent(in) :: feature
	select type (writer => record%writer)
	class is (prc_writer_f_module_t)
	call writer%write_use_line (unit, record%id, feature)
	end select
	end subroutine prclib_driver_record_write_use_line

	@ %def prclib_driver_record_write_use_line
	@ The alternative: write an interface block for a given feature,
	unless the record corresponds to a Fortran module.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: write_interface => prclib_driver_record_write_interface
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_record_write_interface (record, unit, feature)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	type(string_t), intent(in) :: feature
	end subroutine prclib_driver_record_write_interface
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_record_write_interface (record, unit, feature)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	type(string_t), intent(in) :: feature
	select type (writer => record%writer)
	class is (prc_writer_f_module_t)
	class default
	call writer%write_interface (unit, record%id, feature)
	end select
	end subroutine prclib_driver_record_write_interface

	@ %def prclib_driver_record_write_use_line
	@ Write all special feature interfaces for the current record. Do
	this for all process variants.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: write_interfaces => prclib_driver_record_write_interfaces
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_record_write_interfaces (record, unit)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	end subroutine prclib_driver_record_write_interfaces
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_record_write_interfaces (record, unit)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	integer :: i
	do i = 1, size (record%feature)
	call record%writer%write_interface (unit, record%id, record%feature(i))
	end do
	end subroutine prclib_driver_record_write_interfaces

	@ %def prclib_driver_record_write_interfaces
	@ Write the wrapper routines for this record, if it corresponds to a
	Fortran module.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: write_wrappers => prclib_driver_record_write_wrappers
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_record_write_wrappers (record, unit)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	end subroutine prclib_driver_record_write_wrappers
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_record_write_wrappers (record, unit)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	integer :: i
	select type (writer => record%writer)
	class is (prc_writer_f_module_t)
	do i = 1, size (record%feature)
	call writer%write_wrapper (unit, record%id, record%feature(i))
	end do
	end select
	end subroutine prclib_driver_record_write_wrappers

	@ %def prclib_driver_record_write_wrappers
	@ Write the Makefile code for this record.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: write_makefile_code => prclib_driver_record_write_makefile_code
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_record_write_makefile_code &
	(record, unit, os_data, verbose, testflag)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	end subroutine prclib_driver_record_write_makefile_code
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_record_write_makefile_code &
	(record, unit, os_data, verbose, testflag)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	call record%writer%write_makefile_code &
	(unit, record%id, os_data, verbose, testflag)
	end subroutine prclib_driver_record_write_makefile_code

	@ %def prclib_driver_record_write_makefile_code
	@ Write source-code files for this record. This can be used as an alternative
	to handling source code via Makefile. In fact, this procedure is executed
	before [[make]] [[source]] is called. Usually, does nothing.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: write_source_code => prclib_driver_record_write_source_code
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_record_write_source_code (record)
	class(prclib_driver_record_t), intent(in) :: record
	end subroutine prclib_driver_record_write_source_code
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_record_write_source_code (record)
	class(prclib_driver_record_t), intent(in) :: record
	call record%writer%write_source_code (record%id)
	end subroutine prclib_driver_record_write_source_code

	@ %def prclib_driver_record_write_source_code
	@ Execute commands for this record that depend on the sources, so they
	cannot be included in the previous procedure. This procedure is
	executed before (after) [[make]] [[compile]] is called, respectively.
	Usually, does nothing.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: before_compile => prclib_driver_record_before_compile
	procedure :: after_compile => prclib_driver_record_after_compile
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_record_before_compile (record)
	class(prclib_driver_record_t), intent(in) :: record
	end subroutine prclib_driver_record_before_compile
	module subroutine prclib_driver_record_after_compile (record)
	class(prclib_driver_record_t), intent(in) :: record
	end subroutine prclib_driver_record_after_compile
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_record_before_compile (record)
	class(prclib_driver_record_t), intent(in) :: record
	call record%writer%before_compile (record%id)
	end subroutine prclib_driver_record_before_compile

	module subroutine prclib_driver_record_after_compile (record)
	class(prclib_driver_record_t), intent(in) :: record
	call record%writer%after_compile (record%id)
	end subroutine prclib_driver_record_after_compile

	@ %def prclib_driver_record_before_compile
	@ %def prclib_driver_record_after_compile
	@
	\subsection{The process library driver object}
	A [[prclib_driver_t]] object provides the interface to external matrix element
	code. The code is provided by an external library which is either
	statically or dynamically linked.

	The dynamic and static versions of the library are two different
	implementations of the abstract base type.

	The [[basename]] identifies the library, both by file names and by Fortran
	variable names.

	The [[loaded]] flag becomes true once all procedure pointers to the
	matrix element have been assigned.

	For a dynamical external library, the communication proceeds via a
	[[dlaccess]] object.

	[[n_processes]] is the number of external process code components that
	are referenced by this library. The code is addressed by index ([[i_lib]]
	in the process library entry above). This number should be equal to
	the number returned by [[get_n_prc]].

	For each external process, there is a separate [[record]] which holds
	the data that are needed for the driver parts which are specific
	for a given process component. The actual pointers for the loaded
	library will be assigned elsewhere.

	The remainder is a collection of procedure pointers, which can be
	assigned once all external code has been compiled and linked.
	The procedure pointers all take a process component code
	index as an argument. Most return information about the process
	component that should match the process definition. The [[get_fptr]]
	procedures return a function pointer, which is the actual means to
	compute matrix elements or retrieve associated data.

	Finally, the [[unload_hook]] and [[reload_hook]] pointers allow for
	the insertion of additional code when a library is loaded.
	<<Prclib interfaces: public>>=
	public :: prclib_driver_t
	<<Prclib interfaces: types>>=
	type, abstract :: prclib_driver_t
	type(string_t) :: basename
	character(32) :: md5sum = ""
	logical :: loaded = .false.
	type(string_t) :: libname
	type(string_t) :: modellibs_ldflags
	integer :: n_processes = 0
	type(prclib_driver_record_t), dimension(:), allocatable :: record
	procedure(prc_get_n_processes), nopass, pointer :: &
	get_n_processes => null ()
	procedure(prc_get_stringptr), nopass, pointer :: &
	get_process_id_ptr => null ()
	procedure(prc_get_stringptr), nopass, pointer :: &
	get_model_name_ptr => null ()
	procedure(prc_get_stringptr), nopass, pointer :: &
	get_md5sum_ptr => null ()
	procedure(prc_get_log), nopass, pointer :: &
	get_openmp_status => null ()
	procedure(prc_get_int), nopass, pointer :: get_n_in => null ()
	procedure(prc_get_int), nopass, pointer :: get_n_out => null ()
	procedure(prc_get_int), nopass, pointer :: get_n_flv => null ()
	procedure(prc_get_int), nopass, pointer :: get_n_hel => null ()
	procedure(prc_get_int), nopass, pointer :: get_n_col => null ()
	procedure(prc_get_int), nopass, pointer :: get_n_cin => null ()
	procedure(prc_get_int), nopass, pointer :: get_n_cf => null ()
	procedure(prc_set_int_tab1), nopass, pointer :: &
	set_flv_state_ptr => null ()
	procedure(prc_set_int_tab1), nopass, pointer :: &
	set_hel_state_ptr => null ()
	procedure(prc_set_col_state), nopass, pointer :: &
	set_col_state_ptr => null ()
	procedure(prc_set_color_factors), nopass, pointer :: &
	set_color_factors_ptr => null ()
	procedure(prc_get_fptr), nopass, pointer :: get_fptr => null ()
	contains
	<<Prclib interfaces: prclib driver: TBP>>
	end type prclib_driver_t

	@ %def prclib_driver_t
	@ This is the dynamic version. It contains a [[dlaccess]] object for
	communicating with the OS.
	<<Prclib interfaces: public>>=
	public :: prclib_driver_dynamic_t
	<<Prclib interfaces: types>>=
	type, extends (prclib_driver_t) :: prclib_driver_dynamic_t
	type(dlaccess_t) :: dlaccess
	contains
	<<Prclib interfaces: prclib driver dynamic: TBP>>
	end type prclib_driver_dynamic_t

	@ %def prclib_driver_dynamic_t
	@ Print just the metadata. Procedure pointers cannot be printed.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write => prclib_driver_write
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_write (object, unit, libpath)
	class(prclib_driver_t), intent(in) :: object
	integer, intent(in) :: unit
	logical, intent(in), optional :: libpath
	end subroutine prclib_driver_write
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_write (object, unit, libpath)
	class(prclib_driver_t), intent(in) :: object
	integer, intent(in) :: unit
	logical, intent(in), optional :: libpath
	logical :: write_lib
	integer :: i
	write_lib = .true.
	if (present (libpath)) write_lib = libpath
	write (unit, "(1x,A,A)") &
	"External matrix-element code library: ", char (object%basename)
	select type (object)
	type is (prclib_driver_dynamic_t)
	write (unit, "(3x,A,L1)") "static = F"
	class default
	write (unit, "(3x,A,L1)") "static = T"
	end select
	write (unit, "(3x,A,L1)") "loaded = ", object%loaded
	write (unit, "(3x,A,A,A)") "MD5 sum = '", object%md5sum, "'"
	if (write_lib) then
	write (unit, "(3x,A,A,A)") "Mdl flags = '", &
	char (object%modellibs_ldflags), "'"
	end if
	select type (object)
	type is (prclib_driver_dynamic_t)
	write (unit, *)
	call object%dlaccess%write (unit)
	end select
	write (unit, *)
	if (allocated (object%record)) then
	write (unit, "(1x,A)") "Matrix-element code entries:"
	do i = 1, object%n_processes
	call object%record(i)%write (unit)
	end do
	else
	write (unit, "(1x,A)") "Matrix-element code entries: [undefined]"
	end if
	end subroutine prclib_driver_write

	@ %def prclib_driver_write
	@ Allocate a library as either static or dynamic. For static
	libraries, the procedure defers control to an external procedure which
	knows about the available static libraries. By default, this
	procedure is empty, but when we build a stand-alone executable, we
	replace the dummy by an actual dispatcher for the available
	static libraries. If the static dispatcher was not successful, we
	allocate a dynamic library.

	The default version of [[dispatch_prclib_static]] resides in the
	[[prebuilt]] section of the \whizard\ tree, in a separate
	library. It does nothing, but can be replaced by a different
	procedure that allocates a static library driver if requested by name.
	Due to a bug of bind(C) features with submodules in gfortran 7/8/9
	(and maybe together with MPI) this needs to be in the module, not the
	submodule.
	<<Prclib interfaces: public>>=
	public :: dispatch_prclib_driver
	<<Prclib interfaces: main procedures>>=
	subroutine dispatch_prclib_driver &
	(driver, basename, modellibs_ldflags)
	class(prclib_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	type(string_t), intent(in), optional :: modellibs_ldflags
	procedure(dispatch_prclib_driver) :: dispatch_prclib_static
	if (allocated (driver)) deallocate (driver)
	call dispatch_prclib_static (driver, basename)
	if (.not. allocated (driver)) then
	allocate (prclib_driver_dynamic_t :: driver)
	end if
	driver%basename = basename
	driver%modellibs_ldflags = modellibs_ldflags
	end subroutine dispatch_prclib_driver

	@ %def dispatch_prclib_driver
	@ Initialize the ID array and set [[n_processes]] accordingly.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: init => prclib_driver_init
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_init (driver, n_processes)
	class(prclib_driver_t), intent(inout) :: driver
	integer, intent(in) :: n_processes
	end subroutine prclib_driver_init
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_init (driver, n_processes)
	class(prclib_driver_t), intent(inout) :: driver
	integer, intent(in) :: n_processes
	driver%n_processes = n_processes
	allocate (driver%record (n_processes))
	end subroutine prclib_driver_init

	@ %def prclib_driver_init
	@ Set the MD5 sum. This is separate because the MD5 sum may be known only
	after initialization.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: set_md5sum => prclib_driver_set_md5sum
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_set_md5sum (driver, md5sum)
	class(prclib_driver_t), intent(inout) :: driver
	character(32), intent(in) :: md5sum
	end subroutine prclib_driver_set_md5sum
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_set_md5sum (driver, md5sum)
	class(prclib_driver_t), intent(inout) :: driver
	character(32), intent(in) :: md5sum
	driver%md5sum = md5sum
	end subroutine prclib_driver_set_md5sum

	@ %def prclib_driver_set_md5sum
	@ Set the process record for a specific library entry. If the index
	is zero, we do nothing.

	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: set_record => prclib_driver_set_record
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_set_record (driver, i, &
	id, model_name, features, writer)
	class(prclib_driver_t), intent(inout) :: driver
	integer, intent(in) :: i
	type(string_t), intent(in) :: id
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: features
	class(prc_writer_t), intent(in), pointer :: writer
	end subroutine prclib_driver_set_record
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_set_record (driver, i, &
	id, model_name, features, writer)
	class(prclib_driver_t), intent(inout) :: driver
	integer, intent(in) :: i
	type(string_t), intent(in) :: id
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: features
	class(prc_writer_t), intent(in), pointer :: writer
	if (i > 0) then
	associate (record => driver%record(i))
	record%id = id
	record%model_name = model_name
	allocate (record%feature (size (features)))
	record%feature = features
	record%writer => writer
	end associate
	end if
	end subroutine prclib_driver_set_record

	@ %def prclib_driver_set_record
	@ Write all USE directives for a given feature, scanning the array of
	processes. Only Fortran-module processes count. Then, write
	interface blocks for the remaining processes.

	The [[implicit none]] statement must go in-between.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write_interfaces => prclib_driver_write_interfaces
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_write_interfaces (driver, unit, feature)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: feature
	end subroutine prclib_driver_write_interfaces
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_write_interfaces (driver, unit, feature)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: feature
	integer :: i
	do i = 1, driver%n_processes
	call driver%record(i)%write_use_line (unit, feature)
	end do
	write (unit, "(2x,9A)") "implicit none"
	do i = 1, driver%n_processes
	call driver%record(i)%write_interface (unit, feature)
	end do
	end subroutine prclib_driver_write_interfaces

	@ %def prclib_driver_write_interfaces
	@
	\subsection{Write makefile}
	The makefile contains constant parts, parts that depend on the library
	name, and parts that depend on the specific processes and their types.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: generate_makefile => prclib_driver_generate_makefile
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_generate_makefile (driver, unit, os_data, verbose, testflag)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	end subroutine prclib_driver_generate_makefile
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_generate_makefile (driver, unit, os_data, verbose, testflag)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	integer :: i
	write (unit, "(A)") "# WHIZARD: Makefile for process library '" &
	// char (driver%basename) // "'"
	write (unit, "(A)") "# Automatically generated file, do not edit"
	write (unit, "(A)") ""
	write (unit, "(A)") "# Integrity check (don't modify the following line!)"
	write (unit, "(A)") "MD5SUM = '" // driver%md5sum // "'"
	write (unit, "(A)") ""
	write (unit, "(A)") "# Library name"
	write (unit, "(A)") "BASE = " // char (driver%basename)
	write (unit, "(A)") ""
	write (unit, "(A)") "# Compiler"
	write (unit, "(A)") "FC = " // char (os_data%fc)
	write (unit, "(A)") "CC = " // char (os_data%cc)
	write (unit, "(A)") ""
	write (unit, "(A)") "# Included libraries"
	write (unit, "(A)") "FCINCL = " // char (os_data%whizard_includes)
	write (unit, "(A)") ""
	write (unit, "(A)") "# Compiler flags"
	write (unit, "(A)") "FCFLAGS = " // char (os_data%fcflags)
	write (unit, "(A)") "FCFLAGS_PIC = " // char (os_data%fcflags_pic)
	write (unit, "(A)") "CFLAGS = " // char (os_data%cflags)
	write (unit, "(A)") "CFLAGS_PIC = " // char (os_data%cflags_pic)
	write (unit, "(A)") "LDFLAGS = " // char (os_data%whizard_ldflags) &
	// " " // char (os_data%ldflags) // " " // &
	char (driver%modellibs_ldflags)
	write (unit, "(A)") ""
	write (unit, "(A)") "# LaTeX setup"
	write (unit, "(A)") "LATEX = " // char (os_data%latex)
	write (unit, "(A)") "MPOST = " // char (os_data%mpost)
	write (unit, "(A)") "DVIPS = " // char (os_data%dvips)
	write (unit, "(A)") "PS2PDF = " // char (os_data%ps2pdf)
	- write (unit, "(A)") 'TEX_FLAGS = "$$TEXINPUTS:' // &
	- char(os_data%whizard_texpath) // '"'
	- write (unit, "(A)") 'MP_FLAGS = "$$MPINPUTS:' // &
	- char(os_data%whizard_texpath) // '"'
	+ write (unit, "(A)") 'TEX_FLAGS = "' // char(os_data%whizard_texpath) &
	+ // ':$$TEXINPUTS"'
	+ write (unit, "(A)") 'MP_FLAGS = "' // char(os_data%whizard_texpath) &
	+ // ':$$MPINPUTS"'
	write (unit, "(A)") ""
	write (unit, "(A)") "# Libtool"
	write (unit, "(A)") "LIBTOOL = " // char (os_data%whizard_libtool)
	if (verbose) then
	write (unit, "(A)") "FCOMPILE = $(LIBTOOL) --tag=FC --mode=compile"
	write (unit, "(A)") "CCOMPILE = $(LIBTOOL) --tag=CC --mode=compile"
	write (unit, "(A)") "LINK = $(LIBTOOL) --tag=FC --mode=link"
	else
	write (unit, "(A)") "FCOMPILE = @$(LIBTOOL) --silent --tag=FC --mode=compile"
	write (unit, "(A)") "CCOMPILE = @$(LIBTOOL) --silent --tag=CC --mode=compile"
	write (unit, "(A)") "LINK = @$(LIBTOOL) --silent --tag=FC --mode=link"
	end if
	write (unit, "(A)") ""
	write (unit, "(A)") "# Compile commands (default)"
	write (unit, "(A)") "LTFCOMPILE = $(FCOMPILE) $(FC) -c &
	&$(FCINCL) $(FCFLAGS) $(FCFLAGS_PIC)"
	write (unit, "(A)") "LTCCOMPILE = $(CCOMPILE) $(CC) -c &
	&$(CFLAGS) $(CFLAGS_PIC)"
	write (unit, "(A)") ""
	write (unit, "(A)") "# Default target"
	write (unit, "(A)") "all: link diags"
	write (unit, "(A)") ""
	write (unit, "(A)") "# Matrix-element code files"
	do i = 1, size (driver%record)
	call driver%record(i)%write_makefile_code (unit, os_data, verbose, testflag)
	end do
	write (unit, "(A)") ""
	write (unit, "(A)") "# Library driver"
	write (unit, "(A)") "$(BASE).lo: $(BASE).f90 $(OBJECTS)"
	write (unit, "(A)") TAB // "$(LTFCOMPILE) $<"
	if (.not. verbose) then
	write (unit, "(A)") TAB // '@echo " FC " $@'
	end if
	write (unit, "(A)") ""
	write (unit, "(A)") "# Library"
	write (unit, "(A)") "$(BASE).la: $(BASE).lo $(OBJECTS)"
	if (.not. verbose) then
	write (unit, "(A)") TAB // '@echo " FCLD " $@'
	end if
	write (unit, "(A)") TAB // "$(LINK) $(FC) -module -rpath /dev/null &
	&$(FCFLAGS) $(LDFLAGS) -o $(BASE).la $^"
	write (unit, "(A)") ""
	write (unit, "(A)") "# Main targets"
	write (unit, "(A)") "link: compile $(BASE).la"
	write (unit, "(A)") "compile: source $(OBJECTS) $(TEX_OBJECTS) $(BASE).lo"
	write (unit, "(A)") "compile_tex: $(TEX_OBJECTS)"
	write (unit, "(A)") "source: $(SOURCES) $(BASE).f90 $(TEX_SOURCES)"
	write (unit, "(A)") ".PHONY: link diags compile compile_tex source"
	write (unit, "(A)") ""
	write (unit, "(A)") "# Specific cleanup targets"
	do i = 1, size (driver%record)
	write (unit, "(A)") "clean-" // char (driver%record(i)%id) // ":"
	write (unit, "(A)") ".PHONY: clean-" // char (driver%record(i)%id)
	end do
	write (unit, "(A)") ""
	write (unit, "(A)") "# Generic cleanup targets"
	write (unit, "(A)") "clean-library:"
	if (verbose) then
	write (unit, "(A)") TAB // "rm -f $(BASE).la"
	else
	write (unit, "(A)") TAB // '@echo " RM $(BASE).la"'
	write (unit, "(A)") TAB // "@rm -f $(BASE).la"
	end if
	write (unit, "(A)") "clean-objects:"
	if (verbose) then
	write (unit, "(A)") TAB // "rm -f $(BASE).lo $(BASE)_driver.mod &
	&$(CLEAN_OBJECTS)"
	else
	write (unit, "(A)") TAB // '@echo " RM $(BASE).lo &
	&$(BASE)_driver.mod $(CLEAN_OBJECTS)"'
	write (unit, "(A)") TAB // "@rm -f $(BASE).lo $(BASE)_driver.mod &
	&$(CLEAN_OBJECTS)"
	end if
	write (unit, "(A)") "clean-source:"
	if (verbose) then
	write (unit, "(A)") TAB // "rm -f $(CLEAN_SOURCES)"
	else
	write (unit, "(A)") TAB // '@echo " RM $(CLEAN_SOURCES)"'
	write (unit, "(A)") TAB // "@rm -f $(CLEAN_SOURCES)"
	end if
	write (unit, "(A)") "clean-driver:"
	if (verbose) then
	write (unit, "(A)") TAB // "rm -f $(BASE).f90"
	else
	write (unit, "(A)") TAB // '@echo " RM $(BASE).f90"'
	write (unit, "(A)") TAB // "@rm -f $(BASE).f90"
	end if
	write (unit, "(A)") "clean-makefile:"
	if (verbose) then
	write (unit, "(A)") TAB // "rm -f $(BASE).makefile"
	else
	write (unit, "(A)") TAB // '@echo " RM $(BASE).makefile"'
	write (unit, "(A)") TAB // "@rm -f $(BASE).makefile"
	end if
	write (unit, "(A)") ".PHONY: clean-library clean-objects &
	&clean-source clean-driver clean-makefile"
	write (unit, "(A)") ""
	write (unit, "(A)") "clean: clean-library clean-objects clean-source"
	write (unit, "(A)") "distclean: clean clean-driver clean-makefile"
	write (unit, "(A)") ".PHONY: clean distclean"
	end subroutine prclib_driver_generate_makefile

	@ %def prclib_driver_generate_makefile
	@
	\subsection{Write driver file}
	This procedure writes the process library driver source code to the
	specified output unit. The individual routines for writing
	source-code procedures are given below.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: generate_driver_code => prclib_driver_generate_code
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_generate_code (driver, unit)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	end subroutine prclib_driver_generate_code
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_generate_code (driver, unit)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t) :: prefix
	integer :: i

	prefix = driver%basename // "_"

	write (unit, "(A)") "! WHIZARD matrix-element code interface"
	write (unit, "(A)") "!"
	write (unit, "(A)") "! Automatically generated file, do not edit"
	call driver%write_module (unit, prefix)
	call driver%write_lib_md5sum_fun (unit, prefix)
	call driver%write_get_n_processes_fun (unit, prefix)
	call driver%write_get_process_id_fun (unit, prefix)
	call driver%write_get_model_name_fun (unit, prefix)
	call driver%write_get_md5sum_fun (unit, prefix)
	call driver%write_string_to_array_fun (unit, prefix)
	call driver%write_get_openmp_status_fun (unit, prefix)
	call driver%write_get_int_fun (unit, prefix, var_str ("n_in"))
	call driver%write_get_int_fun (unit, prefix, var_str ("n_out"))
	call driver%write_get_int_fun (unit, prefix, var_str ("n_flv"))
	call driver%write_get_int_fun (unit, prefix, var_str ("n_hel"))
	call driver%write_get_int_fun (unit, prefix, var_str ("n_col"))
	call driver%write_get_int_fun (unit, prefix, var_str ("n_cin"))
	call driver%write_get_int_fun (unit, prefix, var_str ("n_cf"))
	call driver%write_set_int_sub (unit, prefix, var_str ("flv_state"))
	call driver%write_set_int_sub (unit, prefix, var_str ("hel_state"))
	call driver%write_set_col_state_sub (unit, prefix)
	call driver%write_set_color_factors_sub (unit, prefix)
	call driver%write_get_fptr_sub (unit, prefix)
	do i = 1, driver%n_processes
	call driver%record(i)%write_wrappers (unit)
	end do
	end subroutine prclib_driver_generate_code

	@ %def prclib_driver_generate_code
	@ The driver module is used and required \emph{only} if we intend to
	link the library statically. Then, it provides the (static) driver
	type as a concrete implementation of the abstract library driver.
	This type contains the internal dispatcher for assigning the library
	procedures to their appropriate procedure pointers. In the dynamical
	case, the assignment is done via the base-type dispatcher which invokes
	the DL mechanism.

	However, compiling this together with the rest in any case should not
	do any harm.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure, nopass :: write_module => prclib_driver_write_module
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_write_module (unit, prefix)
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	end subroutine prclib_driver_write_module
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_write_module (unit, prefix)
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	write (unit, "(A)") ""
	write (unit, "(A)") "! Module: define library driver as an extension &
	&of the abstract driver type."
	write (unit, "(A)") "! This is used _only_ by the library dispatcher &
	&of a static executable."
	write (unit, "(A)") "! For a dynamical library, the stand-alone proce&
	&dures are linked via libdl."
	write (unit, "(A)") ""
	write (unit, "(A)") "module " &
	// char (prefix) // "driver"
	write (unit, "(A)") " use iso_c_binding"
	write (unit, "(A)") " use iso_varying_string, string_t => varying_string"
	write (unit, "(A)") " use diagnostics"
	write (unit, "(A)") " use prclib_interfaces"
	write (unit, "(A)") ""
	write (unit, "(A)") " implicit none"
	write (unit, "(A)") ""
	write (unit, "(A)") " type, extends (prclib_driver_t) :: " &
	// char (prefix) // "driver_t"
	write (unit, "(A)") " contains"
	write (unit, "(A)") " procedure :: get_c_funptr => " &
	// char (prefix) // "driver_get_c_funptr"
	write (unit, "(A)") " end type " &
	// char (prefix) // "driver_t"
	write (unit, "(A)") ""
	write (unit, "(A)") "contains"
	write (unit, "(A)") ""
	write (unit, "(A)") " function " &
	// char (prefix) // "driver_get_c_funptr (driver, feature) result &
	&(c_fptr)"
	write (unit, "(A)") " class(" &
	// char (prefix) // "driver_t), intent(inout) :: driver"
	write (unit, "(A)") " type(string_t), intent(in) :: feature"
	write (unit, "(A)") " type(c_funptr) :: c_fptr"
	call write_decl ("get_n_processes", "get_n_processes")
	call write_decl ("get_stringptr", "get_process_id_ptr")
	call write_decl ("get_stringptr", "get_model_name_ptr")
	call write_decl ("get_stringptr", "get_md5sum_ptr")
	call write_decl ("get_log", "get_openmp_status")
	call write_decl ("get_int", "get_n_in")
	call write_decl ("get_int", "get_n_out")
	call write_decl ("get_int", "get_n_flv")
	call write_decl ("get_int", "get_n_hel")
	call write_decl ("get_int", "get_n_col")
	call write_decl ("get_int", "get_n_cin")
	call write_decl ("get_int", "get_n_cf")
	call write_decl ("set_int_tab1", "set_flv_state_ptr")
	call write_decl ("set_int_tab1", "set_hel_state_ptr")
	call write_decl ("set_col_state", "set_col_state_ptr")
	call write_decl ("set_color_factors", "set_color_factors_ptr")
	call write_decl ("get_fptr", "get_fptr")
	write (unit, "(A)") " select case (char (feature))"
	call write_case ("get_n_processes")
	call write_case ("get_process_id_ptr")
	call write_case ("get_model_name_ptr")
	call write_case ("get_md5sum_ptr")
	call write_case ("get_openmp_status")
	call write_case ("get_n_in")
	call write_case ("get_n_out")
	call write_case ("get_n_flv")
	call write_case ("get_n_hel")
	call write_case ("get_n_col")
	call write_case ("get_n_cin")
	call write_case ("get_n_cf")
	call write_case ("set_flv_state_ptr")
	call write_case ("set_hel_state_ptr")
	call write_case ("set_col_state_ptr")
	call write_case ("set_color_factors_ptr")
	call write_case ("get_fptr")
	write (unit, "(A)") " case default"
	write (unit, "(A)") " call msg_bug ('prclib2 driver setup: unknown &
	&function name')"
	write (unit, "(A)") " end select"
	write (unit, "(A)") " end function " &
	// char (prefix) // "driver_get_c_funptr"
	write (unit, "(A)") ""
	write (unit, "(A)") "end module " &
	// char (prefix) // "driver"
	write (unit, "(A)") ""
	write (unit, "(A)") "! Stand-alone external procedures: used for both &
	&static and dynamic linkage"
	contains
	subroutine write_decl (template, feature)
	character(*), intent(in) :: template, feature
	write (unit, "(A)") " procedure(prc_" // template // ") &"
	write (unit, "(A)") " :: " &
	// char (prefix) // feature
	end subroutine write_decl
	subroutine write_case (feature)
	character(*), intent(in) :: feature
	write (unit, "(A)") " case ('" // feature // "')"
	write (unit, "(A)") " c_fptr = c_funloc (" &
	// char (prefix) // feature // ")"
	end subroutine write_case
	end subroutine prclib_driver_write_module

	@ %def prclib_driver_write_module
	@ This function provides the overall library MD5sum. The function is for
	internal use (therefore not bind(C)), the external interface is via the
	[[get_md5sum_ptr]] procedure with index 0.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write_lib_md5sum_fun => prclib_driver_write_lib_md5sum_fun
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_write_lib_md5sum_fun (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	end subroutine prclib_driver_write_lib_md5sum_fun
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_write_lib_md5sum_fun (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	write (unit, "(A)") ""
	write (unit, "(A)") "! The MD5 sum of the library"
	write (unit, "(A)") "function " // char (prefix) &
	// "md5sum () result (md5sum)"
	write (unit, "(A)") " implicit none"
	write (unit, "(A)") " character(32) :: md5sum"
	write (unit, "(A)") " md5sum = '" // driver%md5sum // "'"
	write (unit, "(A)") "end function " // char (prefix) // "md5sum"
	end subroutine prclib_driver_write_lib_md5sum_fun

	@ %def prclib_driver_write_lib_md5sum_fun
	@
	\subsection{Interface bodies for informational functions}
	These interfaces implement the communication between WHIZARD (the main
	program) and the process-library driver. The procedures are all
	BIND(C), so they can safely be exposed by the library and handled by
	the [[dlopen]] mechanism, which apparently understands only C calling
	conventions.

	In the sections below, for each procedure, we provide both the
	interface itself and a procedure that writes the correponding
	procedure as source code to the process library driver.

	\subsubsection{Process count}
	Return the number of processes contained in the library.
	<<Prclib interfaces: public>>=
	public :: prc_get_n_processes
	<<Prclib interfaces: interfaces>>=
	abstract interface
	function prc_get_n_processes () result (n) bind(C)
	import
	integer(c_int) :: n
	end function prc_get_n_processes
	end interface
	@ %def prc_get_n_processes
	@ Here is the code.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write_get_n_processes_fun
	<<Prclib interfaces: sub interfaces>>=
	module subroutine write_get_n_processes_fun (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	end subroutine write_get_n_processes_fun
	<<Prclib interfaces: procedures>>=
	module subroutine write_get_n_processes_fun (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	write (unit, "(A)") ""
	write (unit, "(A)") "! Return the number of processes in this library"
	write (unit, "(A)") "function " // char (prefix) &
	// "get_n_processes () result (n) bind(C)"
	write (unit, "(A)") " use iso_c_binding"
	write (unit, "(A)") " implicit none"
	write (unit, "(A)") " integer(c_int) :: n"
	write (unit, "(A,I0)") " n = ", driver%n_processes
	write (unit, "(A)") "end function " // char (prefix) &
	// "get_n_processes"
	end subroutine write_get_n_processes_fun

	@ %def write_get_n_processes_fun
	@
	\subsubsection{Informational string functions}
	These functions return constant information about the matrix-element
	code.

	The following procedures have to return strings. With the BIND(C)
	constraint, we choose to return the C pointer to a string, and its
	length, so the procedures implement this interface. They are actually
	subroutines.
	<<Prclib interfaces: public>>=
	public :: prc_get_stringptr
	<<Prclib interfaces: interfaces>>=
	abstract interface
	subroutine prc_get_stringptr (i, cptr, len) bind(C)
	import
	integer(c_int), intent(in) :: i
	type(c_ptr), intent(out) :: cptr
	integer(c_int), intent(out) :: len
	end subroutine prc_get_stringptr
	end interface
	@ %def prc_get_stringptr
	@ To hide this complication, we introduce a subroutine that converts the
	returned C pointer to a [[string_t]] object. As a side effect, we
	deallocate the original after conversion -- otherwise, we might have a
	memory leak.

	For the conversion, we first pointer-convert the C pointer to a
	Fortran character array pointer, length 1 and size [[len]]. Using
	argument association and an internal subroutine, we convert this to a
	character array with length [[len]] and size 1. Using ordinary
	assignment, we finally convert this to [[string_t]].

	The function takes the pointer-returning function as an argument. The
	index [[i]] identifies the process in the library.
	<<Prclib interfaces: procedures>>=
	subroutine get_string_via_cptr (string, i, get_stringptr)
	type(string_t), intent(out) :: string
	integer, intent(in) :: i
	procedure(prc_get_stringptr) :: get_stringptr
	type(c_ptr) :: cptr
	integer(c_int) :: pid, len
	character(kind=c_char), dimension(:), pointer :: c_array
	pid = i
	call get_stringptr (pid, cptr, len)
	if (c_associated (cptr)) then
	call c_f_pointer (cptr, c_array, shape = [len])
	call set_string (c_array)
	call get_stringptr (0_c_int, cptr, len)
	else
	string = ""
	end if
	contains
	subroutine set_string (buffer)
	character(len, kind=c_char), dimension(1), intent(in) :: buffer
	string = buffer(1)
	end subroutine set_string
	end subroutine get_string_via_cptr

	@ %def get_string_via_cptr
	@ Since the module procedures return Fortran strings, we have to
	convert them. This is the necessary auxiliary routine. The routine
	is not BIND(C), it is not accessed from outside.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure, nopass :: write_string_to_array_fun
	<<Prclib interfaces: sub interfaces>>=
	module subroutine write_string_to_array_fun (unit, prefix)
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	end subroutine write_string_to_array_fun
	<<Prclib interfaces: procedures>>=
	module subroutine write_string_to_array_fun (unit, prefix)
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	write (unit, "(A)") ""
	write (unit, "(A)") "! Auxiliary: convert character string &
	&to array pointer"
	write (unit, "(A)") "subroutine " // char (prefix) &
	// "string_to_array (string, a)"
	write (unit, "(A)") " use iso_c_binding"
	write (unit, "(A)") " implicit none"
	write (unit, "(A)") " character(*), intent(in) :: string"
	write (unit, "(A)") " character(kind=c_char), dimension(:), &
	&allocatable, intent(out) :: a"
	write (unit, "(A)") " integer :: i"
	write (unit, "(A)") " allocate (a (len (string)))"
	write (unit, "(A)") " do i = 1, size (a)"
	write (unit, "(A)") " a(i) = string(i:i)"
	write (unit, "(A)") " end do"
	write (unit, "(A)") "end subroutine " // char (prefix) &
	// "string_to_array"
	end subroutine write_string_to_array_fun

	@ %def write_string_to_array_fun
	@ The above routine is called by other functions. It is not in a
	module, so they need its interface explicitly.
	<<Prclib interfaces: procedures>>=
	subroutine write_string_to_array_interface (unit, prefix)
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	write (unit, "(2x,A)") "interface"
	write (unit, "(2x,A)") " subroutine " // char (prefix) &
	// "string_to_array (string, a)"
	write (unit, "(2x,A)") " use iso_c_binding"
	write (unit, "(2x,A)") " implicit none"
	write (unit, "(2x,A)") " character(*), intent(in) :: string"
	write (unit, "(2x,A)") " character(kind=c_char), dimension(:), &
	&allocatable, intent(out) :: a"
	write (unit, "(2x,A)") " end subroutine " // char (prefix) &
	// "string_to_array"
	write (unit, "(2x,A)") "end interface"
	end subroutine write_string_to_array_interface

	@ %def write_string_to_array_interface
	@
	Here are the info functions which return strings, implementing the interface
	[[prc_get_stringptr]].

	Return the process ID for each process.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write_get_process_id_fun
	<<Prclib interfaces: sub interfaces>>=
	module subroutine write_get_process_id_fun (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	end subroutine write_get_process_id_fun
	<<Prclib interfaces: procedures>>=
	module subroutine write_get_process_id_fun (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	integer :: i
	write (unit, "(A)") ""
	write (unit, "(A)") "! Return the process ID of process #i &
	&(as a C pointer to a character array)"
	write (unit, "(A)") "subroutine " // char (prefix) &
	// "get_process_id_ptr (i, cptr, len) bind(C)"
	write (unit, "(A)") " use iso_c_binding"
	write (unit, "(A)") " implicit none"
	write (unit, "(A)") " integer(c_int), intent(in) :: i"
	write (unit, "(A)") " type(c_ptr), intent(out) :: cptr"
	write (unit, "(A)") " integer(c_int), intent(out) :: len"
	write (unit, "(A)") " character(kind=c_char), dimension(:), &
	&allocatable, target, save :: a"
	call write_string_to_array_interface (unit, prefix)
	write (unit, "(A)") " select case (i)"
	write (unit, "(A)") " case (0); if (allocated (a)) deallocate (a)"
	do i = 1, driver%n_processes
	write (unit, "(A,I0,9A)") " case (", i, "); ", &
	"call ", char (prefix), "string_to_array ('", &
	char (driver%record(i)%id), "', a)"
	end do
	write (unit, "(A)") " end select"
	write (unit, "(A)") " if (allocated (a)) then"
	write (unit, "(A)") " cptr = c_loc (a)"
	write (unit, "(A)") " len = size (a)"
	write (unit, "(A)") " else"
	write (unit, "(A)") " cptr = c_null_ptr"
	write (unit, "(A)") " len = 0"
	write (unit, "(A)") " end if"
	write (unit, "(A)") "end subroutine " // char (prefix) &
	// "get_process_id_ptr"
	end subroutine write_get_process_id_fun

	@ %def write_get_process_id_fun
	@ Return the model name, given explicitly.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write_get_model_name_fun
	<<Prclib interfaces: sub interfaces>>=
	module subroutine write_get_model_name_fun (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	end subroutine write_get_model_name_fun
	<<Prclib interfaces: procedures>>=
	module subroutine write_get_model_name_fun (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	integer :: i
	write (unit, "(A)") ""
	write (unit, "(A)") "! Return the model name for process #i &
	&(as a C pointer to a character array)"
	write (unit, "(A)") "subroutine " // char (prefix) &
	// "get_model_name_ptr (i, cptr, len) bind(C)"
	write (unit, "(A)") " use iso_c_binding"
	write (unit, "(A)") " implicit none"
	write (unit, "(A)") " integer(c_int), intent(in) :: i"
	write (unit, "(A)") " type(c_ptr), intent(out) :: cptr"
	write (unit, "(A)") " integer(c_int), intent(out) :: len"
	write (unit, "(A)") " character(kind=c_char), dimension(:), &
	&allocatable, target, save :: a"
	call write_string_to_array_interface (unit, prefix)
	write (unit, "(A)") " select case (i)"
	write (unit, "(A)") " case (0); if (allocated (a)) deallocate (a)"
	do i = 1, driver%n_processes
	write (unit, "(A,I0,9A)") " case (", i, "); ", &
	"call ", char (prefix), "string_to_array ('" , &
	char (driver%record(i)%model_name), &
	"', a)"
	end do
	write (unit, "(A)") " end select"
	write (unit, "(A)") " if (allocated (a)) then"
	write (unit, "(A)") " cptr = c_loc (a)"
	write (unit, "(A)") " len = size (a)"
	write (unit, "(A)") " else"
	write (unit, "(A)") " cptr = c_null_ptr"
	write (unit, "(A)") " len = 0"
	write (unit, "(A)") " end if"
	write (unit, "(A)") "end subroutine " // char (prefix) &
	// "get_model_name_ptr"
	end subroutine write_get_model_name_fun

	@ %def write_get_model_name_fun
	@ Call the MD5 sum function for the process. The function calls the
	corresponding function of the matrix-element code, and it returns the
	C address of a character array with length 32.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write_get_md5sum_fun
	<<Prclib interfaces: sub interfaces>>=
	module subroutine write_get_md5sum_fun (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	end subroutine write_get_md5sum_fun
	<<Prclib interfaces: procedures>>=
	module subroutine write_get_md5sum_fun (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	integer :: i
	write (unit, "(A)") ""
	write (unit, "(A)") "! Return the MD5 sum for the process configuration &
	&(as a C pointer to a character array)"
	write (unit, "(A)") "subroutine " // char (prefix) &
	// "get_md5sum_ptr (i, cptr, len) bind(C)"
	write (unit, "(A)") " use iso_c_binding"
	call driver%write_interfaces (unit, var_str ("md5sum"))
	write (unit, "(A)") " interface"
	write (unit, "(A)") " function " // char (prefix) &
	// "md5sum () result (md5sum)"
	write (unit, "(A)") " character(32) :: md5sum"
	write (unit, "(A)") " end function " // char (prefix) // "md5sum"
	write (unit, "(A)") " end interface"
	write (unit, "(A)") " integer(c_int), intent(in) :: i"
	write (unit, "(A)") " type(c_ptr), intent(out) :: cptr"
	write (unit, "(A)") " integer(c_int), intent(out) :: len"
	write (unit, "(A)") " character(kind=c_char), dimension(32), &
	&target, save :: md5sum"
	write (unit, "(A)") " select case (i)"
	write (unit, "(A)") " case (0)"
	!!! Workaround for Intel oneAPI 2022/23 regression
	! write (unit, "(A)") " call copy (" // char (prefix) // "md5sum ())"
	write (unit, "(A)") " call copy ((" // char (prefix) // "md5sum ()))"
	write (unit, "(A)") " cptr = c_loc (md5sum)"
	do i = 1, driver%n_processes
	write (unit, "(A,I0,A)") " case (", i, ")"
	call driver%record(i)%write_md5sum_call (unit)
	end do
	write (unit, "(A)") " case default"
	write (unit, "(A)") " cptr = c_null_ptr"
	write (unit, "(A)") " end select"
	write (unit, "(A)") " len = 32"
	write (unit, "(A)") "contains"
	write (unit, "(A)") " subroutine copy (md5sum_tmp)"
	write (unit, "(A)") " character, dimension(32), intent(in) :: &
	&md5sum_tmp"
	write (unit, "(A)") " md5sum = md5sum_tmp"
	write (unit, "(A)") " end subroutine copy"
	write (unit, "(A)") "end subroutine " // char (prefix) &
	// "get_md5sum_ptr"
	end subroutine write_get_md5sum_fun

	@ %def write_get_md5sum_fun
	@ The actual call depends on the type of matrix element.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: write_md5sum_call => prclib_driver_record_write_md5sum_call
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_record_write_md5sum_call (record, unit)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	end subroutine prclib_driver_record_write_md5sum_call
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_record_write_md5sum_call (record, unit)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	call record%writer%write_md5sum_call (unit, record%id)
	end subroutine prclib_driver_record_write_md5sum_call

	@ %def prclib_driver_record_write_md5sum_call
	@ The interface goes into the writer base type:
	<<Prclib interfaces: prc writer: TBP>>=
	procedure(write_code), deferred :: write_md5sum_call
	@ %def write_md5sum_call
	@ In the Fortran module case, we take a detour. The string returned
	by the Fortran function is copied into a fixed-size array. The copy
	routine is an internal subroutine of [[get_md5sum_ptr]]. We
	return the C address of the target array.
	<<Prclib interfaces: prc writer f module: TBP>>=
	procedure :: write_md5sum_call => prc_writer_f_module_write_md5sum_call
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prc_writer_f_module_write_md5sum_call (writer, unit, id)
	class(prc_writer_f_module_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	end subroutine prc_writer_f_module_write_md5sum_call
	<<Prclib interfaces: procedures>>=
	module subroutine prc_writer_f_module_write_md5sum_call (writer, unit, id)
	class(prc_writer_f_module_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	!!! Workaround for Intel oneAPI 2022/23 regression
	! write (unit, "(5x,9A)") "call copy (", &
	! char (writer%get_c_procname (id, var_str ("md5sum"))), " ())"
	write (unit, "(5x,9A)") "call copy ((", &
	char (writer%get_c_procname (id, var_str ("md5sum"))), " ()))"
	write (unit, "(5x,9A)") "cptr = c_loc (md5sum)"
	end subroutine prc_writer_f_module_write_md5sum_call

	@ %def prc_writer_f_module_write_md5sum_call
	@ In the C library case, the library function returns a C pointer,
	which we can just copy.
	<<Prclib interfaces: prc writer c lib: TBP>>=
	procedure :: write_md5sum_call => prc_writer_c_lib_write_md5sum_call
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prc_writer_c_lib_write_md5sum_call (writer, unit, id)
	class(prc_writer_c_lib_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	end subroutine prc_writer_c_lib_write_md5sum_call
	<<Prclib interfaces: procedures>>=
	module subroutine prc_writer_c_lib_write_md5sum_call (writer, unit, id)
	class(prc_writer_c_lib_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	write (unit, "(5x,9A)") &
	"cptr = ", &
	char (writer%get_c_procname (id, var_str ("get_md5sum"))), " ()"
	end subroutine prc_writer_c_lib_write_md5sum_call

	@ %def prc_writer_c_lib_write_md5sum_call
	@
	\subsubsection{Actual references to the info functions}
	The string-valued info functions return C character arrays. For the
	API of the library driver, we provide convenience functions which
	(re)convert those arrays into [[string_t]] objects.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: get_process_id => prclib_driver_get_process_id
	procedure :: get_model_name => prclib_driver_get_model_name
	procedure :: get_md5sum => prclib_driver_get_md5sum
	<<Prclib interfaces: sub interfaces>>=
	module function prclib_driver_get_process_id (driver, i) result (string)
	type(string_t) :: string
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	end function prclib_driver_get_process_id
	module function prclib_driver_get_model_name (driver, i) result (string)
	type(string_t) :: string
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	end function prclib_driver_get_model_name
	module function prclib_driver_get_md5sum (driver, i) result (string)
	type(string_t) :: string
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	end function prclib_driver_get_md5sum
	<<Prclib interfaces: procedures>>=
	module function prclib_driver_get_process_id (driver, i) result (string)
	type(string_t) :: string
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	call get_string_via_cptr (string, i, driver%get_process_id_ptr)
	end function prclib_driver_get_process_id

	module function prclib_driver_get_model_name (driver, i) result (string)
	type(string_t) :: string
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	call get_string_via_cptr (string, i, driver%get_model_name_ptr)
	end function prclib_driver_get_model_name

	module function prclib_driver_get_md5sum (driver, i) result (string)
	type(string_t) :: string
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	call get_string_via_cptr (string, i, driver%get_md5sum_ptr)
	end function prclib_driver_get_md5sum

	@ %def prclib_driver_get_process_id
	@ %def prclib_driver_get_model_name
	@ %def prclib_driver_get_md5sum
	@
	\subsubsection{Informational logical functions}
	When returning a logical value, we use the C boolean type, which
	may differ from Fortran.
	<<Prclib interfaces: public>>=
	public :: prc_get_log
	<<Prclib interfaces: interfaces>>=
	abstract interface
	function prc_get_log (pid) result (l) bind(C)
	import
	integer(c_int), intent(in) :: pid
	logical(c_bool) :: l
	end function prc_get_log
	end interface
	@ %def prc_get_log
	@ Return a logical flag which tells whether OpenMP is supported for a
	specific process code.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write_get_openmp_status_fun
	<<Prclib interfaces: sub interfaces>>=
	module subroutine write_get_openmp_status_fun (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	end subroutine write_get_openmp_status_fun
	<<Prclib interfaces: procedures>>=
	module subroutine write_get_openmp_status_fun (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	integer :: i
	write (unit, "(A)") ""
	write (unit, "(A)") "! Return the OpenMP support status"
	write (unit, "(A)") "function " // char (prefix) &
	// "get_openmp_status (i) result (openmp_status) bind(C)"
	write (unit, "(A)") " use iso_c_binding"
	call driver%write_interfaces (unit, var_str ("openmp_supported"))
	write (unit, "(A)") " integer(c_int), intent(in) :: i"
	write (unit, "(A)") " logical(c_bool) :: openmp_status"
	write (unit, "(A)") " select case (i)"
	do i = 1, driver%n_processes
	write (unit, "(A,I0,9A)") " case (", i, "); ", &
	"openmp_status = ", &
	char (driver%record(i)%get_c_procname &
	(var_str ("openmp_supported"))), " ()"
	end do
	write (unit, "(A)") " end select"
	write (unit, "(A)") "end function " // char (prefix) &
	// "get_openmp_status"
	end subroutine write_get_openmp_status_fun

	@ %def write_get_openmp_status_fun
	@
	\subsubsection{Informational integer functions}
	Various process metadata are integer values. We can use a single
	interface for all of them.
	<<Prclib interfaces: public>>=
	public :: prc_get_int
	<<Prclib interfaces: interfaces>>=
	abstract interface
	function prc_get_int (pid) result (n) bind(C)
	import
	integer(c_int), intent(in) :: pid
	integer(c_int) :: n
	end function prc_get_int
	end interface
	@ %def prc_get_int
	@ This function returns any data of type integer, for each process.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write_get_int_fun
	<<Prclib interfaces: sub interfaces>>=
	module subroutine write_get_int_fun (driver, unit, prefix, feature)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	type(string_t), intent(in) :: feature
	end subroutine write_get_int_fun
	<<Prclib interfaces: procedures>>=
	module subroutine write_get_int_fun (driver, unit, prefix, feature)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	type(string_t), intent(in) :: feature
	integer :: i
	write (unit, "(A)") ""
	write (unit, "(9A)") "! Return the value of ", char (feature)
	write (unit, "(9A)") "function ", char (prefix), &
	"get_", char (feature), " (pid)", &
	" result (", char (feature), ") bind(C)"
	write (unit, "(9A)") " use iso_c_binding"
	call driver%write_interfaces (unit, feature)
	write (unit, "(9A)") " integer(c_int), intent(in) :: pid"
	write (unit, "(9A)") " integer(c_int) :: ", char (feature)
	write (unit, "(9A)") " select case (pid)"
	do i = 1, driver%n_processes
	write (unit, "(2x,A,I0,9A)") "case (", i, "); ", &
	char (feature), " = ", &
	char (driver%record(i)%get_c_procname (feature)), &
	" ()"
	end do
	write (unit, "(9A)") " end select"
	write (unit, "(9A)") "end function ", char (prefix), &
	"get_", char (feature)
	end subroutine write_get_int_fun

	@ %def write_get_int_fun
	@ Write a [[case]] line that assigns the value of the external function
	to the current return value.
	<<Prclib interfaces: procedures>>=
	subroutine write_case_int_fun (record, unit, i, feature)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	integer, intent(in) :: i
	type(string_t), intent(in) :: feature
	write (unit, "(5x,A,I0,9A)") "case (", i, "); ", &
	char (feature), " = ", char (record%get_c_procname (feature))
	end subroutine write_case_int_fun

	@ %def write_case_int_fun
	@
	\subsubsection{Flavor and helicity tables}
	Transferring tables is more complicated. First, a two-dimensional array.
	<<Prclib interfaces: public>>=
	public :: prc_set_int_tab1
	<<Prclib interfaces: interfaces>>=
	abstract interface
	subroutine prc_set_int_tab1 (pid, tab, shape) bind(C)
	import
	integer(c_int), intent(in) :: pid
	integer(c_int), dimension(*), intent(out) :: tab
	integer(c_int), dimension(2), intent(in) :: shape
	end subroutine prc_set_int_tab1
	end interface
	@ %def prc_set_int_tab1
	@ This subroutine returns a table of integers.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write_set_int_sub
	<<Prclib interfaces: sub interfaces>>=
	module subroutine write_set_int_sub (driver, unit, prefix, feature)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	type(string_t), intent(in) :: feature
	end subroutine write_set_int_sub
	<<Prclib interfaces: procedures>>=
	module subroutine write_set_int_sub (driver, unit, prefix, feature)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	type(string_t), intent(in) :: feature
	integer :: i
	write (unit, "(A)") ""
	write (unit, "(9A)") "! Set table: ", char (feature)
	write (unit, "(9A)") "subroutine ", char (prefix), &
	"set_", char (feature), "_ptr (pid, ", char (feature), &
	", shape) bind(C)"
	write (unit, "(9A)") " use iso_c_binding"
	call driver%write_interfaces (unit, feature)
	write (unit, "(9A)") " integer(c_int), intent(in) :: pid"
	write (unit, "(9A)") " integer(c_int), dimension(*), intent(out) :: ", &
	char (feature)
	write (unit, "(9A)") " integer(c_int), dimension(2), intent(in) :: shape"
	write (unit, "(9A)") " integer, dimension(:,:), allocatable :: ", &
	char (feature), "_tmp"
	write (unit, "(9A)") " integer :: i, j"
	write (unit, "(9A)") " select case (pid)"
	do i = 1, driver%n_processes
	write (unit, "(2x,A,I0,A)") "case (", i, ")"
	call driver%record(i)%write_int_sub_call (unit, feature)
	end do
	write (unit, "(9A)") " end select"
	write (unit, "(9A)") "end subroutine ", char (prefix), &
	"set_", char (feature), "_ptr"
	end subroutine write_set_int_sub

	@ %def write_set_int_sub
	@ The actual call depends on the type of matrix element.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: write_int_sub_call => prclib_driver_record_write_int_sub_call
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_record_write_int_sub_call (record, unit, feature)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	type(string_t), intent(in) :: feature
	end subroutine prclib_driver_record_write_int_sub_call
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_record_write_int_sub_call (record, unit, feature)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	type(string_t), intent(in) :: feature
	call record%writer%write_int_sub_call (unit, record%id, feature)
	end subroutine prclib_driver_record_write_int_sub_call

	@ %def prclib_driver_record_write_int_sub_call
	@ The interface goes into the writer base type:
	<<Prclib interfaces: prc writer: TBP>>=
	procedure(write_feature_code), deferred :: write_int_sub_call
	@ %def write_int_sub_call
	@ In the Fortran module case, we need an extra copy in the
	(academical) situation where default integer and [[c_int]] differ.
	Otherwise, we just associate a Fortran array with the C pointer and
	let the matrix-element subroutine fill the array.
	<<Prclib interfaces: prc writer f module: TBP>>=
	procedure :: write_int_sub_call => prc_writer_f_module_write_int_sub_call
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prc_writer_f_module_write_int_sub_call (writer, unit, id, feature)
	class(prc_writer_f_module_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	end subroutine prc_writer_f_module_write_int_sub_call
	<<Prclib interfaces: procedures>>=
	module subroutine prc_writer_f_module_write_int_sub_call (writer, unit, id, feature)
	class(prc_writer_f_module_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	write (unit, "(5x,9A)") "allocate (", char (feature), "_tmp ", &
	"(shape(1), shape(2)))"
	write (unit, "(5x,9A)") "call ", &
	char (writer%get_c_procname (id, feature)), &
	" (", char (feature), "_tmp)"
	write (unit, "(5x,9A)") "forall (i=1:shape(1), j=1:shape(2)) "
	write (unit, "(8x,9A)") char (feature), "(i + shape(1)*(j-1)) = ", &
	char (feature), "_tmp", "(i,j)"
	write (unit, "(5x,9A)") "end forall"
	end subroutine prc_writer_f_module_write_int_sub_call

	@ %def prc_writer_f_module_write_int_sub_call
	@ In the C library case, we just transfer the C pointer to the library
	function.
	<<Prclib interfaces: prc writer c lib: TBP>>=
	procedure :: write_int_sub_call => prc_writer_c_lib_write_int_sub_call
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prc_writer_c_lib_write_int_sub_call (writer, unit, id, feature)
	class(prc_writer_c_lib_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	end subroutine prc_writer_c_lib_write_int_sub_call
	<<Prclib interfaces: procedures>>=
	module subroutine prc_writer_c_lib_write_int_sub_call (writer, unit, id, feature)
	class(prc_writer_c_lib_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	write (unit, "(5x,9A)") "call ", &
	char (writer%get_c_procname (id, feature)), " (", char (feature), ")"
	end subroutine prc_writer_c_lib_write_int_sub_call

	@ %def prc_writer_c_lib_write_int_sub_call
	@
	\subsubsection{Color state table}
	The color-state specification needs a table of integers (one array per
	color flow) and a corresponding array of color-ghost flags.
	<<Prclib interfaces: public>>=
	public :: prc_set_col_state
	<<Prclib interfaces: interfaces>>=
	abstract interface
	subroutine prc_set_col_state (pid, col_state, ghost_flag, shape) bind(C)
	import
	integer(c_int), intent(in) :: pid
	integer(c_int), dimension(*), intent(out) :: col_state
	logical(c_bool), dimension(*), intent(out) :: ghost_flag
	integer(c_int), dimension(3), intent(in) :: shape
	end subroutine prc_set_col_state
	end interface
	@ %def prc_set_int_tab2
	@
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write_set_col_state_sub
	<<Prclib interfaces: sub interfaces>>=
	module subroutine write_set_col_state_sub (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	end subroutine write_set_col_state_sub
	<<Prclib interfaces: procedures>>=
	module subroutine write_set_col_state_sub (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	integer :: i
	type(string_t) :: feature
	feature = "col_state"
	write (unit, "(A)") ""
	write (unit, "(9A)") "! Set tables: col_state, ghost_flag"
	write (unit, "(9A)") "subroutine ", char (prefix), &
	"set_col_state_ptr (pid, col_state, ghost_flag, shape) bind(C)"
	write (unit, "(9A)") " use iso_c_binding"
	call driver%write_interfaces (unit, feature)
	write (unit, "(9A)") " integer(c_int), intent(in) :: pid"
	write (unit, "(9A)") &
	" integer(c_int), dimension(*), intent(out) :: col_state"
	write (unit, "(9A)") &
	" logical(c_bool), dimension(*), intent(out) :: ghost_flag"
	write (unit, "(9A)") &
	" integer(c_int), dimension(3), intent(in) :: shape"
	write (unit, "(9A)") &
	" integer, dimension(:,:,:), allocatable :: col_state_tmp"
	write (unit, "(9A)") &
	" logical, dimension(:,:), allocatable :: ghost_flag_tmp"
	write (unit, "(9A)") " integer :: i, j, k"
	write (unit, "(A)") " select case (pid)"
	do i = 1, driver%n_processes
	write (unit, "(A,I0,A)") " case (", i, ")"
	call driver%record(i)%write_col_state_call (unit)
	end do
	write (unit, "(A)") " end select"
	write (unit, "(9A)") "end subroutine ", char (prefix), &
	"set_col_state_ptr"
	end subroutine write_set_col_state_sub

	@ %def write_set_col_state_sub
	@ The actual call depends on the type of matrix element.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: write_col_state_call => prclib_driver_record_write_col_state_call
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_record_write_col_state_call (record, unit)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	end subroutine prclib_driver_record_write_col_state_call
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_record_write_col_state_call (record, unit)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	call record%writer%write_col_state_call (unit, record%id)
	end subroutine prclib_driver_record_write_col_state_call

	@ %def prclib_driver_record_write_col_state_call
	@ The interface goes into the writer base type:
	<<Prclib interfaces: prc writer: TBP>>=
	procedure(write_code), deferred :: write_col_state_call
	@ %def write_col_state_call
	@ In the Fortran module case, we need an extra copy in the
	(academical) situation where default integer and [[c_int]] differ.
	Otherwise, we just associate a Fortran array with the C pointer and
	let the matrix-element subroutine fill the array.
	<<Prclib interfaces: prc writer f module: TBP>>=
	procedure :: write_col_state_call => prc_writer_f_module_write_col_state_call
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prc_writer_f_module_write_col_state_call (writer, unit, id)
	class(prc_writer_f_module_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	end subroutine prc_writer_f_module_write_col_state_call
	<<Prclib interfaces: procedures>>=
	module subroutine prc_writer_f_module_write_col_state_call (writer, unit, id)
	class(prc_writer_f_module_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	write (unit, "(9A)") " allocate (col_state_tmp ", &
	"(shape(1), shape(2), shape(3)))"
	write (unit, "(5x,9A)") "allocate (ghost_flag_tmp ", &
	"(shape(2), shape(3)))"
	write (unit, "(5x,9A)") "call ", &
	char (writer%get_c_procname (id, var_str ("col_state"))), &
	" (col_state_tmp, ghost_flag_tmp)"
	write (unit, "(5x,9A)") "forall (i = 1:shape(2), j = 1:shape(3))"
	write (unit, "(8x,9A)") "forall (k = 1:shape(1))"
	write (unit, "(11x,9A)") &
	"col_state(k + shape(1) * (i + shape(2)*(j-1) - 1)) ", &
	"= col_state_tmp(k,i,j)"
	write (unit, "(8x,9A)") "end forall"
	write (unit, "(8x,9A)") &
	"ghost_flag(i + shape(2)*(j-1)) = ghost_flag_tmp(i,j)"
	write (unit, "(5x,9A)") "end forall"
	end subroutine prc_writer_f_module_write_col_state_call

	@ %def prc_writer_f_module_write_col_state_call
	@ In the C library case, we just transfer the C pointer to the library
	function.
	<<Prclib interfaces: prc writer c lib: TBP>>=
	procedure :: write_col_state_call => prc_writer_c_lib_write_col_state_call
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prc_writer_c_lib_write_col_state_call (writer, unit, id)
	class(prc_writer_c_lib_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	end subroutine prc_writer_c_lib_write_col_state_call
	<<Prclib interfaces: procedures>>=
	module subroutine prc_writer_c_lib_write_col_state_call (writer, unit, id)
	class(prc_writer_c_lib_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	write (unit, "(5x,9A)") "call ", &
	char (writer%get_c_procname (id, var_str ("col_state"))), &
	" (col_state, ghost_flag)"
	end subroutine prc_writer_c_lib_write_col_state_call

	@ %def prc_writer_c_lib_write_col_state_call
	@
	\subsubsection{Color factors}
	For the color-factor information, we return two integer arrays and a
	complex array.
	<<Prclib interfaces: public>>=
	public :: prc_set_color_factors
	<<Prclib interfaces: interfaces>>=
	abstract interface
	subroutine prc_set_color_factors &
	(pid, cf_index1, cf_index2, color_factors, shape) bind(C)
	import
	integer(c_int), intent(in) :: pid
	integer(c_int), dimension(*), intent(out) :: cf_index1, cf_index2
	complex(c_default_complex), dimension(*), intent(out) :: color_factors
	integer(c_int), dimension(1), intent(in) :: shape
	end subroutine prc_set_color_factors
	end interface

	@ %def prc_set_color_factors
	@ This subroutine returns the color-flavor factor table.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write_set_color_factors_sub
	<<Prclib interfaces: sub interfaces>>=
	module subroutine write_set_color_factors_sub (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	end subroutine write_set_color_factors_sub
	<<Prclib interfaces: procedures>>=
	module subroutine write_set_color_factors_sub (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	integer :: i
	type(string_t) :: feature
	feature = "color_factors"
	write (unit, "(A)") ""
	write (unit, "(A)") "! Set tables: color factors"
	write (unit, "(9A)") "subroutine ", char (prefix), &
	"set_color_factors_ptr (pid, cf_index1, cf_index2, color_factors, ", &
	"shape) bind(C)"
	write (unit, "(A)") " use iso_c_binding"
	write (unit, "(A)") " use kinds"
	write (unit, "(A)") " use omega_color"
	call driver%write_interfaces (unit, feature)
	write (unit, "(A)") " integer(c_int), intent(in) :: pid"
	write (unit, "(A)") " integer(c_int), dimension(1), intent(in) :: shape"
	write (unit, "(A)") " integer(c_int), dimension(*), intent(out) :: &
	&cf_index1, cf_index2"
	write (unit, "(A)") " complex(c_default_complex), dimension(*), &
	&intent(out) :: color_factors"
	write (unit, "(A)") " type(omega_color_factor), dimension(:), &
	&allocatable :: cf"
	write (unit, "(A)") " select case (pid)"
	do i = 1, driver%n_processes
	write (unit, "(2x,A,I0,A)") "case (", i, ")"
	call driver%record(i)%write_color_factors_call (unit)
	end do
	write (unit, "(A)") " end select"
	write (unit, "(A)") "end subroutine " // char (prefix) &
	// "set_color_factors_ptr"
	end subroutine write_set_color_factors_sub

	@ %def write_set_color_factors_sub
	@ The actual call depends on the type of matrix element.
	<<Prclib interfaces: prclib driver record: TBP>>=
	procedure :: write_color_factors_call => prclib_driver_record_write_color_factors_call
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_record_write_color_factors_call (record, unit)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	end subroutine prclib_driver_record_write_color_factors_call
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_record_write_color_factors_call (record, unit)
	class(prclib_driver_record_t), intent(in) :: record
	integer, intent(in) :: unit
	call record%writer%write_color_factors_call (unit, record%id)
	end subroutine prclib_driver_record_write_color_factors_call

	@ %def prclib_driver_record_write_color_factors_call
	@ The interface goes into the writer base type:
	<<Prclib interfaces: prc writer: TBP>>=
	procedure(write_code), deferred :: write_color_factors_call
	@ %def write_color_factors_call
	@ In the Fortran module case, the matrix-element procedure fills an
	array of [[omega_color_factor]] elements. We distribute this array
	among two integer arrays and one complex-valued array, for which we
	have the C pointers.
	<<Prclib interfaces: prc writer f module: TBP>>=
	procedure :: write_color_factors_call => prc_writer_f_module_write_color_factors_call
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prc_writer_f_module_write_color_factors_call (writer, unit, id)
	class(prc_writer_f_module_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	end subroutine prc_writer_f_module_write_color_factors_call
	<<Prclib interfaces: procedures>>=
	module subroutine prc_writer_f_module_write_color_factors_call (writer, unit, id)
	class(prc_writer_f_module_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	write (unit, "(5x,A)") "allocate (cf (shape(1)))"
	write (unit, "(5x,9A)") "call ", &
	char (writer%get_c_procname (id, var_str ("color_factors"))), " (cf)"
	write (unit, "(5x,9A)") "cf_index1(1:shape(1)) = cf%i1"
	write (unit, "(5x,9A)") "cf_index2(1:shape(1)) = cf%i2"
	write (unit, "(5x,9A)") "color_factors(1:shape(1)) = cf%factor"
	end subroutine prc_writer_f_module_write_color_factors_call

	@ %def prc_writer_f_module_write_color_factors_call
	@ In the C library case, we just transfer the C pointers to the library
	function. There are three arrays.
	<<Prclib interfaces: prc writer c lib: TBP>>=
	procedure :: write_color_factors_call => &
	prc_writer_c_lib_write_color_factors_call
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prc_writer_c_lib_write_color_factors_call (writer, unit, id)
	class(prc_writer_c_lib_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	end subroutine prc_writer_c_lib_write_color_factors_call
	<<Prclib interfaces: procedures>>=
	module subroutine prc_writer_c_lib_write_color_factors_call (writer, unit, id)
	class(prc_writer_c_lib_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	write (unit, "(5x,9A)") "call ", &
	char (writer%get_c_procname (id, var_str ("color_factors"))), &
	" (cf_index1, cf_index2, color_factors)"
	end subroutine prc_writer_c_lib_write_color_factors_call

	@ %def prc_writer_c_lib_write_color_factors_call
	@
	\subsection{Interfaces for C-library matrix element}
	If the matrix element code is not provided as a Fortran module but as
	a C or bind(C) Fortran library, we need explicit interfaces for the
	library functions. They are not identical to the Fortran module
	versions. They transfer pointers directly.

	The implementation is part of the [[prc_writer_c_lib]] type, which
	serves as base type for all C-library writers. It writes specific
	interfaces depending on the feature.

	We bind this as the method [[write_standard_interface]] instead of
	[[write_interface]], because we have to override the latter.
	Otherwise we could not call the method because the writer type is
	abstract.
	<<Prclib interfaces: prc writer c lib: TBP>>=
	procedure :: write_standard_interface => prc_writer_c_lib_write_interface
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prc_writer_c_lib_write_interface (writer, unit, id, feature)
	class(prc_writer_c_lib_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	end subroutine prc_writer_c_lib_write_interface
	<<Prclib interfaces: procedures>>=
	module subroutine prc_writer_c_lib_write_interface (writer, unit, id, feature)
	class(prc_writer_c_lib_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	select case (char (feature))
	case ("md5sum")
	write (unit, "(2x,9A)") "interface"
	write (unit, "(5x,9A)") "function ", &
	char (writer%get_c_procname (id, var_str ("get_md5sum"))), &
	" () result (cptr) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "implicit none"
	write (unit, "(7x,9A)") "type(c_ptr) :: cptr"
	write (unit, "(5x,9A)") "end function ", &
	char (writer%get_c_procname (id, var_str ("get_md5sum")))
	write (unit, "(2x,9A)") "end interface"
	case ("openmp_supported")
	write (unit, "(2x,9A)") "interface"
	write (unit, "(5x,9A)") "function ", &
	char (writer%get_c_procname (id, feature)), &
	" () result (status) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "implicit none"
	write (unit, "(7x,9A)") "logical(c_bool) :: status"
	write (unit, "(5x,9A)") "end function ", &
	char (writer%get_c_procname (id, feature))
	write (unit, "(2x,9A)") "end interface"
	case ("n_in", "n_out", "n_flv", "n_hel", "n_col", "n_cin", "n_cf")
	write (unit, "(2x,9A)") "interface"
	write (unit, "(5x,9A)") "function ", &
	char (writer%get_c_procname (id, feature)), &
	" () result (n) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "implicit none"
	write (unit, "(7x,9A)") "integer(c_int) :: n"
	write (unit, "(5x,9A)") "end function ", &
	char (writer%get_c_procname (id, feature))
	write (unit, "(2x,9A)") "end interface"
	case ("flv_state", "hel_state")
	write (unit, "(2x,9A)") "interface"
	write (unit, "(5x,9A)") "subroutine ", &
	char (writer%get_c_procname (id, feature)), &
	" (", char (feature), ") bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "implicit none"
	write (unit, "(7x,9A)") "integer(c_int), dimension(*), intent(out) ", &
	":: ", char (feature)
	write (unit, "(5x,9A)") "end subroutine ", &
	char (writer%get_c_procname (id, feature))
	write (unit, "(2x,9A)") "end interface"
	case ("col_state")
	write (unit, "(2x,9A)") "interface"
	write (unit, "(5x,9A)") "subroutine ", &
	char (writer%get_c_procname (id, feature)), &
	" (col_state, ghost_flag) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "implicit none"
	write (unit, "(7x,9A)") "integer(c_int), dimension(*), intent(out) ", &
	":: col_state"
	write (unit, "(7x,9A)") "logical(c_bool), dimension(*), intent(out) ", &
	":: ghost_flag"
	write (unit, "(5x,9A)") "end subroutine ", &
	char (writer%get_c_procname (id, feature))
	write (unit, "(2x,9A)") "end interface"
	case ("color_factors")
	write (unit, "(2x,9A)") "interface"
	write (unit, "(5x,9A)") "subroutine ", &
	char (writer%get_c_procname (id, feature)), &
	" (cf_index1, cf_index2, color_factors) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "implicit none"
	write (unit, "(7x,9A)") "integer(c_int), dimension(*), &
	&intent(out) :: cf_index1"
	write (unit, "(7x,9A)") "integer(c_int), dimension(*), &
	&intent(out) :: cf_index2"
	write (unit, "(7x,9A)") "complex(c_default_complex), dimension(*), &
	&intent(out) :: color_factors"
	write (unit, "(5x,9A)") "end subroutine ", &
	char (writer%get_c_procname (id, feature))
	write (unit, "(2x,9A)") "end interface"
	end select
	end subroutine prc_writer_c_lib_write_interface

	@ %def prc_writer_c_lib_write_interface
	@
	\subsection{Retrieving the tables}
	In the previous section we had the writer routines for procedures that
	return tables, actually C pointers to tables. Here, we write
	convenience routines that unpack them and move the contents to
	suitable Fortran arrays.

	The flavor and helicity tables are two-dimensional integer arrays. We
	use intermediate storage for correctly transforming C to Fortran data
	types.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: set_flv_state => prclib_driver_set_flv_state
	procedure :: set_hel_state => prclib_driver_set_hel_state
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_set_flv_state (driver, i, flv_state)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	integer, dimension(:,:), allocatable, intent(out) :: flv_state
	end subroutine prclib_driver_set_flv_state
	module subroutine prclib_driver_set_hel_state (driver, i, hel_state)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	integer, dimension(:,:), allocatable, intent(out) :: hel_state
	end subroutine prclib_driver_set_hel_state
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_set_flv_state (driver, i, flv_state)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	integer, dimension(:,:), allocatable, intent(out) :: flv_state
	integer :: n_tot, n_flv
	integer(c_int) :: pid
	integer(c_int), dimension(:,:), allocatable :: c_flv_state
	pid = i
	n_tot = driver%get_n_in (pid) + driver%get_n_out (pid)
	n_flv = driver%get_n_flv (pid)
	allocate (flv_state (n_tot, n_flv))
	allocate (c_flv_state (n_tot, n_flv))
	call driver%set_flv_state_ptr &
	(pid, c_flv_state, int ([n_tot, n_flv], kind=c_int))
	flv_state = c_flv_state
	end subroutine prclib_driver_set_flv_state

	module subroutine prclib_driver_set_hel_state (driver, i, hel_state)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	integer, dimension(:,:), allocatable, intent(out) :: hel_state
	integer :: n_tot, n_hel
	integer(c_int) :: pid
	integer(c_int), dimension(:,:), allocatable, target :: c_hel_state
	pid = i
	n_tot = driver%get_n_in (pid) + driver%get_n_out (pid)
	n_hel = driver%get_n_hel (pid)
	allocate (hel_state (n_tot, n_hel))
	allocate (c_hel_state (n_tot, n_hel))
	call driver%set_hel_state_ptr &
	(pid, c_hel_state, int ([n_tot, n_hel], kind=c_int))
	hel_state = c_hel_state
	end subroutine prclib_driver_set_hel_state

	@ %def prclib_driver_set_flv_state
	@ %def prclib_driver_set_hel_state
	@ The color-flow table is three-dimensional, otherwise similar. We
	simultaneously set the ghost-flag table, which consists of logical
	entries.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: set_col_state => prclib_driver_set_col_state
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_set_col_state (driver, i, col_state, ghost_flag)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	integer, dimension(:,:,:), allocatable, intent(out) :: col_state
	logical, dimension(:,:), allocatable, intent(out) :: ghost_flag
	end subroutine prclib_driver_set_col_state
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_set_col_state (driver, i, col_state, ghost_flag)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	integer, dimension(:,:,:), allocatable, intent(out) :: col_state
	logical, dimension(:,:), allocatable, intent(out) :: ghost_flag
	integer :: n_cin, n_tot, n_col
	integer(c_int) :: pid
	integer(c_int), dimension(:,:,:), allocatable :: c_col_state
	logical(c_bool), dimension(:,:), allocatable :: c_ghost_flag
	pid = i
	n_cin = driver%get_n_cin (pid)
	n_tot = driver%get_n_in (pid) + driver%get_n_out (pid)
	n_col = driver%get_n_col (pid)
	allocate (col_state (n_cin, n_tot, n_col))
	allocate (c_col_state (n_cin, n_tot, n_col))
	allocate (ghost_flag (n_tot, n_col))
	allocate (c_ghost_flag (n_tot, n_col))
	call driver%set_col_state_ptr (pid, &
	c_col_state, c_ghost_flag, int ([n_cin, n_tot, n_col], kind=c_int))
	col_state = c_col_state
	ghost_flag = c_ghost_flag
	end subroutine prclib_driver_set_col_state

	@ %def prclib_driver_set_col_state
	@ The color-factor table is a sparse matrix: a two-column array of indices and
	one array which contains the corresponding factors.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: set_color_factors => prclib_driver_set_color_factors
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_set_color_factors (driver, i, color_factors, cf_index)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	complex(default), dimension(:), allocatable, intent(out) :: color_factors
	integer, dimension(:,:), allocatable, intent(out) :: cf_index
	end subroutine prclib_driver_set_color_factors
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_set_color_factors (driver, i, color_factors, cf_index)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	complex(default), dimension(:), allocatable, intent(out) :: color_factors
	integer, dimension(:,:), allocatable, intent(out) :: cf_index
	integer :: n_cf
	integer(c_int) :: pid
	complex(c_default_complex), dimension(:), allocatable, target :: c_color_factors
	integer(c_int), dimension(:), allocatable, target :: c_cf_index1
	integer(c_int), dimension(:), allocatable, target :: c_cf_index2
	pid = i
	n_cf = driver%get_n_cf (pid)
	allocate (color_factors (n_cf))
	allocate (c_color_factors (n_cf))
	allocate (c_cf_index1 (n_cf))
	allocate (c_cf_index2 (n_cf))
	call driver%set_color_factors_ptr (pid, &
	c_cf_index1, c_cf_index2, &
	c_color_factors, int ([n_cf], kind=c_int))
	color_factors = c_color_factors
	allocate (cf_index (2, n_cf))
	cf_index(1,:) = c_cf_index1
	cf_index(2,:) = c_cf_index2
	end subroutine prclib_driver_set_color_factors

	@ %def prclib_driver_set_color_factors
	@
	\subsection{Returning a procedure pointer}
	The functions that directly access the matrix element, event by event,
	are assigned to a process-specific driver object as procedure
	pointers. For the [[dlopen]] interface, we use C function pointers.
	This subroutine returns such a pointer:
	<<Prclib interfaces: public>>=
	public :: prc_get_fptr
	<<Prclib interfaces: interfaces>>=
	abstract interface
	subroutine prc_get_fptr (pid, fid, fptr) bind(C)
	import
	integer(c_int), intent(in) :: pid
	integer(c_int), intent(in) :: fid
	type(c_funptr), intent(out) :: fptr
	end subroutine prc_get_fptr
	end interface

	@ %def prc_get_fptr
	@ This procedure writes the source code for the procedure pointer
	returning subroutine.

	All C functions that are provided by the matrix element code of a
	specific process are handled here. The selection consists of a double
	layered [[select]] [[case]] construct.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: write_get_fptr_sub
	<<Prclib interfaces: sub interfaces>>=
	module subroutine write_get_fptr_sub (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	end subroutine write_get_fptr_sub
	<<Prclib interfaces: procedures>>=
	module subroutine write_get_fptr_sub (driver, unit, prefix)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	integer :: i, j
	write (unit, "(A)") ""
	write (unit, "(A)") "! Return C pointer to a procedure:"
	write (unit, "(A)") "! pid = process index; fid = function index"
	write (unit, "(4A)") "subroutine ", char (prefix), "get_fptr ", &
	"(pid, fid, fptr) bind(C)"
	write (unit, "(A)") " use iso_c_binding"
	write (unit, "(A)") " use kinds"
	write (unit, "(A)") " implicit none"
	write (unit, "(A)") " integer(c_int), intent(in) :: pid"
	write (unit, "(A)") " integer(c_int), intent(in) :: fid"
	write (unit, "(A)") " type(c_funptr), intent(out) :: fptr"
	do i = 1, driver%n_processes
	call driver%record(i)%write_interfaces (unit)
	end do
	write (unit, "(A)") " select case (pid)"
	do i = 1, driver%n_processes
	write (unit, "(2x,A,I0,A)") "case (", i, ")"
	write (unit, "(5x,A)") "select case (fid)"
	associate (record => driver%record(i))
	do j = 1, size (record%feature)
	write (unit, "(5x,A,I0,9A)") "case (", j, "); ", &
	"fptr = c_funloc (", &
	char (record%get_c_procname (record%feature(j))), &
	")"
	end do
	end associate
	write (unit, "(5x,A)") "end select"
	end do
	write (unit, "(A)") " end select"
	write (unit, "(3A)") "end subroutine ", char (prefix), "get_fptr"
	end subroutine write_get_fptr_sub

	@ %def write_get_fptr_sub
	@ The procedures for which we want to return a pointer (the 'features'
	of the matrix element code) are actually Fortran module procedures.
	If we want to have a C signature, we must write wrapper functions for
	all of them. The procedures, their signatures, and the appropriate
	writer routines are specific for the process type.

	To keep this generic, we do not provide the writer routines here, but
	just the interface for a writer routine. The actual routines are
	stored in the process record.

	The [[prefix]] indicates the library, the [[id]] indicates the
	process, and [[procname]] is the bare name of the procedure to be
	written.
	<<Prclib interfaces: public>>=
	public :: write_driver_code
	<<Prclib interfaces: interfaces>>=
	abstract interface
	subroutine write_driver_code (unit, prefix, id, procname)
	import
	integer, intent(in) :: unit
	type(string_t), intent(in) :: prefix
	type(string_t), intent(in) :: id
	type(string_t), intent(in) :: procname
	end subroutine write_driver_code
	end interface

	@ %def write_driver_code
	@
	\subsection{Hooks}
	Interface for additional library unload / reload hooks (currently unused!)
	<<Prclib interfaces: public>>=
	public :: prclib_unload_hook
	public :: prclib_reload_hook
	<<Prclib interfaces: interfaces>>=
	abstract interface
	subroutine prclib_unload_hook (libname)
	import
	type(string_t), intent(in) :: libname
	end subroutine prclib_unload_hook

	subroutine prclib_reload_hook (libname)
	import
	type(string_t), intent(in) :: libname
	end subroutine prclib_reload_hook
	end interface
	@ %def prclib_unload_hook
	@ %def prclib_reload_hook
	@
	\subsection{Make source, compile, link}
	Since we should have written a Makefile, these tasks amount to simple
	[[make]] calls. Note that the Makefile targets depend on each other,
	so calling [[link]] executes also the [[source]] and [[compile]]
	steps, when necessary.

	Optionally, we can use a subdirectory. We construct a prefix for the
	subdirectory, and generate a shell [[cd]] call that moves us into the
	workspace.

	The [[prefix]] version is intended to be prepended to a filename, and can be
	empty. The [[path]] version is intended to be prepended with a following
	slash, so the default is [[.]].
	<<Prclib interfaces: public>>=
	public :: workspace_prefix
	public :: workspace_path
	<<Prclib interfaces: sub interfaces>>=
	module function workspace_prefix (workspace) result (prefix)
	type(string_t), intent(in), optional :: workspace
	type(string_t) :: prefix
	end function workspace_prefix
	module function workspace_path (workspace) result (path)
	type(string_t), intent(in), optional :: workspace
	type(string_t) :: path
	end function workspace_path
	module function workspace_cmd (workspace) result (cmd)
	type(string_t), intent(in), optional :: workspace
	type(string_t) :: cmd
	end function workspace_cmd
	<<Prclib interfaces: procedures>>=
	module function workspace_prefix (workspace) result (prefix)
	type(string_t), intent(in), optional :: workspace
	type(string_t) :: prefix
	if (present (workspace)) then
	if (workspace /= "") then
	prefix = workspace // "/"
	else
	prefix = ""
	end if
	else
	prefix = ""
	end if
	end function workspace_prefix

	module function workspace_path (workspace) result (path)
	type(string_t), intent(in), optional :: workspace
	type(string_t) :: path
	if (present (workspace)) then
	if (workspace /= "") then
	path = workspace
	else
	path = "."
	end if
	else
	path = "."
	end if
	end function workspace_path

	module function workspace_cmd (workspace) result (cmd)
	type(string_t), intent(in), optional :: workspace
	type(string_t) :: cmd
	if (present (workspace)) then
	if (workspace /= "") then
	cmd = "cd " // workspace // " && "
	else
	cmd = ""
	end if
	else
	cmd = ""
	end if
	end function workspace_cmd

	@ %def workspace_prefix
	@ %def workspace_path
	@ %def workspace_cmd
	@ The first routine writes source-code files for the individual
	processes. First it calls the writer routines directly for each
	process, then it calls [[make source]]. The make command may either
	post-process the files, or it may do the complete work, e.g., calling
	an external program the generates the files.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: make_source => prclib_driver_make_source
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_make_source (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	end subroutine prclib_driver_make_source
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_make_source (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	integer :: i
	do i = 1, driver%n_processes
	call driver%record(i)%write_source_code ()
	end do
	call os_system_call ( &
	workspace_cmd (workspace) &
	// "make source " // os_data%makeflags &
	// " -f " // driver%basename // ".makefile")
	end subroutine prclib_driver_make_source

	@ %def prclib_driver_make_source
	@ Compile matrix element source code and the driver source code. As above, we
	first iterate through all processes and call [[before_compile]]. This is
	usually empty, but can execute code that depends on [[make_source]] already
	completed. Similarly, [[after_compile]] scans all processes again.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: make_compile => prclib_driver_make_compile
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_make_compile (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	end subroutine prclib_driver_make_compile
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_make_compile (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	integer :: i
	do i = 1, driver%n_processes
	call driver%record(i)%before_compile ()
	end do
	call os_system_call ( &
	workspace_cmd (workspace) &
	// "make compile " // os_data%makeflags &
	// " -f " // driver%basename // ".makefile")
	do i = 1, driver%n_processes
	call driver%record(i)%after_compile ()
	end do
	end subroutine prclib_driver_make_compile

	@ %def prclib_driver_make_compile
	@ Combine all matrix-element code together with the driver in a
	process library on disk.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: make_link => prclib_driver_make_link
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_make_link (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	end subroutine prclib_driver_make_link
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_make_link (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	integer :: i
	call os_system_call ( &
	workspace_cmd (workspace) &
	// "make link " // os_data%makeflags &
	// " -f " // driver%basename // ".makefile")
	end subroutine prclib_driver_make_link

	@ %def prclib_driver_make_link
	@
	\subsection{Clean up generated files}
	The task of cleaning any generated files should also be deferred to
	Makefile targets. Apart from removing everything, removing specific
	files may be useful for partial rebuilds. (Note that removing the
	makefile itself can only be done once, for obvious reasons.)

	If there is no makefile, do nothing.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: clean_library => prclib_driver_clean_library
	procedure :: clean_objects => prclib_driver_clean_objects
	procedure :: clean_source => prclib_driver_clean_source
	procedure :: clean_driver => prclib_driver_clean_driver
	procedure :: clean_makefile => prclib_driver_clean_makefile
	procedure :: clean => prclib_driver_clean
	procedure :: distclean => prclib_driver_distclean
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_clean_library (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	end subroutine prclib_driver_clean_library
	module subroutine prclib_driver_clean_objects (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	end subroutine prclib_driver_clean_objects
	module subroutine prclib_driver_clean_source (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	end subroutine prclib_driver_clean_source
	module subroutine prclib_driver_clean_driver (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	end subroutine prclib_driver_clean_driver
	module subroutine prclib_driver_clean_makefile (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	end subroutine prclib_driver_clean_makefile
	module subroutine prclib_driver_clean (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	end subroutine prclib_driver_clean
	module subroutine prclib_driver_distclean (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	end subroutine prclib_driver_distclean
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_clean_library (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	if (driver%makefile_exists ()) then
	call os_system_call ( &
	workspace_cmd (workspace) &
	// "make clean-library " // os_data%makeflags &
	// " -f " // driver%basename // ".makefile")
	end if
	end subroutine prclib_driver_clean_library

	module subroutine prclib_driver_clean_objects (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	if (driver%makefile_exists ()) then
	call os_system_call ( &
	workspace_cmd (workspace) &
	// "make clean-objects " // os_data%makeflags &
	// " -f " // driver%basename // ".makefile")
	end if
	end subroutine prclib_driver_clean_objects

	module subroutine prclib_driver_clean_source (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	if (driver%makefile_exists ()) then
	call os_system_call ( &
	workspace_cmd (workspace) &
	// "make clean-source " // os_data%makeflags &
	// " -f " // driver%basename // ".makefile")
	end if
	end subroutine prclib_driver_clean_source

	module subroutine prclib_driver_clean_driver (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	if (driver%makefile_exists ()) then
	call os_system_call ( &
	workspace_cmd (workspace) &
	// "make clean-driver " // os_data%makeflags &
	// " -f " // driver%basename // ".makefile")
	end if
	end subroutine prclib_driver_clean_driver

	module subroutine prclib_driver_clean_makefile (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	if (driver%makefile_exists ()) then
	call os_system_call ( &
	workspace_cmd (workspace) &
	// "make clean-makefile " // os_data%makeflags &
	// " -f " // driver%basename // ".makefile")
	end if
	end subroutine prclib_driver_clean_makefile

	module subroutine prclib_driver_clean (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	if (driver%makefile_exists ()) then
	call os_system_call ( &
	workspace_cmd (workspace) &
	// "make clean " // os_data%makeflags &
	// " -f " // driver%basename // ".makefile")
	end if
	end subroutine prclib_driver_clean

	module subroutine prclib_driver_distclean (driver, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	if (driver%makefile_exists ()) then
	call os_system_call ( &
	workspace_cmd (workspace) &
	// "make distclean " // os_data%makeflags &
	// " -f " // driver%basename // ".makefile")
	end if
	end subroutine prclib_driver_distclean

	@ %def prclib_driver_clean_library
	@ %def prclib_driver_clean_objects
	@ %def prclib_driver_clean_source
	@ %def prclib_driver_clean_driver
	@ %def prclib_driver_clean_makefile
	@ %def prclib_driver_clean
	@ %def prclib_driver_distclean
	@ This Make target should remove all files that apply to a specific process.
	We execute this when we want to force remaking source code. Note that source
	targets need not have prerequisites, so just calling [[make_source]] would not
	do anything if the files exist.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: clean_proc => prclib_driver_clean_proc
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_clean_proc (driver, i, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	end subroutine prclib_driver_clean_proc
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_clean_proc (driver, i, os_data, workspace)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	type(string_t) :: id
	if (driver%makefile_exists ()) then
	id = driver%record(i)%id
	call os_system_call ( &
	workspace_cmd (workspace) &
	// "make clean-" // driver%record(i)%id // " " &
	// os_data%makeflags &
	// " -f " // driver%basename // ".makefile")
	end if
	end subroutine prclib_driver_clean_proc

	@ %def prclib_driver_clean_proc
	@
	\subsection{Further Tools}
	Check for the appropriate makefile.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: makefile_exists => prclib_driver_makefile_exists
	<<Prclib interfaces: sub interfaces>>=
	module function prclib_driver_makefile_exists (driver, workspace) result (flag)
	class(prclib_driver_t), intent(in) :: driver
	type(string_t), intent(in), optional :: workspace
	logical :: flag
	end function prclib_driver_makefile_exists
	<<Prclib interfaces: procedures>>=
	module function prclib_driver_makefile_exists (driver, workspace) result (flag)
	class(prclib_driver_t), intent(in) :: driver
	type(string_t), intent(in), optional :: workspace
	logical :: flag
	inquire (file = char (workspace_prefix (workspace) &
	& // driver%basename) // ".makefile", &
	exist = flag)
	end function prclib_driver_makefile_exists

	@ %def prclib_driver_makefile_exists
	@
	\subsection{Load the library}
	Once the library has been linked, we can dlopen it and assign all
	procedure pointers to their proper places in the library driver
	object. The [[loaded]] flag is set only if all required pointers
	have become assigned.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: load => prclib_driver_load
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_load (driver, os_data, noerror, workspace)
	class(prclib_driver_t), intent(inout) :: driver
	type(os_data_t), intent(in) :: os_data
	logical, intent(in), optional :: noerror
	type(string_t), intent(in), optional :: workspace
	end subroutine prclib_driver_load
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_load (driver, os_data, noerror, workspace)
	class(prclib_driver_t), intent(inout) :: driver
	type(os_data_t), intent(in) :: os_data
	logical, intent(in), optional :: noerror
	type(string_t), intent(in), optional :: workspace
	type(c_funptr) :: c_fptr
	logical :: ignore

	ignore = .false.; if (present (noerror)) ignore = noerror

	driver%libname = os_get_dlname ( &
	workspace_prefix (workspace) // driver%basename, &
	os_data, noerror, noerror)
	if (driver%libname == "") return
	select type (driver)
	type is (prclib_driver_dynamic_t)
	if (.not. dlaccess_is_open (driver%dlaccess)) then
	call dlaccess_init &
	(driver%dlaccess, workspace_path (workspace), &
	driver%libname, os_data)
	if (.not. ignore) call driver%check_dlerror ()
	end if
	driver%loaded = dlaccess_is_open (driver%dlaccess)
	class default
	driver%loaded = .true.
	end select
	if (.not. driver%loaded) return

	c_fptr = driver%get_c_funptr (var_str ("get_n_processes"))
	call c_f_procpointer (c_fptr, driver%get_n_processes)
	driver%loaded = driver%loaded .and. associated (driver%get_n_processes)

	c_fptr = driver%get_c_funptr (var_str ("get_process_id_ptr"))
	call c_f_procpointer (c_fptr, driver%get_process_id_ptr)
	driver%loaded = driver%loaded .and. associated (driver%get_process_id_ptr)

	c_fptr = driver%get_c_funptr (var_str ("get_model_name_ptr"))
	call c_f_procpointer (c_fptr, driver%get_model_name_ptr)
	driver%loaded = driver%loaded .and. associated (driver%get_model_name_ptr)

	c_fptr = driver%get_c_funptr (var_str ("get_md5sum_ptr"))
	call c_f_procpointer (c_fptr, driver%get_md5sum_ptr)
	driver%loaded = driver%loaded .and. associated (driver%get_md5sum_ptr)

	c_fptr = driver%get_c_funptr (var_str ("get_openmp_status"))
	call c_f_procpointer (c_fptr, driver%get_openmp_status)
	driver%loaded = driver%loaded .and. associated (driver%get_openmp_status)

	c_fptr = driver%get_c_funptr (var_str ("get_n_in"))
	call c_f_procpointer (c_fptr, driver%get_n_in)
	driver%loaded = driver%loaded .and. associated (driver%get_n_in)

	c_fptr = driver%get_c_funptr (var_str ("get_n_out"))
	call c_f_procpointer (c_fptr, driver%get_n_out)
	driver%loaded = driver%loaded .and. associated (driver%get_n_out)

	c_fptr = driver%get_c_funptr (var_str ("get_n_flv"))
	call c_f_procpointer (c_fptr, driver%get_n_flv)
	driver%loaded = driver%loaded .and. associated (driver%get_n_flv)

	c_fptr = driver%get_c_funptr (var_str ("get_n_hel"))
	call c_f_procpointer (c_fptr, driver%get_n_hel)
	driver%loaded = driver%loaded .and. associated (driver%get_n_hel)

	c_fptr = driver%get_c_funptr (var_str ("get_n_col"))
	call c_f_procpointer (c_fptr, driver%get_n_col)
	driver%loaded = driver%loaded .and. associated (driver%get_n_col)

	c_fptr = driver%get_c_funptr (var_str ("get_n_cin"))
	call c_f_procpointer (c_fptr, driver%get_n_cin)
	driver%loaded = driver%loaded .and. associated (driver%get_n_cin)

	c_fptr = driver%get_c_funptr (var_str ("get_n_cf"))
	call c_f_procpointer (c_fptr, driver%get_n_cf)
	driver%loaded = driver%loaded .and. associated (driver%get_n_cf)

	c_fptr = driver%get_c_funptr (var_str ("set_flv_state_ptr"))
	call c_f_procpointer (c_fptr, driver%set_flv_state_ptr)
	driver%loaded = driver%loaded .and. associated (driver%set_flv_state_ptr)

	c_fptr = driver%get_c_funptr (var_str ("set_hel_state_ptr"))
	call c_f_procpointer (c_fptr, driver%set_hel_state_ptr)
	driver%loaded = driver%loaded .and. associated (driver%set_hel_state_ptr)

	c_fptr = driver%get_c_funptr (var_str ("set_col_state_ptr"))
	call c_f_procpointer (c_fptr, driver%set_col_state_ptr)
	driver%loaded = driver%loaded .and. associated (driver%set_col_state_ptr)

	c_fptr = driver%get_c_funptr (var_str ("set_color_factors_ptr"))
	call c_f_procpointer (c_fptr, driver%set_color_factors_ptr)
	driver%loaded = driver%loaded .and. associated (driver%set_color_factors_ptr)

	c_fptr = driver%get_c_funptr (var_str ("get_fptr"))
	call c_f_procpointer (c_fptr, driver%get_fptr)
	driver%loaded = driver%loaded .and. associated (driver%get_fptr)

	end subroutine prclib_driver_load

	@ %def prclib_driver_load
	@ Unload. To be sure, nullify the procedure pointers.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: unload => prclib_driver_unload
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_unload (driver)
	class(prclib_driver_t), intent(inout) :: driver
	end subroutine prclib_driver_unload
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_unload (driver)
	class(prclib_driver_t), intent(inout) :: driver
	select type (driver)
	type is (prclib_driver_dynamic_t)
	if (dlaccess_is_open (driver%dlaccess)) then
	call dlaccess_final (driver%dlaccess)
	call driver%check_dlerror ()
	end if
	end select
	driver%loaded = .false.
	nullify (driver%get_n_processes)
	nullify (driver%get_process_id_ptr)
	nullify (driver%get_model_name_ptr)
	nullify (driver%get_md5sum_ptr)
	nullify (driver%get_openmp_status)
	nullify (driver%get_n_in)
	nullify (driver%get_n_out)
	nullify (driver%get_n_flv)
	nullify (driver%get_n_hel)
	nullify (driver%get_n_col)
	nullify (driver%get_n_cin)
	nullify (driver%get_n_cf)
	nullify (driver%set_flv_state_ptr)
	nullify (driver%set_hel_state_ptr)
	nullify (driver%set_col_state_ptr)
	nullify (driver%set_color_factors_ptr)
	nullify (driver%get_fptr)
	end subroutine prclib_driver_unload

	@ %def prclib_driver_unload
	@ This subroutine checks the [[dlerror]] content and issues a fatal
	error if it finds an error there.
	<<Prclib interfaces: prclib driver dynamic: TBP>>=
	procedure :: check_dlerror => prclib_driver_check_dlerror
	<<Prclib interfaces: sub interfaces>>=
	module subroutine prclib_driver_check_dlerror (driver)
	class(prclib_driver_dynamic_t), intent(in) :: driver
	end subroutine prclib_driver_check_dlerror
	<<Prclib interfaces: procedures>>=
	module subroutine prclib_driver_check_dlerror (driver)
	class(prclib_driver_dynamic_t), intent(in) :: driver
	if (dlaccess_has_error (driver%dlaccess)) then
	call msg_fatal (char (dlaccess_get_error (driver%dlaccess)))
	end if
	end subroutine prclib_driver_check_dlerror

	@ %def prclib_driver_check_dlerror
	@ Get the handle (C function pointer) for a given ``feature'' of the
	matrix element code, so it can be assigned to the appropriate
	procedure pointer slot. In the static case, this is a
	trivial pointer assignment, hard-coded into the driver type
	implementation.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure (prclib_driver_get_c_funptr), deferred :: get_c_funptr
	<<Prclib interfaces: interfaces>>=
	abstract interface
	function prclib_driver_get_c_funptr (driver, feature) result (c_fptr)
	import
	class(prclib_driver_t), intent(inout) :: driver
	type(string_t), intent(in) :: feature
	type(c_funptr) :: c_fptr
	end function prclib_driver_get_c_funptr
	end interface

	@ %def prclib_driver_get_c_funptr
	@ In the dynamic-library case, we call the DL interface to retrieve the C
	pointer to a named procedure.
	<<Prclib interfaces: prclib driver dynamic: TBP>>=
	procedure :: get_c_funptr => prclib_driver_dynamic_get_c_funptr
	<<Prclib interfaces: sub interfaces>>=
	module function prclib_driver_dynamic_get_c_funptr &
	(driver, feature) result (c_fptr)
	class(prclib_driver_dynamic_t), intent(inout) :: driver
	type(string_t), intent(in) :: feature
	type(c_funptr) :: c_fptr
	end function prclib_driver_dynamic_get_c_funptr
	<<Prclib interfaces: procedures>>=
	module function prclib_driver_dynamic_get_c_funptr &
	(driver, feature) result (c_fptr)
	class(prclib_driver_dynamic_t), intent(inout) :: driver
	type(string_t), intent(in) :: feature
	type(c_funptr) :: c_fptr
	type(string_t) :: prefix, full_name
	prefix = lower_case (driver%basename) // "_"
	full_name = prefix // feature
	c_fptr = dlaccess_get_c_funptr (driver%dlaccess, full_name)
	call driver%check_dlerror ()
	end function prclib_driver_dynamic_get_c_funptr

	@ %def prclib_driver_get_c_funptr
	@
	\subsection{MD5 sums}
	Recall the MD5 sum written in the Makefile
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: get_md5sum_makefile => prclib_driver_get_md5sum_makefile
	<<Prclib interfaces: sub interfaces>>=
	module function prclib_driver_get_md5sum_makefile &
	(driver, workspace) result (md5sum)
	class(prclib_driver_t), intent(in) :: driver
	type(string_t), intent(in), optional :: workspace
	character(32) :: md5sum
	end function prclib_driver_get_md5sum_makefile
	<<Prclib interfaces: procedures>>=
	module function prclib_driver_get_md5sum_makefile &
	(driver, workspace) result (md5sum)
	class(prclib_driver_t), intent(in) :: driver
	type(string_t), intent(in), optional :: workspace
	character(32) :: md5sum
	type(string_t) :: filename
	character(80) :: buffer
	logical :: exist
	integer :: u, iostat
	md5sum = ""
	filename = workspace_prefix (workspace) // driver%basename // ".makefile"
	inquire (file = char (filename), exist = exist)
	if (exist) then
	u = free_unit ()
	open (u, file = char (filename), action = "read", status = "old")
	iostat = 0
	do
	read (u, "(A)", iostat = iostat) buffer
	if (iostat /= 0) exit
	buffer = adjustl (buffer)
	select case (buffer(1:9))
	case ("MD5SUM = ")
	read (buffer(11:), "(A32)") md5sum
	exit
	end select
	end do
	close (u)
	end if
	end function prclib_driver_get_md5sum_makefile

	@ %def prclib_driver_get_md5sum_makefile
	@ Recall the MD5 sum written in the driver source code.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: get_md5sum_driver => prclib_driver_get_md5sum_driver
	<<Prclib interfaces: sub interfaces>>=
	module function prclib_driver_get_md5sum_driver (driver, workspace) result (md5sum)
	class(prclib_driver_t), intent(in) :: driver
	type(string_t), intent(in), optional :: workspace
	character(32) :: md5sum
	end function prclib_driver_get_md5sum_driver
	<<Prclib interfaces: procedures>>=
	module function prclib_driver_get_md5sum_driver (driver, workspace) result (md5sum)
	class(prclib_driver_t), intent(in) :: driver
	type(string_t), intent(in), optional :: workspace
	character(32) :: md5sum
	type(string_t) :: filename
	character(80) :: buffer
	logical :: exist
	integer :: u, iostat
	md5sum = ""
	filename = workspace_prefix (workspace) // driver%basename // ".f90"
	inquire (file = char (filename), exist = exist)
	if (exist) then
	u = free_unit ()
	open (u, file = char (filename), action = "read", status = "old")
	iostat = 0
	do
	read (u, "(A)", iostat = iostat) buffer
	if (iostat /= 0) exit
	buffer = adjustl (buffer)
	select case (buffer(1:9))
	case ("md5sum = ")
	read (buffer(11:), "(A32)") md5sum
	exit
	end select
	end do
	close (u)
	end if
	end function prclib_driver_get_md5sum_driver

	@ %def prclib_driver_get_md5sum_driver
	@ Recall the MD5 sum written in the matrix element source code.
	<<Prclib interfaces: prclib driver: TBP>>=
	procedure :: get_md5sum_source => prclib_driver_get_md5sum_source
	<<Prclib interfaces: sub interfaces>>=
	module function prclib_driver_get_md5sum_source &
	(driver, i, workspace) result (md5sum)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	type(string_t), intent(in), optional :: workspace
	character(32) :: md5sum
	end function prclib_driver_get_md5sum_source
	<<Prclib interfaces: procedures>>=
	module function prclib_driver_get_md5sum_source &
	(driver, i, workspace) result (md5sum)
	class(prclib_driver_t), intent(in) :: driver
	integer, intent(in) :: i
	type(string_t), intent(in), optional :: workspace
	character(32) :: md5sum
	type(string_t) :: filename
	character(80) :: buffer
	logical :: exist
	integer :: u, iostat
	md5sum = ""

	filename = workspace_prefix (workspace) // driver%record(i)%id // ".f90"
	inquire (file = char (filename), exist = exist)
	if (exist) then
	u = free_unit ()
	open (u, file = char (filename), action = "read", status = "old")
	iostat = 0
	do
	read (u, "(A)", iostat = iostat) buffer
	if (iostat /= 0) exit
	buffer = adjustl (buffer)
	select case (buffer(1:9))
	case ("md5sum = ")
	read (buffer(11:), "(A32)") md5sum
	exit
	end select
	end do
	close (u)
	end if
	end function prclib_driver_get_md5sum_source

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

	module prclib_interfaces_ut
	use kinds
	use system_dependencies, only: CC_IS_GNU, CC_HAS_QUADMATH
	use unit_tests
	use prclib_interfaces_uti

	<<Standard module head>>

	<<Prclib interfaces: public test>>

	<<Prclib interfaces: public test auxiliary>>

	contains

	<<Prclib interfaces: test driver>>

	end module prclib_interfaces_ut
	@ %def prclib_interfaces_ut
	@
	<<[[prclib_interfaces_uti.f90]]>>=
	<<File header>>

	module prclib_interfaces_uti

	use, intrinsic :: iso_c_binding !NODEP!

	use kinds
	use system_dependencies, only: CC_HAS_QUADMATH, DEFAULT_FC_PRECISION
	<<Use strings>>
	use io_units
	use system_defs, only: TAB
	use os_interface

	use prclib_interfaces

	<<Standard module head>>

	<<Prclib interfaces: public test auxiliary>>

	<<Prclib interfaces: test declarations>>

	<<Prclib interfaces: test types>>

	contains

	<<Prclib interfaces: tests>>

	<<Prclib interfaces: test auxiliary>>

	end module prclib_interfaces_uti
	@ %def prclib_interfaces_ut
	@ API: driver for the unit tests below.
	<<Prclib interfaces: public test>>=
	public :: prclib_interfaces_test
	<<Prclib interfaces: test driver>>=
	subroutine prclib_interfaces_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Prclib interfaces: execute tests>>
	end subroutine prclib_interfaces_test

	@ %def prclib_interfaces_test
	@
	\subsubsection{Empty process list}
	Test 1: Create a driver object and display its contents. One of the
	feature lists references a writer procedure; this is just a dummy that
	does nothing useful.
	<<Prclib interfaces: execute tests>>=
	call test (prclib_interfaces_1, "prclib_interfaces_1", &
	"create driver object", &
	u, results)
	<<Prclib interfaces: test declarations>>=
	public :: prclib_interfaces_1
	<<Prclib interfaces: tests>>=
	subroutine prclib_interfaces_1 (u)
	integer, intent(in) :: u
	class(prclib_driver_t), allocatable :: driver
	character(32), parameter :: md5sum = "prclib_interfaces_1_md5sum "
	class(prc_writer_t), pointer :: test_writer_1


	write (u, "(A)") "* Test output: prclib_interfaces_1"
	write (u, "(A)") "* Purpose: display the driver object contents"
	write (u, *)
	write (u, "(A)") "* Create a prclib driver object"
	write (u, "(A)")

	call dispatch_prclib_driver (driver, var_str ("prclib"), var_str (""))
	call driver%init (3)
	call driver%set_md5sum (md5sum)

	allocate (test_writer_1_t :: test_writer_1)

	call driver%set_record (1, var_str ("test1"), var_str ("test_model"), &
	[var_str ("init")], test_writer_1)

	call driver%set_record (2, var_str ("test2"), var_str ("foo_model"), &
	[var_str ("another_proc")], test_writer_1)

	call driver%set_record (3, var_str ("test3"), var_str ("test_model"), &
	[var_str ("init"), var_str ("some_proc")], test_writer_1)

	call driver%write (u)

	deallocate (test_writer_1)

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

	@ %def prclib_interfaces_1
	@ The writer: the procedures write just comment lines. We can fix an
	instance of this as a parameter (since it has no mutable content) and
	just reference the fixed parameter.

	NOTE: temporarily made public.
	<<Prclib interfaces: test types>>=
	type, extends (prc_writer_t) :: test_writer_1_t
	contains
	procedure, nopass :: type_name => test_writer_1_type_name
	procedure :: write_makefile_code => test_writer_1_mk
	procedure :: write_source_code => test_writer_1_src
	procedure :: write_interface => test_writer_1_if
	procedure :: write_md5sum_call => test_writer_1_md5sum
	procedure :: write_int_sub_call => test_writer_1_int_sub
	procedure :: write_col_state_call => test_writer_1_col_state
	procedure :: write_color_factors_call => test_writer_1_col_factors
	procedure :: before_compile => test_writer_1_before_compile
	procedure :: after_compile => test_writer_1_after_compile
	end type test_writer_1_t

	@ %def test_writer_1
	@
	<<Prclib interfaces: test auxiliary>>=
	function test_writer_1_type_name () result (string)
	type(string_t) :: string
	string = "test_1"
	end function test_writer_1_type_name

	subroutine test_writer_1_mk &
	(writer, unit, id, os_data, verbose, testflag)
	class(test_writer_1_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	write (unit, "(5A)") "# Makefile code for process ", char (id), &
	" goes here."
	end subroutine test_writer_1_mk

	subroutine test_writer_1_src (writer, id)
	class(test_writer_1_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine test_writer_1_src

	subroutine test_writer_1_if (writer, unit, id, feature)
	class(test_writer_1_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	write (unit, "(2x,9A)") "! Interface code for ", &
	char (id), "_", char (writer%get_procname (feature)), &
	" goes here."
	end subroutine test_writer_1_if

	subroutine test_writer_1_md5sum (writer, unit, id)
	class(test_writer_1_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	write (unit, "(5x,9A)") "! MD5sum call for ", char (id), " goes here."
	end subroutine test_writer_1_md5sum

	subroutine test_writer_1_int_sub (writer, unit, id, feature)
	class(test_writer_1_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	write (unit, "(5x,9A)") "! ", char (feature), " call for ", &
	char (id), " goes here."
	end subroutine test_writer_1_int_sub

	subroutine test_writer_1_col_state (writer, unit, id)
	class(test_writer_1_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	write (unit, "(5x,9A)") "! col_state call for ", &
	char (id), " goes here."
	end subroutine test_writer_1_col_state

	subroutine test_writer_1_col_factors (writer, unit, id)
	class(test_writer_1_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	write (unit, "(5x,9A)") "! color_factors call for ", &
	char (id), " goes here."
	end subroutine test_writer_1_col_factors

	subroutine test_writer_1_before_compile (writer, id)
	class(test_writer_1_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine test_writer_1_before_compile

	subroutine test_writer_1_after_compile (writer, id)
	class(test_writer_1_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine test_writer_1_after_compile

	@ %def test_writer_1_type_name
	@ %def test_writer_1_mk test_writer_1_if
	@ %def test_writer_1_md5sum test_writer_1_int_sub
	@ %def test_writer_1_col_state test_writer_1_col_factors
	@ %def test_writer_1_before_compile test_writer_1_after_compile
	@
	\subsubsection{Process library driver file}
	Test 2: Write the driver file for a test case with two processes. The
	first process needs no wrapper (C library), the second one needs
	wrappers (Fortran module library).
	<<Prclib interfaces: execute tests>>=
	call test (prclib_interfaces_2, "prclib_interfaces_2", &
	"write driver file", &
	u, results)
	<<Prclib interfaces: test declarations>>=
	public :: prclib_interfaces_2
	<<Prclib interfaces: tests>>=
	subroutine prclib_interfaces_2 (u)
	integer, intent(in) :: u
	class(prclib_driver_t), allocatable :: driver
	character(32), parameter :: md5sum = "prclib_interfaces_2_md5sum "
	class(prc_writer_t), pointer :: test_writer_1, test_writer_2

	write (u, "(A)") "* Test output: prclib_interfaces_2"
	write (u, "(A)") "* Purpose: check the generated driver source code"
	write (u, "(A)")
	write (u, "(A)") "* Create a prclib driver object (2 processes)"
	write (u, "(A)")

	call dispatch_prclib_driver (driver, var_str ("prclib2"), var_str (""))
	call driver%init (2)
	call driver%set_md5sum (md5sum)

	allocate (test_writer_1_t :: test_writer_1)
	allocate (test_writer_2_t :: test_writer_2)

	call driver%set_record (1, var_str ("test1"), var_str ("Test_model"), &
	[var_str ("proc1")], test_writer_1)

	call driver%set_record (2, var_str ("test2"), var_str ("Test_model"), &
	[var_str ("proc1"), var_str ("proc2")], test_writer_2)

	call driver%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write the driver file"
	write (u, "(A)") "* File contents:"
	write (u, "(A)")

	call driver%generate_driver_code (u)

	deallocate (test_writer_1)
	deallocate (test_writer_2)

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

	@ %def prclib_interfaces_2
	@ A writer with wrapper code: the procedures again write just comment
	lines. Since all procedures are NOPASS, we can reuse two of the TBP.
	<<Prclib interfaces: test types>>=
	type, extends (prc_writer_f_module_t) :: test_writer_2_t
	contains
	procedure, nopass :: type_name => test_writer_2_type_name
	procedure :: write_makefile_code => test_writer_2_mk
	procedure :: write_source_code => test_writer_2_src
	procedure :: write_interface => test_writer_2_if
	procedure :: write_wrapper => test_writer_2_wr
	procedure :: before_compile => test_writer_2_before_compile
	procedure :: after_compile => test_writer_2_after_compile
	end type test_writer_2_t

	@ %def test_writer_2
	@
	<<Prclib interfaces: test auxiliary>>=
	function test_writer_2_type_name () result (string)
	type(string_t) :: string
	string = "test_2"
	end function test_writer_2_type_name

	subroutine test_writer_2_mk &
	(writer, unit, id, os_data, verbose, testflag)
	class(test_writer_2_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	write (unit, "(5A)") "# Makefile code for process ", char (id), &
	" goes here."
	end subroutine test_writer_2_mk

	subroutine test_writer_2_src (writer, id)
	class(test_writer_2_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine test_writer_2_src

	subroutine test_writer_2_if (writer, unit, id, feature)
	class(test_writer_2_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	write (unit, "(2x,9A)") "! Interface code for ", &
	char (writer%get_module_name (id)), "_", &
	char (writer%get_procname (feature)), " goes here."
	end subroutine test_writer_2_if

	subroutine test_writer_2_wr (writer, unit, id, feature)
	class(test_writer_2_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	write (unit, *)
	write (unit, "(9A)") "! Wrapper code for ", &
	char (writer%get_c_procname (id, feature)), " goes here."
	end subroutine test_writer_2_wr

	subroutine test_writer_2_before_compile (writer, id)
	class(test_writer_2_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine test_writer_2_before_compile

	subroutine test_writer_2_after_compile (writer, id)
	class(test_writer_2_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine test_writer_2_after_compile

	@ %def test_writer_2_type_name test_writer_2_wr
	@ %def test_writer_2_before_compile test_writer_2_after_compile
	@
	\subsubsection{Process library makefile}
	Test 3: Write the makefile for compiling and linking the process
	library (processes and driver code). There are two processes, one
	with one method, one with two methods.

	To have predictable output, we reset the system-dependent initial
	components of [[os_data]] to known values.
	<<Prclib interfaces: execute tests>>=
	call test (prclib_interfaces_3, "prclib_interfaces_3", &
	"write makefile", &
	u, results)
	<<Prclib interfaces: test declarations>>=
	public :: prclib_interfaces_3
	<<Prclib interfaces: tests>>=
	subroutine prclib_interfaces_3 (u)
	integer, intent(in) :: u
	class(prclib_driver_t), allocatable :: driver
	type(os_data_t) :: os_data
	character(32), parameter :: md5sum = "prclib_interfaces_3_md5sum "
	class(prc_writer_t), pointer :: test_writer_1, test_writer_2

	call os_data%init ()
	os_data%fc = "fortran-compiler"
	os_data%whizard_includes = "-I module-dir"
	os_data%fcflags = "-C=all"
	os_data%fcflags_pic = "-PIC"
	os_data%cc = "c-compiler"
	os_data%cflags = "-I include-dir"
	os_data%cflags_pic = "-PIC"
	os_data%whizard_ldflags = ""
	os_data%ldflags = ""
	os_data%whizard_libtool = "my-libtool"
	os_data%latex = "latex -halt-on-error"
	os_data%mpost = "mpost --math=scaled -halt-on-error"
	os_data%dvips = "dvips"
	os_data%ps2pdf = "ps2pdf14"
	os_data%whizard_texpath = ""

	write (u, "(A)") "* Test output: prclib_interfaces_3"
	write (u, "(A)") "* Purpose: check the generated Makefile"
	write (u, *)
	write (u, "(A)") "* Create a prclib driver object (2 processes)"
	write (u, "(A)")

	call dispatch_prclib_driver (driver, var_str ("prclib3"), var_str (""))
	call driver%init (2)
	call driver%set_md5sum (md5sum)

	allocate (test_writer_1_t :: test_writer_1)
	allocate (test_writer_2_t :: test_writer_2)

	call driver%set_record (1, var_str ("test1"), var_str ("Test_model"), &
	[var_str ("proc1")], test_writer_1)

	call driver%set_record (2, var_str ("test2"), var_str ("Test_model"), &
	[var_str ("proc1"), var_str ("proc2")], test_writer_2)

	call driver%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Write Makefile"
	write (u, "(A)") "* File contents:"
	write (u, "(A)")

	call driver%generate_makefile (u, os_data, verbose = .true.)

	deallocate (test_writer_1)
	deallocate (test_writer_2)

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

	@ %def prclib_interfaces_3
	@
	\subsubsection{Compile test with Fortran module}
	Test 4: Write driver and makefile and try to compile and link the
	library driver.

	There is a single test process with a single feature. The process
	code is provided as a Fortran module, therefore we need a wrapper for
	the featured procedure.
	<<Prclib interfaces: execute tests>>=
	call test (prclib_interfaces_4, "prclib_interfaces_4", &
	"compile and link (Fortran module)", &
	u, results)
	<<Prclib interfaces: test declarations>>=
	public :: prclib_interfaces_4
	<<Prclib interfaces: tests>>=
	subroutine prclib_interfaces_4 (u)
	integer, intent(in) :: u
	class(prclib_driver_t), allocatable :: driver
	class(prc_writer_t), pointer :: test_writer_4
	type(os_data_t) :: os_data
	integer :: u_file

	integer, dimension(:,:), allocatable :: flv_state
	integer, dimension(:,:), allocatable :: hel_state
	integer, dimension(:,:,:), allocatable :: col_state
	logical, dimension(:,:), allocatable :: ghost_flag
	integer, dimension(:,:), allocatable :: cf_index
	complex(default), dimension(:), allocatable :: color_factors
	character(32), parameter :: md5sum = "prclib_interfaces_4_md5sum "
	character(32) :: md5sum_file

	type(c_funptr) :: proc1_ptr
	interface
	subroutine proc1_t (n) bind(C)
	import
	integer(c_int), intent(out) :: n
	end subroutine proc1_t
	end interface
	procedure(proc1_t), pointer :: proc1
	integer(c_int) :: n

	write (u, "(A)") "* Test output: prclib_interfaces_4"
	write (u, "(A)") "* Purpose: compile, link, and load process library"
	write (u, "(A)") "* with (fake) matrix-element code &
	&as a Fortran module"
	write (u, *)
	write (u, "(A)") "* Create a prclib driver object (1 process)"
	write (u, "(A)")

	call os_data%init ()

	allocate (test_writer_4_t :: test_writer_4)
	call test_writer_4%init_test ()

	call dispatch_prclib_driver (driver, var_str ("prclib4"), var_str (""))
	call driver%init (1)
	call driver%set_md5sum (md5sum)

	call driver%set_record (1, var_str ("test4"), var_str ("Test_model"), &
	[var_str ("proc1")], test_writer_4)

	call driver%write (u)

	write (u, *)
	write (u, "(A)") "* Write Makefile"
	u_file = free_unit ()
	open (u_file, file="prclib4.makefile", status="replace", action="write")
	call driver%generate_makefile (u_file, os_data, verbose = .false.)
	close (u_file)

	write (u, "(A)")
	write (u, "(A)") "* Recall MD5 sum from Makefile"
	write (u, "(A)")

	md5sum_file = driver%get_md5sum_makefile ()
	write (u, "(1x,A,A,A)") "MD5 sum = '", md5sum_file, "'"

	write (u, "(A)")
	write (u, "(A)") "* Write driver source code"

	u_file = free_unit ()
	open (u_file, file="prclib4.f90", status="replace", action="write")
	call driver%generate_driver_code (u_file)
	close (u_file)

	write (u, "(A)")
	write (u, "(A)") "* Recall MD5 sum from driver source"
	write (u, "(A)")

	md5sum_file = driver%get_md5sum_driver ()
	write (u, "(1x,A,A,A)") "MD5 sum = '", md5sum_file, "'"

	write (u, "(A)")
	write (u, "(A)") "* Write matrix-element source code"
	call driver%make_source (os_data)

	write (u, "(A)")
	write (u, "(A)") "* Recall MD5 sum from matrix-element source"
	write (u, "(A)")

	md5sum_file = driver%get_md5sum_source (1)
	write (u, "(1x,A,A,A)") "MD5 sum = '", md5sum_file, "'"

	write (u, "(A)")
	write (u, "(A)") "* Compile source code"
	call driver%make_compile (os_data)

	write (u, "(A)") "* Link library"
	call driver%make_link (os_data)

	write (u, "(A)") "* Load library"
	call driver%load (os_data)

	write (u, *)
	call driver%write (u)
	write (u, *)

	if (driver%loaded) then
	write (u, "(A)") "* Call library functions:"
	write (u, *)
	write (u, "(1x,A,I0)") "n_processes = ", driver%get_n_processes ()
	write (u, "(1x,A,A,A)") "process_id = '", &
	char (driver%get_process_id (1)), "'"
	write (u, "(1x,A,A,A)") "model_name = '", &
	char (driver%get_model_name (1)), "'"
	write (u, "(1x,A,A,A)") "md5sum (lib) = '", &
	char (driver%get_md5sum (0)), "'"
	write (u, "(1x,A,A,A)") "md5sum (proc) = '", &
	char (driver%get_md5sum (1)), "'"
	write (u, "(1x,A,L1)") "openmp_status = ", driver%get_openmp_status (1)
	write (u, "(1x,A,I0)") "n_in = ", driver%get_n_in (1)
	write (u, "(1x,A,I0)") "n_out = ", driver%get_n_out (1)
	write (u, "(1x,A,I0)") "n_flv = ", driver%get_n_flv (1)
	write (u, "(1x,A,I0)") "n_hel = ", driver%get_n_hel (1)
	write (u, "(1x,A,I0)") "n_col = ", driver%get_n_col (1)
	write (u, "(1x,A,I0)") "n_cin = ", driver%get_n_cin (1)
	write (u, "(1x,A,I0)") "n_cf = ", driver%get_n_cf (1)

	call driver%set_flv_state (1, flv_state)
	write (u, "(1x,A,10(1x,I0))") "flv_state =", flv_state

	call driver%set_hel_state (1, hel_state)
	write (u, "(1x,A,10(1x,I0))") "hel_state =", hel_state

	call driver%set_col_state (1, col_state, ghost_flag)
	write (u, "(1x,A,10(1x,I0))") "col_state =", col_state
	write (u, "(1x,A,10(1x,L1))") "ghost_flag =", ghost_flag

	call driver%set_color_factors (1, color_factors, cf_index)
	write (u, "(1x,A,10(1x,F5.3))") "color_factors =", color_factors
	write (u, "(1x,A,10(1x,I0))") "cf_index =", cf_index

	call driver%get_fptr (1, 1, proc1_ptr)
	call c_f_procpointer (proc1_ptr, proc1)
	if (associated (proc1)) then
	write (u, *)
	call proc1 (n)
	write (u, "(1x,A,I0)") "proc1(1) = ", n
	end if

	end if

	deallocate (test_writer_4)

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

	@ %def prclib_interfaces_4
	@ This version of test-code writer actually writes an interface and
	wrapper code. The wrapped function is a no-parameter function with integer
	result.

	The stored MD5 sum may be modified.

	We will reuse this later, therefore public.
	<<Prclib interfaces: public test auxiliary>>=
	public :: test_writer_4_t
	<<Prclib interfaces: test types>>=
	type, extends (prc_writer_f_module_t) :: test_writer_4_t
	contains
	procedure, nopass :: type_name => test_writer_4_type_name
	procedure, nopass :: get_module_name => &
	test_writer_4_get_module_name
	procedure :: write_makefile_code => test_writer_4_mk
	procedure :: write_source_code => test_writer_4_src
	procedure :: write_interface => test_writer_4_if
	procedure :: write_wrapper => test_writer_4_wr
	procedure :: before_compile => test_writer_4_before_compile
	procedure :: after_compile => test_writer_4_after_compile
	end type test_writer_4_t

	@ %def test_writer_4
	@
	<<Prclib interfaces: test auxiliary>>=
	function test_writer_4_type_name () result (string)
	type(string_t) :: string
	string = "test_4"
	end function test_writer_4_type_name

	function test_writer_4_get_module_name (id) result (name)
	type(string_t), intent(in) :: id
	type(string_t) :: name
	name = "tpr_" // id
	end function test_writer_4_get_module_name

	subroutine test_writer_4_mk &
	(writer, unit, id, os_data, verbose, testflag)
	class(test_writer_4_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	write (unit, "(5A)") "SOURCES += ", char (id), ".f90"
	write (unit, "(5A)") "OBJECTS += ", char (id), ".lo"
	write (unit, "(5A)") "CLEAN_SOURCES += ", char (id), ".f90"
	write (unit, "(5A)") "CLEAN_OBJECTS += tpr_", char (id), ".mod"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (id), ".lo"
	write (unit, "(5A)") char (id), ".lo: ", char (id), ".f90"
	if (.not. verbose) then
	write (unit, "(5A)") TAB // '@echo " FC " $@'
	end if
	write (unit, "(5A)") TAB, "$(LTFCOMPILE) $<"
	end subroutine test_writer_4_mk

	subroutine test_writer_4_src (writer, id)
	class(test_writer_4_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	call write_test_module_file (id, var_str ("proc1"), writer%md5sum)
	end subroutine test_writer_4_src

	subroutine test_writer_4_if (writer, unit, id, feature)
	class(test_writer_4_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	write (unit, "(2x,9A)") "interface"
	write (unit, "(5x,9A)") "subroutine ", &
	char (writer%get_c_procname (id, feature)), &
	" (n) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "implicit none"
	write (unit, "(7x,9A)") "integer(c_int), intent(out) :: n"
	write (unit, "(5x,9A)") "end subroutine ", &
	char (writer%get_c_procname (id, feature))
	write (unit, "(2x,9A)") "end interface"
	end subroutine test_writer_4_if

	subroutine test_writer_4_wr (writer, unit, id, feature)
	class(test_writer_4_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	write (unit, *)
	write (unit, "(9A)") "subroutine ", &
	char (writer%get_c_procname (id, feature)), &
	" (n) bind(C)"
	write (unit, "(2x,9A)") "use iso_c_binding"
	write (unit, "(2x,9A)") "use tpr_", char (id), ", only: ", &
	char (writer%get_procname (feature))
	write (unit, "(2x,9A)") "implicit none"
	write (unit, "(2x,9A)") "integer(c_int), intent(out) :: n"
	write (unit, "(2x,9A)") "call ", char (feature), " (n)"
	write (unit, "(9A)") "end subroutine ", &
	char (writer%get_c_procname (id, feature))
	end subroutine test_writer_4_wr

	subroutine test_writer_4_before_compile (writer, id)
	class(test_writer_4_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine test_writer_4_before_compile

	subroutine test_writer_4_after_compile (writer, id)
	class(test_writer_4_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine test_writer_4_after_compile

	@ %def test_writer_2_type_name test_writer_4_wr
	@ %def test_writer_4_before_compile test_writer_4_after_compile
	@
	We need a test module file (actually, one for each process in the test
	above) that allows us to check compilation and linking. The test
	module implements a colorless $1\to 2$ process, and it implements one
	additional function (feature), the name given as an argument.
	<<Prclib interfaces: test auxiliary>>=
	subroutine write_test_module_file (basename, feature, md5sum)
	type(string_t), intent(in) :: basename
	type(string_t), intent(in) :: feature
	character(32), intent(in) :: md5sum
	integer :: u
	u = free_unit ()
	open (u, file = char (basename) // ".f90", &
	status = "replace", action = "write")
	write (u, "(A)") "! (Pseudo) matrix element code file &
	&for WHIZARD self-test"
	write (u, *)
	write (u, "(A)") "module tpr_" // char (basename)
	write (u, *)
	write (u, "(2x,A)") "use kinds"
	write (u, "(2x,A)") "use omega_color, OCF => omega_color_factor"
	write (u, *)
	write (u, "(2x,A)") "implicit none"
	write (u, "(2x,A)") "private"
	write (u, *)
	call write_test_me_code_1 (u)
	write (u, *)
	write (u, "(2x,A)") "public :: " // char (feature)
	write (u, *)
	write (u, "(A)") "contains"
	write (u, *)
	call write_test_me_code_2 (u, md5sum)
	write (u, *)
	write (u, "(2x,A)") "subroutine " // char (feature) // " (n)"
	write (u, "(2x,A)") " integer, intent(out) :: n"
	write (u, "(2x,A)") " n = 42"
	write (u, "(2x,A)") "end subroutine " // char (feature)
	write (u, *)
	write (u, "(A)") "end module tpr_" // char (basename)
	close (u)
	end subroutine write_test_module_file

	@ %def write_test_module_file
	@
	The following two subroutines provide building blocks for a
	matrix-element source code file, useful only for testing the
	workflow. The first routine writes the header part, the other routine
	the implementation of the procedures listed in the header.
	<<Prclib interfaces: test auxiliary>>=
	subroutine write_test_me_code_1 (u)
	integer, intent(in) :: u
	write (u, "(2x,A)") "public :: md5sum"
	write (u, "(2x,A)") "public :: openmp_supported"
	write (u, *)
	write (u, "(2x,A)") "public :: n_in"
	write (u, "(2x,A)") "public :: n_out"
	write (u, "(2x,A)") "public :: n_flv"
	write (u, "(2x,A)") "public :: n_hel"
	write (u, "(2x,A)") "public :: n_cin"
	write (u, "(2x,A)") "public :: n_col"
	write (u, "(2x,A)") "public :: n_cf"
	write (u, *)
	write (u, "(2x,A)") "public :: flv_state"
	write (u, "(2x,A)") "public :: hel_state"
	write (u, "(2x,A)") "public :: col_state"
	write (u, "(2x,A)") "public :: color_factors"
	end subroutine write_test_me_code_1

	subroutine write_test_me_code_2 (u, md5sum)
	integer, intent(in) :: u
	character(32), intent(in) :: md5sum
	write (u, "(2x,A)") "pure function md5sum ()"
	write (u, "(2x,A)") " character(len=32) :: md5sum"
	write (u, "(2x,A)") " md5sum = '" // md5sum // "'"
	write (u, "(2x,A)") "end function md5sum"
	write (u, *)
	write (u, "(2x,A)") "pure function openmp_supported () result (status)"
	write (u, "(2x,A)") " logical :: status"
	write (u, "(2x,A)") " status = .false."
	write (u, "(2x,A)") "end function openmp_supported"
	write (u, *)
	write (u, "(2x,A)") "pure function n_in () result (n)"
	write (u, "(2x,A)") " integer :: n"
	write (u, "(2x,A)") " n = 1"
	write (u, "(2x,A)") "end function n_in"
	write (u, *)
	write (u, "(2x,A)") "pure function n_out () result (n)"
	write (u, "(2x,A)") " integer :: n"
	write (u, "(2x,A)") " n = 2"
	write (u, "(2x,A)") "end function n_out"
	write (u, *)
	write (u, "(2x,A)") "pure function n_flv () result (n)"
	write (u, "(2x,A)") " integer :: n"
	write (u, "(2x,A)") " n = 1"
	write (u, "(2x,A)") "end function n_flv"
	write (u, *)
	write (u, "(2x,A)") "pure function n_hel () result (n)"
	write (u, "(2x,A)") " integer :: n"
	write (u, "(2x,A)") " n = 1"
	write (u, "(2x,A)") "end function n_hel"
	write (u, *)
	write (u, "(2x,A)") "pure function n_cin () result (n)"
	write (u, "(2x,A)") " integer :: n"
	write (u, "(2x,A)") " n = 2"
	write (u, "(2x,A)") "end function n_cin"
	write (u, *)
	write (u, "(2x,A)") "pure function n_col () result (n)"
	write (u, "(2x,A)") " integer :: n"
	write (u, "(2x,A)") " n = 1"
	write (u, "(2x,A)") "end function n_col"
	write (u, *)
	write (u, "(2x,A)") "pure function n_cf () result (n)"
	write (u, "(2x,A)") " integer :: n"
	write (u, "(2x,A)") " n = 1"
	write (u, "(2x,A)") "end function n_cf"
	write (u, *)
	write (u, "(2x,A)") "pure subroutine flv_state (a)"
	write (u, "(2x,A)") " integer, dimension(:,:), intent(out) :: a"
	write (u, "(2x,A)") " a = reshape ([1,2,3], [3,1])"
	write (u, "(2x,A)") "end subroutine flv_state"
	write (u, *)
	write (u, "(2x,A)") "pure subroutine hel_state (a)"
	write (u, "(2x,A)") " integer, dimension(:,:), intent(out) :: a"
	write (u, "(2x,A)") " a = reshape ([0,0,0], [3,1])"
	write (u, "(2x,A)") "end subroutine hel_state"
	write (u, *)
	write (u, "(2x,A)") "pure subroutine col_state (a, g)"
	write (u, "(2x,A)") " integer, dimension(:,:,:), intent(out) :: a"
	write (u, "(2x,A)") " logical, dimension(:,:), intent(out) :: g"
	write (u, "(2x,A)") " a = reshape ([0,0, 0,0, 0,0], [2,3,1])"
	write (u, "(2x,A)") " g = reshape ([.false., .false., .false.], [3,1])"
	write (u, "(2x,A)") "end subroutine col_state"
	write (u, *)
	write (u, "(2x,A)") "pure subroutine color_factors (cf)"
	write (u, "(2x,A)") " type(OCF), dimension(:), intent(out) :: cf"
	write (u, "(2x,A)") " cf = [ OCF(1,1,+1._default) ]"
	write (u, "(2x,A)") "end subroutine color_factors"
	end subroutine write_test_me_code_2

	@ %def write_test_me_code_1 write_test_me_code_2
	@
	\subsubsection{Compile test with Fortran bind(C) library}
	Test 5: Write driver and makefile and try to compile and link the
	library driver.

	There is a single test process with a single feature. The process
	code is provided as a Fortran library of independent procedures.
	These procedures are bind(C).
	<<Prclib interfaces: execute tests>>=
	call test (prclib_interfaces_5, "prclib_interfaces_5", &
	"compile and link (Fortran library)", &
	u, results)
	<<Prclib interfaces: test declarations>>=
	public :: prclib_interfaces_5
	<<Prclib interfaces: tests>>=
	subroutine prclib_interfaces_5 (u)
	integer, intent(in) :: u
	class(prclib_driver_t), allocatable :: driver
	class(prc_writer_t), pointer :: test_writer_5
	type(os_data_t) :: os_data
	integer :: u_file

	integer, dimension(:,:), allocatable :: flv_state
	integer, dimension(:,:), allocatable :: hel_state
	integer, dimension(:,:,:), allocatable :: col_state
	logical, dimension(:,:), allocatable :: ghost_flag
	integer, dimension(:,:), allocatable :: cf_index
	complex(default), dimension(:), allocatable :: color_factors
	character(32), parameter :: md5sum = "prclib_interfaces_5_md5sum "

	type(c_funptr) :: proc1_ptr
	interface
	subroutine proc1_t (n) bind(C)
	import
	integer(c_int), intent(out) :: n
	end subroutine proc1_t
	end interface
	procedure(proc1_t), pointer :: proc1
	integer(c_int) :: n

	write (u, "(A)") "* Test output: prclib_interfaces_5"
	write (u, "(A)") "* Purpose: compile, link, and load process library"
	write (u, "(A)") "* with (fake) matrix-element code &
	&as a Fortran bind(C) library"
	write (u, *)
	write (u, "(A)") "* Create a prclib driver object (1 process)"
	write (u, "(A)")

	call os_data%init ()
	allocate (test_writer_5_t :: test_writer_5)

	call dispatch_prclib_driver (driver, var_str ("prclib5"), var_str (""))
	call driver%init (1)
	call driver%set_md5sum (md5sum)

	call driver%set_record (1, var_str ("test5"), var_str ("Test_model"), &
	[var_str ("proc1")], test_writer_5)

	call driver%write (u)

	write (u, *)
	write (u, "(A)") "* Write makefile"
	u_file = free_unit ()
	open (u_file, file="prclib5.makefile", status="replace", action="write")
	call driver%generate_makefile (u_file, os_data, verbose = .false.)
	close (u_file)

	write (u, "(A)") "* Write driver source code"
	u_file = free_unit ()
	open (u_file, file="prclib5.f90", status="replace", action="write")
	call driver%generate_driver_code (u_file)
	close (u_file)

	write (u, "(A)") "* Write matrix-element source code"
	call driver%make_source (os_data)

	write (u, "(A)") "* Compile source code"
	call driver%make_compile (os_data)

	write (u, "(A)") "* Link library"
	call driver%make_link (os_data)

	write (u, "(A)") "* Load library"
	call driver%load (os_data)

	write (u, *)
	call driver%write (u)
	write (u, *)

	if (driver%loaded) then
	write (u, "(A)") "* Call library functions:"
	write (u, *)
	write (u, "(1x,A,I0)") "n_processes = ", driver%get_n_processes ()
	write (u, "(1x,A,A)") "process_id = ", &
	char (driver%get_process_id (1))
	write (u, "(1x,A,A)") "model_name = ", &
	char (driver%get_model_name (1))
	write (u, "(1x,A,A)") "md5sum = ", &
	char (driver%get_md5sum (1))
	write (u, "(1x,A,L1)") "openmp_status = ", driver%get_openmp_status (1)
	write (u, "(1x,A,I0)") "n_in = ", driver%get_n_in (1)
	write (u, "(1x,A,I0)") "n_out = ", driver%get_n_out (1)
	write (u, "(1x,A,I0)") "n_flv = ", driver%get_n_flv (1)
	write (u, "(1x,A,I0)") "n_hel = ", driver%get_n_hel (1)
	write (u, "(1x,A,I0)") "n_col = ", driver%get_n_col (1)
	write (u, "(1x,A,I0)") "n_cin = ", driver%get_n_cin (1)
	write (u, "(1x,A,I0)") "n_cf = ", driver%get_n_cf (1)

	call driver%set_flv_state (1, flv_state)
	write (u, "(1x,A,10(1x,I0))") "flv_state =", flv_state

	call driver%set_hel_state (1, hel_state)
	write (u, "(1x,A,10(1x,I0))") "hel_state =", hel_state

	call driver%set_col_state (1, col_state, ghost_flag)
	write (u, "(1x,A,10(1x,I0))") "col_state =", col_state
	write (u, "(1x,A,10(1x,L1))") "ghost_flag =", ghost_flag

	call driver%set_color_factors (1, color_factors, cf_index)
	write (u, "(1x,A,10(1x,F5.3))") "color_factors =", color_factors
	write (u, "(1x,A,10(1x,I0))") "cf_index =", cf_index

	call driver%get_fptr (1, 1, proc1_ptr)
	call c_f_procpointer (proc1_ptr, proc1)
	if (associated (proc1)) then
	write (u, *)
	call proc1 (n)
	write (u, "(1x,A,I0)") "proc1(1) = ", n
	end if

	end if

	deallocate (test_writer_5)

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

	@ %def prclib_interfaces_5
	@ This version of test-code writer writes interfaces for all standard
	features plus one specific feature. The interfaces are all bind(C),
	so no wrapper is needed.
	<<Prclib interfaces: test types>>=
	type, extends (prc_writer_c_lib_t) :: test_writer_5_t
	contains
	procedure, nopass :: type_name => test_writer_5_type_name
	procedure :: write_makefile_code => test_writer_5_mk
	procedure :: write_source_code => test_writer_5_src
	procedure :: write_interface => test_writer_5_if
	procedure :: before_compile => test_writer_5_before_compile
	procedure :: after_compile => test_writer_5_after_compile
	end type test_writer_5_t

	@ %def test_writer_5
	@ The
	<<Prclib interfaces: test auxiliary>>=
	function test_writer_5_type_name () result (string)
	type(string_t) :: string
	string = "test_5"
	end function test_writer_5_type_name

	subroutine test_writer_5_mk &
	(writer, unit, id, os_data, verbose, testflag)
	class(test_writer_5_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	write (unit, "(5A)") "SOURCES += ", char (id), ".f90"
	write (unit, "(5A)") "OBJECTS += ", char (id), ".lo"
	write (unit, "(5A)") char (id), ".lo: ", char (id), ".f90"
	if (.not. verbose) then
	write (unit, "(5A)") TAB // '@echo " FC " $@'
	end if
	write (unit, "(5A)") TAB, "$(LTFCOMPILE) $<"
	end subroutine test_writer_5_mk

	subroutine test_writer_5_src (writer, id)
	class(test_writer_5_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	call write_test_f_lib_file (id, var_str ("proc1"))
	end subroutine test_writer_5_src

	subroutine test_writer_5_if (writer, unit, id, feature)
	class(test_writer_5_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id, feature
	select case (char (feature))
	case ("proc1")
	write (unit, "(2x,9A)") "interface"
	write (unit, "(5x,9A)") "subroutine ", &
	char (writer%get_c_procname (id, feature)), &
	" (n) bind(C)"
	write (unit, "(7x,9A)") "import"
	write (unit, "(7x,9A)") "implicit none"
	write (unit, "(7x,9A)") "integer(c_int), intent(out) :: n"
	write (unit, "(5x,9A)") "end subroutine ", &
	char (writer%get_c_procname (id, feature))
	write (unit, "(2x,9A)") "end interface"
	case default
	call writer%write_standard_interface (unit, id, feature)
	end select
	end subroutine test_writer_5_if

	subroutine test_writer_5_before_compile (writer, id)
	class(test_writer_5_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine test_writer_5_before_compile

	subroutine test_writer_5_after_compile (writer, id)
	class(test_writer_5_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	end subroutine test_writer_5_after_compile

	@ %def test_writer_5_type_name test_writer_5_mk
	@ %def test_writer_5_if
	@ %def test_writer_5_before_compile test_writer_5_after_compile
	@
	We need a test module file (actually, one for each process in the test
	above) that allows us to check compilation and linking. The test
	module implements a colorless $1\to 2$ process, and it implements one
	additional function (feature), the name given as an argument.
	<<Prclib interfaces: test auxiliary>>=
	subroutine write_test_f_lib_file (basename, feature)
	type(string_t), intent(in) :: basename
	type(string_t), intent(in) :: feature
	integer :: u
	u = free_unit ()
	open (u, file = char (basename) // ".f90", &
	status = "replace", action = "write")
	write (u, "(A)") "! (Pseudo) matrix element code file &
	&for WHIZARD self-test"
	call write_test_me_code_3 (u, char (basename))
	write (u, *)
	write (u, "(A)") "subroutine " // char (basename) // "_" &
	// char (feature) // " (n) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " integer(c_int), intent(out) :: n"
	write (u, "(A)") " n = 42"
	write (u, "(A)") "end subroutine " // char (basename) // "_" &
	// char (feature)
	close (u)
	end subroutine write_test_f_lib_file

	@ %def write_test_module_file
	@
	The following matrix-element source code is identical to the previous
	one, but modified such as to provide independent procedures without a
	module envelope.
	<<Prclib interfaces: test auxiliary>>=
	subroutine write_test_me_code_3 (u, id)
	integer, intent(in) :: u
	character(*), intent(in) :: id
	write (u, "(A)") "function " // id // "_get_md5sum () &
	&result (cptr) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " type(c_ptr) :: cptr"
	write (u, "(A)") " character(c_char), dimension(32), &
	&target, save :: md5sum"
	write (u, "(A)") " md5sum = copy (c_char_&
	&'1234567890abcdef1234567890abcdef')"
	write (u, "(A)") " cptr = c_loc (md5sum)"
	write (u, "(A)") "contains"
	write (u, "(A)") " function copy (md5sum)"
	write (u, "(A)") " character(c_char), dimension(32) :: copy"
	write (u, "(A)") " character(c_char), dimension(32), intent(in) :: &
	&md5sum"
	write (u, "(A)") " copy = md5sum"
	write (u, "(A)") " end function copy"
	write (u, "(A)") "end function " // id // "_get_md5sum"
	write (u, *)
	write (u, "(A)") "function " // id // "_openmp_supported () &
	&result (status) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " logical(c_bool) :: status"
	write (u, "(A)") " status = .false."
	write (u, "(A)") "end function " // id // "_openmp_supported"
	write (u, *)
	write (u, "(A)") "function " // id // "_n_in () result (n) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " integer(c_int) :: n"
	write (u, "(A)") " n = 1"
	write (u, "(A)") "end function " // id // "_n_in"
	write (u, *)
	write (u, "(A)") "function " // id // "_n_out () result (n) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " integer(c_int) :: n"
	write (u, "(A)") " n = 2"
	write (u, "(A)") "end function " // id // "_n_out"
	write (u, *)
	write (u, "(A)") "function " // id // "_n_flv () result (n) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " integer(c_int) :: n"
	write (u, "(A)") " n = 1"
	write (u, "(A)") "end function " // id // "_n_flv"
	write (u, *)
	write (u, "(A)") "function " // id // "_n_hel () result (n) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " integer(c_int) :: n"
	write (u, "(A)") " n = 1"
	write (u, "(A)") "end function " // id // "_n_hel"
	write (u, *)
	write (u, "(A)") "function " // id // "_n_cin () result (n) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " integer(c_int) :: n"
	write (u, "(A)") " n = 2"
	write (u, "(A)") "end function " // id // "_n_cin"
	write (u, *)
	write (u, "(A)") "function " // id // "_n_col () result (n) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " integer(c_int) :: n"
	write (u, "(A)") " n = 1"
	write (u, "(A)") "end function " // id // "_n_col"
	write (u, *)
	write (u, "(A)") "function " // id // "_n_cf () result (n) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " integer(c_int) :: n"
	write (u, "(A)") " n = 1"
	write (u, "(A)") "end function " // id // "_n_cf"
	write (u, *)
	write (u, "(A)") "subroutine " // id // "_flv_state (flv_state) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " integer(c_int), dimension(*), intent(out) :: flv_state"
	write (u, "(A)") " flv_state(1:3) = [1,2,3]"
	write (u, "(A)") "end subroutine " // id // "_flv_state"
	write (u, *)
	write (u, "(A)") "subroutine " // id // "_hel_state (hel_state) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " integer(c_int), dimension(*), intent(out) :: hel_state"
	write (u, "(A)") " hel_state(1:3) = [0,0,0]"
	write (u, "(A)") "end subroutine " // id // "_hel_state"
	write (u, *)
	write (u, "(A)") "subroutine " // id // "_col_state &
	&(col_state, ghost_flag) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " integer(c_int), dimension(*), intent(out) &
	&:: col_state"
	write (u, "(A)") " logical(c_bool), dimension(*), intent(out) &
	&:: ghost_flag"
	write (u, "(A)") " col_state(1:6) = [0,0, 0,0, 0,0]"
	write (u, "(A)") " ghost_flag(1:3) = [.false., .false., .false.]"
	write (u, "(A)") "end subroutine " // id // "_col_state"
	write (u, *)
	write (u, "(A)") "subroutine " // id // "_color_factors &
	&(cf_index1, cf_index2, color_factors) bind(C)"
	write (u, "(A)") " use iso_c_binding"
	write (u, "(A)") " use kinds"
	write (u, "(A)") " implicit none"
	write (u, "(A)") " integer(c_int), dimension(*), intent(out) :: cf_index1"
	write (u, "(A)") " integer(c_int), dimension(*), intent(out) :: cf_index2"
	write (u, "(A)") " complex(c_default_complex), dimension(*), &
	&intent(out) :: color_factors"
	write (u, "(A)") " cf_index1(1:1) = [1]"
	write (u, "(A)") " cf_index2(1:1) = [1]"
	write (u, "(A)") " color_factors(1:1) = [1]"
	write (u, "(A)") "end subroutine " // id // "_color_factors"
	end subroutine write_test_me_code_3

	@ %def write_test_me_code_3
	@
	\subsubsection{Compile test with genuine C library}
	Test 6: Write driver and makefile and try to compile and link the
	library driver.

	There is a single test process with a single feature. The process
	code is provided as a C library of independent procedures.
	These procedures should match the Fortran bind(C) interface.
	<<Prclib interfaces: execute tests>>=
	if (default == double .or. (CC_IS_GNU .and. CC_HAS_QUADMATH)) then
	call test (prclib_interfaces_6, "prclib_interfaces_6", &
	"compile and link (C library)", &
	u, results)
	end if
	<<Prclib interfaces: test declarations>>=
	public :: prclib_interfaces_6
	<<Prclib interfaces: tests>>=
	subroutine prclib_interfaces_6 (u)
	integer, intent(in) :: u
	class(prclib_driver_t), allocatable :: driver
	class(prc_writer_t), pointer :: test_writer_6
	type(os_data_t) :: os_data
	integer :: u_file

	integer, dimension(:,:), allocatable :: flv_state
	integer, dimension(:,:), allocatable :: hel_state
	integer, dimension(:,:,:), allocatable :: col_state
	logical, dimension(:,:), allocatable :: ghost_flag
	integer, dimension(:,:), allocatable :: cf_index
	complex(default), dimension(:), allocatable :: color_factors
	character(32), parameter :: md5sum = "prclib_interfaces_6_md5sum "

	type(c_funptr) :: proc1_ptr
	interface
	subroutine proc1_t (n) bind(C)
	import
	integer(c_int), intent(out) :: n
	end subroutine proc1_t
	end interface
	procedure(proc1_t), pointer :: proc1
	integer(c_int) :: n

	write (u, "(A)") "* Test output: prclib_interfaces_6"
	write (u, "(A)") "* Purpose: compile, link, and load process library"
	write (u, "(A)") "* with (fake) matrix-element code &
	&as a C library"
	write (u, *)
	write (u, "(A)") "* Create a prclib driver object (1 process)"
	write (u, "(A)")

	call os_data%init ()
	allocate (test_writer_6_t :: test_writer_6)

	call dispatch_prclib_driver (driver, var_str ("prclib6"), var_str (""))
	call driver%init (1)
	call driver%set_md5sum (md5sum)

	call driver%set_record (1, var_str ("test6"), var_str ("Test_model"), &
	[var_str ("proc1")], test_writer_6)

	call driver%write (u)

	write (u, *)
	write (u, "(A)") "* Write makefile"
	u_file = free_unit ()
	open (u_file, file="prclib6.makefile", status="replace", action="write")
	call driver%generate_makefile (u_file, os_data, verbose = .false.)
	close (u_file)

	write (u, "(A)") "* Write driver source code"
	u_file = free_unit ()
	open (u_file, file="prclib6.f90", status="replace", action="write")
	call driver%generate_driver_code (u_file)
	close (u_file)

	write (u, "(A)") "* Write matrix-element source code"
	call driver%make_source (os_data)

	write (u, "(A)") "* Compile source code"
	call driver%make_compile (os_data)

	write (u, "(A)") "* Link library"
	call driver%make_link (os_data)

	write (u, "(A)") "* Load library"
	call driver%load (os_data)

	write (u, *)
	call driver%write (u)
	write (u, *)

	if (driver%loaded) then
	write (u, "(A)") "* Call library functions:"
	write (u, *)
	write (u, "(1x,A,I0)") "n_processes = ", driver%get_n_processes ()
	write (u, "(1x,A,A)") "process_id = ", &
	char (driver%get_process_id (1))
	write (u, "(1x,A,A)") "model_name = ", &
	char (driver%get_model_name (1))
	write (u, "(1x,A,A)") "md5sum = ", &
	char (driver%get_md5sum (1))
	write (u, "(1x,A,L1)") "openmp_status = ", driver%get_openmp_status (1)
	write (u, "(1x,A,I0)") "n_in = ", driver%get_n_in (1)
	write (u, "(1x,A,I0)") "n_out = ", driver%get_n_out (1)
	write (u, "(1x,A,I0)") "n_flv = ", driver%get_n_flv (1)
	write (u, "(1x,A,I0)") "n_hel = ", driver%get_n_hel (1)
	write (u, "(1x,A,I0)") "n_col = ", driver%get_n_col (1)
	write (u, "(1x,A,I0)") "n_cin = ", driver%get_n_cin (1)
	write (u, "(1x,A,I0)") "n_cf = ", driver%get_n_cf (1)

	call driver%set_flv_state (1, flv_state)
	write (u, "(1x,A,10(1x,I0))") "flv_state =", flv_state

	call driver%set_hel_state (1, hel_state)
	write (u, "(1x,A,10(1x,I0))") "hel_state =", hel_state

	call driver%set_col_state (1, col_state, ghost_flag)
	write (u, "(1x,A,10(1x,I0))") "col_state =", col_state
	write (u, "(1x,A,10(1x,L1))") "ghost_flag =", ghost_flag

	call driver%set_color_factors (1, color_factors, cf_index)
	write (u, "(1x,A,10(1x,F5.3))") "color_factors =", color_factors
	write (u, "(1x,A,10(1x,I0))") "cf_index =", cf_index

	call driver%get_fptr (1, 1, proc1_ptr)
	call c_f_procpointer (proc1_ptr, proc1)
	if (associated (proc1)) then
	write (u, *)
	call proc1 (n)
	write (u, "(1x,A,I0)") "proc1(1) = ", n
	end if

	end if

	deallocate (test_writer_6)

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

	@ %def prclib_interfaces_6
	@ This version of test-code writer writes interfaces for all standard
	features plus one specific feature. The interfaces are all bind(C),
	so no wrapper is needed.

	The driver part is identical to the Fortran case, so we simply extend
	the previous [[test_writer_5]] type. We only have to override the
	Makefile writer.
	<<Prclib interfaces: test types>>=
	type, extends (test_writer_5_t) :: test_writer_6_t
	contains
	procedure, nopass :: type_name => test_writer_6_type_name
	procedure :: write_makefile_code => test_writer_6_mk
	procedure :: write_source_code => test_writer_6_src
	end type test_writer_6_t

	@ %def test_writer_6
	@
	<<Prclib interfaces: test auxiliary>>=
	function test_writer_6_type_name () result (string)
	type(string_t) :: string
	string = "test_6"
	end function test_writer_6_type_name

	subroutine test_writer_6_mk &
	(writer, unit, id, os_data, verbose, testflag)
	class(test_writer_6_t), intent(in) :: writer
	integer, intent(in) :: unit
	type(string_t), intent(in) :: id
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: verbose
	logical, intent(in), optional :: testflag
	write (unit, "(5A)") "SOURCES += ", char (id), ".c"
	write (unit, "(5A)") "OBJECTS += ", char (id), ".lo"
	write (unit, "(5A)") char (id), ".lo: ", char (id), ".c"
	if (.not. verbose) then
	write (unit, "(5A)") TAB // '@echo " FC " $@'
	end if
	write (unit, "(5A)") TAB, "$(LTCCOMPILE) $<"
	end subroutine test_writer_6_mk

	subroutine test_writer_6_src (writer, id)
	class(test_writer_6_t), intent(in) :: writer
	type(string_t), intent(in) :: id
	call write_test_c_lib_file (id, var_str ("proc1"))
	end subroutine test_writer_6_src

	@ %def test_writer_6_type_name test_writer_6_mk
	@
	We need a test module file (actually, one for each process in the test
	above) that allows us to check compilation and linking. The test
	module implements a colorless $1\to 2$ process, and it implements one
	additional function (feature), the name given as an argument.
	<<Prclib interfaces: test auxiliary>>=
	subroutine write_test_c_lib_file (basename, feature)
	type(string_t), intent(in) :: basename
	type(string_t), intent(in) :: feature
	integer :: u
	u = free_unit ()
	open (u, file = char (basename) // ".c", &
	status = "replace", action = "write")
	write (u, "(A)") "/* (Pseudo) matrix element code file &
	&for WHIZARD self-test */"
	write (u, "(A)") "#include <stdbool.h>"
	if (CC_HAS_QUADMATH) then
	write (u, "(A)") "#include <quadmath.h>"
	end if
	write (u, *)
	call write_test_me_code_4 (u, char (basename))
	write (u, *)
	write (u, "(A)") "void " // char (basename) // "_" &
	// char (feature) // "(int* n) {"
	write (u, "(A)") " *n = 42;"
	write (u, "(A)") "}"
	close (u)
	end subroutine write_test_c_lib_file

	@ %def write_test_module_file
	@
	The following matrix-element source code is equivalent to the code in
	the previous example, but coded in C.
	<<Prclib interfaces: test auxiliary>>=
	subroutine write_test_me_code_4 (u, id)
	integer, intent(in) :: u
	character(*), intent(in) :: id
	write (u, "(A)") "char* " // id // "_get_md5sum() {"
	write (u, "(A)") " return ""1234567890abcdef1234567890abcdef"";"
	write (u, "(A)") "}"
	write (u, *)
	write (u, "(A)") "bool " // id // "_openmp_supported() {"
	write (u, "(A)") " return false;"
	write (u, "(A)") "}"
	write (u, *)
	write (u, "(A)") "int " // id // "_n_in() {"
	write (u, "(A)") " return 1;"
	write (u, "(A)") "}"
	write (u, *)
	write (u, "(A)") "int " // id // "_n_out() {"
	write (u, "(A)") " return 2;"
	write (u, "(A)") "}"
	write (u, *)
	write (u, "(A)") "int " // id // "_n_flv() {"
	write (u, "(A)") " return 1;"
	write (u, "(A)") "}"
	write (u, *)
	write (u, "(A)") "int " // id // "_n_hel() {"
	write (u, "(A)") " return 1;"
	write (u, "(A)") "}"
	write (u, *)
	write (u, "(A)") "int " // id // "_n_cin() {"
	write (u, "(A)") " return 2;"
	write (u, "(A)") "}"
	write (u, *)
	write (u, "(A)") "int " // id // "_n_col() {"
	write (u, "(A)") " return 1;"
	write (u, "(A)") "}"
	write (u, *)
	write (u, "(A)") "int " // id // "_n_cf() {"
	write (u, "(A)") " return 1;"
	write (u, "(A)") "}"
	write (u, *)
	write (u, "(A)") "void " // id // "_flv_state( int (*a)[] ) {"
	write (u, "(A)") " static int flv_state[1][3] = { { 1, 2, 3 } };"
	write (u, "(A)") " int j;"
	write (u, "(A)") " for (j = 0; j < 3; j++) { (*a)[j] &
	&= flv_state[0][j]; }"
	write (u, "(A)") "}"
	write (u, *)
	write (u, "(A)") "void " // id // "_hel_state( int (*a)[] ) {"
	write (u, "(A)") " static int hel_state[1][3] = { { 0, 0, 0 } };"
	write (u, "(A)") " int j;"
	write (u, "(A)") " for (j = 0; j < 3; j++) { (*a)[j] &
	&= hel_state[0][j]; }"
	write (u, "(A)") "}"
	write (u, *)
	write (u, "(A)") "void " // id // "_col_state&
	&( int (a)[], bool (g)[] ) {"
	write (u, "(A)") " static int col_state[1][3][2] = &
	&{ { {0, 0}, {0, 0}, {0, 0} } };"
	write (u, "(A)") " static bool ghost_flag[1][3] = &
	&{ { false, false, false } };"
	write (u, "(A)") " int j,k;"
	write (u, "(A)") " for (j = 0; j < 3; j++) {"
	write (u, "(A)") " for (k = 0; k < 2; k++) {"
	write (u, "(A)") " (a)[j2+k] = col_state[0][j][k];"
	write (u, "(A)") " }"
	write (u, "(A)") " (*g)[j] = ghost_flag[0][j];"
	write (u, "(A)") " }"
	write (u, "(A)") "}"
	write (u, *)
	select case (DEFAULT_FC_PRECISION)
	case ("quadruple")
	write (u, "(A)") "void " // id // "_color_factors&
	&( int (cf_index1)[], int (cf_index2)[], &
	&__complex128 (*color_factors)[] ) {"
	case ("extended")
	write (u, "(A)") "void " // id // "_color_factors&
	&( int (cf_index1)[], int (cf_index2)[], &
	&long double _Complex (*color_factors)[] ) {"
	case default
	write (u, "(A)") "void " // id // "_color_factors&
	&( int (cf_index1)[], int (cf_index2)[], &
	&double _Complex (*color_factors)[] ) {"
	end select
	write (u, "(A)") " (*color_factors)[0] = 1;"
	write (u, "(A)") " (*cf_index1)[0] = 1;"
	write (u, "(A)") " (*cf_index2)[0] = 1;"
	write (u, "(A)") "}"
	end subroutine write_test_me_code_4

	@ %def write_test_me_code_4
	@
	\subsubsection{Test cleanup targets}
	Test 7: Repeat test 4 (create, compile, link Fortran module and
	driver) and properly clean up all generated files.
	<<Prclib interfaces: execute tests>>=
	call test (prclib_interfaces_7, "prclib_interfaces_7", &
	"cleanup", &
	u, results)
	<<Prclib interfaces: test declarations>>=
	public :: prclib_interfaces_7
	<<Prclib interfaces: tests>>=
	subroutine prclib_interfaces_7 (u)
	integer, intent(in) :: u
	class(prclib_driver_t), allocatable :: driver
	class(prc_writer_t), pointer :: test_writer_4
	type(os_data_t) :: os_data
	integer :: u_file
	character(32), parameter :: md5sum = "1234567890abcdef1234567890abcdef"

	write (u, "(A)") "* Test output: prclib_interfaces_7"
	write (u, "(A)") "* Purpose: compile and link process library"
	write (u, "(A)") "* with (fake) matrix-element code &
	&as a Fortran module"
	write (u, "(A)") "* then clean up generated files"
	write (u, *)
	write (u, "(A)") "* Create a prclib driver object (1 process)"

	allocate (test_writer_4_t :: test_writer_4)

	call os_data%init ()
	call dispatch_prclib_driver (driver, var_str ("prclib7"), var_str (""))
	call driver%init (1)
	call driver%set_md5sum (md5sum)
	call driver%set_record (1, var_str ("test7"), var_str ("Test_model"), &
	[var_str ("proc1")], test_writer_4)

	write (u, "(A)") "* Write makefile"
	u_file = free_unit ()
	open (u_file, file="prclib7.makefile", status="replace", action="write")
	call driver%generate_makefile (u_file, os_data, verbose = .false.)
	close (u_file)

	write (u, "(A)") "* Write driver source code"
	u_file = free_unit ()
	open (u_file, file="prclib7.f90", status="replace", action="write")
	call driver%generate_driver_code (u_file)
	close (u_file)

	write (u, "(A)") "* Write matrix-element source code"
	call driver%make_source (os_data)

	write (u, "(A)") "* Compile source code"
	call driver%make_compile (os_data)

	write (u, "(A)") "* Link library"
	call driver%make_link (os_data)


	write (u, "(A)") "* File check"
	write (u, *)
	call check_file (u, "test7.f90")
	call check_file (u, "tpr_test7.mod")
	call check_file (u, "test7.lo")
	call check_file (u, "prclib7.makefile")
	call check_file (u, "prclib7.f90")
	call check_file (u, "prclib7.lo")
	call check_file (u, "prclib7.la")

	write (u, *)
	write (u, "(A)") "* Delete library"
	write (u, *)
	call driver%clean_library (os_data)
	call check_file (u, "prclib7.la")

	write (u, *)
	write (u, "(A)") "* Delete object code"
	write (u, *)
	call driver%clean_objects (os_data)
	call check_file (u, "test7.lo")
	call check_file (u, "tpr_test7.mod")
	call check_file (u, "prclib7.lo")

	write (u, *)
	write (u, "(A)") "* Delete source code"
	write (u, *)
	call driver%clean_source (os_data)
	call check_file (u, "test7.f90")

	write (u, *)
	write (u, "(A)") "* Delete driver source code"
	write (u, *)
	call driver%clean_driver (os_data)
	call check_file (u, "prclib7.f90")

	write (u, *)
	write (u, "(A)") "* Delete makefile"
	write (u, *)
	call driver%clean_makefile (os_data)
	call check_file (u, "prclib7.makefile")

	deallocate (test_writer_4)

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

	@ %def prclib_interfaces_7
	@ Auxiliary routine: check and report existence of a file
	<<Prclib interfaces: test auxiliary>>=
	subroutine check_file (u, file)
	integer, intent(in) :: u
	character(*), intent(in) :: file
	logical :: exist
	inquire (file=file, exist=exist)
	write (u, "(2x,A,A,L1)") file, " = ", exist
	end subroutine check_file

	@ %def check_file
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Abstract process core configuration}
	In this module, we define abstract data types that handle the method-specific
	part of defining a process (including all of its options) and accessing an
	external matrix element.

	There are no unit tests, these are deferred to the [[process_libraries]]
	module below.
	<<[[prc_core_def.f90]]>>=
	<<File header>>

	module prc_core_def

	<<Use strings>>
	use process_constants
	use prclib_interfaces

	<<Standard module head>>

	<<Prc core def: public>>

	<<Prc core def: types>>

	<<Prc core def: interfaces>>

	interface
	<<Prc core def: sub interfaces>>
	end interface

	end module prc_core_def
	@ %def prc_core_def
	@
	<<[[prc_core_def_sub.f90]]>>=
	<<File header>>

	submodule (prc_core_def) prc_core_def_s

	use io_units
	use diagnostics

	implicit none

	contains

	<<Prc core def: procedures>>

	end submodule prc_core_def_s

	@ %def prc_core_def_s
	@
	\subsection{Process core definition type}
	For storing configuration data that depend on the specific process
	variant, we introduce a polymorphic type. At this point, we just
	declare an abstract base type. This allows us to defer the
	implementation to later modules.

	There should be no components that need explicit finalization,
	otherwise we would have to call a finalizer from the
	[[process_component_def_t]] wrapper.

	@ Translate a [[prc_core_def_t]] to above named integers
	<<Prc core def: public>>=
	public :: prc_core_def_t
	<<Prc core def: types>>=
	type, abstract :: prc_core_def_t
	class(prc_writer_t), allocatable :: writer
	contains
	<<Prc core def: process core def: TBP>>
	end type prc_core_def_t

	@ %def prc_core_def_t
	@ Interfaces for the deferred methods.

	This returns a string. No passed argument; the string is constant and
	depends just on the type.
	<<Prc core def: process core def: TBP>>=
	procedure (prc_core_def_get_string), nopass, deferred :: type_string
	<<Prc core def: interfaces>>=
	abstract interface
	function prc_core_def_get_string () result (string)
	import
	type(string_t) :: string
	end function prc_core_def_get_string
	end interface

	@ %def prc_core_def_get_string
	@
	The [[write]] method should
	display the content completely.
	<<Prc core def: process core def: TBP>>=
	procedure (prc_core_def_write), deferred :: write
	<<Prc core def: interfaces>>=
	abstract interface
	subroutine prc_core_def_write (object, unit)
	import
	class(prc_core_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine prc_core_def_write
	end interface

	@ %def prc_core_def_write
	@
	The [[read]] method should
	fill the content completely.
	<<Prc core def: process core def: TBP>>=
	procedure (prc_core_def_read), deferred :: read
	<<Prc core def: interfaces>>=
	abstract interface
	subroutine prc_core_def_read (object, unit)
	import
	class(prc_core_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine prc_core_def_read
	end interface

	@ %def prc_core_def_read
	@ This communicates a MD5 checksum to the writer inside the [[core_def]]
	object, if there is any. Usually, this checksum is not yet known at the time
	when the writer is initialized.
	<<Prc core def: process core def: TBP>>=
	procedure :: set_md5sum => prc_core_def_set_md5sum
	<<Prc core def: sub interfaces>>=
	module subroutine prc_core_def_set_md5sum (core_def, md5sum)
	class(prc_core_def_t), intent(inout) :: core_def
	character(32) :: md5sum
	end subroutine prc_core_def_set_md5sum
	<<Prc core def: procedures>>=
	module subroutine prc_core_def_set_md5sum (core_def, md5sum)
	class(prc_core_def_t), intent(inout) :: core_def
	character(32) :: md5sum
	if (allocated (core_def%writer)) core_def%writer%md5sum = md5sum
	end subroutine prc_core_def_set_md5sum

	@ %def prc_core_def_set_md5sum
	@ Allocate an appropriate driver object which corresponds to the
	chosen process core definition.

	For internal matrix element (i.e., those which do not need external
	code), the driver should have access to all matrix element information
	from the beginning. In short, it is the matrix-element code.

	For external matrix elements, the driver will get access to the
	external matrix element code.
	<<Prc core def: process core def: TBP>>=
	procedure(prc_core_def_allocate_driver), deferred :: allocate_driver
	<<Prc core def: interfaces>>=
	abstract interface
	subroutine prc_core_def_allocate_driver (object, driver, basename)
	import
	class(prc_core_def_t), intent(in) :: object
	class(prc_core_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	end subroutine prc_core_def_allocate_driver
	end interface

	@ %def prc_core_def_allocate_driver
	@ This flag tells whether the particular variant needs external code.
	We implement a default function which returns false. The flag
	depends only on the type, therefore we implement it as [[nopass]].
	<<Prc core def: process core def: TBP>>=
	procedure, nopass :: needs_code => prc_core_def_needs_code
	<<Prc core def: sub interfaces>>=
	module function prc_core_def_needs_code () result (flag)
	logical :: flag
	end function prc_core_def_needs_code
	<<Prc core def: procedures>>=
	module function prc_core_def_needs_code () result (flag)
	logical :: flag
	flag = .false.
	end function prc_core_def_needs_code

	@ %def prc_core_def_needs_code
	@ This subroutine allocates an array which holds the name of all
	features that this process core implements. This feature
	applies to matrix element code that is not coded as a Fortran module
	but communicates via independent library functions, which follow the C
	calling conventions. The addresses of those functions are returned as
	C function pointers, which can be converted into Fortran procedure
	pointers. The conversion is done in code specific for the process
	variant; here we just retrieve the C function pointer.

	The array returned here serves the purpose of writing specific
	driver code. The driver interfaces only those C functions which are
	supported for the given process core.

	If the process core does not require external code, this array is
	meaningless.
	<<Prc core def: process core def: TBP>>=
	procedure(prc_core_def_get_features), nopass, deferred &
	:: get_features
	<<Prc core def: interfaces>>=
	abstract interface
	subroutine prc_core_def_get_features (features)
	import
	type(string_t), dimension(:), allocatable, intent(out) :: features
	end subroutine prc_core_def_get_features
	end interface

	@ %def prc_core_def_get_features
	@ Assign pointers to the process-specific procedures to the driver, if
	the process is external.
	<<Prc core def: process core def: TBP>>=
	procedure(prc_core_def_connect), deferred :: connect
	<<Prc core def: interfaces>>=
	abstract interface
	subroutine prc_core_def_connect (def, lib_driver, i, proc_driver)
	import
	class(prc_core_def_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	end subroutine prc_core_def_connect
	end interface

	@ %def prc_core_def_connect
	@
	\subsection{Process core template}
	We must be able to automatically allocate a process core definition object
	with the appropriate type, given only the type name.

	To this end, we introduce a [[prc_template_t]] type which is simply a wrapper
	for an empty [[prc_core_def_t]] object. Choosing one of the templates from an
	array, we can allocate the target object.
	<<Prc core def: public>>=
	public :: prc_template_t
	<<Prc core def: types>>=
	type :: prc_template_t
	class(prc_core_def_t), allocatable :: core_def
	end type prc_template_t

	@ %def prc_template_t
	@ The allocation routine. We use the [[source]] option of the [[allocate]]
	statement. The [[mold]] option would probably more appropriate, but is a
	F2008 feature.
	<<Prc core def: public>>=
	public :: allocate_core_def
	<<Prc core def: sub interfaces>>=
	module subroutine allocate_core_def (template, name, core_def)
	type(prc_template_t), dimension(:), intent(in) :: template
	type(string_t), intent(in) :: name
	class(prc_core_def_t), allocatable :: core_def
	end subroutine allocate_core_def
	<<Prc core def: procedures>>=
	module subroutine allocate_core_def (template, name, core_def)
	type(prc_template_t), dimension(:), intent(in) :: template
	type(string_t), intent(in) :: name
	class(prc_core_def_t), allocatable :: core_def
	integer :: i
	do i = 1, size (template)
	if (template(i)%core_def%type_string () == name) then
	allocate (core_def, source = template(i)%core_def)
	return
	end if
	end do
	end subroutine allocate_core_def

	@ %def allocate_core_def
	@
	\subsection{Process driver}
	For each process component, we implement a driver object which holds
	the calls to the matrix element and various auxiliary routines as
	procedure pointers. Any actual calculation will use this object to
	communicate with the process.

	Depending on the type of process (as described by a corresponding
	[[prc_core_def]] object), the procedure pointers may refer to
	external or internal code, and there may be additional procedures for
	certain types. The base type defined here is abstract.
	<<Prc core def: public>>=
	public :: prc_core_driver_t
	<<Prc core def: types>>=
	type, abstract :: prc_core_driver_t
	contains
	<<Prc core def: process driver: TBP>>
	end type prc_core_driver_t

	@ %def prc_core_driver_t
	@ This returns the process type. No reference to contents.
	<<Prc core def: process driver: TBP>>=
	procedure(prc_core_driver_type_name), nopass, deferred :: type_name
	<<Prc core def: interfaces>>=
	abstract interface
	function prc_core_driver_type_name () result (type)
	import
	type(string_t) :: type
	end function prc_core_driver_type_name
	end interface

	@ %def prc_core_driver_type_name
	@
	\subsection{Process driver for intrinsic process}
	This is an abstract extension for the driver type. It has one
	additional method, namely a subroutine that fills the record of
	constant process data. For an external process, this task is
	performed by the external library driver instead.
	<<Prc core def: public>>=
	public :: process_driver_internal_t
	<<Prc core def: types>>=
	type, extends (prc_core_driver_t), abstract :: process_driver_internal_t
	contains
	<<Prc core def: process driver internal: TBP>>
	end type process_driver_internal_t

	@ %def process_driver_internal_t
	<<Prc core def: process driver internal: TBP>>=
	procedure(process_driver_fill_constants), deferred :: fill_constants
	<<Prc core def: interfaces>>=
	abstract interface
	subroutine process_driver_fill_constants (driver, data)
	import
	class(process_driver_internal_t), intent(in) :: driver
	type(process_constants_t), intent(out) :: data
	end subroutine process_driver_fill_constants
	end interface

	@ %def process_driver_fill_constants
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process library access}
	\label{sec:process_libraries}
	Processes (the code and data that are necessary for evaluating matrix
	elements of a particular process or process component) are organized
	in process libraries. In full form, process libraries contain
	generated and dynamically compiled and linked code, so they are actual
	libraries on the OS level. Alternatively, there may be simple
	processes that can be generated without referring to external
	libraries, and external libraries that are just linked in.

	This module interfaces the OS to create, build, and use process
	libraries.

	We work with two related data structures. There is the list of
	process configurations that stores the user input and data derived
	from it. A given process configuration list is scanned for creating a
	process library, which consists of both data and code. The creation
	step involves calling external programs and incorporating external
	code.

	For the subsequent integration and event generation steps, we read the
	process library. We also support partial (re)creation of the process
	library. To this end, we should be able to reconstruct the
	configuration data records from the process library.
	<<[[process_libraries.f90]]>>=
	<<File header>>

	module process_libraries

	use, intrinsic :: iso_c_binding !NODEP!

	<<Use strings>>
	use physics_defs
	use os_interface
	use model_data
	use particle_specifiers
	use process_constants
	use prclib_interfaces
	use prc_core_def

	<<Standard module head>>

	<<Process libraries: public>>

	<<Process libraries: parameters>>

	<<Process libraries: types>>

	interface
	<<Process libraries: sub interfaces>>
	end interface

	end module process_libraries

	@ %def process_libraries
	@
	<<[[process_libraries_sub.f90]]>>=
	<<File header>>

	submodule (process_libraries) process_libraries_s

	use io_units
	use diagnostics
	use md5

	implicit none

	contains

	<<Process libraries: procedures>>

	end submodule process_libraries_s

	@ %def process_libraries_s
	@
	\subsection{Auxiliary stuff}
	Here is a small subroutine that strips the left-hand side and the
	equals sign off an equation.
	<<Process libraries: public>>=
	public :: strip_equation_lhs
	<<Process libraries: sub interfaces>>=
	module subroutine strip_equation_lhs (buffer)
	character(*), intent(inout) :: buffer
	end subroutine strip_equation_lhs
	<<Process libraries: procedures>>=
	module subroutine strip_equation_lhs (buffer)
	character(*), intent(inout) :: buffer
	type(string_t) :: string, prefix
	string = buffer
	call split (string, prefix, "=")
	buffer = string
	end subroutine strip_equation_lhs

	@ %def strip_equation_lhs
	@
	\subsection{Process definition objects}
	We collect process configuration data in a derived type,
	[[process_def_t]]. A process can be a collection of several
	components which are treated as a single entity for the purpose of
	observables and event generation. Multiple process components may
	initially be defined by the user. The system may add additional
	components, e.g., subtraction terms. The common data type is
	[[process_component_def_t]]. Within each component, there are several
	universal data items, and a part which depend on the particular
	process variant. The latter is covered by an abstract type
	[[prc_core_def_t]] and its extensions.

	@
	\subsubsection{Wrapper for components}
	We define a wrapper type for the configuration of individual
	components.

	The string [[basename]] is used for building file, module, and
	function names for the current process component. Initially, it will
	be built from the corresponding process basename by appending an
	alphanumeric suffix.

	The logical [[initial]] tells whether this is a user-defined (true) or
	system-generated (false) configuration.

	The numbers [[n_in]], [[n_out]], and [[n_tot]] denote the incoming,
	outgoing and total number of particles (partons) participating in the
	process component, respectively. These are the nominal particles, as
	input by the user (recombination may change the particle content, for
	the output events).

	The string arrays [[prt_in]] and [[prt_out]] hold the particle
	specifications as provided by the user. For a system-generated
	process component, they remain deallocated.

	The [[method]] string is used to determine the type of process matrix
	element and how it is obtained.

	The [[description]] string collects the information about particle
	content and method in a single human-readable string.

	The pointer object [[core_def]] is allocated according to the
	actual process variant, which depends on the method. The subobject
	holds any additional configuration data that is relevant for the
	process component.

	We assume that no finalizer is needed.
	<<Process libraries: public>>=
	public :: process_component_def_t
	<<Process libraries: types>>=
	type :: process_component_def_t
	private
	type(string_t) :: basename
	logical :: initial = .false.
	integer :: n_in = 0
	integer :: n_out = 0
	integer :: n_tot = 0
	type(prt_spec_t), dimension(:), allocatable :: prt_in
	type(prt_spec_t), dimension(:), allocatable :: prt_out
	type(string_t) :: method
	type(string_t) :: description
	class(prc_core_def_t), allocatable :: core_def
	character(32) :: md5sum = ""
	integer :: nlo_type = BORN
	integer, dimension(N_ASSOCIATED_COMPONENTS) :: associated_components = 0
	logical :: active
	integer :: fixed_emitter = -1
	integer :: alpha_power = 0
	integer :: alphas_power = 0
	contains
	<<Process libraries: process component def: TBP>>
	end type process_component_def_t

	@ %def process_component_def_t
	@ Display the complete content.
	<<Process libraries: process component def: TBP>>=
	procedure :: write => process_component_def_write
	<<Process libraries: sub interfaces>>=
	module subroutine process_component_def_write (object, unit)
	class(process_component_def_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine process_component_def_write
	<<Process libraries: procedures>>=
	module subroutine process_component_def_write (object, unit)
	class(process_component_def_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(3x,A,A)") "Component ID = ", char (object%basename)
	write (u, "(3x,A,L1)") "Initial component = ", object%initial
	write (u, "(3x,A,I0,1x,I0,1x,I0)") "N (in, out, tot) = ", &
	object%n_in, object%n_out, object%n_tot
	write (u, "(3x,A)", advance="no") "Particle content = "
	if (allocated (object%prt_in)) then
	call prt_spec_write (object%prt_in, u, advance="no")
	else
	write (u, "(A)", advance="no") "[undefined]"
	end if
	write (u, "(A)", advance="no") " => "
	if (allocated (object%prt_out)) then
	call prt_spec_write (object%prt_out, u, advance="no")
	else
	write (u, "(A)", advance="no") "[undefined]"
	end if
	write (u, "(A)")
	if (object%method /= "") then
	write (u, "(3x,A,A)") "Method = ", &
	char (object%method)
	else
	write (u, "(3x,A)") "Method = [undefined]"
	end if
	if (allocated (object%core_def)) then
	write (u, "(3x,A,A)") "Process variant = ", &
	char (object%core_def%type_string ())
	call object%core_def%write (u)
	else
	write (u, "(3x,A)") "Process variant = [undefined]"
	end if
	write (u, "(3x,A,A,A)") "MD5 sum (def) = '", object%md5sum, "'"
	end subroutine process_component_def_write

	@ %def process_component_def_write
	@ Read the process component definition. Allocate the process variant
	definition with appropriate type, matching the type name on file with
	the provided templates.
	<<Process libraries: process component def: TBP>>=
	procedure :: read => process_component_def_read
	<<Process libraries: sub interfaces>>=
	module subroutine process_component_def_read (component, unit, core_def_templates)
	class(process_component_def_t), intent(out) :: component
	integer, intent(in) :: unit
	type(prc_template_t), dimension(:), intent(in) :: core_def_templates
	end subroutine process_component_def_read
	<<Process libraries: procedures>>=
	module subroutine process_component_def_read (component, unit, core_def_templates)
	class(process_component_def_t), intent(out) :: component
	integer, intent(in) :: unit
	type(prc_template_t), dimension(:), intent(in) :: core_def_templates
	character(80) :: buffer
	type(string_t) :: var_buffer, prefix, in_state, out_state
	type(string_t) :: variant_type

	read (unit, "(A)") buffer
	call strip_equation_lhs (buffer)
	component%basename = trim (adjustl (buffer))

	read (unit, "(A)") buffer
	call strip_equation_lhs (buffer)
	read (buffer, *) component%initial

	read (unit, "(A)") buffer
	call strip_equation_lhs (buffer)
	read (buffer, *) component%n_in, component%n_out, component%n_tot

	call get (unit, var_buffer)
	call split (var_buffer, prefix, "=") ! keeps 'in => out'
	call split (var_buffer, prefix, "=") ! actually: separator is '=>'

	in_state = prefix
	if (component%n_in > 0) then
	call prt_spec_read (component%prt_in, in_state)
	end if

	out_state = extract (var_buffer, 2)
	if (component%n_out > 0) then
	call prt_spec_read (component%prt_out, out_state)
	end if

	read (unit, "(A)") buffer
	call strip_equation_lhs (buffer)
	component%method = trim (adjustl (buffer))
	if (component%method == "[undefined]") &
	component%method = ""

	read (unit, "(A)") buffer
	call strip_equation_lhs (buffer)
	variant_type = trim (adjustl (buffer))
	call allocate_core_def &
	(core_def_templates, variant_type, component%core_def)
	if (allocated (component%core_def)) then
	call component%core_def%read (unit)
	end if

	read (unit, "(A)") buffer
	call strip_equation_lhs (buffer)
	read (buffer(3:34), "(A32)") component%md5sum

	end subroutine process_component_def_read

	@ %def process_component_def_read
	@ Short account.
	<<Process libraries: process component def: TBP>>=
	procedure :: show => process_component_def_show
	<<Process libraries: sub interfaces>>=
	module subroutine process_component_def_show (object, unit)
	class(process_component_def_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine process_component_def_show
	<<Process libraries: procedures>>=
	module subroutine process_component_def_show (object, unit)
	class(process_component_def_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(6x,A)", advance="no") char (object%basename)
	if (.not. object%initial) &
	write (u, "('*')", advance="no")
	write (u, "(':',1x)", advance="no")
	if (allocated (object%prt_in)) then
	call prt_spec_write (object%prt_in, u, advance="no")
	else
	write (u, "(A)", advance="no") "[undefined]"
	end if
	write (u, "(A)", advance="no") " => "
	if (allocated (object%prt_out)) then
	call prt_spec_write (object%prt_out, u, advance="no")
	else
	write (u, "(A)", advance="no") "[undefined]"
	end if
	if (object%method /= "") then
	write (u, "(2x,'[',A,']')") char (object%method)
	else
	write (u, *)
	end if
	end subroutine process_component_def_show

	@ %def process_component_def_show
	@ Compute the MD5 sum of a process component. We reset the stored MD5
	sum to the empty string (so a previous value is not included in the
	calculation), then write a temporary file and calculate the MD5 sum of
	that file.

	This implies that all data that are displayed by the [[write]] method
	become part of the MD5 sum calculation.

	The [[model]] is not part of the object, but must be included in the MD5 sum.
	Otherwise, modifying the model and nothing else would not trigger remaking the
	process-component source. Note that the model parameters may change later and
	therefore are not incorporated.

	After the MD5 sum of the component has been computed, we communicate it to the
	[[writer]] subobject of the specific [[core_def]] component. Although these
	types are abstract, the MD5-related features are valid for the abstract
	types.
	<<Process libraries: process component def: TBP>>=
	procedure :: compute_md5sum => process_component_def_compute_md5sum
	<<Process libraries: sub interfaces>>=
	module subroutine process_component_def_compute_md5sum (component, model)
	class(process_component_def_t), intent(inout) :: component
	class(model_data_t), intent(in), optional, target :: model
	end subroutine process_component_def_compute_md5sum
	<<Process libraries: procedures>>=
	module subroutine process_component_def_compute_md5sum (component, model)
	class(process_component_def_t), intent(inout) :: component
	class(model_data_t), intent(in), optional, target :: model
	integer :: u
	component%md5sum = ""
	u = free_unit ()
	open (u, status = "scratch", action = "readwrite")
	if (present (model)) write (u, "(A32)") model%get_md5sum ()
	call component%write (u)
	rewind (u)
	component%md5sum = md5sum (u)
	close (u)
	if (allocated (component%core_def)) then
	call component%core_def%set_md5sum (component%md5sum)
	end if
	end subroutine process_component_def_compute_md5sum

	@ %def process_component_def_compute_md5sum
	@
	<<Process libraries: process component def: TBP>>=
	procedure :: get_def_type_string => process_component_def_get_def_type_string
	<<Process libraries: sub interfaces>>=
	module function process_component_def_get_def_type_string (component) result (type_string)
	type(string_t) :: type_string
	class(process_component_def_t), intent(in) :: component
	end function process_component_def_get_def_type_string
	<<Process libraries: procedures>>=
	module function process_component_def_get_def_type_string (component) result (type_string)
	type(string_t) :: type_string
	class(process_component_def_t), intent(in) :: component
	type_string = component%core_def%type_string ()
	end function process_component_def_get_def_type_string

	@ %def process_component_def_get_def_type_string
	@ Allocate the process driver (with a suitable type) for a process
	component. For internal processes, we may set all data already at
	this stage.
	<<Process libraries: process component def: TBP>>=
	procedure :: allocate_driver => process_component_def_allocate_driver
	<<Process libraries: sub interfaces>>=
	module subroutine process_component_def_allocate_driver (component, driver)
	class(process_component_def_t), intent(in) :: component
	class(prc_core_driver_t), intent(out), allocatable :: driver
	end subroutine process_component_def_allocate_driver
	<<Process libraries: procedures>>=
	module subroutine process_component_def_allocate_driver (component, driver)
	class(process_component_def_t), intent(in) :: component
	class(prc_core_driver_t), intent(out), allocatable :: driver
	if (allocated (component%core_def)) then
	call component%core_def%allocate_driver (driver, component%basename)
	end if
	end subroutine process_component_def_allocate_driver

	@ %def process_component_def_allocate_driver
	@ Tell whether the process core needs external code.
	<<Process libraries: process component def: TBP>>=
	procedure :: needs_code => process_component_def_needs_code
	<<Process libraries: sub interfaces>>=
	module function process_component_def_needs_code (component) result (flag)
	class(process_component_def_t), intent(in) :: component
	logical :: flag
	end function process_component_def_needs_code
	<<Process libraries: procedures>>=
	module function process_component_def_needs_code (component) result (flag)
	class(process_component_def_t), intent(in) :: component
	logical :: flag
	flag = component%core_def%needs_code ()
	end function process_component_def_needs_code

	@ %def process_component_def_needs_code
	@ If there is external code, the [[core_def]] subobject should
	provide a writer object. This method returns a pointer to the writer.
	<<Process libraries: process component def: TBP>>=
	procedure :: get_writer_ptr => process_component_def_get_writer_ptr
	<<Process libraries: sub interfaces>>=
	module function process_component_def_get_writer_ptr (component) result (writer)
	class(process_component_def_t), intent(in), target :: component
	class(prc_writer_t), pointer :: writer
	end function process_component_def_get_writer_ptr
	<<Process libraries: procedures>>=
	module function process_component_def_get_writer_ptr (component) result (writer)
	class(process_component_def_t), intent(in), target :: component
	class(prc_writer_t), pointer :: writer
	writer => component%core_def%writer
	end function process_component_def_get_writer_ptr

	@ %def process_component_def_get_writer_ptr
	@ Return an array which holds the names of all C functions that this
	process component implements.
	<<Process libraries: process component def: TBP>>=
	procedure :: get_features => process_component_def_get_features
	<<Process libraries: sub interfaces>>=
	module function process_component_def_get_features (component) result (features)
	class(process_component_def_t), intent(in) :: component
	type(string_t), dimension(:), allocatable :: features
	end function process_component_def_get_features
	<<Process libraries: procedures>>=
	module function process_component_def_get_features (component) result (features)
	class(process_component_def_t), intent(in) :: component
	type(string_t), dimension(:), allocatable :: features
	call component%core_def%get_features (features)
	end function process_component_def_get_features

	@ %def process_component_def_get_features
	@ Assign procedure pointers in the [[driver]] component (external
	processes). For internal processes, this is meaningless.
	<<Process libraries: process component def: TBP>>=
	procedure :: connect => process_component_def_connect
	<<Process libraries: sub interfaces>>=
	module subroutine process_component_def_connect &
	(component, lib_driver, i, proc_driver)
	class(process_component_def_t), intent(in) :: component
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	end subroutine process_component_def_connect
	<<Process libraries: procedures>>=
	module subroutine process_component_def_connect &
	(component, lib_driver, i, proc_driver)
	class(process_component_def_t), intent(in) :: component
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	select type (proc_driver)
	class is (process_driver_internal_t)
	!!! Nothing to do
	class default
	call component%core_def%connect (lib_driver, i, proc_driver)
	end select
	end subroutine process_component_def_connect

	@ %def process_component_def_connect
	@ Return a pointer to the process core definition, which is of
	abstract type.
	<<Process libraries: process component def: TBP>>=
	procedure :: get_core_def_ptr => process_component_get_core_def_ptr
	<<Process libraries: sub interfaces>>=
	module function process_component_get_core_def_ptr (component) result (ptr)
	class(process_component_def_t), intent(in), target :: component
	class(prc_core_def_t), pointer :: ptr
	end function process_component_get_core_def_ptr
	<<Process libraries: procedures>>=
	module function process_component_get_core_def_ptr (component) result (ptr)
	class(process_component_def_t), intent(in), target :: component
	class(prc_core_def_t), pointer :: ptr
	ptr => component%core_def
	end function process_component_get_core_def_ptr

	@ %def process_component_get_core_def_ptr
	@ Return nominal particle counts, as input by the user.
	<<Process libraries: process component def: TBP>>=
	procedure :: get_n_in => process_component_def_get_n_in
	procedure :: get_n_out => process_component_def_get_n_out
	procedure :: get_n_tot => process_component_def_get_n_tot
	<<Process libraries: sub interfaces>>=
	module function process_component_def_get_n_in (component) result (n_in)
	class(process_component_def_t), intent(in) :: component
	integer :: n_in
	end function process_component_def_get_n_in
	module function process_component_def_get_n_out (component) result (n_out)
	class(process_component_def_t), intent(in) :: component
	integer :: n_out
	end function process_component_def_get_n_out
	module function process_component_def_get_n_tot (component) result (n_tot)
	class(process_component_def_t), intent(in) :: component
	integer :: n_tot
	end function process_component_def_get_n_tot
	<<Process libraries: procedures>>=
	module function process_component_def_get_n_in (component) result (n_in)
	class(process_component_def_t), intent(in) :: component
	integer :: n_in
	n_in = component%n_in
	end function process_component_def_get_n_in

	module function process_component_def_get_n_out (component) result (n_out)
	class(process_component_def_t), intent(in) :: component
	integer :: n_out
	n_out = component%n_out
	end function process_component_def_get_n_out

	module function process_component_def_get_n_tot (component) result (n_tot)
	class(process_component_def_t), intent(in) :: component
	integer :: n_tot
	n_tot = component%n_tot
	end function process_component_def_get_n_tot

	@ %def process_component_def_get_n_in
	@ %def process_component_def_get_n_out
	@ %def process_component_def_get_n_tot
	@ Allocate and return string arrays for the incoming and outgoing particles.
	<<Process libraries: process component def: TBP>>=
	procedure :: get_prt_in => process_component_def_get_prt_in
	procedure :: get_prt_out => process_component_def_get_prt_out
	<<Process libraries: sub interfaces>>=
	module subroutine process_component_def_get_prt_in (component, prt)
	class(process_component_def_t), intent(in) :: component
	type(string_t), dimension(:), intent(out), allocatable :: prt
	end subroutine process_component_def_get_prt_in
	module subroutine process_component_def_get_prt_out (component, prt)
	class(process_component_def_t), intent(in) :: component
	type(string_t), dimension(:), intent(out), allocatable :: prt
	end subroutine process_component_def_get_prt_out
	<<Process libraries: procedures>>=
	module subroutine process_component_def_get_prt_in (component, prt)
	class(process_component_def_t), intent(in) :: component
	type(string_t), dimension(:), intent(out), allocatable :: prt
	integer :: i
	allocate (prt (component%n_in))
	do i = 1, component%n_in
	prt(i) = component%prt_in(i)%to_string ()
	end do
	end subroutine process_component_def_get_prt_in

	module subroutine process_component_def_get_prt_out (component, prt)
	class(process_component_def_t), intent(in) :: component
	type(string_t), dimension(:), intent(out), allocatable :: prt
	integer :: i
	allocate (prt (component%n_out))
	do i = 1, component%n_out
	prt(i) = component%prt_out(i)%to_string ()
	end do
	end subroutine process_component_def_get_prt_out

	@ %def process_component_def_get_prt_in
	@ %def process_component_def_get_prt_out
	@ Return the incoming and outgoing particle specifiers as-is.
	<<Process libraries: process component def: TBP>>=
	procedure :: get_prt_spec_in => process_component_def_get_prt_spec_in
	procedure :: get_prt_spec_out => process_component_def_get_prt_spec_out
	<<Process libraries: sub interfaces>>=
	module function process_component_def_get_prt_spec_in (component) result (prt)
	class(process_component_def_t), intent(in) :: component
	type(prt_spec_t), dimension(:), allocatable :: prt
	end function process_component_def_get_prt_spec_in
	module function process_component_def_get_prt_spec_out (component) result (prt)
	class(process_component_def_t), intent(in) :: component
	type(prt_spec_t), dimension(:), allocatable :: prt
	end function process_component_def_get_prt_spec_out
	<<Process libraries: procedures>>=
	module function process_component_def_get_prt_spec_in (component) result (prt)
	class(process_component_def_t), intent(in) :: component
	type(prt_spec_t), dimension(:), allocatable :: prt
	allocate (prt (component%n_in))
	prt(:) = component%prt_in(:)
	end function process_component_def_get_prt_spec_in

	module function process_component_def_get_prt_spec_out (component) result (prt)
	class(process_component_def_t), intent(in) :: component
	type(prt_spec_t), dimension(:), allocatable :: prt
	allocate (prt (component%n_out))
	prt(:) = component%prt_out(:)
	end function process_component_def_get_prt_spec_out

	@ %def process_component_def_get_prt_spec_in
	@ %def process_component_def_get_prt_spec_out
	@ Return the combination of incoming particles as a PDG code
	<<Process libraries: process component def: TBP>>=
	procedure :: get_pdg_in => process_component_def_get_pdg_in
	<<Process libraries: sub interfaces>>=
	module subroutine process_component_def_get_pdg_in (component, model, pdg)
	class(process_component_def_t), intent(in) :: component
	class(model_data_t), intent(in), target :: model
	integer, intent(out), dimension(:) :: pdg
	end subroutine process_component_def_get_pdg_in
	<<Process libraries: procedures>>=
	module subroutine process_component_def_get_pdg_in (component, model, pdg)
	class(process_component_def_t), intent(in) :: component
	class(model_data_t), intent(in), target :: model
	integer, intent(out), dimension(:) :: pdg
	integer :: i
	do i = 1, size (pdg)
	pdg(i) = model%get_pdg (component%prt_in(i)%to_string ())
	end do
	end subroutine process_component_def_get_pdg_in

	@ %def process_component_def_get_pdg_in
	@ Return the MD5 sum.
	<<Process libraries: process component def: TBP>>=
	procedure :: get_md5sum => process_component_def_get_md5sum
	<<Process libraries: sub interfaces>>=
	pure module function process_component_def_get_md5sum (component) result (md5sum)
	class(process_component_def_t), intent(in) :: component
	character(32) :: md5sum
	end function process_component_def_get_md5sum
	<<Process libraries: procedures>>=
	pure module function process_component_def_get_md5sum (component) result (md5sum)
	class(process_component_def_t), intent(in) :: component
	character(32) :: md5sum
	md5sum = component%md5sum
	end function process_component_def_get_md5sum

	@ %def process_component_def_get_md5sum
	@ Get NLO data
	<<Process libraries: process component def: TBP>>=
	procedure :: get_nlo_type => process_component_def_get_nlo_type
	procedure :: get_associated_born &
	=> process_component_def_get_associated_born
	procedure :: get_associated_real_fin &
	=> process_component_def_get_associated_real_fin
	procedure :: get_associated_real_sing &
	=> process_component_def_get_associated_real_sing
	procedure :: get_associated_subtraction &
	=> process_component_def_get_associated_subtraction
	procedure :: get_association_list &
	=> process_component_def_get_association_list
	procedure :: can_be_integrated &
	=> process_component_def_can_be_integrated
	procedure :: get_associated_real => process_component_def_get_associated_real
	<<Process libraries: sub interfaces>>=
	elemental module function process_component_def_get_nlo_type &
	(component) result (nlo_type)
	integer :: nlo_type
	class(process_component_def_t), intent(in) :: component
	end function process_component_def_get_nlo_type
	elemental module function process_component_def_get_associated_born &
	(component) result (i_born)
	integer :: i_born
	class(process_component_def_t), intent(in) :: component
	end function process_component_def_get_associated_born
	elemental module function process_component_def_get_associated_real_fin &
	(component) result (i_rfin)
	integer :: i_rfin
	class(process_component_def_t), intent(in) :: component
	end function process_component_def_get_associated_real_fin
	elemental module function process_component_def_get_associated_real_sing &
	(component) result (i_rsing)
	integer :: i_rsing
	class(process_component_def_t), intent(in) :: component
	end function process_component_def_get_associated_real_sing
	elemental module function process_component_def_get_associated_subtraction &
	(component) result (i_sub)
	integer :: i_sub
	class(process_component_def_t), intent(in) :: component
	end function process_component_def_get_associated_subtraction
	elemental module function process_component_def_can_be_integrated &
	(component) result (active)
	logical :: active
	class(process_component_def_t), intent(in) :: component
	end function process_component_def_can_be_integrated
	module function process_component_def_get_association_list &
	(component, i_skip_in) result (list)
	integer, dimension(:), allocatable :: list
	class(process_component_def_t), intent(in) :: component
	integer, intent(in), optional :: i_skip_in
	end function process_component_def_get_association_list
	module function process_component_def_get_associated_real &
	(component) result (i_real)
	integer :: i_real
	class(process_component_def_t), intent(in) :: component
	end function process_component_def_get_associated_real
	<<Process libraries: procedures>>=
	elemental module function process_component_def_get_nlo_type &
	(component) result (nlo_type)
	integer :: nlo_type
	class(process_component_def_t), intent(in) :: component
	nlo_type = component%nlo_type
	end function process_component_def_get_nlo_type

	elemental module function process_component_def_get_associated_born &
	(component) result (i_born)
	integer :: i_born
	class(process_component_def_t), intent(in) :: component
	i_born = component%associated_components(ASSOCIATED_BORN)
	end function process_component_def_get_associated_born

	elemental module function process_component_def_get_associated_real_fin &
	(component) result (i_rfin)
	integer :: i_rfin
	class(process_component_def_t), intent(in) :: component
	i_rfin = component%associated_components(ASSOCIATED_REAL_FIN)
	end function process_component_def_get_associated_real_fin

	elemental module function process_component_def_get_associated_real_sing &
	(component) result (i_rsing)
	integer :: i_rsing
	class(process_component_def_t), intent(in) :: component
	i_rsing = component%associated_components(ASSOCIATED_REAL_SING)
	end function process_component_def_get_associated_real_sing

	elemental module function process_component_def_get_associated_subtraction &
	(component) result (i_sub)
	integer :: i_sub
	class(process_component_def_t), intent(in) :: component
	i_sub = component%associated_components(ASSOCIATED_SUB)
	end function process_component_def_get_associated_subtraction

	elemental module function process_component_def_can_be_integrated &
	(component) result (active)
	logical :: active
	class(process_component_def_t), intent(in) :: component
	active = component%active
	end function process_component_def_can_be_integrated

	module function process_component_def_get_association_list &
	(component, i_skip_in) result (list)
	integer, dimension(:), allocatable :: list
	class(process_component_def_t), intent(in) :: component
	integer, intent(in), optional :: i_skip_in
	integer :: i, j, n, i_skip
	logical :: valid
	i_skip = 0; if (present (i_skip_in)) i_skip = i_skip_in
	n = count (component%associated_components /= 0) - 1
	if (i_skip > 0) then
	if (component%associated_components(i_skip) > 0) n = n - 1
	end if
	allocate (list (n))
	j = 1
	do i = 1, size(component%associated_components)
	valid = component%associated_components(i) /= 0 &
	.and. i /= ASSOCIATED_SUB .and. i /= i_skip
	if (valid) then
	list(j) = component%associated_components(i)
	j = j + 1
	end if
	end do
	end function process_component_def_get_association_list

	module function process_component_def_get_associated_real &
	(component) result (i_real)
	integer :: i_real
	class(process_component_def_t), intent(in) :: component
	i_real = component%associated_components(ASSOCIATED_REAL)
	end function process_component_def_get_associated_real

	@ %def process_component_def_get_nlo_type, process_component_def_get_associated_born
	@ %def process_component_def_can_be_integrated
	@ %def process_component_def_get_association_list
	@ %def process_component_def_get_associated_real
	@ %def process_component_def_get_associated_real_fin
	@ %def process_component_def_get_associated_subtraction
	@
	<<Process libraries: process component def: TBP>>=
	procedure :: get_me_method => process_component_def_get_me_method
	<<Process libraries: sub interfaces>>=
	elemental module function process_component_def_get_me_method (component) result (method)
	type(string_t) :: method
	class(process_component_def_t), intent(in) :: component
	end function process_component_def_get_me_method
	<<Process libraries: procedures>>=
	elemental module function process_component_def_get_me_method (component) result (method)
	type(string_t) :: method
	class(process_component_def_t), intent(in) :: component
	method = component%method
	end function process_component_def_get_me_method

	@ %def process_component_def_get_me_method
	@
	<<Process libraries: process component def: TBP>>=
	procedure :: get_fixed_emitter => process_component_def_get_fixed_emitter
	<<Process libraries: sub interfaces>>=
	module function process_component_def_get_fixed_emitter (component) result (emitter)
	integer :: emitter
	class(process_component_def_t), intent(in) :: component
	end function process_component_def_get_fixed_emitter
	<<Process libraries: procedures>>=
	module function process_component_def_get_fixed_emitter (component) result (emitter)
	integer :: emitter
	class(process_component_def_t), intent(in) :: component
	emitter = component%fixed_emitter
	end function process_component_def_get_fixed_emitter

	@ %def process_component_def_get_fixed_emitter
	@
	<<Process libraries: process component def: TBP>>=
	procedure :: get_coupling_powers => process_component_def_get_coupling_powers
	<<Process libraries: sub interfaces>>=
	pure module subroutine process_component_def_get_coupling_powers &
	(component, alpha_power, alphas_power)
	class(process_component_def_t), intent(in) :: component
	integer, intent(out) :: alpha_power, alphas_power
	end subroutine process_component_def_get_coupling_powers
	<<Process libraries: procedures>>=
	pure module subroutine process_component_def_get_coupling_powers &
	(component, alpha_power, alphas_power)
	class(process_component_def_t), intent(in) :: component
	integer, intent(out) :: alpha_power, alphas_power
	alpha_power = component%alpha_power
	alphas_power = component%alphas_power
	end subroutine process_component_def_get_coupling_powers

	@ %def process_component_def_get_coupling_powers
	@
	\subsubsection{Process definition}
	The process component definitions are collected in a common process
	definition object.

	The [[id]] is the ID string that the user has provided for identifying
	this process. It must be a string that is allowed as part of a
	Fortran variable name, since it may be used for generating code.

	The number [[n_in]] is 1 or 2 for a decay or scattering process,
	respectively. This must be identical to [[n_in]] for all components.

	The initial and extra component definitions (see above) are allocated as the
	[[initial]] and [[extra]] arrays, respectively. The latter
	are determined from the former.

	The [[md5sum]] is used to verify the integrity of the configuration.
	<<Process libraries: public>>=
	public :: process_def_t
	<<Process libraries: types>>=
	type :: process_def_t
	private
	type(string_t) :: id
	integer :: num_id = 0
	class(model_data_t), pointer :: model => null ()
	type(string_t) :: model_name
	integer :: n_in = 0
	integer :: n_initial = 0
	integer :: n_extra = 0
	type(process_component_def_t), dimension(:), allocatable :: initial
	type(process_component_def_t), dimension(:), allocatable :: extra
	character(32) :: md5sum = ""
	logical :: nlo_process = .false.
	logical :: negative_sf = .false.
	logical :: requires_resonances = .false.
	contains
	<<Process libraries: process def: TBP>>
	end type process_def_t

	@ %def process_def_t
	@ Write the process definition including components:
	<<Process libraries: process def: TBP>>=
	procedure :: write => process_def_write
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_write (object, unit)
	class(process_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine process_def_write
	<<Process libraries: procedures>>=
	module subroutine process_def_write (object, unit)
	class(process_def_t), intent(in) :: object
	integer, intent(in) :: unit
	integer :: i
	write (unit, "(1x,A,A,A)") "ID = '", char (object%id), "'"
	if (object%num_id /= 0) &
	write (unit, "(1x,A,I0)") "ID(num) = ", object%num_id
	select case (object%n_in)
	case (1); write (unit, "(1x,A)") "Decay"
	case (2); write (unit, "(1x,A)") "Scattering"
	case default
	write (unit, "(1x,A)") "[Undefined process]"
	return
	end select
	if (object%model_name /= "") then
	write (unit, "(1x,A,A)") "Model = ", char (object%model_name)
	else
	write (unit, "(1x,A)") "Model = [undefined]"
	end if
	write (unit, "(1x,A,I0)") "Initially defined component(s) = ", &
	object%n_initial
	write (unit, "(1x,A,I0)") "Extra generated component(s) = ", &
	object%n_extra
	if (object%requires_resonances) then
	! This line has to matched with the reader below!
	write (unit, "(1x,A,I0)") "Resonant subprocesses required"
	end if
	write (unit, "(1x,A,A,A)") "MD5 sum = '", object%md5sum, "'"
	if (allocated (object%initial)) then
	do i = 1, size (object%initial)
	write (unit, "(1x,A,I0)") "Component #", i
	call object%initial(i)%write (unit)
	end do
	end if
	if (allocated (object%extra)) then
	do i = 1, size (object%extra)
	write (unit, "(1x,A,I0)") "Component #", object%n_initial + i
	call object%extra(i)%write (unit)
	end do
	end if
	end subroutine process_def_write

	@ %def process_def_write
	@ Read the process definition including components.
	<<Process libraries: process def: TBP>>=
	procedure :: read => process_def_read
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_read (object, unit, core_def_templates)
	class(process_def_t), intent(out) :: object
	integer, intent(in) :: unit
	type(prc_template_t), dimension(:), intent(in) :: core_def_templates
	end subroutine process_def_read
	<<Process libraries: procedures>>=
	module subroutine process_def_read (object, unit, core_def_templates)
	class(process_def_t), intent(out) :: object
	integer, intent(in) :: unit
	type(prc_template_t), dimension(:), intent(in) :: core_def_templates
	integer :: i, i1, i2
	character(80) :: buffer, ref
	read (unit, "(A)") buffer
	call strip_equation_lhs (buffer)
	i1 = scan (buffer, "'")
	i2 = scan (buffer, "'", back=.true.)
	if (i2 > i1) then
	object%id = buffer(i1+1:i2-1)
	else
	object%id = ""
	end if

	read (unit, "(A)") buffer
	select case (buffer(2:11))
	case ("Decay "); object%n_in = 1
	case ("Scattering"); object%n_in = 2
	case default
	return
	end select

	read (unit, "(A)") buffer
	call strip_equation_lhs (buffer)
	object%model_name = trim (adjustl (buffer))
	if (object%model_name == "[undefined]") object%model_name = ""

	read (unit, "(A)") buffer
	call strip_equation_lhs (buffer)
	read (buffer, *) object%n_initial

	read (unit, "(A)") buffer
	call strip_equation_lhs (buffer)
	read (buffer, *) object%n_extra

	read (unit, "(A)") buffer
	if (buffer(1:9) == " Resonant") then
	object%requires_resonances = .true.
	read (unit, "(A)") buffer
	else
	object%requires_resonances = .false.
	end if

	call strip_equation_lhs (buffer)
	read (buffer(3:34), "(A32)") object%md5sum

	if (object%n_initial > 0) then
	allocate (object%initial (object%n_initial))
	do i = 1, object%n_initial
	read (unit, "(A)") buffer
	write (ref, "(1x,A,I0)") "Component #", i
	if (buffer /= ref) return ! Wrong component header
	call object%initial(i)%read (unit, core_def_templates)
	end do
	end if

	end subroutine process_def_read

	@ %def process_def_read
	@ Short account.
	<<Process libraries: process def: TBP>>=
	procedure :: show => process_def_show
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_show (object, unit)
	class(process_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine process_def_show
	<<Process libraries: procedures>>=
	module subroutine process_def_show (object, unit)
	class(process_def_t), intent(in) :: object
	integer, intent(in) :: unit
	integer :: i
	write (unit, "(4x,A)", advance="no") char (object%id)
	if (object%num_id /= 0) &
	write (unit, "(1x,'(',I0,')')", advance="no") object%num_id
	if (object%model_name /= "") &
	write (unit, "(1x,'[',A,']')", advance="no") char (object%model_name)
	if (object%requires_resonances) then
	write (unit, "(1x,A)", advance="no") "[+ resonant subprocesses]"
	end if
	write (unit, *)
	if (allocated (object%initial)) then
	do i = 1, size (object%initial)
	call object%initial(i)%show (unit)
	end do
	end if
	if (allocated (object%extra)) then
	do i = 1, size (object%extra)
	call object%extra(i)%show (unit)
	end do
	end if
	end subroutine process_def_show

	@ %def process_def_show
	@ Initialize an entry (initialize the process definition inside). We
	allocate the 'initial' set of components. Extra components remain
	unallocated.

	The model should be present as a pointer. This allows us to retrieve the
	model's MD5 sum. However, for various tests it is sufficient to have the
	name.

	We create the basenames for the process components by appending a
	suffix which we increment for each component.
	<<Process libraries: process def: TBP>>=
	procedure :: init => process_def_init
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_init (def, id, &
	model, model_name, n_in, n_components, num_id, &
	nlo_process, negative_sf, requires_resonances)
	class(process_def_t), intent(out) :: def
	type(string_t), intent(in), optional :: id
	class(model_data_t), intent(in), optional, target :: model
	type(string_t), intent(in), optional :: model_name
	integer, intent(in), optional :: n_in
	integer, intent(in), optional :: n_components
	integer, intent(in), optional :: num_id
	logical, intent(in), optional :: nlo_process
	logical, intent(in), optional :: negative_sf
	logical, intent(in), optional :: requires_resonances
	end subroutine process_def_init
	<<Process libraries: procedures>>=
	module subroutine process_def_init (def, id, &
	model, model_name, n_in, n_components, num_id, &
	nlo_process, negative_sf, requires_resonances)
	class(process_def_t), intent(out) :: def
	type(string_t), intent(in), optional :: id
	class(model_data_t), intent(in), optional, target :: model
	type(string_t), intent(in), optional :: model_name
	integer, intent(in), optional :: n_in
	integer, intent(in), optional :: n_components
	integer, intent(in), optional :: num_id
	logical, intent(in), optional :: nlo_process
	logical, intent(in), optional :: negative_sf
	logical, intent(in), optional :: requires_resonances
	character(16) :: suffix
	integer :: i
	if (present (id)) then
	def%id = id
	else
	def%id = ""
	end if
	if (present (num_id)) then
	def%num_id = num_id
	end if
	if (present (model)) then
	def%model => model
	def%model_name = model%get_name ()
	else
	def%model => null ()
	if (present (model_name)) then
	def%model_name = model_name
	else
	def%model_name = ""
	end if
	end if
	if (present (n_in)) def%n_in = n_in
	if (present (n_components)) then
	def%n_initial = n_components
	allocate (def%initial (n_components))
	end if
	if (present (nlo_process)) then
	def%nlo_process = nlo_process
	end if
	if (present (negative_sf)) then
	def%negative_sf = negative_sf
	end if
	if (present (requires_resonances)) then
	def%requires_resonances = requires_resonances
	end if
	def%initial%initial = .true.
	def%initial%method = ""
	do i = 1, def%n_initial
	write (suffix, "(A,I0)") "_i", i
	def%initial(i)%basename = def%id // trim (suffix)
	end do
	def%initial%description = ""
	end subroutine process_def_init

	@ %def process_def_init
	@ Explicitly set the model name (for unit test).
	<<Process libraries: process def: TBP>>=
	procedure :: set_model_name => process_def_set_model_name
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_set_model_name (def, model_name)
	class(process_def_t), intent(inout) :: def
	type(string_t), intent(in) :: model_name
	end subroutine process_def_set_model_name
	<<Process libraries: procedures>>=
	module subroutine process_def_set_model_name (def, model_name)
	class(process_def_t), intent(inout) :: def
	type(string_t), intent(in) :: model_name
	def%model_name = model_name
	end subroutine process_def_set_model_name

	@ %def process_def_set_model_name
	@ Initialize an initial component. The particle content
	must be specified. The process core block is not (yet) allocated.

	We assume that the particle arrays match the [[n_in]] and
	[[n_out]] values in size. The model is referred to by name; it is
	identified as an existing model later. The index [[i]] must refer to
	an existing element of the component array.

	Data specific for the process core of a component are imported as
	the [[core_def]] argument. We should allocate an object of class
	[[prc_core_def_t]] with the appropriate specific type, fill it,
	and transfer it to the process component definition here. The
	allocation is moved, so the original allocated object is returned empty.
	<<Process libraries: process def: TBP>>=
	procedure :: import_component => process_def_import_component
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_import_component (def, &
	i, n_out, prt_in, prt_out, method, variant, &
	nlo_type, can_be_integrated)
	class(process_def_t), intent(inout) :: def
	integer, intent(in) :: i
	integer, intent(in), optional :: n_out
	type(prt_spec_t), dimension(:), intent(in), optional :: prt_in
	type(prt_spec_t), dimension(:), intent(in), optional :: prt_out
	type(string_t), intent(in), optional :: method
	integer, intent(in), optional :: nlo_type
	logical, intent(in), optional :: can_be_integrated
	class(prc_core_def_t), &
	intent(inout), allocatable, optional :: variant
	end subroutine process_def_import_component
	<<Process libraries: procedures>>=
	module subroutine process_def_import_component (def, &
	i, n_out, prt_in, prt_out, method, variant, &
	nlo_type, can_be_integrated)
	class(process_def_t), intent(inout) :: def
	integer, intent(in) :: i
	integer, intent(in), optional :: n_out
	type(prt_spec_t), dimension(:), intent(in), optional :: prt_in
	type(prt_spec_t), dimension(:), intent(in), optional :: prt_out
	type(string_t), intent(in), optional :: method
	integer, intent(in), optional :: nlo_type
	logical, intent(in), optional :: can_be_integrated
	type(string_t) :: nlo_type_string
	class(prc_core_def_t), &
	intent(inout), allocatable, optional :: variant
	integer :: p
	associate (comp => def%initial(i))
	if (present (n_out)) then
	comp%n_in = def%n_in
	comp%n_out = n_out
	comp%n_tot = def%n_in + n_out
	end if
	if (present (prt_in)) then
	allocate (comp%prt_in (size (prt_in)))
	comp%prt_in = prt_in
	end if
	if (present (prt_out)) then
	allocate (comp%prt_out (size (prt_out)))
	comp%prt_out = prt_out
	end if
	if (present (method)) comp%method = method
	if (present (variant)) then
	call move_alloc (variant, comp%core_def)
	end if
	if (present (nlo_type)) then
	comp%nlo_type = nlo_type
	end if
	if (present (can_be_integrated)) then
	comp%active = can_be_integrated
	else
	comp%active = .true.
	end if
	if (allocated (comp%prt_in) .and. allocated (comp%prt_out)) then
	associate (d => comp%description)
	d = ""
	do p = 1, size (prt_in)
	if (p > 1) d = d // ", "
	d = d // comp%prt_in(p)%to_string ()
	end do
	d = d // " => "
	do p = 1, size (prt_out)
	if (p > 1) d = d // ", "
	d = d // comp%prt_out(p)%to_string ()
	end do
	if (comp%method /= "") then
	if ((def%nlo_process .and. .not. comp%active) .or. &
	comp%nlo_type == NLO_SUBTRACTION) then
	d = d // " [inactive]"
	else
	d = d // " [" // comp%method // "]"
	end if
	end if
	nlo_type_string = component_status (comp%nlo_type)
	if (nlo_type_string /= "born") then
	d = d // ", [" // nlo_type_string // "]"
	end if
	end associate
	end if
	end associate
	end subroutine process_def_import_component

	@ %def process_def_import_component
	@
	<<Process libraries: process def: TBP>>=
	procedure :: get_n_components => process_def_get_n_components
	<<Process libraries: sub interfaces>>=
	module function process_def_get_n_components (def) result (n)
	class(process_def_t), intent(in) :: def
	integer :: n
	end function process_def_get_n_components
	<<Process libraries: procedures>>=
	module function process_def_get_n_components (def) result (n)
	class(process_def_t), intent(in) :: def
	integer :: n
	n = size (def%initial)
	end function process_def_get_n_components

	@ %def process_def_get_n_components
	@
	<<Process libraries: process def: TBP>>=
	procedure :: set_fixed_emitter => process_def_set_fixed_emitter
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_set_fixed_emitter (def, i, emitter)
	class(process_def_t), intent(inout) :: def
	integer, intent(in) :: i, emitter
	end subroutine process_def_set_fixed_emitter
	<<Process libraries: procedures>>=
	module subroutine process_def_set_fixed_emitter (def, i, emitter)
	class(process_def_t), intent(inout) :: def
	integer, intent(in) :: i, emitter
	def%initial(i)%fixed_emitter = emitter
	end subroutine process_def_set_fixed_emitter

	@ %def process_def_set_fixed_emitter
	@
	<<Process libraries: process def: TBP>>=
	procedure :: set_coupling_powers => process_def_set_coupling_powers
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_set_coupling_powers (def, alpha_power, alphas_power)
	class(process_def_t), intent(inout) :: def
	integer, intent(in) :: alpha_power, alphas_power
	end subroutine process_def_set_coupling_powers
	<<Process libraries: procedures>>=
	module subroutine process_def_set_coupling_powers (def, alpha_power, alphas_power)
	class(process_def_t), intent(inout) :: def
	integer, intent(in) :: alpha_power, alphas_power
	def%initial(1)%alpha_power = alpha_power
	def%initial(1)%alphas_power = alphas_power
	end subroutine process_def_set_coupling_powers

	@ %def process_def_set_coupling_powers
	@
	<<Process libraries: process def: TBP>>=
	procedure :: set_associated_components => &
	process_def_set_associated_components
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_set_associated_components (def, i, &
	i_list, remnant, real_finite, mismatch)
	class(process_def_t), intent(inout) :: def
	logical, intent(in) :: remnant, real_finite, mismatch
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: i_list
	end subroutine process_def_set_associated_components
	<<Process libraries: procedures>>=
	module subroutine process_def_set_associated_components (def, i, &
	i_list, remnant, real_finite, mismatch)
	class(process_def_t), intent(inout) :: def
	logical, intent(in) :: remnant, real_finite, mismatch
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: i_list
	integer :: add_index
	add_index = 0
	associate (comp => def%initial(i)%associated_components)
	comp(ASSOCIATED_BORN) = i_list(1)
	comp(ASSOCIATED_REAL) = i_list(2)
	comp(ASSOCIATED_VIRT) = i_list(3)
	comp(ASSOCIATED_SUB) = i_list(4)
	if (remnant) then
	comp(ASSOCIATED_PDF) = i_list(5)
	add_index = add_index + 1
	end if
	if (real_finite) then
	comp(ASSOCIATED_REAL_FIN) = i_list(5+add_index)
	add_index = add_index + 1
	end if
	if (mismatch) then
	!!! incomplete
	end if
	end associate
	end subroutine process_def_set_associated_components

	@ %def process_def_set_associated_components
	@
	Compute the MD5 sum for this process definition. We compute the MD5
	sums for all components individually, than concatenate a string of
	those and compute the MD5 sum of this string. We also include the
	model name. All other data part of the component definitions.
	<<Process libraries: process def: TBP>>=
	procedure :: compute_md5sum => process_def_compute_md5sum
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_compute_md5sum (def, model)
	class(process_def_t), intent(inout) :: def
	class(model_data_t), intent(in), optional, target :: model
	end subroutine process_def_compute_md5sum
	<<Process libraries: procedures>>=
	module subroutine process_def_compute_md5sum (def, model)
	class(process_def_t), intent(inout) :: def
	class(model_data_t), intent(in), optional, target :: model
	integer :: i
	type(string_t) :: buffer
	buffer = def%model_name
	do i = 1, def%n_initial
	call def%initial(i)%compute_md5sum (model)
	buffer = buffer // def%initial(i)%md5sum
	end do
	do i = 1, def%n_extra
	call def%extra(i)%compute_md5sum (model)
	buffer = buffer // def%initial(i)%md5sum
	end do
	def%md5sum = md5sum (char (buffer))
	end subroutine process_def_compute_md5sum

	@ %def process_def_compute_md5sum
	@ Return the MD5 sum of the process or of a process component.
	<<Process libraries: process def: TBP>>=
	procedure :: get_md5sum => process_def_get_md5sum
	<<Process libraries: sub interfaces>>=
	module function process_def_get_md5sum (def, i_component) result (md5sum)
	class(process_def_t), intent(in) :: def
	integer, intent(in), optional :: i_component
	character(32) :: md5sum
	end function process_def_get_md5sum
	<<Process libraries: procedures>>=
	module function process_def_get_md5sum (def, i_component) result (md5sum)
	class(process_def_t), intent(in) :: def
	integer, intent(in), optional :: i_component
	character(32) :: md5sum
	if (present (i_component)) then
	md5sum = def%initial(i_component)%md5sum
	else
	md5sum = def%md5sum
	end if
	end function process_def_get_md5sum

	@ %def process_def_get_md5sum
	@ Return a pointer to the definition of a particular component (for
	test purposes).
	<<Process libraries: process def: TBP>>=
	procedure :: get_core_def_ptr => process_def_get_core_def_ptr
	<<Process libraries: sub interfaces>>=
	module function process_def_get_core_def_ptr (def, i_component) result (ptr)
	class(process_def_t), intent(in), target :: def
	integer, intent(in) :: i_component
	class(prc_core_def_t), pointer :: ptr
	end function process_def_get_core_def_ptr
	<<Process libraries: procedures>>=
	module function process_def_get_core_def_ptr (def, i_component) result (ptr)
	class(process_def_t), intent(in), target :: def
	integer, intent(in) :: i_component
	class(prc_core_def_t), pointer :: ptr
	ptr => def%initial(i_component)%get_core_def_ptr ()
	end function process_def_get_core_def_ptr

	@ %def process_def_get_core_def_ptr
	@
	This query tells whether a specific process component relies on
	external code. This includes all traditional WHIZARD matrix elements
	which rely on \oMega\ for code generation. Other process components
	(trivial decays, subtraction terms) do not require external code.

	NOTE: Implemented only for initial component.

	The query is passed to the process component.
	<<Process libraries: process def: TBP>>=
	procedure :: needs_code => process_def_needs_code
	<<Process libraries: sub interfaces>>=
	module function process_def_needs_code (def, i_component) result (flag)
	class(process_def_t), intent(in) :: def
	integer, intent(in) :: i_component
	logical :: flag
	end function process_def_needs_code
	<<Process libraries: procedures>>=
	module function process_def_needs_code (def, i_component) result (flag)
	class(process_def_t), intent(in) :: def
	integer, intent(in) :: i_component
	logical :: flag
	flag = def%initial(i_component)%needs_code ()
	end function process_def_needs_code

	@ %def process_def_needs_code
	@ Return the first entry for the incoming particle(s), PDG code, of
	this process.
	<<Process libraries: process def: TBP>>=
	procedure :: get_pdg_in_1 => process_def_get_pdg_in_1
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_get_pdg_in_1 (def, pdg)
	class(process_def_t), intent(in), target :: def
	integer, dimension(:), intent(out) :: pdg
	end subroutine process_def_get_pdg_in_1
	<<Process libraries: procedures>>=
	module subroutine process_def_get_pdg_in_1 (def, pdg)
	class(process_def_t), intent(in), target :: def
	integer, dimension(:), intent(out) :: pdg
	call def%initial(1)%get_pdg_in (def%model, pdg)
	end subroutine process_def_get_pdg_in_1

	@ %def process_def_get_pdg_in_1
	@
	<<Process libraries: process def: TBP>>=
	procedure :: is_nlo => process_def_is_nlo
	<<Process libraries: sub interfaces>>=
	elemental module function process_def_is_nlo (def) result (flag)
	logical :: flag
	class(process_def_t), intent(in) :: def
	end function process_def_is_nlo
	<<Process libraries: procedures>>=
	elemental module function process_def_is_nlo (def) result (flag)
	logical :: flag
	class(process_def_t), intent(in) :: def
	flag = def%nlo_process
	end function process_def_is_nlo

	@ %def process_def_is_nlo
	@
	<<Process libraries: process def: TBP>>=
	procedure :: get_nlo_type => process_def_get_nlo_type
	<<Process libraries: sub interfaces>>=
	elemental module function process_def_get_nlo_type (def, i_component) result (nlo_type)
	integer :: nlo_type
	class(process_def_t), intent(in) :: def
	integer, intent(in) :: i_component
	end function process_def_get_nlo_type
	<<Process libraries: procedures>>=
	elemental module function process_def_get_nlo_type (def, i_component) result (nlo_type)
	integer :: nlo_type
	class(process_def_t), intent(in) :: def
	integer, intent(in) :: i_component
	nlo_type = def%initial(i_component)%nlo_type
	end function process_def_get_nlo_type

	@ %def process_def_get_nlo_type
	@
	<<Process libraries: process def: TBP>>=
	procedure :: get_negative_sf => process_def_get_negative_sf
	<<Process libraries: sub interfaces>>=
	elemental module function process_def_get_negative_sf (def) result (neg_sf)
	logical :: neg_sf
	class(process_def_t), intent(in) :: def
	end function process_def_get_negative_sf
	<<Process libraries: procedures>>=
	elemental module function process_def_get_negative_sf (def) result (neg_sf)
	logical :: neg_sf
	class(process_def_t), intent(in) :: def
	neg_sf = def%negative_sf
	end function process_def_get_negative_sf

	@ %def process_def_get_negative_sf
	@ Number of incoming particles, common to all components.
	<<Process libraries: process def: TBP>>=
	procedure :: get_n_in => process_def_get_n_in
	<<Process libraries: sub interfaces>>=
	module function process_def_get_n_in (def) result (n_in)
	class(process_def_t), intent(in) :: def
	integer :: n_in
	end function process_def_get_n_in
	<<Process libraries: procedures>>=
	module function process_def_get_n_in (def) result (n_in)
	class(process_def_t), intent(in) :: def
	integer :: n_in
	n_in = def%n_in
	end function process_def_get_n_in

	@ %def process_def_get_n_in
	@ Pointer to a particular component definition record.
	<<Process libraries: process def: TBP>>=
	procedure :: get_component_def_ptr => process_def_get_component_def_ptr
	<<Process libraries: sub interfaces>>=
	module function process_def_get_component_def_ptr (def, i) result (component)
	type(process_component_def_t), pointer :: component
	class(process_def_t), intent(in), target :: def
	integer, intent(in) :: i
	end function process_def_get_component_def_ptr
	<<Process libraries: procedures>>=
	module function process_def_get_component_def_ptr (def, i) result (component)
	type(process_component_def_t), pointer :: component
	class(process_def_t), intent(in), target :: def
	integer, intent(in) :: i
	if (i <= def%n_initial) then
	component => def%initial(i)
	else
	component => null ()
	end if
	end function process_def_get_component_def_ptr

	@ %def process_def_get_component_def_ptr
	@
	\subsubsection{Process definition list}
	A list of process definitions is the starting point for creating a
	process library. The list is built when reading the user input. When
	reading an existing process library, the list is used for
	cross-checking and updating the configuration.

	We need a type for the list entry. The simplest way is to extend the
	process definition type, so all methods apply to the process
	definition directly.
	<<Process libraries: public>>=
	public :: process_def_entry_t
	<<Process libraries: types>>=
	type, extends (process_def_t) :: process_def_entry_t
	private
	type(process_def_entry_t), pointer :: next => null ()
	end type process_def_entry_t

	@ %def process_def_entry_t
	@ This is the type for the list itself.
	<<Process libraries: public>>=
	public :: process_def_list_t
	<<Process libraries: types>>=
	type :: process_def_list_t
	private
	type(process_def_entry_t), pointer :: first => null ()
	type(process_def_entry_t), pointer :: last => null ()
	contains
	<<Process libraries: process def list: TBP>>
	end type process_def_list_t

	@ %def process_def_list_t
	@ The deallocates the list iteratively. We assume that the list
	entries do not need finalization themselves.
	<<Process libraries: process def list: TBP>>=
	procedure :: final => process_def_list_final
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_list_final (list)
	class(process_def_list_t), intent(inout) :: list
	end subroutine process_def_list_final
	<<Process libraries: procedures>>=
	module subroutine process_def_list_final (list)
	class(process_def_list_t), intent(inout) :: list
	type(process_def_entry_t), pointer :: current
	nullify (list%last)
	do while (associated (list%first))
	current => list%first
	list%first => current%next
	deallocate (current)
	end do
	end subroutine process_def_list_final

	@ %def process_def_list_final
	@ Write the complete list.
	<<Process libraries: process def list: TBP>>=
	procedure :: write => process_def_list_write
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_list_write (object, unit, libpath)
	class(process_def_list_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: libpath
	end subroutine process_def_list_write
	<<Process libraries: procedures>>=
	module subroutine process_def_list_write (object, unit, libpath)
	class(process_def_list_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: libpath
	type(process_def_entry_t), pointer :: entry
	integer :: i, u
	u = given_output_unit (unit)
	if (associated (object%first)) then
	i = 1
	entry => object%first
	do while (associated (entry))
	write (u, "(1x,A,I0,A)") "Process #", i, ":"
	call entry%write (u)
	i = i + 1
	entry => entry%next
	if (associated (entry)) write (u, *)
	end do
	else
	write (u, "(1x,A)") "Process definition list: [empty]"
	end if
	end subroutine process_def_list_write

	@ %def process_def_list_write
	@ Short account.
	<<Process libraries: process def list: TBP>>=
	procedure :: show => process_def_list_show
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_list_show (object, unit)
	class(process_def_list_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine process_def_list_show
	<<Process libraries: procedures>>=
	module subroutine process_def_list_show (object, unit)
	class(process_def_list_t), intent(in) :: object
	integer, intent(in), optional :: unit
	type(process_def_entry_t), pointer :: entry
	integer :: u
	u = given_output_unit (unit)
	if (associated (object%first)) then
	write (u, "(2x,A)") "Processes:"
	entry => object%first
	do while (associated (entry))
	call entry%show (u)
	entry => entry%next
	end do
	else
	write (u, "(2x,A)") "Processes: [empty]"
	end if
	end subroutine process_def_list_show

	@ %def process_def_list_show
	@ Read the complete list. We need an array of templates for the
	component subobjects of abstract [[prc_core_t]] type, to
	allocate them with the correct specific type.

	NOTE: Error handling is missing. Reading will just be aborted on
	error, or an I/O error occurs.
	<<Process libraries: process def list: TBP>>=
	procedure :: read => process_def_list_read
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_list_read (object, unit, core_def_templates)
	class(process_def_list_t), intent(out) :: object
	integer, intent(in) :: unit
	type(prc_template_t), dimension(:), intent(in) :: core_def_templates
	end subroutine process_def_list_read
	<<Process libraries: procedures>>=
	module subroutine process_def_list_read (object, unit, core_def_templates)
	class(process_def_list_t), intent(out) :: object
	integer, intent(in) :: unit
	type(prc_template_t), dimension(:), intent(in) :: core_def_templates
	type(process_def_entry_t), pointer :: entry
	character(80) :: buffer, ref
	integer :: i
	read (unit, "(A)") buffer
	write (ref, "(1x,A)") "Process definition list: [empty]"
	if (buffer == ref) return ! OK: empty library
	backspace (unit)
	READ_ENTRIES: do i = 1, huge(0)-1
	if (i > 1) read (unit, *, end=1)
	read (unit, "(A)") buffer

	write (ref, "(1x,A,I0,A)") "Process #", i, ":"
	if (buffer /= ref) return ! Wrong process header: done.
	allocate (entry)
	call entry%read (unit, core_def_templates)
	call object%append (entry)
	end do READ_ENTRIES
	1 continue ! EOF: done
	end subroutine process_def_list_read

	@ %def process_def_list_read
	@ Append an entry to the list. The entry should be allocated as a
	pointer, and the pointer allocation is transferred. The original
	pointer is returned null.
	<<Process libraries: process def list: TBP>>=
	procedure :: append => process_def_list_append
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_list_append (list, entry)
	class(process_def_list_t), intent(inout) :: list
	type(process_def_entry_t), intent(inout), pointer :: entry
	end subroutine process_def_list_append
	<<Process libraries: procedures>>=
	module subroutine process_def_list_append (list, entry)
	class(process_def_list_t), intent(inout) :: list
	type(process_def_entry_t), intent(inout), pointer :: entry
	if (list%contains (entry%id)) then
	call msg_fatal ("Recording process: '" // char (entry%id) &
	// "' has already been defined")
	end if
	if (associated (list%first)) then
	list%last%next => entry
	else
	list%first => entry
	end if
	list%last => entry
	entry => null ()
	end subroutine process_def_list_append

	@ %def process_def_list_append
	@
	\subsubsection{Probe the process definition list}
	Return the number of processes supported by the library.
	<<Process libraries: process def list: TBP>>=
	procedure :: get_n_processes => process_def_list_get_n_processes
	<<Process libraries: sub interfaces>>=
	module function process_def_list_get_n_processes (list) result (n)
	integer :: n
	class(process_def_list_t), intent(in) :: list
	end function process_def_list_get_n_processes
	<<Process libraries: procedures>>=
	module function process_def_list_get_n_processes (list) result (n)
	integer :: n
	class(process_def_list_t), intent(in) :: list
	type(process_def_entry_t), pointer :: current
	n = 0
	current => list%first
	do while (associated (current))
	n = n + 1
	current => current%next
	end do
	end function process_def_list_get_n_processes

	@ %def process_def_list_get_n_processes
	@ Allocate an array with the process IDs supported by the library.
	<<Process libraries: process def list: TBP>>=
	procedure :: get_process_id_list => process_def_list_get_process_id_list
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_list_get_process_id_list (list, id)
	class(process_def_list_t), intent(in) :: list
	type(string_t), dimension(:), allocatable, intent(out) :: id
	end subroutine process_def_list_get_process_id_list
	<<Process libraries: procedures>>=
	module subroutine process_def_list_get_process_id_list (list, id)
	class(process_def_list_t), intent(in) :: list
	type(string_t), dimension(:), allocatable, intent(out) :: id
	type(process_def_entry_t), pointer :: current
	integer :: i
	allocate (id (list%get_n_processes ()))
	i = 0
	current => list%first
	do while (associated (current))
	i = i + 1
	id(i) = current%id
	current => current%next
	end do
	end subroutine process_def_list_get_process_id_list

	@ %def process_def_list_get_process_id_list
	@ Return just the processes which require resonant subprocesses.
	<<Process libraries: process def list: TBP>>=
	procedure :: get_process_id_req_resonant => &
	process_def_list_get_process_id_req_resonant
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_list_get_process_id_req_resonant (list, id)
	class(process_def_list_t), intent(in) :: list
	type(string_t), dimension(:), allocatable, intent(out) :: id
	end subroutine process_def_list_get_process_id_req_resonant
	<<Process libraries: procedures>>=
	module subroutine process_def_list_get_process_id_req_resonant (list, id)
	class(process_def_list_t), intent(in) :: list
	type(string_t), dimension(:), allocatable, intent(out) :: id
	type(process_def_entry_t), pointer :: current
	integer :: i
	allocate (id (list%get_n_processes ()))
	i = 0
	current => list%first
	do while (associated (current))
	if (current%requires_resonances) then
	i = i + 1
	id(i) = current%id
	end if
	current => current%next
	end do
	id = id(1:i)
	end subroutine process_def_list_get_process_id_req_resonant

	@ %def process_def_list_get_process_id_list
	@ Return a pointer to a particular process entry.
	<<Process libraries: process def list: TBP>>=
	procedure :: get_process_def_ptr => process_def_list_get_process_def_ptr
	<<Process libraries: sub interfaces>>=
	module function process_def_list_get_process_def_ptr (list, id) result (entry)
	type(process_def_entry_t), pointer :: entry
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	end function process_def_list_get_process_def_ptr
	<<Process libraries: procedures>>=
	module function process_def_list_get_process_def_ptr (list, id) result (entry)
	type(process_def_entry_t), pointer :: entry
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	type(process_def_entry_t), pointer :: current
	current => list%first
	do while (associated (current))
	if (id == current%id) exit
	current => current%next
	end do
	entry => current
	end function process_def_list_get_process_def_ptr

	@ %def process_def_list_get_process_def_ptr
	@ Return true if a given process is in the library.
	<<Process libraries: process def list: TBP>>=
	procedure :: contains => process_def_list_contains
	<<Process libraries: sub interfaces>>=
	module function process_def_list_contains (list, id) result (flag)
	logical :: flag
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	end function process_def_list_contains
	<<Process libraries: procedures>>=
	module function process_def_list_contains (list, id) result (flag)
	logical :: flag
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	type(process_def_entry_t), pointer :: current
	current => list%get_process_def_ptr (id)
	flag = associated (current)
	end function process_def_list_contains

	@ %def process_def_list_contains
	@ Return the index of the entry that corresponds to a given process.
	<<Process libraries: process def list: TBP>>=
	procedure :: get_entry_index => process_def_list_get_entry_index
	<<Process libraries: sub interfaces>>=
	module function process_def_list_get_entry_index (list, id) result (n)
	integer :: n
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	end function process_def_list_get_entry_index
	<<Process libraries: procedures>>=
	module function process_def_list_get_entry_index (list, id) result (n)
	integer :: n
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	type(process_def_entry_t), pointer :: current
	n = 0
	current => list%first
	do while (associated (current))
	n = n + 1
	if (id == current%id) then
	return
	end if
	current => current%next
	end do
	n = 0
	end function process_def_list_get_entry_index

	@ %def process_def_list_get_entry_index
	@ Return the numerical ID for a process.
	<<Process libraries: process def list: TBP>>=
	procedure :: get_num_id => process_def_list_get_num_id
	<<Process libraries: sub interfaces>>=
	module function process_def_list_get_num_id (list, id) result (num_id)
	integer :: num_id
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	end function process_def_list_get_num_id
	<<Process libraries: procedures>>=
	module function process_def_list_get_num_id (list, id) result (num_id)
	integer :: num_id
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	type(process_def_entry_t), pointer :: current
	current => list%get_process_def_ptr (id)
	if (associated (current)) then
	num_id = current%num_id
	else
	num_id = 0
	end if
	end function process_def_list_get_num_id

	@ %def process_def_list_get_num_id
	@ Return the model name for a given process in the library.
	<<Process libraries: process def list: TBP>>=
	procedure :: get_model_name => process_def_list_get_model_name
	<<Process libraries: sub interfaces>>=
	module function process_def_list_get_model_name (list, id) result (model_name)
	type(string_t) :: model_name
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	end function process_def_list_get_model_name
	<<Process libraries: procedures>>=
	module function process_def_list_get_model_name (list, id) result (model_name)
	type(string_t) :: model_name
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	type(process_def_entry_t), pointer :: current
	current => list%get_process_def_ptr (id)
	if (associated (current)) then
	model_name = current%model_name
	else
	model_name = ""
	end if
	end function process_def_list_get_model_name

	@ %def process_def_list_get_model_name
	@ Return the number of incoming particles of a given process in the library.
	This tells us whether the process is a decay or a scattering.
	<<Process libraries: process def list: TBP>>=
	procedure :: get_n_in => process_def_list_get_n_in
	<<Process libraries: sub interfaces>>=
	module function process_def_list_get_n_in (list, id) result (n)
	integer :: n
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	end function process_def_list_get_n_in
	<<Process libraries: procedures>>=
	module function process_def_list_get_n_in (list, id) result (n)
	integer :: n
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	type(process_def_entry_t), pointer :: current
	current => list%get_process_def_ptr (id)
	if (associated (current)) then
	n = current%n_in
	else
	n = 0
	end if
	end function process_def_list_get_n_in

	@ %def process_def_list_get_n_in
	@ Return the incoming particle pdg codesnumber of incoming particles
	of a given process in the library. If there is a PDG array, return
	only the first code for each beam. This serves as a quick way
	for (re)constructing beam properties.
	<<Process libraries: process def list: TBP>>=
	procedure :: get_pdg_in_1 => process_def_list_get_pdg_in_1
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_list_get_pdg_in_1 (list, id, pdg)
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	integer, dimension(:), intent(out) :: pdg
	end subroutine process_def_list_get_pdg_in_1
	<<Process libraries: procedures>>=
	module subroutine process_def_list_get_pdg_in_1 (list, id, pdg)
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	integer, dimension(:), intent(out) :: pdg
	type(process_def_entry_t), pointer :: current
	current => list%get_process_def_ptr (id)
	if (associated (current)) then
	call current%get_pdg_in_1 (pdg)
	else
	pdg = 0
	end if
	end subroutine process_def_list_get_pdg_in_1

	@ %def process_def_list_get_pdg_in_1
	@ Return the list of component IDs of a given process in the library.
	<<Process libraries: process def list: TBP>>=
	procedure :: get_component_list => process_def_list_get_component_list
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_list_get_component_list (list, id, cid)
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	type(string_t), dimension(:), allocatable, intent(out) :: cid
	end subroutine process_def_list_get_component_list
	<<Process libraries: procedures>>=
	module subroutine process_def_list_get_component_list (list, id, cid)
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	type(string_t), dimension(:), allocatable, intent(out) :: cid
	type(process_def_entry_t), pointer :: current
	integer :: i, n
	current => list%get_process_def_ptr (id)
	if (associated (current)) then
	allocate (cid (current%n_initial + current%n_extra))
	do i = 1, current%n_initial
	cid(i) = current%initial(i)%basename
	end do
	n = current%n_initial
	do i = 1, current%n_extra
	cid(n + i) = current%extra(i)%basename
	end do
	end if
	end subroutine process_def_list_get_component_list

	@ %def process_def_list_get_component_list
	@ Return the list of component description strings for a given process
	in the library.
	<<Process libraries: process def list: TBP>>=
	procedure :: get_component_description_list => &
	process_def_list_get_component_description_list
	<<Process libraries: sub interfaces>>=
	module subroutine process_def_list_get_component_description_list &
	(list, id, description)
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	type(string_t), dimension(:), allocatable, intent(out) :: description
	end subroutine process_def_list_get_component_description_list
	<<Process libraries: procedures>>=
	module subroutine process_def_list_get_component_description_list &
	(list, id, description)
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	type(string_t), dimension(:), allocatable, intent(out) :: description
	type(process_def_entry_t), pointer :: current
	integer :: i, n
	current => list%get_process_def_ptr (id)
	if (associated (current)) then
	allocate (description (current%n_initial + current%n_extra))
	do i = 1, current%n_initial
	description(i) = current%initial(i)%description
	end do
	n = current%n_initial
	do i = 1, current%n_extra
	description(n + i) = current%extra(i)%description
	end do
	end if
	end subroutine process_def_list_get_component_description_list

	@ %def process_def_list_get_component_description_list
	@ Return whether the entry requires construction of a resonanct
	subprocess set.
	<<Process libraries: process def list: TBP>>=
	procedure :: req_resonant => process_def_list_req_resonant
	<<Process libraries: sub interfaces>>=
	module function process_def_list_req_resonant (list, id) result (flag)
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	logical :: flag
	end function process_def_list_req_resonant
	<<Process libraries: procedures>>=
	module function process_def_list_req_resonant (list, id) result (flag)
	class(process_def_list_t), intent(in) :: list
	type(string_t), intent(in) :: id
	logical :: flag
	type(process_def_entry_t), pointer :: current
	current => list%get_process_def_ptr (id)
	if (associated (current)) then
	flag = current%requires_resonances
	else
	flag = .false.
	end if
	end function process_def_list_req_resonant

	@ %def process_def_list_req_resonant
	@
	\subsection{Process library}
	The process library object is the interface between the process
	definition data, as provided by the user, generated or linked process
	code on file, and the process run data that reference the process
	code.

	\subsubsection{Process library entry}
	For each process component that is part of the library, there is a
	separate library entry ([[process_library_entry_t]]. The library
	entry connects a process definition with the specific code (if any) in
	the compiled driver library.

	The [[status]] indicates how far the process has been
	processed by the system (definition, code generation, compilation,
	linking). A process with status [[STAT_LOADED]] is accessible for
	computing matrix elements.

	The [[def]] pointer identifies the corresponding process definition.
	The process component within that definition is identified by the
	[[i_component]] index.

	The [[i_external]] index refers to the compiled library driver. If it is zero,
	there is no associated matrix-element code.

	The [[driver]] component holds the pointers to the matrix-element
	specific functions, in particular the matrix element function itself.
	<<Process libraries: types>>=
	type :: process_library_entry_t
	private
	integer :: status = STAT_UNKNOWN
	type(process_def_t), pointer :: def => null ()
	integer :: i_component = 0
	integer :: i_external = 0
	class(prc_core_driver_t), allocatable :: driver
	contains
	<<Process libraries: process library entry: TBP>>
	end type process_library_entry_t

	@ %def process_library_entry_t
	@ Here are the available status codes. An entry starts with
	[[UNKNOWN]] status. Once the association with a valid process
	definition is established, the status becomes [[CONFIGURED]].
	If matrix element source code is to be generated by the system or
	provided from elsewhere, [[CODE_GENERATED]] indicates that this is
	done. The [[COMPILED]] status is next, it also applies to
	processes which are accessed as precompiled binaries. Finally, the
	library is linked and process pointers are set; this is marked as
	[[LOADED]].

	For a process library, the initial status is [[OPEN]], since process
	definitions may be added. After configuration, the process content is fixed
	and the status becomes [[CONFIGURED]]. The further states are as above,
	always referring to the lowest status among the process entries.
	<<Process libraries: parameters>>=
	integer, parameter, public :: STAT_UNKNOWN = 0
	integer, parameter, public :: STAT_OPEN = 1
	integer, parameter, public :: STAT_CONFIGURED = 2
	integer, parameter, public :: STAT_SOURCE = 3
	integer, parameter, public :: STAT_COMPILED = 4
	integer, parameter, public :: STAT_LINKED = 5
	integer, parameter, public :: STAT_ACTIVE = 6

	integer, parameter, public :: ASSOCIATED_BORN = 1
	integer, parameter, public :: ASSOCIATED_REAL = 2
	integer, parameter, public :: ASSOCIATED_VIRT = 3
	integer, parameter, public :: ASSOCIATED_SUB = 4
	integer, parameter, public :: ASSOCIATED_PDF = 5
	integer, parameter, public :: ASSOCIATED_REAL_SING = 6
	integer, parameter, public :: ASSOCIATED_REAL_FIN = 7
	integer, parameter, public :: N_ASSOCIATED_COMPONENTS = 7

	@ %def STAT_UNKNOWN STAT_OPEN STAT_CONFIGURED
	@ %def STAT_SOURCE STAT_COMPILED STAT_LINKED STAT_ACTIVE
	@ These are the associated code letters, for output:
	<<Process libraries: parameters>>=
	character, dimension(0:6), parameter :: STATUS_LETTER = &
	["?", "o", "f", "s", "c", "l", "a"]

	@ %def STATUS_LETTER
	@ This produces a condensed account of the library entry. The status
	is indicated by a letter in brackets, then the ID and component index
	of the associated process definition, finally the library index, if available.
	<<Process libraries: process library entry: TBP>>=
	procedure :: to_string => process_library_entry_to_string
	<<Process libraries: sub interfaces>>=
	module function process_library_entry_to_string (object) result (string)
	type(string_t) :: string
	class(process_library_entry_t), intent(in) :: object
	end function process_library_entry_to_string
	<<Process libraries: procedures>>=
	module function process_library_entry_to_string (object) result (string)
	type(string_t) :: string
	class(process_library_entry_t), intent(in) :: object
	character(32) :: buffer
	string = "[" // STATUS_LETTER(object%status) // "]"
	select case (object%status)
	case (STAT_UNKNOWN)
	case default
	if (associated (object%def)) then
	write (buffer, "(I0)") object%i_component
	string = string // " " // object%def%id // "." // trim (buffer)
	end if
	if (object%i_external /= 0) then
	write (buffer, "(I0)") object%i_external
	string = string // " = ext:" // trim (buffer)
	else
	string = string // " = int"
	end if
	if (allocated (object%driver)) then
	string = string // " (" // object%driver%type_name () // ")"
	end if
	end select
	end function process_library_entry_to_string

	@ %def process_library_entry_to_string
	@ Initialize with data. Used for the unit tests.
	<<Process libraries: process library entry: TBP>>=
	procedure :: init => process_library_entry_init
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_entry_init (object, &
	status, def, i_component, i_external, driver_template)
	class(process_library_entry_t), intent(out) :: object
	integer, intent(in) :: status
	type(process_def_t), target, intent(in) :: def
	integer, intent(in) :: i_component
	integer, intent(in) :: i_external
	class(prc_core_driver_t), intent(inout), allocatable, optional &
	:: driver_template
	end subroutine process_library_entry_init
	<<Process libraries: procedures>>=
	module subroutine process_library_entry_init (object, &
	status, def, i_component, i_external, driver_template)
	class(process_library_entry_t), intent(out) :: object
	integer, intent(in) :: status
	type(process_def_t), target, intent(in) :: def
	integer, intent(in) :: i_component
	integer, intent(in) :: i_external
	class(prc_core_driver_t), intent(inout), allocatable, optional &
	:: driver_template
	object%status = status
	object%def => def
	object%i_component = i_component
	object%i_external = i_external
	if (present (driver_template)) then
	call move_alloc (driver_template, object%driver)
	end if
	end subroutine process_library_entry_init

	@ %def process_library_entry_init
	@ Assign pointers for all process-specific features. We have to
	combine the method from the [[core_def]] specification, the
	assigned pointers within the library driver, the index within that
	driver, and the process driver which should receive the links.
	<<Process libraries: process library entry: TBP>>=
	procedure :: connect => process_library_entry_connect
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_entry_connect (entry, lib_driver, i)
	class(process_library_entry_t), intent(inout) :: entry
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	end subroutine process_library_entry_connect
	<<Process libraries: procedures>>=
	module subroutine process_library_entry_connect (entry, lib_driver, i)
	class(process_library_entry_t), intent(inout) :: entry
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	call entry%def%initial(entry%i_component)%connect &
	(lib_driver, i, entry%driver)
	end subroutine process_library_entry_connect

	@ %def process_library_entry_connect
	@
	\subsubsection{The process library object}
	The [[process_library_t]] type is an extension of the
	[[process_def_list_t]] type. Thus, it automatically contains the
	process definition list.

	The [[basename]] identifies the library generically.

	The [[external]] flag is true if any process within the library needs external
	code, so the library must correspond to an actual code library (statically or
	dynamically linked).

	The [[entry]] array contains all process components that can be handled by this
	library. Each entry refers to the process (component) definition and to the
	associated external matrix element code, if there is any.

	The [[driver]] object is needed only if [[external]] is true. This object
	handles all interactions with external matrix-element code.

	The [[md5sum]] summarizes the complete [[process_def_list_t]] base
	object. It can be used to check if the library configuration has changed.
	<<Process libraries: public>>=
	public :: process_library_t
	<<Process libraries: types>>=
	type, extends (process_def_list_t) :: process_library_t
	private
	type(string_t) :: basename
	integer :: n_entries = 0
	logical :: external = .false.
	integer :: status = STAT_UNKNOWN
	logical :: static = .false.
	logical :: driver_exists = .false.
	logical :: makefile_exists = .false.
	integer :: update_counter = 0
	type(process_library_entry_t), dimension(:), allocatable :: entry
	class(prclib_driver_t), allocatable :: driver
	character(32) :: md5sum = ""
	contains
	<<Process libraries: process library: TBP>>
	end type process_library_t

	@ %def process_library_t
	@ For the output, we write first the metadata and the DL access
	record, then the library entries in short form, and finally the
	process definition list which is the base object.

	Don't write the MD5 sum since this is used to generate it.
	<<Process libraries: process library: TBP>>=
	procedure :: write => process_library_write
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_write (object, unit, libpath)
	class(process_library_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: libpath
	end subroutine process_library_write
	<<Process libraries: procedures>>=
	module subroutine process_library_write (object, unit, libpath)
	class(process_library_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: libpath
	integer :: i, u
	u = given_output_unit (unit)
	write (u, "(1x,A,A)") "Process library: ", char (object%basename)
	write (u, "(3x,A,L1)") "external = ", object%external
	write (u, "(3x,A,L1)") "makefile exists = ", object%makefile_exists
	write (u, "(3x,A,L1)") "driver exists = ", object%driver_exists
	write (u, "(3x,A,A1)") "code status = ", &
	STATUS_LETTER (object%status)
	write (u, *)
	if (allocated (object%entry)) then
	write (u, "(1x,A)", advance="no") "Process library entries:"
	write (u, "(1x,I0)") object%n_entries
	do i = 1, size (object%entry)
	write (u, "(1x,A,I0,A,A)") "Entry #", i, ": ", &
	char (object%entry(i)%to_string ())
	end do
	write (u, *)
	end if
	if (object%external) then
	call object%driver%write (u, libpath)
	write (u, *)
	end if
	call object%process_def_list_t%write (u)
	end subroutine process_library_write

	@ %def process_library_write
	@ Condensed version for screen output.
	<<Process libraries: process library: TBP>>=
	procedure :: show => process_library_show
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_show (object, unit)
	class(process_library_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine process_library_show
	<<Process libraries: procedures>>=
	module subroutine process_library_show (object, unit)
	class(process_library_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	write (u, "(A,A)") "Process library: ", char (object%basename)
	write (u, "(2x,A,L1)") "external = ", object%external
	if (object%static) then
	write (u, "(2x,A,L1)") "static = ", .true.
	else
	write (u, "(2x,A,L1)") "makefile exists = ", object%makefile_exists
	write (u, "(2x,A,L1)") "driver exists = ", object%driver_exists
	end if
	write (u, "(2x,A,A1)", advance="no") "code status = "
	select case (object%status)
	case (STAT_UNKNOWN); write (u, "(A)") "[unknown]"
	case (STAT_OPEN); write (u, "(A)") "open"
	case (STAT_CONFIGURED); write (u, "(A)") "configured"
	case (STAT_SOURCE); write (u, "(A)") "source code exists"
	case (STAT_COMPILED); write (u, "(A)") "compiled"
	case (STAT_LINKED); write (u, "(A)") "linked"
	case (STAT_ACTIVE); write (u, "(A)") "active"
	end select
	call object%process_def_list_t%show (u)
	end subroutine process_library_show

	@ %def process_library_show
	@
	The initializer defines just the basename. We may now add process definitions
	to the library.
	<<Process libraries: process library: TBP>>=
	procedure :: init => process_library_init
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_init (lib, basename)
	class(process_library_t), intent(out) :: lib
	type(string_t), intent(in) :: basename
	end subroutine process_library_init
	<<Process libraries: procedures>>=
	module subroutine process_library_init (lib, basename)
	class(process_library_t), intent(out) :: lib
	type(string_t), intent(in) :: basename
	lib%basename = basename
	lib%status = STAT_OPEN
	call msg_message ("Process library '" // char (basename) &
	// "': initialized")
	end subroutine process_library_init

	@ %def process_library_init
	@
	This alternative initializer declares the library as static. We
	should now add process definitions to the library, but all external
	process code exists already. We need the driver object, and we should
	check the defined processes against the stored ones.
	<<Process libraries: process library: TBP>>=
	procedure :: init_static => process_library_init_static
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_init_static (lib, basename)
	class(process_library_t), intent(out) :: lib
	type(string_t), intent(in) :: basename
	end subroutine process_library_init_static
	<<Process libraries: procedures>>=
	module subroutine process_library_init_static (lib, basename)
	class(process_library_t), intent(out) :: lib
	type(string_t), intent(in) :: basename
	lib%basename = basename
	lib%status = STAT_OPEN
	lib%static = .true.
	call msg_message ("Static process library '" // char (basename) &
	// "': initialized")
	end subroutine process_library_init_static

	@ %def process_library_init_static
	@ The [[configure]] procedure scans the allocated entries in the process
	definition list. The configuration proceeds in three passes.

	In the first pass, we scan the process definition list and count the
	number of process components and the number of components which need
	external code. This is used to allocate the [[entry]] array.

	In the second pass, we initialize the [[entry]] elements which connect
	process definitions, process driver objects, and external code.

	In the third pass, we initialize the library driver object, allocating
	an entry for each external matrix element.

	NOTE: Currently we handle only [[initial]] process components; [[extra]]
	components are ignored.
	<<Process libraries: process library: TBP>>=
	procedure :: configure => process_library_configure
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_configure (lib, os_data)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	end subroutine process_library_configure
	<<Process libraries: procedures>>=
	module subroutine process_library_configure (lib, os_data)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	type(process_def_entry_t), pointer :: def_entry
	integer :: n_entries, n_external, i_entry, i_external
	type(string_t) :: model_name
	integer :: i_component

	n_entries = 0
	n_external = 0
	if (allocated (lib%entry)) deallocate (lib%entry)

	def_entry => lib%first
	do while (associated (def_entry))
	do i_component = 1, def_entry%n_initial
	n_entries = n_entries + 1
	if (def_entry%initial(i_component)%needs_code ()) then
	n_external = n_external + 1
	lib%external = .true.
	end if
	end do
	def_entry => def_entry%next
	end do

	call lib%allocate_entries (n_entries)

	i_entry = 0
	i_external = 0
	def_entry => lib%first
	do while (associated (def_entry))
	do i_component = 1, def_entry%n_initial
	i_entry = i_entry + 1
	associate (lib_entry => lib%entry(i_entry))
	lib_entry%status = STAT_CONFIGURED
	lib_entry%def => def_entry%process_def_t
	lib_entry%i_component = i_component
	if (def_entry%initial(i_component)%needs_code ()) then
	i_external = i_external + 1
	lib_entry%i_external = i_external
	end if
	call def_entry%initial(i_component)%allocate_driver &
	(lib_entry%driver)
	end associate
	end do
	def_entry => def_entry%next
	end do

	call dispatch_prclib_driver (lib%driver, &
	lib%basename, lib%get_modellibs_ldflags (os_data))
	call lib%driver%init (n_external)
	do i_entry = 1, n_entries
	associate (lib_entry => lib%entry(i_entry))
	i_component = lib_entry%i_component
	model_name = lib_entry%def%model_name
	associate (def => lib_entry%def%initial(i_component))
	if (def%needs_code ()) then
	call lib%driver%set_record (lib_entry%i_external, &
	def%basename, &
	model_name, &
	def%get_features (), def%get_writer_ptr ())
	end if
	end associate
	end associate
	end do

	if (lib%static) then
	if (lib%n_entries /= 0) lib%entry%status = STAT_LINKED
	lib%status = STAT_LINKED
	else if (lib%external) then
	where (lib%entry%i_external == 0) lib%entry%status = STAT_LINKED
	lib%status = STAT_CONFIGURED
	lib%makefile_exists = .false.
	lib%driver_exists = .false.
	else
	if (lib%n_entries /= 0) lib%entry%status = STAT_LINKED
	lib%status = STAT_LINKED
	end if
	end subroutine process_library_configure

	@ %def process_library_configure
	@ Basic setup: allocate the [[entry]] array.
	<<Process libraries: process library: TBP>>=
	procedure :: allocate_entries => process_library_allocate_entries
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_allocate_entries (lib, n_entries)
	class(process_library_t), intent(inout) :: lib
	integer, intent(in) :: n_entries
	end subroutine process_library_allocate_entries
	<<Process libraries: procedures>>=
	module subroutine process_library_allocate_entries (lib, n_entries)
	class(process_library_t), intent(inout) :: lib
	integer, intent(in) :: n_entries
	lib%n_entries = n_entries
	allocate (lib%entry (n_entries))
	end subroutine process_library_allocate_entries

	@ %def process_library_allocate_entries
	@ Initialize an entry with data (used by unit tests).
	<<Process libraries: process library: TBP>>=
	procedure :: init_entry => process_library_init_entry
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_init_entry (lib, i, &
	status, def, i_component, i_external, driver_template)
	class(process_library_t), intent(inout) :: lib
	integer, intent(in) :: i
	integer, intent(in) :: status
	type(process_def_t), target, intent(in) :: def
	integer, intent(in) :: i_component
	integer, intent(in) :: i_external
	class(prc_core_driver_t), intent(inout), allocatable, optional &
	:: driver_template
	end subroutine process_library_init_entry
	<<Process libraries: procedures>>=
	module subroutine process_library_init_entry (lib, i, &
	status, def, i_component, i_external, driver_template)
	class(process_library_t), intent(inout) :: lib
	integer, intent(in) :: i
	integer, intent(in) :: status
	type(process_def_t), target, intent(in) :: def
	integer, intent(in) :: i_component
	integer, intent(in) :: i_external
	class(prc_core_driver_t), intent(inout), allocatable, optional &
	:: driver_template
	call lib%entry(i)%init (status, def, i_component, i_external, &
	driver_template)
	end subroutine process_library_init_entry

	@ %def process_library_init_entry
	@ Compute the MD5 sum. We concatenate the individual MD5 sums of all
	processes (which, in turn, are derived from the MD5 sums of their
	components) and compute the MD5 sum of that.

	This should be executed \emph{after} configuration, where the driver was
	initialized, since otherwise the MD5 sum stored in the driver would be
	overwritten.
	<<Process libraries: process library: TBP>>=
	procedure :: compute_md5sum => process_library_compute_md5sum
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_compute_md5sum (lib, model)
	class(process_library_t), intent(inout) :: lib
	class(model_data_t), intent(in), optional, target :: model
	end subroutine process_library_compute_md5sum
	<<Process libraries: procedures>>=
	module subroutine process_library_compute_md5sum (lib, model)
	class(process_library_t), intent(inout) :: lib
	class(model_data_t), intent(in), optional, target :: model
	type(process_def_entry_t), pointer :: def_entry
	type(string_t) :: buffer
	buffer = lib%basename
	def_entry => lib%first
	do while (associated (def_entry))
	call def_entry%compute_md5sum (model)
	buffer = buffer // def_entry%md5sum
	def_entry => def_entry%next
	end do
	lib%md5sum = md5sum (char (buffer))
	call lib%driver%set_md5sum (lib%md5sum)
	end subroutine process_library_compute_md5sum

	@ %def process_library_compute_md5sum
	@ Write an appropriate makefile, if there are external processes. Unless
	[[force]] is in effect, first check if there is already a makefile with the
	correct MD5 sum. If yes, do nothing.

	The [[workspace]] optional argument puts any library code in a subdirectory.
	<<Process libraries: process library: TBP>>=
	procedure :: write_makefile => process_library_write_makefile
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_write_makefile &
	(lib, os_data, force, verbose, testflag, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: force, verbose
	logical, intent(in), optional :: testflag
	type(string_t), intent(in), optional :: workspace
	end subroutine process_library_write_makefile
	<<Process libraries: procedures>>=
	module subroutine process_library_write_makefile &
	(lib, os_data, force, verbose, testflag, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: force, verbose
	logical, intent(in), optional :: testflag
	type(string_t), intent(in), optional :: workspace
	character(32) :: md5sum_file
	logical :: generate
	integer :: unit
	if (lib%external .and. .not. lib%static) then
	generate = .true.
	if (.not. force) then
	md5sum_file = lib%driver%get_md5sum_makefile (workspace)
	if (lib%md5sum == md5sum_file) then
	call msg_message ("Process library '" // char (lib%basename) &
	// "': keeping makefile")
	generate = .false.
	end if
	end if
	if (generate) then
	call msg_message ("Process library '" // char (lib%basename) &
	// "': writing makefile")
	unit = free_unit ()
	open (unit, &
	file = char (workspace_prefix (workspace) &
	& // lib%driver%basename // ".makefile"), &
	status="replace", action="write")
	call lib%driver%generate_makefile (unit, os_data, verbose, testflag)
	close (unit)
	end if
	lib%makefile_exists = .true.
	end if
	end subroutine process_library_write_makefile

	@ %def process_library_write_makefile
	@
	@ Write the driver source code for the library to file, if there are
	external processes.
	<<Process libraries: process library: TBP>>=
	procedure :: write_driver => process_library_write_driver
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_write_driver (lib, force, workspace)
	class(process_library_t), intent(inout) :: lib
	logical, intent(in) :: force
	type(string_t), intent(in), optional :: workspace
	end subroutine process_library_write_driver
	<<Process libraries: procedures>>=
	module subroutine process_library_write_driver (lib, force, workspace)
	class(process_library_t), intent(inout) :: lib
	logical, intent(in) :: force
	type(string_t), intent(in), optional :: workspace
	character(32) :: md5sum_file
	logical :: generate
	integer :: unit
	if (lib%external .and. .not. lib%static) then
	generate = .true.
	if (.not. force) then
	md5sum_file = lib%driver%get_md5sum_driver (workspace)
	if (lib%md5sum == md5sum_file) then
	call msg_message ("Process library '" // char (lib%basename) &
	// "': keeping driver")
	generate = .false.
	end if
	end if
	if (generate) then
	call msg_message ("Process library '" // char (lib%basename) &
	// "': writing driver")
	unit = free_unit ()
	open (unit, &
	file = char (workspace_prefix (workspace) &
	& // lib%driver%basename // ".f90"), &
	status="replace", action="write")
	call lib%driver%generate_driver_code (unit)
	close (unit)
	end if
	lib%driver_exists = .true.
	end if
	end subroutine process_library_write_driver

	@ %def process_library_write_driver
	@ Update the compilation status of an external library.

	Strictly speaking, this is not necessary for a one-time run, since the
	individual library methods will update the status themselves.
	However, it allows us to identify compilation steps that we can skip
	because the file exists or is already loaded, for the whole library or
	for particular entries.

	Independently, the building process is controlled by a makefile.
	Thus, previous files are reused if they are not modified by the
	current compilation.
	\begin{enumerate}
	\item
	If it is not already loaded, attempt to load the library. If successful,
	check the overall MD5 sum. If it matches, just keep it loaded and mark as
	ACTIVE. If not, check the MD5 sum for all linked process components.
	Where it matches, mark the entry as COMPILED. Then, unload the library and
	mark as CONFIGURED.

	Thus, we can identify compiled files for all matrix elements which are
	accessible via the previous compiled library, even if it is no longer up to
	date.
	\item
	If the library is now in CONFIGURED state, look for valid source files.
	Each entry that is just in CONFIGURED state will advance to SOURCE if the
	MD5 sum matches. Finally, advance the whole library to SOURCE if all
	entries are at least in this condition.
	\end{enumerate}
	<<Process libraries: process library: TBP>>=
	procedure :: update_status => process_library_update_status
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_update_status (lib, os_data, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	end subroutine process_library_update_status
	<<Process libraries: procedures>>=
	module subroutine process_library_update_status (lib, os_data, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	type(string_t), intent(in), optional :: workspace
	character(32) :: md5sum_file
	integer :: i, i_external, i_component
	if (lib%external) then
	select case (lib%status)
	case (STAT_CONFIGURED:STAT_LINKED)
	call lib%driver%load (os_data, noerror=.true., workspace=workspace)
	end select
	if (lib%driver%loaded) then
	md5sum_file = lib%driver%get_md5sum (0)
	if (lib%md5sum == md5sum_file) then
	call lib%load_entries ()
	lib%entry%status = STAT_ACTIVE
	lib%status = STAT_ACTIVE
	call msg_message ("Process library '" // char (lib%basename) &
	// "': active")
	else
	do i = 1, lib%n_entries
	associate (entry => lib%entry(i))
	i_external = entry%i_external
	i_component = entry%i_component
	if (i_external /= 0) then
	md5sum_file = lib%driver%get_md5sum (i_external)
	if (entry%def%get_md5sum (i_component) == md5sum_file) then
	entry%status = STAT_COMPILED
	else
	entry%status = STAT_CONFIGURED
	end if
	end if
	end associate
	end do
	call lib%driver%unload ()
	lib%status = STAT_CONFIGURED
	end if
	end if
	select case (lib%status)
	case (STAT_CONFIGURED)
	do i = 1, lib%n_entries
	associate (entry => lib%entry(i))
	i_external = entry%i_external
	i_component = entry%i_component
	if (i_external /= 0) then
	select case (entry%status)
	case (STAT_CONFIGURED)
	md5sum_file = lib%driver%get_md5sum_source &
	(i_external, workspace)
	if (entry%def%get_md5sum (i_component) == md5sum_file) then
	entry%status = STAT_SOURCE
	end if
	end select
	end if
	end associate
	end do
	if (all (lib%entry%status >= STAT_SOURCE)) then
	md5sum_file = lib%driver%get_md5sum_driver (workspace)
	if (lib%md5sum == md5sum_file) then
	lib%status = STAT_SOURCE
	end if
	end if
	end select
	end if
	end subroutine process_library_update_status

	@ %def process_library_update_status
	@
	This procedure triggers code generation for all processes where this
	is possible.

	We generate code only for external processes of status
	[[STAT_CONFIGURED]], which then advance to [[STAT_SOURCE]]. If, for a
	particular process, the status is already advanced, we do not remove previous
	files, so [[make]] will consider them as up to date if they exist. Otherwise,
	we remove those files to force a fresh [[make]].

	Finally, if any source code has been generated, we need a driver file.
	<<Process libraries: process library: TBP>>=
	procedure :: make_source => process_library_make_source
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_make_source &
	(lib, os_data, keep_old_source, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	logical, intent(in), optional :: keep_old_source
	type(string_t), intent(in), optional :: workspace
	end subroutine process_library_make_source
	<<Process libraries: procedures>>=
	module subroutine process_library_make_source &
	(lib, os_data, keep_old_source, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	logical, intent(in), optional :: keep_old_source
	type(string_t), intent(in), optional :: workspace
	logical :: keep_old
	integer :: i, i_external
	keep_old = .false.
	if (present (keep_old_source)) keep_old = keep_old_source
	if (lib%external .and. .not. lib%static) then
	select case (lib%status)
	case (STAT_CONFIGURED)
	if (keep_old) then
	call msg_message ("Process library '" // char (lib%basename) &
	// "': keeping source code")
	else
	call msg_message ("Process library '" // char (lib%basename) &
	// "': creating source code")
	do i = 1, size (lib%entry)
	associate (entry => lib%entry(i))
	i_external = entry%i_external
	if (i_external /= 0 &
	.and. lib%entry(i)%status == STAT_CONFIGURED) then
	call lib%driver%clean_proc &
	(i_external, os_data, workspace)
	end if
	end associate
	if (signal_is_pending ()) return
	end do
	call lib%driver%make_source (os_data, workspace)
	end if
	lib%status = STAT_SOURCE
	where (lib%entry%i_external /= 0 &
	.and. lib%entry%status == STAT_CONFIGURED)
	lib%entry%status = STAT_SOURCE
	end where
	lib%status = STAT_SOURCE
	end select
	end if
	end subroutine process_library_make_source

	@ %def process_library_make_source
	@ Compile the generated code and update the status codes. Try to make
	the sources first, just in case. This includes compiling possible \LaTeX
	Feynman diagram files.
	<<Process libraries: process library: TBP>>=
	procedure :: make_compile => process_library_make_compile
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_make_compile &
	(lib, os_data, keep_old_source, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	logical, intent(in), optional :: keep_old_source
	type(string_t), intent(in), optional :: workspace
	end subroutine process_library_make_compile
	<<Process libraries: procedures>>=
	module subroutine process_library_make_compile &
	(lib, os_data, keep_old_source, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	logical, intent(in), optional :: keep_old_source
	type(string_t), intent(in), optional :: workspace
	if (lib%external .and. .not. lib%static) then
	select case (lib%status)
	case (STAT_CONFIGURED)
	call lib%make_source (os_data, keep_old_source, workspace)
	end select
	if (signal_is_pending ()) return
	select case (lib%status)
	case (STAT_SOURCE)
	call msg_message ("Process library '" // char (lib%basename) &
	// "': compiling sources")
	call lib%driver%make_compile (os_data, workspace)
	where (lib%entry%i_external /= 0 &
	.and. lib%entry%status == STAT_SOURCE)
	lib%entry%status = STAT_COMPILED
	end where
	lib%status = STAT_COMPILED
	end select
	end if
	end subroutine process_library_make_compile

	@ %def process_library_make_compile
	@ Link the process library. Try to compile first, just in case.
	<<Process libraries: process library: TBP>>=
	procedure :: make_link => process_library_make_link
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_make_link &
	(lib, os_data, keep_old_source, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	logical, intent(in), optional :: keep_old_source
	type(string_t), intent(in), optional :: workspace
	end subroutine process_library_make_link
	<<Process libraries: procedures>>=
	module subroutine process_library_make_link &
	(lib, os_data, keep_old_source, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	logical, intent(in), optional :: keep_old_source
	type(string_t), intent(in), optional :: workspace
	if (lib%external .and. .not. lib%static) then
	select case (lib%status)
	case (STAT_CONFIGURED:STAT_SOURCE)
	call lib%make_compile (os_data, keep_old_source, workspace)
	end select
	if (signal_is_pending ()) return
	select case (lib%status)
	case (STAT_COMPILED)
	call msg_message ("Process library '" // char (lib%basename) &
	// "': linking")
	call lib%driver%make_link (os_data, workspace)
	lib%entry%status = STAT_LINKED
	lib%status = STAT_LINKED
	end select
	end if
	end subroutine process_library_make_link

	@ %def process_library_make_link
	@ Load the process library, i.e., assign pointers to the library
	functions.
	<<Process libraries: process library: TBP>>=
	procedure :: load => process_library_load
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_load (lib, os_data, keep_old_source, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	logical, intent(in), optional :: keep_old_source
	type(string_t), intent(in), optional :: workspace
	end subroutine process_library_load
	<<Process libraries: procedures>>=
	module subroutine process_library_load (lib, os_data, keep_old_source, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	logical, intent(in), optional :: keep_old_source
	type(string_t), intent(in), optional :: workspace
	select case (lib%status)
	case (STAT_CONFIGURED:STAT_COMPILED)
	call lib%make_link (os_data, keep_old_source, workspace)
	end select
	if (signal_is_pending ()) return
	select case (lib%status)
	case (STAT_LINKED)
	if (lib%external) then
	call msg_message ("Process library '" // char (lib%basename) &
	// "': loading")
	call lib%driver%load (os_data, workspace=workspace)
	call lib%load_entries ()
	end if
	lib%entry%status = STAT_ACTIVE
	lib%status = STAT_ACTIVE
	end select
	end subroutine process_library_load

	@ %def process_library_load
	@ This is the actual loading part for the process methods.
	<<Process libraries: process library: TBP>>=
	procedure :: load_entries => process_library_load_entries
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_load_entries (lib)
	class(process_library_t), intent(inout) :: lib
	end subroutine process_library_load_entries
	<<Process libraries: procedures>>=
	module subroutine process_library_load_entries (lib)
	class(process_library_t), intent(inout) :: lib
	integer :: i
	do i = 1, size (lib%entry)
	associate (entry => lib%entry(i))
	if (entry%i_external /= 0) then
	call entry%connect (lib%driver, entry%i_external)
	end if
	end associate
	end do
	end subroutine process_library_load_entries

	@ %def process_library_load_entries
	@ Unload the library, if possible. This reverts the status to ``linked''.
	<<Process libraries: process library: TBP>>=
	procedure :: unload => process_library_unload
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_unload (lib)
	class(process_library_t), intent(inout) :: lib
	end subroutine process_library_unload
	<<Process libraries: procedures>>=
	module subroutine process_library_unload (lib)
	class(process_library_t), intent(inout) :: lib
	select case (lib%status)
	case (STAT_ACTIVE)
	if (lib%external) then
	call msg_message ("Process library '" // char (lib%basename) &
	// "': unloading")
	call lib%driver%unload ()
	end if
	lib%entry%status = STAT_LINKED
	lib%status = STAT_LINKED
	end select
	end subroutine process_library_unload

	@ %def process_library_unload
	@ Unload, clean all generated files and revert the library status. If
	[[distclean]] is set, also remove the makefile and the driver source.
	<<Process libraries: process library: TBP>>=
	procedure :: clean => process_library_clean
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_clean (lib, os_data, distclean, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: distclean
	type(string_t), intent(in), optional :: workspace
	end subroutine process_library_clean
	<<Process libraries: procedures>>=
	module subroutine process_library_clean (lib, os_data, distclean, workspace)
	class(process_library_t), intent(inout) :: lib
	type(os_data_t), intent(in) :: os_data
	logical, intent(in) :: distclean
	type(string_t), intent(in), optional :: workspace
	call lib%unload ()
	if (lib%external .and. .not. lib%static) then
	call msg_message ("Process library '" // char (lib%basename) &
	// "': removing old files")
	if (distclean) then
	call lib%driver%distclean (os_data, workspace)
	else
	call lib%driver%clean (os_data, workspace)
	end if
	end if
	where (lib%entry%i_external /= 0)
	lib%entry%status = STAT_CONFIGURED
	elsewhere
	lib%entry%status = STAT_LINKED
	end where
	if (lib%external) then
	lib%status = STAT_CONFIGURED
	else
	lib%status = STAT_LINKED
	end if
	end subroutine process_library_clean

	@ %def process_library_clean
	@ Unload and revert the library status to INITIAL. This allows for
	appending new processes. No files are deleted.
	<<Process libraries: process library: TBP>>=
	procedure :: open => process_library_open
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_open (lib)
	class(process_library_t), intent(inout) :: lib
	end subroutine process_library_open
	<<Process libraries: procedures>>=
	module subroutine process_library_open (lib)
	class(process_library_t), intent(inout) :: lib
	select case (lib%status)
	case (STAT_OPEN)
	case default
	call lib%unload ()
	if (.not. lib%static) then
	lib%entry%status = STAT_OPEN
	lib%status = STAT_OPEN
	if (lib%external) lib%update_counter = lib%update_counter + 1
	call msg_message ("Process library '" // char (lib%basename) &
	// "': open")
	else
	call msg_error ("Static process library '" // char (lib%basename) &
	// "': processes can't be appended")
	end if
	end select
	end subroutine process_library_open

	@ %def process_library_open
	@
	\subsection{Use the library}
	Return the base name of the library
	<<Process libraries: process library: TBP>>=
	procedure :: get_name => process_library_get_name
	<<Process libraries: sub interfaces>>=
	module function process_library_get_name (lib) result (name)
	class(process_library_t), intent(in) :: lib
	type(string_t) :: name
	end function process_library_get_name
	<<Process libraries: procedures>>=
	module function process_library_get_name (lib) result (name)
	class(process_library_t), intent(in) :: lib
	type(string_t) :: name
	name = lib%basename
	end function process_library_get_name

	@ %def process_library_get_name
	@
	Once activated, we view the process library object as an interface for
	accessing the matrix elements.
	<<Process libraries: process library: TBP>>=
	procedure :: is_active => process_library_is_active
	<<Process libraries: sub interfaces>>=
	module function process_library_is_active (lib) result (flag)
	logical :: flag
	class(process_library_t), intent(in) :: lib
	end function process_library_is_active
	<<Process libraries: procedures>>=
	module function process_library_is_active (lib) result (flag)
	logical :: flag
	class(process_library_t), intent(in) :: lib
	flag = lib%status == STAT_ACTIVE
	end function process_library_is_active

	@ %def process_library_is_active
	@ Return the current status code of the library. If an index is
	provided, return the status of that entry.
	<<Process libraries: process library: TBP>>=
	procedure :: get_status => process_library_get_status
	<<Process libraries: sub interfaces>>=
	module function process_library_get_status (lib, i) result (status)
	class(process_library_t), intent(in) :: lib
	integer, intent(in), optional :: i
	integer :: status
	end function process_library_get_status
	<<Process libraries: procedures>>=
	module function process_library_get_status (lib, i) result (status)
	class(process_library_t), intent(in) :: lib
	integer, intent(in), optional :: i
	integer :: status
	if (present (i)) then
	status = lib%entry(i)%status
	else
	status = lib%status
	end if
	end function process_library_get_status

	@ %def process_library_get_status
	@ Return the update counter. Since this is incremented each time the
	library is re-opened, we can use this to check if existing pointers to
	matrix element code are still valid.
	<<Process libraries: process library: TBP>>=
	procedure :: get_update_counter => process_library_get_update_counter
	<<Process libraries: sub interfaces>>=
	module function process_library_get_update_counter (lib) result (counter)
	class(process_library_t), intent(in) :: lib
	integer :: counter
	end function process_library_get_update_counter
	<<Process libraries: procedures>>=
	module function process_library_get_update_counter (lib) result (counter)
	class(process_library_t), intent(in) :: lib
	integer :: counter
	counter = lib%update_counter
	end function process_library_get_update_counter

	@ %def process_library_get_update_counter
	@ Manually set the current status code of the library. If the
	optional flag is set, set also the entry status codes. This is used
	for unit tests.
	<<Process libraries: process library: TBP>>=
	procedure :: set_status => process_library_set_status
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_set_status (lib, status, entries)
	class(process_library_t), intent(inout) :: lib
	integer, intent(in) :: status
	logical, intent(in), optional :: entries
	end subroutine process_library_set_status
	<<Process libraries: procedures>>=
	module subroutine process_library_set_status (lib, status, entries)
	class(process_library_t), intent(inout) :: lib
	integer, intent(in) :: status
	logical, intent(in), optional :: entries
	lib%status = status
	if (present (entries)) then
	if (entries) lib%entry%status = status
	end if
	end subroutine process_library_set_status

	@ %def process_library_set_status
	@ Return the load status of the associated driver.
	<<Process libraries: process library: TBP>>=
	procedure :: is_loaded => process_library_is_loaded
	<<Process libraries: sub interfaces>>=
	module function process_library_is_loaded (lib) result (flag)
	class(process_library_t), intent(in) :: lib
	logical :: flag
	end function process_library_is_loaded
	<<Process libraries: procedures>>=
	module function process_library_is_loaded (lib) result (flag)
	class(process_library_t), intent(in) :: lib
	logical :: flag
	flag = lib%driver%loaded
	end function process_library_is_loaded

	@ %def process_library_is_loaded
	@ Retrieve constants using the process library driver. We assume that
	the process code has been loaded, if external.
	<<Process libraries: process library entry: TBP>>=
	procedure :: fill_constants => process_library_entry_fill_constants
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_entry_fill_constants (entry, driver, data)
	class(process_library_entry_t), intent(in) :: entry
	class(prclib_driver_t), intent(in) :: driver
	type(process_constants_t), intent(out) :: data
	end subroutine process_library_entry_fill_constants
	<<Process libraries: procedures>>=
	module subroutine process_library_entry_fill_constants (entry, driver, data)
	class(process_library_entry_t), intent(in) :: entry
	class(prclib_driver_t), intent(in) :: driver
	type(process_constants_t), intent(out) :: data
	integer :: i
	if (entry%i_external /= 0) then
	i = entry%i_external
	data%id = driver%get_process_id (i)
	data%model_name = driver%get_model_name (i)
	data%md5sum = driver%get_md5sum (i)
	data%openmp_supported = driver%get_openmp_status (i)
	data%n_in = driver%get_n_in (i)
	data%n_out = driver%get_n_out (i)
	data%n_flv = driver%get_n_flv (i)
	data%n_hel = driver%get_n_hel (i)
	data%n_col = driver%get_n_col (i)
	data%n_cin = driver%get_n_cin (i)
	data%n_cf = driver%get_n_cf (i)
	call driver%set_flv_state (i, data%flv_state)
	call driver%set_hel_state (i, data%hel_state)
	call driver%set_col_state (i, data%col_state, data%ghost_flag)
	call driver%set_color_factors (i, data%color_factors, data%cf_index)
	else
	select type (proc_driver => entry%driver)
	class is (process_driver_internal_t)
	call proc_driver%fill_constants (data)
	end select
	end if
	end subroutine process_library_entry_fill_constants

	@ %def process_library_entry_fill_constants
	@ Retrieve the constants for a process
	<<Process libraries: process library: TBP>>=
	procedure :: fill_constants => process_library_fill_constants
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_fill_constants (lib, id, i_component, data)
	class(process_library_t), intent(in) :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	type(process_constants_t), intent(out) :: data
	end subroutine process_library_fill_constants
	<<Process libraries: procedures>>=
	module subroutine process_library_fill_constants (lib, id, i_component, data)
	class(process_library_t), intent(in) :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	type(process_constants_t), intent(out) :: data
	integer :: i
	do i = 1, size (lib%entry)
	associate (entry => lib%entry(i))
	if (entry%def%id == id .and. entry%i_component == i_component) then
	call entry%fill_constants (lib%driver, data)
	return
	end if
	end associate
	end do
	end subroutine process_library_fill_constants

	@ %def process_library_fill_constants
	@ Retrieve the constants and a connected driver for a process,
	identified by a process ID and a subprocess index. We
	scan the process entries until we have found a match.
	<<Process libraries: process library: TBP>>=
	procedure :: connect_process => process_library_connect_process
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_connect_process &
	(lib, id, i_component, data, proc_driver)
	class(process_library_t), intent(in) :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	type(process_constants_t), intent(out) :: data
	class(prc_core_driver_t), allocatable, intent(out) :: proc_driver
	end subroutine process_library_connect_process
	<<Process libraries: procedures>>=
	module subroutine process_library_connect_process &
	(lib, id, i_component, data, proc_driver)
	class(process_library_t), intent(in) :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	type(process_constants_t), intent(out) :: data
	class(prc_core_driver_t), allocatable, intent(out) :: proc_driver
	integer :: i
	do i = 1, size (lib%entry)
	associate (entry => lib%entry(i))
	if (entry%def%id == id .and. entry%i_component == i_component) then
	call entry%fill_constants (lib%driver, data)
	allocate (proc_driver, source = entry%driver)
	return
	end if
	end associate
	end do
	call msg_fatal ("Process library '" // char (lib%basename) &
	// "': process '" // char (id) // "' not found")
	end subroutine process_library_connect_process

	@ %def process_library_connect_process
	@
	Shortcut for use in unit tests: fetch the MD5sum from a specific
	library entry and inject it into the writer of a specific record.
	<<Process libraries: process library: TBP>>=
	procedure :: test_transfer_md5sum => process_library_test_transfer_md5sum
	<<Process libraries: sub interfaces>>=
	module subroutine process_library_test_transfer_md5sum (lib, r, e, c)
	class(process_library_t), intent(inout) :: lib
	integer, intent(in) :: r, e, c
	end subroutine process_library_test_transfer_md5sum
	<<Process libraries: procedures>>=
	module subroutine process_library_test_transfer_md5sum (lib, r, e, c)
	class(process_library_t), intent(inout) :: lib
	integer, intent(in) :: r, e, c
	associate (writer => lib%driver%record(r)%writer)
	writer%md5sum = lib%entry(e)%def%get_md5sum (c)
	end associate
	end subroutine process_library_test_transfer_md5sum

	@ %def process_library_test_transfer_md5sum
	@
	<<Process libraries: process library: TBP>>=
	procedure :: get_nlo_type => process_library_get_nlo_type
	<<Process libraries: sub interfaces>>=
	module function process_library_get_nlo_type (lib, id, i_component) result (nlo_type)
	integer :: nlo_type
	class(process_library_t), intent(in) :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	end function process_library_get_nlo_type
	<<Process libraries: procedures>>=
	module function process_library_get_nlo_type (lib, id, i_component) result (nlo_type)
	integer :: nlo_type
	class(process_library_t), intent(in) :: lib
	type(string_t), intent(in) :: id
	integer, intent(in) :: i_component
	integer :: i
	do i = 1, size (lib%entry)
	if (lib%entry(i)%def%id == id .and. lib%entry(i)%i_component == i_component) then
	nlo_type = lib%entry(i)%def%get_nlo_type (i_component)
	exit
	end if
	end do
	end function process_library_get_nlo_type

	@ %def process_library_get_nlo_type
	@
	\subsection{Collect model-specific libraries}
	This returns appropriate linker flags for the model parameter libraries that
	are used by the generated matrix element. At the end, the main libwhizard is
	appended (again), because functions from that may be reqired.

	Extra models in the local user space need to be treated individually.
	<<Process libraries: process library: TBP>>=
	procedure :: get_modellibs_ldflags => process_library_get_modellibs_ldflags
	<<Process libraries: sub interfaces>>=
	module function process_library_get_modellibs_ldflags (prc_lib, os_data) result (flags)
	class(process_library_t), intent(in) :: prc_lib
	type(os_data_t), intent(in) :: os_data
	type(string_t) :: flags
	end function process_library_get_modellibs_ldflags
	<<Process libraries: procedures>>=
	module function process_library_get_modellibs_ldflags (prc_lib, os_data) result (flags)
	class(process_library_t), intent(in) :: prc_lib
	type(os_data_t), intent(in) :: os_data
	type(string_t) :: flags
	type(string_t), dimension(:), allocatable :: models
	type(string_t) :: modelname, modellib, modellib_full
	logical :: exist
	integer :: i, j, mi
	flags = " -lomega"
	if ((.not. os_data%use_testfiles) .and. &
	os_dir_exist (os_data%whizard_models_libpath_local)) &
	flags = flags // " -L" // os_data%whizard_models_libpath_local
	flags = flags // " -L" // os_data%whizard_models_libpath
	allocate (models(prc_lib%n_entries + 1))
	models = ""
	mi = 1
	if (allocated (prc_lib%entry)) then
	SCAN: do i = 1, prc_lib%n_entries
	if (associated (prc_lib%entry(i)%def)) then
	if (prc_lib%entry(i)%def%model_name /= "") then
	modelname = prc_lib%entry(i)%def%model_name
	else
	cycle SCAN
	end if
	else
	cycle SCAN
	end if
	do j = 1, mi
	if (models(mi) == modelname) cycle SCAN
	end do
	models(mi) = modelname
	mi = mi + 1
	if (os_data%use_libtool) then
	modellib = "libparameters_" // modelname // ".la"
	else
	modellib = "libparameters_" // modelname // ".a"
	end if
	exist = .false.
	if (.not. os_data%use_testfiles) then
	modellib_full = os_data%whizard_models_libpath_local &
	// "/" // modellib
	inquire (file=char (modellib_full), exist=exist)
	end if
	if (.not. exist) then
	modellib_full = os_data%whizard_models_libpath &
	// "/" // modellib
	inquire (file=char (modellib_full), exist=exist)
	end if
	if (exist) flags = flags // " -lparameters_" // modelname
	end do SCAN
	end if
	deallocate (models)
	flags = flags // " -lwhizard"
	end function process_library_get_modellibs_ldflags

	@ %def process_library_get_modellibs_ldflags
	@
	<<Process libraries: process library: TBP>>=
	procedure :: get_static_modelname => process_library_get_static_modelname
	<<Process libraries: sub interfaces>>=
	module function process_library_get_static_modelname (prc_lib, os_data) result (name)
	class(process_library_t), intent(in) :: prc_lib
	type(os_data_t), intent(in) :: os_data
	type(string_t) :: name
	end function process_library_get_static_modelname
	<<Process libraries: procedures>>=
	module function process_library_get_static_modelname (prc_lib, os_data) result (name)
	class(process_library_t), intent(in) :: prc_lib
	type(os_data_t), intent(in) :: os_data
	type(string_t) :: name
	type(string_t), dimension(:), allocatable :: models
	type(string_t) :: modelname, modellib, modellib_full
	logical :: exist
	integer :: i, j, mi
	name = ""
	allocate (models(prc_lib%n_entries + 1))
	models = ""
	mi = 1
	if (allocated (prc_lib%entry)) then
	SCAN: do i = 1, prc_lib%n_entries
	if (associated (prc_lib%entry(i)%def)) then
	if (prc_lib%entry(i)%def%model_name /= "") then
	modelname = prc_lib%entry(i)%def%model_name
	else
	cycle SCAN
	end if
	else
	cycle SCAN
	end if
	do j = 1, mi
	if (models(mi) == modelname) cycle SCAN
	end do
	models(mi) = modelname
	mi = mi + 1
	modellib = "libparameters_" // modelname // ".a"
	exist = .false.
	if (.not. os_data%use_testfiles) then
	modellib_full = os_data%whizard_models_libpath_local &
	// "/" // modellib
	inquire (file=char (modellib_full), exist=exist)
	end if
	if (.not. exist) then
	modellib_full = os_data%whizard_models_libpath &
	// "/" // modellib
	inquire (file=char (modellib_full), exist=exist)
	end if
	if (exist) name = name // " " // modellib_full
	end do SCAN
	end if
	deallocate (models)
	end function process_library_get_static_modelname

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

	module process_libraries_ut
	use unit_tests
	use process_libraries_uti

	<<Standard module head>>

	<<Process libraries: public test>>

	contains

	<<Process libraries: test driver>>

	end module process_libraries_ut
	@ %def process_libraries_ut
	@
	<<[[process_libraries_uti.f90]]>>=
	<<File header>>

	module process_libraries_uti

	use, intrinsic :: iso_c_binding !NODEP!

	<<Use strings>>
	use io_units
	use os_interface
	use particle_specifiers, only: new_prt_spec
	use process_constants
	use prclib_interfaces
	use prc_core_def

	use process_libraries

	use prclib_interfaces_ut, only: test_writer_4_t

	<<Standard module head>>

	<<Process libraries: test declarations>>

	<<Process libraries: test types>>

	contains

	<<Process libraries: tests>>

	<<Process libraries: test auxiliary>>

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

	@ %def process_libraries_test
	@
	\subsubsection{Empty process list}
	Test 1: Write an empty process list.
	<<Process libraries: execute tests>>=
	call test (process_libraries_1, "process_libraries_1", &
	"empty process list", &
	u, results)
	<<Process libraries: test declarations>>=
	public :: process_libraries_1
	<<Process libraries: tests>>=
	subroutine process_libraries_1 (u)
	integer, intent(in) :: u
	type(process_def_list_t) :: process_def_list

	write (u, "(A)") "* Test output: process_libraries_1"
	write (u, "(A)") "* Purpose: Display an empty process definition list"
	write (u, "(A)")

	call process_def_list%write (u)

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

	@ %def process_libraries_1
	@
	\subsubsection{Process definition list}
	Test 2: Process definition list with processes and components.
	Construct the list, write to file, read it in again, and display.
	Finalize and delete the list after use.

	We define a trivial 'test' type for the process variant. The test
	type contains just one (meaningless) data item, which is an integer.
	<<Process libraries: test types>>=
	type, extends (prc_core_def_t) :: prcdef_2_t
	integer :: data = 0
	logical :: file = .false.
	contains
	<<Process libraries: prcdef 2: TBP>>
	end type prcdef_2_t

	@ %def prcdef_2_t
	@ The process variant is named 'test'.
	<<Process libraries: prcdef 2: TBP>>=
	procedure, nopass :: type_string => prcdef_2_type_string
	<<Process libraries: test auxiliary>>=
	function prcdef_2_type_string () result (string)
	type(string_t) :: string
	string = "test"
	end function prcdef_2_type_string

	@ %def prcdef_2_type_string
	@ Write the contents (the integer value).
	<<Process libraries: prcdef 2: TBP>>=
	procedure :: write => prcdef_2_write
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_2_write (object, unit)
	class(prcdef_2_t), intent(in) :: object
	integer, intent(in) :: unit
	write (unit, "(3x,A,I0)") "Test data = ", object%data
	end subroutine prcdef_2_write

	@ %def prcdef_2_write
	@ Recover the integer value.
	<<Process libraries: prcdef 2: TBP>>=
	procedure :: read => prcdef_2_read
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_2_read (object, unit)
	class(prcdef_2_t), intent(out) :: object
	integer, intent(in) :: unit
	character(80) :: buffer
	read (unit, "(A)") buffer
	call strip_equation_lhs (buffer)
	read (buffer, *) object%data
	end subroutine prcdef_2_read

	@ %def prcdef_2_read
	@ No external procedures.
	<<Process libraries: prcdef 2: TBP>>=
	procedure, nopass :: get_features => prcdef_2_get_features
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_2_get_features (features)
	type(string_t), dimension(:), allocatable, intent(out) :: features
	allocate (features (0))
	end subroutine prcdef_2_get_features

	@ %def prcdef_2_get_features
	@ No code generated.
	<<Process libraries: prcdef 2: TBP>>=
	procedure :: generate_code => prcdef_2_generate_code
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_2_generate_code (object, &
	basename, model_name, prt_in, prt_out)
	class(prcdef_2_t), intent(in) :: object
	type(string_t), intent(in) :: basename
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	end subroutine prcdef_2_generate_code

	@ %def prcdef_2_generate_code
	@ Allocate the driver with the appropriate type.
	<<Process libraries: prcdef 2: TBP>>=
	procedure :: allocate_driver => prcdef_2_allocate_driver
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_2_allocate_driver (object, driver, basename)
	class(prcdef_2_t), intent(in) :: object
	class(prc_core_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	allocate (prctest_2_t :: driver)
	end subroutine prcdef_2_allocate_driver

	@ %def prcdef_2_allocate_driver
	@ Nothing to connect.
	<<Process libraries: prcdef 2: TBP>>=
	procedure :: connect => prcdef_2_connect
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_2_connect (def, lib_driver, i, proc_driver)
	class(prcdef_2_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	end subroutine prcdef_2_connect

	@ %def prcdef_2_connect
	@ The associated driver type.
	<<Process libraries: test types>>=
	type, extends (process_driver_internal_t) :: prctest_2_t
	contains
	<<Process libraries: prctest 2: TBP>>
	end type prctest_2_t

	@ %def prctest_2_t
	@ Return the type name.
	<<Process libraries: prctest 2: TBP>>=
	procedure, nopass :: type_name => prctest_2_type_name
	<<Process libraries: test auxiliary>>=
	function prctest_2_type_name () result (type)
	type(string_t) :: type
	type = "test"
	end function prctest_2_type_name

	@ %def prctest_2_type_name
	@ This should fill constant process data. We do not check those here,
	however, therefore nothing done.
	<<Process libraries: prctest 2: TBP>>=
	procedure :: fill_constants => prctest_2_fill_constants
	<<Process libraries: test auxiliary>>=
	subroutine prctest_2_fill_constants (driver, data)
	class(prctest_2_t), intent(in) :: driver
	type(process_constants_t), intent(out) :: data
	end subroutine prctest_2_fill_constants

	@ %def prctest_2_fill_constants
	@
	Here is the actual test.

	For reading, we need a list of templates, i.e., an array containing
	allocated objects for all available process variants. This is the
	purpose of [[process_core_templates]]. Here, we have only a single
	template for the 'test' variant.
	<<Process libraries: execute tests>>=
	call test (process_libraries_2, "process_libraries_2", &
	"process definition list", &
	u, results)
	<<Process libraries: test declarations>>=
	public :: process_libraries_2
	<<Process libraries: tests>>=
	subroutine process_libraries_2 (u)
	integer, intent(in) :: u
	type(prc_template_t), dimension(:), allocatable :: process_core_templates
	type(process_def_list_t) :: process_def_list
	type(process_def_entry_t), pointer :: entry => null ()
	class(prc_core_def_t), allocatable :: test_def
	integer :: scratch_unit

	write (u, "(A)") "* Test output: process_libraries_2"
	write (u, "(A)") "* Purpose: Construct a process definition list,"
	write (u, "(A)") "* write it to file and reread it"
	write (u, "(A)") ""
	write (u, "(A)") "* Construct a process definition list"
	write (u, "(A)") "* First process definition: empty"
	write (u, "(A)") "* Second process definition: two components"
	write (u, "(A)") "* First component: empty"
	write (u, "(A)") "* Second component: test data"
	write (u, "(A)") "* Third process definition:"
	write (u, "(A)") "* Embedded decays and polarization"
	write (u, "(A)")

	allocate (process_core_templates (1))
	allocate (prcdef_2_t :: process_core_templates(1)%core_def)

	allocate (entry)
	call entry%init (var_str ("first"), n_in = 0, n_components = 0)
	call entry%compute_md5sum ()
	call process_def_list%append (entry)

	allocate (entry)
	call entry%init (var_str ("second"), model_name = var_str ("Test"), &
	n_in = 1, n_components = 2)
	allocate (prcdef_2_t :: test_def)
	select type (test_def)
	type is (prcdef_2_t); test_def%data = 42
	end select
	call entry%import_component (2, n_out = 2, &
	prt_in = new_prt_spec ([var_str ("a")]), &
	prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
	method = var_str ("test"), &
	variant = test_def)
	call entry%compute_md5sum ()
	call process_def_list%append (entry)

	allocate (entry)
	call entry%init (var_str ("third"), model_name = var_str ("Test"), &
	n_in = 2, n_components = 1)
	allocate (prcdef_2_t :: test_def)
	call entry%import_component (1, n_out = 3, &
	prt_in = &
	new_prt_spec ([var_str ("a"), var_str ("b")]), &
	prt_out = &
	[new_prt_spec (var_str ("c")), &
	new_prt_spec (var_str ("d"), .true.), &
	new_prt_spec (var_str ("e"), [var_str ("e_decay")])], &
	method = var_str ("test"), &
	variant = test_def)
	call entry%compute_md5sum ()
	call process_def_list%append (entry)
	call process_def_list%write (u)

	write (u, "(A)") ""
	write (u, "(A)") "* Write the process definition list to (scratch) file"

	scratch_unit = free_unit ()
	open (unit = scratch_unit, status="scratch", action = "readwrite")
	call process_def_list%write (scratch_unit)
	call process_def_list%final ()

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

	rewind (scratch_unit)
	call process_def_list%read (scratch_unit, process_core_templates)
	close (scratch_unit)

	call process_def_list%write (u)
	call process_def_list%final ()

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

	@ %def process_libraries_2
	@
	\subsubsection{Process library object}
	Test 3: Process library object with several process definitions and
	library entries. Just construct the object, modify some initial
	content, and write the result. The modifications are mostly applied
	directly, so we do not test anything but the contents and the output
	routine.
	<<Process libraries: execute tests>>=
	call test (process_libraries_3, "process_libraries_3", &
	"recover process definition list from file", &
	u, results)
	<<Process libraries: test declarations>>=
	public :: process_libraries_3
	<<Process libraries: tests>>=
	subroutine process_libraries_3 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	type(process_def_entry_t), pointer :: entry
	class(prc_core_driver_t), allocatable :: driver_template

	write (u, "(A)") "* Test output: process_libraries_3"
	write (u, "(A)") "* Purpose: Construct a process library object &
	&with entries"
	write (u, "(A)") ""
	write (u, "(A)") "* Construct and display a process library object"
	write (u, "(A)") "* with 5 entries"
	write (u, "(A)") "* associated with 3 matrix element codes"
	write (u, "(A)") "* corresponding to 3 process definitions"
	write (u, "(A)") "* with 2, 1, 1 components, respectively"
	write (u, "(A)")

	call lib%init (var_str ("testlib"))

	call lib%set_status (STAT_ACTIVE)
	call lib%allocate_entries (5)

	allocate (entry)
	call entry%init (var_str ("test_a"), n_in = 2, n_components = 2)
	allocate (prctest_2_t :: driver_template)
	call lib%init_entry (3, STAT_SOURCE, entry%process_def_t, 2, 2, &
	driver_template)
	call lib%init_entry (4, STAT_COMPILED, entry%process_def_t, 1, 0)
	call lib%append (entry)

	allocate (entry)
	call entry%init (var_str ("test_b"), n_in = 2, n_components = 1)
	call lib%init_entry (2, STAT_CONFIGURED, entry%process_def_t, 1, 1)
	call lib%append (entry)

	allocate (entry)
	call entry%init (var_str ("test_c"), n_in = 2, n_components = 1)
	allocate (prctest_2_t :: driver_template)
	call lib%init_entry (5, STAT_LINKED, entry%process_def_t, 1, 3, &
	driver_template)
	call lib%append (entry)

	call lib%write (u)
	call lib%final ()

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

	@ %def process_libraries_3
	@
	\subsubsection{Process library for test matrix element (no file)}
	Test 4: We proceed through the library generation and loading phases
	with a test matrix element type that needs no code written on file.
	<<Process libraries: execute tests>>=
	call test (process_libraries_4, "process_libraries_4", &
	"build and load internal process library", &
	u, results)
	<<Process libraries: test declarations>>=
	public :: process_libraries_4
	<<Process libraries: tests>>=
	subroutine process_libraries_4 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	type(process_def_entry_t), pointer :: entry
	class(prc_core_def_t), allocatable :: core_def
	type(os_data_t) :: os_data

	write (u, "(A)") "* Test output: process_libraries_4"
	write (u, "(A)") "* Purpose: build a process library with an &
	&internal (pseudo) matrix element"
	write (u, "(A)") "* No Makefile or code should be generated"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with one entry &
	&(no external code)"
	write (u, "(A)")
	call os_data%init ()
	call lib%init (var_str ("proclibs4"))

	allocate (prcdef_2_t :: core_def)

	allocate (entry)
	call entry%init (var_str ("proclibs4_a"), n_in = 1, n_components = 1)
	call entry%import_component (1, n_out = 2, variant = core_def)
	call lib%append (entry)

	write (u, "(A)") "* Configure library"
	write (u, "(A)")
	call lib%configure (os_data)

	write (u, "(A)") "* Compute MD5 sum"
	write (u, "(A)")
	call lib%compute_md5sum ()

	write (u, "(A)") "* Write makefile (no-op)"
	write (u, "(A)")
	call lib%write_makefile (os_data, force = .true., verbose = .true.)

	write (u, "(A)") "* Write driver source code (no-op)"
	write (u, "(A)")
	call lib%write_driver (force = .true.)

	write (u, "(A)") "* Write process source code (no-op)"
	write (u, "(A)")
	call lib%make_source (os_data)

	write (u, "(A)") "* Compile (no-op)"
	write (u, "(A)")
	call lib%make_compile (os_data)

	write (u, "(A)") "* Link (no-op)"
	write (u, "(A)")
	call lib%make_link (os_data)

	write (u, "(A)") "* Load (no-op)"
	write (u, "(A)")
	call lib%load (os_data)

	call lib%write (u)
	call lib%final ()

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

	@ %def process_libraries_4
	@
	\subsubsection{Build workflow for test matrix element}
	Test 5: We write source code for a dummy process.

	We define another trivial type for the process variant. The test
	type contains just no variable data, but produces code on file.
	<<Process libraries: test types>>=
	type, extends (prc_core_def_t) :: prcdef_5_t
	contains
	<<Process libraries: prcdef 5: TBP>>
	end type prcdef_5_t

	@ %def prcdef_5_t
	@ The process variant is named [[test_file]].
	<<Process libraries: prcdef 5: TBP>>=
	procedure, nopass :: type_string => prcdef_5_type_string
	<<Process libraries: test auxiliary>>=
	function prcdef_5_type_string () result (string)
	type(string_t) :: string
	string = "test_file"
	end function prcdef_5_type_string

	@ %def prcdef_5_type_string
	@ We reuse the writer [[test_writer_4]] from the previous module.
	<<Process libraries: prcdef 5: TBP>>=
	procedure :: init => prcdef_5_init
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_5_init (object)
	class(prcdef_5_t), intent(out) :: object
	allocate (test_writer_4_t :: object%writer)
	end subroutine prcdef_5_init

	@ %def prcdef_5_init
	@ Nothing to write.
	<<Process libraries: prcdef 5: TBP>>=
	procedure :: write => prcdef_5_write
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_5_write (object, unit)
	class(prcdef_5_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine prcdef_5_write

	@ %def prcdef_5_write
	@ Nothing to read.
	<<Process libraries: prcdef 5: TBP>>=
	procedure :: read => prcdef_5_read
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_5_read (object, unit)
	class(prcdef_5_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine prcdef_5_read

	@ %def prcdef_5_read
	@ Allocate the driver with the appropriate type.
	<<Process libraries: prcdef 5: TBP>>=
	procedure :: allocate_driver => prcdef_5_allocate_driver
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_5_allocate_driver (object, driver, basename)
	class(prcdef_5_t), intent(in) :: object
	class(prc_core_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	allocate (prctest_5_t :: driver)
	end subroutine prcdef_5_allocate_driver

	@ %def prcdef_5_allocate_driver
	@ This time we need code:
	<<Process libraries: prcdef 5: TBP>>=
	procedure, nopass :: needs_code => prcdef_5_needs_code
	<<Process libraries: test auxiliary>>=
	function prcdef_5_needs_code () result (flag)
	logical :: flag
	flag = .true.
	end function prcdef_5_needs_code

	@ %def prcdef_5_needs_code
	@ For the test case, we implement a single feature [[proc1]].
	<<Process libraries: prcdef 5: TBP>>=
	procedure, nopass :: get_features => prcdef_5_get_features
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_5_get_features (features)
	type(string_t), dimension(:), allocatable, intent(out) :: features
	allocate (features (1))
	features = [ var_str ("proc1") ]
	end subroutine prcdef_5_get_features

	@ %def prcdef_5_get_features
	@ Nothing to connect.
	<<Process libraries: prcdef 5: TBP>>=
	procedure :: connect => prcdef_5_connect
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_5_connect (def, lib_driver, i, proc_driver)
	class(prcdef_5_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	end subroutine prcdef_5_connect

	@ %def prcdef_5_connect
	@ The driver type.
	<<Process libraries: test types>>=
	type, extends (prc_core_driver_t) :: prctest_5_t
	contains
	<<Process libraries: prctest 5: TBP>>
	end type prctest_5_t

	@ %def prctest_5_t
	@ Return the type name.
	<<Process libraries: prctest 5: TBP>>=
	procedure, nopass :: type_name => prctest_5_type_name
	<<Process libraries: test auxiliary>>=
	function prctest_5_type_name () result (type)
	type(string_t) :: type
	type = "test_file"
	end function prctest_5_type_name

	@ %def prctest_5_type_name
	@
	Here is the actual test:
	<<Process libraries: execute tests>>=
	call test (process_libraries_5, "process_libraries_5", &
	"build external process library", &
	u, results)
	<<Process libraries: test declarations>>=
	public :: process_libraries_5
	<<Process libraries: tests>>=
	subroutine process_libraries_5 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	type(process_def_entry_t), pointer :: entry
	class(prc_core_def_t), allocatable :: core_def
	type(os_data_t) :: os_data

	write (u, "(A)") "* Test output: process_libraries_5"
	write (u, "(A)") "* Purpose: build a process library with an &
	&external (pseudo) matrix element"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with one entry"
	write (u, "(A)")
	call lib%init (var_str ("proclibs5"))
	call os_data%init ()

	allocate (prcdef_5_t :: core_def)
	select type (core_def)
	type is (prcdef_5_t)
	call core_def%init ()
	end select

	allocate (entry)
	call entry%init (var_str ("proclibs5_a"), &
	model_name = var_str ("Test_Model"), &
	n_in = 1, n_components = 1)
	call entry%import_component (1, n_out = 2, &
	prt_in = new_prt_spec ([var_str ("a")]), &
	prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
	method = var_str ("test"), &
	variant = core_def)
	call lib%append (entry)

	write (u, "(A)") "* Configure library"
	write (u, "(A)")
	call lib%configure (os_data)

	write (u, "(A)") "* Compute MD5 sum"
	write (u, "(A)")
	call lib%compute_md5sum ()

	write (u, "(A)") "* Write makefile"
	write (u, "(A)")
	call lib%write_makefile (os_data, force = .true., verbose = .false.)

	write (u, "(A)") "* Write driver source code"
	write (u, "(A)")
	call lib%write_driver (force = .true.)

	write (u, "(A)") "* Write process source code"
	write (u, "(A)")
	call lib%make_source (os_data)

	write (u, "(A)") "* Compile"
	write (u, "(A)")
	call lib%make_compile (os_data)

	write (u, "(A)") "* Link"
	write (u, "(A)")
	call lib%make_link (os_data)

	call lib%write (u, libpath = .false.)

	call lib%final ()

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

	@ %def process_libraries_5
	@
	\subsubsection{Build and load library with test matrix element}
	Test 6: We write source code for a dummy process.

	This process variant is identical to the previous case, but it
	supports a driver for the test procedure 'proc1'.
	<<Process libraries: test types>>=
	type, extends (prc_core_def_t) :: prcdef_6_t
	contains
	<<Process libraries: prcdef 6: TBP>>
	end type prcdef_6_t

	@ %def prcdef_6_t
	@ The process variant is named [[test_file]].
	<<Process libraries: prcdef 6: TBP>>=
	procedure, nopass :: type_string => prcdef_6_type_string
	<<Process libraries: test auxiliary>>=
	function prcdef_6_type_string () result (string)
	type(string_t) :: string
	string = "test_file"
	end function prcdef_6_type_string

	@ %def prcdef_6_type_string
	@ We reuse the writer [[test_writer_4]] from the previous module.
	<<Process libraries: prcdef 6: TBP>>=
	procedure :: init => prcdef_6_init
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_6_init (object)
	class(prcdef_6_t), intent(out) :: object
	allocate (test_writer_4_t :: object%writer)
	call object%writer%init_test ()
	end subroutine prcdef_6_init

	@ %def prcdef_6_init
	@ Nothing to write.
	<<Process libraries: prcdef 6: TBP>>=
	procedure :: write => prcdef_6_write
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_6_write (object, unit)
	class(prcdef_6_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine prcdef_6_write

	@ %def prcdef_6_write
	@ Nothing to read.
	<<Process libraries: prcdef 6: TBP>>=
	procedure :: read => prcdef_6_read
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_6_read (object, unit)
	class(prcdef_6_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine prcdef_6_read

	@ %def prcdef_6_read
	@ Allocate the driver with the appropriate type.
	<<Process libraries: prcdef 6: TBP>>=
	procedure :: allocate_driver => prcdef_6_allocate_driver
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_6_allocate_driver (object, driver, basename)
	class(prcdef_6_t), intent(in) :: object
	class(prc_core_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	allocate (prctest_6_t :: driver)
	end subroutine prcdef_6_allocate_driver

	@ %def prcdef_6_allocate_driver
	@ This time we need code:
	<<Process libraries: prcdef 6: TBP>>=
	procedure, nopass :: needs_code => prcdef_6_needs_code
	<<Process libraries: test auxiliary>>=
	function prcdef_6_needs_code () result (flag)
	logical :: flag
	flag = .true.
	end function prcdef_6_needs_code

	@ %def prcdef_6_needs_code
	@ For the test case, we implement a single feature [[proc1]].
	<<Process libraries: prcdef 6: TBP>>=
	procedure, nopass :: get_features => prcdef_6_get_features
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_6_get_features (features)
	type(string_t), dimension(:), allocatable, intent(out) :: features
	allocate (features (1))
	features = [ var_str ("proc1") ]
	end subroutine prcdef_6_get_features

	@ %def prcdef_6_get_features
	@ The interface of the only specific feature.
	<<Process libraries: test types>>=
	abstract interface
	subroutine proc1_t (n) bind(C)
	import
	integer(c_int), intent(out) :: n
	end subroutine proc1_t
	end interface

	@ %def proc1_t
	@ Connect the feature [[proc1]] with the process driver.
	<<Process libraries: prcdef 6: TBP>>=
	procedure :: connect => prcdef_6_connect
	<<Process libraries: test auxiliary>>=
	subroutine prcdef_6_connect (def, lib_driver, i, proc_driver)
	class(prcdef_6_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	integer(c_int) :: pid, fid
	type(c_funptr) :: fptr
	select type (proc_driver)
	type is (prctest_6_t)
	pid = i
	fid = 1
	call lib_driver%get_fptr (pid, fid, fptr)
	call c_f_procpointer (fptr, proc_driver%proc1)
	end select
	end subroutine prcdef_6_connect

	@ %def prcdef_6_connect
	@
	The driver type.
	<<Process libraries: test types>>=
	type, extends (prc_core_driver_t) :: prctest_6_t
	procedure(proc1_t), nopass, pointer :: proc1 => null ()
	contains
	<<Process libraries: prctest 6: TBP>>
	end type prctest_6_t

	@ %def prctest_6_t
	@ Return the type name.
	<<Process libraries: prctest 6: TBP>>=
	procedure, nopass :: type_name => prctest_6_type_name
	<<Process libraries: test auxiliary>>=
	function prctest_6_type_name () result (type)
	type(string_t) :: type
	type = "test_file"
	end function prctest_6_type_name

	@ %def prctest_6_type_name
	@
	Here is the actual test:
	<<Process libraries: execute tests>>=
	call test (process_libraries_6, "process_libraries_6", &
	"build and load external process library", &
	u, results)
	<<Process libraries: test declarations>>=
	public :: process_libraries_6
	<<Process libraries: tests>>=
	subroutine process_libraries_6 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	type(process_def_entry_t), pointer :: entry
	class(prc_core_def_t), allocatable :: core_def
	type(os_data_t) :: os_data
	type(string_t), dimension(:), allocatable :: name_list
	type(process_constants_t) :: data
	class(prc_core_driver_t), allocatable :: proc_driver
	integer :: i
	integer(c_int) :: n

	write (u, "(A)") "* Test output: process_libraries_6"
	write (u, "(A)") "* Purpose: build and load a process library"
	write (u, "(A)") "* with an external (pseudo) matrix element"
	write (u, "(A)") "* Check single-call linking"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with one entry"
	write (u, "(A)")
	call lib%init (var_str ("proclibs6"))
	call os_data%init ()

	allocate (prcdef_6_t :: core_def)
	select type (core_def)
	type is (prcdef_6_t)
	call core_def%init ()
	end select

	allocate (entry)
	call entry%init (var_str ("proclibs6_a"), &
	model_name = var_str ("Test_model"), &
	n_in = 1, n_components = 1)
	call entry%import_component (1, n_out = 2, &
	prt_in = new_prt_spec ([var_str ("a")]), &
	prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
	method = var_str ("test"), &
	variant = core_def)
	call lib%append (entry)

	write (u, "(A)") "* Configure library"
	write (u, "(A)")
	call lib%configure (os_data)

	write (u, "(A)") "* Write makefile"
	write (u, "(A)")
	call lib%write_makefile (os_data, force = .true., verbose = .false.)

	write (u, "(A)") "* Write driver source code"
	write (u, "(A)")
	call lib%write_driver (force = .true.)

	write (u, "(A)") "* Write process source code, compile, link, load"
	write (u, "(A)")
	call lib%load (os_data)

	call lib%write (u, libpath = .false.)

	write (u, "(A)")
	write (u, "(A)") "* Probe library API:"
	write (u, "(A)")

	write (u, "(1x,A,A,A)") "name = '", &
	char (lib%get_name ()), "'"
	write (u, "(1x,A,L1)") "is active = ", &
	lib%is_active ()
	write (u, "(1x,A,I0)") "n_processes = ", &
	lib%get_n_processes ()
	write (u, "(1x,A)", advance="no") "processes ="
	call lib%get_process_id_list (name_list)
	do i = 1, size (name_list)
	write (u, "(1x,A)", advance="no") char (name_list(i))
	end do
	write (u, *)
	write (u, "(1x,A,L1)") "proclibs6_a is process = ", &
	lib%contains (var_str ("proclibs6_a"))
	write (u, "(1x,A,I0)") "proclibs6_a has index = ", &
	lib%get_entry_index (var_str ("proclibs6_a"))
	write (u, "(1x,A,L1)") "foobar is process = ", &
	lib%contains (var_str ("foobar"))
	write (u, "(1x,A,I0)") "foobar has index = ", &
	lib%get_entry_index (var_str ("foobar"))
	write (u, "(1x,A,I0)") "n_in(proclibs6_a) = ", &
	lib%get_n_in (var_str ("proclibs6_a"))
	write (u, "(1x,A,A)") "model_name(proclibs6_a) = ", &
	char (lib%get_model_name (var_str ("proclibs6_a")))
	write (u, "(1x,A)", advance="no") "components(proclibs6_a) ="
	call lib%get_component_list (var_str ("proclibs6_a"), name_list)
	do i = 1, size (name_list)
	write (u, "(1x,A)", advance="no") char (name_list(i))
	end do
	write (u, *)

	write (u, "(A)")
	write (u, "(A)") "* Constants of proclibs6_a_i1:"
	write (u, "(A)")

	call lib%connect_process (var_str ("proclibs6_a"), 1, data, proc_driver)

	write (u, "(1x,A,A)") "component ID = ", char (data%id)
	write (u, "(1x,A,A)") "model name = ", char (data%model_name)
	write (u, "(1x,A,A,A)") "md5sum = '", data%md5sum, "'"
	write (u, "(1x,A,L1)") "openmp supported = ", data%openmp_supported
	write (u, "(1x,A,I0)") "n_in = ", data%n_in
	write (u, "(1x,A,I0)") "n_out = ", data%n_out
	write (u, "(1x,A,I0)") "n_flv = ", data%n_flv
	write (u, "(1x,A,I0)") "n_hel = ", data%n_hel
	write (u, "(1x,A,I0)") "n_col = ", data%n_col
	write (u, "(1x,A,I0)") "n_cin = ", data%n_cin
	write (u, "(1x,A,I0)") "n_cf = ", data%n_cf
	write (u, "(1x,A,10(1x,I0))") "flv state =", data%flv_state
	write (u, "(1x,A,10(1x,I0))") "hel state =", data%hel_state
	write (u, "(1x,A,10(1x,I0))") "col state =", data%col_state
	write (u, "(1x,A,10(1x,L1))") "ghost flag =", data%ghost_flag
	write (u, "(1x,A,10(1x,F5.3))") "color factors =", data%color_factors
	write (u, "(1x,A,10(1x,I0))") "cf index =", data%cf_index

	write (u, "(A)")
	write (u, "(A)") "* Call feature of proclibs6_a:"
	write (u, "(A)")

	select type (proc_driver)
	type is (prctest_6_t)
	call proc_driver%proc1 (n)
	write (u, "(1x,A,I0)") "proc1 = ", n
	end select

	call lib%final ()

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

	@ %def process_libraries_6
	@
	\subsubsection{MD5 sums}
	Check MD5 sum calculation.
	<<Process libraries: execute tests>>=
	call test (process_libraries_7, "process_libraries_7", &
	"process definition list", &
	u, results)
	<<Process libraries: test declarations>>=
	public :: process_libraries_7
	<<Process libraries: tests>>=
	subroutine process_libraries_7 (u)
	integer, intent(in) :: u
	type(prc_template_t), dimension(:), allocatable :: process_core_templates
	type(process_def_entry_t), target :: entry
	class(prc_core_def_t), allocatable :: test_def
	class(prc_core_def_t), pointer :: def

	write (u, "(A)") "* Test output: process_libraries_7"
	write (u, "(A)") "* Purpose: Construct a process definition list &
	&and check MD5 sums"
	write (u, "(A)")
	write (u, "(A)") "* Construct a process definition list"
	write (u, "(A)") "* Process: two components"
	write (u, "(A)")

	allocate (process_core_templates (1))
	allocate (prcdef_2_t :: process_core_templates(1)%core_def)

	call entry%init (var_str ("first"), model_name = var_str ("Test"), &
	n_in = 1, n_components = 2)
	allocate (prcdef_2_t :: test_def)
	select type (test_def)
	type is (prcdef_2_t); test_def%data = 31
	end select
	call entry%import_component (1, n_out = 3, &
	prt_in = new_prt_spec ([var_str ("a")]), &
	prt_out = new_prt_spec ([var_str ("b"), var_str ("c"), &
	var_str ("e")]), &
	method = var_str ("test"), &
	variant = test_def)
	allocate (prcdef_2_t :: test_def)
	select type (test_def)
	type is (prcdef_2_t); test_def%data = 42
	end select
	call entry%import_component (2, n_out = 2, &
	prt_in = new_prt_spec ([var_str ("a")]), &
	prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
	method = var_str ("test"), &
	variant = test_def)
	call entry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Compute MD5 sums"
	write (u, "(A)")

	call entry%compute_md5sum ()
	call entry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Recalculate MD5 sums (should be identical)"
	write (u, "(A)")

	call entry%compute_md5sum ()
	call entry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Modify a component and recalculate MD5 sums"
	write (u, "(A)")

	def => entry%get_core_def_ptr (2)
	select type (def)
	type is (prcdef_2_t)
	def%data = 54
	end select
	call entry%compute_md5sum ()
	call entry%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Modify the model and recalculate MD5 sums"
	write (u, "(A)")

	call entry%set_model_name (var_str ("foo"))
	call entry%compute_md5sum ()
	call entry%write (u)

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

	@ %def process_libraries_7
	@
	Here is the actual test:
	<<Process libraries: execute tests>>=
	call test (process_libraries_8, "process_libraries_8", &
	"library status checks", &
	u, results)
	<<Process libraries: test declarations>>=
	public :: process_libraries_8
	<<Process libraries: tests>>=
	subroutine process_libraries_8 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	type(process_def_entry_t), pointer :: entry
	class(prc_core_def_t), allocatable :: core_def
	type(os_data_t) :: os_data

	write (u, "(A)") "* Test output: process_libraries_8"
	write (u, "(A)") "* Purpose: build and load a process library"
	write (u, "(A)") "* with an external (pseudo) matrix element"
	write (u, "(A)") "* Check status updates"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with one entry"
	write (u, "(A)")
	call lib%init (var_str ("proclibs8"))
	call os_data%init ()

	allocate (prcdef_6_t :: core_def)
	select type (core_def)
	type is (prcdef_6_t)
	call core_def%init ()
	end select

	allocate (entry)
	call entry%init (var_str ("proclibs8_a"), &
	model_name = var_str ("Test_model"), &
	n_in = 1, n_components = 1)
	call entry%import_component (1, n_out = 2, &
	prt_in = new_prt_spec ([var_str ("a")]), &
	prt_out = new_prt_spec ([var_str ("b"), var_str ("c")]), &
	method = var_str ("test"), &
	variant = core_def)
	call lib%append (entry)

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

	call lib%configure (os_data)
	call lib%compute_md5sum ()

	call lib%test_transfer_md5sum (1, 1, 1)

	write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
	write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
	write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)

	write (u, "(A)")
	write (u, "(A)") "* Write makefile"
	write (u, "(A)")
	call lib%write_makefile (os_data, force = .true., verbose = .false.)

	write (u, "(A)") "* Update status"
	write (u, "(A)")

	call lib%update_status (os_data)
	write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
	write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
	write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)

	write (u, "(A)")
	write (u, "(A)") "* Write driver source code"
	write (u, "(A)")
	call lib%write_driver (force = .false.)

	write (u, "(A)") "* Write process source code"
	write (u, "(A)")
	call lib%make_source (os_data)

	write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
	write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
	write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)

	write (u, "(A)")
	write (u, "(A)") "* Compile and load"
	write (u, "(A)")

	call lib%load (os_data)
	write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
	write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
	write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)

	write (u, "(A)")
	write (u, "(A)") "* Append process and reconfigure"
	write (u, "(A)")

	allocate (prcdef_6_t :: core_def)
	select type (core_def)
	type is (prcdef_6_t)
	call core_def%init ()
	end select

	allocate (entry)
	call entry%init (var_str ("proclibs8_b"), &
	model_name = var_str ("Test_model"), &
	n_in = 1, n_components = 1)
	call entry%import_component (1, n_out = 2, &
	prt_in = new_prt_spec ([var_str ("a")]), &
	prt_out = new_prt_spec ([var_str ("b"), var_str ("d")]), &
	method = var_str ("test"), &
	variant = core_def)
	call lib%append (entry)

	call lib%configure (os_data)
	call lib%compute_md5sum ()
	call lib%test_transfer_md5sum (2, 2, 1)
	call lib%write_makefile (os_data, force = .false., verbose = .false.)
	call lib%write_driver (force = .false.)

	write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
	write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
	write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
	write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)

	write (u, "(A)")
	write (u, "(A)") "* Update status"
	write (u, "(A)")

	call lib%update_status (os_data)
	write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
	write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
	write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
	write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)

	write (u, "(A)")
	write (u, "(A)") "* Write source code"
	write (u, "(A)")

	call lib%make_source (os_data)
	write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
	write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
	write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
	write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)

	write (u, "(A)")
	write (u, "(A)") "* Reset status"
	write (u, "(A)")

	call lib%set_status (STAT_CONFIGURED, entries=.true.)
	write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
	write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
	write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
	write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)

	write (u, "(A)")
	write (u, "(A)") "* Update status"
	write (u, "(A)")

	call lib%update_status (os_data)
	write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
	write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
	write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
	write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)

	write (u, "(A)")
	write (u, "(A)") "* Partial cleanup"
	write (u, "(A)")

	call lib%clean (os_data, distclean = .false.)
	write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
	write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
	write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
	write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)


	write (u, "(A)")
	write (u, "(A)") "* Update status"
	write (u, "(A)")

	call lib%update_status (os_data)
	write (u, "(1x,A,L1)") "library loaded = ", lib%is_loaded ()
	write (u, "(1x,A,I0)") "lib status = ", lib%get_status ()
	write (u, "(1x,A,I0)") "proc1 status = ", lib%get_status (1)
	write (u, "(1x,A,I0)") "proc2 status = ", lib%get_status (2)

	write (u, "(A)")
	write (u, "(A)") "* Complete cleanup"

	call lib%clean (os_data, distclean = .true.)
	call lib%final ()

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

	@ %def process_libraries_8
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Process Library Stacks}

	For storing and handling multiple libraries, we define process library stacks.
	These are ordinary stacks where new entries are pushed onto the top.
	<<[[prclib_stacks.f90]]>>=
	<<File header>>

	module prclib_stacks

	<<Use strings>>
	use process_libraries

	<<Standard module head>>

	<<Prclib stacks: public>>

	<<Prclib stacks: types>>

	interface
	<<Prclib stacks: sub interfaces>>
	end interface

	end module prclib_stacks
	@ %def prclib_stacks
	@
	<<[[prclib_stacks_sub.f90]]>>=
	<<File header>>

	submodule (prclib_stacks) prclib_stacks_s

	use io_units
	use format_utils, only: write_separator

	implicit none

	contains

	<<Prclib stacks: procedures>>

	end submodule prclib_stacks_s

	@ %def prclib_stacks_s
	@
	\subsection{The stack entry type}
	A stack entry is a process library object, augmented by a pointer to the
	next entry. We do not need specific methods, all relevant methods are
	inherited.

	On higher level, process libraries should be prepared as process entry objects.
	<<Prclib stacks: public>>=
	public :: prclib_entry_t
	<<Prclib stacks: types>>=
	type, extends (process_library_t) :: prclib_entry_t
	type(prclib_entry_t), pointer :: next => null ()
	end type prclib_entry_t

	@ %def prclib_entry_t
	@
	\subsection{The prclib stack type}
	For easy conversion and lookup it is useful to store the filling
	number in the object. The content is stored as a linked list.
	<<Prclib stacks: public>>=
	public :: prclib_stack_t
	<<Prclib stacks: types>>=
	type :: prclib_stack_t
	integer :: n = 0
	type(prclib_entry_t), pointer :: first => null ()
	contains
	<<Prclib stacks: prclib stack: TBP>>
	end type prclib_stack_t

	@ %def prclib_stack_t
	@ Finalizer. Iteratively deallocate the stack entries. The resulting
	empty stack can be immediately recycled, if necessary.
	<<Prclib stacks: prclib stack: TBP>>=
	procedure :: final => prclib_stack_final
	<<Prclib stacks: sub interfaces>>=
	module subroutine prclib_stack_final (object)
	class(prclib_stack_t), intent(inout) :: object
	end subroutine prclib_stack_final
	<<Prclib stacks: procedures>>=
	module subroutine prclib_stack_final (object)
	class(prclib_stack_t), intent(inout) :: object
	type(prclib_entry_t), pointer :: lib
	do while (associated (object%first))
	lib => object%first
	object%first => lib%next
	call lib%final ()
	deallocate (lib)
	end do
	object%n = 0
	end subroutine prclib_stack_final

	@ %def prclib_stack_final
	@ Output. The entries on the stack will be ordered LIFO, i.e., backwards.
	<<Prclib stacks: prclib stack: TBP>>=
	procedure :: write => prclib_stack_write
	<<Prclib stacks: sub interfaces>>=
	module subroutine prclib_stack_write (object, unit, libpath)
	class(prclib_stack_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: libpath
	end subroutine prclib_stack_write
	<<Prclib stacks: procedures>>=
	module subroutine prclib_stack_write (object, unit, libpath)
	class(prclib_stack_t), intent(in) :: object
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: libpath
	type(prclib_entry_t), pointer :: lib
	integer :: u
	u = given_output_unit (unit)
	call write_separator (u, 2)
	select case (object%n)
	case (0)
	write (u, "(1x,A)") "Process library stack: [empty]"
	case default
	write (u, "(1x,A)") "Process library stack:"
	lib => object%first
	do while (associated (lib))
	call write_separator (u)
	call lib%write (u, libpath)
	lib => lib%next
	end do
	end select
	call write_separator (u, 2)
	end subroutine prclib_stack_write

	@ %def prclib_stack_write
	@
	\subsection{Operating on Stacks}
	We take a library entry pointer and push it onto the stack. The previous
	pointer is nullified. Subsequently, the library entry is `owned' by the
	stack and will be finalized when the stack is deleted.
	<<Prclib stacks: prclib stack: TBP>>=
	procedure :: push => prclib_stack_push
	<<Prclib stacks: sub interfaces>>=
	module subroutine prclib_stack_push (stack, lib)
	class(prclib_stack_t), intent(inout) :: stack
	type(prclib_entry_t), intent(inout), pointer :: lib
	end subroutine prclib_stack_push
	<<Prclib stacks: procedures>>=
	module subroutine prclib_stack_push (stack, lib)
	class(prclib_stack_t), intent(inout) :: stack
	type(prclib_entry_t), intent(inout), pointer :: lib
	lib%next => stack%first
	stack%first => lib
	lib => null ()
	stack%n = stack%n + 1
	end subroutine prclib_stack_push

	@ %def prclib_stack_push
	@
	\subsection{Accessing Contents}
	Return a pointer to the topmost stack element. The result type is
	just the bare [[process_library_t]]. There is no [[target]] attribute
	required since the stack elements are allocated via pointers.
	<<Prclib stacks: prclib stack: TBP>>=
	procedure :: get_first_ptr => prclib_stack_get_first_ptr
	<<Prclib stacks: sub interfaces>>=
	module function prclib_stack_get_first_ptr (stack) result (ptr)
	class(prclib_stack_t), intent(in) :: stack
	type(process_library_t), pointer :: ptr
	end function prclib_stack_get_first_ptr
	<<Prclib stacks: procedures>>=
	module function prclib_stack_get_first_ptr (stack) result (ptr)
	class(prclib_stack_t), intent(in) :: stack
	type(process_library_t), pointer :: ptr
	if (associated (stack%first)) then
	ptr => stack%first%process_library_t
	else
	ptr => null ()
	end if
	end function prclib_stack_get_first_ptr

	@ %def prclib_stack_get_first_ptr
	@ Return a complete list of the libraries (names) in the stack. The list is
	in the order in which the elements got pushed onto the stack, so the 'first'
	entry is listed last.
	<<Prclib stacks: prclib stack: TBP>>=
	procedure :: get_names => prclib_stack_get_names
	<<Prclib stacks: sub interfaces>>=
	module subroutine prclib_stack_get_names (stack, libname)
	class(prclib_stack_t), intent(in) :: stack
	type(string_t), dimension(:), allocatable, intent(out) :: libname
	end subroutine prclib_stack_get_names
	<<Prclib stacks: procedures>>=
	module subroutine prclib_stack_get_names (stack, libname)
	class(prclib_stack_t), intent(in) :: stack
	type(string_t), dimension(:), allocatable, intent(out) :: libname
	type(prclib_entry_t), pointer :: lib
	integer :: i
	allocate (libname (stack%n))
	i = stack%n
	lib => stack%first
	do while (associated (lib))
	libname(i) = lib%get_name ()
	i = i - 1
	lib => lib%next
	end do
	end subroutine prclib_stack_get_names

	@ %def prclib_stack_get_names
	@ Return a pointer to the library with given name.
	<<Prclib stacks: prclib stack: TBP>>=
	procedure :: get_library_ptr => prclib_stack_get_library_ptr
	<<Prclib stacks: sub interfaces>>=
	module function prclib_stack_get_library_ptr (stack, libname) result (ptr)
	class(prclib_stack_t), intent(in) :: stack
	type(string_t), intent(in) :: libname
	type(process_library_t), pointer :: ptr
	end function prclib_stack_get_library_ptr
	<<Prclib stacks: procedures>>=
	module function prclib_stack_get_library_ptr (stack, libname) result (ptr)
	class(prclib_stack_t), intent(in) :: stack
	type(string_t), intent(in) :: libname
	type(process_library_t), pointer :: ptr
	type(prclib_entry_t), pointer :: current
	current => stack%first
	do while (associated (current))
	if (current%get_name () == libname) then
	ptr => current%process_library_t
	return
	end if
	current => current%next
	end do
	ptr => null ()
	end function prclib_stack_get_library_ptr

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

	module prclib_stacks_ut
	use unit_tests
	use prclib_stacks_uti

	<<Standard module head>>

	<<Prclib stacks: public test>>

	contains

	<<Prclib stacks: test driver>>

	end module prclib_stacks_ut
	@ %def prclib_stacks_ut
	@
	<<[[prclib_stacks_uti.f90]]>>=
	<<File header>>

	module prclib_stacks_uti

	<<Use strings>>

	use prclib_stacks

	<<Standard module head>>

	<<Prclib stacks: test declarations>>

	contains

	<<Prclib stacks: tests>>

	end module prclib_stacks_uti
	@ %def prclib_stacks_ut
	@ API: driver for the unit tests below.
	<<Prclib stacks: public test>>=
	public :: prclib_stacks_test
	<<Prclib stacks: test driver>>=
	subroutine prclib_stacks_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Prclib stacks: execute tests>>
	end subroutine prclib_stacks_test

	@ %def prclib_stacks_test
	@
	\subsubsection{Write an empty process library stack}
	The most trivial test is to write an uninitialized process library stack.
	<<Prclib stacks: execute tests>>=
	call test (prclib_stacks_1, "prclib_stacks_1", &
	"write an empty process library stack", &
	u, results)
	<<Prclib stacks: test declarations>>=
	public :: prclib_stacks_1
	<<Prclib stacks: tests>>=
	subroutine prclib_stacks_1 (u)
	integer, intent(in) :: u
	type(prclib_stack_t) :: stack

	write (u, "(A)") "* Test output: prclib_stacks_1"
	write (u, "(A)") "* Purpose: display an empty process library stack"
	write (u, "(A)")

	call stack%write (u)

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

	end subroutine prclib_stacks_1

	@ %def prclib_stacks_1
	@
	\subsubsection{Fill a process library stack}
	Fill a process library stack with two (identical) processes.
	<<Prclib stacks: execute tests>>=
	call test (prclib_stacks_2, "prclib_stacks_2", &
	"fill a process library stack", &
	u, results)
	<<Prclib stacks: test declarations>>=
	public :: prclib_stacks_2
	<<Prclib stacks: tests>>=
	subroutine prclib_stacks_2 (u)
	integer, intent(in) :: u
	type(prclib_stack_t) :: stack
	type(prclib_entry_t), pointer :: lib

	write (u, "(A)") "* Test output: prclib_stacks_2"
	write (u, "(A)") "* Purpose: fill a process library stack"
	write (u, "(A)")

	write (u, "(A)") "* Initialize two (empty) libraries &
	&and push them on the stack"
	write (u, "(A)")

	allocate (lib)
	call lib%init (var_str ("lib1"))
	call stack%push (lib)

	allocate (lib)
	call lib%init (var_str ("lib2"))
	call stack%push (lib)

	call stack%write (u)

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

	call stack%final ()

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

	end subroutine prclib_stacks_2

	@ %def prclib_stacks_2
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Trivial matrix element for tests}

	For the purpose of testing the workflow, we implement here two matrix
	elements with the simplest possible structure.

	This matrix element generator can only generate a single scattering
	process and a single decay process. The scattering process is a
	quartic interaction of a massless, neutral and colorless scalar [[s]]
	with unit coupling results in a trivial $2\to 2$ scattering process.
	The matrix element is implemented internally, so we do not need the
	machinery of external process libraries. The decay process is a decay
	of [[s]] into a pair of colored fermions [[f]].

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

	module prc_test

	use, intrinsic :: iso_c_binding !NODEP!

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use particle_specifiers, only: new_prt_spec
	use process_constants
	use prclib_interfaces
	use prc_core_def
	use process_libraries

	<<Standard module head>>

	<<Test ME: public>>

	<<Test ME: types>>

	interface
	<<Test ME: sub interfaces>>
	end interface

	contains

	<<Test ME: main procedures>>

	end module prc_test
	@ %def prc_test
	@
	<<[[prc_test_sub.f90]]>>=
	<<File header>>

	submodule (prc_test) prc_test_s

	implicit none

	contains

	<<Test ME: procedures>>

	end submodule prc_test_s

	@ %def prc_test_s
	@
	\subsection{Process definition}
	For the process definition we implement an extension of the
	[[prc_core_def_t]] abstract type.
	<<Test ME: public>>=
	public :: prc_test_def_t
	<<Test ME: types>>=
	type, extends (prc_core_def_t) :: prc_test_def_t
	type(string_t) :: model_name
	type(string_t), dimension(:), allocatable :: prt_in
	type(string_t), dimension(:), allocatable :: prt_out
	contains
	<<Test ME: test me def: TBP>>
	end type prc_test_def_t

	@ %def prc_test_def_t
	<<Test ME: test me def: TBP>>=
	procedure, nopass :: type_string => prc_test_def_type_string
	<<Test ME: sub interfaces>>=
	module function prc_test_def_type_string () result (string)
	type(string_t) :: string
	end function prc_test_def_type_string
	<<Test ME: procedures>>=
	module function prc_test_def_type_string () result (string)
	type(string_t) :: string
	string = "test_me"
	end function prc_test_def_type_string

	@ %def prc_test_def_type_string
	@ There is no 'feature' here since there is no external code.
	<<Test ME: test me def: TBP>>=
	procedure, nopass :: get_features => prc_test_def_get_features
	<<Test ME: sub interfaces>>=
	module subroutine prc_test_def_get_features (features)
	type(string_t), dimension(:), allocatable, intent(out) :: features
	end subroutine prc_test_def_get_features
	<<Test ME: procedures>>=
	module subroutine prc_test_def_get_features (features)
	type(string_t), dimension(:), allocatable, intent(out) :: features
	allocate (features (0))
	end subroutine prc_test_def_get_features

	@ %def prc_test_def_get_features
	@ Initialization: set some data (not really useful).
	<<Test ME: test me def: TBP>>=
	procedure :: init => prc_test_def_init
	<<Test ME: sub interfaces>>=
	module subroutine prc_test_def_init (object, model_name, prt_in, prt_out)
	class(prc_test_def_t), intent(out) :: object
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	end subroutine prc_test_def_init
	<<Test ME: procedures>>=
	module subroutine prc_test_def_init (object, model_name, prt_in, prt_out)
	class(prc_test_def_t), intent(out) :: object
	type(string_t), intent(in) :: model_name
	type(string_t), dimension(:), intent(in) :: prt_in
	type(string_t), dimension(:), intent(in) :: prt_out
	object%model_name = model_name
	allocate (object%prt_in (size (prt_in)))
	object%prt_in = prt_in
	allocate (object%prt_out (size (prt_out)))
	object%prt_out = prt_out
	end subroutine prc_test_def_init

	@ %def prc_test_def_init
	@ Write/read process- and method-specific data. (No-op)
	<<Test ME: test me def: TBP>>=
	procedure :: write => prc_test_def_write
	<<Test ME: sub interfaces>>=
	module subroutine prc_test_def_write (object, unit)
	class(prc_test_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine prc_test_def_write
	<<Test ME: procedures>>=
	module subroutine prc_test_def_write (object, unit)
	class(prc_test_def_t), intent(in) :: object
	integer, intent(in) :: unit
	end subroutine prc_test_def_write

	@ %def prc_test_def_write
	@
	<<Test ME: test me def: TBP>>=
	procedure :: read => prc_test_def_read
	<<Test ME: sub interfaces>>=
	module subroutine prc_test_def_read (object, unit)
	class(prc_test_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine prc_test_def_read
	<<Test ME: procedures>>=
	module subroutine prc_test_def_read (object, unit)
	class(prc_test_def_t), intent(out) :: object
	integer, intent(in) :: unit
	end subroutine prc_test_def_read

	@ %def prc_test_def_read
	@ Allocate the driver for test ME matrix elements. We get the
	actual component ID (basename), and we can transfer all
	process-specific data from the process definition.Due to a bug of
	bind(C) features with submodules in gfortran 7/8/9 (and maybe together
	with MPI) this needs to be in the module, not the submodule.
	<<Test ME: test me def: TBP>>=
	procedure :: allocate_driver => prc_test_def_allocate_driver
	<<Test ME: main procedures>>=
	subroutine prc_test_def_allocate_driver (object, driver, basename)
	class(prc_test_def_t), intent(in) :: object
	class(prc_core_driver_t), intent(out), allocatable :: driver
	type(string_t), intent(in) :: basename
	allocate (prc_test_t :: driver)
	select type (driver)
	type is (prc_test_t)
	driver%id = basename
	driver%model_name = object%model_name
	select case (size (object%prt_in))
	case (1); driver%scattering = .false.
	case (2); driver%scattering = .true.
	end select
	end select
	end subroutine prc_test_def_allocate_driver

	@ %def prc_test_def_allocate_driver
	@ Nothing to connect. This subroutine will not be called.
	<<Test ME: test me def: TBP>>=
	procedure :: connect => prc_test_def_connect
	<<Test ME: sub interfaces>>=
	module subroutine prc_test_def_connect (def, lib_driver, i, proc_driver)
	class(prc_test_def_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	end subroutine prc_test_def_connect
	<<Test ME: procedures>>=
	module subroutine prc_test_def_connect (def, lib_driver, i, proc_driver)
	class(prc_test_def_t), intent(in) :: def
	class(prclib_driver_t), intent(in) :: lib_driver
	integer, intent(in) :: i
	class(prc_core_driver_t), intent(inout) :: proc_driver
	end subroutine prc_test_def_connect

	@ %def prc_test_def_connect
	@
	\subsection{Driver}
	<<Test ME: public>>=
	public :: prc_test_t
	<<Test ME: types>>=
	type, extends (process_driver_internal_t) :: prc_test_t
	type(string_t) :: id
	type(string_t) :: model_name
	logical :: scattering = .true.
	contains
	<<Test ME: test me driver: TBP>>
	end type prc_test_t

	@ %def prc_test_t
	@ In contrast to generic matrix-element implementations, we can
	hard-wire the amplitude method as a type-bound procedure.
	<<Test ME: test me driver: TBP>>=
	procedure, nopass :: get_amplitude => prc_test_get_amplitude
	<<Test ME: sub interfaces>>=
	module function prc_test_get_amplitude (p) result (amp)
	complex(default) :: amp
	real(default), dimension(:,:), intent(in) :: p
	end function prc_test_get_amplitude
	<<Test ME: procedures>>=
	module function prc_test_get_amplitude (p) result (amp)
	complex(default) :: amp
	real(default), dimension(:,:), intent(in) :: p
	amp = 1
	end function prc_test_get_amplitude

	@ %def prc_test_get_amplitude
	@ The reported type is the same as for the [[prc_test_def_t]] type.
	<<Test ME: test me driver: TBP>>=
	procedure, nopass :: type_name => prc_test_type_name
	<<Test ME: sub interfaces>>=
	module function prc_test_type_name () result (string)
	type(string_t) :: string
	end function prc_test_type_name
	<<Test ME: procedures>>=
	module function prc_test_type_name () result (string)
	type(string_t) :: string
	string = "test_me"
	end function prc_test_type_name

	@ %def prc_test_type_name
	@ Fill process constants.
	<<Test ME: test me driver: TBP>>=
	procedure :: fill_constants => prc_test_fill_constants
	<<Test ME: sub interfaces>>=
	module subroutine prc_test_fill_constants (driver, data)
	class(prc_test_t), intent(in) :: driver
	type(process_constants_t), intent(out) :: data
	end subroutine prc_test_fill_constants
	<<Test ME: procedures>>=
	module subroutine prc_test_fill_constants (driver, data)
	class(prc_test_t), intent(in) :: driver
	type(process_constants_t), intent(out) :: data
	data%id = driver%id
	data%model_name = driver%model_name
	if (driver%scattering) then
	data%n_in = 2
	data%n_out = 2
	data%n_flv = 1
	data%n_hel = 1
	data%n_col = 1
	data%n_cin = 2
	data%n_cf = 1
	allocate (data%flv_state (4, 1))
	data%flv_state = 25
	allocate (data%hel_state (4, 1))
	data%hel_state = 0
	allocate (data%col_state (2, 4, 1))
	data%col_state = 0
	allocate (data%ghost_flag (4, 1))
	data%ghost_flag = .false.
	allocate (data%color_factors (1))
	data%color_factors = 1
	allocate (data%cf_index (2, 1))
	data%cf_index = 1
	else
	data%n_in = 1
	data%n_out = 2
	data%n_flv = 1
	data%n_hel = 2
	data%n_col = 1
	data%n_cin = 2
	data%n_cf = 1
	allocate (data%flv_state (3, 1))
	data%flv_state(:,1) = [25, 6, -6]
	allocate (data%hel_state (3, 2))
	data%hel_state(:,1) = [0, 1,-1]
	data%hel_state(:,2) = [0,-1, 1]
	allocate (data%col_state (2, 3, 1))
	data%col_state = reshape ([0,0, 1,0, 0,-1], [2,3,1])
	allocate (data%ghost_flag (3, 1))
	data%ghost_flag = .false.
	allocate (data%color_factors (1))
	data%color_factors = 3
	allocate (data%cf_index (2, 1))
	data%cf_index = 1
	end if
	end subroutine prc_test_fill_constants

	@ %def prc_test_fill_constants
	@
	\subsection{Shortcut}
	Since this module is there for testing purposes, we set up a
	subroutine that does all the work at once: create a library with the
	two processes (scattering and decay), configure and load, and set up
	the driver. Due to a bug of bind(C) features with submodules in
	gfortran 7/8/9 (and maybe together with MPI) this needs to be in the
	module, not the submodule.
	<<Test ME: public>>=
	public :: prc_test_create_library
	<<Test ME: main procedures>>=
	subroutine prc_test_create_library &
	(libname, lib, scattering, decay, procname1, procname2)
	type(string_t), intent(in) :: libname
	type(process_library_t), intent(out) :: lib
	logical, intent(in), optional :: scattering, decay
	type(string_t), intent(in), optional :: procname1, procname2
	type(string_t) :: model_name, procname
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry
	type(os_data_t) :: os_data
	logical :: sca, dec
	sca = .true.; if (present (scattering)) sca = scattering
	dec = .false.; if (present (decay)) dec = decay

	call os_data%init ()
	call lib%init (libname)
	model_name = "Test"

	if (sca) then
	if (present (procname1)) then
	procname = procname1
	else
	procname = libname
	end if
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("s"), var_str ("s")]
	prt_out = [var_str ("s"), var_str ("s")]
	allocate (prc_test_def_t :: def)
	select type (def)
	type is (prc_test_def_t)
	call def%init (model_name, prt_in, prt_out)
	end select
	allocate (entry)
	call entry%init (procname, model_name = model_name, &
	n_in = 2, n_components = 1)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("test_me"), &
	variant = def)
	call lib%append (entry)
	end if

	if (dec) then
	if (present (procname2)) then
	procname = procname2
	else
	procname = libname
	end if
	if (allocated (prt_in)) deallocate (prt_in, prt_out)
	allocate (prt_in (1), prt_out (2))
	prt_in = [var_str ("s")]
	prt_out = [var_str ("f"), var_str ("fbar")]
	allocate (prc_test_def_t :: def)
	select type (def)
	type is (prc_test_def_t)
	call def%init (model_name, prt_in, prt_out)
	end select
	allocate (entry)
	call entry%init (procname, model_name = model_name, &
	n_in = 1, n_components = 1)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("test_decay"), &
	variant = def)
	call lib%append (entry)
	end if

	call lib%configure (os_data)
	call lib%load (os_data)
	end subroutine prc_test_create_library

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

	module prc_test_ut
	use unit_tests
	use prc_test_uti

	<<Standard module head>>

	<<Test ME: public test>>

	contains

	<<Test ME: test driver>>

	end module prc_test_ut
	@ %def prc_test_ut
	@
	<<[[prc_test_uti.f90]]>>=
	<<File header>>

	module prc_test_uti

	<<Use kinds>>
	<<Use strings>>
	use os_interface
	use particle_specifiers, only: new_prt_spec
	use process_constants
	use prc_core_def
	use process_libraries

	use prc_test

	<<Standard module head>>

	<<Test ME: test declarations>>

	contains

	<<Test ME: tests>>

	end module prc_test_uti
	@ %def prc_test_ut
	@ API: driver for the unit tests below.
	<<Test ME: public test>>=
	public :: prc_test_test
	<<Test ME: test driver>>=
	subroutine prc_test_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Test ME: execute tests>>
	end subroutine prc_test_test

	@ %def prc_test_test
	@
	\subsubsection{Generate and load the scattering process}
	The process is $s s \to s s$, where $s$ is a trivial scalar particle,
	for vanishing mass and unit coupling. We initialize the process,
	build the library, and compute the particular matrix element for
	momenta of unit energy and right-angle scattering. (The scattering is
	independent of angle.) The matrix element is equal to unity.
	<<Test ME: execute tests>>=
	call test (prc_test_1, "prc_test_1", &
	"build and load trivial process", &
	u, results)
	<<Test ME: test declarations>>=
	public :: prc_test_1
	<<Test ME: tests>>=
	subroutine prc_test_1 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(process_library_t) :: lib
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry
	type(string_t) :: model_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(process_constants_t) :: data
	class(prc_core_driver_t), allocatable :: driver
	real(default), dimension(0:3,4) :: p
	integer :: i

	write (u, "(A)") "* Test output: prc_test_1"
	write (u, "(A)") "* Purpose: create a trivial process"
	write (u, "(A)") "* build a library and &
	&access the matrix element"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with one entry"
	write (u, "(A)")
	call os_data%init ()
	call lib%init (var_str ("prc_test1"))

	model_name = "Test"
	allocate (prt_in (2), prt_out (2))
	prt_in = [var_str ("s"), var_str ("s")]
	prt_out = [var_str ("s"), var_str ("s")]

	allocate (prc_test_def_t :: def)
	select type (def)
	type is (prc_test_def_t)
	call def%init (model_name, prt_in, prt_out)
	end select
	allocate (entry)
	call entry%init (var_str ("prc_test1_a"), model_name = model_name, &
	n_in = 2, n_components = 1)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("test_me"), &
	variant = def)
	call lib%append (entry)

	write (u, "(A)") "* Configure library"
	write (u, "(A)")
	call lib%configure (os_data)

	write (u, "(A)") "* Load library"
	write (u, "(A)")
	call lib%load (os_data)

	call lib%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Probe library API:"
	write (u, "(A)")

	write (u, "(1x,A,L1)") "is active = ", &
	lib%is_active ()
	write (u, "(1x,A,I0)") "n_processes = ", &
	lib%get_n_processes ()

	write (u, "(A)")
	write (u, "(A)") "* Constants of prc_test1_a_i1:"
	write (u, "(A)")

	call lib%connect_process (var_str ("prc_test1_a"), 1, data, driver)

	write (u, "(1x,A,A)") "component ID = ", char (data%id)
	write (u, "(1x,A,A)") "model name = ", char (data%model_name)
	write (u, "(1x,A,A,A)") "md5sum = '", data%md5sum, "'"
	write (u, "(1x,A,L1)") "openmp supported = ", data%openmp_supported
	write (u, "(1x,A,I0)") "n_in = ", data%n_in
	write (u, "(1x,A,I0)") "n_out = ", data%n_out
	write (u, "(1x,A,I0)") "n_flv = ", data%n_flv
	write (u, "(1x,A,I0)") "n_hel = ", data%n_hel
	write (u, "(1x,A,I0)") "n_col = ", data%n_col
	write (u, "(1x,A,I0)") "n_cin = ", data%n_cin
	write (u, "(1x,A,I0)") "n_cf = ", data%n_cf
	write (u, "(1x,A,10(1x,I0))") "flv state =", data%flv_state
	write (u, "(1x,A,10(1x,I2))") "hel state =", data%hel_state(:,1)
	write (u, "(1x,A,10(1x,I0))") "col state =", data%col_state
	write (u, "(1x,A,10(1x,L1))") "ghost flag =", data%ghost_flag
	write (u, "(1x,A,10(1x,F5.3))") "color factors =", data%color_factors
	write (u, "(1x,A,10(1x,I0))") "cf index =", data%cf_index

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics:"
	write (u, "(A)")

	p = reshape ([ &
	1.0_default, 0.0_default, 0.0_default, 1.0_default, &
	1.0_default, 0.0_default, 0.0_default,-1.0_default, &
	1.0_default, 1.0_default, 0.0_default, 0.0_default, &
	1.0_default,-1.0_default, 0.0_default, 0.0_default &
	], [4,4])
	do i = 1, 4
	write (u, "(2x,A,I0,A,4(1x,F7.4))") "p", i, " =", p(:,i)
	end do

	write (u, "(A)")
	write (u, "(A)") "* Compute matrix element:"
	write (u, "(A)")

	select type (driver)
	type is (prc_test_t)
	write (u, "(1x,A,1x,E11.4)") "\|amp\| =", abs (driver%get_amplitude (p))
	end select

	call lib%final ()

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

	end subroutine prc_test_1

	@ %def prc_test_1
	@
	\subsubsection{Shortcut}
	This is identical to the previous test, but we create the library be a single
	command. This is handy for other modules which use the test process.
	<<Test ME: execute tests>>=
	call test (prc_test_2, "prc_test_2", &
	"build and load trivial process using shortcut", &
	u, results)
	<<Test ME: test declarations>>=
	public :: prc_test_2
	<<Test ME: tests>>=
	subroutine prc_test_2 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	class(prc_core_driver_t), allocatable :: driver
	type(process_constants_t) :: data
	real(default), dimension(0:3,4) :: p

	write (u, "(A)") "* Test output: prc_test_2"
	write (u, "(A)") "* Purpose: create a trivial process"
	write (u, "(A)") "* build a library and &
	&access the matrix element"
	write (u, "(A)")

	write (u, "(A)") "* Build and load a process library with one entry"

	call prc_test_create_library (var_str ("prc_test2"), lib)
	call lib%connect_process (var_str ("prc_test2"), 1, data, driver)

	p = reshape ([ &
	1.0_default, 0.0_default, 0.0_default, 1.0_default, &
	1.0_default, 0.0_default, 0.0_default,-1.0_default, &
	1.0_default, 1.0_default, 0.0_default, 0.0_default, &
	1.0_default,-1.0_default, 0.0_default, 0.0_default &
	], [4,4])

	write (u, "(A)")
	write (u, "(A)") "* Compute matrix element:"
	write (u, "(A)")

	select type (driver)
	type is (prc_test_t)
	write (u, "(1x,A,1x,E11.4)") "\|amp\| =", abs (driver%get_amplitude (p))
	end select

	call lib%final ()

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

	end subroutine prc_test_2

	@ %def prc_test_2
	@
	\subsubsection{Generate and load the decay process}
	The process is $s \to f\bar f$, where $s$ is a trivial scalar particle
	and $f$ is a colored fermion. We initialize the process,
	build the library, and compute the particular matrix element for a
	fixed momentum configuration. (The decay is
	independent of angle.) The matrix element is equal to unity.
	<<Test ME: execute tests>>=
	call test (prc_test_3, "prc_test_3", &
	"build and load trivial decay", &
	u, results)
	<<Test ME: test declarations>>=
	public :: prc_test_3
	<<Test ME: tests>>=
	subroutine prc_test_3 (u)
	integer, intent(in) :: u
	type(os_data_t) :: os_data
	type(process_library_t) :: lib
	class(prc_core_def_t), allocatable :: def
	type(process_def_entry_t), pointer :: entry
	type(string_t) :: model_name
	type(string_t), dimension(:), allocatable :: prt_in, prt_out
	type(process_constants_t) :: data
	class(prc_core_driver_t), allocatable :: driver
	real(default), dimension(0:3,3) :: p
	integer :: i

	write (u, "(A)") "* Test output: prc_test_3"
	write (u, "(A)") "* Purpose: create a trivial decay process"
	write (u, "(A)") "* build a library and &
	&access the matrix element"
	write (u, "(A)")

	write (u, "(A)") "* Initialize a process library with one entry"
	write (u, "(A)")
	call os_data%init ()
	call lib%init (var_str ("prc_test3"))

	model_name = "Test"
	allocate (prt_in (1), prt_out (2))
	prt_in = [var_str ("s")]
	prt_out = [var_str ("f"), var_str ("F")]

	allocate (prc_test_def_t :: def)
	select type (def)
	type is (prc_test_def_t)
	call def%init (model_name, prt_in, prt_out)
	end select
	allocate (entry)
	call entry%init (var_str ("prc_test3_a"), model_name = model_name, &
	n_in = 1, n_components = 1)
	call entry%import_component (1, n_out = size (prt_out), &
	prt_in = new_prt_spec (prt_in), &
	prt_out = new_prt_spec (prt_out), &
	method = var_str ("test_me"), &
	variant = def)
	call lib%append (entry)

	write (u, "(A)") "* Configure library"
	write (u, "(A)")
	call lib%configure (os_data)

	write (u, "(A)") "* Load library"
	write (u, "(A)")
	call lib%load (os_data)

	call lib%write (u)

	write (u, "(A)")
	write (u, "(A)") "* Probe library API:"
	write (u, "(A)")

	write (u, "(1x,A,L1)") "is active = ", &
	lib%is_active ()
	write (u, "(1x,A,I0)") "n_processes = ", &
	lib%get_n_processes ()

	write (u, "(A)")
	write (u, "(A)") "* Constants of prc_test3_a_i1:"
	write (u, "(A)")

	call lib%connect_process (var_str ("prc_test3_a"), 1, data, driver)

	write (u, "(1x,A,A)") "component ID = ", char (data%id)
	write (u, "(1x,A,A)") "model name = ", char (data%model_name)
	write (u, "(1x,A,A,A)") "md5sum = '", data%md5sum, "'"
	write (u, "(1x,A,L1)") "openmp supported = ", data%openmp_supported
	write (u, "(1x,A,I0)") "n_in = ", data%n_in
	write (u, "(1x,A,I0)") "n_out = ", data%n_out
	write (u, "(1x,A,I0)") "n_flv = ", data%n_flv
	write (u, "(1x,A,I0)") "n_hel = ", data%n_hel
	write (u, "(1x,A,I0)") "n_col = ", data%n_col
	write (u, "(1x,A,I0)") "n_cin = ", data%n_cin
	write (u, "(1x,A,I0)") "n_cf = ", data%n_cf
	write (u, "(1x,A,10(1x,I0))") "flv state =", data%flv_state
	write (u, "(1x,A,10(1x,I2))") "hel state =", data%hel_state(:,1)
	write (u, "(1x,A,10(1x,I2))") "hel state =", data%hel_state(:,2)
	write (u, "(1x,A,10(1x,I0))") "col state =", data%col_state
	write (u, "(1x,A,10(1x,L1))") "ghost flag =", data%ghost_flag
	write (u, "(1x,A,10(1x,F5.3))") "color factors =", data%color_factors
	write (u, "(1x,A,10(1x,I0))") "cf index =", data%cf_index

	write (u, "(A)")
	write (u, "(A)") "* Set kinematics:"
	write (u, "(A)")

	p = reshape ([ &
	125._default, 0.0_default, 0.0_default, 0.0_default, &
	62.5_default, 0.0_default, 0.0_default, 62.5_default, &
	62.5_default, 0.0_default, 0.0_default,-62.5_default &
	], [4,3])
	do i = 1, 3
	write (u, "(2x,A,I0,A,4(1x,F8.4))") "p", i, " =", p(:,i)
	end do

	write (u, "(A)")
	write (u, "(A)") "* Compute matrix element:"
	write (u, "(A)")

	select type (driver)
	type is (prc_test_t)
	write (u, "(1x,A,1x,E11.4)") "\|amp\| =", abs (driver%get_amplitude (p))
	end select

	call lib%final ()

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

	end subroutine prc_test_3

	@ %def prc_test_3
	@
	\subsubsection{Shortcut}
	This is identical to the previous test, but we create the library be a single
	command. This is handy for other modules which use the test process.
	<<Test ME: execute tests>>=
	call test (prc_test_4, "prc_test_4", &
	"build and load trivial decay using shortcut", &
	u, results)
	<<Test ME: test declarations>>=
	public :: prc_test_4
	<<Test ME: tests>>=
	subroutine prc_test_4 (u)
	integer, intent(in) :: u
	type(process_library_t) :: lib
	class(prc_core_driver_t), allocatable :: driver
	type(process_constants_t) :: data
	real(default), dimension(0:3,3) :: p

	write (u, "(A)") "* Test output: prc_test_4"
	write (u, "(A)") "* Purpose: create a trivial decay process"
	write (u, "(A)") "* build a library and &
	&access the matrix element"
	write (u, "(A)")

	write (u, "(A)") "* Build and load a process library with one entry"

	call prc_test_create_library (var_str ("prc_test4"), lib, &
	scattering=.false., decay=.true.)
	call lib%connect_process (var_str ("prc_test4"), 1, data, driver)

	p = reshape ([ &
	125._default, 0.0_default, 0.0_default, 0.0_default, &
	62.5_default, 0.0_default, 0.0_default, 62.5_default, &
	62.5_default, 0.0_default, 0.0_default,-62.5_default &
	], [4,3])

	write (u, "(A)")
	write (u, "(A)") "* Compute matrix element:"
	write (u, "(A)")

	select type (driver)
	type is (prc_test_t)
	write (u, "(1x,A,1x,E11.4)") "\|amp\| =", abs (driver%get_amplitude (p))
	end select

	call lib%final ()

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

	end subroutine prc_test_4

	@ %def prc_test_4
	Index: trunk/src/types/types.nw
	===================================================================
	--- trunk/src/types/types.nw (revision 8883)
	+++ trunk/src/types/types.nw (revision 8884)
	@@ -1,9251 +1,9251 @@
	%% -- ess-noweb-default-code-mode: f90-mode; noweb-default-code-mode: f90-mode; --
	% WHIZARD code as NOWEB source: common types and objects
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\chapter{Sindarin Built-In Types}
	\includemodulegraph{types}

	Here, we define a couple of types and objects which are useful both
	internally for \whizard, and visible to the user, so they correspond
	to Sindarin types.
	\begin{description}
	\item[particle\_specifiers]
	Expressions for particles and particle alternatives, involving
	particle names.
	\item[pdg\_arrays]
	Integer (PDG) codes for particles. Useful for particle aliases
	(e.g., 'quark' for $u,d,s$ etc.).
	\item[jets]
	Define (pseudo)jets as objects. Functional only if the [[fastjet]] library
	is linked. (This may change in the future.)
	\item[subevents]
	Particle collections built from event records, for use in analysis and other
	Sindarin expressions
	\item[analysis]
	Observables, histograms, and plots.
	\end{description}

	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Particle Specifiers}
	In this module we introduce a type for specifying a particle or particle
	alternative. In addition to the particle specifiers (strings separated by
	colons), the type contains an optional flag [[polarized]] and a string
	[[decay]]. If the [[polarized]] flag is set, particle polarization
	information should be kept when generating events for this process. If the
	[[decay]] string is set, it is the ID of a decay process which should be
	applied to this particle when generating events.

	In input/output form, the [[polarized]] flag is indicated by an asterisk
	[[(*)]] in brackets, and the [[decay]] is indicated by its ID in brackets.

	The [[read]] and [[write]] procedures in this module are not type-bound but
	generic procedures which handle scalar and array arguments.
	<<[[particle_specifiers.f90]]>>=
	<<File header>>

	module particle_specifiers

	<<Use strings>>

	<<Standard module head>>

	<<Particle specifiers: public>>

	<<Particle specifiers: types>>

	<<Particle specifiers: interfaces>>

	interface
	<<Particle specifiers: sub interfaces>>
	end interface

	contains

	<<Particle specifiers: main procedures>>

	end module particle_specifiers
	@ %def particle_specifiers
	@
	<<[[particle_specifiers_sub.f90]]>>=
	<<File header>>

	submodule (particle_specifiers) particle_specifiers_s

	use io_units
	use diagnostics

	implicit none

	contains

	<<Particle specifiers: procedures>>

	end submodule particle_specifiers_s

	@ %def particle_specifiers_s
	@
	\subsection{Base type}
	This is an abstract type which can hold a single particle or an expression.
	<<Particle specifiers: types>>=
	type, abstract :: prt_spec_expr_t
	contains
	<<Particle specifiers: prt spec expr: TBP>>
	end type prt_spec_expr_t

	@ %def prt_expr_t
	@ Output, as a string.
	<<Particle specifiers: prt spec expr: TBP>>=
	procedure (prt_spec_expr_to_string), deferred :: to_string
	<<Particle specifiers: interfaces>>=
	abstract interface
	function prt_spec_expr_to_string (object) result (string)
	import
	class(prt_spec_expr_t), intent(in) :: object
	type(string_t) :: string
	end function prt_spec_expr_to_string
	end interface

	@ %def prt_spec_expr_to_string
	@ Call an [[expand]] method for all enclosed subexpressions (before handling
	the current expression).
	<<Particle specifiers: prt spec expr: TBP>>=
	procedure (prt_spec_expr_expand_sub), deferred :: expand_sub
	<<Particle specifiers: interfaces>>=
	abstract interface
	subroutine prt_spec_expr_expand_sub (object)
	import
	class(prt_spec_expr_t), intent(inout) :: object
	end subroutine prt_spec_expr_expand_sub
	end interface

	@ %def prt_spec_expr_expand_sub
	@
	\subsection{Wrapper type}
	This wrapper can hold a particle expression of any kind. We need it so we can
	make variadic arrays.
	<<Particle specifiers: public>>=
	public :: prt_expr_t
	<<Particle specifiers: types>>=
	type :: prt_expr_t
	class(prt_spec_expr_t), allocatable :: x
	contains
	<<Particle specifiers: prt expr: TBP>>
	end type prt_expr_t

	@ %def prt_expr_t
	@ Output as a string: delegate.
	<<Particle specifiers: prt expr: TBP>>=
	procedure :: to_string => prt_expr_to_string
	<<Particle specifiers: sub interfaces>>=
	recursive module function prt_expr_to_string (object) result (string)
	class(prt_expr_t), intent(in) :: object
	type(string_t) :: string
	end function prt_expr_to_string
	<<Particle specifiers: procedures>>=
	recursive module function prt_expr_to_string (object) result (string)
	class(prt_expr_t), intent(in) :: object
	type(string_t) :: string
	if (allocated (object%x)) then
	string = object%x%to_string ()
	else
	string = ""
	end if
	end function prt_expr_to_string

	@ %def prt_expr_to_string
	@ Allocate the expression as a particle specifier and copy the value.
	Due to compiler bugs in gfortran 7-9 not in submodule.
	<<Particle specifiers: prt expr: TBP>>=
	procedure :: init_spec => prt_expr_init_spec
	<<Particle specifiers: main procedures>>=
	subroutine prt_expr_init_spec (object, spec)
	class(prt_expr_t), intent(out) :: object
	type(prt_spec_t), intent(in) :: spec
	allocate (prt_spec_t :: object%x)
	select type (x => object%x)
	type is (prt_spec_t)
	x = spec
	end select
	end subroutine prt_expr_init_spec

	@ %def prt_expr_init_spec
	@ Allocate as a list/sum and allocate for a given length
	Due to compiler bugs in gfortran 7-9 not in submodule.
	<<Particle specifiers: prt expr: TBP>>=
	procedure :: init_list => prt_expr_init_list
	procedure :: init_sum => prt_expr_init_sum
	<<Particle specifiers: main procedures>>=
	subroutine prt_expr_init_list (object, n)
	class(prt_expr_t), intent(out) :: object
	integer, intent(in) :: n
	allocate (prt_spec_list_t :: object%x)
	select type (x => object%x)
	type is (prt_spec_list_t)
	allocate (x%expr (n))
	end select
	end subroutine prt_expr_init_list

	subroutine prt_expr_init_sum (object, n)
	class(prt_expr_t), intent(out) :: object
	integer, intent(in) :: n
	allocate (prt_spec_sum_t :: object%x)
	select type (x => object%x)
	type is (prt_spec_sum_t)
	allocate (x%expr (n))
	end select
	end subroutine prt_expr_init_sum

	@ %def prt_expr_init_list
	@ %def prt_expr_init_sum
	@ Return the number of terms. This is unity, except if the expression is a
	sum.
	<<Particle specifiers: prt expr: TBP>>=
	procedure :: get_n_terms => prt_expr_get_n_terms
	<<Particle specifiers: sub interfaces>>=
	module function prt_expr_get_n_terms (object) result (n)
	class(prt_expr_t), intent(in) :: object
	integer :: n
	end function prt_expr_get_n_terms
	<<Particle specifiers: procedures>>=
	module function prt_expr_get_n_terms (object) result (n)
	class(prt_expr_t), intent(in) :: object
	integer :: n
	if (allocated (object%x)) then
	select type (x => object%x)
	type is (prt_spec_sum_t)
	n = size (x%expr)
	class default
	n = 1
	end select
	else
	n = 0
	end if
	end function prt_expr_get_n_terms

	@ %def prt_expr_get_n_terms
	@ Transform one of the terms, as returned by the previous method, to an array
	of particle specifiers. The array has more than one entry if the selected
	term is a list. This makes sense only if the expression has been completely
	expanded, so the list contains only atoms.
	<<Particle specifiers: prt expr: TBP>>=
	procedure :: term_to_array => prt_expr_term_to_array
	<<Particle specifiers: sub interfaces>>=
	recursive module subroutine prt_expr_term_to_array (object, array, i)
	class(prt_expr_t), intent(in) :: object
	type(prt_spec_t), dimension(:), intent(inout), allocatable :: array
	integer, intent(in) :: i
	end subroutine prt_expr_term_to_array
	<<Particle specifiers: procedures>>=
	recursive module subroutine prt_expr_term_to_array (object, array, i)
	class(prt_expr_t), intent(in) :: object
	type(prt_spec_t), dimension(:), intent(inout), allocatable :: array
	integer, intent(in) :: i
	integer :: j
	if (allocated (array)) deallocate (array)
	select type (x => object%x)
	type is (prt_spec_t)
	allocate (array (1))
	array(1) = x
	type is (prt_spec_list_t)
	allocate (array (size (x%expr)))
	do j = 1, size (array)
	select type (y => x%expr(j)%x)
	type is (prt_spec_t)
	array(j) = y
	end select
	end do
	type is (prt_spec_sum_t)
	call x%expr(i)%term_to_array (array, 1)
	end select
	end subroutine prt_expr_term_to_array

	@ %def prt_expr_term_to_array
	@
	\subsection{The atomic type}
	The trivial case is a single particle, including optional decay and
	polarization attributes.

	\subsubsection{Definition}
	The particle is unstable if the [[decay]] array is allocated. The
	[[polarized]] flag and decays may not be set simultaneously.
	<<Particle specifiers: public>>=
	public :: prt_spec_t
	<<Particle specifiers: types>>=
	type, extends (prt_spec_expr_t) :: prt_spec_t
	private
	type(string_t) :: name
	logical :: polarized = .false.
	type(string_t), dimension(:), allocatable :: decay
	contains
	<<Particle specifiers: prt spec: TBP>>
	end type prt_spec_t

	@ %def prt_spec_t
	@
	\subsubsection{I/O}
	Output. Old-style subroutines.
	<<Particle specifiers: public>>=
	public :: prt_spec_write
	<<Particle specifiers: interfaces>>=
	interface prt_spec_write
	module procedure prt_spec_write1
	module procedure prt_spec_write2
	end interface prt_spec_write
	<<Particle specifiers: sub interfaces>>=
	module subroutine prt_spec_write1 (object, unit, advance)
	type(prt_spec_t), intent(in) :: object
	integer, intent(in), optional :: unit
	character(len=*), intent(in), optional :: advance
	end subroutine prt_spec_write1
	<<Particle specifiers: procedures>>=
	module subroutine prt_spec_write1 (object, unit, advance)
	type(prt_spec_t), intent(in) :: object
	integer, intent(in), optional :: unit
	character(len=*), intent(in), optional :: advance
	character(3) :: adv
	integer :: u
	u = given_output_unit (unit)
	adv = "yes"; if (present (advance)) adv = advance
	write (u, "(A)", advance = adv) char (object%to_string ())
	end subroutine prt_spec_write1

	@ %def prt_spec_write1
	@ Write an array as a list of particle specifiers.
	<<Particle specifiers: sub interfaces>>=
	module subroutine prt_spec_write2 (prt_spec, unit, advance)
	type(prt_spec_t), dimension(:), intent(in) :: prt_spec
	integer, intent(in), optional :: unit
	character(len=*), intent(in), optional :: advance
	end subroutine prt_spec_write2
	<<Particle specifiers: procedures>>=
	module subroutine prt_spec_write2 (prt_spec, unit, advance)
	type(prt_spec_t), dimension(:), intent(in) :: prt_spec
	integer, intent(in), optional :: unit
	character(len=*), intent(in), optional :: advance
	character(3) :: adv
	integer :: u, i
	u = given_output_unit (unit)
	adv = "yes"; if (present (advance)) adv = advance
	do i = 1, size (prt_spec)
	if (i > 1) write (u, "(A)", advance="no") ", "
	call prt_spec_write (prt_spec(i), u, advance="no")
	end do
	write (u, "(A)", advance = adv)
	end subroutine prt_spec_write2

	@ %def prt_spec_write2
	@ Read. Input may be string or array of strings.
	<<Particle specifiers: public>>=
	public :: prt_spec_read
	<<Particle specifiers: interfaces>>=
	interface prt_spec_read
	module procedure prt_spec_read1
	module procedure prt_spec_read2
	end interface prt_spec_read
	@ Read a single particle specifier
	<<Particle specifiers: sub interfaces>>=
	pure module subroutine prt_spec_read1 (prt_spec, string)
	type(prt_spec_t), intent(out) :: prt_spec
	type(string_t), intent(in) :: string
	end subroutine prt_spec_read1
	<<Particle specifiers: procedures>>=
	pure module subroutine prt_spec_read1 (prt_spec, string)
	type(prt_spec_t), intent(out) :: prt_spec
	type(string_t), intent(in) :: string
	type(string_t) :: arg, buffer
	integer :: b1, b2, c, n, i
	b1 = scan (string, "(")
	b2 = scan (string, ")")
	if (b1 == 0) then
	prt_spec%name = trim (adjustl (string))
	else
	prt_spec%name = trim (adjustl (extract (string, 1, b1-1)))
	arg = trim (adjustl (extract (string, b1+1, b2-1)))
	if (arg == "*") then
	prt_spec%polarized = .true.
	else
	n = 0
	buffer = arg
	do
	if (verify (buffer, " ") == 0) exit
	n = n + 1
	c = scan (buffer, "+")
	if (c == 0) exit
	buffer = extract (buffer, c+1)
	end do
	allocate (prt_spec%decay (n))
	buffer = arg
	do i = 1, n
	c = scan (buffer, "+")
	if (c == 0) c = len (buffer) + 1
	prt_spec%decay(i) = trim (adjustl (extract (buffer, 1, c-1)))
	buffer = extract (buffer, c+1)
	end do
	end if
	end if
	end subroutine prt_spec_read1

	@ %def prt_spec_read1
	@ Read a particle specifier array, given as a single string. The
	array is allocated to the correct size.
	<<Particle specifiers: sub interfaces>>=
	pure module subroutine prt_spec_read2 (prt_spec, string)
	type(prt_spec_t), dimension(:), intent(out), allocatable :: prt_spec
	type(string_t), intent(in) :: string
	end subroutine prt_spec_read2
	<<Particle specifiers: procedures>>=
	pure module subroutine prt_spec_read2 (prt_spec, string)
	type(prt_spec_t), dimension(:), intent(out), allocatable :: prt_spec
	type(string_t), intent(in) :: string
	type(string_t) :: buffer
	integer :: c, i, n
	n = 0
	buffer = string
	do
	n = n + 1
	c = scan (buffer, ",")
	if (c == 0) exit
	buffer = extract (buffer, c+1)
	end do
	allocate (prt_spec (n))
	buffer = string
	do i = 1, size (prt_spec)
	c = scan (buffer, ",")
	if (c == 0) c = len (buffer) + 1
	call prt_spec_read (prt_spec(i), &
	trim (adjustl (extract (buffer, 1, c-1))))
	buffer = extract (buffer, c+1)
	end do
	end subroutine prt_spec_read2

	@ %def prt_spec_read2
	@
	\subsubsection{Constructor}
	Initialize a particle specifier.
	<<Particle specifiers: public>>=
	public :: new_prt_spec
	<<Particle specifiers: interfaces>>=
	interface new_prt_spec
	module procedure new_prt_spec_
	module procedure new_prt_spec_polarized
	module procedure new_prt_spec_unstable
	end interface new_prt_spec
	<<Particle specifiers: sub interfaces>>=
	elemental module function new_prt_spec_ (name) result (prt_spec)
	type(string_t), intent(in) :: name
	type(prt_spec_t) :: prt_spec
	end function new_prt_spec_
	elemental module function new_prt_spec_polarized (name, polarized) result (prt_spec)
	type(string_t), intent(in) :: name
	logical, intent(in) :: polarized
	type(prt_spec_t) :: prt_spec
	end function new_prt_spec_polarized
	pure module function new_prt_spec_unstable (name, decay) result (prt_spec)
	type(string_t), intent(in) :: name
	type(string_t), dimension(:), intent(in) :: decay
	type(prt_spec_t) :: prt_spec
	end function new_prt_spec_unstable
	<<Particle specifiers: procedures>>=
	elemental module function new_prt_spec_ (name) result (prt_spec)
	type(string_t), intent(in) :: name
	type(prt_spec_t) :: prt_spec
	prt_spec%name = name
	end function new_prt_spec_

	elemental module function new_prt_spec_polarized (name, polarized) result (prt_spec)
	type(string_t), intent(in) :: name
	logical, intent(in) :: polarized
	type(prt_spec_t) :: prt_spec
	prt_spec%name = name
	prt_spec%polarized = polarized
	end function new_prt_spec_polarized

	pure module function new_prt_spec_unstable (name, decay) result (prt_spec)
	type(string_t), intent(in) :: name
	type(string_t), dimension(:), intent(in) :: decay
	type(prt_spec_t) :: prt_spec
	prt_spec%name = name
	allocate (prt_spec%decay (size (decay)))
	prt_spec%decay = decay
	end function new_prt_spec_unstable

	@ %def new_prt_spec
	@
	\subsubsection{Access Methods}
	Return the particle name without qualifiers
	<<Particle specifiers: prt spec: TBP>>=
	procedure :: get_name => prt_spec_get_name
	<<Particle specifiers: sub interfaces>>=
	elemental module function prt_spec_get_name (prt_spec) result (name)
	class(prt_spec_t), intent(in) :: prt_spec
	type(string_t) :: name
	end function prt_spec_get_name
	<<Particle specifiers: procedures>>=
	elemental module function prt_spec_get_name (prt_spec) result (name)
	class(prt_spec_t), intent(in) :: prt_spec
	type(string_t) :: name
	name = prt_spec%name
	end function prt_spec_get_name

	@ %def prt_spec_get_name
	@ Return the name with qualifiers
	<<Particle specifiers: prt spec: TBP>>=
	procedure :: to_string => prt_spec_to_string
	<<Particle specifiers: sub interfaces>>=
	module function prt_spec_to_string (object) result (string)
	class(prt_spec_t), intent(in) :: object
	type(string_t) :: string
	end function prt_spec_to_string
	<<Particle specifiers: procedures>>=
	module function prt_spec_to_string (object) result (string)
	class(prt_spec_t), intent(in) :: object
	type(string_t) :: string
	integer :: i
	string = object%name
	if (allocated (object%decay)) then
	string = string // "("
	do i = 1, size (object%decay)
	if (i > 1) string = string // " + "
	string = string // object%decay(i)
	end do
	string = string // ")"
	else if (object%polarized) then
	string = string // "(*)"
	end if
	end function prt_spec_to_string

	@ %def prt_spec_to_string
	@ Return the polarization flag
	<<Particle specifiers: prt spec: TBP>>=
	procedure :: is_polarized => prt_spec_is_polarized
	<<Particle specifiers: sub interfaces>>=
	elemental module function prt_spec_is_polarized (prt_spec) result (flag)
	class(prt_spec_t), intent(in) :: prt_spec
	logical :: flag
	end function prt_spec_is_polarized
	<<Particle specifiers: procedures>>=
	elemental module function prt_spec_is_polarized (prt_spec) result (flag)
	class(prt_spec_t), intent(in) :: prt_spec
	logical :: flag
	flag = prt_spec%polarized
	end function prt_spec_is_polarized

	@ %def prt_spec_is_polarized
	@ The particle is unstable if there is a decay array.
	<<Particle specifiers: prt spec: TBP>>=
	procedure :: is_unstable => prt_spec_is_unstable
	<<Particle specifiers: sub interfaces>>=
	elemental module function prt_spec_is_unstable (prt_spec) result (flag)
	class(prt_spec_t), intent(in) :: prt_spec
	logical :: flag
	end function prt_spec_is_unstable
	<<Particle specifiers: procedures>>=
	elemental module function prt_spec_is_unstable (prt_spec) result (flag)
	class(prt_spec_t), intent(in) :: prt_spec
	logical :: flag
	flag = allocated (prt_spec%decay)
	end function prt_spec_is_unstable

	@ %def prt_spec_is_unstable
	@ Return the number of decay channels
	<<Particle specifiers: prt spec: TBP>>=
	procedure :: get_n_decays => prt_spec_get_n_decays
	<<Particle specifiers: sub interfaces>>=
	elemental module function prt_spec_get_n_decays (prt_spec) result (n)
	class(prt_spec_t), intent(in) :: prt_spec
	integer :: n
	end function prt_spec_get_n_decays
	<<Particle specifiers: procedures>>=
	elemental module function prt_spec_get_n_decays (prt_spec) result (n)
	class(prt_spec_t), intent(in) :: prt_spec
	integer :: n
	if (allocated (prt_spec%decay)) then
	n = size (prt_spec%decay)
	else
	n = 0
	end if
	end function prt_spec_get_n_decays

	@ %def prt_spec_get_n_decays
	@ Return the decay channels
	<<Particle specifiers: prt spec: TBP>>=
	procedure :: get_decays => prt_spec_get_decays
	<<Particle specifiers: sub interfaces>>=
	module subroutine prt_spec_get_decays (prt_spec, decay)
	class(prt_spec_t), intent(in) :: prt_spec
	type(string_t), dimension(:), allocatable, intent(out) :: decay
	end subroutine prt_spec_get_decays
	<<Particle specifiers: procedures>>=
	module subroutine prt_spec_get_decays (prt_spec, decay)
	class(prt_spec_t), intent(in) :: prt_spec
	type(string_t), dimension(:), allocatable, intent(out) :: decay
	if (allocated (prt_spec%decay)) then
	allocate (decay (size (prt_spec%decay)))
	decay = prt_spec%decay
	else
	allocate (decay (0))
	end if
	end subroutine prt_spec_get_decays

	@ %def prt_spec_get_decays
	@
	\subsubsection{Miscellaneous}
	There is nothing to expand here:
	<<Particle specifiers: prt spec: TBP>>=
	procedure :: expand_sub => prt_spec_expand_sub
	<<Particle specifiers: sub interfaces>>=
	module subroutine prt_spec_expand_sub (object)
	class(prt_spec_t), intent(inout) :: object
	end subroutine prt_spec_expand_sub
	<<Particle specifiers: procedures>>=
	module subroutine prt_spec_expand_sub (object)
	class(prt_spec_t), intent(inout) :: object
	end subroutine prt_spec_expand_sub

	@ %def prt_spec_expand_sub
	@
	\subsection{List}
	A list of particle specifiers, indicating, e.g., the final state of a
	process.
	<<Particle specifiers: public>>=
	public :: prt_spec_list_t
	<<Particle specifiers: types>>=
	type, extends (prt_spec_expr_t) :: prt_spec_list_t
	type(prt_expr_t), dimension(:), allocatable :: expr
	contains
	<<Particle specifiers: prt spec list: TBP>>
	end type prt_spec_list_t

	@ %def prt_spec_list_t
	@ Output: Concatenate the components. Insert brackets if the component is
	also a list. The components of the [[expr]] array, if any, should all be
	filled.
	<<Particle specifiers: prt spec list: TBP>>=
	procedure :: to_string => prt_spec_list_to_string
	<<Particle specifiers: sub interfaces>>=
	recursive module function prt_spec_list_to_string (object) result (string)
	class(prt_spec_list_t), intent(in) :: object
	type(string_t) :: string
	end function prt_spec_list_to_string
	<<Particle specifiers: procedures>>=
	recursive module function prt_spec_list_to_string (object) result (string)
	class(prt_spec_list_t), intent(in) :: object
	type(string_t) :: string
	integer :: i
	string = ""
	if (allocated (object%expr)) then
	do i = 1, size (object%expr)
	if (i > 1) string = string // ", "
	select type (x => object%expr(i)%x)
	type is (prt_spec_list_t)
	string = string // "(" // x%to_string () // ")"
	class default
	string = string // x%to_string ()
	end select
	end do
	end if
	end function prt_spec_list_to_string

	@ %def prt_spec_list_to_string
	@ Flatten: if there is a subexpression which is also a list, include the
	components as direct members of the current list.
	<<Particle specifiers: prt spec list: TBP>>=
	procedure :: flatten => prt_spec_list_flatten
	<<Particle specifiers: sub interfaces>>=
	module subroutine prt_spec_list_flatten (object)
	class(prt_spec_list_t), intent(inout) :: object
	end subroutine prt_spec_list_flatten
	<<Particle specifiers: procedures>>=
	module subroutine prt_spec_list_flatten (object)
	class(prt_spec_list_t), intent(inout) :: object
	type(prt_expr_t), dimension(:), allocatable :: tmp_expr
	integer :: i, n_flat, i_flat
	n_flat = 0
	do i = 1, size (object%expr)
	select type (y => object%expr(i)%x)
	type is (prt_spec_list_t)
	n_flat = n_flat + size (y%expr)
	class default
	n_flat = n_flat + 1
	end select
	end do
	if (n_flat > size (object%expr)) then
	allocate (tmp_expr (n_flat))
	i_flat = 0
	do i = 1, size (object%expr)
	select type (y => object%expr(i)%x)
	type is (prt_spec_list_t)
	tmp_expr (i_flat + 1 : i_flat + size (y%expr)) = y%expr
	i_flat = i_flat + size (y%expr)
	class default
	tmp_expr (i_flat + 1) = object%expr(i)
	i_flat = i_flat + 1
	end select
	end do
	end if
	if (allocated (tmp_expr)) &
	call move_alloc (from = tmp_expr, to = object%expr)
	end subroutine prt_spec_list_flatten

	@ %def prt_spec_list_flatten
	@ Convert a list of sums into a sum of lists. (Subexpressions which are not
	sums are left untouched.) Due to compiler bug in gfortran 7-9 not in submodule.
	<<Particle specifiers: main procedures>>=
	subroutine distribute_prt_spec_list (object)
	class(prt_spec_expr_t), intent(inout), allocatable :: object
	class(prt_spec_expr_t), allocatable :: new_object
	integer, dimension(:), allocatable :: n, ii
	integer :: k, n_expr, n_terms, i_term
	select type (object)
	type is (prt_spec_list_t)
	n_expr = size (object%expr)
	allocate (n (n_expr), source = 1)
	allocate (ii (n_expr), source = 1)
	do k = 1, size (object%expr)
	select type (y => object%expr(k)%x)
	type is (prt_spec_sum_t)
	n(k) = size (y%expr)
	end select
	end do
	n_terms = product (n)
	if (n_terms > 1) then
	allocate (prt_spec_sum_t :: new_object)
	select type (new_object)
	type is (prt_spec_sum_t)
	allocate (new_object%expr (n_terms))
	do i_term = 1, n_terms
	allocate (prt_spec_list_t :: new_object%expr(i_term)%x)
	select type (x => new_object%expr(i_term)%x)
	type is (prt_spec_list_t)
	allocate (x%expr (n_expr))
	do k = 1, n_expr
	select type (y => object%expr(k)%x)
	type is (prt_spec_sum_t)
	x%expr(k) = y%expr(ii(k))
	class default
	x%expr(k) = object%expr(k)
	end select
	end do
	end select
	INCR_INDEX: do k = n_expr, 1, -1
	if (ii(k) < n(k)) then
	ii(k) = ii(k) + 1
	exit INCR_INDEX
	else
	ii(k) = 1
	end if
	end do INCR_INDEX
	end do
	end select
	end if
	end select
	if (allocated (new_object)) call move_alloc (from = new_object, to = object)
	end subroutine distribute_prt_spec_list

	@ %def distribute_prt_spec_list
	@ Apply [[expand]] to all components of the list.
	<<Particle specifiers: prt spec list: TBP>>=
	procedure :: expand_sub => prt_spec_list_expand_sub
	<<Particle specifiers: sub interfaces>>=
	recursive module subroutine prt_spec_list_expand_sub (object)
	class(prt_spec_list_t), intent(inout) :: object
	end subroutine prt_spec_list_expand_sub
	<<Particle specifiers: procedures>>=
	recursive module subroutine prt_spec_list_expand_sub (object)
	class(prt_spec_list_t), intent(inout) :: object
	integer :: i
	if (allocated (object%expr)) then
	do i = 1, size (object%expr)
	call object%expr(i)%expand ()
	end do
	end if
	end subroutine prt_spec_list_expand_sub

	@ %def prt_spec_list_expand_sub
	@
	\subsection{Sum}
	A sum of particle specifiers, indicating, e.g., a sum of final states.
	<<Particle specifiers: public>>=
	public :: prt_spec_sum_t
	<<Particle specifiers: types>>=
	type, extends (prt_spec_expr_t) :: prt_spec_sum_t
	type(prt_expr_t), dimension(:), allocatable :: expr
	contains
	<<Particle specifiers: prt spec sum: TBP>>
	end type prt_spec_sum_t

	@ %def prt_spec_sum_t
	@ Output: Concatenate the components. Insert brackets if the component is
	a list or also a sum. The components of the [[expr]] array, if any, should
	all be filled.
	<<Particle specifiers: prt spec sum: TBP>>=
	procedure :: to_string => prt_spec_sum_to_string
	<<Particle specifiers: sub interfaces>>=
	recursive module function prt_spec_sum_to_string (object) result (string)
	class(prt_spec_sum_t), intent(in) :: object
	type(string_t) :: string
	end function prt_spec_sum_to_string
	<<Particle specifiers: procedures>>=
	recursive module function prt_spec_sum_to_string (object) result (string)
	class(prt_spec_sum_t), intent(in) :: object
	type(string_t) :: string
	integer :: i
	string = ""
	if (allocated (object%expr)) then
	do i = 1, size (object%expr)
	if (i > 1) string = string // " + "
	select type (x => object%expr(i)%x)
	type is (prt_spec_list_t)
	string = string // "(" // x%to_string () // ")"
	type is (prt_spec_sum_t)
	string = string // "(" // x%to_string () // ")"
	class default
	string = string // x%to_string ()
	end select
	end do
	end if
	end function prt_spec_sum_to_string

	@ %def prt_spec_sum_to_string
	@ Flatten: if there is a subexpression which is also a sum, include the
	components as direct members of the current sum.

	This is identical to [[prt_spec_list_flatten]] above, except for the type.
	<<Particle specifiers: prt spec sum: TBP>>=
	procedure :: flatten => prt_spec_sum_flatten
	<<Particle specifiers: sub interfaces>>=
	module subroutine prt_spec_sum_flatten (object)
	class(prt_spec_sum_t), intent(inout) :: object
	end subroutine prt_spec_sum_flatten
	<<Particle specifiers: procedures>>=
	module subroutine prt_spec_sum_flatten (object)
	class(prt_spec_sum_t), intent(inout) :: object
	type(prt_expr_t), dimension(:), allocatable :: tmp_expr
	integer :: i, n_flat, i_flat
	n_flat = 0
	do i = 1, size (object%expr)
	select type (y => object%expr(i)%x)
	type is (prt_spec_sum_t)
	n_flat = n_flat + size (y%expr)
	class default
	n_flat = n_flat + 1
	end select
	end do
	if (n_flat > size (object%expr)) then
	allocate (tmp_expr (n_flat))
	i_flat = 0
	do i = 1, size (object%expr)
	select type (y => object%expr(i)%x)
	type is (prt_spec_sum_t)
	tmp_expr (i_flat + 1 : i_flat + size (y%expr)) = y%expr
	i_flat = i_flat + size (y%expr)
	class default
	tmp_expr (i_flat + 1) = object%expr(i)
	i_flat = i_flat + 1
	end select
	end do
	end if
	if (allocated (tmp_expr)) &
	call move_alloc (from = tmp_expr, to = object%expr)
	end subroutine prt_spec_sum_flatten

	@ %def prt_spec_sum_flatten
	@ Apply [[expand]] to all terms in the sum.
	<<Particle specifiers: prt spec sum: TBP>>=
	procedure :: expand_sub => prt_spec_sum_expand_sub
	<<Particle specifiers: sub interfaces>>=
	recursive module subroutine prt_spec_sum_expand_sub (object)
	class(prt_spec_sum_t), intent(inout) :: object
	end subroutine prt_spec_sum_expand_sub
	<<Particle specifiers: procedures>>=
	recursive module subroutine prt_spec_sum_expand_sub (object)
	class(prt_spec_sum_t), intent(inout) :: object
	integer :: i
	if (allocated (object%expr)) then
	do i = 1, size (object%expr)
	call object%expr(i)%expand ()
	end do
	end if
	end subroutine prt_spec_sum_expand_sub

	@ %def prt_spec_sum_expand_sub
	@
	\subsection{Expression Expansion}
	The [[expand]] method transforms each particle specifier expression into a sum
	of lists, according to the rules
	\begin{align}
	a, (b, c) &\to a, b, c
	\\
	a + (b + c) &\to a + b + c
	\\
	a, b + c &\to (a, b) + (a, c)
	\end{align}
	Note that the precedence of comma and plus are opposite to this expansion, so
	the parentheses in the final expression are necessary.

	We assume that subexpressions are filled, i.e., arrays are allocated.
	Do to compiler bug in gfortran 7-9 not in submodule.
	<<Particle specifiers: prt expr: TBP>>=
	procedure :: expand => prt_expr_expand
	<<Particle specifiers: main procedures>>=
	recursive subroutine prt_expr_expand (expr)
	class(prt_expr_t), intent(inout) :: expr
	if (allocated (expr%x)) then
	call distribute_prt_spec_list (expr%x)
	call expr%x%expand_sub ()
	select type (x => expr%x)
	type is (prt_spec_list_t)
	call x%flatten ()
	type is (prt_spec_sum_t)
	call x%flatten ()
	end select
	end if
	end subroutine prt_expr_expand

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

	module particle_specifiers_ut
	use unit_tests
	use particle_specifiers_uti

	<<Standard module head>>

	<<Particle specifiers: public test>>

	contains

	<<Particle specifiers: test driver>>

	end module particle_specifiers_ut
	@ %def particle_specifiers_ut
	@
	<<[[particle_specifiers_uti.f90]]>>=
	<<File header>>

	module particle_specifiers_uti

	<<Use strings>>

	use particle_specifiers

	<<Standard module head>>

	<<Particle specifiers: test declarations>>

	contains

	<<Particle specifiers: tests>>

	end module particle_specifiers_uti
	@ %def particle_specifiers_ut
	@ API: driver for the unit tests below.
	<<Particle specifiers: public test>>=
	public :: particle_specifiers_test
	<<Particle specifiers: test driver>>=
	subroutine particle_specifiers_test (u, results)
	integer, intent(in) :: u
	type(test_results_t), intent(inout) :: results
	<<Particle specifiers: execute tests>>
	end subroutine particle_specifiers_test

	@ %def particle_specifiers_test
	@
	\subsubsection{Particle specifier array}
	Define, read and write an array of particle specifiers.
	<<Particle specifiers: execute tests>>=
	call test (particle_specifiers_1, "particle_specifiers_1", &
	"Handle particle specifiers", &
	u, results)
	<<Particle specifiers: test declarations>>=
	public :: particle_specifiers_1
	<<Particle specifiers: tests>>=
	subroutine particle_specifiers_1 (u)
	integer, intent(in) :: u
	type(prt_spec_t), dimension(:), allocatable :: prt_spec
	type(string_t), dimension(:), allocatable :: decay
	type(string_t), dimension(0) :: no_decay
	integer :: i, j

	write (u, "(A)") "* Test output: particle_specifiers_1"
	write (u, "(A)") "* Purpose: Read and write a particle specifier array"
	write (u, "(A)")

	allocate (prt_spec (5))
	prt_spec = [ &
	new_prt_spec (var_str ("a")), &
	new_prt_spec (var_str ("b"), .true.), &
	new_prt_spec (var_str ("c"), [var_str ("dec1")]), &
	new_prt_spec (var_str ("d"), [var_str ("dec1"), var_str ("dec2")]), &
	new_prt_spec (var_str ("e"), no_decay) &
	]
	do i = 1, size (prt_spec)
	write (u, "(A)") char (prt_spec(i)%to_string ())
	end do
	write (u, "(A)")

	call prt_spec_read (prt_spec, &
	var_str (" a, b( *), c( dec1), d (dec1 + dec2 ), e()"))
	call prt_spec_write (prt_spec, u)

	do i = 1, size (prt_spec)
	write (u, "(A)")
	write (u, "(A,A)") char (prt_spec(i)%get_name ()), ":"
	write (u, "(A,L1)") "polarized = ", prt_spec(i)%is_polarized ()
	write (u, "(A,L1)") "unstable = ", prt_spec(i)%is_unstable ()
	write (u, "(A,I0)") "n_decays = ", prt_spec(i)%get_n_decays ()
	call prt_spec(i)%get_decays (decay)
	write (u, "(A)", advance="no") "decays ="
	do j = 1, size (decay)
	write (u, "(1x,A)", advance="no") char (decay(j))
	end do
	write (u, "(A)")
	end do

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

	@ %def particle_specifiers_1
	@
	\subsubsection{Particle specifier expressions}
	Nested expressions (only basic particles, no decay specs).
	<<Particle specifiers: execute tests>>=
	call test (particle_specifiers_2, "particle_specifiers_2", &
	"Particle specifier expressions", &
	u, results)
	<<Particle specifiers: test declarations>>=
	public :: particle_specifiers_2
	<<Particle specifiers: tests>>=
	subroutine particle_specifiers_2 (u)
	integer, intent(in) :: u
	type(prt_spec_t) :: a, b, c, d, e, f
	type(prt_expr_t) :: pe1, pe2, pe3
	type(prt_expr_t) :: pe4, pe5, pe6, pe7, pe8, pe9
	integer :: i
	type(prt_spec_t), dimension(:), allocatable :: pa

	write (u, "(A)") "* Test output: particle_specifiers_2"
	write (u, "(A)") "* Purpose: Create and display particle expressions"
	write (u, "(A)")

	write (u, "(A)") "* Basic expressions"
	write (u, *)

	a = new_prt_spec (var_str ("a"))
	b = new_prt_spec (var_str ("b"))
	c = new_prt_spec (var_str ("c"))
	d = new_prt_spec (var_str ("d"))
	e = new_prt_spec (var_str ("e"))
	f = new_prt_spec (var_str ("f"))

	call pe1%init_spec (a)
	write (u, "(A)") char (pe1%to_string ())

	call pe2%init_sum (2)
	select type (x => pe2%x)
	type is (prt_spec_sum_t)
	call x%expr(1)%init_spec (a)
	call x%expr(2)%init_spec (b)
	end select
	write (u, "(A)") char (pe2%to_string ())

	call pe3%init_list (2)
	select type (x => pe3%x)
	type is (prt_spec_list_t)
	call x%expr(1)%init_spec (a)
	call x%expr(2)%init_spec (b)
	end select
	write (u, "(A)") char (pe3%to_string ())

	write (u, *)
	write (u, "(A)") "* Nested expressions"
	write (u, *)

	call pe4%init_list (2)
	select type (x => pe4%x)
	type is (prt_spec_list_t)
	call x%expr(1)%init_sum (2)
	select type (y => x%expr(1)%x)
	type is (prt_spec_sum_t)
	call y%expr(1)%init_spec (a)
	call y%expr(2)%init_spec (b)
	end select
	call x%expr(2)%init_spec (c)
	end select
	write (u, "(A)") char (pe4%to_string ())

	call pe5%init_list (2)
	select type (x => pe5%x)
	type is (prt_spec_list_t)
	call x%expr(1)%init_list (2)
	select type (y => x%expr(1)%x)
	type is (prt_spec_list_t)
	call y%expr(1)%init_spec (a)
	call y%expr(2)%init_spec (b)
	end select
	call x%expr(2)%init_spec (c)
	end select
	write (u, "(A)") char (pe5%to_string ())

	call pe6%init_sum (2)
	select type (x => pe6%x)
	type is (prt_spec_sum_t)
	call x%expr(1)%init_spec (a)
	call x%expr(2)%init_sum (2)
	select type (y => x%expr(2)%x)
	type is (prt_spec_sum_t)
	call y%expr(1)%init_spec (b)
	call y%expr(2)%init_spec (c)
	end select
	end select
	write (u, "(A)") char (pe6%to_string ())

	call pe7%init_list (2)
	select type (x => pe7%x)
	type is (prt_spec_list_t)
	call x%expr(1)%init_sum (2)
	select type (y => x%expr(1)%x)
	type is (prt_spec_sum_t)
	call y%expr(1)%init_spec (a)
	call y%expr(2)%init_list (2)
	select type (z => y%expr(2)%x)
	type is (prt_spec_list_t)
	call z%expr(1)%init_spec (b)
	call z%expr(2)%init_spec (c)
	end select
	end select
	call x%expr(2)%init_spec (d)
	end select
	write (u, "(A)") char (pe7%to_string ())

	call pe8%init_sum (2)
	select type (x => pe8%x)
	type is (prt_spec_sum_t)
	call x%expr(1)%init_list (2)
	select type (y => x%expr(1)%x)
	type is (prt_spec_list_t)
	call y%expr(1)%init_spec (a)
	call y%expr(2)%init_spec (b)
	end select
	call x%expr(2)%init_list (2)
	select type (y => x%expr(2)%x)
	type is (prt_spec_list_t)
	call y%expr(1)%init_spec (c)
	call y%expr(2)%init_spec (d)
	end select
	end select
	write (u, "(A)") char (pe8%to_string ())

	call pe9%init_list (3)
	select type (x => pe9%x)
	type is (prt_spec_list_t)
	call x%expr(1)%init_sum (2)
	select type (y => x%expr(1)%x)
	type is (prt_spec_sum_t)
	call y%expr(1)%init_spec (a)
	call y%expr(2)%init_spec (b)
	end select
	call x%expr(2)%init_spec (c)
	call x%expr(3)%init_sum (3)
	select type (y => x%expr(3)%x)
	type is (prt_spec_sum_t)
	call y%expr(1)%init_spec (d)
	call y%expr(2)%init_spec (e)
	call y%expr(3)%init_spec (f)
	end select
	end select
	write (u, "(A)") char (pe9%to_string ())

	write (u, *)
	write (u, "(A)") "* Expand as sum"
	write (u, *)

	call pe1%expand ()
	write (u, "(A)") char (pe1%to_string ())

	call pe4%expand ()
	write (u, "(A)") char (pe4%to_string ())

	call pe5%expand ()
	write (u, "(A)") char (pe5%to_string ())

	call pe6%expand ()
	write (u, "(A)") char (pe6%to_string ())

	call pe7%expand ()
	write (u, "(A)") char (pe7%to_string ())

	call pe8%expand ()
	write (u, "(A)") char (pe8%to_string ())

	call pe9%expand ()
	write (u, "(A)") char (pe9%to_string ())

	write (u, *)
	write (u, "(A)") "* Transform to arrays:"

	write (u, "(A)") "* Atomic specifier"
	do i = 1, pe1%get_n_terms ()
	call pe1%term_to_array (pa, i)
	call prt_spec_write (pa, u)
	end do

	write (u, *)
	write (u, "(A)") "* List"
	do i = 1, pe5%get_n_terms ()
	call pe5%term_to_array (pa, i)
	call prt_spec_write (pa, u)
	end do

	write (u, *)
	write (u, "(A)") "* Sum of atoms"
	do i = 1, pe6%get_n_terms ()
	call pe6%term_to_array (pa, i)
	call prt_spec_write (pa, u)
	end do

	write (u, *)
	write (u, "(A)") "* Sum of lists"
	do i = 1, pe9%get_n_terms ()
	call pe9%term_to_array (pa, i)
	call prt_spec_write (pa, u)
	end do

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

	@ %def particle_specifiers_2
	@
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{PDG arrays}

	For defining aliases, we introduce a special type which holds a set of
	(integer) PDG codes.
	<<[[pdg_arrays.f90]]>>=
	<<File header>>

	module pdg_arrays

	<<Standard module head>>

	<<PDG arrays: public>>

	<<PDG arrays: types>>

	<<PDG arrays: interfaces>>

	interface
	<<PDG arrays: sub interfaces>>
	end interface

	end module pdg_arrays
	@ %def pdg_arrays
	@
	<<[[pdg_arrays_sub.f90]]>>=
	<<File header>>

	submodule (pdg_arrays) pdg_arrays_s

	use io_units
	use sorting
	use physics_defs

	implicit none

	contains

	<<PDG arrays: procedures>>

	end submodule pdg_arrays_s

	@ %def pdg_arrays_s
	@
	\subsection{Type definition}
	Using an allocatable array eliminates the need for initializer and/or
	finalizer.
	<<PDG arrays: public>>=
	public :: pdg_array_t
	<<PDG arrays: types>>=
	type :: pdg_array_t
	private
	integer, dimension(:), allocatable :: pdg
	contains
	<<PDG arrays: pdg array: TBP>>
	end type pdg_array_t

	@ %def pdg_array_t
	@ Output.
	<<PDG arrays: pdg array: TBP>>=
	procedure :: write => pdg_array_write
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_array_write (aval, unit)
	class(pdg_array_t), intent(in) :: aval
	integer, intent(in), optional :: unit
	end subroutine pdg_array_write
	<<PDG arrays: procedures>>=
	module subroutine pdg_array_write (aval, unit)
	class(pdg_array_t), intent(in) :: aval
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(A)", advance="no") "PDG("
	if (allocated (aval%pdg)) then
	do i = 1, size (aval%pdg)
	if (i > 1) write (u, "(A)", advance="no") ", "
	write (u, "(I0)", advance="no") aval%pdg(i)
	end do
	end if
	write (u, "(A)", advance="no") ")"
	end subroutine pdg_array_write

	@ %def pdg_array_write
	@
	<<PDG arrays: public>>=
	public :: pdg_array_write_set
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_array_write_set (aval, unit)
	type(pdg_array_t), intent(in), dimension(:) :: aval
	integer, intent(in), optional :: unit
	end subroutine pdg_array_write_set
	<<PDG arrays: procedures>>=
	module subroutine pdg_array_write_set (aval, unit)
	type(pdg_array_t), intent(in), dimension(:) :: aval
	integer, intent(in), optional :: unit
	integer :: i
	do i = 1, size (aval)
	call aval(i)%write (unit)
	print *, ''
	end do
	end subroutine pdg_array_write_set

	@ %def pdg_array_write_set
	@
	\subsection{Basic operations}
	Assignment. We define assignment from and to an integer array.
	Note that the integer array, if it is the l.h.s., must be declared
	allocatable by the caller.
	<<PDG arrays: public>>=
	public :: assignment(=)
	<<PDG arrays: interfaces>>=
	interface assignment(=)
	module procedure pdg_array_from_int_array
	module procedure pdg_array_from_int
	module procedure int_array_from_pdg_array
	end interface

	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_array_from_int_array (aval, iarray)
	type(pdg_array_t), intent(out) :: aval
	integer, dimension(:), intent(in) :: iarray
	end subroutine pdg_array_from_int_array
	elemental module subroutine pdg_array_from_int (aval, int)
	type(pdg_array_t), intent(out) :: aval
	integer, intent(in) :: int
	end subroutine pdg_array_from_int
	module subroutine int_array_from_pdg_array (iarray, aval)
	integer, dimension(:), allocatable, intent(out) :: iarray
	type(pdg_array_t), intent(in) :: aval
	end subroutine int_array_from_pdg_array
	<<PDG arrays: procedures>>=
	module subroutine pdg_array_from_int_array (aval, iarray)
	type(pdg_array_t), intent(out) :: aval
	integer, dimension(:), intent(in) :: iarray
	allocate (aval%pdg (size (iarray)))
	aval%pdg = iarray
	end subroutine pdg_array_from_int_array

	elemental module subroutine pdg_array_from_int (aval, int)
	type(pdg_array_t), intent(out) :: aval
	integer, intent(in) :: int
	allocate (aval%pdg (1))
	aval%pdg = int
	end subroutine pdg_array_from_int

	module subroutine int_array_from_pdg_array (iarray, aval)
	integer, dimension(:), allocatable, intent(out) :: iarray
	type(pdg_array_t), intent(in) :: aval
	if (allocated (aval%pdg)) then
	allocate (iarray (size (aval%pdg)))
	iarray = aval%pdg
	else
	allocate (iarray (0))
	end if
	end subroutine int_array_from_pdg_array

	@ %def pdg_array_from_int_array pdg_array_from_int int_array_from_pdg_array
	@ Allocate space for a PDG array
	<<PDG arrays: pdg array: TBP>>=
	procedure :: init => pdg_array_init
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_array_init (aval, n_elements)
	class(pdg_array_t), intent(inout) :: aval
	integer, intent(in) :: n_elements
	end subroutine pdg_array_init
	<<PDG arrays: procedures>>=
	module subroutine pdg_array_init (aval, n_elements)
	class(pdg_array_t), intent(inout) :: aval
	integer, intent(in) :: n_elements
	allocate(aval%pdg(n_elements))
	end subroutine pdg_array_init

	@ %def pdg_array_init
	@ Deallocate a previously allocated pdg array
	<<PDG arrays: pdg array: TBP>>=
	procedure :: delete => pdg_array_delete
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_array_delete (aval)
	class(pdg_array_t), intent(inout) :: aval
	end subroutine pdg_array_delete
	<<PDG arrays: procedures>>=
	module subroutine pdg_array_delete (aval)
	class(pdg_array_t), intent(inout) :: aval
	if (allocated (aval%pdg)) deallocate (aval%pdg)
	end subroutine pdg_array_delete

	@ %def pdg_array_delete
	@ Merge two pdg arrays, i.e. append a particle string to another leaving out doublettes
	<<PDG arrays: pdg array: TBP>>=
	procedure :: merge => pdg_array_merge
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_array_merge (aval1, aval2)
	class(pdg_array_t), intent(inout) :: aval1
	type(pdg_array_t), intent(in) :: aval2
	end subroutine pdg_array_merge
	<<PDG arrays: procedures>>=
	module subroutine pdg_array_merge (aval1, aval2)
	class(pdg_array_t), intent(inout) :: aval1
	type(pdg_array_t), intent(in) :: aval2
	type(pdg_array_t) :: aval
	if (allocated (aval1%pdg) .and. allocated (aval2%pdg)) then
	if (.not. any (aval1%pdg == aval2%pdg)) aval = aval1 // aval2
	else if (allocated (aval1%pdg)) then
	aval = aval1
	else if (allocated (aval2%pdg)) then
	aval = aval2
	end if
	call pdg_array_delete (aval1)
	call pdg_array_from_int_array (aval1, aval%pdg)
	end subroutine pdg_array_merge

	@ %def pdg_array_merge
	@ Length of the array.
	<<PDG arrays: pdg array: TBP>>=
	procedure :: get_length => pdg_array_get_length
	<<PDG arrays: sub interfaces>>=
	elemental module function pdg_array_get_length (aval) result (n)
	class(pdg_array_t), intent(in) :: aval
	integer :: n
	end function pdg_array_get_length
	<<PDG arrays: procedures>>=
	elemental module function pdg_array_get_length (aval) result (n)
	class(pdg_array_t), intent(in) :: aval
	integer :: n
	if (allocated (aval%pdg)) then
	n = size (aval%pdg)
	else
	n = 0
	end if
	end function pdg_array_get_length

	@ %def pdg_array_get_length
	@ Return the element with index i.
	<<PDG arrays: pdg array: TBP>>=
	procedure :: get => pdg_array_get
	<<PDG arrays: sub interfaces>>=
	elemental module function pdg_array_get (aval, i) result (pdg)
	class(pdg_array_t), intent(in) :: aval
	integer, intent(in), optional :: i
	integer :: pdg
	end function pdg_array_get
	<<PDG arrays: procedures>>=
	elemental module function pdg_array_get (aval, i) result (pdg)
	class(pdg_array_t), intent(in) :: aval
	integer, intent(in), optional :: i
	integer :: pdg
	if (present (i)) then
	pdg = aval%pdg(i)
	else
	pdg = aval%pdg(1)
	end if
	end function pdg_array_get

	@ %def pdg_array_get
	@ Explicitly set the element with index i.
	<<PDG arrays: pdg array: TBP>>=
	procedure :: set => pdg_array_set
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_array_set (aval, i, pdg)
	class(pdg_array_t), intent(inout) :: aval
	integer, intent(in) :: i
	integer, intent(in) :: pdg
	end subroutine pdg_array_set
	<<PDG arrays: procedures>>=
	module subroutine pdg_array_set (aval, i, pdg)
	class(pdg_array_t), intent(inout) :: aval
	integer, intent(in) :: i
	integer, intent(in) :: pdg
	aval%pdg(i) = pdg
	end subroutine pdg_array_set

	@ %def pdg_array_set
	@
	<<PDG arrays: pdg array: TBP>>=
	procedure :: add => pdg_array_add
	<<PDG arrays: sub interfaces>>=
	module function pdg_array_add (aval, aval_add) result (aval_out)
	type(pdg_array_t) :: aval_out
	class(pdg_array_t), intent(in) :: aval
	type(pdg_array_t), intent(in) :: aval_add
	end function pdg_array_add
	<<PDG arrays: procedures>>=
	module function pdg_array_add (aval, aval_add) result (aval_out)
	type(pdg_array_t) :: aval_out
	class(pdg_array_t), intent(in) :: aval
	type(pdg_array_t), intent(in) :: aval_add
	integer :: n, n_add, i
	n = size (aval%pdg)
	n_add = size (aval_add%pdg)
	allocate (aval_out%pdg (n + n_add))
	aval_out%pdg(1:n) = aval%pdg
	do i = 1, n_add
	aval_out%pdg(n+i) = aval_add%pdg(i)
	end do
	end function pdg_array_add

	@ %def pdg_array_add
	@ Replace element with index [[i]] by a new array of elements.
	<<PDG arrays: pdg array: TBP>>=
	procedure :: replace => pdg_array_replace
	<<PDG arrays: sub interfaces>>=
	module function pdg_array_replace (aval, i, pdg_new) result (aval_new)
	class(pdg_array_t), intent(in) :: aval
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: pdg_new
	type(pdg_array_t) :: aval_new
	end function pdg_array_replace
	<<PDG arrays: procedures>>=
	module function pdg_array_replace (aval, i, pdg_new) result (aval_new)
	class(pdg_array_t), intent(in) :: aval
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: pdg_new
	type(pdg_array_t) :: aval_new
	integer :: n, l
	n = size (aval%pdg)
	l = size (pdg_new)
	allocate (aval_new%pdg (n + l - 1))
	aval_new%pdg(:i-1) = aval%pdg(:i-1)
	aval_new%pdg(i:i+l-1) = pdg_new
	aval_new%pdg(i+l:) = aval%pdg(i+1:)
	end function pdg_array_replace

	@ %def pdg_array_replace
	@ Concatenate two PDG arrays
	<<PDG arrays: public>>=
	public :: operator(//)
	<<PDG arrays: interfaces>>=
	interface operator(//)
	module procedure concat_pdg_arrays
	end interface

	<<PDG arrays: sub interfaces>>=
	module function concat_pdg_arrays (aval1, aval2) result (aval)
	type(pdg_array_t) :: aval
	type(pdg_array_t), intent(in) :: aval1, aval2
	end function concat_pdg_arrays
	<<PDG arrays: procedures>>=
	module function concat_pdg_arrays (aval1, aval2) result (aval)
	type(pdg_array_t) :: aval
	type(pdg_array_t), intent(in) :: aval1, aval2
	integer :: n1, n2
	if (allocated (aval1%pdg) .and. allocated (aval2%pdg)) then
	n1 = size (aval1%pdg)
	n2 = size (aval2%pdg)
	allocate (aval%pdg (n1 + n2))
	aval%pdg(:n1) = aval1%pdg
	aval%pdg(n1+1:) = aval2%pdg
	else if (allocated (aval1%pdg)) then
	aval = aval1
	else if (allocated (aval2%pdg)) then
	aval = aval2
	end if
	end function concat_pdg_arrays

	@ %def concat_pdg_arrays
	@
	\subsection{Matching}
	A PDG array matches a given PDG code if the code is present within the
	array. If either one is zero (UNDEFINED), the match also succeeds.
	<<PDG arrays: public>>=
	public :: operator(.match.)
	<<PDG arrays: interfaces>>=
	interface operator(.match.)
	module procedure pdg_array_match_integer
	module procedure pdg_array_match_pdg_array
	end interface

	@ %def .match.
	@ Match a single code against the array.
	<<PDG arrays: sub interfaces>>=
	elemental module function pdg_array_match_integer (aval, pdg) result (flag)
	logical :: flag
	type(pdg_array_t), intent(in) :: aval
	integer, intent(in) :: pdg
	end function pdg_array_match_integer
	<<PDG arrays: procedures>>=
	elemental module function pdg_array_match_integer (aval, pdg) result (flag)
	logical :: flag
	type(pdg_array_t), intent(in) :: aval
	integer, intent(in) :: pdg
	if (allocated (aval%pdg)) then
	flag = pdg == UNDEFINED &
	.or. any (aval%pdg == UNDEFINED) &
	.or. any (aval%pdg == pdg)
	else
	flag = .false.
	end if
	end function pdg_array_match_integer

	@ %def pdg_array_match_integer
	@ Check if the pdg-number corresponds to a quark
	<<PDG arrays: public>>=
	public :: is_quark
	<<PDG arrays: sub interfaces>>=
	elemental module function is_quark (pdg_nr)
	logical :: is_quark
	integer, intent(in) :: pdg_nr
	end function is_quark
	<<PDG arrays: procedures>>=
	elemental module function is_quark (pdg_nr)
	logical :: is_quark
	integer, intent(in) :: pdg_nr
	if (abs (pdg_nr) >= 1 .and. abs (pdg_nr) <= 6) then
	is_quark = .true.
	else
	is_quark = .false.
	end if
	end function is_quark

	@ %def is_quark
	@ Check if pdg-number corresponds to a gluon
	<<PDG arrays: public>>=
	public :: is_gluon
	<<PDG arrays: sub interfaces>>=
	elemental module function is_gluon (pdg_nr)
	logical :: is_gluon
	integer, intent(in) :: pdg_nr
	end function is_gluon
	<<PDG arrays: procedures>>=
	elemental module function is_gluon (pdg_nr)
	logical :: is_gluon
	integer, intent(in) :: pdg_nr
	if (pdg_nr == GLUON) then
	is_gluon = .true.
	else
	is_gluon = .false.
	end if
	end function is_gluon

	@ %def is_gluon
	@ Check if pdg-number corresponds to a photon
	<<PDG arrays: public>>=
	public :: is_photon
	<<PDG arrays: sub interfaces>>=
	elemental module function is_photon (pdg_nr)
	logical :: is_photon
	integer, intent(in) :: pdg_nr
	end function is_photon
	<<PDG arrays: procedures>>=
	elemental module function is_photon (pdg_nr)
	logical :: is_photon
	integer, intent(in) :: pdg_nr
	if (pdg_nr == PHOTON) then
	is_photon = .true.
	else
	is_photon = .false.
	end if
	end function is_photon

	@ %def is_photon
	@ Check if pdg-number corresponds to a colored particle
	<<PDG arrays: public>>=
	public :: is_colored
	<<PDG arrays: sub interfaces>>=
	elemental module function is_colored (pdg_nr)
	logical :: is_colored
	integer, intent(in) :: pdg_nr
	end function is_colored
	<<PDG arrays: procedures>>=
	elemental module function is_colored (pdg_nr)
	logical :: is_colored
	integer, intent(in) :: pdg_nr
	is_colored = is_quark (pdg_nr) .or. is_gluon (pdg_nr)
	end function is_colored

	@ %def is_colored
	@ Check if the pdg-number corresponds to a lepton
	<<PDG arrays: public>>=
	public :: is_lepton
	<<PDG arrays: sub interfaces>>=
	elemental module function is_lepton (pdg_nr)
	logical :: is_lepton
	integer, intent(in) :: pdg_nr
	end function is_lepton
	<<PDG arrays: procedures>>=
	elemental module function is_lepton (pdg_nr)
	logical :: is_lepton
	integer, intent(in) :: pdg_nr
	if (abs (pdg_nr) >= ELECTRON .and. &
	abs (pdg_nr) <= TAU_NEUTRINO) then
	is_lepton = .true.
	else
	is_lepton = .false.
	end if
	end function is_lepton

	@ %def is_lepton
	@
	@ Check if the pdg-number corresponds to a charged lepton
	<<PDG arrays: public>>=
	public :: is_charged_lepton
	<<PDG arrays: sub interfaces>>=
	elemental module function is_charged_lepton (pdg_nr)
	logical :: is_charged_lepton
	integer, intent(in) :: pdg_nr
	end function is_charged_lepton
	<<PDG arrays: procedures>>=
	elemental module function is_charged_lepton (pdg_nr)
	logical :: is_charged_lepton
	integer, intent(in) :: pdg_nr
	if (abs (pdg_nr) == ELECTRON .or. &
	abs (pdg_nr) == MUON .or. &
	abs (pdg_nr) == TAU) then
	is_charged_lepton = .true.
	else
	is_charged_lepton = .false.
	end if
	end function is_charged_lepton
	@ %def is_charged_lepton
	@
	<<PDG arrays: public>>=
	public :: is_fermion
	<<PDG arrays: sub interfaces>>=
	elemental module function is_fermion (pdg_nr)
	logical :: is_fermion
	integer, intent(in) :: pdg_nr
	end function is_fermion
	<<PDG arrays: procedures>>=
	elemental module function is_fermion (pdg_nr)
	logical :: is_fermion
	integer, intent(in) :: pdg_nr
	is_fermion = is_lepton(pdg_nr) .or. is_quark(pdg_nr)
	end function is_fermion

	@ %def is_fermion
	@ Check if the pdg-number corresponds to a massless vector boson
	<<PDG arrays: public>>=
	public :: is_massless_vector
	<<PDG arrays: sub interfaces>>=
	elemental module function is_massless_vector (pdg_nr)
	integer, intent(in) :: pdg_nr
	logical :: is_massless_vector
	end function is_massless_vector
	<<PDG arrays: procedures>>=
	elemental module function is_massless_vector (pdg_nr)
	integer, intent(in) :: pdg_nr
	logical :: is_massless_vector
	if (pdg_nr == GLUON .or. pdg_nr == PHOTON) then
	is_massless_vector = .true.
	else
	is_massless_vector = .false.
	end if
	end function is_massless_vector

	@ %def is_massless_vector
	@ Check if pdg-number corresponds to a massive vector boson
	<<PDG arrays: public>>=
	public :: is_massive_vector
	<<PDG arrays: sub interfaces>>=
	elemental module function is_massive_vector (pdg_nr)
	integer, intent(in) :: pdg_nr
	logical :: is_massive_vector
	end function is_massive_vector
	<<PDG arrays: procedures>>=
	elemental module function is_massive_vector (pdg_nr)
	integer, intent(in) :: pdg_nr
	logical :: is_massive_vector
	if (abs (pdg_nr) == Z_BOSON .or. abs (pdg_nr) == W_BOSON) then
	is_massive_vector = .true.
	else
	is_massive_vector = .false.
	end if
	end function is_massive_vector

	@ %def is massive_vector
	@ Check if pdg-number corresponds to a vector boson
	<<PDG arrays: public>>=
	public :: is_vector
	<<PDG arrays: sub interfaces>>=
	elemental module function is_vector (pdg_nr)
	integer, intent(in) :: pdg_nr
	logical :: is_vector
	end function is_vector
	<<PDG arrays: procedures>>=
	elemental module function is_vector (pdg_nr)
	integer, intent(in) :: pdg_nr
	logical :: is_vector
	if (is_massless_vector (pdg_nr) .or. is_massive_vector (pdg_nr)) then
	is_vector = .true.
	else
	is_vector = .false.
	end if
	end function is_vector

	@ %def is vector
	@ Check if particle is elementary.
	<<PDG arrays: public>>=
	public :: is_elementary
	<<PDG arrays: sub interfaces>>=
	elemental module function is_elementary (pdg_nr)
	integer, intent(in) :: pdg_nr
	logical :: is_elementary
	end function is_elementary
	<<PDG arrays: procedures>>=
	elemental module function is_elementary (pdg_nr)
	integer, intent(in) :: pdg_nr
	logical :: is_elementary
	if (is_vector (pdg_nr) .or. is_fermion (pdg_nr) .or. pdg_nr == 25) then
	is_elementary = .true.
	else
	is_elementary = .false.
	end if
	end function is_elementary

	@ %def is_elementary
	@ Check if particle is an EW boson or scalar.
	<<PDG arrays: public>>=
	public :: is_ew_boson_scalar
	<<PDG arrays: sub interfaces>>=
	elemental module function is_ew_boson_scalar (pdg_nr)
	integer, intent(in) :: pdg_nr
	logical :: is_ew_boson_scalar
	end function is_ew_boson_scalar
	<<PDG arrays: procedures>>=
	elemental module function is_ew_boson_scalar (pdg_nr)
	integer, intent(in) :: pdg_nr
	logical :: is_ew_boson_scalar
	if (is_photon (pdg_nr) .or. is_massive_vector (pdg_nr) .or. pdg_nr == 25) then
	is_ew_boson_scalar = .true.
	else
	is_ew_boson_scalar = .false.
	end if
	end function is_ew_boson_scalar

	@ %def is_ew_boson_scalar
	@ Check if particle is strongly interacting
	<<PDG arrays: pdg array: TBP>>=
	procedure :: has_colored_particles => pdg_array_has_colored_particles
	<<PDG arrays: sub interfaces>>=
	module function pdg_array_has_colored_particles (pdg) result (colored)
	class(pdg_array_t), intent(in) :: pdg
	logical :: colored
	end function pdg_array_has_colored_particles
	<<PDG arrays: procedures>>=
	module function pdg_array_has_colored_particles (pdg) result (colored)
	class(pdg_array_t), intent(in) :: pdg
	logical :: colored
	integer :: i, pdg_nr
	colored = .false.
	do i = 1, size (pdg%pdg)
	pdg_nr = pdg%pdg(i)
	if (is_quark (pdg_nr) .or. is_gluon (pdg_nr)) then
	colored = .true.
	exit
	end if
	end do
	end function pdg_array_has_colored_particles

	@ %def pdg_array_has_colored_particles
	This function is a convenience function for the determination of
	possible compatibility of flavor structures of processes with certain
	orders of QCD and QED/EW coupling constants. It assumes the Standard
	Model (SM) as underlying physics model.
	The function is based on a naive counting of external particles which
	are connected to the process by the specific kind of couplings depending
	on the underlying theory (QCD and/or QED/EW) of which the corresponding
	particle is a part of. It is constructed in a way that the exclusion of
	coupling power combinations is well-defined.
	<<PDG arrays: public>>=
	public :: query_coupling_powers
	<<PDG arrays: sub interfaces>>=
	module function query_coupling_powers (flv, a_power, as_power) result (valid)
	integer, intent(in), dimension(:) :: flv
	integer, intent(in) :: a_power, as_power
	logical :: valid
	end function query_coupling_powers
	<<PDG arrays: procedures>>=
	module function query_coupling_powers (flv, a_power, as_power) result (valid)
	integer, intent(in), dimension(:) :: flv
	integer, dimension(:, :), allocatable :: power_pair_array
	integer, dimension(2) :: power_pair_ref
	integer, intent(in) :: a_power, as_power
	integer :: i, n_legs, n_gluons, n_quarks, n_gamWZH, n_leptons
	logical, dimension(:), allocatable :: pairs_included
	logical :: valid
	integer :: n_bound
	power_pair_ref = [a_power, as_power]
	n_legs = size (flv)
	allocate (power_pair_array (2, n_legs - 1))
	do i = 1, n_legs - 1
	power_pair_array (1, i) = n_legs - 1 - i
	power_pair_array (2, i) = i - 1
	end do
	allocate (pairs_included (n_legs - 1))
	pairs_included = .true.
	n_gluons = count (is_gluon (flv))
	n_gamWZH = count (is_ew_boson_scalar (flv))
	n_quarks = count (is_quark (flv))
	n_leptons = count (is_lepton (flv))
	if (n_gluons >= 1 .and. n_gluons <= 3) then
	do i = 1, n_gluons
	pairs_included (i) = .false.
	end do
	else if (n_gluons > 2 .and. n_quarks <= 2 .and. n_gluons + n_quarks == n_legs) then
	do i = 1, n_legs - 2
	pairs_included (i) = .false.
	end do
	end if
	n_bound = 0
	if (n_gamWZH + n_leptons == n_legs) then
	n_bound = n_gamWZH + n_leptons - 2
	else if (n_quarks == 2 .and. n_leptons + n_quarks + n_gamWZH == n_legs) then
	n_bound = n_legs - 2
	else if (n_gamWZH + n_leptons > 0) then
	n_bound = n_leptons/2 + n_gamWZH
	end if
	if (n_bound > 0) then
	do i = 1, n_bound
	pairs_included (n_legs - i) = .false.
	end do
	end if
	if (n_quarks == 4 .and. .not. qcd_ew_interferences (flv)) then
	do i = 1, 2
	pairs_included (n_legs - i) = .false.
	end do
	end if
	valid = .false.
	do i = 1, n_legs - 1
	if (all (power_pair_array (:, i) == power_pair_ref) .and. pairs_included (i)) then
	valid = .true.
	exit
	end if
	end do
	end function query_coupling_powers

	@ %def query_coupling_powers
	This functions checks if there is a flavor structure which possibly can
	induce QCD-EW interference amplitudes. It evaluates to [[true]] if there are
	at least 2 quark pairs whereby the quarks of at least one quark pair must
	have the same flavor.
	<<PDG arrays: public>>=
	public :: qcd_ew_interferences
	<<PDG arrays: sub interfaces>>=
	module function qcd_ew_interferences (flv) result (valid)
	integer, intent(in), dimension(:) :: flv
	logical :: valid
	end function qcd_ew_interferences
	<<PDG arrays: procedures>>=
	module function qcd_ew_interferences (flv) result (valid)
	integer, intent(in), dimension(:) :: flv
	integer :: i, n_pairs
	logical :: valid, qqbar_pair
	n_pairs = 0
	valid = .false.
	qqbar_pair = .false.
	if (count (is_quark (flv)) >= 4) then
	do i = DOWN_Q, TOP_Q
	qqbar_pair = count (abs (flv) == i) >= 2
	if (qqbar_pair) n_pairs = n_pairs + 1
	if (n_pairs > 0) then
	valid = .true.
	exit
	end if
	end do
	end if
	end function qcd_ew_interferences

	@ %def qcd_ew_interferences
	@ Assign equivalent cut expression class to PDG code.
	<<PDG arrays: public>>=
	public :: flv_eqv_expr_class
	<<PDG arrays: sub interfaces>>=
	module function flv_eqv_expr_class (flv) result (assign_qgA)
	integer, intent(in) :: flv
	logical, dimension(3) :: assign_qgA
	end function flv_eqv_expr_class
	<<PDG arrays: procedures>>=
	module function flv_eqv_expr_class (flv) result (assign_qgA)
	integer, intent(in) :: flv
	logical, dimension(3) :: assign_qgA
	assign_qgA = [is_quark (flv), is_gluon (flv), is_photon (flv)]
	end function flv_eqv_expr_class

	@ %def flv_eqv_expr_class
	@ Match two arrays. Succeeds if any pair of entries matches.
	<<PDG arrays: sub interfaces>>=
	module function pdg_array_match_pdg_array (aval1, aval2) result (flag)
	logical :: flag
	type(pdg_array_t), intent(in) :: aval1, aval2
	end function pdg_array_match_pdg_array
	<<PDG arrays: procedures>>=
	module function pdg_array_match_pdg_array (aval1, aval2) result (flag)
	logical :: flag
	type(pdg_array_t), intent(in) :: aval1, aval2
	if (allocated (aval1%pdg) .and. allocated (aval2%pdg)) then
	flag = any (aval1 .match. aval2%pdg)
	else
	flag = .false.
	end if
	end function pdg_array_match_pdg_array

	@ %def pdg_array_match_pdg_array
	@ Comparison. Here, we take the PDG arrays as-is, assuming that they
	are sorted.

	The ordering is a bit odd: first, we look only at the absolute values
	of the PDG codes. If they all match, the particle comes before the
	antiparticle, scanning from left to right.
	<<PDG arrays: public>>=
	public :: operator(<)
	public :: operator(>)
	public :: operator(<=)
	public :: operator(>=)
	public :: operator(==)
	public :: operator(/=)
	<<PDG arrays: interfaces>>=
	interface operator(<)
	module procedure pdg_array_lt
	end interface
	interface operator(>)
	module procedure pdg_array_gt
	end interface
	interface operator(<=)
	module procedure pdg_array_le
	end interface
	interface operator(>=)
	module procedure pdg_array_ge
	end interface
	interface operator(==)
	module procedure pdg_array_eq
	end interface
	interface operator(/=)
	module procedure pdg_array_ne
	end interface

	<<PDG arrays: sub interfaces>>=
	elemental module function pdg_array_lt (aval1, aval2) result (flag)
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical :: flag
	end function pdg_array_lt
	elemental module function pdg_array_gt (aval1, aval2) result (flag)
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical :: flag
	end function pdg_array_gt
	elemental module function pdg_array_le (aval1, aval2) result (flag)
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical :: flag
	end function pdg_array_le
	elemental module function pdg_array_ge (aval1, aval2) result (flag)
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical :: flag
	end function pdg_array_ge
	elemental module function pdg_array_eq (aval1, aval2) result (flag)
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical :: flag
	end function pdg_array_eq
	elemental module function pdg_array_ne (aval1, aval2) result (flag)
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical :: flag
	end function pdg_array_ne
	<<PDG arrays: procedures>>=
	elemental module function pdg_array_lt (aval1, aval2) result (flag)
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical :: flag
	integer :: i
	if (size (aval1%pdg) /= size (aval2%pdg)) then
	flag = size (aval1%pdg) < size (aval2%pdg)
	else
	do i = 1, size (aval1%pdg)
	if (abs (aval1%pdg(i)) /= abs (aval2%pdg(i))) then
	flag = abs (aval1%pdg(i)) < abs (aval2%pdg(i))
	return
	end if
	end do
	do i = 1, size (aval1%pdg)
	if (aval1%pdg(i) /= aval2%pdg(i)) then
	flag = aval1%pdg(i) > aval2%pdg(i)
	return
	end if
	end do
	flag = .false.
	end if
	end function pdg_array_lt

	elemental module function pdg_array_gt (aval1, aval2) result (flag)
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical :: flag
	flag = .not. (aval1 < aval2 .or. aval1 == aval2)
	end function pdg_array_gt

	elemental module function pdg_array_le (aval1, aval2) result (flag)
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical :: flag
	flag = aval1 < aval2 .or. aval1 == aval2
	end function pdg_array_le

	elemental module function pdg_array_ge (aval1, aval2) result (flag)
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical :: flag
	flag = .not. (aval1 < aval2)
	end function pdg_array_ge

	elemental module function pdg_array_eq (aval1, aval2) result (flag)
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical :: flag
	if (size (aval1%pdg) /= size (aval2%pdg)) then
	flag = .false.
	else
	flag = all (aval1%pdg == aval2%pdg)
	end if
	end function pdg_array_eq

	elemental module function pdg_array_ne (aval1, aval2) result (flag)
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical :: flag
	flag = .not. (aval1 == aval2)
	end function pdg_array_ne

	@ Equivalence. Two PDG arrays are equivalent if either one contains
	[[UNDEFINED]] or if each element of array 1 is present in array 2, and
	vice versa.
	<<PDG arrays: public>>=
	public :: operator(.eqv.)
	public :: operator(.neqv.)
	<<PDG arrays: interfaces>>=
	interface operator(.eqv.)
	module procedure pdg_array_equivalent
	end interface
	interface operator(.neqv.)
	module procedure pdg_array_inequivalent
	end interface

	<<PDG arrays: sub interfaces>>=
	elemental module function pdg_array_equivalent (aval1, aval2) result (eq)
	logical :: eq
	type(pdg_array_t), intent(in) :: aval1, aval2
	end function pdg_array_equivalent
	elemental module function pdg_array_inequivalent (aval1, aval2) result (neq)
	logical :: neq
	type(pdg_array_t), intent(in) :: aval1, aval2
	end function pdg_array_inequivalent
	<<PDG arrays: procedures>>=
	elemental module function pdg_array_equivalent (aval1, aval2) result (eq)
	logical :: eq
	type(pdg_array_t), intent(in) :: aval1, aval2
	logical, dimension(:), allocatable :: match1, match2
	integer :: i
	if (allocated (aval1%pdg) .and. allocated (aval2%pdg)) then
	eq = any (aval1%pdg == UNDEFINED) &
	.or. any (aval2%pdg == UNDEFINED)
	if (.not. eq) then
	allocate (match1 (size (aval1%pdg)))
	allocate (match2 (size (aval2%pdg)))
	match1 = .false.
	match2 = .false.
	do i = 1, size (aval1%pdg)
	match2 = match2 .or. aval1%pdg(i) == aval2%pdg
	end do
	do i = 1, size (aval2%pdg)
	match1 = match1 .or. aval2%pdg(i) == aval1%pdg
	end do
	eq = all (match1) .and. all (match2)
	end if
	else
	eq = .false.
	end if
	end function pdg_array_equivalent

	elemental module function pdg_array_inequivalent (aval1, aval2) result (neq)
	logical :: neq
	type(pdg_array_t), intent(in) :: aval1, aval2
	neq = .not. pdg_array_equivalent (aval1, aval2)
	end function pdg_array_inequivalent

	@ %def pdg_array_equivalent
	@
	\subsection{Sorting}
	Sort a PDG array by absolute value, particle before antiparticle. After
	sorting, we eliminate double entries.
	<<PDG arrays: public>>=
	public :: sort_abs
	<<PDG arrays: interfaces>>=
	interface sort_abs
	module procedure pdg_array_sort_abs
	end interface

	<<PDG arrays: pdg array: TBP>>=
	procedure :: sort_abs => pdg_array_sort_abs
	<<PDG arrays: sub interfaces>>=
	module function pdg_array_sort_abs (aval1, unique) result (aval2)
	class(pdg_array_t), intent(in) :: aval1
	logical, intent(in), optional :: unique
	type(pdg_array_t) :: aval2
	end function pdg_array_sort_abs
	<<PDG arrays: procedures>>=
	module function pdg_array_sort_abs (aval1, unique) result (aval2)
	class(pdg_array_t), intent(in) :: aval1
	logical, intent(in), optional :: unique
	type(pdg_array_t) :: aval2
	integer, dimension(:), allocatable :: tmp
	logical, dimension(:), allocatable :: mask
	integer :: i, n
	logical :: uni
	uni = .false.; if (present (unique)) uni = unique
	n = size (aval1%pdg)
	if (uni) then
	allocate (tmp (n), mask(n))
	tmp = sort_abs (aval1%pdg)
	mask(1) = .true.
	do i = 2, n
	mask(i) = tmp(i) /= tmp(i-1)
	end do
	allocate (aval2%pdg (count (mask)))
	aval2%pdg = pack (tmp, mask)
	else
	allocate (aval2%pdg (n))
	aval2%pdg = sort_abs (aval1%pdg)
	end if
	end function pdg_array_sort_abs

	@ %def sort_abs
	@
	<<PDG arrays: pdg array: TBP>>=
	procedure :: intersect => pdg_array_intersect
	<<PDG arrays: sub interfaces>>=
	module function pdg_array_intersect (aval1, match) result (aval2)
	class(pdg_array_t), intent(in) :: aval1
	integer, dimension(:) :: match
	type(pdg_array_t) :: aval2
	end function pdg_array_intersect
	<<PDG arrays: procedures>>=
	module function pdg_array_intersect (aval1, match) result (aval2)
	class(pdg_array_t), intent(in) :: aval1
	integer, dimension(:) :: match
	type(pdg_array_t) :: aval2
	integer, dimension(:), allocatable :: isec
	integer :: i
	isec = pack (aval1%pdg, [(any(aval1%pdg(i) == match), i=1,size(aval1%pdg))])
	call pdg_array_from_int_array (aval2, isec)
	end function pdg_array_intersect

	@ %def pdg_array_intersect
	@
	<<PDG arrays: pdg array: TBP>>=
	procedure :: search_for_particle => pdg_array_search_for_particle
	<<PDG arrays: sub interfaces>>=
	elemental module function pdg_array_search_for_particle (pdg, i_part) result (found)
	class(pdg_array_t), intent(in) :: pdg
	integer, intent(in) :: i_part
	logical :: found
	end function pdg_array_search_for_particle
	<<PDG arrays: procedures>>=
	elemental module function pdg_array_search_for_particle (pdg, i_part) result (found)
	class(pdg_array_t), intent(in) :: pdg
	integer, intent(in) :: i_part
	logical :: found
	found = any (pdg%pdg == i_part)
	end function pdg_array_search_for_particle

	@ %def pdg_array_search_for_particle
	@
	<<PDG arrays: pdg array: TBP>>=
	procedure :: invert => pdg_array_invert
	<<PDG arrays: sub interfaces>>=
	module function pdg_array_invert (pdg) result (pdg_inverse)
	class(pdg_array_t), intent(in) :: pdg
	type(pdg_array_t) :: pdg_inverse
	end function pdg_array_invert
	<<PDG arrays: procedures>>=
	module function pdg_array_invert (pdg) result (pdg_inverse)
	class(pdg_array_t), intent(in) :: pdg
	type(pdg_array_t) :: pdg_inverse
	integer :: i, n
	n = size (pdg%pdg)
	allocate (pdg_inverse%pdg (n))
	do i = 1, n
	select case (pdg%pdg(i))
	case (GLUON, PHOTON, Z_BOSON, 25)
	pdg_inverse%pdg(i) = pdg%pdg(i)
	case default
	pdg_inverse%pdg(i) = -pdg%pdg(i)
	end select
	end do
	end function pdg_array_invert

	@ %def pdg_array_invert
	@
	\subsection{PDG array list}
	A PDG array list, or PDG list, is an array of PDG-array objects with
	some convenience methods.
	<<PDG arrays: public>>=
	public :: pdg_list_t
	<<PDG arrays: types>>=
	type :: pdg_list_t
	type(pdg_array_t), dimension(:), allocatable :: a
	contains
	<<PDG arrays: pdg list: TBP>>
	end type pdg_list_t

	@ %def pdg_list_t
	@ Output, as a comma-separated list without advancing I/O.
	<<PDG arrays: pdg list: TBP>>=
	procedure :: write => pdg_list_write
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_list_write (object, unit)
	class(pdg_list_t), intent(in) :: object
	integer, intent(in), optional :: unit
	end subroutine pdg_list_write
	<<PDG arrays: procedures>>=
	module subroutine pdg_list_write (object, unit)
	class(pdg_list_t), intent(in) :: object
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit)
	if (allocated (object%a)) then
	do i = 1, size (object%a)
	if (i > 1) write (u, "(A)", advance="no") ", "
	call object%a(i)%write (u)
	end do
	end if
	end subroutine pdg_list_write

	@ %def pdg_list_write
	@ Initialize for a certain size. The entries are initially empty PDG arrays.
	<<PDG arrays: pdg list: TBP>>=
	generic :: init => pdg_list_init_size
	procedure, private :: pdg_list_init_size
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_list_init_size (pl, n)
	class(pdg_list_t), intent(out) :: pl
	integer, intent(in) :: n
	end subroutine pdg_list_init_size
	<<PDG arrays: procedures>>=
	module subroutine pdg_list_init_size (pl, n)
	class(pdg_list_t), intent(out) :: pl
	integer, intent(in) :: n
	allocate (pl%a (n))
	end subroutine pdg_list_init_size

	@ %def pdg_list_init_size
	@ Initialize with a definite array of PDG codes. That is, each entry
	in the list becomes a single-particle PDG array.
	<<PDG arrays: pdg list: TBP>>=
	generic :: init => pdg_list_init_int_array
	procedure, private :: pdg_list_init_int_array
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_list_init_int_array (pl, pdg)
	class(pdg_list_t), intent(out) :: pl
	integer, dimension(:), intent(in) :: pdg
	end subroutine pdg_list_init_int_array
	<<PDG arrays: procedures>>=
	module subroutine pdg_list_init_int_array (pl, pdg)
	class(pdg_list_t), intent(out) :: pl
	integer, dimension(:), intent(in) :: pdg
	integer :: i
	allocate (pl%a (size (pdg)))
	do i = 1, size (pdg)
	call pdg_array_from_int (pl%a(i), pdg(i))
	end do
	end subroutine pdg_list_init_int_array

	@ %def pdg_list_init_array
	@ Set one of the entries. No bounds-check.
	<<PDG arrays: pdg list: TBP>>=
	generic :: set => pdg_list_set_int
	generic :: set => pdg_list_set_int_array
	generic :: set => pdg_list_set_pdg_array
	procedure, private :: pdg_list_set_int
	procedure, private :: pdg_list_set_int_array
	procedure, private :: pdg_list_set_pdg_array
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_list_set_int (pl, i, pdg)
	class(pdg_list_t), intent(inout) :: pl
	integer, intent(in) :: i
	integer, intent(in) :: pdg
	end subroutine pdg_list_set_int
	module subroutine pdg_list_set_int_array (pl, i, pdg)
	class(pdg_list_t), intent(inout) :: pl
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: pdg
	end subroutine pdg_list_set_int_array
	module subroutine pdg_list_set_pdg_array (pl, i, pa)
	class(pdg_list_t), intent(inout) :: pl
	integer, intent(in) :: i
	type(pdg_array_t), intent(in) :: pa
	end subroutine pdg_list_set_pdg_array
	<<PDG arrays: procedures>>=
	module subroutine pdg_list_set_int (pl, i, pdg)
	class(pdg_list_t), intent(inout) :: pl
	integer, intent(in) :: i
	integer, intent(in) :: pdg
	call pdg_array_from_int (pl%a(i), pdg)
	end subroutine pdg_list_set_int

	module subroutine pdg_list_set_int_array (pl, i, pdg)
	class(pdg_list_t), intent(inout) :: pl
	integer, intent(in) :: i
	integer, dimension(:), intent(in) :: pdg
	call pdg_array_from_int_array (pl%a(i), pdg)
	end subroutine pdg_list_set_int_array

	module subroutine pdg_list_set_pdg_array (pl, i, pa)
	class(pdg_list_t), intent(inout) :: pl
	integer, intent(in) :: i
	type(pdg_array_t), intent(in) :: pa
	pl%a(i) = pa
	end subroutine pdg_list_set_pdg_array

	@ %def pdg_list_set
	@ Array size, not the length of individual entries
	<<PDG arrays: pdg list: TBP>>=
	procedure :: get_size => pdg_list_get_size
	<<PDG arrays: sub interfaces>>=
	module function pdg_list_get_size (pl) result (n)
	class(pdg_list_t), intent(in) :: pl
	integer :: n
	end function pdg_list_get_size
	<<PDG arrays: procedures>>=
	module function pdg_list_get_size (pl) result (n)
	class(pdg_list_t), intent(in) :: pl
	integer :: n
	if (allocated (pl%a)) then
	n = size (pl%a)
	else
	n = 0
	end if
	end function pdg_list_get_size

	@ %def pdg_list_get_size
	@ Return an entry, as a PDG array.
	<<PDG arrays: pdg list: TBP>>=
	procedure :: get => pdg_list_get
	<<PDG arrays: sub interfaces>>=
	module function pdg_list_get (pl, i) result (pa)
	type(pdg_array_t) :: pa
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: i
	end function pdg_list_get
	<<PDG arrays: procedures>>=
	module function pdg_list_get (pl, i) result (pa)
	type(pdg_array_t) :: pa
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: i
	pa = pl%a(i)
	end function pdg_list_get

	@ %def pdg_list_get
	@ Check if the list entries are all either mutually disjoint or identical.
	The individual entries (PDG arrays) should already be sorted, so we can test
	for equality.
	<<PDG arrays: pdg list: TBP>>=
	procedure :: is_regular => pdg_list_is_regular
	<<PDG arrays: sub interfaces>>=
	module function pdg_list_is_regular (pl) result (flag)
	class(pdg_list_t), intent(in) :: pl
	logical :: flag
	end function pdg_list_is_regular
	<<PDG arrays: procedures>>=
	module function pdg_list_is_regular (pl) result (flag)
	class(pdg_list_t), intent(in) :: pl
	logical :: flag
	integer :: i, j, s
	s = pl%get_size ()
	flag = .true.
	do i = 1, s
	do j = i + 1, s
	if (pl%a(i) .match. pl%a(j)) then
	if (pl%a(i) /= pl%a(j)) then
	flag = .false.
	return
	end if
	end if
	end do
	end do
	end function pdg_list_is_regular

	@ %def pdg_list_is_regular
	@ Sort the list. First, each entry gets sorted, including elimination
	of doublers. Then, we sort the list, using the first member of each
	PDG array as the marker. No removal of doublers at this stage.

	If [[n_in]] is supplied, we do not reorder the first [[n_in]] particle
	entries.
	<<PDG arrays: pdg list: TBP>>=
	procedure :: sort_abs => pdg_list_sort_abs
	<<PDG arrays: sub interfaces>>=
	module function pdg_list_sort_abs (pl, n_in) result (pl_sorted)
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in), optional :: n_in
	type(pdg_list_t) :: pl_sorted
	end function pdg_list_sort_abs
	<<PDG arrays: procedures>>=
	module function pdg_list_sort_abs (pl, n_in) result (pl_sorted)
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in), optional :: n_in
	type(pdg_list_t) :: pl_sorted
	type(pdg_array_t), dimension(:), allocatable :: pa
	integer, dimension(:), allocatable :: pdg, map
	integer :: i, n0
	call pl_sorted%init (pl%get_size ())
	if (allocated (pl%a)) then
	allocate (pa (size (pl%a)))
	do i = 1, size (pl%a)
	pa(i) = pl%a(i)%sort_abs (unique = .true.)
	end do
	allocate (pdg (size (pa)), source = 0)
	do i = 1, size (pa)
	if (allocated (pa(i)%pdg)) then
	if (size (pa(i)%pdg) > 0) then
	pdg(i) = pa(i)%pdg(1)
	end if
	end if
	end do
	if (present (n_in)) then
	n0 = n_in
	else
	n0 = 0
	end if
	allocate (map (size (pdg)))
	map(:n0) = [(i, i = 1, n0)]
	map(n0+1:) = n0 + order_abs (pdg(n0+1:))
	do i = 1, size (pa)
	call pl_sorted%set (i, pa(map(i)))
	end do
	end if
	end function pdg_list_sort_abs

	@ %def pdg_list_sort_abs
	@ Compare sorted lists: equality. The result is undefined if some entries
	are not allocated.
	<<PDG arrays: pdg list: TBP>>=
	generic :: operator (==) => pdg_list_eq
	procedure, private :: pdg_list_eq
	<<PDG arrays: sub interfaces>>=
	module function pdg_list_eq (pl1, pl2) result (flag)
	class(pdg_list_t), intent(in) :: pl1, pl2
	logical :: flag
	end function pdg_list_eq
	<<PDG arrays: procedures>>=
	module function pdg_list_eq (pl1, pl2) result (flag)
	class(pdg_list_t), intent(in) :: pl1, pl2
	logical :: flag
	integer :: i
	flag = .false.
	if (allocated (pl1%a) .and. allocated (pl2%a)) then
	if (size (pl1%a) == size (pl2%a)) then
	do i = 1, size (pl1%a)
	associate (a1 => pl1%a(i), a2 => pl2%a(i))
	if (allocated (a1%pdg) .and. allocated (a2%pdg)) then
	if (size (a1%pdg) == size (a2%pdg)) then
	if (size (a1%pdg) > 0) then
	if (a1%pdg(1) /= a2%pdg(1)) return
	end if
	else
	return
	end if
	else
	return
	end if
	end associate
	end do
	flag = .true.
	end if
	end if
	end function pdg_list_eq

	@ %def pdg_list_eq
	@ Compare sorted lists. The result is undefined if some entries
	are not allocated.

	The ordering is quite complicated. First, a shorter list comes before
	a longer list. Comparing entry by entry, a shorter entry comes
	first. Next, we check the first PDG code within corresponding
	entries. This is compared by absolute value. If equal, particle
	comes before antiparticle. Finally, if all is equal, the result is
	false.
	<<PDG arrays: pdg list: TBP>>=
	generic :: operator (<) => pdg_list_lt
	procedure, private :: pdg_list_lt
	<<PDG arrays: sub interfaces>>=
	module function pdg_list_lt (pl1, pl2) result (flag)
	class(pdg_list_t), intent(in) :: pl1, pl2
	logical :: flag
	end function pdg_list_lt
	<<PDG arrays: procedures>>=
	module function pdg_list_lt (pl1, pl2) result (flag)
	class(pdg_list_t), intent(in) :: pl1, pl2
	logical :: flag
	integer :: i
	flag = .false.
	if (allocated (pl1%a) .and. allocated (pl2%a)) then
	if (size (pl1%a) < size (pl2%a)) then
	flag = .true.; return
	else if (size (pl1%a) > size (pl2%a)) then
	return
	else
	do i = 1, size (pl1%a)
	associate (a1 => pl1%a(i), a2 => pl2%a(i))
	if (allocated (a1%pdg) .and. allocated (a2%pdg)) then
	if (size (a1%pdg) < size (a2%pdg)) then
	flag = .true.; return
	else if (size (a1%pdg) > size (a2%pdg)) then
	return
	else
	if (size (a1%pdg) > 0) then
	if (abs (a1%pdg(1)) < abs (a2%pdg(1))) then
	flag = .true.; return
	else if (abs (a1%pdg(1)) > abs (a2%pdg(1))) then
	return
	else if (a1%pdg(1) > 0 .and. a2%pdg(1) < 0) then
	flag = .true.; return
	else if (a1%pdg(1) < 0 .and. a2%pdg(1) > 0) then
	return
	end if
	end if
	end if
	else
	return
	end if
	end associate
	end do
	flag = .false.
	end if
	end if
	end function pdg_list_lt

	@ %def pdg_list_lt
	@ Replace an entry. In the result, the entry [[#i]] is replaced by
	the contents of the second argument. The result is not sorted.

	If [[n_in]] is also set and [[i]] is less or equal to [[n_in]],
	replace [[#i]] only by the first entry of [[pl_insert]], and insert
	the remainder after entry [[n_in]].
	<<PDG arrays: pdg list: TBP>>=
	procedure :: replace => pdg_list_replace
	<<PDG arrays: sub interfaces>>=
	module function pdg_list_replace (pl, i, pl_insert, n_in) result (pl_out)
	type(pdg_list_t) :: pl_out
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: i
	class(pdg_list_t), intent(in) :: pl_insert
	integer, intent(in), optional :: n_in
	end function pdg_list_replace
	<<PDG arrays: procedures>>=
	module function pdg_list_replace (pl, i, pl_insert, n_in) result (pl_out)
	type(pdg_list_t) :: pl_out
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: i
	class(pdg_list_t), intent(in) :: pl_insert
	integer, intent(in), optional :: n_in
	integer :: n, n_insert, n_out, k
	n = pl%get_size ()
	n_insert = pl_insert%get_size ()
	n_out = n + n_insert - 1
	call pl_out%init (n_out)
	! if (allocated (pl%a)) then
	do k = 1, i - 1
	pl_out%a(k) = pl%a(k)
	end do
	! end if
	if (present (n_in)) then
	pl_out%a(i) = pl_insert%a(1)
	do k = i + 1, n_in
	pl_out%a(k) = pl%a(k)
	end do
	do k = 1, n_insert - 1
	pl_out%a(n_in+k) = pl_insert%a(1+k)
	end do
	do k = 1, n - n_in
	pl_out%a(n_in+k+n_insert-1) = pl%a(n_in+k)
	end do
	else
	! if (allocated (pl_insert%a)) then
	do k = 1, n_insert
	pl_out%a(i-1+k) = pl_insert%a(k)
	end do
	! end if
	! if (allocated (pl%a)) then
	do k = 1, n - i
	pl_out%a(i+n_insert-1+k) = pl%a(i+k)
	end do
	end if
	! end if
	end function pdg_list_replace

	@ %def pdg_list_replace
	@
	<<PDG arrays: pdg list: TBP>>=
	procedure :: fusion => pdg_list_fusion
	<<PDG arrays: sub interfaces>>=
	module function pdg_list_fusion (pl, pl_insert, i, check_if_existing) result (pl_out)
	type(pdg_list_t) :: pl_out
	class(pdg_list_t), intent(in) :: pl
	type(pdg_list_t), intent(in) :: pl_insert
	integer, intent(in) :: i
	logical, intent(in) :: check_if_existing
	end function pdg_list_fusion
	<<PDG arrays: procedures>>=
	module function pdg_list_fusion (pl, pl_insert, i, check_if_existing) result (pl_out)
	type(pdg_list_t) :: pl_out
	class(pdg_list_t), intent(in) :: pl
	type(pdg_list_t), intent(in) :: pl_insert
	integer, intent(in) :: i
	logical, intent(in) :: check_if_existing
	integer :: n, n_insert, k, n_out
	logical :: new_pdg
	n = pl%get_size ()
	n_insert = pl_insert%get_size ()
	new_pdg = .not. check_if_existing .or. &
	(.not. any (pl%search_for_particle (pl_insert%a(1)%pdg)))
	call pl_out%init (n + n_insert - 1)
	do k = 1, n
	if (new_pdg .and. k == i) then
	pl_out%a(k) = pl%a(k)%add (pl_insert%a(1))
	else
	pl_out%a(k) = pl%a(k)
	end if
	end do
	do k = n + 1, n + n_insert - 1
	pl_out%a(k) = pl_insert%a(k-n)
	end do
	end function pdg_list_fusion

	@ %def pdg_list_fusion
	@
	<<PDG arrays: pdg list: TBP>>=
	procedure :: get_pdg_sizes => pdg_list_get_pdg_sizes
	<<PDG arrays: sub interfaces>>=
	module function pdg_list_get_pdg_sizes (pl) result (i_size)
	integer, dimension(:), allocatable :: i_size
	class(pdg_list_t), intent(in) :: pl
	end function pdg_list_get_pdg_sizes
	<<PDG arrays: procedures>>=
	module function pdg_list_get_pdg_sizes (pl) result (i_size)
	integer, dimension(:), allocatable :: i_size
	class(pdg_list_t), intent(in) :: pl
	integer :: i, n
	n = pl%get_size ()
	allocate (i_size (n))
	do i = 1, n
	i_size(i) = size (pl%a(i)%pdg)
	end do
	end function pdg_list_get_pdg_sizes

	@ %def pdg_list_get_pdg_sizes
	@ Replace the entries of [[pl]] by the matching entries of [[pl_match]], one by
	one. This is done in-place. If there is no match, return failure.
	<<PDG arrays: pdg list: TBP>>=
	procedure :: match_replace => pdg_list_match_replace
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_list_match_replace (pl, pl_match, success)
	class(pdg_list_t), intent(inout) :: pl
	class(pdg_list_t), intent(in) :: pl_match
	logical, intent(out) :: success
	end subroutine pdg_list_match_replace
	<<PDG arrays: procedures>>=
	module subroutine pdg_list_match_replace (pl, pl_match, success)
	class(pdg_list_t), intent(inout) :: pl
	class(pdg_list_t), intent(in) :: pl_match
	logical, intent(out) :: success
	integer :: i, j
	success = .true.
	SCAN_ENTRIES: do i = 1, size (pl%a)
	do j = 1, size (pl_match%a)
	if (pl%a(i) .match. pl_match%a(j)) then
	pl%a(i) = pl_match%a(j)
	cycle SCAN_ENTRIES
	end if
	end do
	success = .false.
	return
	end do SCAN_ENTRIES
	end subroutine pdg_list_match_replace

	@ %def pdg_list_match_replace
	@ Just check if a PDG array matches any entry in the PDG list. The second
	version returns the position of the match within the list. An optional mask
	indicates the list elements that should be checked.
	<<PDG arrays: pdg list: TBP>>=
	generic :: operator (.match.) => pdg_list_match_pdg_array
	procedure, private :: pdg_list_match_pdg_array
	procedure :: find_match => pdg_list_find_match_pdg_array
	<<PDG arrays: sub interfaces>>=
	module function pdg_list_match_pdg_array (pl, pa) result (flag)
	class(pdg_list_t), intent(in) :: pl
	type(pdg_array_t), intent(in) :: pa
	logical :: flag
	end function pdg_list_match_pdg_array
	module function pdg_list_find_match_pdg_array (pl, pa, mask) result (i)
	class(pdg_list_t), intent(in) :: pl
	type(pdg_array_t), intent(in) :: pa
	logical, dimension(:), intent(in), optional :: mask
	integer :: i
	end function pdg_list_find_match_pdg_array
	<<PDG arrays: procedures>>=
	module function pdg_list_match_pdg_array (pl, pa) result (flag)
	class(pdg_list_t), intent(in) :: pl
	type(pdg_array_t), intent(in) :: pa
	logical :: flag
	flag = pl%find_match (pa) /= 0
	end function pdg_list_match_pdg_array

	module function pdg_list_find_match_pdg_array (pl, pa, mask) result (i)
	class(pdg_list_t), intent(in) :: pl
	type(pdg_array_t), intent(in) :: pa
	logical, dimension(:), intent(in), optional :: mask
	integer :: i
	do i = 1, size (pl%a)
	if (present (mask)) then
	if (.not. mask(i)) cycle
	end if
	if (pl%a(i) .match. pa) return
	end do
	i = 0
	end function pdg_list_find_match_pdg_array

	@ %def pdg_list_match_pdg_array
	@ %def pdg_list_find_match_pdg_array
	@ Some old compilers have problems with allocatable arrays as
	intent(out) or as function result, so be conservative here:
	<<PDG arrays: pdg list: TBP>>=
	procedure :: create_pdg_array => pdg_list_create_pdg_array
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_list_create_pdg_array (pl, pdg)
	class(pdg_list_t), intent(in) :: pl
	type(pdg_array_t), dimension(:), intent(inout), allocatable :: pdg
	end subroutine pdg_list_create_pdg_array
	<<PDG arrays: procedures>>=
	module subroutine pdg_list_create_pdg_array (pl, pdg)
	class(pdg_list_t), intent(in) :: pl
	type(pdg_array_t), dimension(:), intent(inout), allocatable :: pdg
	integer :: n_elements
	integer :: i
	associate (a => pl%a)
	n_elements = size (a)
	if (allocated (pdg)) deallocate (pdg)
	allocate (pdg (n_elements))
	do i = 1, n_elements
	pdg(i) = a(i)
	end do
	end associate
	end subroutine pdg_list_create_pdg_array

	@ %def pdg_list_create_pdg_array
	@
	<<PDG arrays: pdg list: TBP>>=
	procedure :: create_antiparticles => pdg_list_create_antiparticles
	<<PDG arrays: sub interfaces>>=
	module subroutine pdg_list_create_antiparticles (pl, pl_anti, n_new_particles)
	class(pdg_list_t), intent(in) :: pl
	type(pdg_list_t), intent(out) :: pl_anti
	integer, intent(out) :: n_new_particles
	end subroutine pdg_list_create_antiparticles
	<<PDG arrays: procedures>>=
	module subroutine pdg_list_create_antiparticles (pl, pl_anti, n_new_particles)
	class(pdg_list_t), intent(in) :: pl
	type(pdg_list_t), intent(out) :: pl_anti
	integer, intent(out) :: n_new_particles
	type(pdg_list_t) :: pl_inverse
	integer :: i, n
	integer :: n_identical
	logical, dimension(:), allocatable :: collect
	n = pl%get_size (); n_identical = 0
	allocate (collect (n)); collect = .true.
	call pl_inverse%init (n)
	do i = 1, n
	pl_inverse%a(i) = pl%a(i)%invert()
	end do
	do i = 1, n
	if (any (pl_inverse%a(i) == pl%a)) then
	collect(i) = .false.
	n_identical = n_identical + 1
	end if
	end do
	n_new_particles = n - n_identical
	if (n_new_particles > 0) then
	call pl_anti%init (n_new_particles)
	do i = 1, n
	if (collect (i)) pl_anti%a(i) = pl_inverse%a(i)
	end do
	end if
	end subroutine pdg_list_create_antiparticles

	@ %def pdg_list_create_antiparticles
	@
	<<PDG arrays: pdg list: TBP>>=
	procedure :: search_for_particle => pdg_list_search_for_particle
	<<PDG arrays: sub interfaces>>=
	elemental module function pdg_list_search_for_particle (pl, i_part) result (found)
	logical :: found
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: i_part
	end function pdg_list_search_for_particle
	<<PDG arrays: procedures>>=
	elemental module function pdg_list_search_for_particle (pl, i_part) result (found)
	logical :: found
	class(pdg_list_t), intent(in) :: pl
	integer, intent(in) :: i_part
	integer :: i_pl
	do i_pl = 1, size (pl%a)
	found = pl%a(i_pl)%search_for_particle (i_part)
	if (found) return
	end do
	end function pdg_list_search_for_particle

	@ %def pdg_list_search_for_particle
	@
	<<PDG arrays: pdg list: TBP>>=
	procedure :: contains_colored_particles => pdg_list_contains_colored_particles
	<<PDG arrays: sub interfaces>>=
	module function pdg_list_contains_colored_particles (pl) result (colored)
	class(pdg_list_t), intent(in) :: pl
	logical :: colored
	end function pdg_list_contains_colored_particles
	<<PDG arrays: procedures>>=
	module function pdg_list_contains_colored_particles (pl) result (colored)
	class(pdg_list_t), intent(in) :: pl
	logical :: colored
	integer :: i
	colored = .false.
	do i = 1, size (pl%a)
	if (pl%a(i)%has_colored_particles()) then
	colored = .true.
	exit
	end if
	end do
	end function pdg_list_contains_colored_particles

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

	module pdg_arrays_ut
	use unit_tests
	use pdg_arrays_uti

	<<Standard module head>>

	<<PDG arrays: public test>>

	contains

	<<PDG arrays: test driver>>

	end module pdg_arrays_ut
	@ %def pdg_arrays_ut
	@
	<<[[pdg_arrays_uti.f90]]>>=
	<<File header>>

	module pdg_arrays_uti

	use pdg_arrays

	<<Standard module head>>

	<<PDG arrays: test declarations>>

	contains

	<<PDG arrays: tests>>

	end module pdg_arrays_uti
	@ %def pdg_arrays_ut
	@ API: driver for the unit tests below.
	<<PDG arrays: public test>>=
	public :: pdg_arrays_test
	<<PDG arrays: test driver>>=
	subroutine pdg_arrays_test (u, results)
	integer, intent(in) :: u
	type (test_results_t), intent(inout) :: results
	<<PDG arrays: execute tests>>
	end subroutine pdg_arrays_test

	@ %def pdg_arrays_test
	@ Basic functionality.
	<<PDG arrays: execute tests>>=
	call test (pdg_arrays_1, "pdg_arrays_1", &
	"create and sort PDG array", &
	u, results)
	<<PDG arrays: test declarations>>=
	public :: pdg_arrays_1
	<<PDG arrays: tests>>=
	subroutine pdg_arrays_1 (u)
	integer, intent(in) :: u

	type(pdg_array_t) :: pa, pa1, pa2, pa3, pa4, pa5, pa6
	integer, dimension(:), allocatable :: pdg

	write (u, "(A)") "* Test output: pdg_arrays_1"
	write (u, "(A)") "* Purpose: create and sort PDG arrays"
	write (u, "(A)")

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

	call pa%write (u)
	write (u, *)
	write (u, "(A,I0)") "length = ", pa%get_length ()
	pdg = pa
	write (u, "(A,3(1x,I0))") "contents = ", pdg

	write (u, *)
	pa = 1
	call pa%write (u)
	write (u, *)
	write (u, "(A,I0)") "length = ", pa%get_length ()
	pdg = pa
	write (u, "(A,3(1x,I0))") "contents = ", pdg

	write (u, *)
	pa = [1, 2, 3]
	call pa%write (u)
	write (u, *)
	write (u, "(A,I0)") "length = ", pa%get_length ()
	pdg = pa
	write (u, "(A,3(1x,I0))") "contents = ", pdg
	write (u, "(A,I0)") "element #2 = ", pa%get (2)

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

	pa = pa%replace (2, [-5, 5, -7])
	call pa%write (u)
	write (u, *)

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

	pa = [1, -7, 3, -5, 5, 3]
	call pa%write (u)
	write (u, *)
	pa1 = pa%sort_abs ()
	pa2 = pa%sort_abs (unique = .true.)
	call pa1%write (u)
	write (u, *)
	call pa2%write (u)
	write (u, *)

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

	pa1 = [1, 3]
	pa2 = [1, 2, -2]
	pa3 = [1, 2, 4]
	pa4 = [1, 2, 4]
	pa5 = [1, 2, -4]
	pa6 = [1, 2, -3]

	write (u, "(A,6(1x,L1))") "< ", &
	pa1 < pa2, pa2 < pa3, pa3 < pa4, pa4 < pa5, pa5 < pa6, pa6 < pa1
	write (u, "(A,6(1x,L1))") "> ", &
	pa1 > pa2, pa2 > pa3, pa3 > pa4, pa4 > pa5, pa5 > pa6, pa6 > pa1
	write (u, "(A,6(1x,L1))") "<=", &
	pa1 <= pa2, pa2 <= pa3, pa3 <= pa4, pa4 <= pa5, pa5 <= pa6, pa6 <= pa1
	write (u, "(A,6(1x,L1))") ">=", &
	pa1 >= pa2, pa2 >= pa3, pa3 >= pa4, pa4 >= pa5, pa5 >= pa6, pa6 >= pa1
	write (u, "(A,6(1x,L1))") "==", &
	pa1 == pa2, pa2 == pa3, pa3 == pa4, pa4 == pa5, pa5 == pa6, pa6 == pa1
	write (u, "(A,6(1x,L1))") "/=", &
	pa1 /= pa2, pa2 /= pa3, pa3 /= pa4, pa4 /= pa5, pa5 /= pa6, pa6 /= pa1

	write (u, *)
	pa1 = [0]
	pa2 = [1, 2]
	pa3 = [1, -2]

	write (u, "(A,6(1x,L1))") "eqv ", &
	pa1 .eqv. pa1, pa1 .eqv. pa2, &
	pa2 .eqv. pa2, pa2 .eqv. pa3

	write (u, "(A,6(1x,L1))") "neqv", &
	pa1 .neqv. pa1, pa1 .neqv. pa2, &
	pa2 .neqv. pa2, pa2 .neqv. pa3


	write (u, *)
	write (u, "(A,6(1x,L1))") "match", &
	pa1 .match. 0, pa1 .match. 1, &
	pa2 .match. 0, pa2 .match. 1, pa2 .match. 3

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

	end subroutine pdg_arrays_1

	@ %def pdg_arrays_1
	@ PDG array list, i.e., arrays of arrays.
	<<PDG arrays: execute tests>>=
	call test (pdg_arrays_2, "pdg_arrays_2", &
	"create and sort PDG lists", &
	u, results)
	<<PDG arrays: test declarations>>=
	public :: pdg_arrays_2
	<<PDG arrays: tests>>=
	subroutine pdg_arrays_2 (u)
	integer, intent(in) :: u

	type(pdg_array_t) :: pa
	type(pdg_list_t) :: pl, pl1

	write (u, "(A)") "* Test output: pdg_arrays_2"
	write (u, "(A)") "* Purpose: create and sort PDG lists"
	write (u, "(A)")

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

	call pl%init (3)
	call pl%set (1, 42)
	call pl%set (2, [3, 2])
	pa = [5, -5]
	call pl%set (3, pa)
	call pl%write (u)
	write (u, *)
	write (u, "(A,I0)") "size = ", pl%get_size ()

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

	pl = pl%sort_abs ()
	call pl%write (u)
	write (u, *)

	write (u, "(A)")
	write (u, "(A)") "* Extract item #3"
	write (u, "(A)")

	pa = pl%get (3)
	call pa%write (u)
	write (u, *)

	write (u, "(A)")
	write (u, "(A)") "* Replace item #3"
	write (u, "(A)")

	call pl1%init (2)
	call pl1%set (1, [2, 4])
	call pl1%set (2, -7)

	pl = pl%replace (3, pl1)
	call pl%write (u)
	write (u, *)

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

	end subroutine pdg_arrays_2

	@ %def pdg_arrays_2
	@ Check if a (sorted) PDG array lists is regular. The entries (PDG arrays)
	must not overlap, unless they are identical.
	<<PDG arrays: execute tests>>=
	call test (pdg_arrays_3, "pdg_arrays_3", &
	"check PDG lists", &
	u, results)
	<<PDG arrays: test declarations>>=
	public :: pdg_arrays_3
	<<PDG arrays: tests>>=
	subroutine pdg_arrays_3 (u)
	integer, intent(in) :: u

	type(pdg_list_t) :: pl

	write (u, "(A)") "* Test output: pdg_arrays_3"
	write (u, "(A)") "* Purpose: check for regular PDG lists"
	write (u, "(A)")

	write (u, "(A)") "* Regular list"
	write (u, "(A)")

	call pl%init (4)
	call pl%set (1, [1, 2])
	call pl%set (2, [1, 2])
	call pl%set (3, [5, -5])
	call pl%set (4, 42)
	call pl%write (u)
	write (u, *)
	write (u, "(L1)") pl%is_regular ()

	write (u, "(A)")
	write (u, "(A)") "* Irregular list"
	write (u, "(A)")

	call pl%init (4)
	call pl%set (1, [1, 2])
	call pl%set (2, [1, 2])
	call pl%set (3, [2, 5, -5])
	call pl%set (4, 42)
	call pl%write (u)
	write (u, *)
	write (u, "(L1)") pl%is_regular ()

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

	end subroutine pdg_arrays_3

	@ %def pdg_arrays_3
	@ Compare PDG array lists. The lists must be regular, i.e., sorted and with
	non-overlapping (or identical) entries.
	<<PDG arrays: execute tests>>=
	call test (pdg_arrays_4, "pdg_arrays_4", &
	"compare PDG lists", &
	u, results)
	<<PDG arrays: test declarations>>=
	public :: pdg_arrays_4
	<<PDG arrays: tests>>=
	subroutine pdg_arrays_4 (u)
	integer, intent(in) :: u

	type(pdg_list_t) :: pl1, pl2, pl3

	write (u, "(A)") "* Test output: pdg_arrays_4"
	write (u, "(A)") "* Purpose: check for regular PDG lists"
	write (u, "(A)")

	write (u, "(A)") "* Create lists"
	write (u, "(A)")

	call pl1%init (4)
	call pl1%set (1, [1, 2])
	call pl1%set (2, [1, 2])
	call pl1%set (3, [5, -5])
	call pl1%set (4, 42)
	write (u, "(I1,1x)", advance = "no") 1
	call pl1%write (u)
	write (u, *)

	call pl2%init (2)
	call pl2%set (1, 3)
	call pl2%set (2, [5, -5])
	write (u, "(I1,1x)", advance = "no") 2
	call pl2%write (u)
	write (u, *)

	call pl3%init (2)
	call pl3%set (1, 4)
	call pl3%set (2, [5, -5])
	write (u, "(I1,1x)", advance = "no") 3
	call pl3%write (u)
	write (u, *)

	write (u, "(A)")
	write (u, "(A)") "* a == b"
	write (u, "(A)")

	write (u, "(2x,A)") "123"
	write (u, *)
	write (u, "(I1,1x,4L1)") 1, pl1 == pl1, pl1 == pl2, pl1 == pl3
	write (u, "(I1,1x,4L1)") 2, pl2 == pl1, pl2 == pl2, pl2 == pl3
	write (u, "(I1,1x,4L1)") 3, pl3 == pl1, pl3 == pl2, pl3 == pl3

	write (u, "(A)")
	write (u, "(A)") "* a < b"
	write (u, "(A)")

	write (u, "(2x,A)") "123"
	write (u, *)
	write (u, "(I1,1x,4L1)") 1, pl1 < pl1, pl1 < pl2, pl1 < pl3
	write (u, "(I1,1x,4L1)") 2, pl2 < pl1, pl2 < pl2, pl2 < pl3
	write (u, "(I1,1x,4L1)") 3, pl3 < pl1, pl3 < pl2, pl3 < pl3

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

	end subroutine pdg_arrays_4

	@ %def pdg_arrays_4
	@ Match-replace: translate all entries in the first list into the
	matching entries of the second list, if there is a match.
	<<PDG arrays: execute tests>>=
	call test (pdg_arrays_5, "pdg_arrays_5", &
	"match PDG lists", &
	u, results)
	<<PDG arrays: test declarations>>=
	public :: pdg_arrays_5
	<<PDG arrays: tests>>=
	subroutine pdg_arrays_5 (u)
	integer, intent(in) :: u

	type(pdg_list_t) :: pl1, pl2, pl3
	logical :: success

	write (u, "(A)") "* Test output: pdg_arrays_5"
	write (u, "(A)") "* Purpose: match-replace"
	write (u, "(A)")

	write (u, "(A)") "* Create lists"
	write (u, "(A)")

	call pl1%init (2)
	call pl1%set (1, [1, 2])
	call pl1%set (2, 42)
	call pl1%write (u)
	write (u, *)
	call pl3%init (2)
	call pl3%set (1, [42, -42])
	call pl3%set (2, [1, 2, 3, 4])
	call pl1%match_replace (pl3, success)
	call pl3%write (u)
	write (u, "(1x,A,1x,L1,':',1x)", advance="no") "=>", success
	call pl1%write (u)
	write (u, *)

	write (u, *)

	call pl2%init (2)
	call pl2%set (1, 9)
	call pl2%set (2, 42)
	call pl2%write (u)
	write (u, *)
	call pl2%match_replace (pl3, success)
	call pl3%write (u)
	write (u, "(1x,A,1x,L1,':',1x)", advance="no") "=>", success
	call pl2%write (u)
	write (u, *)

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

	end subroutine pdg_arrays_5

	@ %def pdg_arrays_5
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Jets}

	The FastJet library is linked externally, if available. The wrapper code is
	also in a separate directory. Here, we define \whizard-specific procedures
	and tests.
	<<[[jets.f90]]>>=
	<<File header>>

	module jets

	use fastjet !NODEP!

	<<Standard module head>>

	<<Jets: public>>

	contains

	<<Jets: procedures>>

	end module jets
	@ %def jets
	@
	\subsection{Re-exported symbols}
	We use this module as a proxy for the FastJet interface, therefore we
	re-export some symbols.
	<<Jets: public>>=
	public :: fastjet_available
	public :: fastjet_init
	public :: jet_definition_t
	public :: pseudojet_t
	public :: pseudojet_vector_t
	public :: cluster_sequence_t
	public :: assignment (=)

	@ %def jet_definition_t pseudojet_t pseudojet_vector_t cluster_sequence_t
	@ The initialization routine prints the banner.
	<<Jets: procedures>>=
	subroutine fastjet_init ()
	call print_banner ()
	end subroutine fastjet_init

	@ %def fastjet_init
	@ The jet algorithm codes (actually, integers)
	<<Jets: public>>=
	public :: kt_algorithm
	public :: cambridge_algorithm
	public :: antikt_algorithm
	public :: genkt_algorithm
	public :: cambridge_for_passive_algorithm
	public :: genkt_for_passive_algorithm
	public :: ee_kt_algorithm
	public :: ee_genkt_algorithm
	public :: plugin_algorithm
	public :: undefined_jet_algorithm

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

	module jets_ut
	use unit_tests
	use jets_uti

	<<Standard module head>>

	<<Jets: public test>>

	contains

	<<Jets: test driver>>

	end module jets_ut
	@ %def jets_ut
	@
	<<[[jets_uti.f90]]>>=
	<<File header>>

	module jets_uti

	<<Use kinds>>
	use fastjet !NODEP!

	use jets

	<<Standard module head>>

	<<Jets: test declarations>>

	contains

	<<Jets: tests>>

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

	@ %def jets_test
	@ This test is actually the minimal example from the FastJet manual,
	translated to Fortran.

	Note that FastJet creates pseudojet vectors, which we mirror in the
	[[pseudojet_vector_t]], but immediately assign to pseudojet arrays. Without
	automatic finalization available in the compilers, we should avoid this in
	actual code and rather introduce intermediate variables for those objects,
	which we can finalize explicitly.
	<<Jets: execute tests>>=
	call test (jets_1, "jets_1", &
	"basic FastJet functionality", &
	u, results)
	<<Jets: test declarations>>=
	public :: jets_1
	<<Jets: tests>>=
	subroutine jets_1 (u)
	integer, intent(in) :: u

	type(pseudojet_t), dimension(:), allocatable :: prt, jets, constituents
	type(jet_definition_t) :: jet_def
	type(cluster_sequence_t) :: cs

	integer, parameter :: dp = default
	integer :: i, j

	write (u, "(A)") "* Test output: jets_1"
	write (u, "(A)") "* Purpose: test basic FastJet functionality"
	write (u, "(A)")

	write (u, "(A)") "* Print banner"
	call print_banner ()

	write (u, *)
	write (u, "(A)") "* Prepare input particles"
	allocate (prt (3))
	call prt(1)%init ( 99._dp, 0.1_dp, 0._dp, 100._dp)
	call prt(2)%init ( 4._dp,-0.1_dp, 0._dp, 5._dp)
	call prt(3)%init (-99._dp, 0._dp, 0._dp, 99._dp)

	write (u, *)
	write (u, "(A)") "* Define jet algorithm"
	call jet_def%init (antikt_algorithm, 0.7_dp)

	write (u, *)
	write (u, "(A)") "* Cluster particles according to jet algorithm"

	write (u, *)
	write (u, "(A,A)") "Clustering with ", jet_def%description ()
	call cs%init (pseudojet_vector (prt), jet_def)

	write (u, *)
	write (u, "(A)") "* Sort output jets"
	jets = sorted_by_pt (cs%inclusive_jets ())

	write (u, *)
	write (u, "(A)") "* Print jet observables and constituents"
	write (u, *)
	write (u, "(4x,3(7x,A3))") "pt", "y", "phi"
	do i = 1, size (jets)
	write (u, "(A,1x,I0,A,3(1x,F9.5))") &
	"jet", i, ":", jets(i)%perp (), jets(i)%rap (), jets(i)%phi ()
	constituents = jets(i)%constituents ()
	do j = 1, size (constituents)
	write (u, "(4x,A,1x,I0,A,F9.5)") &
	"constituent", j, "'s pt:", constituents(j)%perp ()
	end do
	do j = 1, size (constituents)
	call constituents(j)%final ()
	end do
	end do

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

	do i = 1, size (prt)
	call prt(i)%final ()
	end do
	do i = 1, size (jets)
	call jets(i)%final ()
	end do
	call jet_def%final ()
	call cs%final ()

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

	end subroutine jets_1

	@ %def jets_1
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Subevents}

	The purpose of subevents is to store the relevant part of the physical
	event (either partonic or hadronic), and to hold particle selections
	and combinations which are constructed in cut or analysis expressions.
	<<[[subevents.f90]]>>=
	<<File header>>

	module subevents

	use, intrinsic :: iso_c_binding !NODEP!

	<<Use kinds>>
	use numeric_utils, only: pacify
	use c_particles
	use lorentz
	use pdg_arrays
	use jets

	<<Standard module head>>

	<<Subevents: public>>

	<<Subevents: parameters>>

	<<Subevents: types>>

	<<Subevents: interfaces>>

	interface
	<<Subevents: sub interfaces>>
	end interface

	end module subevents
	@ %def subevents
	@
	<<[[subevents_sub.f90]]>>=
	<<File header>>

	submodule (subevents) subevents_s

	use io_units
	use format_defs, only: FMT_14, FMT_19
	use format_utils, only: pac_fmt
	use physics_defs
	use sorting

	implicit none

	contains

	<<Subevents: procedures>>

	end submodule subevents_s

	@ %def subevents_s
	@
	\subsection{Particles}
	For the purpose of this module, a particle has a type which can
	indicate a beam, incoming, outgoing, or composite particle, flavor and
	helicity codes (integer, undefined for composite), four-momentum and
	invariant mass squared. (Other particles types are used in extended
	event types, but also defined here.) Furthermore, each particle has
	an allocatable array of ancestors -- particle indices which indicate
	the building blocks of a composite particle. For an incoming/outgoing
	particle, the array contains only the index of the particle itself.

	For incoming particles, the momentum is inverted before storing it in
	the particle object.
	<<Subevents: parameters>>=
	integer, parameter, public :: PRT_UNDEFINED = 0
	integer, parameter, public :: PRT_BEAM = -9
	integer, parameter, public :: PRT_INCOMING = 1
	integer, parameter, public :: PRT_OUTGOING = 2
	integer, parameter, public :: PRT_COMPOSITE = 3
	integer, parameter, public :: PRT_VIRTUAL = 4
	integer, parameter, public :: PRT_RESONANT = 5
	integer, parameter, public :: PRT_BEAM_REMNANT = 9

	@ %def PRT_UNDEFINED PRT_BEAM
	@ %def PRT_INCOMING PRT_OUTGOING PRT_COMPOSITE
	@ %def PRT_COMPOSITE PRT_VIRTUAL PRT_RESONANT
	@ %def PRT_BEAM_REMNANT
	@
	\subsubsection{The type}
	We initialize only the type here and mark as unpolarized. The
	initializers below do the rest. The logicals [[is_b_jet]] and
	[[is_c_jet]] are true only if [[prt_t]] comes out of the
	[[subevt_cluster]] routine and fulfils the correct flavor content.
	<<Subevents: public>>=
	public :: prt_t
	<<Subevents: types>>=
	type :: prt_t
	private
	integer :: type = PRT_UNDEFINED
	integer :: pdg
	logical :: polarized = .false.
	logical :: colorized = .false.
	logical :: clustered = .false.
	logical :: is_b_jet = .false.
	logical :: is_c_jet = .false.
	integer :: h
	type(vector4_t) :: p
	real(default) :: p2
	integer, dimension(:), allocatable :: src
	integer, dimension(:), allocatable :: col
	integer, dimension(:), allocatable :: acl
	end type prt_t

	@ %def prt_t
	@ Initializers. Polarization is set separately. Finalizers are not
	needed.
	<<Subevents: procedures>>=
	subroutine prt_init_beam (prt, pdg, p, p2, src)
	type(prt_t), intent(out) :: prt
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: p2
	integer, dimension(:), intent(in) :: src
	prt%type = PRT_BEAM
	call prt_set (prt, pdg, - p, p2, src)
	end subroutine prt_init_beam

	subroutine prt_init_incoming (prt, pdg, p, p2, src)
	type(prt_t), intent(out) :: prt
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: p2
	integer, dimension(:), intent(in) :: src
	prt%type = PRT_INCOMING
	call prt_set (prt, pdg, - p, p2, src)
	end subroutine prt_init_incoming

	subroutine prt_init_outgoing (prt, pdg, p, p2, src)
	type(prt_t), intent(out) :: prt
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: p2
	integer, dimension(:), intent(in) :: src
	prt%type = PRT_OUTGOING
	call prt_set (prt, pdg, p, p2, src)
	end subroutine prt_init_outgoing

	subroutine prt_init_composite (prt, p, src)
	type(prt_t), intent(out) :: prt
	type(vector4_t), intent(in) :: p
	integer, dimension(:), intent(in) :: src
	prt%type = PRT_COMPOSITE
	call prt_set (prt, 0, p, p**2, src)
	end subroutine prt_init_composite

	@ %def prt_init_beam prt_init_incoming prt_init_outgoing prt_init_composite
	@
	This version is for temporary particle objects, so the [[src]] array
	is not set.
	<<Subevents: public>>=
	public :: prt_init_combine
	<<Subevents: sub interfaces>>=
	module subroutine prt_init_combine (prt, prt1, prt2)
	type(prt_t), intent(out) :: prt
	type(prt_t), intent(in) :: prt1, prt2
	end subroutine prt_init_combine
	<<Subevents: procedures>>=
	module subroutine prt_init_combine (prt, prt1, prt2)
	type(prt_t), intent(out) :: prt
	type(prt_t), intent(in) :: prt1, prt2
	type(vector4_t) :: p
	integer, dimension(0) :: src
	prt%type = PRT_COMPOSITE
	p = prt1%p + prt2%p
	call prt_set (prt, 0, p, p**2, src)
	end subroutine prt_init_combine

	@ %def prt_init_combine
	@ Init from a pseudojet object.
	<<Subevents: procedures>>=
	subroutine prt_init_pseudojet (prt, jet, src, pdg, is_b_jet, is_c_jet)
	type(prt_t), intent(out) :: prt
	type(pseudojet_t), intent(in) :: jet
	integer, dimension(:), intent(in) :: src
	integer, intent(in) :: pdg
	logical, intent(in) :: is_b_jet, is_c_jet
	type(vector4_t) :: p
	prt%type = PRT_COMPOSITE
	p = vector4_moving (jet%e(), &
	vector3_moving ([jet%px(), jet%py(), jet%pz()]))
	call prt_set (prt, pdg, p, p**2, src)
	prt%is_b_jet = is_b_jet
	prt%is_c_jet = is_c_jet
	prt%clustered = .true.
	end subroutine prt_init_pseudojet

	@ %def prt_init_pseudojet
	@
	\subsubsection{Accessing contents}
	<<Subevents: public>>=
	public :: prt_get_pdg
	<<Subevents: sub interfaces>>=
	elemental module function prt_get_pdg (prt) result (pdg)
	integer :: pdg
	type(prt_t), intent(in) :: prt
	end function prt_get_pdg
	<<Subevents: procedures>>=
	elemental module function prt_get_pdg (prt) result (pdg)
	integer :: pdg
	type(prt_t), intent(in) :: prt
	pdg = prt%pdg
	end function prt_get_pdg

	@ %def prt_get_pdg
	<<Subevents: public>>=
	public :: prt_get_momentum
	<<Subevents: sub interfaces>>=
	elemental module function prt_get_momentum (prt) result (p)
	type(vector4_t) :: p
	type(prt_t), intent(in) :: prt
	end function prt_get_momentum
	<<Subevents: procedures>>=
	elemental module function prt_get_momentum (prt) result (p)
	type(vector4_t) :: p
	type(prt_t), intent(in) :: prt
	p = prt%p
	end function prt_get_momentum

	@ %def prt_get_momentum
	<<Subevents: public>>=
	public :: prt_get_msq
	<<Subevents: sub interfaces>>=
	elemental module function prt_get_msq (prt) result (msq)
	real(default) :: msq
	type(prt_t), intent(in) :: prt
	end function prt_get_msq
	<<Subevents: procedures>>=
	elemental module function prt_get_msq (prt) result (msq)
	real(default) :: msq
	type(prt_t), intent(in) :: prt
	msq = prt%p2
	end function prt_get_msq

	@ %def prt_get_msq
	<<Subevents: public>>=
	public :: prt_is_polarized
	<<Subevents: sub interfaces>>=
	elemental module function prt_is_polarized (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	end function prt_is_polarized
	<<Subevents: procedures>>=
	elemental module function prt_is_polarized (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	flag = prt%polarized
	end function prt_is_polarized

	@ %def prt_is_polarized
	<<Subevents: public>>=
	public :: prt_get_helicity
	<<Subevents: sub interfaces>>=
	elemental module function prt_get_helicity (prt) result (h)
	integer :: h
	type(prt_t), intent(in) :: prt
	end function prt_get_helicity
	<<Subevents: procedures>>=
	elemental module function prt_get_helicity (prt) result (h)
	integer :: h
	type(prt_t), intent(in) :: prt
	h = prt%h
	end function prt_get_helicity

	@ %def prt_get_helicity
	<<Subevents: public>>=
	public :: prt_is_colorized
	<<Subevents: sub interfaces>>=
	elemental module function prt_is_colorized (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	end function prt_is_colorized
	<<Subevents: procedures>>=
	elemental module function prt_is_colorized (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	flag = prt%colorized
	end function prt_is_colorized

	@ %def prt_is_colorized
	<<Subevents: public>>=
	public :: prt_is_clustered
	<<Subevents: sub interfaces>>=
	elemental module function prt_is_clustered (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	end function prt_is_clustered
	<<Subevents: procedures>>=
	elemental module function prt_is_clustered (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	flag = prt%clustered
	end function prt_is_clustered

	@ %def prt_is_clustered
	<<Subevents: public>>=
	public :: prt_is_recombinable
	<<Subevents: sub interfaces>>=
	elemental module function prt_is_recombinable (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	end function prt_is_recombinable
	<<Subevents: procedures>>=
	elemental module function prt_is_recombinable (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	flag = prt_is_parton (prt) .or. &
	abs(prt%pdg) == TOP_Q .or. &
	prt_is_lepton (prt) .or. &
	prt_is_photon (prt)
	end function prt_is_recombinable

	@ %def prt_is_recombinable
	<<Subevents: public>>=
	public :: prt_is_photon
	<<Subevents: sub interfaces>>=
	elemental module function prt_is_photon (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	end function prt_is_photon
	<<Subevents: procedures>>=
	elemental module function prt_is_photon (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	flag = prt%pdg == PHOTON
	end function prt_is_photon

	@ %def prt_is_photon
	We do not take the top quark into account here.
	<<Subevents: public>>=
	public :: prt_is_parton
	<<Subevents: sub interfaces>>=
	elemental module function prt_is_parton (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	end function prt_is_parton
	<<Subevents: procedures>>=
	elemental module function prt_is_parton (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	flag = abs(prt%pdg) == DOWN_Q .or. &
	abs(prt%pdg) == UP_Q .or. &
	abs(prt%pdg) == STRANGE_Q .or. &
	abs(prt%pdg) == CHARM_Q .or. &
	abs(prt%pdg) == BOTTOM_Q .or. &
	prt%pdg == GLUON
	end function prt_is_parton

	@ %def prt_is_parton
	<<Subevents: public>>=
	public :: prt_is_lepton
	<<Subevents: sub interfaces>>=
	elemental module function prt_is_lepton (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	end function prt_is_lepton
	<<Subevents: procedures>>=
	elemental module function prt_is_lepton (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	flag = abs(prt%pdg) == ELECTRON .or. &
	abs(prt%pdg) == MUON .or. &
	abs(prt%pdg) == TAU
	end function prt_is_lepton

	@ %def prt_is_lepton
	<<Subevents: public>>=
	public :: prt_is_b_jet
	<<Subevents: sub interfaces>>=
	elemental module function prt_is_b_jet (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	end function prt_is_b_jet
	<<Subevents: procedures>>=
	elemental module function prt_is_b_jet (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	flag = prt%is_b_jet
	end function prt_is_b_jet

	@ %def prt_is_b_jet
	<<Subevents: public>>=
	public :: prt_is_c_jet
	<<Subevents: sub interfaces>>=
	elemental module function prt_is_c_jet (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	end function prt_is_c_jet
	<<Subevents: procedures>>=
	elemental module function prt_is_c_jet (prt) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt
	flag = prt%is_c_jet
	end function prt_is_c_jet

	@ %def prt_is_c_jet
	@ The number of open color (anticolor) lines. We inspect the list of color
	(anticolor) lines and count the entries that do not appear in the list
	of anticolors (colors). (There is no check against duplicates; we assume that
	color line indices are unique.)
	<<Subevents: public>>=
	public :: prt_get_n_col
	public :: prt_get_n_acl
	<<Subevents: sub interfaces>>=
	elemental module function prt_get_n_col (prt) result (n)
	integer :: n
	type(prt_t), intent(in) :: prt
	end function prt_get_n_col
	elemental module function prt_get_n_acl (prt) result (n)
	integer :: n
	type(prt_t), intent(in) :: prt
	end function prt_get_n_acl
	<<Subevents: procedures>>=
	elemental module function prt_get_n_col (prt) result (n)
	integer :: n
	type(prt_t), intent(in) :: prt
	integer, dimension(:), allocatable :: col, acl
	integer :: i
	n = 0
	if (prt%colorized) then
	do i = 1, size (prt%col)
	if (all (prt%col(i) /= prt%acl)) n = n + 1
	end do
	end if
	end function prt_get_n_col

	elemental module function prt_get_n_acl (prt) result (n)
	integer :: n
	type(prt_t), intent(in) :: prt
	integer, dimension(:), allocatable :: col, acl
	integer :: i
	n = 0
	if (prt%colorized) then
	do i = 1, size (prt%acl)
	if (all (prt%acl(i) /= prt%col)) n = n + 1
	end do
	end if
	end function prt_get_n_acl

	@ %def prt_get_n_col
	@ %def prt_get_n_acl
	@ Return the color and anticolor-flow line indices explicitly.
	<<Subevents: public>>=
	public :: prt_get_color_indices
	<<Subevents: sub interfaces>>=
	module subroutine prt_get_color_indices (prt, col, acl)
	type(prt_t), intent(in) :: prt
	integer, dimension(:), allocatable, intent(out) :: col, acl
	end subroutine prt_get_color_indices
	<<Subevents: procedures>>=
	module subroutine prt_get_color_indices (prt, col, acl)
	type(prt_t), intent(in) :: prt
	integer, dimension(:), allocatable, intent(out) :: col, acl
	if (prt%colorized) then
	col = prt%col
	acl = prt%acl
	else
	col = [integer::]
	acl = [integer::]
	end if
	end subroutine prt_get_color_indices

	@ %def prt_get_color_indices
	@
	\subsubsection{Setting data}
	Set the PDG, momentum and momentum squared, and ancestors. If
	allocate-on-assignment is available, this can be simplified.
	<<Subevents: procedures>>=
	subroutine prt_set (prt, pdg, p, p2, src)
	type(prt_t), intent(inout) :: prt
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: p2
	integer, dimension(:), intent(in) :: src
	prt%pdg = pdg
	prt%p = p
	prt%p2 = p2
	if (allocated (prt%src)) then
	if (size (src) /= size (prt%src)) then
	deallocate (prt%src)
	allocate (prt%src (size (src)))
	end if
	else
	allocate (prt%src (size (src)))
	end if
	prt%src = src
	end subroutine prt_set

	@ %def prt_set
	@ Set the particle PDG code separately.
	<<Subevents: procedures>>=
	elemental subroutine prt_set_pdg (prt, pdg)
	type(prt_t), intent(inout) :: prt
	integer, intent(in) :: pdg
	prt%pdg = pdg
	end subroutine prt_set_pdg

	@ %def prt_set_pdg
	@ Set the momentum separately.
	<<Subevents: procedures>>=
	elemental subroutine prt_set_p (prt, p)
	type(prt_t), intent(inout) :: prt
	type(vector4_t), intent(in) :: p
	prt%p = p
	end subroutine prt_set_p

	@ %def prt_set_p
	@ Set the squared invariant mass separately.
	<<Subevents: procedures>>=
	elemental subroutine prt_set_p2 (prt, p2)
	type(prt_t), intent(inout) :: prt
	real(default), intent(in) :: p2
	prt%p2 = p2
	end subroutine prt_set_p2

	@ %def prt_set_p2
	@ Set helicity (optional).
	<<Subevents: procedures>>=
	subroutine prt_polarize (prt, h)
	type(prt_t), intent(inout) :: prt
	integer, intent(in) :: h
	prt%polarized = .true.
	prt%h = h
	end subroutine prt_polarize

	@ %def prt_polarize
	@ Set color-flow indices (optional).
	<<Subevents: procedures>>=
	subroutine prt_colorize (prt, col, acl)
	type(prt_t), intent(inout) :: prt
	integer, dimension(:), intent(in) :: col, acl
	prt%colorized = .true.
	prt%col = col
	prt%acl = acl
	end subroutine prt_colorize

	@ %def prt_colorize
	@
	\subsubsection{Conversion}
	Transform a [[prt_t]] object into a [[c_prt_t]] object.
	<<Subevents: public>>=
	public :: c_prt
	<<Subevents: interfaces>>=
	interface c_prt
	module procedure c_prt_from_prt
	end interface

	@ %def c_prt
	<<Subevents: sub interfaces>>=
	elemental module function c_prt_from_prt (prt) result (c_prt)
	type(c_prt_t) :: c_prt
	type(prt_t), intent(in) :: prt
	end function c_prt_from_prt
	<<Subevents: procedures>>=
	elemental module function c_prt_from_prt (prt) result (c_prt)
	type(c_prt_t) :: c_prt
	type(prt_t), intent(in) :: prt
	c_prt = prt%p
	c_prt%type = prt%type
	c_prt%pdg = prt%pdg
	if (prt%polarized) then
	c_prt%polarized = 1
	else
	c_prt%polarized = 0
	end if
	c_prt%h = prt%h
	end function c_prt_from_prt

	@ %def c_prt_from_prt
	@
	\subsubsection{Output}
	<<Subevents: public>>=
	public :: prt_write
	<<Subevents: sub interfaces>>=
	module subroutine prt_write (prt, unit, testflag)
	type(prt_t), intent(in) :: prt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	end subroutine prt_write
	<<Subevents: procedures>>=
	module subroutine prt_write (prt, unit, testflag)
	type(prt_t), intent(in) :: prt
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: testflag
	logical :: pacified
	type(prt_t) :: tmp
	character(len=7) :: fmt
	integer :: u, i
	call pac_fmt (fmt, FMT_19, FMT_14, testflag)
	u = given_output_unit (unit); if (u < 0) return
	pacified = .false. ; if (present (testflag)) pacified = testflag
	tmp = prt
	if (pacified) call pacify (tmp)
	write (u, "(1x,A)", advance="no") "prt("
	select case (prt%type)
	case (PRT_UNDEFINED); write (u, "('?')", advance="no")
	case (PRT_BEAM); write (u, "('b:')", advance="no")
	case (PRT_INCOMING); write (u, "('i:')", advance="no")
	case (PRT_OUTGOING); write (u, "('o:')", advance="no")
	case (PRT_COMPOSITE); write (u, "('c:')", advance="no")
	end select
	select case (prt%type)
	case (PRT_BEAM, PRT_INCOMING, PRT_OUTGOING)
	if (prt%polarized) then
	write (u, "(I0,'/',I0,'\|')", advance="no") prt%pdg, prt%h
	else
	write (u, "(I0,'\|')", advance="no") prt%pdg
	end if
	end select
	select case (prt%type)
	case (PRT_BEAM, PRT_INCOMING, PRT_OUTGOING, PRT_COMPOSITE)
	if (prt%colorized) then
	write (u, "(*(I0,:,','))", advance="no") prt%col
	write (u, "('/')", advance="no")
	write (u, "(*(I0,:,','))", advance="no") prt%acl
	write (u, "('\|')", advance="no")
	end if
	end select
	select case (prt%type)
	case (PRT_BEAM, PRT_INCOMING, PRT_OUTGOING, PRT_COMPOSITE)
	write (u, "(" // FMT_14 // ",';'," // FMT_14 // ",','," // &
	FMT_14 // ",','," // FMT_14 // ")", advance="no") tmp%p
	write (u, "('\|'," // fmt // ")", advance="no") tmp%p2
	end select
	if (allocated (prt%src)) then
	write (u, "('\|')", advance="no")
	do i = 1, size (prt%src)
	write (u, "(1x,I0)", advance="no") prt%src(i)
	end do
	end if
	if (prt%is_b_jet) then
	write (u, "('\|b jet')", advance="no")
	end if
	if (prt%is_c_jet) then
	write (u, "('\|c jet')", advance="no")
	end if
	write (u, "(A)") ")"
	end subroutine prt_write

	@ %def prt_write
	@
	\subsubsection{Tools}
	Two particles match if their [[src]] arrays are the same.
	<<Subevents: public>>=
	public :: operator(.match.)
	<<Subevents: interfaces>>=
	interface operator(.match.)
	module procedure prt_match
	end interface

	@ %def .match.
	<<Subevents: sub interfaces>>=
	elemental module function prt_match (prt1, prt2) result (match)
	logical :: match
	type(prt_t), intent(in) :: prt1, prt2
	end function prt_match
	<<Subevents: procedures>>=
	elemental module function prt_match (prt1, prt2) result (match)
	logical :: match
	type(prt_t), intent(in) :: prt1, prt2
	if (size (prt1%src) == size (prt2%src)) then
	match = all (prt1%src == prt2%src)
	else
	match = .false.
	end if
	end function prt_match

	@ %def prt_match
	@ The combine operation makes a pseudoparticle whose momentum is the
	result of adding (the momenta of) the pair of input particles. We
	trace the particles from which a particle is built by storing a
	[[src]] array. Each particle entry in the [[src]] list contains a
	list of indices which indicates its building blocks. The indices
	refer to an original list of particles. Index lists are sorted, and
	they contain no element more than once.

	We thus require that in a given pseudoparticle, each original particle
	occurs at most once.

	The result is intent(inout), so it will not be initialized when the
	subroutine is entered.

	If the particles carry color, we recall that the combined particle is a
	composite which is understood as outgoing. If one of the arguments is an
	incoming particle, is color entries must be reversed.
	<<Subevents: procedures>>=
	subroutine prt_combine (prt, prt_in1, prt_in2, ok)
	type(prt_t), intent(inout) :: prt
	type(prt_t), intent(in) :: prt_in1, prt_in2
	logical :: ok
	integer, dimension(:), allocatable :: src
	integer, dimension(:), allocatable :: col1, acl1, col2, acl2
	call combine_index_lists (src, prt_in1%src, prt_in2%src)
	ok = allocated (src)
	if (ok) then
	call prt_init_composite (prt, prt_in1%p + prt_in2%p, src)
	if (prt_in1%colorized .or. prt_in2%colorized) then
	select case (prt_in1%type)
	case default
	call prt_get_color_indices (prt_in1, col1, acl1)
	case (PRT_BEAM, PRT_INCOMING)
	call prt_get_color_indices (prt_in1, acl1, col1)
	end select
	select case (prt_in2%type)
	case default
	call prt_get_color_indices (prt_in2, col2, acl2)
	case (PRT_BEAM, PRT_INCOMING)
	call prt_get_color_indices (prt_in2, acl2, col2)
	end select
	call prt_colorize (prt, [col1, col2], [acl1, acl2])
	end if
	end if
	end subroutine prt_combine

	@ %def prt_combine
	@ This variant does not produce the combined particle, it just checks
	whether the combination is valid (no common [[src]] entry).
	<<Subevents: public>>=
	public :: are_disjoint
	<<Subevents: sub interfaces>>=
	module function are_disjoint (prt_in1, prt_in2) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt_in1, prt_in2
	end function are_disjoint
	<<Subevents: procedures>>=
	module function are_disjoint (prt_in1, prt_in2) result (flag)
	logical :: flag
	type(prt_t), intent(in) :: prt_in1, prt_in2
	flag = index_lists_are_disjoint (prt_in1%src, prt_in2%src)
	end function are_disjoint

	@ %def are_disjoint
	@ [[src]] Lists with length $>1$ are built by a [[combine]] operation
	which merges the lists in a sorted manner. If the result would have a
	duplicate entry, it is discarded, and the result is unallocated.
	<<Subevents: procedures>>=
	subroutine combine_index_lists (res, src1, src2)
	integer, dimension(:), intent(in) :: src1, src2
	integer, dimension(:), allocatable :: res
	integer :: i1, i2, i
	allocate (res (size (src1) + size (src2)))
	if (size (src1) == 0) then
	res = src2
	return
	else if (size (src2) == 0) then
	res = src1
	return
	end if
	i1 = 1
	i2 = 1
	LOOP: do i = 1, size (res)
	if (src1(i1) < src2(i2)) then
	res(i) = src1(i1); i1 = i1 + 1
	if (i1 > size (src1)) then
	res(i+1:) = src2(i2:)
	exit LOOP
	end if
	else if (src1(i1) > src2(i2)) then
	res(i) = src2(i2); i2 = i2 + 1
	if (i2 > size (src2)) then
	res(i+1:) = src1(i1:)
	exit LOOP
	end if
	else
	deallocate (res)
	exit LOOP
	end if
	end do LOOP
	end subroutine combine_index_lists

	@ %def combine_index_lists
	@ This function is similar, but it does not actually merge the list,
	it just checks whether they are disjoint (no common [[src]] entry).
	<<Subevents: procedures>>=
	function index_lists_are_disjoint (src1, src2) result (flag)
	logical :: flag
	integer, dimension(:), intent(in) :: src1, src2
	integer :: i1, i2, i
	flag = .true.
	i1 = 1
	i2 = 1
	LOOP: do i = 1, size (src1) + size (src2)
	if (src1(i1) < src2(i2)) then
	i1 = i1 + 1
	if (i1 > size (src1)) then
	exit LOOP
	end if
	else if (src1(i1) > src2(i2)) then
	i2 = i2 + 1
	if (i2 > size (src2)) then
	exit LOOP
	end if
	else
	flag = .false.
	exit LOOP
	end if
	end do LOOP
	end function index_lists_are_disjoint

	@ %def index_lists_are_disjoint
	@
	\subsection{subevents}
	Particles are collected in subevents. This type is implemented as a
	dynamically allocated array, which need not be completely filled. The
	value [[n_active]] determines the number of meaningful entries.

	\subsubsection{Type definition}
	<<Subevents: public>>=
	public :: subevt_t
	<<Subevents: types>>=
	type :: subevt_t
	private
	integer :: n_active = 0
	type(prt_t), dimension(:), allocatable :: prt
	contains
	<<Subevents: subevt: TBP>>
	end type subevt_t

	@ %def subevt_t
	@ Initialize, allocating with size zero (default) or given size. The
	number of contained particles is set equal to the size.
	<<Subevents: public>>=
	public :: subevt_init
	<<Subevents: sub interfaces>>=
	module subroutine subevt_init (subevt, n_active)
	type(subevt_t), intent(out) :: subevt
	integer, intent(in), optional :: n_active
	end subroutine subevt_init
	<<Subevents: procedures>>=
	module subroutine subevt_init (subevt, n_active)
	type(subevt_t), intent(out) :: subevt
	integer, intent(in), optional :: n_active
	if (present (n_active)) subevt%n_active = n_active
	allocate (subevt%prt (subevt%n_active))
	end subroutine subevt_init

	@ %def subevt_init
	@ (Re-)allocate the subevent with some given size. If the size
	is greater than the previous one, do a real reallocation. Otherwise,
	just reset the recorded size. Contents are untouched, but become
	invalid.
	<<Subevents: subevt: TBP>>=
	procedure :: reset => subevt_reset
	<<Subevents: sub interfaces>>=
	module subroutine subevt_reset (subevt, n_active)
	class(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: n_active
	end subroutine subevt_reset
	<<Subevents: procedures>>=
	module subroutine subevt_reset (subevt, n_active)
	class(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: n_active
	subevt%n_active = n_active
	if (subevt%n_active > size (subevt%prt)) then
	deallocate (subevt%prt)
	allocate (subevt%prt (subevt%n_active))
	end if
	end subroutine subevt_reset

	@ %def subevt_reset
	@ Output. No prefix for the headline 'subevt', because this will usually be
	printed appending to a previous line.
	<<Subevents: subevt: TBP>>=
	procedure :: write => subevt_write
	<<Subevents: sub interfaces>>=
	module subroutine subevt_write (object, unit, prefix, pacified)
	class(subevt_t), intent(in) :: object
	integer, intent(in), optional :: unit
	character(*), intent(in), optional :: prefix
	logical, intent(in), optional :: pacified
	end subroutine subevt_write
	<<Subevents: procedures>>=
	module subroutine subevt_write (object, unit, prefix, pacified)
	class(subevt_t), intent(in) :: object
	integer, intent(in), optional :: unit
	character(*), intent(in), optional :: prefix
	logical, intent(in), optional :: pacified
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,A)") "subevent:"
	do i = 1, object%n_active
	if (present (prefix)) write (u, "(A)", advance="no") prefix
	write (u, "(1x,I0)", advance="no") i
	call prt_write (object%prt(i), unit = unit, testflag = pacified)
	end do
	end subroutine subevt_write

	@ %def subevt_write
	@ Defined assignment: transfer only meaningful entries. This is a
	deep copy (as would be default assignment).
	<<Subevents: interfaces>>=
	interface assignment(=)
	module procedure subevt_assign
	end interface

	@ %def =
	<<Subevents: sub interfaces>>=
	module subroutine subevt_assign (subevt, subevt_in)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: subevt_in
	end subroutine subevt_assign
	<<Subevents: procedures>>=
	module subroutine subevt_assign (subevt, subevt_in)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: subevt_in
	if (.not. allocated (subevt%prt)) then
	call subevt_init (subevt, subevt_in%n_active)
	else
	call subevt%reset (subevt_in%n_active)
	end if
	subevt%prt(:subevt%n_active) = subevt_in%prt(:subevt%n_active)
	end subroutine subevt_assign

	@ %def subevt_assign
	@
	\subsubsection{Fill contents}
	Store incoming/outgoing particles which are completely defined.
	<<Subevents: public>>=
	<<Subevents: subevt: TBP>>=
	procedure :: set_beam => subevt_set_beam
	procedure :: set_composite => subevt_set_composite
	procedure :: set_incoming => subevt_set_incoming
	procedure :: set_outgoing => subevt_set_outgoing
	<<Subevents: sub interfaces>>=
	module subroutine subevt_set_beam (subevt, i, pdg, p, p2, src)
	class(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: i
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: p2
	integer, dimension(:), intent(in), optional :: src
	end subroutine subevt_set_beam
	module subroutine subevt_set_incoming (subevt, i, pdg, p, p2, src)
	class(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: i
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: p2
	integer, dimension(:), intent(in), optional :: src
	end subroutine subevt_set_incoming
	module subroutine subevt_set_outgoing (subevt, i, pdg, p, p2, src)
	class(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: i
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: p2
	integer, dimension(:), intent(in), optional :: src
	end subroutine subevt_set_outgoing
	module subroutine subevt_set_composite (subevt, i, p, src)
	class(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: i
	type(vector4_t), intent(in) :: p
	integer, dimension(:), intent(in) :: src
	end subroutine subevt_set_composite
	<<Subevents: procedures>>=
	module subroutine subevt_set_beam (subevt, i, pdg, p, p2, src)
	class(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: i
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: p2
	integer, dimension(:), intent(in), optional :: src
	if (present (src)) then
	call prt_init_beam (subevt%prt(i), pdg, p, p2, src)
	else
	call prt_init_beam (subevt%prt(i), pdg, p, p2, [i])
	end if
	end subroutine subevt_set_beam

	module subroutine subevt_set_incoming (subevt, i, pdg, p, p2, src)
	class(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: i
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: p2
	integer, dimension(:), intent(in), optional :: src
	if (present (src)) then
	call prt_init_incoming (subevt%prt(i), pdg, p, p2, src)
	else
	call prt_init_incoming (subevt%prt(i), pdg, p, p2, [i])
	end if
	end subroutine subevt_set_incoming

	module subroutine subevt_set_outgoing (subevt, i, pdg, p, p2, src)
	class(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: i
	integer, intent(in) :: pdg
	type(vector4_t), intent(in) :: p
	real(default), intent(in) :: p2
	integer, dimension(:), intent(in), optional :: src
	if (present (src)) then
	call prt_init_outgoing (subevt%prt(i), pdg, p, p2, src)
	else
	call prt_init_outgoing (subevt%prt(i), pdg, p, p2, [i])
	end if
	end subroutine subevt_set_outgoing

	module subroutine subevt_set_composite (subevt, i, p, src)
	class(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: i
	type(vector4_t), intent(in) :: p
	integer, dimension(:), intent(in) :: src
	call prt_init_composite (subevt%prt(i), p, src)
	end subroutine subevt_set_composite

	@ %def subevt_set_incoming subevt_set_outgoing subevt_set_composite
	@ Separately assign flavors, simultaneously for all incoming/outgoing
	particles.
	<<Subevents: subevt: TBP>>=
	procedure :: set_pdg_beam => subevt_set_pdg_beam
	procedure :: set_pdg_incoming => subevt_set_pdg_incoming
	procedure :: set_pdg_outgoing => subevt_set_pdg_outgoing
	<<Subevents: sub interfaces>>=
	module subroutine subevt_set_pdg_beam (subevt, pdg)
	class(subevt_t), intent(inout) :: subevt
	integer, dimension(:), intent(in) :: pdg
	end subroutine subevt_set_pdg_beam
	module subroutine subevt_set_pdg_incoming (subevt, pdg)
	class(subevt_t), intent(inout) :: subevt
	integer, dimension(:), intent(in) :: pdg
	end subroutine subevt_set_pdg_incoming
	module subroutine subevt_set_pdg_outgoing (subevt, pdg)
	class(subevt_t), intent(inout) :: subevt
	integer, dimension(:), intent(in) :: pdg
	end subroutine subevt_set_pdg_outgoing
	<<Subevents: procedures>>=
	module subroutine subevt_set_pdg_beam (subevt, pdg)
	class(subevt_t), intent(inout) :: subevt
	integer, dimension(:), intent(in) :: pdg
	integer :: i, j
	j = 1
	do i = 1, subevt%n_active
	if (subevt%prt(i)%type == PRT_BEAM) then
	call prt_set_pdg (subevt%prt(i), pdg(j))
	j = j + 1
	if (j > size (pdg)) exit
	end if
	end do
	end subroutine subevt_set_pdg_beam

	module subroutine subevt_set_pdg_incoming (subevt, pdg)
	class(subevt_t), intent(inout) :: subevt
	integer, dimension(:), intent(in) :: pdg
	integer :: i, j
	j = 1
	do i = 1, subevt%n_active
	if (subevt%prt(i)%type == PRT_INCOMING) then
	call prt_set_pdg (subevt%prt(i), pdg(j))
	j = j + 1
	if (j > size (pdg)) exit
	end if
	end do
	end subroutine subevt_set_pdg_incoming

	module subroutine subevt_set_pdg_outgoing (subevt, pdg)
	class(subevt_t), intent(inout) :: subevt
	integer, dimension(:), intent(in) :: pdg
	integer :: i, j
	j = 1
	do i = 1, subevt%n_active
	if (subevt%prt(i)%type == PRT_OUTGOING) then
	call prt_set_pdg (subevt%prt(i), pdg(j))
	j = j + 1
	if (j > size (pdg)) exit
	end if
	end do
	end subroutine subevt_set_pdg_outgoing

	@ %def subevt_set_pdg_beam
	@ %def subevt_set_pdg_incoming
	@ %def subevt_set_pdg_outgoing
	@ Separately assign momenta, simultaneously for all incoming/outgoing
	particles.
	<<Subevents: subevt: TBP>>=
	procedure :: set_p_beam => subevt_set_p_beam
	procedure :: set_p_incoming => subevt_set_p_incoming
	procedure :: set_p_outgoing => subevt_set_p_outgoing
	<<Subevents: sub interfaces>>=
	module subroutine subevt_set_p_beam (subevt, p)
	class(subevt_t), intent(inout) :: subevt
	type(vector4_t), dimension(:), intent(in) :: p
	end subroutine subevt_set_p_beam
	module subroutine subevt_set_p_incoming (subevt, p)
	class(subevt_t), intent(inout) :: subevt
	type(vector4_t), dimension(:), intent(in) :: p
	end subroutine subevt_set_p_incoming
	module subroutine subevt_set_p_outgoing (subevt, p)
	class(subevt_t), intent(inout) :: subevt
	type(vector4_t), dimension(:), intent(in) :: p
	end subroutine subevt_set_p_outgoing
	<<Subevents: procedures>>=
	module subroutine subevt_set_p_beam (subevt, p)
	class(subevt_t), intent(inout) :: subevt
	type(vector4_t), dimension(:), intent(in) :: p
	integer :: i, j
	j = 1
	do i = 1, subevt%n_active
	if (subevt%prt(i)%type == PRT_BEAM) then
	call prt_set_p (subevt%prt(i), p(j))
	j = j + 1
	if (j > size (p)) exit
	end if
	end do
	end subroutine subevt_set_p_beam

	module subroutine subevt_set_p_incoming (subevt, p)
	class(subevt_t), intent(inout) :: subevt
	type(vector4_t), dimension(:), intent(in) :: p
	integer :: i, j
	j = 1
	do i = 1, subevt%n_active
	if (subevt%prt(i)%type == PRT_INCOMING) then
	call prt_set_p (subevt%prt(i), p(j))
	j = j + 1
	if (j > size (p)) exit
	end if
	end do
	end subroutine subevt_set_p_incoming

	module subroutine subevt_set_p_outgoing (subevt, p)
	class(subevt_t), intent(inout) :: subevt
	type(vector4_t), dimension(:), intent(in) :: p
	integer :: i, j
	j = 1
	do i = 1, subevt%n_active
	if (subevt%prt(i)%type == PRT_OUTGOING) then
	call prt_set_p (subevt%prt(i), p(j))
	j = j + 1
	if (j > size (p)) exit
	end if
	end do
	end subroutine subevt_set_p_outgoing

	@ %def subevt_set_p_beam
	@ %def subevt_set_p_incoming
	@ %def subevt_set_p_outgoing
	@ Separately assign the squared invariant mass, simultaneously for all
	incoming/outgoing particles.
	<<Subevents: subevt: TBP>>=
	procedure :: set_p2_beam => subevt_set_p2_beam
	procedure :: set_p2_incoming => subevt_set_p2_incoming
	procedure :: set_p2_outgoing => subevt_set_p2_outgoing
	<<Subevents: sub interfaces>>=
	module subroutine subevt_set_p2_beam (subevt, p2)
	class(subevt_t), intent(inout) :: subevt
	real(default), dimension(:), intent(in) :: p2
	end subroutine subevt_set_p2_beam
	module subroutine subevt_set_p2_incoming (subevt, p2)
	class(subevt_t), intent(inout) :: subevt
	real(default), dimension(:), intent(in) :: p2
	end subroutine subevt_set_p2_incoming
	module subroutine subevt_set_p2_outgoing (subevt, p2)
	class(subevt_t), intent(inout) :: subevt
	real(default), dimension(:), intent(in) :: p2
	end subroutine subevt_set_p2_outgoing
	<<Subevents: procedures>>=
	module subroutine subevt_set_p2_beam (subevt, p2)
	class(subevt_t), intent(inout) :: subevt
	real(default), dimension(:), intent(in) :: p2
	integer :: i, j
	j = 1
	do i = 1, subevt%n_active
	if (subevt%prt(i)%type == PRT_BEAM) then
	call prt_set_p2 (subevt%prt(i), p2(j))
	j = j + 1
	if (j > size (p2)) exit
	end if
	end do
	end subroutine subevt_set_p2_beam

	module subroutine subevt_set_p2_incoming (subevt, p2)
	class(subevt_t), intent(inout) :: subevt
	real(default), dimension(:), intent(in) :: p2
	integer :: i, j
	j = 1
	do i = 1, subevt%n_active
	if (subevt%prt(i)%type == PRT_INCOMING) then
	call prt_set_p2 (subevt%prt(i), p2(j))
	j = j + 1
	if (j > size (p2)) exit
	end if
	end do
	end subroutine subevt_set_p2_incoming

	module subroutine subevt_set_p2_outgoing (subevt, p2)
	class(subevt_t), intent(inout) :: subevt
	real(default), dimension(:), intent(in) :: p2
	integer :: i, j
	j = 1
	do i = 1, subevt%n_active
	if (subevt%prt(i)%type == PRT_OUTGOING) then
	call prt_set_p2 (subevt%prt(i), p2(j))
	j = j + 1
	if (j > size (p2)) exit
	end if
	end do
	end subroutine subevt_set_p2_outgoing

	@ %def subevt_set_p2_beam
	@ %def subevt_set_p2_incoming
	@ %def subevt_set_p2_outgoing
	@ Set polarization for an entry
	<<Subevents: public>>=
	public :: subevt_polarize
	<<Subevents: sub interfaces>>=
	module subroutine subevt_polarize (subevt, i, h)
	type(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: i, h
	end subroutine subevt_polarize
	<<Subevents: procedures>>=
	module subroutine subevt_polarize (subevt, i, h)
	type(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: i, h
	call prt_polarize (subevt%prt(i), h)
	end subroutine subevt_polarize

	@ %def subevt_polarize
	@ Set color-flow indices for an entry
	<<Subevents: public>>=
	public :: subevt_colorize
	<<Subevents: sub interfaces>>=
	module subroutine subevt_colorize (subevt, i, col, acl)
	type(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: i, col, acl
	end subroutine subevt_colorize
	<<Subevents: procedures>>=
	module subroutine subevt_colorize (subevt, i, col, acl)
	type(subevt_t), intent(inout) :: subevt
	integer, intent(in) :: i, col, acl
	if (col > 0 .and. acl > 0) then
	call prt_colorize (subevt%prt(i), [col], [acl])
	else if (col > 0) then
	call prt_colorize (subevt%prt(i), [col], [integer ::])
	else if (acl > 0) then
	call prt_colorize (subevt%prt(i), [integer ::], [acl])
	else
	call prt_colorize (subevt%prt(i), [integer ::], [integer ::])
	end if
	end subroutine subevt_colorize

	@ %def subevt_colorize
	@
	\subsubsection{Accessing contents}
	Return true if the subevent has entries.
	<<Subevents: subevt: TBP>>=
	procedure :: is_nonempty => subevt_is_nonempty
	<<Subevents: sub interfaces>>=
	module function subevt_is_nonempty (subevt) result (flag)
	logical :: flag
	class(subevt_t), intent(in) :: subevt
	end function subevt_is_nonempty
	<<Subevents: procedures>>=
	module function subevt_is_nonempty (subevt) result (flag)
	logical :: flag
	class(subevt_t), intent(in) :: subevt
	flag = subevt%n_active /= 0
	end function subevt_is_nonempty

	@ %def subevt_is_nonempty
	@ Return the number of entries
	<<Subevents: subevt: TBP>>=
	procedure :: get_length => subevt_get_length
	<<Subevents: sub interfaces>>=
	module function subevt_get_length (subevt) result (length)
	integer :: length
	class(subevt_t), intent(in) :: subevt
	end function subevt_get_length
	<<Subevents: procedures>>=
	module function subevt_get_length (subevt) result (length)
	integer :: length
	class(subevt_t), intent(in) :: subevt
	length = subevt%n_active
	end function subevt_get_length

	@ %def subevt_get_length
	@ Return a specific particle. The index is not checked for validity.
	<<Subevents: subevt: TBP>>=
	procedure :: get_prt => subevt_get_prt
	<<Subevents: sub interfaces>>=
	module function subevt_get_prt (subevt, i) result (prt)
	type(prt_t) :: prt
	class(subevt_t), intent(in) :: subevt
	integer, intent(in) :: i
	end function subevt_get_prt
	<<Subevents: procedures>>=
	module function subevt_get_prt (subevt, i) result (prt)
	type(prt_t) :: prt
	class(subevt_t), intent(in) :: subevt
	integer, intent(in) :: i
	prt = subevt%prt(i)
	end function subevt_get_prt

	@ %def subevt_get_prt
	@ Return the partonic energy squared. We take the particles with flag
	[[PRT_INCOMING]] and compute their total invariant mass.
	<<Subevents: subevt: TBP>>=
	procedure :: get_sqrts_hat => subevt_get_sqrts_hat
	<<Subevents: sub interfaces>>=
	module function subevt_get_sqrts_hat (subevt) result (sqrts_hat)
	class(subevt_t), intent(in) :: subevt
	real(default) :: sqrts_hat
	end function subevt_get_sqrts_hat
	<<Subevents: procedures>>=
	module function subevt_get_sqrts_hat (subevt) result (sqrts_hat)
	class(subevt_t), intent(in) :: subevt
	real(default) :: sqrts_hat
	type(vector4_t) :: p
	integer :: i
	do i = 1, subevt%n_active
	if (subevt%prt(i)%type == PRT_INCOMING) then
	p = p + prt_get_momentum (subevt%prt(i))
	end if
	end do
	sqrts_hat = p ** 1
	end function subevt_get_sqrts_hat

	@ %def subevt_get_sqrts_hat
	@ Return the number of incoming (outgoing) particles, respectively.
	Beam particles or composites are not counted.
	<<Subevents: subevt: TBP>>=
	procedure :: get_n_in => subevt_get_n_in
	procedure :: get_n_out => subevt_get_n_out
	<<Subevents: sub interfaces>>=
	module function subevt_get_n_in (subevt) result (n_in)
	class(subevt_t), intent(in) :: subevt
	integer :: n_in
	end function subevt_get_n_in
	module function subevt_get_n_out (subevt) result (n_out)
	class(subevt_t), intent(in) :: subevt
	integer :: n_out
	end function subevt_get_n_out
	<<Subevents: procedures>>=
	module function subevt_get_n_in (subevt) result (n_in)
	class(subevt_t), intent(in) :: subevt
	integer :: n_in
	n_in = count (subevt%prt(:subevt%n_active)%type == PRT_INCOMING)
	end function subevt_get_n_in

	module function subevt_get_n_out (subevt) result (n_out)
	class(subevt_t), intent(in) :: subevt
	integer :: n_out
	n_out = count (subevt%prt(:subevt%n_active)%type == PRT_OUTGOING)
	end function subevt_get_n_out

	@ %def subevt_get_n_in
	@ %def subevt_get_n_out
	@
	<<Subevents: interfaces>>=
	interface c_prt
	module procedure c_prt_from_subevt
	module procedure c_prt_array_from_subevt
	end interface

	@ %def c_prt
	<<Subevents: sub interfaces>>=
	module function c_prt_from_subevt (subevt, i) result (c_prt)
	type(c_prt_t) :: c_prt
	type(subevt_t), intent(in) :: subevt
	integer, intent(in) :: i
	end function c_prt_from_subevt
	module function c_prt_array_from_subevt (subevt) result (c_prt_array)
	type(subevt_t), intent(in) :: subevt
	type(c_prt_t), dimension(subevt%n_active) :: c_prt_array
	end function c_prt_array_from_subevt
	<<Subevents: procedures>>=
	module function c_prt_from_subevt (subevt, i) result (c_prt)
	type(c_prt_t) :: c_prt
	type(subevt_t), intent(in) :: subevt
	integer, intent(in) :: i
	c_prt = c_prt_from_prt (subevt%prt(i))
	end function c_prt_from_subevt

	module function c_prt_array_from_subevt (subevt) result (c_prt_array)
	type(subevt_t), intent(in) :: subevt
	type(c_prt_t), dimension(subevt%n_active) :: c_prt_array
	c_prt_array = c_prt_from_prt (subevt%prt(1:subevt%n_active))
	end function c_prt_array_from_subevt

	@ %def c_prt_from_subevt
	@ %def c_prt_array_from_subevt
	@
	\subsubsection{Operations with subevents}
	The join operation joins two subevents. When appending the
	elements of the second list, we check for each particle whether it is
	already in the first list. If yes, it is discarded. The result list
	should be initialized already.

	If a mask is present, it refers to the second subevent.
	Particles where the mask is not set are discarded.
	<<Subevents: public>>=
	public :: subevt_join
	<<Subevents: sub interfaces>>=
	module subroutine subevt_join (subevt, pl1, pl2, mask2)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl1, pl2
	logical, dimension(:), intent(in), optional :: mask2
	end subroutine subevt_join
	<<Subevents: procedures>>=
	module subroutine subevt_join (subevt, pl1, pl2, mask2)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl1, pl2
	logical, dimension(:), intent(in), optional :: mask2
	integer :: n1, n2, i, n
	n1 = pl1%n_active
	n2 = pl2%n_active
	call subevt%reset (n1 + n2)
	subevt%prt(:n1) = pl1%prt(:n1)
	n = n1
	if (present (mask2)) then
	do i = 1, pl2%n_active
	if (mask2(i)) then
	if (disjoint (i)) then
	n = n + 1
	subevt%prt(n) = pl2%prt(i)
	end if
	end if
	end do
	else
	do i = 1, pl2%n_active
	if (disjoint (i)) then
	n = n + 1
	subevt%prt(n) = pl2%prt(i)
	end if
	end do
	end if
	subevt%n_active = n
	contains
	function disjoint (i) result (flag)
	integer, intent(in) :: i
	logical :: flag
	integer :: j
	do j = 1, pl1%n_active
	if (.not. are_disjoint (pl1%prt(j), pl2%prt(i))) then
	flag = .false.
	return
	end if
	end do
	flag = .true.
	end function disjoint
	end subroutine subevt_join

	@ %def subevt_join
	@ The combine operation makes a subevent whose entries are the
	result of adding (the momenta of) each pair of particles in the input
	lists. We trace the particles from which a particles is built by
	storing a [[src]] array. Each particle entry in the [[src]] list
	contains a list of indices which indicates its building blocks. The
	indices refer to an original list of particles. Index lists are sorted,
	and they contain no element more than once.

	We thus require that in a given pseudoparticle, each original particle
	occurs at most once.
	<<Subevents: public>>=
	public :: subevt_combine
	<<Subevents: sub interfaces>>=
	module subroutine subevt_combine (subevt, pl1, pl2, mask12)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl1, pl2
	logical, dimension(:,:), intent(in), optional :: mask12
	end subroutine subevt_combine
	<<Subevents: procedures>>=
	module subroutine subevt_combine (subevt, pl1, pl2, mask12)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl1, pl2
	logical, dimension(:,:), intent(in), optional :: mask12
	integer :: n1, n2, i1, i2, n, j
	logical :: ok
	n1 = pl1%n_active
	n2 = pl2%n_active
	call subevt%reset (n1 * n2)
	n = 1
	do i1 = 1, n1
	do i2 = 1, n2
	if (present (mask12)) then
	ok = mask12(i1,i2)
	else
	ok = .true.
	end if
	if (ok) call prt_combine &
	(subevt%prt(n), pl1%prt(i1), pl2%prt(i2), ok)
	if (ok) then
	CHECK_DOUBLES: do j = 1, n - 1
	if (subevt%prt(n) .match. subevt%prt(j)) then
	ok = .false.; exit CHECK_DOUBLES
	end if
	end do CHECK_DOUBLES
	if (ok) n = n + 1
	end if
	end do
	end do
	subevt%n_active = n - 1
	end subroutine subevt_combine

	@ %def subevt_combine
	@ The collect operation makes a single-entry subevent which
	results from combining (the momenta of) all particles in the input
	list. As above, the result does not contain an original particle more
	than once; this is checked for each particle when it is collected.
	Furthermore, each entry has a mask; where the mask is false, the entry
	is dropped.

	(Thus, if the input particles are already composite, there is some
	chance that the result depends on the order of the input list and is
	not as expected. This situation should be avoided.)
	<<Subevents: public>>=
	public :: subevt_collect
	<<Subevents: sub interfaces>>=
	module subroutine subevt_collect (subevt, pl1, mask1)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl1
	logical, dimension(:), intent(in) :: mask1
	end subroutine subevt_collect
	<<Subevents: procedures>>=
	module subroutine subevt_collect (subevt, pl1, mask1)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl1
	logical, dimension(:), intent(in) :: mask1
	type(prt_t) :: prt
	integer :: i
	logical :: ok
	call subevt%reset (1)
	subevt%n_active = 0
	do i = 1, pl1%n_active
	if (mask1(i)) then
	if (subevt%n_active == 0) then
	subevt%n_active = 1
	subevt%prt(1) = pl1%prt(i)
	else
	call prt_combine (prt, subevt%prt(1), pl1%prt(i), ok)
	if (ok) subevt%prt(1) = prt
	end if
	end if
	end do
	end subroutine subevt_collect

	@ %def subevt_collect
	@ The cluster operation is similar to [[collect]], but applies a jet
	algorithm. The result is a subevent consisting of jets and, possibly,
	unclustered extra particles. As above, the result does not contain an
	original particle more than once; this is checked for each particle when it is
	collected. Furthermore, each entry has a mask; where the mask is false, the
	entry is dropped.

	The algorithm: first determine the (pseudo)particles that participate in the
	clustering. They should not overlap, and the mask entry must be set. We then
	cluster the particles, using the given jet definition. The result particles are
	retrieved from the cluster sequence. We still have to determine the source
	indices for each jet: for each input particle, we get the jet index.
	Accumulating the source entries for all particles that are part of a given
	jet, we derive the jet source entries. Finally, we delete the C structures
	that have been constructed by FastJet and its interface.
	<<Subevents: public>>=
	public :: subevt_cluster
	<<Subevents: sub interfaces>>=
	module subroutine subevt_cluster (subevt, pl1, dcut, mask1, jet_def, &
	keep_jets, exclusive)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl1
	real(default), intent(in) :: dcut
	logical, dimension(:), intent(in) :: mask1
	type(jet_definition_t), intent(in) :: jet_def
	logical, intent(in) :: keep_jets, exclusive
	end subroutine subevt_cluster
	<<Subevents: procedures>>=
	module subroutine subevt_cluster (subevt, pl1, dcut, mask1, jet_def, &
	keep_jets, exclusive)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl1
	real(default), intent(in) :: dcut
	logical, dimension(:), intent(in) :: mask1
	type(jet_definition_t), intent(in) :: jet_def
	logical, intent(in) :: keep_jets, exclusive
	integer, dimension(:), allocatable :: map, jet_index
	type(pseudojet_t), dimension(:), allocatable :: jet_in, jet_out
	type(pseudojet_vector_t) :: jv_in, jv_out
	type(cluster_sequence_t) :: cs
	integer :: i, n_src, n_active
	call map_prt_index (pl1, mask1, n_src, map)
	n_active = count (map /= 0)
	allocate (jet_in (n_active))
	allocate (jet_index (n_active))
	do i = 1, n_active
	call jet_in(i)%init (prt_get_momentum (pl1%prt(map(i))))
	end do
	call jv_in%init (jet_in)
	call cs%init (jv_in, jet_def)
	if (exclusive) then
	jv_out = cs%exclusive_jets (dcut)
	else
	jv_out = cs%inclusive_jets ()
	end if
	call cs%assign_jet_indices (jv_out, jet_index)
	allocate (jet_out (jv_out%size ()))
	jet_out = jv_out
	call fill_pseudojet (subevt, pl1, jet_out, jet_index, n_src, map)
	do i = 1, size (jet_out)
	call jet_out(i)%final ()
	end do
	call jv_out%final ()
	call cs%final ()
	call jv_in%final ()
	do i = 1, size (jet_in)
	call jet_in(i)%final ()
	end do
	contains
	! Uniquely combine sources and add map those new indices to the old ones
	subroutine map_prt_index (pl1, mask1, n_src, map)
	type(subevt_t), intent(in) :: pl1
	logical, dimension(:), intent(in) :: mask1
	integer, intent(out) :: n_src
	integer, dimension(:), allocatable, intent(out) :: map
	integer, dimension(:), allocatable :: src, src_tmp
	integer :: i
	allocate (src(0))
	allocate (map (pl1%n_active), source = 0)
	n_active = 0
	do i = 1, pl1%n_active
	if (.not. mask1(i)) cycle
	call combine_index_lists (src_tmp, src, pl1%prt(i)%src)
	if (.not. allocated (src_tmp)) cycle
	call move_alloc (from=src_tmp, to=src)
	n_active = n_active + 1
	map(n_active) = i
	end do
	n_src = size (src)
	end subroutine map_prt_index
	! Retrieve source(s) of a jet and fill corresponding subevent
	subroutine fill_pseudojet (subevt, pl1, jet_out, jet_index, n_src, map)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl1
	type(pseudojet_t), dimension(:), intent(in) :: jet_out
	integer, dimension(:), intent(in) :: jet_index
	integer, dimension(:), intent(in) :: map
	integer, intent(in) :: n_src
	integer, dimension(n_src) :: src_fill
	integer :: i, jet, k, combined_pdg, pdg, n_quarks, n_src_fill
	logical :: is_b, is_c
	call subevt%reset (size (jet_out))
	do jet = 1, size (jet_out)
	pdg = 0; src_fill = 0; n_src_fill = 0; combined_pdg = 0; n_quarks = 0
	is_b = .false.; is_c = .false.
	PARTICLE: do i = 1, size (jet_index)
	if (jet_index(i) /= jet) cycle PARTICLE
	associate (prt => pl1%prt(map(i)), n_src_prt => size(pl1%prt(map(i))%src))
	do k = 1, n_src_prt
	src_fill(n_src_fill + k) = prt%src(k)
	end do
	n_src_fill = n_src_fill + n_src_prt
	if (is_quark (prt%pdg)) then
	n_quarks = n_quarks + 1
	if (.not. is_b) then
	if (abs (prt%pdg) == 5) then
	is_b = .true.
	is_c = .false.
	else if (abs (prt%pdg) == 4) then
	is_c = .true.
	end if
	end if
	if (combined_pdg == 0) combined_pdg = prt%pdg
	end if
	end associate
	end do PARTICLE
	if (keep_jets .and. n_quarks == 1) pdg = combined_pdg
	call prt_init_pseudojet (subevt%prt(jet), jet_out(jet), &
	src_fill(:n_src_fill), pdg, is_b, is_c)
	end do
	end subroutine fill_pseudojet
	end subroutine subevt_cluster

	@ %def subevt_cluster
	@ Do recombination. The incoming subevent [[pl]] is left unchanged if
	it either does not contain photons at all, or consists just of a
	single photon and nothing else or the photon does have a larger $R>R_0$
	distance to the nearest other particle or does not fulfill the
	[[mask1]] condition. Otherwise, the subevent is one entry shorter and
	contains a single recombined particle whose original flavor is kept
	depending on the setting [[keep_flv]]. When this subroutine is called,
	it is explicitly assumed that there is only one photon. For the
	moment, we take here the first photon from the subevent to possibly
	recombine and leave this open for generalization.
	<<Subevents: public>>=
	public :: subevt_recombine
	<<Subevents: sub interfaces>>=
	module subroutine subevt_recombine (subevt, pl, mask1, reco_r0, keep_flv)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl
	logical, dimension(:), intent(in) :: mask1
	logical, intent(in) :: keep_flv
	real(default), intent(in) :: reco_r0
	end subroutine subevt_recombine
	<<Subevents: procedures>>=
	module subroutine subevt_recombine (subevt, pl, mask1, reco_r0, keep_flv)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl
	type(prt_t), dimension(:), allocatable :: prt_rec
	logical, dimension(:), intent(in) :: mask1
	logical, intent(in) :: keep_flv
	real(default), intent(in) :: reco_r0
	real(default), dimension(:), allocatable :: del_rij
	integer, dimension(:), allocatable :: i_sortr
	type(prt_t) :: prt_gam, prt_comb
	logical :: recombine, ok
	integer :: i, n, i_gam, n_gam, n_rec, pdg_orig
	n = pl%get_length ()
	n_gam = 0
	FIND_FIRST_PHOTON: do i = 1, n
	if (prt_is_photon (pl%prt (i))) then
	n_gam = n_gam + 1
	prt_gam = pl%prt (i)
	i_gam = i
	exit FIND_FIRST_PHOTON
	end if
	end do FIND_FIRST_PHOTON
	n_rec = n - n_gam
	if (n_gam == 0) then
	subevt = pl
	else
	if (n_rec > 0) then
	allocate (prt_rec (n_rec))
	do i = 1, n_rec
	if (i == i_gam) cycle
	if (i < i_gam) then
	prt_rec(i) = pl%prt(i)
	else
	prt_rec(i) = pl%prt(i+n_gam)
	end if
	end do
	allocate (del_rij (n_rec), i_sortr (n_rec))
	del_rij(1:n_rec) = eta_phi_distance(prt_get_momentum (prt_gam), &
	prt_get_momentum (prt_rec(1:n_rec)))
	i_sortr = order (del_rij)
	recombine = del_rij (i_sortr (1)) <= reco_r0 .and. mask1(i_gam)
	if (recombine) then
	call subevt%reset (pl%n_active-n_gam)
	do i = 1, n_rec
	if (i == i_sortr(1)) then
	pdg_orig = prt_get_pdg (prt_rec(i_sortr (1)))
	call prt_combine (prt_comb, prt_gam, prt_rec(i_sortr (1)), ok)
	if (ok) then
	subevt%prt(i_sortr (1)) = prt_comb
	if (keep_flv) call prt_set_pdg &
	(subevt%prt(i_sortr (1)), pdg_orig)
	end if
	else
	subevt%prt(i) = prt_rec(i)
	end if
	end do
	else
	subevt = pl
	end if
	else
	subevt = pl
	end if
	end if
	end subroutine subevt_recombine

	@ %def subevt_recombine
	@ Return a list of all particles for which the mask is true.
	<<Subevents: public>>=
	public :: subevt_select
	<<Subevents: sub interfaces>>=
	module subroutine subevt_select (subevt, pl, mask1)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl
	logical, dimension(:), intent(in) :: mask1
	end subroutine subevt_select
	<<Subevents: procedures>>=
	module subroutine subevt_select (subevt, pl, mask1)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl
	logical, dimension(:), intent(in) :: mask1
	integer :: i, n
	call subevt%reset (pl%n_active)
	n = 0
	do i = 1, pl%n_active
	if (mask1(i)) then
	n = n + 1
	subevt%prt(n) = pl%prt(i)
	end if
	end do
	subevt%n_active = n
	end subroutine subevt_select

	@ %def subevt_select
	@ Return a subevent which consists of the single particle with
	specified [[index]]. If [[index]] is negative, count from the end.
	If it is out of bounds, return an empty list.
	<<Subevents: public>>=
	public :: subevt_extract
	<<Subevents: sub interfaces>>=
	module subroutine subevt_extract (subevt, pl, index)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl
	integer, intent(in) :: index
	end subroutine subevt_extract
	<<Subevents: procedures>>=
	module subroutine subevt_extract (subevt, pl, index)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl
	integer, intent(in) :: index
	if (index > 0) then
	if (index <= pl%n_active) then
	call subevt%reset (1)
	subevt%prt(1) = pl%prt(index)
	else
	call subevt%reset (0)
	end if
	else if (index < 0) then
	if (abs (index) <= pl%n_active) then
	call subevt%reset (1)
	subevt%prt(1) = pl%prt(pl%n_active + 1 + index)
	else
	call subevt%reset (0)
	end if
	else
	call subevt%reset (0)
	end if
	end subroutine subevt_extract

	@ %def subevt_extract
	@ Return the list of particles sorted according to increasing values
	of the provided integer or real array. If no array is given, sort by
	PDG value.
	<<Subevents: public>>=
	public :: subevt_sort
	<<Subevents: interfaces>>=
	interface subevt_sort
	module procedure subevt_sort_pdg
	module procedure subevt_sort_int
	module procedure subevt_sort_real
	end interface

	<<Subevents: sub interfaces>>=
	module subroutine subevt_sort_pdg (subevt, pl)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl
	end subroutine subevt_sort_pdg
	module subroutine subevt_sort_int (subevt, pl, ival)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl
	integer, dimension(:), intent(in) :: ival
	end subroutine subevt_sort_int
	module subroutine subevt_sort_real (subevt, pl, rval)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl
	real(default), dimension(:), intent(in) :: rval
	end subroutine subevt_sort_real
	<<Subevents: procedures>>=
	module subroutine subevt_sort_pdg (subevt, pl)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl
	integer :: n
	n = subevt%n_active
	call subevt_sort_int (subevt, pl, abs (3 * subevt%prt(:n)%pdg - 1))
	end subroutine subevt_sort_pdg

	module subroutine subevt_sort_int (subevt, pl, ival)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl
	integer, dimension(:), intent(in) :: ival
	call subevt%reset (pl%n_active)
	subevt%n_active = pl%n_active
	subevt%prt = pl%prt( order (ival) )
	end subroutine subevt_sort_int

	module subroutine subevt_sort_real (subevt, pl, rval)
	type(subevt_t), intent(inout) :: subevt
	type(subevt_t), intent(in) :: pl
	real(default), dimension(:), intent(in) :: rval
	integer :: i
	integer, dimension(size(rval)) :: idx
	call subevt%reset (pl%n_active)
	subevt%n_active = pl%n_active
	if (allocated (subevt%prt)) deallocate (subevt%prt)
	allocate (subevt%prt (size(pl%prt)))
	idx = order (rval)
	do i = 1, size (idx)
	subevt%prt(i) = pl%prt (idx(i))
	end do
	end subroutine subevt_sort_real

	@ %def subevt_sort
	@ Return the list of particles which have any of the specified PDG
	codes (and optionally particle type: beam, incoming, outgoing).
	<<Subevents: public>>=
	public :: subevt_select_pdg_code
	<<Subevents: sub interfaces>>=
	module subroutine subevt_select_pdg_code (subevt, aval, subevt_in, prt_type)
	type(subevt_t), intent(inout) :: subevt
	type(pdg_array_t), intent(in) :: aval
	type(subevt_t), intent(in) :: subevt_in
	integer, intent(in), optional :: prt_type
	end subroutine subevt_select_pdg_code
	<<Subevents: procedures>>=
	module subroutine subevt_select_pdg_code (subevt, aval, subevt_in, prt_type)
	type(subevt_t), intent(inout) :: subevt
	type(pdg_array_t), intent(in) :: aval
	type(subevt_t), intent(in) :: subevt_in
	integer, intent(in), optional :: prt_type
	integer :: n_active, n_match
	logical, dimension(:), allocatable :: mask
	integer :: i, j
	n_active = subevt_in%n_active
	allocate (mask (n_active))
	forall (i = 1:n_active) &
	mask(i) = aval .match. subevt_in%prt(i)%pdg
	if (present (prt_type)) &
	mask = mask .and. subevt_in%prt(:n_active)%type == prt_type
	n_match = count (mask)
	call subevt%reset (n_match)
	j = 0
	do i = 1, n_active
	if (mask(i)) then
	j = j + 1
	subevt%prt(j) = subevt_in%prt(i)
	end if
	end do
	end subroutine subevt_select_pdg_code

	@ %def subevt_select_pdg_code
	@
	\subsection{Eliminate numerical noise}
	This is useful for testing purposes: set entries to zero that are smaller in
	absolute values than a given tolerance parameter.

	Note: instead of setting the tolerance in terms of EPSILON
	(kind-dependent), we fix it to $10^{-16}$, which is the typical value
	for double precision. The reason is that there are situations where
	intermediate representations (external libraries, files) are limited
	to double precision, even if the main program uses higher precision.
	<<Subevents: public>>=
	public :: pacify
	<<Subevents: interfaces>>=
	interface pacify
	module procedure pacify_prt
	module procedure pacify_subevt
	end interface pacify

	@ %def pacify
	<<Subevents: sub interfaces>>=
	module subroutine pacify_prt (prt)
	class(prt_t), intent(inout) :: prt
	end subroutine pacify_prt
	module subroutine pacify_subevt (subevt)
	class(subevt_t), intent(inout) :: subevt
	end subroutine pacify_subevt
	<<Subevents: procedures>>=
	module subroutine pacify_prt (prt)
	class(prt_t), intent(inout) :: prt
	real(default) :: e
	e = max (1E-10_default * energy (prt%p), 1E-13_default)
	call pacify (prt%p, e)
	call pacify (prt%p2, 1E3_default * e)
	end subroutine pacify_prt

	module subroutine pacify_subevt (subevt)
	class(subevt_t), intent(inout) :: subevt
	integer :: i
	do i = 1, subevt%n_active
	call pacify (subevt%prt(i))
	end do
	end subroutine pacify_subevt

	@ %def pacify_prt
	@ %def pacify_subevt
	@
	\clearpage
	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	\section{Analysis tools}

	This module defines structures useful for data analysis. These
	include observables, histograms, and plots.

	Observables are quantities that are calculated and summed up event by
	event. At the end, one can compute the average and error.

	Histograms have their bins in addition to the observable properties.
	Histograms are usually written out in tables and displayed
	graphically.

	In plots, each record creates its own entry in a table. This can be
	used for scatter plots if called event by event, or for plotting
	dependencies on parameters if called once per integration run.

	Graphs are container for histograms and plots, which carry their own graphics
	options.

	The type layout is still somewhat obfuscated. This would become much simpler
	if type extension could be used.
	<<[[analysis.f90]]>>=
	<<File header>>

	module analysis

	<<Use kinds>>
	<<Use strings>>
	use os_interface

	<<Standard module head>>

	<<Analysis: public>>

	<<Analysis: parameters>>

	<<Analysis: types>>

	<<Analysis: interfaces>>

	<<Analysis: variables>>

	interface
	<<Analysis: sub interfaces>>
	end interface

	end module analysis
	@ %def analysis
	@
	<<[[analysis_sub.f90]]>>=
	<<File header>>

	submodule (analysis) analysis_s

	use io_units
	use format_utils, only: quote_underscore, tex_format
	use system_defs, only: TAB
	use diagnostics
	use ifiles

	implicit none

	contains

	<<Analysis: procedures>>

	end submodule analysis_s

	@ %def analysis_s
	@
	\subsection{Output formats}
	These formats share a common field width (alignment).
	<<Analysis: parameters>>=
	character(*), parameter, public :: HISTOGRAM_HEAD_FORMAT = "1x,A15,3x"
	character(*), parameter, public :: HISTOGRAM_INTG_FORMAT = "3x,I9,3x"
	character(*), parameter, public :: HISTOGRAM_DATA_FORMAT = "ES19.12"

	@ %def HISTOGRAM_HEAD_FORMAT HISTOGRAM_INTG_FORMAT HISTOGRAM_DATA_FORMAT
	@
	\subsection{Graph options}
	These parameters are used for displaying data. They apply to a whole graph,
	which may contain more than one plot element.

	The GAMELAN code chunks are part of both [[graph_options]] and
	[[drawing_options]]. The [[drawing_options]] copy is used in histograms and
	plots, also as graph elements. The [[graph_options]] copy is used for
	[[graph]] objects as a whole. Both copies are usually identical.
	<<Analysis: public>>=
	public :: graph_options_t
	<<Analysis: types>>=
	type :: graph_options_t
	private
	type(string_t) :: id
	type(string_t) :: title
	type(string_t) :: description
	type(string_t) :: x_label
	type(string_t) :: y_label
	integer :: width_mm = 130
	integer :: height_mm = 90
	logical :: x_log = .false.
	logical :: y_log = .false.
	real(default) :: x_min = 0
	real(default) :: x_max = 1
	real(default) :: y_min = 0
	real(default) :: y_max = 1
	logical :: x_min_set = .false.
	logical :: x_max_set = .false.
	logical :: y_min_set = .false.
	logical :: y_max_set = .false.
	type(string_t) :: gmlcode_bg
	type(string_t) :: gmlcode_fg
	contains
	<<Analysis: graph options: TBP>>
	end type graph_options_t

	@ %def graph_options_t
	@ Initialize the record, all strings are empty. The limits are undefined.
	<<Analysis: graph options: TBP>>=
	procedure :: init => graph_options_init
	<<Analysis: sub interfaces>>=
	module subroutine graph_options_init (graph_options)
	class(graph_options_t), intent(out) :: graph_options
	end subroutine graph_options_init
	<<Analysis: procedures>>=
	module subroutine graph_options_init (graph_options)
	class(graph_options_t), intent(out) :: graph_options
	graph_options%id = ""
	graph_options%title = ""
	graph_options%description = ""
	graph_options%x_label = ""
	graph_options%y_label = ""
	graph_options%gmlcode_bg = ""
	graph_options%gmlcode_fg = ""
	end subroutine graph_options_init

	@ %def graph_options_init
	@ Set individual options.
	<<Analysis: graph options: TBP>>=
	procedure :: set => graph_options_set
	<<Analysis: sub interfaces>>=
	module subroutine graph_options_set (graph_options, id, &
	title, description, x_label, y_label, width_mm, height_mm, &
	x_log, y_log, x_min, x_max, y_min, y_max, &
	gmlcode_bg, gmlcode_fg)
	class(graph_options_t), intent(inout) :: graph_options
	type(string_t), intent(in), optional :: id
	type(string_t), intent(in), optional :: title
	type(string_t), intent(in), optional :: description
	type(string_t), intent(in), optional :: x_label, y_label
	integer, intent(in), optional :: width_mm, height_mm
	logical, intent(in), optional :: x_log, y_log
	real(default), intent(in), optional :: x_min, x_max, y_min, y_max
	type(string_t), intent(in), optional :: gmlcode_bg, gmlcode_fg
	end subroutine graph_options_set
	<<Analysis: procedures>>=
	module subroutine graph_options_set (graph_options, id, &
	title, description, x_label, y_label, width_mm, height_mm, &
	x_log, y_log, x_min, x_max, y_min, y_max, &
	gmlcode_bg, gmlcode_fg)
	class(graph_options_t), intent(inout) :: graph_options
	type(string_t), intent(in), optional :: id
	type(string_t), intent(in), optional :: title
	type(string_t), intent(in), optional :: description
	type(string_t), intent(in), optional :: x_label, y_label
	integer, intent(in), optional :: width_mm, height_mm
	logical, intent(in), optional :: x_log, y_log
	real(default), intent(in), optional :: x_min, x_max, y_min, y_max
	type(string_t), intent(in), optional :: gmlcode_bg, gmlcode_fg
	if (present (id)) graph_options%id = id
	if (present (title)) graph_options%title = title
	if (present (description)) graph_options%description = description
	if (present (x_label)) graph_options%x_label = x_label
	if (present (y_label)) graph_options%y_label = y_label
	if (present (width_mm)) graph_options%width_mm = width_mm
	if (present (height_mm)) graph_options%height_mm = height_mm
	if (present (x_log)) graph_options%x_log = x_log
	if (present (y_log)) graph_options%y_log = y_log
	if (present (x_min)) graph_options%x_min = x_min
	if (present (x_max)) graph_options%x_max = x_max
	if (present (y_min)) graph_options%y_min = y_min
	if (present (y_max)) graph_options%y_max = y_max
	if (present (x_min)) graph_options%x_min_set = .true.
	if (present (x_max)) graph_options%x_max_set = .true.
	if (present (y_min)) graph_options%y_min_set = .true.
	if (present (y_max)) graph_options%y_max_set = .true.
	if (present (gmlcode_bg)) graph_options%gmlcode_bg = gmlcode_bg
	if (present (gmlcode_fg)) graph_options%gmlcode_fg = gmlcode_fg
	end subroutine graph_options_set

	@ %def graph_options_set
	@ Write a simple account of all options.
	<<Analysis: graph options: TBP>>=
	procedure :: write => graph_options_write
	<<Analysis: sub interfaces>>=
	module subroutine graph_options_write (gro, unit)
	class(graph_options_t), intent(in) :: gro
	integer, intent(in), optional :: unit
	end subroutine graph_options_write
	<<Analysis: procedures>>=
	module subroutine graph_options_write (gro, unit)
	class(graph_options_t), intent(in) :: gro
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	1 format (A,1x,'"',A,'"')
	2 format (A,1x,L1)
	3 format (A,1x,ES19.12)
	4 format (A,1x,I0)
	5 format (A,1x,'[undefined]')
	write (u, 1) "title =", char (gro%title)
	write (u, 1) "description =", char (gro%description)
	write (u, 1) "x_label =", char (gro%x_label)
	write (u, 1) "y_label =", char (gro%y_label)
	write (u, 2) "x_log =", gro%x_log
	write (u, 2) "y_log =", gro%y_log
	if (gro%x_min_set) then
	write (u, 3) "x_min =", gro%x_min
	else
	write (u, 5) "x_min ="
	end if
	if (gro%x_max_set) then
	write (u, 3) "x_max =", gro%x_max
	else
	write (u, 5) "x_max ="
	end if
	if (gro%y_min_set) then
	write (u, 3) "y_min =", gro%y_min
	else
	write (u, 5) "y_min ="
	end if
	if (gro%y_max_set) then
	write (u, 3) "y_max =", gro%y_max
	else
	write (u, 5) "y_max ="
	end if
	write (u, 4) "width_mm =", gro%width_mm
	write (u, 4) "height_mm =", gro%height_mm
	write (u, 1) "gmlcode_bg =", char (gro%gmlcode_bg)
	write (u, 1) "gmlcode_fg =", char (gro%gmlcode_fg)
	end subroutine graph_options_write

	@ %def graph_options_write
	@ Write a \LaTeX\ header/footer for the analysis file.
	<<Analysis: procedures>>=
	subroutine graph_options_write_tex_header (gro, unit)
	type(graph_options_t), intent(in) :: gro
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	if (gro%title /= "") then
	write (u, "(A)")
	write (u, "(A)") "\section{" // char (gro%title) // "}"
	else
	write (u, "(A)") "\section{" // char (quote_underscore (gro%id)) // "}"
	end if
	if (gro%description /= "") then
	write (u, "(A)") char (gro%description)
	write (u, *)
	write (u, "(A)") "\vspace*{\baselineskip}"
	end if
	write (u, "(A)") "\vspace*{\baselineskip}"
	write (u, "(A)") "\unitlength 1mm"
	write (u, "(A,I0,',',I0,A)") &
	"\begin{gmlgraph*}(", &
	gro%width_mm, gro%height_mm, &
	")[dat]"
	end subroutine graph_options_write_tex_header

	subroutine graph_options_write_tex_footer (gro, unit)
	type(graph_options_t), intent(in) :: gro
	integer, intent(in), optional :: unit
	integer :: u, width, height
	width = gro%width_mm - 10
	height = gro%height_mm - 10
	u = given_output_unit (unit)
	write (u, "(A)") " begingmleps ""Whizard-Logo.eps"";"
	write (u, "(A,I0,A,I0,A)") &
	" base := (", width, "unitlength,", height, "unitlength);"
	write (u, "(A)") " height := 9.6*unitlength;"
	write (u, "(A)") " width := 11.2*unitlength;"
	write (u, "(A)") " endgmleps;"
	write (u, "(A)") "\end{gmlgraph*}"
	end subroutine graph_options_write_tex_footer

	@ %def graph_options_write_tex_header
	@ %def graph_options_write_tex_footer
	@ Return the analysis object ID.
	<<Analysis: procedures>>=
	function graph_options_get_id (gro) result (id)
	type(string_t) :: id
	type(graph_options_t), intent(in) :: gro
	id = gro%id
	end function graph_options_get_id

	@ %def graph_options_get_id
	@ Create an appropriate [[setup]] command (linear/log).
	<<Analysis: procedures>>=
	function graph_options_get_gml_setup (gro) result (cmd)
	type(string_t) :: cmd
	type(graph_options_t), intent(in) :: gro
	type(string_t) :: x_str, y_str
	if (gro%x_log) then
	x_str = "log"
	else
	x_str = "linear"
	end if
	if (gro%y_log) then
	y_str = "log"
	else
	y_str = "linear"
	end if
	cmd = "setup (" // x_str // ", " // y_str // ");"
	end function graph_options_get_gml_setup

	@ %def graph_options_get_gml_setup
	@ Return the labels in GAMELAN form.
	<<Analysis: procedures>>=
	function graph_options_get_gml_x_label (gro) result (cmd)
	type(string_t) :: cmd
	type(graph_options_t), intent(in) :: gro
	cmd = 'label.bot (<' // '<' // gro%x_label // '>' // '>, out);'
	end function graph_options_get_gml_x_label

	function graph_options_get_gml_y_label (gro) result (cmd)
	type(string_t) :: cmd
	type(graph_options_t), intent(in) :: gro
	cmd = 'label.ulft (<' // '<' // gro%y_label // '>' // '>, out);'
	end function graph_options_get_gml_y_label

	@ %def graph_options_get_gml_x_label
	@ %def graph_options_get_gml_y_label
	@ Create an appropriate [[graphrange]] statement for the given graph options.
	Where the graph options are not set, use the supplied arguments, if any,
	otherwise set the undefined value.
	<<Analysis: procedures>>=
	function graph_options_get_gml_graphrange &
	(gro, x_min, x_max, y_min, y_max) result (cmd)
	type(string_t) :: cmd
	type(graph_options_t), intent(in) :: gro
	real(default), intent(in), optional :: x_min, x_max, y_min, y_max
	type(string_t) :: x_min_str, x_max_str, y_min_str, y_max_str
	character(*), parameter :: fmt = "(ES15.8)"
	if (gro%x_min_set) then
	x_min_str = "#" // trim (adjustl (real2string (gro%x_min, fmt)))
	else if (present (x_min)) then
	x_min_str = "#" // trim (adjustl (real2string (x_min, fmt)))
	else
	x_min_str = "??"
	end if
	if (gro%x_max_set) then
	x_max_str = "#" // trim (adjustl (real2string (gro%x_max, fmt)))
	else if (present (x_max)) then
	x_max_str = "#" // trim (adjustl (real2string (x_max, fmt)))
	else
	x_max_str = "??"
	end if
	if (gro%y_min_set) then
	y_min_str = "#" // trim (adjustl (real2string (gro%y_min, fmt)))
	else if (present (y_min)) then
	y_min_str = "#" // trim (adjustl (real2string (y_min, fmt)))
	else
	y_min_str = "??"
	end if
	if (gro%y_max_set) then
	y_max_str = "#" // trim (adjustl (real2string (gro%y_max, fmt)))
	else if (present (y_max)) then
	y_max_str = "#" // trim (adjustl (real2string (y_max, fmt)))
	else
	y_max_str = "??"
	end if
	cmd = "graphrange (" // x_min_str // ", " // y_min_str // "), " &
	// "(" // x_max_str // ", " // y_max_str // ");"
	end function graph_options_get_gml_graphrange

	@ %def graph_options_get_gml_graphrange
	@ Get extra GAMELAN code to be executed before and after the usual drawing
	commands.
	<<Analysis: procedures>>=
	function graph_options_get_gml_bg_command (gro) result (cmd)
	type(string_t) :: cmd
	type(graph_options_t), intent(in) :: gro
	cmd = gro%gmlcode_bg
	end function graph_options_get_gml_bg_command

	function graph_options_get_gml_fg_command (gro) result (cmd)
	type(string_t) :: cmd
	type(graph_options_t), intent(in) :: gro
	cmd = gro%gmlcode_fg
	end function graph_options_get_gml_fg_command

	@ %def graph_options_get_gml_bg_command
	@ %def graph_options_get_gml_fg_command
	@ Append the header for generic data output in ifile format. We print only
	labels, not graphics parameters.
	<<Analysis: procedures>>=
	subroutine graph_options_get_header (pl, header, comment)
	type(graph_options_t), intent(in) :: pl
	type(ifile_t), intent(inout) :: header
	type(string_t), intent(in), optional :: comment
	type(string_t) :: c
	if (present (comment)) then
	c = comment
	else
	c = ""
	end if
	call ifile_append (header, &
	c // "ID: " // pl%id)
	call ifile_append (header, &
	c // "title: " // pl%title)
	call ifile_append (header, &
	c // "description: " // pl%description)
	call ifile_append (header, &
	c // "x axis label: " // pl%x_label)
	call ifile_append (header, &
	c // "y axis label: " // pl%y_label)
	end subroutine graph_options_get_header

	@ %def graph_options_get_header
	@
	\subsection{Drawing options}
	These options apply to an individual graph element (histogram or plot).
	<<Analysis: public>>=
	public :: drawing_options_t
	<<Analysis: types>>=
	type :: drawing_options_t
	type(string_t) :: dataset
	logical :: with_hbars = .false.
	logical :: with_base = .false.
	logical :: piecewise = .false.
	logical :: fill = .false.
	logical :: draw = .false.
	logical :: err = .false.
	logical :: symbols = .false.
	type(string_t) :: fill_options
	type(string_t) :: draw_options
	type(string_t) :: err_options
	type(string_t) :: symbol
	type(string_t) :: gmlcode_bg
	type(string_t) :: gmlcode_fg
	contains
	<<Analysis: drawing options: TBP>>
	end type drawing_options_t

	@ %def drawing_options_t
	@ Write a simple account of all options.
	<<Analysis: drawing options: TBP>>=
	procedure :: write => drawing_options_write
	<<Analysis: sub interfaces>>=
	module subroutine drawing_options_write (dro, unit)
	class(drawing_options_t), intent(in) :: dro
	integer, intent(in), optional :: unit
	end subroutine drawing_options_write
	<<Analysis: procedures>>=
	module subroutine drawing_options_write (dro, unit)
	class(drawing_options_t), intent(in) :: dro
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit)
	1 format (A,1x,'"',A,'"')
	2 format (A,1x,L1)
	write (u, 2) "with_hbars =", dro%with_hbars
	write (u, 2) "with_base =", dro%with_base
	write (u, 2) "piecewise =", dro%piecewise
	write (u, 2) "fill =", dro%fill
	write (u, 2) "draw =", dro%draw
	write (u, 2) "err =", dro%err
	write (u, 2) "symbols =", dro%symbols
	write (u, 1) "fill_options=", char (dro%fill_options)
	write (u, 1) "draw_options=", char (dro%draw_options)
	write (u, 1) "err_options =", char (dro%err_options)
	write (u, 1) "symbol =", char (dro%symbol)
	write (u, 1) "gmlcode_bg =", char (dro%gmlcode_bg)
	write (u, 1) "gmlcode_fg =", char (dro%gmlcode_fg)
	end subroutine drawing_options_write

	@ %def drawing_options_write
	@ Init with empty strings and default options, appropriate for either
	histogram or plot.
	<<Analysis: drawing options: TBP>>=
	procedure :: init_histogram => drawing_options_init_histogram
	procedure :: init_plot => drawing_options_init_plot
	<<Analysis: sub interfaces>>=
	module subroutine drawing_options_init_histogram (dro)
	class(drawing_options_t), intent(out) :: dro
	end subroutine drawing_options_init_histogram
	module subroutine drawing_options_init_plot (dro)
	class(drawing_options_t), intent(out) :: dro
	end subroutine drawing_options_init_plot
	<<Analysis: procedures>>=
	module subroutine drawing_options_init_histogram (dro)
	class(drawing_options_t), intent(out) :: dro
	dro%dataset = "dat"
	dro%with_hbars = .true.
	dro%with_base = .true.
	dro%piecewise = .true.
	dro%fill = .true.
	dro%draw = .true.
	dro%fill_options = "withcolor col.default"
	dro%draw_options = ""
	dro%err_options = ""
	dro%symbol = "fshape(circle scaled 1mm)()"
	dro%gmlcode_bg = ""
	dro%gmlcode_fg = ""
	end subroutine drawing_options_init_histogram

	module subroutine drawing_options_init_plot (dro)
	class(drawing_options_t), intent(out) :: dro
	dro%dataset = "dat"
	dro%draw = .true.
	dro%fill_options = "withcolor col.default"
	dro%draw_options = ""
	dro%err_options = ""
	dro%symbol = "fshape(circle scaled 1mm)()"
	dro%gmlcode_bg = ""
	dro%gmlcode_fg = ""
	end subroutine drawing_options_init_plot

	@ %def drawing_options_init_histogram
	@ %def drawing_options_init_plot
	@ Set individual options.
	<<Analysis: drawing options: TBP>>=
	procedure :: set => drawing_options_set
	<<Analysis: sub interfaces>>=
	module subroutine drawing_options_set (dro, dataset, &
	with_hbars, with_base, piecewise, fill, draw, err, symbols, &
	fill_options, draw_options, err_options, symbol, &
	gmlcode_bg, gmlcode_fg)
	class(drawing_options_t), intent(inout) :: dro
	type(string_t), intent(in), optional :: dataset
	logical, intent(in), optional :: with_hbars, with_base, piecewise
	logical, intent(in), optional :: fill, draw, err, symbols
	type(string_t), intent(in), optional :: fill_options, draw_options
	type(string_t), intent(in), optional :: err_options, symbol
	type(string_t), intent(in), optional :: gmlcode_bg, gmlcode_fg
	end subroutine drawing_options_set
	<<Analysis: procedures>>=
	module subroutine drawing_options_set (dro, dataset, &
	with_hbars, with_base, piecewise, fill, draw, err, symbols, &
	fill_options, draw_options, err_options, symbol, &
	gmlcode_bg, gmlcode_fg)
	class(drawing_options_t), intent(inout) :: dro
	type(string_t), intent(in), optional :: dataset
	logical, intent(in), optional :: with_hbars, with_base, piecewise
	logical, intent(in), optional :: fill, draw, err, symbols
	type(string_t), intent(in), optional :: fill_options, draw_options
	type(string_t), intent(in), optional :: err_options, symbol
	type(string_t), intent(in), optional :: gmlcode_bg, gmlcode_fg
	if (present (dataset)) dro%dataset = dataset
	if (present (with_hbars)) dro%with_hbars = with_hbars
	if (present (with_base)) dro%with_base = with_base
	if (present (piecewise)) dro%piecewise = piecewise
	if (present (fill)) dro%fill = fill
	if (present (draw)) dro%draw = draw
	if (present (err)) dro%err = err
	if (present (symbols)) dro%symbols = symbols
	if (present (fill_options)) dro%fill_options = fill_options
	if (present (draw_options)) dro%draw_options = draw_options
	if (present (err_options)) dro%err_options = err_options
	if (present (symbol)) dro%symbol = symbol
	if (present (gmlcode_bg)) dro%gmlcode_bg = gmlcode_bg
	if (present (gmlcode_fg)) dro%gmlcode_fg = gmlcode_fg
	end subroutine drawing_options_set

	@ %def drawing_options_set
	@ There are sepate commands for drawing the
	curve and for drawing errors. The symbols are applied to the latter. First
	of all, we may have to compute a baseline:
	<<Analysis: procedures>>=
	function drawing_options_get_calc_command (dro) result (cmd)
	type(string_t) :: cmd
	type(drawing_options_t), intent(in) :: dro
	if (dro%with_base) then
	cmd = "calculate " // dro%dataset // ".base (" // dro%dataset // ") " &
	// "(x, #0);"
	else
	cmd = ""
	end if
	end function drawing_options_get_calc_command

	@ %def drawing_options_get_calc_command
	@ Return the drawing command.
	<<Analysis: procedures>>=
	function drawing_options_get_draw_command (dro) result (cmd)
	type(string_t) :: cmd
	type(drawing_options_t), intent(in) :: dro
	if (dro%fill) then
	cmd = "fill"
	else if (dro%draw) then
	cmd = "draw"
	else
	cmd = ""
	end if
	if (dro%fill .or. dro%draw) then
	if (dro%piecewise) cmd = cmd // " piecewise"
	if (dro%draw .and. dro%with_base) cmd = cmd // " cyclic"
	cmd = cmd // " from (" // dro%dataset
	if (dro%with_base) then
	if (dro%piecewise) then
	cmd = cmd // ", " // dro%dataset // ".base/\" ! "
	else
	cmd = cmd // " ~ " // dro%dataset // ".base\" ! "
	end if
	end if
	cmd = cmd // ")"
	if (dro%fill) then
	cmd = cmd // " " // dro%fill_options
	if (dro%draw) cmd = cmd // " outlined"
	end if
	if (dro%draw) cmd = cmd // " " // dro%draw_options
	cmd = cmd // ";"
	end if
	end function drawing_options_get_draw_command

	@ %def drawing_options_get_draw_command
	@ The error command draws error bars, if any.
	<<Analysis: procedures>>=
	function drawing_options_get_err_command (dro) result (cmd)
	type(string_t) :: cmd
	type(drawing_options_t), intent(in) :: dro
	if (dro%err) then
	cmd = "draw piecewise " &
	// "from (" // dro%dataset // ".err)" &
	// " " // dro%err_options // ";"
	else
	cmd = ""
	end if
	end function drawing_options_get_err_command

	@ %def drawing_options_get_err_command
	@ The symbol command draws symbols, if any.
	<<Analysis: procedures>>=
	function drawing_options_get_symb_command (dro) result (cmd)
	type(string_t) :: cmd
	type(drawing_options_t), intent(in) :: dro
	if (dro%symbols) then
	cmd = "phantom" &
	// " from (" // dro%dataset // ")" &
	// " withsymbol (" // dro%symbol // ");"
	else
	cmd = ""
	end if
	end function drawing_options_get_symb_command

	@ %def drawing_options_get_symb_command
	@ Get extra GAMELAN code to be executed before and after the usual drawing
	commands.
	<<Analysis: procedures>>=
	function drawing_options_get_gml_bg_command (dro) result (cmd)
	type(string_t) :: cmd
	type(drawing_options_t), intent(in) :: dro
	cmd = dro%gmlcode_bg
	end function drawing_options_get_gml_bg_command

	function drawing_options_get_gml_fg_command (dro) result (cmd)
	type(string_t) :: cmd
	type(drawing_options_t), intent(in) :: dro
	cmd = dro%gmlcode_fg
	end function drawing_options_get_gml_fg_command

	@ %def drawing_options_get_gml_bg_command
	@ %def drawing_options_get_gml_fg_command
	@
	\subsection{Observables}
	The observable type holds the accumulated observable values and weight
	sums which are necessary for proper averaging.
	<<Analysis: types>>=
	type :: observable_t
	private
	real(default) :: sum_values = 0
	real(default) :: sum_squared_values = 0
	real(default) :: sum_weights = 0
	real(default) :: sum_squared_weights = 0
	integer :: count = 0
	type(string_t) :: obs_label
	type(string_t) :: obs_unit
	type(graph_options_t) :: graph_options
	end type observable_t

	@ %def observable_t
	@ Initialize with defined properties
	<<Analysis: procedures>>=
	subroutine observable_init (obs, obs_label, obs_unit, graph_options)
	type(observable_t), intent(out) :: obs
	type(string_t), intent(in), optional :: obs_label, obs_unit
	type(graph_options_t), intent(in), optional :: graph_options
	if (present (obs_label)) then
	obs%obs_label = obs_label
	else
	obs%obs_label = ""
	end if
	if (present (obs_unit)) then
	obs%obs_unit = obs_unit
	else
	obs%obs_unit = ""
	end if
	if (present (graph_options)) then
	obs%graph_options = graph_options
	else
	call obs%graph_options%init ()
	end if
	end subroutine observable_init

	@ %def observable_init
	@ Reset all numeric entries.
	<<Analysis: procedures>>=
	subroutine observable_clear (obs)
	type(observable_t), intent(inout) :: obs
	obs%sum_values = 0
	obs%sum_squared_values = 0
	obs%sum_weights = 0
	obs%sum_squared_weights = 0
	obs%count = 0
	end subroutine observable_clear

	@ %def observable_clear
	@ Record a value. Always successful for observables.
	<<Analysis: interfaces>>=
	interface observable_record_value
	module procedure observable_record_value_unweighted
	module procedure observable_record_value_weighted
	end interface

	<<Analysis: sub interfaces>>=
	module subroutine observable_record_value_unweighted (obs, value, success)
	type(observable_t), intent(inout) :: obs
	real(default), intent(in) :: value
	logical, intent(out), optional :: success
	end subroutine observable_record_value_unweighted
	module subroutine observable_record_value_weighted (obs, value, weight, success)
	type(observable_t), intent(inout) :: obs
	real(default), intent(in) :: value, weight
	logical, intent(out), optional :: success
	end subroutine observable_record_value_weighted
	<<Analysis: procedures>>=
	module subroutine observable_record_value_unweighted (obs, value, success)
	type(observable_t), intent(inout) :: obs
	real(default), intent(in) :: value
	logical, intent(out), optional :: success
	obs%sum_values = obs%sum_values + value
	obs%sum_squared_values = obs%sum_squared_values + value**2
	obs%sum_weights = obs%sum_weights + 1
	obs%sum_squared_weights = obs%sum_squared_weights + 1
	obs%count = obs%count + 1
	if (present (success)) success = .true.
	end subroutine observable_record_value_unweighted

	module subroutine observable_record_value_weighted (obs, value, weight, success)
	type(observable_t), intent(inout) :: obs
	real(default), intent(in) :: value, weight
	logical, intent(out), optional :: success
	obs%sum_values = obs%sum_values + value * weight
	obs%sum_squared_values = obs%sum_squared_values + value*2 weight
	obs%sum_weights = obs%sum_weights + weight
	obs%sum_squared_weights = obs%sum_squared_weights + weight**2
	obs%count = obs%count + 1
	if (present (success)) success = .true.
	end subroutine observable_record_value_weighted

	@ %def observable_record_value
	@ Here are the statistics formulas:
	\begin{enumerate}
	\item Unweighted case:
	Given a sample of $n$ values $x_i$, the average is
	\begin{equation}
	\langle x \rangle = \frac{\sum x_i}{n}
	\end{equation}
	and the error estimate
	\begin{align}
	\Delta x &= \sqrt{\frac{1}{n-1}\langle{\sum(x_i - \langle x\rangle)^2}}
	\\
	&= \sqrt{\frac{1}{n-1}
	\left(\frac{\sum x_i^2}{n} - \frac{(\sum x_i)^2}{n^2}\right)}
	\end{align}
	\item Weighted case:
	Instead of weight 1, each event comes with weight $w_i$.
	\begin{equation}
	\langle x \rangle = \frac{\sum x_i w_i}{\sum w_i}
	\end{equation}
	and
	\begin{equation}
	\Delta x
	= \sqrt{\frac{1}{n-1}
	\left(\frac{\sum x_i^2 w_i}{\sum w_i}
	- \frac{(\sum x_i w_i)^2}{(\sum w_i)^2}\right)}
	\end{equation}
	For $w_i=1$, this specializes to the previous formula.
	\end{enumerate}
	<<Analysis: procedures>>=
	function observable_get_n_entries (obs) result (n)
	integer :: n
	type(observable_t), intent(in) :: obs
	n = obs%count
	end function observable_get_n_entries

	function observable_get_average (obs) result (avg)
	real(default) :: avg
	type(observable_t), intent(in) :: obs
	if (obs%sum_weights /= 0) then
	avg = obs%sum_values / obs%sum_weights
	else
	avg = 0
	end if
	end function observable_get_average

	function observable_get_error (obs) result (err)
	real(default) :: err
	type(observable_t), intent(in) :: obs
	real(default) :: var, n
	if (obs%sum_weights /= 0) then
	select case (obs%count)
	case (0:1)
	err = 0
	case default
	n = obs%count
	var = obs%sum_squared_values / obs%sum_weights &
	- (obs%sum_values / obs%sum_weights) ** 2
	err = sqrt (max (var, 0._default) / (n - 1))
	end select
	else
	err = 0
	end if
	end function observable_get_error

	@ %def observable_get_n_entries
	@ %def observable_get_sum
	@ %def observable_get_average
	@ %def observable_get_error
	@ Write label and/or physical unit to a string.
	<<Analysis: procedures>>=
	function observable_get_label (obs, wl, wu) result (string)
	type(string_t) :: string
	type(observable_t), intent(in) :: obs
	logical, intent(in) :: wl, wu
	type(string_t) :: obs_label, obs_unit
	if (wl) then
	if (obs%obs_label /= "") then
	obs_label = obs%obs_label
	else
	obs_label = "\textrm{Observable}"
	end if
	else
	obs_label = ""
	end if
	if (wu) then
	if (obs%obs_unit /= "") then
	if (wl) then
	obs_unit = "\;[" // obs%obs_unit // "]"
	else
	obs_unit = obs%obs_unit
	end if
	else
	obs_unit = ""
	end if
	else
	obs_unit = ""
	end if
	string = obs_label // obs_unit
	end function observable_get_label

	@ %def observable_get_label
	@
	\subsection{Output}
	<<Analysis: procedures>>=
	subroutine observable_write (obs, unit)
	type(observable_t), intent(in) :: obs
	integer, intent(in), optional :: unit
	real(default) :: avg, err, relerr
	integer :: n
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	avg = observable_get_average (obs)
	err = observable_get_error (obs)
	if (avg /= 0) then
	relerr = err / abs (avg)
	else
	relerr = 0
	end if
	n = observable_get_n_entries (obs)
	if (obs%graph_options%title /= "") then
	write (u, "(A,1x,3A)") &
	"title =", '"', char (obs%graph_options%title), '"'
	end if
	if (obs%graph_options%title /= "") then
	write (u, "(A,1x,3A)") &
	"description =", '"', char (obs%graph_options%description), '"'
	end if
	write (u, "(A,1x," // HISTOGRAM_DATA_FORMAT // ")", advance = "no") &
	"average =", avg
	call write_unit ()
	write (u, "(A,1x," // HISTOGRAM_DATA_FORMAT // ")", advance = "no") &
	"error[abs] =", err
	call write_unit ()
	write (u, "(A,1x," // HISTOGRAM_DATA_FORMAT // ")") &
	"error[rel] =", relerr
	write (u, "(A,1x,I0)") &
	"n_entries =", n
	contains
	subroutine write_unit ()
	if (obs%obs_unit /= "") then
	write (u, "(1x,A)") char (obs%obs_unit)
	else
	write (u, *)
	end if
	end subroutine write_unit
	end subroutine observable_write

	@ %def observable_write
	@ \LaTeX\ output.
	<<Analysis: procedures>>=
	subroutine observable_write_driver (obs, unit, write_heading)
	type(observable_t), intent(in) :: obs
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: write_heading
	real(default) :: avg, err
	integer :: n_digits
	logical :: heading
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	heading = .true.; if (present (write_heading)) heading = write_heading
	avg = observable_get_average (obs)
	err = observable_get_error (obs)
	if (avg /= 0 .and. err /= 0) then
	n_digits = max (2, 2 - int (log10 (abs (err / real (avg, default)))))
	else if (avg /= 0) then
	n_digits = 100
	else
	n_digits = 1
	end if
	if (heading) then
	write (u, "(A)")
	if (obs%graph_options%title /= "") then
	write (u, "(A)") "\section{" // char (obs%graph_options%title) &
	// "}"
	else
	write (u, "(A)") "\section{Observable}"
	end if
	if (obs%graph_options%description /= "") then
	write (u, "(A)") char (obs%graph_options%description)
	write (u, *)
	end if
	write (u, "(A)") "\begin{flushleft}"
	end if
	write (u, "(A)", advance="no") " $\langle{" ! $ sign
	write (u, "(A)", advance="no") char (observable_get_label (obs, wl=.true., wu=.false.))
	write (u, "(A)", advance="no") "}\rangle = "
	write (u, "(A)", advance="no") char (tex_format (avg, n_digits))
	write (u, "(A)", advance="no") "\pm"
	write (u, "(A)", advance="no") char (tex_format (err, 2))
	write (u, "(A)", advance="no") "\;{"
	write (u, "(A)", advance="no") char (observable_get_label (obs, wl=.false., wu=.true.))
	write (u, "(A)") "}"
	write (u, "(A)", advance="no") " \quad[n_{\text{entries}} = "
	write (u, "(I0)",advance="no") observable_get_n_entries (obs)
	write (u, "(A)") "]$" ! $ fool Emacs' noweb mode
	if (heading) then
	write (u, "(A)") "\end{flushleft}"
	end if
	end subroutine observable_write_driver

	@ %def observable_write_driver
	@
	\subsection{Histograms}
	\subsubsection{Bins}
	<<Analysis: types>>=
	type :: bin_t
	private
	real(default) :: midpoint = 0
	real(default) :: width = 0
	real(default) :: sum_weights = 0
	real(default) :: sum_squared_weights = 0
	real(default) :: sum_excess_weights = 0
	integer :: count = 0
	end type bin_t

	@ %def bin_t
	<<Analysis: procedures>>=
	subroutine bin_init (bin, midpoint, width)
	type(bin_t), intent(out) :: bin
	real(default), intent(in) :: midpoint, width
	bin%midpoint = midpoint
	bin%width = width
	end subroutine bin_init

	@ %def bin_init
	<<Analysis: procedures>>=
	elemental subroutine bin_clear (bin)
	type(bin_t), intent(inout) :: bin
	bin%sum_weights = 0
	bin%sum_squared_weights = 0
	bin%sum_excess_weights = 0
	bin%count = 0
	end subroutine bin_clear

	@ %def bin_clear
	<<Analysis: procedures>>=
	subroutine bin_record_value (bin, normalize, weight, excess)
	type(bin_t), intent(inout) :: bin
	logical, intent(in) :: normalize
	real(default), intent(in) :: weight
	real(default), intent(in), optional :: excess
	real(default) :: w, e
	if (normalize) then
	if (bin%width /= 0) then
	w = weight / bin%width
	if (present (excess)) e = excess / bin%width
	else
	w = 0
	if (present (excess)) e = 0
	end if
	else
	w = weight
	if (present (excess)) e = excess
	end if
	bin%sum_weights = bin%sum_weights + w
	bin%sum_squared_weights = bin%sum_squared_weights + w ** 2
	if (present (excess)) &
	bin%sum_excess_weights = bin%sum_excess_weights + abs (e)
	bin%count = bin%count + 1
	end subroutine bin_record_value

	@ %def bin_record_value
	<<Analysis: procedures>>=
	function bin_get_midpoint (bin) result (x)
	real(default) :: x
	type(bin_t), intent(in) :: bin
	x = bin%midpoint
	end function bin_get_midpoint

	function bin_get_width (bin) result (w)
	real(default) :: w
	type(bin_t), intent(in) :: bin
	w = bin%width
	end function bin_get_width

	function bin_get_n_entries (bin) result (n)
	integer :: n
	type(bin_t), intent(in) :: bin
	n = bin%count
	end function bin_get_n_entries

	function bin_get_sum (bin) result (s)
	real(default) :: s
	type(bin_t), intent(in) :: bin
	s = bin%sum_weights
	end function bin_get_sum

	function bin_get_error (bin) result (err)
	real(default) :: err
	type(bin_t), intent(in) :: bin
	err = sqrt (bin%sum_squared_weights)
	end function bin_get_error

	function bin_get_excess (bin) result (excess)
	real(default) :: excess
	type(bin_t), intent(in) :: bin
	excess = bin%sum_excess_weights
	end function bin_get_excess

	@ %def bin_get_midpoint
	@ %def bin_get_width
	@ %def bin_get_n_entries
	@ %def bin_get_sum
	@ %def bin_get_error
	@ %def bin_get_excess
	<<Analysis: procedures>>=
	subroutine bin_write_header (unit)
	integer, intent(in), optional :: unit
	character(120) :: buffer
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (buffer, "(A,4(1x," //HISTOGRAM_HEAD_FORMAT // "),2x,A)") &
	"#", "bin midpoint", "value ", "error ", &
	"excess ", "n"
	write (u, "(A)") trim (buffer)
	end subroutine bin_write_header

	subroutine bin_write (bin, unit)
	type(bin_t), intent(in) :: bin
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,4(1x," // HISTOGRAM_DATA_FORMAT // "),2x,I0)") &
	bin_get_midpoint (bin), &
	bin_get_sum (bin), &
	bin_get_error (bin), &
	bin_get_excess (bin), &
	bin_get_n_entries (bin)
	end subroutine bin_write

	@ %def bin_write_header
	@ %def bin_write
	@
	\subsubsection{Histograms}
	<<Analysis: types>>=
	type :: histogram_t
	private
	real(default) :: lower_bound = 0
	real(default) :: upper_bound = 0
	real(default) :: width = 0
	integer :: n_bins = 0
	logical :: normalize_bins = .false.
	type(observable_t) :: obs
	type(observable_t) :: obs_within_bounds
	type(bin_t) :: underflow
	type(bin_t), dimension(:), allocatable :: bin
	type(bin_t) :: overflow
	type(graph_options_t) :: graph_options
	type(drawing_options_t) :: drawing_options
	end type histogram_t

	@ %def histogram_t
	@
	\subsubsection{Initializer/finalizer}
	Initialize a histogram. We may provide either the bin width or the
	number of bins. A finalizer is not needed, since the histogram contains no
	pointer (sub)components.
	<<Analysis: interfaces>>=
	interface histogram_init
	module procedure histogram_init_n_bins
	module procedure histogram_init_bin_width
	end interface

	<<Analysis: sub interfaces>>=
	module subroutine histogram_init_n_bins (h, id, &
	lower_bound, upper_bound, n_bins, normalize_bins, &
	obs_label, obs_unit, graph_options, drawing_options)
	type(histogram_t), intent(out) :: h
	type(string_t), intent(in) :: id
	real(default), intent(in) :: lower_bound, upper_bound
	integer, intent(in) :: n_bins
	logical, intent(in) :: normalize_bins
	type(string_t), intent(in), optional :: obs_label, obs_unit
	type(graph_options_t), intent(in), optional :: graph_options
	type(drawing_options_t), intent(in), optional :: drawing_options
	end subroutine histogram_init_n_bins
	module subroutine histogram_init_bin_width (h, id, &
	lower_bound, upper_bound, bin_width, normalize_bins, &
	obs_label, obs_unit, graph_options, drawing_options)
	type(histogram_t), intent(out) :: h
	type(string_t), intent(in) :: id
	real(default), intent(in) :: lower_bound, upper_bound, bin_width
	logical, intent(in) :: normalize_bins
	type(string_t), intent(in), optional :: obs_label, obs_unit
	type(graph_options_t), intent(in), optional :: graph_options
	type(drawing_options_t), intent(in), optional :: drawing_options
	end subroutine histogram_init_bin_width
	<<Analysis: procedures>>=
	module subroutine histogram_init_n_bins (h, id, &
	lower_bound, upper_bound, n_bins, normalize_bins, &
	obs_label, obs_unit, graph_options, drawing_options)
	type(histogram_t), intent(out) :: h
	type(string_t), intent(in) :: id
	real(default), intent(in) :: lower_bound, upper_bound
	integer, intent(in) :: n_bins
	logical, intent(in) :: normalize_bins
	type(string_t), intent(in), optional :: obs_label, obs_unit
	type(graph_options_t), intent(in), optional :: graph_options
	type(drawing_options_t), intent(in), optional :: drawing_options
	real(default) :: bin_width
	integer :: i
	call observable_init (h%obs_within_bounds, obs_label, obs_unit)
	call observable_init (h%obs, obs_label, obs_unit)
	h%lower_bound = lower_bound
	h%upper_bound = upper_bound
	h%n_bins = max (n_bins, 1)
	h%width = h%upper_bound - h%lower_bound
	h%normalize_bins = normalize_bins
	bin_width = h%width / h%n_bins
	allocate (h%bin (h%n_bins))
	call bin_init (h%underflow, h%lower_bound, 0._default)
	do i = 1, h%n_bins
	call bin_init (h%bin(i), &
	h%lower_bound - bin_width/2 + i * bin_width, bin_width)
	end do
	call bin_init (h%overflow, h%upper_bound, 0._default)
	if (present (graph_options)) then
	h%graph_options = graph_options
	else
	call h%graph_options%init ()
	end if
	call graph_options_set (h%graph_options, id = id)
	if (present (drawing_options)) then
	h%drawing_options = drawing_options
	else
	call h%drawing_options%init_histogram ()
	end if
	end subroutine histogram_init_n_bins

	module subroutine histogram_init_bin_width (h, id, &
	lower_bound, upper_bound, bin_width, normalize_bins, &
	obs_label, obs_unit, graph_options, drawing_options)
	type(histogram_t), intent(out) :: h
	type(string_t), intent(in) :: id
	real(default), intent(in) :: lower_bound, upper_bound, bin_width
	logical, intent(in) :: normalize_bins
	type(string_t), intent(in), optional :: obs_label, obs_unit
	type(graph_options_t), intent(in), optional :: graph_options
	type(drawing_options_t), intent(in), optional :: drawing_options
	integer :: n_bins
	if (bin_width /= 0) then
	n_bins = nint ((upper_bound - lower_bound) / bin_width)
	else
	n_bins = 1
	end if
	call histogram_init_n_bins (h, id, &
	lower_bound, upper_bound, n_bins, normalize_bins, &
	obs_label, obs_unit, graph_options, drawing_options)
	end subroutine histogram_init_bin_width

	@ %def histogram_init
	@ Initialize a histogram by copying another one.

	Since [[h]] has no pointer (sub)components, intrinsic assignment is
	sufficient. Optionally, we replace the drawing options.
	<<Analysis: procedures>>=
	subroutine histogram_init_histogram (h, h_in, drawing_options)
	type(histogram_t), intent(out) :: h
	type(histogram_t), intent(in) :: h_in
	type(drawing_options_t), intent(in), optional :: drawing_options
	h = h_in
	if (present (drawing_options)) then
	h%drawing_options = drawing_options
	end if
	end subroutine histogram_init_histogram

	@ %def histogram_init_histogram
	@
	\subsubsection{Fill histograms}
	Clear the histogram contents, but do not modify the structure.
	<<Analysis: procedures>>=
	subroutine histogram_clear (h)
	type(histogram_t), intent(inout) :: h
	call observable_clear (h%obs)
	call observable_clear (h%obs_within_bounds)
	call bin_clear (h%underflow)
	if (allocated (h%bin)) call bin_clear (h%bin)
	call bin_clear (h%overflow)
	end subroutine histogram_clear

	@ %def histogram_clear
	@ Record a value. Successful if the value is within bounds, otherwise
	it is recorded as under-/overflow. Optionally, we may provide an
	excess weight that could be returned by the unweighting procedure.
	<<Analysis: procedures>>=
	subroutine histogram_record_value_unweighted (h, value, excess, success)
	type(histogram_t), intent(inout) :: h
	real(default), intent(in) :: value
	real(default), intent(in), optional :: excess
	logical, intent(out), optional :: success
	integer :: i_bin
	call observable_record_value (h%obs, value)
	if (h%width /= 0) then
	i_bin = floor (((value - h%lower_bound) / h%width) * h%n_bins) + 1
	else
	i_bin = 0
	end if
	if (i_bin <= 0) then
	call bin_record_value (h%underflow, .false., 1._default, excess)
	if (present (success)) success = .false.
	else if (i_bin <= h%n_bins) then
	call observable_record_value (h%obs_within_bounds, value)
	call bin_record_value &
	(h%bin(i_bin), h%normalize_bins, 1._default, excess)
	if (present (success)) success = .true.
	else
	call bin_record_value (h%overflow, .false., 1._default, excess)
	if (present (success)) success = .false.
	end if
	end subroutine histogram_record_value_unweighted

	@ %def histogram_record_value_unweighted
	@ Weighted events: analogous, but no excess weight.
	<<Analysis: procedures>>=
	subroutine histogram_record_value_weighted (h, value, weight, success)
	type(histogram_t), intent(inout) :: h
	real(default), intent(in) :: value, weight
	logical, intent(out), optional :: success
	integer :: i_bin
	call observable_record_value (h%obs, value, weight)
	if (h%width /= 0) then
	i_bin = floor (((value - h%lower_bound) / h%width) * h%n_bins) + 1
	else
	i_bin = 0
	end if
	if (i_bin <= 0) then
	call bin_record_value (h%underflow, .false., weight)
	if (present (success)) success = .false.
	else if (i_bin <= h%n_bins) then
	call observable_record_value (h%obs_within_bounds, value, weight)
	call bin_record_value (h%bin(i_bin), h%normalize_bins, weight)
	if (present (success)) success = .true.
	else
	call bin_record_value (h%overflow, .false., weight)
	if (present (success)) success = .false.
	end if
	end subroutine histogram_record_value_weighted

	@ %def histogram_record_value_weighted
	@
	\subsubsection{Access contents}
	Inherited from the observable component (all-over average etc.)
	<<Analysis: procedures>>=
	function histogram_get_n_entries (h) result (n)
	integer :: n
	type(histogram_t), intent(in) :: h
	n = observable_get_n_entries (h%obs)
	end function histogram_get_n_entries

	function histogram_get_average (h) result (avg)
	real(default) :: avg
	type(histogram_t), intent(in) :: h
	avg = observable_get_average (h%obs)
	end function histogram_get_average

	function histogram_get_error (h) result (err)
	real(default) :: err
	type(histogram_t), intent(in) :: h
	err = observable_get_error (h%obs)
	end function histogram_get_error

	@ %def histogram_get_n_entries
	@ %def histogram_get_average
	@ %def histogram_get_error
	@ Analogous, but applied only to events within bounds.
	<<Analysis: procedures>>=
	function histogram_get_n_entries_within_bounds (h) result (n)
	integer :: n
	type(histogram_t), intent(in) :: h
	n = observable_get_n_entries (h%obs_within_bounds)
	end function histogram_get_n_entries_within_bounds

	function histogram_get_average_within_bounds (h) result (avg)
	real(default) :: avg
	type(histogram_t), intent(in) :: h
	avg = observable_get_average (h%obs_within_bounds)
	end function histogram_get_average_within_bounds

	function histogram_get_error_within_bounds (h) result (err)
	real(default) :: err
	type(histogram_t), intent(in) :: h
	err = observable_get_error (h%obs_within_bounds)
	end function histogram_get_error_within_bounds

	@ %def histogram_get_n_entries_within_bounds
	@ %def histogram_get_average_within_bounds
	@ %def histogram_get_error_within_bounds
	Get the number of bins
	<<Analysis: procedures>>=
	function histogram_get_n_bins (h) result (n)
	type(histogram_t), intent(in) :: h
	integer :: n
	n = h%n_bins
	end function histogram_get_n_bins

	@ %def histogram_get_n_bins
	@ Check bins. If the index is zero or above the limit, return the
	results for underflow or overflow, respectively.
	<<Analysis: procedures>>=
	function histogram_get_n_entries_for_bin (h, i) result (n)
	integer :: n
	type(histogram_t), intent(in) :: h
	integer, intent(in) :: i
	if (i <= 0) then
	n = bin_get_n_entries (h%underflow)
	else if (i <= h%n_bins) then
	n = bin_get_n_entries (h%bin(i))
	else
	n = bin_get_n_entries (h%overflow)
	end if
	end function histogram_get_n_entries_for_bin

	function histogram_get_sum_for_bin (h, i) result (avg)
	real(default) :: avg
	type(histogram_t), intent(in) :: h
	integer, intent(in) :: i
	if (i <= 0) then
	avg = bin_get_sum (h%underflow)
	else if (i <= h%n_bins) then
	avg = bin_get_sum (h%bin(i))
	else
	avg = bin_get_sum (h%overflow)
	end if
	end function histogram_get_sum_for_bin

	function histogram_get_error_for_bin (h, i) result (err)
	real(default) :: err
	type(histogram_t), intent(in) :: h
	integer, intent(in) :: i
	if (i <= 0) then
	err = bin_get_error (h%underflow)
	else if (i <= h%n_bins) then
	err = bin_get_error (h%bin(i))
	else
	err = bin_get_error (h%overflow)
	end if
	end function histogram_get_error_for_bin

	function histogram_get_excess_for_bin (h, i) result (err)
	real(default) :: err
	type(histogram_t), intent(in) :: h
	integer, intent(in) :: i
	if (i <= 0) then
	err = bin_get_excess (h%underflow)
	else if (i <= h%n_bins) then
	err = bin_get_excess (h%bin(i))
	else
	err = bin_get_excess (h%overflow)
	end if
	end function histogram_get_excess_for_bin

	@ %def histogram_get_n_entries_for_bin
	@ %def histogram_get_sum_for_bin
	@ %def histogram_get_error_for_bin
	@ %def histogram_get_excess_for_bin
	@ Return a pointer to the graph options.
	<<Analysis: procedures>>=
	function histogram_get_graph_options_ptr (h) result (ptr)
	type(graph_options_t), pointer :: ptr
	type(histogram_t), intent(in), target :: h
	ptr => h%graph_options
	end function histogram_get_graph_options_ptr

	@ %def histogram_get_graph_options_ptr
	@ Return a pointer to the drawing options.
	<<Analysis: procedures>>=
	function histogram_get_drawing_options_ptr (h) result (ptr)
	type(drawing_options_t), pointer :: ptr
	type(histogram_t), intent(in), target :: h
	ptr => h%drawing_options
	end function histogram_get_drawing_options_ptr

	@ %def histogram_get_drawing_options_ptr
	@
	\subsubsection{Output}
	<<Analysis: procedures>>=
	subroutine histogram_write (h, unit)
	type(histogram_t), intent(in) :: h
	integer, intent(in), optional :: unit
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call bin_write_header (u)
	if (allocated (h%bin)) then
	do i = 1, h%n_bins
	call bin_write (h%bin(i), u)
	end do
	end if
	write (u, "(A)")
	write (u, "(A,1x,A)") "#", "Underflow:"
	call bin_write (h%underflow, u)
	write (u, "(A)")
	write (u, "(A,1x,A)") "#", "Overflow:"
	call bin_write (h%overflow, u)
	write (u, "(A)")
	write (u, "(A,1x,A)") "#", "Summary: data within bounds"
	call observable_write (h%obs_within_bounds, u)
	write (u, "(A)")
	write (u, "(A,1x,A)") "#", "Summary: all data"
	call observable_write (h%obs, u)
	write (u, "(A)")
	end subroutine histogram_write

	@ %def histogram_write
	@ Write the GAMELAN reader for histogram contents.
	<<Analysis: procedures>>=
	subroutine histogram_write_gml_reader (h, filename, unit)
	type(histogram_t), intent(in) :: h
	type(string_t), intent(in) :: filename
	integer, intent(in), optional :: unit
	character(*), parameter :: fmt = "(ES15.8)"
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(2x,A)") 'fromfile "' // char (filename) // '":'
	write (u, "(4x,A)") 'key "# Histogram:";'
	write (u, "(4x,A)") 'dx := #' &
	// real2char (h%width / h%n_bins / 2, fmt) // ';'
	write (u, "(4x,A)") 'for i withinblock:'
	write (u, "(6x,A)") 'get x, y, y.d, y.n, y.e;'
	if (h%drawing_options%with_hbars) then
	write (u, "(6x,A)") 'plot (' // char (h%drawing_options%dataset) &
	// ') (x,y) hbar dx;'
	else
	write (u, "(6x,A)") 'plot (' // char (h%drawing_options%dataset) &
	// ') (x,y);'
	end if
	if (h%drawing_options%err) then
	write (u, "(6x,A)") 'plot (' // char (h%drawing_options%dataset) &
	// '.err) ' &
	// '(x,y) vbar y.d;'
	end if
	!!! Future excess options for plots
	! write (u, "(6x,A)") 'if show_excess: ' // &
	! & 'plot(dat.e)(x, y plus y.e) hbar dx; fi'
	write (u, "(4x,A)") 'endfor'
	write (u, "(2x,A)") 'endfrom'
	end subroutine histogram_write_gml_reader

	@ %def histogram_write_gml_reader
	@ \LaTeX\ and GAMELAN output.
	<<Analysis: procedures>>=
	subroutine histogram_write_gml_driver (h, filename, unit)
	type(histogram_t), intent(in) :: h
	type(string_t), intent(in) :: filename
	integer, intent(in), optional :: unit
	type(string_t) :: calc_cmd, bg_cmd, draw_cmd, err_cmd, symb_cmd, fg_cmd
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call graph_options_write_tex_header (h%graph_options, unit)
	write (u, "(2x,A)") char (graph_options_get_gml_setup (h%graph_options))
	write (u, "(2x,A)") char (graph_options_get_gml_graphrange &
	(h%graph_options, x_min=h%lower_bound, x_max=h%upper_bound))
	call histogram_write_gml_reader (h, filename, unit)
	calc_cmd = drawing_options_get_calc_command (h%drawing_options)
	if (calc_cmd /= "") write (u, "(2x,A)") char (calc_cmd)
	bg_cmd = drawing_options_get_gml_bg_command (h%drawing_options)
	if (bg_cmd /= "") write (u, "(2x,A)") char (bg_cmd)
	draw_cmd = drawing_options_get_draw_command (h%drawing_options)
	if (draw_cmd /= "") write (u, "(2x,A)") char (draw_cmd)
	err_cmd = drawing_options_get_err_command (h%drawing_options)
	if (err_cmd /= "") write (u, "(2x,A)") char (err_cmd)
	symb_cmd = drawing_options_get_symb_command (h%drawing_options)
	if (symb_cmd /= "") write (u, "(2x,A)") char (symb_cmd)
	fg_cmd = drawing_options_get_gml_fg_command (h%drawing_options)
	if (fg_cmd /= "") write (u, "(2x,A)") char (fg_cmd)
	write (u, "(2x,A)") char (graph_options_get_gml_x_label (h%graph_options))
	write (u, "(2x,A)") char (graph_options_get_gml_y_label (h%graph_options))
	call graph_options_write_tex_footer (h%graph_options, unit)
	write (u, "(A)") "\vspace*{2\baselineskip}"
	write (u, "(A)") "\begin{flushleft}"
	write (u, "(A)") "\textbf{Data within bounds:} \\"
	call observable_write_driver (h%obs_within_bounds, unit, &
	write_heading=.false.)
	write (u, "(A)") "\\[0.5\baselineskip]"
	write (u, "(A)") "\textbf{All data:} \\"
	call observable_write_driver (h%obs, unit, write_heading=.false.)
	write (u, "(A)") "\end{flushleft}"
	end subroutine histogram_write_gml_driver

	@ %def histogram_write_gml_driver
	@ Return the header for generic data output as an ifile.
	<<Analysis: procedures>>=
	subroutine histogram_get_header (h, header, comment)
	type(histogram_t), intent(in) :: h
	type(ifile_t), intent(inout) :: header
	type(string_t), intent(in), optional :: comment
	type(string_t) :: c
	if (present (comment)) then
	c = comment
	else
	c = ""
	end if
	call ifile_append (header, c // "WHIZARD histogram data")
	call graph_options_get_header (h%graph_options, header, comment)
	call ifile_append (header, &
	c // "range: " // real2string (h%lower_bound) &
	// " - " // real2string (h%upper_bound))
	call ifile_append (header, &
	c // "counts total: " &
	// int2char (histogram_get_n_entries_within_bounds (h)))
	call ifile_append (header, &
	c // "total average: " &
	// real2string (histogram_get_average_within_bounds (h)) // " +- " &
	// real2string (histogram_get_error_within_bounds (h)))
	end subroutine histogram_get_header

	@ %def histogram_get_header
	@
	\subsection{Plots}
	\subsubsection{Points}
	<<Analysis: types>>=
	type :: point_t
	private
	real(default) :: x = 0
	real(default) :: y = 0
	real(default) :: yerr = 0
	real(default) :: xerr = 0
	type(point_t), pointer :: next => null ()
	end type point_t

	@ %def point_t
	<<Analysis: interfaces>>=
	interface point_init
	module procedure point_init_contents
	module procedure point_init_point
	end interface
	<<Analysis: sub interfaces>>=
	module subroutine point_init_contents (point, x, y, yerr, xerr)
	type(point_t), intent(out) :: point
	real(default), intent(in) :: x, y
	real(default), intent(in), optional :: yerr, xerr
	end subroutine point_init_contents
	module subroutine point_init_point (point, point_in)
	type(point_t), intent(out) :: point
	type(point_t), intent(in) :: point_in
	end subroutine point_init_point
	<<Analysis: procedures>>=
	module subroutine point_init_contents (point, x, y, yerr, xerr)
	type(point_t), intent(out) :: point
	real(default), intent(in) :: x, y
	real(default), intent(in), optional :: yerr, xerr
	point%x = x
	point%y = y
	if (present (yerr)) point%yerr = yerr
	if (present (xerr)) point%xerr = xerr
	end subroutine point_init_contents

	module subroutine point_init_point (point, point_in)
	type(point_t), intent(out) :: point
	type(point_t), intent(in) :: point_in
	point%x = point_in%x
	point%y = point_in%y
	point%yerr = point_in%yerr
	point%xerr = point_in%xerr
	end subroutine point_init_point

	@ %def point_init
	<<Analysis: procedures>>=
	function point_get_x (point) result (x)
	real(default) :: x
	type(point_t), intent(in) :: point
	x = point%x
	end function point_get_x

	function point_get_y (point) result (y)
	real(default) :: y
	type(point_t), intent(in) :: point
	y = point%y
	end function point_get_y

	function point_get_xerr (point) result (xerr)
	real(default) :: xerr
	type(point_t), intent(in) :: point
	xerr = point%xerr
	end function point_get_xerr

	function point_get_yerr (point) result (yerr)
	real(default) :: yerr
	type(point_t), intent(in) :: point
	yerr = point%yerr
	end function point_get_yerr

	@ %def point_get_x
	@ %def point_get_y
	@ %def point_get_xerr
	@ %def point_get_yerr
	<<Analysis: procedures>>=
	subroutine point_write_header (unit)
	integer, intent(in) :: unit
	character(120) :: buffer
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (buffer, "(A,4(1x," // HISTOGRAM_HEAD_FORMAT // "))") &
	"#", "x ", "y ", "yerr ", "xerr "
	write (u, "(A)") trim (buffer)
	end subroutine point_write_header

	subroutine point_write (point, unit)
	type(point_t), intent(in) :: point
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(1x,4(1x," // HISTOGRAM_DATA_FORMAT // "))") &
	point_get_x (point), &
	point_get_y (point), &
	point_get_yerr (point), &
	point_get_xerr (point)
	end subroutine point_write

	@ %def point_write
	@
	\subsubsection{Plots}
	<<Analysis: types>>=
	type :: plot_t
	private
	type(point_t), pointer :: first => null ()
	type(point_t), pointer :: last => null ()
	integer :: count = 0
	type(graph_options_t) :: graph_options
	type(drawing_options_t) :: drawing_options
	end type plot_t

	@ %def plot_t
	@
	\subsubsection{Initializer/finalizer}
	Initialize a plot. We provide the lower and upper bound in the $x$
	direction.
	<<Analysis: interfaces>>=
	interface plot_init
	module procedure plot_init_empty
	module procedure plot_init_plot
	end interface
	<<Analysis: sub interfaces>>=
	module subroutine plot_init_empty (p, id, graph_options, drawing_options)
	type(plot_t), intent(out) :: p
	type(string_t), intent(in) :: id
	type(graph_options_t), intent(in), optional :: graph_options
	type(drawing_options_t), intent(in), optional :: drawing_options
	end subroutine plot_init_empty
	<<Analysis: procedures>>=
	module subroutine plot_init_empty (p, id, graph_options, drawing_options)
	type(plot_t), intent(out) :: p
	type(string_t), intent(in) :: id
	type(graph_options_t), intent(in), optional :: graph_options
	type(drawing_options_t), intent(in), optional :: drawing_options
	if (present (graph_options)) then
	p%graph_options = graph_options
	else
	call p%graph_options%init ()
	end if
	call p%graph_options%set (id = id)
	if (present (drawing_options)) then
	p%drawing_options = drawing_options
	else
	call p%drawing_options%init_plot ()
	end if
	end subroutine plot_init_empty

	@ %def plot_init
	@ Initialize a plot by copying another one, optionally merging in a new
	set of drawing options.

	Since [[p]] has pointer (sub)components, we have to explicitly deep-copy the
	original.
	<<Analysis: sub interfaces>>=
	module subroutine plot_init_plot (p, p_in, drawing_options)
	type(plot_t), intent(out) :: p
	type(plot_t), intent(in) :: p_in
	type(drawing_options_t), intent(in), optional :: drawing_options
	end subroutine plot_init_plot
	<<Analysis: procedures>>=
	module subroutine plot_init_plot (p, p_in, drawing_options)
	type(plot_t), intent(out) :: p
	type(plot_t), intent(in) :: p_in
	type(drawing_options_t), intent(in), optional :: drawing_options
	type(point_t), pointer :: current, new
	current => p_in%first
	do while (associated (current))
	allocate (new)
	call point_init (new, current)
	if (associated (p%last)) then
	p%last%next => new
	else
	p%first => new
	end if
	p%last => new
	current => current%next
	end do
	p%count = p_in%count
	p%graph_options = p_in%graph_options
	if (present (drawing_options)) then
	p%drawing_options = drawing_options
	else
	p%drawing_options = p_in%drawing_options
	end if
	end subroutine plot_init_plot

	@ %def plot_init_plot
	@ Finalize the plot by deallocating the list of points.
	<<Analysis: procedures>>=
	subroutine plot_final (plot)
	type(plot_t), intent(inout) :: plot
	type(point_t), pointer :: current
	do while (associated (plot%first))
	current => plot%first
	plot%first => current%next
	deallocate (current)
	end do
	plot%last => null ()
	end subroutine plot_final

	@ %def plot_final
	@
	\subsubsection{Fill plots}
	Clear the plot contents, but do not modify the structure.
	<<Analysis: procedures>>=
	subroutine plot_clear (plot)
	type(plot_t), intent(inout) :: plot
	plot%count = 0
	call plot_final (plot)
	end subroutine plot_clear

	@ %def plot_clear
	@ Record a value. Successful if the value is within bounds, otherwise
	it is recorded as under-/overflow.
	<<Analysis: procedures>>=
	subroutine plot_record_value (plot, x, y, yerr, xerr, success)
	type(plot_t), intent(inout) :: plot
	real(default), intent(in) :: x, y
	real(default), intent(in), optional :: yerr, xerr
	logical, intent(out), optional :: success
	type(point_t), pointer :: point
	plot%count = plot%count + 1
	allocate (point)
	call point_init (point, x, y, yerr, xerr)
	if (associated (plot%first)) then
	plot%last%next => point
	else
	plot%first => point
	end if
	plot%last => point
	if (present (success)) success = .true.
	end subroutine plot_record_value

	@ %def plot_record_value
	@
	\subsubsection{Access contents}
	The number of points.
	<<Analysis: procedures>>=
	function plot_get_n_entries (plot) result (n)
	integer :: n
	type(plot_t), intent(in) :: plot
	n = plot%count
	end function plot_get_n_entries

	@ %def plot_get_n_entries
	@ Return a pointer to the graph options.
	<<Analysis: procedures>>=
	function plot_get_graph_options_ptr (p) result (ptr)
	type(graph_options_t), pointer :: ptr
	type(plot_t), intent(in), target :: p
	ptr => p%graph_options
	end function plot_get_graph_options_ptr

	@ %def plot_get_graph_options_ptr
	@ Return a pointer to the drawing options.
	<<Analysis: procedures>>=
	function plot_get_drawing_options_ptr (p) result (ptr)
	type(drawing_options_t), pointer :: ptr
	type(plot_t), intent(in), target :: p
	ptr => p%drawing_options
	end function plot_get_drawing_options_ptr

	@ %def plot_get_drawing_options_ptr
	@
	\subsubsection{Output}
	This output format is used by the GAMELAN driver below.
	<<Analysis: procedures>>=
	subroutine plot_write (plot, unit)
	type(plot_t), intent(in) :: plot
	integer, intent(in), optional :: unit
	type(point_t), pointer :: point
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call point_write_header (u)
	point => plot%first
	do while (associated (point))
	call point_write (point, unit)
	point => point%next
	end do
	write (u, *)
	write (u, "(A,1x,A)") "#", "Summary:"
	write (u, "(A,1x,I0)") &
	"n_entries =", plot_get_n_entries (plot)
	write (u, *)
	end subroutine plot_write

	@ %def plot_write
	@ Write the GAMELAN reader for plot contents.
	<<Analysis: procedures>>=
	subroutine plot_write_gml_reader (p, filename, unit)
	type(plot_t), intent(in) :: p
	type(string_t), intent(in) :: filename
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, "(2x,A)") 'fromfile "' // char (filename) // '":'
	write (u, "(4x,A)") 'key "# Plot:";'
	write (u, "(4x,A)") 'for i withinblock:'
	write (u, "(6x,A)") 'get x, y, y.err, x.err;'
	write (u, "(6x,A)") 'plot (' // char (p%drawing_options%dataset) &
	// ') (x,y);'
	if (p%drawing_options%err) then
	write (u, "(6x,A)") 'plot (' // char (p%drawing_options%dataset) &
	// '.err) (x,y) vbar y.err hbar x.err;'
	end if
	write (u, "(4x,A)") 'endfor'
	write (u, "(2x,A)") 'endfrom'
	end subroutine plot_write_gml_reader

	@ %def plot_write_gml_header
	@ \LaTeX\ and GAMELAN output. Analogous to histogram output.
	<<Analysis: procedures>>=
	subroutine plot_write_gml_driver (p, filename, unit)
	type(plot_t), intent(in) :: p
	type(string_t), intent(in) :: filename
	integer, intent(in), optional :: unit
	type(string_t) :: calc_cmd, bg_cmd, draw_cmd, err_cmd, symb_cmd, fg_cmd
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	call graph_options_write_tex_header (p%graph_options, unit)
	write (u, "(2x,A)") &
	char (graph_options_get_gml_setup (p%graph_options))
	write (u, "(2x,A)") &
	char (graph_options_get_gml_graphrange (p%graph_options))
	call plot_write_gml_reader (p, filename, unit)
	calc_cmd = drawing_options_get_calc_command (p%drawing_options)
	if (calc_cmd /= "") write (u, "(2x,A)") char (calc_cmd)
	bg_cmd = drawing_options_get_gml_bg_command (p%drawing_options)
	if (bg_cmd /= "") write (u, "(2x,A)") char (bg_cmd)
	draw_cmd = drawing_options_get_draw_command (p%drawing_options)
	if (draw_cmd /= "") write (u, "(2x,A)") char (draw_cmd)
	err_cmd = drawing_options_get_err_command (p%drawing_options)
	if (err_cmd /= "") write (u, "(2x,A)") char (err_cmd)
	symb_cmd = drawing_options_get_symb_command (p%drawing_options)
	if (symb_cmd /= "") write (u, "(2x,A)") char (symb_cmd)
	fg_cmd = drawing_options_get_gml_fg_command (p%drawing_options)
	if (fg_cmd /= "") write (u, "(2x,A)") char (fg_cmd)
	write (u, "(2x,A)") char (graph_options_get_gml_x_label (p%graph_options))
	write (u, "(2x,A)") char (graph_options_get_gml_y_label (p%graph_options))
	call graph_options_write_tex_footer (p%graph_options, unit)
	end subroutine plot_write_gml_driver

	@ %def plot_write_driver
	@ Append header for generic data output in ifile format.
	<<Analysis: procedures>>=
	subroutine plot_get_header (plot, header, comment)
	type(plot_t), intent(in) :: plot
	type(ifile_t), intent(inout) :: header
	type(string_t), intent(in), optional :: comment
	type(string_t) :: c
	if (present (comment)) then
	c = comment
	else
	c = ""
	end if
	call ifile_append (header, c // "WHIZARD plot data")
	call graph_options_get_header (plot%graph_options, header, comment)
	call ifile_append (header, &
	c // "number of points: " &
	// int2char (plot_get_n_entries (plot)))
	end subroutine plot_get_header

	@ %def plot_get_header
	@
	\subsection{Graphs}
	A graph is a container for several graph elements. Each graph element is
	either a plot or a histogram. There is an appropriate base type below
	(the [[analysis_object_t]]), but to avoid recursion, we define a separate base
	type here. Note that there is no actual recursion: a graph is an analysis
	object, but a graph cannot contain graphs.

	(If we could use type extension, the implementation would be much more
	transparent.)

	\subsubsection{Graph elements}
	Graph elements cannot be filled by the [[record]] command directly. The
	contents are always copied from elementary histograms or plots.
	<<Analysis: types>>=
	type :: graph_element_t
	private
	integer :: type = AN_UNDEFINED
	type(histogram_t), pointer :: h => null ()
	type(plot_t), pointer :: p => null ()
	end type graph_element_t

	@ %def graph_element_t
	<<Analysis: procedures>>=
	subroutine graph_element_final (el)
	type(graph_element_t), intent(inout) :: el
	select case (el%type)
	case (AN_HISTOGRAM)
	deallocate (el%h)
	case (AN_PLOT)
	call plot_final (el%p)
	deallocate (el%p)
	end select
	el%type = AN_UNDEFINED
	end subroutine graph_element_final

	@ %def graph_element_final
	@ Return the number of entries in the graph element:
	<<Analysis: procedures>>=
	function graph_element_get_n_entries (el) result (n)
	integer :: n
	type(graph_element_t), intent(in) :: el
	select case (el%type)
	case (AN_HISTOGRAM); n = histogram_get_n_entries (el%h)
	case (AN_PLOT); n = plot_get_n_entries (el%p)
	case default; n = 0
	end select
	end function graph_element_get_n_entries

	@ %def graph_element_get_n_entries
	@ Return a pointer to the graph / drawing options.
	<<Analysis: procedures>>=
	function graph_element_get_graph_options_ptr (el) result (ptr)
	type(graph_options_t), pointer :: ptr
	type(graph_element_t), intent(in) :: el
	select case (el%type)
	case (AN_HISTOGRAM); ptr => histogram_get_graph_options_ptr (el%h)
	case (AN_PLOT); ptr => plot_get_graph_options_ptr (el%p)
	case default; ptr => null ()
	end select
	end function graph_element_get_graph_options_ptr

	function graph_element_get_drawing_options_ptr (el) result (ptr)
	type(drawing_options_t), pointer :: ptr
	type(graph_element_t), intent(in) :: el
	select case (el%type)
	case (AN_HISTOGRAM); ptr => histogram_get_drawing_options_ptr (el%h)
	case (AN_PLOT); ptr => plot_get_drawing_options_ptr (el%p)
	case default; ptr => null ()
	end select
	end function graph_element_get_drawing_options_ptr

	@ %def graph_element_get_graph_options_ptr
	@ %def graph_element_get_drawing_options_ptr
	@ Output, simple wrapper for the plot/histogram writer.
	<<Analysis: procedures>>=
	subroutine graph_element_write (el, unit)
	type(graph_element_t), intent(in) :: el
	integer, intent(in), optional :: unit
	type(graph_options_t), pointer :: gro
	type(string_t) :: id
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	gro => graph_element_get_graph_options_ptr (el)
	id = graph_options_get_id (gro)
	write (u, "(A,A)") '#', repeat ("-", 78)
	select case (el%type)
	case (AN_HISTOGRAM)
	write (u, "(A)", advance="no") "# Histogram: "
	write (u, "(1x,A)") char (id)
	call histogram_write (el%h, unit)
	case (AN_PLOT)
	write (u, "(A)", advance="no") "# Plot: "
	write (u, "(1x,A)") char (id)
	call plot_write (el%p, unit)
	end select
	end subroutine graph_element_write

	@ %def graph_element_write
	<<Analysis: procedures>>=
	subroutine graph_element_write_gml_reader (el, filename, unit)
	type(graph_element_t), intent(in) :: el
	type(string_t), intent(in) :: filename
	integer, intent(in), optional :: unit
	select case (el%type)
	case (AN_HISTOGRAM); call histogram_write_gml_reader (el%h, filename, unit)
	case (AN_PLOT); call plot_write_gml_reader (el%p, filename, unit)
	end select
	end subroutine graph_element_write_gml_reader

	@ %def graph_element_write_gml_reader
	@
	\subsubsection{The graph type}
	The actual graph type contains its own [[graph_options]], which override the
	individual settings. The [[drawing_options]] are set in the graph elements.
	This distinction motivates the separation of the two types.
	<<Analysis: types>>=
	type :: graph_t
	private
	type(graph_element_t), dimension(:), allocatable :: el
	type(graph_options_t) :: graph_options
	end type graph_t

	@ %def graph_t
	@
	\subsubsection{Initializer/finalizer}
	The graph is created with a definite number of elements. The elements are
	filled one by one, optionally with modified drawing options.
	<<Analysis: procedures>>=
	subroutine graph_init (g, id, n_elements, graph_options)
	type(graph_t), intent(out) :: g
	type(string_t), intent(in) :: id
	integer, intent(in) :: n_elements
	type(graph_options_t), intent(in), optional :: graph_options
	allocate (g%el (n_elements))
	if (present (graph_options)) then
	g%graph_options = graph_options
	else
	call g%graph_options%init ()
	end if
	call g%graph_options%set (id = id)
	end subroutine graph_init

	@ %def graph_init
	<<Analysis: procedures>>=
	subroutine graph_insert_histogram (g, i, h, drawing_options)
	type(graph_t), intent(inout), target :: g
	integer, intent(in) :: i
	type(histogram_t), intent(in) :: h
	type(drawing_options_t), intent(in), optional :: drawing_options
	type(graph_options_t), pointer :: gro
	type(drawing_options_t), pointer :: dro
	type(string_t) :: id
	g%el(i)%type = AN_HISTOGRAM
	allocate (g%el(i)%h)
	call histogram_init_histogram (g%el(i)%h, h, drawing_options)
	gro => histogram_get_graph_options_ptr (g%el(i)%h)
	dro => histogram_get_drawing_options_ptr (g%el(i)%h)
	id = graph_options_get_id (gro)
	call dro%set (dataset = "dat." // id)
	end subroutine graph_insert_histogram

	@ %def graph_insert_histogram
	<<Analysis: procedures>>=
	subroutine graph_insert_plot (g, i, p, drawing_options)
	type(graph_t), intent(inout) :: g
	integer, intent(in) :: i
	type(plot_t), intent(in) :: p
	type(drawing_options_t), intent(in), optional :: drawing_options
	type(graph_options_t), pointer :: gro
	type(drawing_options_t), pointer :: dro
	type(string_t) :: id
	g%el(i)%type = AN_PLOT
	allocate (g%el(i)%p)
	call plot_init_plot (g%el(i)%p, p, drawing_options)
	gro => plot_get_graph_options_ptr (g%el(i)%p)
	dro => plot_get_drawing_options_ptr (g%el(i)%p)
	id = graph_options_get_id (gro)
	call dro%set (dataset = "dat." // id)
	end subroutine graph_insert_plot

	@ %def graph_insert_plot
	@ Finalizer.
	<<Analysis: procedures>>=
	subroutine graph_final (g)
	type(graph_t), intent(inout) :: g
	integer :: i
	do i = 1, size (g%el)
	call graph_element_final (g%el(i))
	end do
	deallocate (g%el)
	end subroutine graph_final

	@ %def graph_final
	@
	\subsubsection{Access contents}
	The number of elements.
	<<Analysis: procedures>>=
	function graph_get_n_elements (graph) result (n)
	integer :: n
	type(graph_t), intent(in) :: graph
	n = size (graph%el)
	end function graph_get_n_elements

	@ %def graph_get_n_elements
	@ Retrieve a pointer to the drawing options of an element, so they can be
	modified. (The [[target]] attribute is not actually needed because the
	components are pointers.)
	<<Analysis: procedures>>=
	function graph_get_drawing_options_ptr (g, i) result (ptr)
	type(drawing_options_t), pointer :: ptr
	type(graph_t), intent(in), target :: g
	integer, intent(in) :: i
	ptr => graph_element_get_drawing_options_ptr (g%el(i))
	end function graph_get_drawing_options_ptr

	@ %def graph_get_drawing_options_ptr
	@
	\subsubsection{Output}
	The default output format just writes histogram and plot data.
	<<Analysis: procedures>>=
	subroutine graph_write (graph, unit)
	type(graph_t), intent(in) :: graph
	integer, intent(in), optional :: unit
	integer :: i
	do i = 1, size (graph%el)
	call graph_element_write (graph%el(i), unit)
	end do
	end subroutine graph_write

	@ %def graph_write
	@ The GAMELAN driver is not a simple wrapper, but it writes the plot/histogram
	contents embedded the complete graph. First, data are read in, global
	background commands next, then individual elements, then global foreground
	commands.
	<<Analysis: procedures>>=
	subroutine graph_write_gml_driver (g, filename, unit)
	type(graph_t), intent(in) :: g
	type(string_t), intent(in) :: filename
	type(string_t) :: calc_cmd, bg_cmd, draw_cmd, err_cmd, symb_cmd, fg_cmd
	integer, intent(in), optional :: unit
	type(drawing_options_t), pointer :: dro
	integer :: u, i
	u = given_output_unit (unit); if (u < 0) return
	call graph_options_write_tex_header (g%graph_options, unit)
	write (u, "(2x,A)") &
	char (graph_options_get_gml_setup (g%graph_options))
	write (u, "(2x,A)") &
	char (graph_options_get_gml_graphrange (g%graph_options))
	do i = 1, size (g%el)
	call graph_element_write_gml_reader (g%el(i), filename, unit)
	calc_cmd = drawing_options_get_calc_command &
	(graph_element_get_drawing_options_ptr (g%el(i)))
	if (calc_cmd /= "") write (u, "(2x,A)") char (calc_cmd)
	end do
	bg_cmd = graph_options_get_gml_bg_command (g%graph_options)
	if (bg_cmd /= "") write (u, "(2x,A)") char (bg_cmd)
	do i = 1, size (g%el)
	dro => graph_element_get_drawing_options_ptr (g%el(i))
	bg_cmd = drawing_options_get_gml_bg_command (dro)
	if (bg_cmd /= "") write (u, "(2x,A)") char (bg_cmd)
	draw_cmd = drawing_options_get_draw_command (dro)
	if (draw_cmd /= "") write (u, "(2x,A)") char (draw_cmd)
	err_cmd = drawing_options_get_err_command (dro)
	if (err_cmd /= "") write (u, "(2x,A)") char (err_cmd)
	symb_cmd = drawing_options_get_symb_command (dro)
	if (symb_cmd /= "") write (u, "(2x,A)") char (symb_cmd)
	fg_cmd = drawing_options_get_gml_fg_command (dro)
	if (fg_cmd /= "") write (u, "(2x,A)") char (fg_cmd)
	end do
	fg_cmd = graph_options_get_gml_fg_command (g%graph_options)
	if (fg_cmd /= "") write (u, "(2x,A)") char (fg_cmd)
	write (u, "(2x,A)") char (graph_options_get_gml_x_label (g%graph_options))
	write (u, "(2x,A)") char (graph_options_get_gml_y_label (g%graph_options))
	call graph_options_write_tex_footer (g%graph_options, unit)
	end subroutine graph_write_gml_driver

	@ %def graph_write_gml_driver
	@ Append header for generic data output in ifile format.
	<<Analysis: procedures>>=
	subroutine graph_get_header (graph, header, comment)
	type(graph_t), intent(in) :: graph
	type(ifile_t), intent(inout) :: header
	type(string_t), intent(in), optional :: comment
	type(string_t) :: c
	if (present (comment)) then
	c = comment
	else
	c = ""
	end if
	call ifile_append (header, c // "WHIZARD graph data")
	call graph_options_get_header (graph%graph_options, header, comment)
	call ifile_append (header, &
	c // "number of graph elements: " &
	// int2char (graph_get_n_elements (graph)))
	end subroutine graph_get_header

	@ %def graph_get_header
	@
	\subsection{Analysis objects}
	This data structure holds all observables, histograms and such that
	are currently active. We have one global store; individual items are
	identified by their ID strings.

	(This should rather be coded by type extension.)
	<<Analysis: parameters>>=
	integer, parameter :: AN_UNDEFINED = 0
	integer, parameter :: AN_OBSERVABLE = 1
	integer, parameter :: AN_HISTOGRAM = 2
	integer, parameter :: AN_PLOT = 3
	integer, parameter :: AN_GRAPH = 4
	<<Analysis: public>>=
	public :: AN_UNDEFINED, AN_HISTOGRAM, AN_OBSERVABLE, AN_PLOT, AN_GRAPH

	@ %def AN_UNDEFINED
	@ %def AN_OBSERVABLE AN_HISTOGRAM AN_PLOT AN_GRAPH
	<<Analysis: types>>=
	type :: analysis_object_t
	private
	type(string_t) :: id
	integer :: type = AN_UNDEFINED
	type(observable_t), pointer :: obs => null ()
	type(histogram_t), pointer :: h => null ()
	type(plot_t), pointer :: p => null ()
	type(graph_t), pointer :: g => null ()
	type(analysis_object_t), pointer :: next => null ()
	end type analysis_object_t

	@ %def analysis_object_t
	@
	\subsubsection{Initializer/finalizer}
	Allocate with the correct type but do not fill initial values.
	<<Analysis: procedures>>=
	subroutine analysis_object_init (obj, id, type)
	type(analysis_object_t), intent(out) :: obj
	type(string_t), intent(in) :: id
	integer, intent(in) :: type
	obj%id = id
	obj%type = type
	select case (obj%type)
	case (AN_OBSERVABLE); allocate (obj%obs)
	case (AN_HISTOGRAM); allocate (obj%h)
	case (AN_PLOT); allocate (obj%p)
	case (AN_GRAPH); allocate (obj%g)
	end select
	end subroutine analysis_object_init

	@ %def analysis_object_init
	<<Analysis: procedures>>=
	subroutine analysis_object_final (obj)
	type(analysis_object_t), intent(inout) :: obj
	select case (obj%type)
	case (AN_OBSERVABLE)
	deallocate (obj%obs)
	case (AN_HISTOGRAM)
	deallocate (obj%h)
	case (AN_PLOT)
	call plot_final (obj%p)
	deallocate (obj%p)
	case (AN_GRAPH)
	call graph_final (obj%g)
	deallocate (obj%g)
	end select
	obj%type = AN_UNDEFINED
	end subroutine analysis_object_final

	@ %def analysis_object_final
	@ Clear the analysis object, i.e., reset it to its initial state. Not
	applicable to graphs, which are always combinations of other existing
	objects.
	<<Analysis: procedures>>=
	subroutine analysis_object_clear (obj)
	type(analysis_object_t), intent(inout) :: obj
	select case (obj%type)
	case (AN_OBSERVABLE)
	call observable_clear (obj%obs)
	case (AN_HISTOGRAM)
	call histogram_clear (obj%h)
	case (AN_PLOT)
	call plot_clear (obj%p)
	end select
	end subroutine analysis_object_clear

	@ %def analysis_object_clear
	@
	\subsubsection{Fill with data}
	Record data. The effect depends on the type of analysis object.
	<<Analysis: procedures>>=
	subroutine analysis_object_record_data (obj, &
	x, y, yerr, xerr, weight, excess, success)
	type(analysis_object_t), intent(inout) :: obj
	real(default), intent(in) :: x
	real(default), intent(in), optional :: y, yerr, xerr, weight, excess
	logical, intent(out), optional :: success
	select case (obj%type)
	case (AN_OBSERVABLE)
	if (present (weight)) then
	call observable_record_value_weighted (obj%obs, x, weight, success)
	else
	call observable_record_value_unweighted (obj%obs, x, success)
	end if
	case (AN_HISTOGRAM)
	if (present (weight)) then
	call histogram_record_value_weighted (obj%h, x, weight, success)
	else
	call histogram_record_value_unweighted (obj%h, x, excess, success)
	end if
	case (AN_PLOT)
	if (present (y)) then
	call plot_record_value (obj%p, x, y, yerr, xerr, success)
	else
	if (present (success)) success = .false.
	end if
	case default
	if (present (success)) success = .false.
	end select
	end subroutine analysis_object_record_data

	@ %def analysis_object_record_data
	@ Explicitly set the pointer to the next object in the list.
	<<Analysis: procedures>>=
	subroutine analysis_object_set_next_ptr (obj, next)
	type(analysis_object_t), intent(inout) :: obj
	type(analysis_object_t), pointer :: next
	obj%next => next
	end subroutine analysis_object_set_next_ptr

	@ %def analysis_object_set_next_ptr
	@
	\subsubsection{Access contents}
	Return a pointer to the next object in the list.
	<<Analysis: procedures>>=
	function analysis_object_get_next_ptr (obj) result (next)
	type(analysis_object_t), pointer :: next
	type(analysis_object_t), intent(in) :: obj
	next => obj%next
	end function analysis_object_get_next_ptr

	@ %def analysis_object_get_next_ptr
	@ Return data as appropriate for the object type.
	<<Analysis: procedures>>=
	function analysis_object_get_n_elements (obj) result (n)
	integer :: n
	type(analysis_object_t), intent(in) :: obj
	select case (obj%type)
	case (AN_HISTOGRAM)
	n = 1
	case (AN_PLOT)
	n = 1
	case (AN_GRAPH)
	n = graph_get_n_elements (obj%g)
	case default
	n = 0
	end select
	end function analysis_object_get_n_elements

	function analysis_object_get_n_entries (obj, within_bounds) result (n)
	integer :: n
	type(analysis_object_t), intent(in) :: obj
	logical, intent(in), optional :: within_bounds
	logical :: wb
	select case (obj%type)
	case (AN_OBSERVABLE)
	n = observable_get_n_entries (obj%obs)
	case (AN_HISTOGRAM)
	wb = .false.; if (present (within_bounds)) wb = within_bounds
	if (wb) then
	n = histogram_get_n_entries_within_bounds (obj%h)
	else
	n = histogram_get_n_entries (obj%h)
	end if
	case (AN_PLOT)
	n = plot_get_n_entries (obj%p)
	case default
	n = 0
	end select
	end function analysis_object_get_n_entries

	function analysis_object_get_average (obj, within_bounds) result (avg)
	real(default) :: avg
	type(analysis_object_t), intent(in) :: obj
	logical, intent(in), optional :: within_bounds
	logical :: wb
	select case (obj%type)
	case (AN_OBSERVABLE)
	avg = observable_get_average (obj%obs)
	case (AN_HISTOGRAM)
	wb = .false.; if (present (within_bounds)) wb = within_bounds
	if (wb) then
	avg = histogram_get_average_within_bounds (obj%h)
	else
	avg = histogram_get_average (obj%h)
	end if
	case default
	avg = 0
	end select
	end function analysis_object_get_average

	function analysis_object_get_error (obj, within_bounds) result (err)
	real(default) :: err
	type(analysis_object_t), intent(in) :: obj
	logical, intent(in), optional :: within_bounds
	logical :: wb
	select case (obj%type)
	case (AN_OBSERVABLE)
	err = observable_get_error (obj%obs)
	case (AN_HISTOGRAM)
	wb = .false.; if (present (within_bounds)) wb = within_bounds
	if (wb) then
	err = histogram_get_error_within_bounds (obj%h)
	else
	err = histogram_get_error (obj%h)
	end if
	case default
	err = 0
	end select
	end function analysis_object_get_error

	@ %def analysis_object_get_n_elements
	@ %def analysis_object_get_n_entries
	@ %def analysis_object_get_average
	@ %def analysis_object_get_error
	@ Return pointers to the actual contents:
	<<Analysis: procedures>>=
	function analysis_object_get_observable_ptr (obj) result (obs)
	type(observable_t), pointer :: obs
	type(analysis_object_t), intent(in) :: obj
	select case (obj%type)
	case (AN_OBSERVABLE); obs => obj%obs
	case default; obs => null ()
	end select
	end function analysis_object_get_observable_ptr

	function analysis_object_get_histogram_ptr (obj) result (h)
	type(histogram_t), pointer :: h
	type(analysis_object_t), intent(in) :: obj
	select case (obj%type)
	case (AN_HISTOGRAM); h => obj%h
	case default; h => null ()
	end select
	end function analysis_object_get_histogram_ptr

	function analysis_object_get_plot_ptr (obj) result (plot)
	type(plot_t), pointer :: plot
	type(analysis_object_t), intent(in) :: obj
	select case (obj%type)
	case (AN_PLOT); plot => obj%p
	case default; plot => null ()
	end select
	end function analysis_object_get_plot_ptr

	function analysis_object_get_graph_ptr (obj) result (g)
	type(graph_t), pointer :: g
	type(analysis_object_t), intent(in) :: obj
	select case (obj%type)
	case (AN_GRAPH); g => obj%g
	case default; g => null ()
	end select
	end function analysis_object_get_graph_ptr

	@ %def analysis_object_get_observable_ptr
	@ %def analysis_object_get_histogram_ptr
	@ %def analysis_object_get_plot_ptr
	@ %def analysis_object_get_graph_ptr
	@ Return true if the object has a graphical representation:
	<<Analysis: procedures>>=
	function analysis_object_has_plot (obj) result (flag)
	logical :: flag
	type(analysis_object_t), intent(in) :: obj
	select case (obj%type)
	case (AN_HISTOGRAM); flag = .true.
	case (AN_PLOT); flag = .true.
	case (AN_GRAPH); flag = .true.
	case default; flag = .false.
	end select
	end function analysis_object_has_plot

	@ %def analysis_object_has_plot
	@
	\subsubsection{Output}
	<<Analysis: procedures>>=
	subroutine analysis_object_write (obj, unit, verbose)
	type(analysis_object_t), intent(in) :: obj
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	logical :: verb
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	verb = .false.; if (present (verbose)) verb = verbose
	write (u, "(A)") repeat ("#", 79)
	select case (obj%type)
	case (AN_OBSERVABLE)
	write (u, "(A)", advance="no") "# Observable:"
	case (AN_HISTOGRAM)
	write (u, "(A)", advance="no") "# Histogram: "
	case (AN_PLOT)
	write (u, "(A)", advance="no") "# Plot: "
	case (AN_GRAPH)
	write (u, "(A)", advance="no") "# Graph: "
	case default
	write (u, "(A)") "# [undefined analysis object]"
	return
	end select
	write (u, "(1x,A)") char (obj%id)
	select case (obj%type)
	case (AN_OBSERVABLE)
	call observable_write (obj%obs, unit)
	case (AN_HISTOGRAM)
	if (verb) then
	call obj%h%graph_options%write (unit)
	write (u, *)
	call obj%h%drawing_options%write (unit)
	write (u, *)
	end if
	call histogram_write (obj%h, unit)
	case (AN_PLOT)
	if (verb) then
	call obj%p%graph_options%write (unit)
	write (u, *)
	call obj%p%drawing_options%write (unit)
	write (u, *)
	end if
	call plot_write (obj%p, unit)
	case (AN_GRAPH)
	call graph_write (obj%g, unit)
	end select
	end subroutine analysis_object_write

	@ %def analysis_object_write
	@ Write the object part of the \LaTeX\ driver file.
	<<Analysis: procedures>>=
	subroutine analysis_object_write_driver (obj, filename, unit)
	type(analysis_object_t), intent(in) :: obj
	type(string_t), intent(in) :: filename
	integer, intent(in), optional :: unit
	select case (obj%type)
	case (AN_OBSERVABLE)
	call observable_write_driver (obj%obs, unit)
	case (AN_HISTOGRAM)
	call histogram_write_gml_driver (obj%h, filename, unit)
	case (AN_PLOT)
	call plot_write_gml_driver (obj%p, filename, unit)
	case (AN_GRAPH)
	call graph_write_gml_driver (obj%g, filename, unit)
	end select
	end subroutine analysis_object_write_driver

	@ %def analysis_object_write_driver
	@ Return a data header for external formats, in ifile form.
	<<Analysis: procedures>>=
	subroutine analysis_object_get_header (obj, header, comment)
	type(analysis_object_t), intent(in) :: obj
	type(ifile_t), intent(inout) :: header
	type(string_t), intent(in), optional :: comment
	select case (obj%type)
	case (AN_HISTOGRAM)
	call histogram_get_header (obj%h, header, comment)
	case (AN_PLOT)
	call plot_get_header (obj%p, header, comment)
	end select
	end subroutine analysis_object_get_header

	@ %def analysis_object_get_header
	@
	\subsection{Analysis object iterator}
	Analysis objects are containers which have iterable data structures:
	histograms/bins and plots/points. If they are to be treated on a common
	basis, it is useful to have an iterator which hides the implementation
	details.

	The iterator is used only for elementary analysis objects that contain plot
	data: histograms or plots. It is invalid for meta-objects (graphs) and
	non-graphical objects (observables).
	<<Analysis: types>>=
	type :: analysis_iterator_t
	private
	integer :: type = AN_UNDEFINED
	type(analysis_object_t), pointer :: object => null ()
	integer :: index = 1
	type(point_t), pointer :: point => null ()
	end type

	@ %def analysis_iterator_t
	@ The initializer places the iterator at the beginning of the analysis object.
	<<Analysis: procedures>>=
	subroutine analysis_iterator_init (iterator, object)
	type(analysis_iterator_t), intent(out) :: iterator
	type(analysis_object_t), intent(in), target :: object
	iterator%object => object
	if (associated (iterator%object)) then
	iterator%type = iterator%object%type
	select case (iterator%type)
	case (AN_PLOT)
	iterator%point => iterator%object%p%first
	end select
	end if
	end subroutine analysis_iterator_init

	@ %def analysis_iterator_init
	@ The iterator is valid as long as it points to an existing entry. An
	iterator for a data object without array data (observable) is always invalid.
	<<Analysis: procedures>>=
	function analysis_iterator_is_valid (iterator) result (valid)
	logical :: valid
	type(analysis_iterator_t), intent(in) :: iterator
	if (associated (iterator%object)) then
	select case (iterator%type)
	case (AN_HISTOGRAM)
	valid = iterator%index <= histogram_get_n_bins (iterator%object%h)
	case (AN_PLOT)
	valid = associated (iterator%point)
	case default
	valid = .false.
	end select
	else
	valid = .false.
	end if
	end function analysis_iterator_is_valid

	@ %def analysis_iterator_is_valid
	@ Advance the iterator.
	<<Analysis: procedures>>=
	subroutine analysis_iterator_advance (iterator)
	type(analysis_iterator_t), intent(inout) :: iterator
	if (associated (iterator%object)) then
	select case (iterator%type)
	case (AN_PLOT)
	iterator%point => iterator%point%next
	end select
	iterator%index = iterator%index + 1
	end if
	end subroutine analysis_iterator_advance

	@ %def analysis_iterator_advance
	@ Retrieve the object type:
	<<Analysis: procedures>>=
	function analysis_iterator_get_type (iterator) result (type)
	integer :: type
	type(analysis_iterator_t), intent(in) :: iterator
	type = iterator%type
	end function analysis_iterator_get_type

	@ %def analysis_iterator_get_type
	@ Use the iterator to retrieve data. We implement a common routine which
	takes the data descriptors as optional arguments. Data which do not occur in
	the selected type trigger to an error condition.

	The iterator must point to a valid entry.
	<<Analysis: procedures>>=
	subroutine analysis_iterator_get_data (iterator, &
	x, y, yerr, xerr, width, excess, index, n_total)
	type(analysis_iterator_t), intent(in) :: iterator
	real(default), intent(out), optional :: x, y, yerr, xerr, width, excess
	integer, intent(out), optional :: index, n_total
	select case (iterator%type)
	case (AN_HISTOGRAM)
	if (present (x)) &
	x = bin_get_midpoint (iterator%object%h%bin(iterator%index))
	if (present (y)) &
	y = bin_get_sum (iterator%object%h%bin(iterator%index))
	if (present (yerr)) &
	yerr = bin_get_error (iterator%object%h%bin(iterator%index))
	if (present (xerr)) &
	call invalid ("histogram", "xerr")
	if (present (width)) &
	width = bin_get_width (iterator%object%h%bin(iterator%index))
	if (present (excess)) &
	excess = bin_get_excess (iterator%object%h%bin(iterator%index))
	if (present (index)) &
	index = iterator%index
	if (present (n_total)) &
	n_total = histogram_get_n_bins (iterator%object%h)
	case (AN_PLOT)
	if (present (x)) &
	x = point_get_x (iterator%point)
	if (present (y)) &
	y = point_get_y (iterator%point)
	if (present (yerr)) &
	yerr = point_get_yerr (iterator%point)
	if (present (xerr)) &
	xerr = point_get_xerr (iterator%point)
	if (present (width)) &
	call invalid ("plot", "width")
	if (present (excess)) &
	call invalid ("plot", "excess")
	if (present (index)) &
	index = iterator%index
	if (present (n_total)) &
	n_total = plot_get_n_entries (iterator%object%p)
	case default
	call msg_bug ("analysis_iterator_get_data: called " &
	// "for unsupported analysis object type")
	end select
	contains
	subroutine invalid (typestr, objstr)
	character(*), intent(in) :: typestr, objstr
	call msg_bug ("analysis_iterator_get_data: attempt to get '" &
	// objstr // "' for type '" // typestr // "'")
	end subroutine invalid
	end subroutine analysis_iterator_get_data

	@ %def analysis_iterator_get_data
	@
	\subsection{Analysis store}
	This data structure holds all observables, histograms and such that
	are currently active. We have one global store; individual items are
	identified by their ID strings and types.
	<<Analysis: variables>>=
	type(analysis_store_t), save :: analysis_store

	@ %def analysis_store
	<<Analysis: types>>=
	type :: analysis_store_t
	private
	type(analysis_object_t), pointer :: first => null ()
	type(analysis_object_t), pointer :: last => null ()
	end type analysis_store_t

	@ %def analysis_store_t
	@ Delete the analysis store
	<<Analysis: public>>=
	public :: analysis_final
	<<Analysis: sub interfaces>>=
	module subroutine analysis_final ()
	end subroutine analysis_final
	<<Analysis: procedures>>=
	module subroutine analysis_final ()
	type(analysis_object_t), pointer :: current
	do while (associated (analysis_store%first))
	current => analysis_store%first
	analysis_store%first => current%next
	call analysis_object_final (current)
	end do
	analysis_store%last => null ()
	end subroutine analysis_final

	@ %def analysis_final
	@ Append a new analysis object
	<<Analysis: procedures>>=
	subroutine analysis_store_append_object (id, type)
	type(string_t), intent(in) :: id
	integer, intent(in) :: type
	type(analysis_object_t), pointer :: obj
	allocate (obj)
	call analysis_object_init (obj, id, type)
	if (associated (analysis_store%last)) then
	analysis_store%last%next => obj
	else
	analysis_store%first => obj
	end if
	analysis_store%last => obj
	end subroutine analysis_store_append_object

	@ %def analysis_store_append_object
	@ Return a pointer to the analysis object with given ID.
	<<Analysis: procedures>>=
	function analysis_store_get_object_ptr (id) result (obj)
	type(string_t), intent(in) :: id
	type(analysis_object_t), pointer :: obj
	obj => analysis_store%first
	do while (associated (obj))
	if (obj%id == id) return
	obj => obj%next
	end do
	end function analysis_store_get_object_ptr

	@ %def analysis_store_get_object_ptr
	@ Initialize an analysis object: either reset it if present, or append
	a new entry.
	<<Analysis: procedures>>=
	subroutine analysis_store_init_object (id, type, obj)
	type(string_t), intent(in) :: id
	integer, intent(in) :: type
	type(analysis_object_t), pointer :: obj, next
	obj => analysis_store_get_object_ptr (id)
	if (associated (obj)) then
	next => analysis_object_get_next_ptr (obj)
	call analysis_object_final (obj)
	call analysis_object_init (obj, id, type)
	call analysis_object_set_next_ptr (obj, next)
	else
	call analysis_store_append_object (id, type)
	obj => analysis_store%last
	end if
	end subroutine analysis_store_init_object

	@ %def analysis_store_init_object
	@ Get the type of a analysis object
	<<Analysis: public>>=
	public :: analysis_store_get_object_type
	<<Analysis: sub interfaces>>=
	module function analysis_store_get_object_type (id) result (type)
	type(string_t), intent(in) :: id
	integer :: type
	end function analysis_store_get_object_type
	<<Analysis: procedures>>=
	module function analysis_store_get_object_type (id) result (type)
	type(string_t), intent(in) :: id
	integer :: type
	type(analysis_object_t), pointer :: object
	object => analysis_store_get_object_ptr (id)
	if (associated (object)) then
	type = object%type
	else
	type = AN_UNDEFINED
	end if
	end function analysis_store_get_object_type

	@ %def analysis_store_get_object_type
	@ Return the number of objects in the store.
	<<Analysis: procedures>>=
	function analysis_store_get_n_objects () result (n)
	integer :: n
	type(analysis_object_t), pointer :: current
	n = 0
	current => analysis_store%first
	do while (associated (current))
	n = n + 1
	current => current%next
	end do
	end function analysis_store_get_n_objects

	@ %def analysis_store_get_n_objects
	@ Allocate an array and fill it with all existing IDs.
	<<Analysis: public>>=
	public :: analysis_store_get_ids
	<<Analysis: sub interfaces>>=
	module subroutine analysis_store_get_ids (id)
	type(string_t), dimension(:), allocatable, intent(out) :: id
	end subroutine analysis_store_get_ids
	<<Analysis: procedures>>=
	module subroutine analysis_store_get_ids (id)
	type(string_t), dimension(:), allocatable, intent(out) :: id
	type(analysis_object_t), pointer :: current
	integer :: i
	allocate (id (analysis_store_get_n_objects()))
	i = 0
	current => analysis_store%first
	do while (associated (current))
	i = i + 1
	id(i) = current%id
	current => current%next
	end do
	end subroutine analysis_store_get_ids

	@ %def analysis_store_get_ids
	@
	\subsection{\LaTeX\ driver file}
	Write a driver file for all objects in the store.
	<<Analysis: procedures>>=
	subroutine analysis_store_write_driver_all (filename_data, unit)
	type(string_t), intent(in) :: filename_data
	integer, intent(in), optional :: unit
	type(analysis_object_t), pointer :: obj
	call analysis_store_write_driver_header (unit)
	obj => analysis_store%first
	do while (associated (obj))
	call analysis_object_write_driver (obj, filename_data, unit)
	obj => obj%next
	end do
	call analysis_store_write_driver_footer (unit)
	end subroutine analysis_store_write_driver_all

	@ %def analysis_store_write_driver_all
	@
	Write a driver file for an array of objects.
	<<Analysis: procedures>>=
	subroutine analysis_store_write_driver_obj (filename_data, id, unit)
	type(string_t), intent(in) :: filename_data
	type(string_t), dimension(:), intent(in) :: id
	integer, intent(in), optional :: unit
	type(analysis_object_t), pointer :: obj
	integer :: i
	call analysis_store_write_driver_header (unit)
	do i = 1, size (id)
	obj => analysis_store_get_object_ptr (id(i))
	if (associated (obj)) &
	call analysis_object_write_driver (obj, filename_data, unit)
	end do
	call analysis_store_write_driver_footer (unit)
	end subroutine analysis_store_write_driver_obj

	@ %def analysis_store_write_driver_obj
	@ The beginning of the driver file.
	<<Analysis: procedures>>=
	subroutine analysis_store_write_driver_header (unit)
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write (u, '(A)') "\documentclass[12pt]{article}"
	write (u, *)
	write (u, '(A)') "\usepackage{gamelan}"
	write (u, '(A)') "\usepackage{amsmath}"
	write (u, '(A)') "\usepackage{ifpdf}"
	write (u, '(A)') "\ifpdf"
	write (u, '(A)') " \DeclareGraphicsRule{}{mps}{}{}"
	write (u, '(A)') "\else"
	write (u, '(A)') " \DeclareGraphicsRule{}{eps}{}{}"
	write (u, '(A)') "\fi"
	write (u, *)
	write (u, '(A)') "\begin{document}"
	write (u, '(A)') "\begin{gmlfile}"
	write (u, *)
	write (u, '(A)') "\begin{gmlcode}"
	write (u, '(A)') " color col.default, col.excess;"
	write (u, '(A)') " col.default = 0.9white;"
	write (u, '(A)') " col.excess = red;"
	write (u, '(A)') " boolean show_excess;"
	!!! Future excess options for plots
	! if (mcs(1)%plot_excess .and. mcs(1)%unweighted) then
	! write (u, '(A)') " show_excess = true;"
	! else
	write (u, '(A)') " show_excess = false;"
	! end if
	write (u, '(A)') "\end{gmlcode}"
	write (u, *)
	end subroutine analysis_store_write_driver_header

	@ %def analysis_store_write_driver_header
	@ The end of the driver file.
	<<Analysis: procedures>>=
	subroutine analysis_store_write_driver_footer (unit)
	integer, intent(in), optional :: unit
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	write(u, *)
	write(u, '(A)') "\end{gmlfile}"
	write(u, '(A)') "\end{document}"
	end subroutine analysis_store_write_driver_footer

	@ %def analysis_store_write_driver_footer
	@
	\subsection{API}
	\subsubsection{Creating new objects}
	The specific versions below:
	<<Analysis: public>>=
	public :: analysis_init_observable
	<<Analysis: sub interfaces>>=
	module subroutine analysis_init_observable (id, obs_label, obs_unit, graph_options)
	type(string_t), intent(in) :: id
	type(string_t), intent(in), optional :: obs_label, obs_unit
	type(graph_options_t), intent(in), optional :: graph_options
	end subroutine analysis_init_observable
	<<Analysis: procedures>>=
	module subroutine analysis_init_observable (id, obs_label, obs_unit, graph_options)
	type(string_t), intent(in) :: id
	type(string_t), intent(in), optional :: obs_label, obs_unit
	type(graph_options_t), intent(in), optional :: graph_options
	type(analysis_object_t), pointer :: obj
	type(observable_t), pointer :: obs
	call analysis_store_init_object (id, AN_OBSERVABLE, obj)
	obs => analysis_object_get_observable_ptr (obj)
	call observable_init (obs, obs_label, obs_unit, graph_options)
	end subroutine analysis_init_observable

	@ %def analysis_init_observable
	<<Analysis: public>>=
	public :: analysis_init_histogram
	<<Analysis: interfaces>>=
	interface analysis_init_histogram
	module procedure analysis_init_histogram_n_bins
	module procedure analysis_init_histogram_bin_width
	end interface

	<<Analysis: sub interfaces>>=
	module subroutine analysis_init_histogram_n_bins &
	(id, lower_bound, upper_bound, n_bins, normalize_bins, &
	obs_label, obs_unit, graph_options, drawing_options)
	type(string_t), intent(in) :: id
	real(default), intent(in) :: lower_bound, upper_bound
	integer, intent(in) :: n_bins
	logical, intent(in) :: normalize_bins
	type(string_t), intent(in), optional :: obs_label, obs_unit
	type(graph_options_t), intent(in), optional :: graph_options
	type(drawing_options_t), intent(in), optional :: drawing_options
	end subroutine analysis_init_histogram_n_bins
	module subroutine analysis_init_histogram_bin_width &
	(id, lower_bound, upper_bound, bin_width, normalize_bins, &
	obs_label, obs_unit, graph_options, drawing_options)
	type(string_t), intent(in) :: id
	real(default), intent(in) :: lower_bound, upper_bound, bin_width
	logical, intent(in) :: normalize_bins
	type(string_t), intent(in), optional :: obs_label, obs_unit
	type(graph_options_t), intent(in), optional :: graph_options
	type(drawing_options_t), intent(in), optional :: drawing_options
	end subroutine analysis_init_histogram_bin_width
	<<Analysis: procedures>>=
	module subroutine analysis_init_histogram_n_bins &
	(id, lower_bound, upper_bound, n_bins, normalize_bins, &
	obs_label, obs_unit, graph_options, drawing_options)
	type(string_t), intent(in) :: id
	real(default), intent(in) :: lower_bound, upper_bound
	integer, intent(in) :: n_bins
	logical, intent(in) :: normalize_bins
	type(string_t), intent(in), optional :: obs_label, obs_unit
	type(graph_options_t), intent(in), optional :: graph_options
	type(drawing_options_t), intent(in), optional :: drawing_options
	type(analysis_object_t), pointer :: obj
	type(histogram_t), pointer :: h
	call analysis_store_init_object (id, AN_HISTOGRAM, obj)
	h => analysis_object_get_histogram_ptr (obj)
	call histogram_init (h, id, &
	lower_bound, upper_bound, n_bins, normalize_bins, &
	obs_label, obs_unit, graph_options, drawing_options)
	end subroutine analysis_init_histogram_n_bins

	module subroutine analysis_init_histogram_bin_width &
	(id, lower_bound, upper_bound, bin_width, normalize_bins, &
	obs_label, obs_unit, graph_options, drawing_options)
	type(string_t), intent(in) :: id
	real(default), intent(in) :: lower_bound, upper_bound, bin_width
	logical, intent(in) :: normalize_bins
	type(string_t), intent(in), optional :: obs_label, obs_unit
	type(graph_options_t), intent(in), optional :: graph_options
	type(drawing_options_t), intent(in), optional :: drawing_options
	type(analysis_object_t), pointer :: obj
	type(histogram_t), pointer :: h
	call analysis_store_init_object (id, AN_HISTOGRAM, obj)
	h => analysis_object_get_histogram_ptr (obj)
	call histogram_init (h, id, &
	lower_bound, upper_bound, bin_width, normalize_bins, &
	obs_label, obs_unit, graph_options, drawing_options)
	end subroutine analysis_init_histogram_bin_width

	@ %def analysis_init_histogram_n_bins
	@ %def analysis_init_histogram_bin_width
	<<Analysis: public>>=
	public :: analysis_init_plot
	<<Analysis: sub interfaces>>=
	module subroutine analysis_init_plot (id, graph_options, drawing_options)
	type(string_t), intent(in) :: id
	type(graph_options_t), intent(in), optional :: graph_options
	type(drawing_options_t), intent(in), optional :: drawing_options
	end subroutine analysis_init_plot
	<<Analysis: procedures>>=
	module subroutine analysis_init_plot (id, graph_options, drawing_options)
	type(string_t), intent(in) :: id
	type(graph_options_t), intent(in), optional :: graph_options
	type(drawing_options_t), intent(in), optional :: drawing_options
	type(analysis_object_t), pointer :: obj
	type(plot_t), pointer :: plot
	call analysis_store_init_object (id, AN_PLOT, obj)
	plot => analysis_object_get_plot_ptr (obj)
	call plot_init (plot, id, graph_options, drawing_options)
	end subroutine analysis_init_plot

	@ %def analysis_init_plot
	<<Analysis: public>>=
	public :: analysis_init_graph
	<<Analysis: sub interfaces>>=
	module subroutine analysis_init_graph (id, n_elements, graph_options)
	type(string_t), intent(in) :: id
	integer, intent(in) :: n_elements
	type(graph_options_t), intent(in), optional :: graph_options
	end subroutine analysis_init_graph
	<<Analysis: procedures>>=
	module subroutine analysis_init_graph (id, n_elements, graph_options)
	type(string_t), intent(in) :: id
	integer, intent(in) :: n_elements
	type(graph_options_t), intent(in), optional :: graph_options
	type(analysis_object_t), pointer :: obj
	type(graph_t), pointer :: graph
	call analysis_store_init_object (id, AN_GRAPH, obj)
	graph => analysis_object_get_graph_ptr (obj)
	call graph_init (graph, id, n_elements, graph_options)
	end subroutine analysis_init_graph

	@ %def analysis_init_graph
	@
	\subsubsection{Recording data}
	This procedure resets an object or the whole store to its initial
	state.
	<<Analysis: public>>=
	public :: analysis_clear
	<<Analysis: interfaces>>=
	interface analysis_clear
	module procedure analysis_store_clear_obj
	module procedure analysis_store_clear_all
	end interface

	<<Analysis: sub interfaces>>=
	module subroutine analysis_store_clear_obj (id)
	type(string_t), intent(in) :: id
	end subroutine analysis_store_clear_obj
	module subroutine analysis_store_clear_all ()
	end subroutine analysis_store_clear_all
	<<Analysis: procedures>>=
	module subroutine analysis_store_clear_obj (id)
	type(string_t), intent(in) :: id
	type(analysis_object_t), pointer :: obj
	obj => analysis_store_get_object_ptr (id)
	if (associated (obj)) then
	call analysis_object_clear (obj)
	end if
	end subroutine analysis_store_clear_obj

	module subroutine analysis_store_clear_all ()
	type(analysis_object_t), pointer :: obj
	obj => analysis_store%first
	do while (associated (obj))
	call analysis_object_clear (obj)
	obj => obj%next
	end do
	end subroutine analysis_store_clear_all

	@ %def analysis_clear
	@
	There is one generic recording function whose behavior depends on the
	type of analysis object.
	<<Analysis: public>>=
	public :: analysis_record_data
	<<Analysis: sub interfaces>>=
	module subroutine analysis_record_data (id, x, y, yerr, xerr, &
	weight, excess, success, exist)
	type(string_t), intent(in) :: id
	real(default), intent(in) :: x
	real(default), intent(in), optional :: y, yerr, xerr, weight, excess
	logical, intent(out), optional :: success, exist
	end subroutine analysis_record_data
	<<Analysis: procedures>>=
	module subroutine analysis_record_data (id, x, y, yerr, xerr, &
	weight, excess, success, exist)
	type(string_t), intent(in) :: id
	real(default), intent(in) :: x
	real(default), intent(in), optional :: y, yerr, xerr, weight, excess
	logical, intent(out), optional :: success, exist
	type(analysis_object_t), pointer :: obj
	obj => analysis_store_get_object_ptr (id)
	if (associated (obj)) then
	call analysis_object_record_data (obj, x, y, yerr, xerr, &
	weight, excess, success)
	if (present (exist)) exist = .true.
	else
	if (present (success)) success = .false.
	if (present (exist)) exist = .false.
	end if
	end subroutine analysis_record_data

	@ %def analysis_record_data
	@
	\subsubsection{Build a graph}
	This routine sets up the array of graph elements by copying the graph elements
	given as input. The object must exist and already be initialized as a graph.
	<<Analysis: public>>=
	public :: analysis_fill_graph
	<<Analysis: sub interfaces>>=
	module subroutine analysis_fill_graph (id, i, id_in, drawing_options)
	type(string_t), intent(in) :: id
	integer, intent(in) :: i
	type(string_t), intent(in) :: id_in
	type(drawing_options_t), intent(in), optional :: drawing_options
	end subroutine analysis_fill_graph
	<<Analysis: procedures>>=
	module subroutine analysis_fill_graph (id, i, id_in, drawing_options)
	type(string_t), intent(in) :: id
	integer, intent(in) :: i
	type(string_t), intent(in) :: id_in
	type(drawing_options_t), intent(in), optional :: drawing_options
	type(analysis_object_t), pointer :: obj
	type(graph_t), pointer :: g
	type(histogram_t), pointer :: h
	type(plot_t), pointer :: p
	obj => analysis_store_get_object_ptr (id)
	g => analysis_object_get_graph_ptr (obj)
	obj => analysis_store_get_object_ptr (id_in)
	if (associated (obj)) then
	select case (obj%type)
	case (AN_HISTOGRAM)
	h => analysis_object_get_histogram_ptr (obj)
	call graph_insert_histogram (g, i, h, drawing_options)
	case (AN_PLOT)
	p => analysis_object_get_plot_ptr (obj)
	call graph_insert_plot (g, i, p, drawing_options)
	case default
	call msg_error ("Graph '" // char (id) // "': Element '" &
	// char (id_in) // "' is neither histogram nor plot.")
	end select
	else
	call msg_error ("Graph '" // char (id) // "': Element '" &
	// char (id_in) // "' is undefined.")
	end if
	end subroutine analysis_fill_graph

	@ %def analysis_fill_graph
	@
	\subsubsection{Retrieve generic results}
	Check if a named object exists.
	<<Analysis: public>>=
	public :: analysis_exists
	<<Analysis: sub interfaces>>=
	module function analysis_exists (id) result (flag)
	type(string_t), intent(in) :: id
	logical :: flag
	end function analysis_exists
	<<Analysis: procedures>>=
	module function analysis_exists (id) result (flag)
	type(string_t), intent(in) :: id
	logical :: flag
	type(analysis_object_t), pointer :: obj
	flag = .true.
	obj => analysis_store%first
	do while (associated (obj))
	if (obj%id == id) return
	obj => obj%next
	end do
	flag = .false.
	end function analysis_exists

	@ %def analysis_exists
	@ The following functions should work for all kinds of analysis object:
	<<Analysis: public>>=
	public :: analysis_get_n_elements
	public :: analysis_get_n_entries
	public :: analysis_get_average
	public :: analysis_get_error

	<<Analysis: sub interfaces>>=
	module function analysis_get_n_elements (id) result (n)
	integer :: n
	type(string_t), intent(in) :: id
	end function analysis_get_n_elements
	module function analysis_get_n_entries (id, within_bounds) result (n)
	integer :: n
	type(string_t), intent(in) :: id
	logical, intent(in), optional :: within_bounds
	end function analysis_get_n_entries
	module function analysis_get_average (id, within_bounds) result (avg)
	real(default) :: avg
	type(string_t), intent(in) :: id
	logical, intent(in), optional :: within_bounds
	end function analysis_get_average
	module function analysis_get_error (id, within_bounds) result (err)
	real(default) :: err
	type(string_t), intent(in) :: id
	logical, intent(in), optional :: within_bounds
	end function analysis_get_error
	<<Analysis: procedures>>=
	module function analysis_get_n_elements (id) result (n)
	integer :: n
	type(string_t), intent(in) :: id
	type(analysis_object_t), pointer :: obj
	obj => analysis_store_get_object_ptr (id)
	if (associated (obj)) then
	n = analysis_object_get_n_elements (obj)
	else
	n = 0
	end if
	end function analysis_get_n_elements

	module function analysis_get_n_entries (id, within_bounds) result (n)
	integer :: n
	type(string_t), intent(in) :: id
	logical, intent(in), optional :: within_bounds
	type(analysis_object_t), pointer :: obj
	obj => analysis_store_get_object_ptr (id)
	if (associated (obj)) then
	n = analysis_object_get_n_entries (obj, within_bounds)
	else
	n = 0
	end if
	end function analysis_get_n_entries

	module function analysis_get_average (id, within_bounds) result (avg)
	real(default) :: avg
	type(string_t), intent(in) :: id
	type(analysis_object_t), pointer :: obj
	logical, intent(in), optional :: within_bounds
	obj => analysis_store_get_object_ptr (id)
	if (associated (obj)) then
	avg = analysis_object_get_average (obj, within_bounds)
	else
	avg = 0
	end if
	end function analysis_get_average

	module function analysis_get_error (id, within_bounds) result (err)
	real(default) :: err
	type(string_t), intent(in) :: id
	type(analysis_object_t), pointer :: obj
	logical, intent(in), optional :: within_bounds
	obj => analysis_store_get_object_ptr (id)
	if (associated (obj)) then
	err = analysis_object_get_error (obj, within_bounds)
	else
	err = 0
	end if
	end function analysis_get_error

	@ %def analysis_get_n_elements
	@ %def analysis_get_n_entries
	@ %def analysis_get_average
	@ %def analysis_get_error
	@ Return true if any analysis object is graphical
	<<Analysis: public>>=
	public :: analysis_has_plots
	<<Analysis: interfaces>>=
	interface analysis_has_plots
	module procedure analysis_has_plots_any
	module procedure analysis_has_plots_obj
	end interface

	<<Analysis: sub interfaces>>=
	module function analysis_has_plots_any () result (flag)
	logical :: flag
	end function analysis_has_plots_any
	module function analysis_has_plots_obj (id) result (flag)
	logical :: flag
	type(string_t), dimension(:), intent(in) :: id
	end function analysis_has_plots_obj
	<<Analysis: procedures>>=
	module function analysis_has_plots_any () result (flag)
	logical :: flag
	type(analysis_object_t), pointer :: obj
	flag = .false.
	obj => analysis_store%first
	do while (associated (obj))
	flag = analysis_object_has_plot (obj)
	if (flag) return
	end do
	end function analysis_has_plots_any

	module function analysis_has_plots_obj (id) result (flag)
	logical :: flag
	type(string_t), dimension(:), intent(in) :: id
	type(analysis_object_t), pointer :: obj
	integer :: i
	flag = .false.
	do i = 1, size (id)
	obj => analysis_store_get_object_ptr (id(i))
	if (associated (obj)) then
	flag = analysis_object_has_plot (obj)
	if (flag) return
	end if
	end do
	end function analysis_has_plots_obj

	@ %def analysis_has_plots
	@
	\subsubsection{Iterators}
	Initialize an iterator for the given object. If the object does not exist or
	has wrong type, the iterator will be invalid.
	<<Analysis: procedures>>=
	subroutine analysis_init_iterator (id, iterator)
	type(string_t), intent(in) :: id
	type(analysis_iterator_t), intent(out) :: iterator
	type(analysis_object_t), pointer :: obj
	obj => analysis_store_get_object_ptr (id)
	if (associated (obj)) call analysis_iterator_init (iterator, obj)
	end subroutine analysis_init_iterator

	@ %def analysis_init_iterator
	@
	\subsubsection{Output}
	<<Analysis: public>>=
	public :: analysis_write
	<<Analysis: interfaces>>=
	interface analysis_write
	module procedure analysis_write_object
	module procedure analysis_write_all
	end interface

	@ %def interface
	<<Analysis: sub interfaces>>=
	module subroutine analysis_write_object (id, unit, verbose)
	type(string_t), intent(in) :: id
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine analysis_write_object
	module subroutine analysis_write_all (unit, verbose)
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	end subroutine analysis_write_all
	<<Analysis: procedures>>=
	module subroutine analysis_write_object (id, unit, verbose)
	type(string_t), intent(in) :: id
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	type(analysis_object_t), pointer :: obj
	obj => analysis_store_get_object_ptr (id)
	if (associated (obj)) then
	call analysis_object_write (obj, unit, verbose)
	else
	call msg_error ("Analysis object '" // char (id) // "' not found")
	end if
	end subroutine analysis_write_object

	module subroutine analysis_write_all (unit, verbose)
	integer, intent(in), optional :: unit
	logical, intent(in), optional :: verbose
	type(analysis_object_t), pointer :: obj
	integer :: u
	u = given_output_unit (unit); if (u < 0) return
	obj => analysis_store%first
	do while (associated (obj))
	call analysis_object_write (obj, unit, verbose)
	obj => obj%next
	end do
	end subroutine analysis_write_all

	@ %def analysis_write_object
	@ %def analysis_write_all
	<<Analysis: public>>=
	public :: analysis_write_driver
	<<Analysis: sub interfaces>>=
	module subroutine analysis_write_driver (filename_data, id, unit)
	type(string_t), intent(in) :: filename_data
	type(string_t), dimension(:), intent(in), optional :: id
	integer, intent(in), optional :: unit
	end subroutine analysis_write_driver
	<<Analysis: procedures>>=
	module subroutine analysis_write_driver (filename_data, id, unit)
	type(string_t), intent(in) :: filename_data
	type(string_t), dimension(:), intent(in), optional :: id
	integer, intent(in), optional :: unit
	if (present (id)) then
	call analysis_store_write_driver_obj (filename_data, id, unit)
	else
	call analysis_store_write_driver_all (filename_data, unit)
	end if
	end subroutine analysis_write_driver

	@ %def analysis_write_driver
	<<Analysis: public>>=
	public :: analysis_compile_tex
	<<Analysis: sub interfaces>>=
	module subroutine analysis_compile_tex (file, has_gmlcode, os_data)
	type(string_t), intent(in) :: file
	logical, intent(in) :: has_gmlcode
	type(os_data_t), intent(in) :: os_data
	end subroutine analysis_compile_tex
	<<Analysis: procedures>>=
	module subroutine analysis_compile_tex (file, has_gmlcode, os_data)
	type(string_t), intent(in) :: file
	logical, intent(in) :: has_gmlcode
	type(os_data_t), intent(in) :: os_data
	integer :: status
	if (os_data%event_analysis_ps) then
	call os_system_call ("make compile " // os_data%makeflags // " -f " // &
	char (file) // "_ana.makefile", status)
	if (status /= 0) then
	call msg_error ("Unable to compile analysis output file")
	end if
	else
	call msg_warning ("Skipping results display because " &
	// "latex/mpost/dvips is not available")
	end if
	end subroutine analysis_compile_tex

	@ %def analysis_compile_tex
	@ Write header for generic data output to an ifile.
	<<Analysis: procedures>>=
	subroutine analysis_get_header (id, header, comment)
	type(string_t), intent(in) :: id
	type(ifile_t), intent(inout) :: header
	type(string_t), intent(in), optional :: comment
	type(analysis_object_t), pointer :: object
	object => analysis_store_get_object_ptr (id)
	if (associated (object)) then
	call analysis_object_get_header (object, header, comment)
	end if
	end subroutine analysis_get_header

	@ %def analysis_get_header
	@ Write a makefile in order to do the compile steps.
	<<Analysis: public>>=
	public :: analysis_write_makefile
	<<Analysis: sub interfaces>>=
	module subroutine analysis_write_makefile (filename, unit, has_gmlcode, os_data)
	type(string_t), intent(in) :: filename
	integer, intent(in) :: unit
	logical, intent(in) :: has_gmlcode
	type(os_data_t), intent(in) :: os_data
	end subroutine analysis_write_makefile
	<<Analysis: procedures>>=
	module subroutine analysis_write_makefile (filename, unit, has_gmlcode, os_data)
	type(string_t), intent(in) :: filename
	integer, intent(in) :: unit
	logical, intent(in) :: has_gmlcode
	type(os_data_t), intent(in) :: os_data
	write (unit, "(3A)") "# WHIZARD: Makefile for analysis '", &
	char (filename), "'"
	write (unit, "(A)") "# Automatically generated file, do not edit"
	write (unit, "(A)") ""
	write (unit, "(A)") "# LaTeX setup"
	write (unit, "(A)") "LATEX = " // char (os_data%latex)
	write (unit, "(A)") "MPOST = " // char (os_data%mpost)
	write (unit, "(A)") "GML = " // char (os_data%gml)
	write (unit, "(A)") "DVIPS = " // char (os_data%dvips)
	write (unit, "(A)") "PS2PDF = " // char (os_data%ps2pdf)
	- write (unit, "(A)") 'TEX_FLAGS = "$$TEXINPUTS:' // &
	- char(os_data%whizard_texpath) // '"'
	- write (unit, "(A)") 'MP_FLAGS = "$$MPINPUTS:' // &
	- char(os_data%whizard_texpath) // '"'
	+ write (unit, "(A)") 'TEX_FLAGS = "' // char(os_data%whizard_texpath) &
	+ // ':$$TEXINPUTS"'
	+ write (unit, "(A)") 'MP_FLAGS = "' // char(os_data%whizard_texpath) &
	+ // ':$$MPINPUTS"'
	write (unit, "(A)") ""
	write (unit, "(5A)") "TEX_SOURCES = ", char (filename), ".tex"
	if (os_data%event_analysis_pdf) then
	write (unit, "(5A)") "TEX_OBJECTS = ", char (filename), ".pdf"
	else
	write (unit, "(5A)") "TEX_OBJECTS = ", char (filename), ".ps"
	end if
	if (os_data%event_analysis_ps) then
	if (os_data%event_analysis_pdf) then
	write (unit, "(5A)") char (filename), ".pdf: ", &
	char (filename), ".tex"
	else
	write (unit, "(5A)") char (filename), ".ps: ", &
	char (filename), ".tex"
	end if
	write (unit, "(5A)") TAB, "-TEXINPUTS=$(TEX_FLAGS) $(LATEX) " // &
	char (filename) // ".tex"
	if (has_gmlcode) then
	write (unit, "(5A)") TAB, "$(GML) " // char (filename)
	write (unit, "(5A)") TAB, "TEXINPUTS=$(TEX_FLAGS) $(LATEX) " // &
	char (filename) // ".tex"
	end if
	write (unit, "(5A)") TAB, "$(DVIPS) -o " // char (filename) // ".ps " // &
	char (filename) // ".dvi"
	if (os_data%event_analysis_pdf) then
	write (unit, "(5A)") TAB, "$(PS2PDF) " // char (filename) // ".ps"
	end if
	end if
	write (unit, "(A)")
	write (unit, "(A)") "compile: $(TEX_OBJECTS)"
	write (unit, "(A)") ".PHONY: compile"
	write (unit, "(A)")
	write (unit, "(5A)") "CLEAN_OBJECTS = ", char (filename), ".aux"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".log"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".dvi"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".out"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".[1-9]"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".[1-9][0-9]"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".[1-9][0-9][0-9]"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".t[1-9]"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".t[1-9][0-9]"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".t[1-9][0-9][0-9]"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".ltp"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".mp"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".mpx"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".dvi"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".ps"
	write (unit, "(5A)") "CLEAN_OBJECTS += ", char (filename), ".pdf"
	write (unit, "(A)")
	write (unit, "(A)") "# Generic cleanup targets"
	write (unit, "(A)") "clean-objects:"
	write (unit, "(A)") TAB // "rm -f $(CLEAN_OBJECTS)"
	write (unit, "(A)") ""
	write (unit, "(A)") "clean: clean-objects"
	write (unit, "(A)") ".PHONY: clean"
	end subroutine analysis_write_makefile

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

	module analysis_ut
	use unit_tests
	use analysis_uti

	<<Standard module head>>

	<<Analysis: public test>>

	contains

	<<Analysis: test driver>>

	end module analysis_ut
	@ %def analysis_ut
	@
	<<[[analysis_uti.f90]]>>=
	<<File header>>

	module analysis_uti

	<<Use kinds>>
	<<Use strings>>
	use format_defs, only: FMT_19

	use analysis

	<<Standard module head>>

	<<Analysis: test declarations>>

	contains

	<<Analysis: tests>>

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

	@ %def analysis_test
	<<Analysis: execute tests>>=
	call test (analysis_1, "analysis_1", &
	"check elementary analysis building blocks", &
	u, results)
	<<Analysis: test declarations>>=
	public :: analysis_1
	<<Analysis: tests>>=
	subroutine analysis_1 (u)
	integer, intent(in) :: u
	type(string_t) :: id1, id2, id3, id4
	integer :: i
	id1 = "foo"
	id2 = "bar"
	id3 = "hist"
	id4 = "plot"

	write (u, "(A)") "* Test output: Analysis"
	write (u, "(A)") "* Purpose: test the analysis routines"
	write (u, "(A)")

	call analysis_init_observable (id1)
	call analysis_init_observable (id2)
	call analysis_init_histogram &
	(id3, 0.5_default, 5.5_default, 1._default, normalize_bins=.false.)
	call analysis_init_plot (id4)
	do i = 1, 3
	write (u, "(A,1x," // FMT_19 // ")") "data = ", real(i,default)
	call analysis_record_data (id1, real(i,default))
	call analysis_record_data (id2, real(i,default), &
	weight=real(i,default))
	call analysis_record_data (id3, real(i,default))
	call analysis_record_data (id4, real(i,default), real(i,default)**2)
	end do
	write (u, "(A,10(1x,I5))") "n_entries = ", &
	analysis_get_n_entries (id1), &
	analysis_get_n_entries (id2), &
	analysis_get_n_entries (id3), &
	analysis_get_n_entries (id3, within_bounds = .true.), &
	analysis_get_n_entries (id4), &
	analysis_get_n_entries (id4, within_bounds = .true.)
	write (u, "(A,10(1x," // FMT_19 // "))") "average = ", &
	analysis_get_average (id1), &
	analysis_get_average (id2), &
	analysis_get_average (id3), &
	analysis_get_average (id3, within_bounds = .true.)
	write (u, "(A,10(1x," // FMT_19 // "))") "error = ", &
	analysis_get_error (id1), &
	analysis_get_error (id2), &
	analysis_get_error (id3), &
	analysis_get_error (id3, within_bounds = .true.)

	write (u, "(A)")
	write (u, "(A)") "* Clear analysis #2"
	write (u, "(A)")

	call analysis_clear (id2)
	do i = 4, 6
	print *, "data = ", real(i,default)
	call analysis_record_data (id1, real(i,default))
	call analysis_record_data (id2, real(i,default), &
	weight=real(i,default))
	call analysis_record_data (id3, real(i,default))
	call analysis_record_data (id4, real(i,default), real(i,default)**2)
	end do
	write (u, "(A,10(1x,I5))") "n_entries = ", &
	analysis_get_n_entries (id1), &
	analysis_get_n_entries (id2), &
	analysis_get_n_entries (id3), &
	analysis_get_n_entries (id3, within_bounds = .true.), &
	analysis_get_n_entries (id4), &
	analysis_get_n_entries (id4, within_bounds = .true.)
	write (u, "(A,10(1x," // FMT_19 // "))") "average = ", &
	analysis_get_average (id1), &
	analysis_get_average (id2), &
	analysis_get_average (id3), &
	analysis_get_average (id3, within_bounds = .true.)
	write (u, "(A,10(1x," // FMT_19 // "))") "error = ", &
	analysis_get_error (id1), &
	analysis_get_error (id2), &
	analysis_get_error (id3), &
	analysis_get_error (id3, within_bounds = .true.)
	write (u, "(A)")
	call analysis_write (u)

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

	call analysis_clear ()
	call analysis_final ()

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

	@ %def analysis_1
	Index: trunk/omega/share/doc/Makefile.am
	===================================================================
	--- trunk/omega/share/doc/Makefile.am (revision 8883)
	+++ trunk/omega/share/doc/Makefile.am (revision 8884)
	@@ -1,270 +1,270 @@
	# Makefile.am -- Makefile for O'Mega within and without WHIZARD
	##
	## Process this file with automake to produce Makefile.in
	##
	########################################################################
	#
	# Copyright (C) 1999-2023 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.
	#
	########################################################################

	########################################################################
	### TODO: fix weaving of lexers and parsers
	########################################################################

	include $(top_srcdir)/omega/src/Makefile.sources

	VPATH = $(srcdir):$(top_builddir)/omega/src:$(srcdir):$(top_srcdir)/omega/src

	PICTURES_PDF = \
	modules.pdf \
	omega-paper-1-pics-1.pdf \
	omega-paper-1-pics-2.pdf \
	omega-paper-1-pics-3.pdf \
	omega-paper-1-pics-4.pdf \
	omega-paper-1-pics-5.pdf \
	omega-paper-1-pics-6.pdf \
	omega-paper-1-pics-7.pdf \
	omega-paper-1-pics-8.pdf \
	omega-paper-1-pics-9.pdf \
	omega-paper-1-pics-10.pdf \
	bhabha.pdf bhabha0.pdf \
	epemudbardubar.pdf epemudbardubar0.pdf \
	epemudbarmunumubar.pdf epemudbarmunumubar0.pdf \
	sign_ex.pdf fusion_rules.pdf mom_choice.pdf \
	mom_flow.pdf

	LATEX_STYLES = \
	flex.cls thophys.sty thohacks.sty \
	noweb.sty ocamlweb.sty ytableau.sty \
	feynmp.sty feynmp.mp emp.sty

	-TEX_FLAGS = "$$TEXINPUTS:$(top_srcdir)/omega/share/doc"
	-MP_FLAGS = "$$MPINPUTS:$(top_srcdir)/omega/share/doc"
	+TEX_FLAGS = "$(top_srcdir)/omega/share/doc:$$TEXINPUTS"
	+MP_FLAGS = "$(top_srcdir)/omega/share/doc:$$MPINPUTS"

	if DISTRIBUTION
	PDFS = omega.pdf omega-paper-1.pdf omega-paper-2.pdf
	else
	PDFS =
	endif

	### Files needed to be installed with the O'Mega distribution
	modelsdir = $(pkgdatadir)/doc
	if CONTEXT_AVAILABLE
	dist_doc_DATA = $(PDFS)
	else
	dist_doc_DATA =
	endif

	EXTRA_DIST = $(PICTURES_PDF) $(LATEX_STYLES)

	if NOWEB_AVAILABLE
	pdf-local: $(PDFS)
	else
	pdf-local:
	endif

	SUFFIXES = .mly .mll .ml .implementation .mli .interface .nw .tex .pdf

	MPOST_LATEX = TEX=$(LATEX) TEXINPUTS=$(TEX_FLAGS) MPINPUTS=$(MP_FLAGS) $(MPOST)

	if DISTRIBUTION
	if CONTEXT_AVAILABLE
	if PDFLATEX_AVAILABLE
	.tex.pdf:
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; else \
	echo " PDFLATEX " $<; TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; fi
	if MPOST_AVAILABLE
	@if test -r $*pics.mp; then \
	if $(AM_V_P); then MPINPUTS=$(MP_FLAGS) $(MPOST) $*pics; else \
	echo " METAPOST " $pics.mp; MPINPUTS=$(MP_FLAGS) $(MPOST) $pics > /dev/null; fi; \
	fi
	@if test -r $*.mp; then \
	if $(AM_V_P); then $(MPOST_LATEX) $*; else \
	echo " METAPOST " $.mp; $(MPOST_LATEX) $ >/dev/null; fi; \
	fi
	endif MPOST_AVAILABLE
	$(AM_V_at)echo " PDFLATEX skipping -bibtex $*"
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; else \
	echo " PDFLATEX " $<; TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; fi
	@if $(AM_V_P); then \
	if grep -s 'Rerun to get cross-references right.' $*.log; then \
	TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; \
	fi; else \
	if grep -s 'Rerun to get cross-references right.' $*.log >/dev/null; then \
	echo " PDFLATEX " $< "(for cross-references)"; \
	TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; \
	fi; \
	fi
	endif PDFLATEX_AVAILABLE
	endif CONTEXT_AVAILABLE
	endif DISTRIBUTION

	if DISTRIBUTION
	if CONTEXT_AVAILABLE
	if PDFLATEX_AVAILABLE

	omega-paper-1.pdf: modules.pdf \
	omega-paper-1-pics-1.pdf \
	omega-paper-1-pics-2.pdf \
	omega-paper-1-pics-3.pdf \
	omega-paper-1-pics-4.pdf \
	omega-paper-1-pics-5.pdf \
	omega-paper-1-pics-6.pdf \
	omega-paper-1-pics-7.pdf \
	omega-paper-1-pics-8.pdf \
	omega-paper-1-pics-9.pdf \
	omega-paper-1-pics-10.pdf

	# Dependencies and avoid mpost race condition
	omega-paper-2.pdf: \
	omega-paper-1.pdf sign_ex.pdf fusion_rules.pdf \
	mom_choice.pdf mom_flow.pdf

	endif PDFLATEX_AVAILABLE
	endif CONTEXT_AVAILABLE
	endif DISTRIBUTION

	OMEGA_CORE_INTERFACES = $(OMEGA_CORE_MLI:.mli=.interface)
	OMEGA_CORE_IMPLEMENTATIONS = $(OMEGA_CORE_ML:.ml=.implementation)
	OMEGA_MODELLIB_INTERFACES = $(OMEGA_MODELLIB_MLI:.mli=.interface)
	OMEGA_MODELLIB_IMPLEMENTATIONS = $(OMEGA_MODELLIB_ML:.ml=.implementation)
	OMEGA_TARGETLIB_INTERFACES = $(OMEGA_TARGETLIB_MLI:.mli=.interface)
	OMEGA_TARGETLIB_IMPLEMENTATIONS = $(OMEGA_TARGETLIB_ML:.ml=.implementation)
	OMEGA_APPLICATIONS_IMPLEMENTATIONS = $(OMEGA_APPLICATIONS_ML:.ml=.implementation)

	OMEGA_INTERFACES = \
	$(OMEGA_CORE_INTERFACES) \
	$(OMEGA_MODELLIB_INTERFACES) \
	$(OMEGA_TARGETLIB_INTERFACES)

	OMEGA_IMPLEMENTATIONS = \
	$(OMEGA_CORE_IMPLEMENTATIONS) \
	$(OMEGA_MODELLIB_IMPLEMENTATIONS) \
	$(OMEGA_TARGETLIB_IMPLEMENTATIONS) \
	$(OMEGA_APPLICATIONS_IMPLEMENTATIONS)

	if !NOWEB_AVAILABLE

	omega.pdf:

	else NOWEB_AVAILABLE

	omega.pdf: \
	$(OMEGA_INTERFACES) $(OMEGA_IMPLEMENTATIONS) omegalib.tex index.tex \
	$(PICTURES_PDF)

	.nw.tex:
	@if $(AM_V_P); then :; else echo " NOWEAVE " $@; fi
	$(AM_V_at)$(NOWEAVE) -delay $< > $@

	if DISTRIBUTION
	if OCAMLWEB_AVAILABLE

	.mll.implementation:
	@if $(AM_V_P); then :; else echo " OCAMLWEB " $@; fi
	$(AM_V_at)$(OCAMLWEB) --no-preamble --noweb --no-index $< >$@

	.mly.implementation:
	@if $(AM_V_P); then :; else echo " OCAMLWEB " $@; fi
	$(AM_V_at)$(OCAMLWEB) --no-preamble --noweb --no-index $< >$@

	.ml.implementation:
	@if $(AM_V_P); then :; else echo " OCAMLWEB " $@; fi
	$(AM_V_at)$(OCAMLWEB) --no-preamble --noweb --no-index $< >$@

	.mli.interface:
	@if $(AM_V_P); then :; else echo " OCAMLWEB " $@; fi
	$(AM_V_at)$(OCAMLWEB) --no-preamble --noweb --no-index $< >$@

	index.tex: $(OMEGA_CAML)
	@if $(AM_V_P); then :; else echo " OCAMLWEB " $@; fi
	$(AM_V_at)$(OCAMLWEB) --no-preamble --noweb $^ \| \
	sed -n '/\\ocwbeginindex{}/,/\\ocwendindex{}/p' >$@

	endif OCAMLWEB_AVAILABLE
	endif DISTRIBUTION

	endif NOWEB_AVAILABLE

	########################################################################

	## Cleanup tasks
	mostlyclean-latex:
	-rm -f .log .aux .toc .mpx .idx .out omega*.mp \
	omegapics.t[0-9] omegapics.[0-9] $(PICTURES_PDF) \
	omegalib.tex
	clean-latex:
	maintainer-clean-latex:
	-rm $(PDFS)
	if NOWEB_AVAILABLE
	mostlyclean-omega:
	-test "$(srcdir)" != "." && rm -f $(PDFS)
	maintainer-clean-omega:
	else
	mostlyclean-omega:
	maintainer-clean-omega:
	endif
	.PHONY: mostlyclean-latex clean-latex maintainer-clean-latex
	.PHONY: mostlyclean-omega maintainer-clean-omega

	if OCAMLWEB_AVAILABLE
	mostlyclean-caml:
	-rm -f $(OMEGA_INTERFACES) $(OMEGA_IMPLEMENTATIONS) index.tex
	else
	mostlyclean-caml:
	endif
	clean-caml:
	if OCAMLWEB_AVAILABLE
	maintainer-clean-caml:
	-rm -f $(OMEGA_INTERFACES) $(OMEGA_IMPLEMENTATIONS) index.tex
	else
	maintainer-clean-caml:
	endif
	.PHONY: mostlyclean-caml clean-caml maintainer-clean-caml

	## Remove backup files
	maintainer-clean-backup:
	-rm -f *~
	.PHONY: maintainer-clean-backup

	## Register additional clean targets
	mostlyclean-local: mostlyclean-latex mostlyclean-caml mostlyclean-omega
	clean-local: clean-latex clean-caml
	maintainer-clean-local: maintainer-clean-latex maintainer-clean-caml \
	maintainer-clean-omega maintainer-clean-backup

	if !DISTRIBUTION
	install-data-hook:
	-$(INSTALL) -m 644 omega.pdf $(DESTDIR)$(datarootdir)/doc/omega
	-$(INSTALL) -m 644 omega-paper-1.pdf $(DESTDIR)$(datarootdir)/doc/omega
	-$(INSTALL) -m 644 omega-paper-2.pdf $(DESTDIR)$(datarootdir)/doc/omega

	uninstall-hook:
	-rm -f $(DESTDIR)/$(datarootdir)/doc/omega/omega.pdf
	-rm -f $(DESTDIR)/$(datarootdir)/doc/omega/omega-paper-1.pdf
	-rm -f $(DESTDIR)/$(datarootdir)/doc/omega/omega-paper-2.pdf
	endif

	########################################################################
	## The End.
	########################################################################
	Index: trunk/share/doc/Makefile.am
	===================================================================
	--- trunk/share/doc/Makefile.am (revision 8883)
	+++ trunk/share/doc/Makefile.am (revision 8884)
	@@ -1,305 +1,305 @@
	## Makefile.am -- Makefile for WHIZARD
	##
	## Process this file with automake to produce Makefile.in
	#
	# Copyright (C) 1999-2023 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 WHIZARD documented source is assembled from various directories
	## defined outside the DISTRIBUTION environment as modern autotools
	## versions complain otherwise
	w_srcdir = $(top_srcdir)/src
	VPATH = $(srcdir):$(w_srcdir)/noweb-frame:$(w_srcdir)/utilities:$(w_srcdir)/testing:$(w_srcdir)/system:$(w_srcdir)/combinatorics:$(w_srcdir)/parsing:$(w_srcdir)/rng:$(w_srcdir)/expr_base:$(w_srcdir)/physics:$(w_srcdir)/qed_pdf:$(w_srcdir)/qft:$(w_srcdir)/types:$(w_srcdir)/matrix_elements:$(w_srcdir)/particles:$(w_srcdir)/beams:$(w_srcdir)/me_methods:$(w_srcdir)/events:$(w_srcdir)/phase_space:$(w_srcdir)/vegas:$(w_srcdir)/mci:$(w_srcdir)/fks:$(w_srcdir)/gosam:$(w_srcdir)/openloops:$(w_srcdir)/blha:$(w_srcdir)/shower:$(w_srcdir)/muli:$(w_srcdir)/variables:$(w_srcdir)/model_features:$(w_srcdir)/threshold:$(w_srcdir)/process_integration:$(w_srcdir)/matching:$(w_srcdir)/transforms:$(w_srcdir)/whizard-core:$(w_srcdir)/main:$(w_srcdir)/api

	## The primary targets
	if DISTRIBUTION
	## The manual source has to be distributed
	dist_noinst_DATA = manual.tex $(PACKAGE).tex \
	book.hva custom.hva fancysection.hva Whizard-Logo.jpg \
	$(MANUAL_PICS) dep2dot.py

	MANUAL_PICS = \
	proc_4f-history.pdf whizstruct.pdf cc10_1.pdf \
	cc10_2.pdf Z-lineshape_1.pdf Z-lineshape_2.pdf \
	flow4.pdf lep_higgs_1.pdf \
	lep_higgs_2.pdf lep_higgs_3.pdf circe2-smoothing.pdf \
	resonance_e_gam.pdf resonance_n_charged.pdf \
	resonance_n_hadron.pdf resonance_n_particles.pdf \
	resonance_n_photons.pdf resonance_n_visible.pdf

	if NOWEB_AVAILABLE
	dist_pdf_DATA = manual.pdf $(PACKAGE).pdf gamelan_manual.pdf
	else
	dist_pdf_DATA = manual.pdf gamelan_manual.pdf
	endif
	else
	dist_pdf_DATA =
	endif

	pdf-local: manual.pdf $(PACKAGE).pdf gamelan_manual.pdf

	if DISTRIBUTION
	if HEVEA_AVAILABLE
	html_DATA = manual.html index.html
	endif HEVEA_AVAILABLE
	endif DISTRIBUTION

	GML=../../src/gamelan/whizard-gml --math=scaled -halt-on-error --gmldir ../../src/gamelan

	LATEX_STYLES = \
	noweb.sty thophys.sty gamelan.sty hevea.sty

	-TEX_FLAGS = "$$TEXINPUTS:$(top_srcdir)/share/doc"
	+TEX_FLAGS = "$(top_srcdir)/share/doc:$$TEXINPUTS"

	EXTRA_DIST = $(LATEX_STYLES)

	## don't try to run the files in parallel (TeXLive 2009 doesn't like it)
	manual.pdf: $(PACKAGE).pdf
	$(PACKAGE).pdf: gamelan_manual.pdf $(WHIZARD_DEPENDENCY_GRAPHS_PDF) overview.pdf

	manual.pdf: variables.tex

	variables.tex: ../../src/whizard
	../../src/whizard --generate-variables-tex > variables.tex

	gamelan_manual.pdf: gamelan.sty

	SUFFIXES: .dot .tex .pdf

	.dot.pdf:
	@if $(AM_V_P); then :; else echo " DOT " $@; fi
	$(AM_V_at)$(DOT) -Tpdf $< > $@

	if DISTRIBUTION
	WHIZARD_DEPENDENCY_GRAPHS_DOT = \
	blha.dot \
	beams.dot \
	combinatorics.dot \
	events.dot \
	expr_base.dot \
	fks.dot \
	gosam.dot \
	matching.dot \
	matrix_elements.dot \
	vegas.dot \
	mci.dot \
	me_methods.dot \
	model_features.dot \
	muli.dot \
	openloops.dot \
	parsing.dot \
	particles.dot \
	phase_space.dot \
	physics.dot \
	qed_pdf.dot \
	process_integration.dot \
	qft.dot \
	rng.dot \
	shower.dot \
	system.dot \
	testing.dot \
	threshold.dot \
	transforms.dot \
	types.dot \
	utilities.dot \
	variables.dot \
	whizard-core.dot \
	main.dot \
	api.dot

	WHIZARD_DEPENDENCY_GRAPHS_PDF = $(WHIZARD_DEPENDENCY_GRAPHS_DOT:.dot=.pdf)
	all-dots: $(WHIZARD_DEPENDENCY_GRAPHS_DOT) overview.dot

	$(WHIZARD_DEPENDENCY_GRAPHS_DOT):
	@rm -f $@
	@if $(AM_V_P); then \
	$(top_srcdir)/share/doc/dep2dot.py \
	../../src/`echo $@ \| sed 's/.dot//'`/Makefile.depend > $@; else \
	echo " DEP2DOT " $@; \
	$(top_srcdir)/share/doc/dep2dot.py \
	../../src/`echo $@ \| sed 's/.dot//'`/Makefile.depend > $@; fi

	overview.dot:
	@rm -f $@
	@if $(AM_V_P); then \
	list=''; \
	for dep in $(WHIZARD_DEPENDENCY_GRAPHS_DOT); do \
	list="$$list ../../src/`echo $$dep \| sed 's/.dot//'`/Makefile.depend"; \
	done ; \
	$(top_srcdir)/share/doc/dep2dot.py $$list > $@; else \
	echo " DEP2DOT " $@; \
	list=''; \
	for dep in $(WHIZARD_DEPENDENCY_GRAPHS_DOT); do \
	list="$$list ../../src/`echo $$dep \| sed 's/.dot//'`/Makefile.depend"; \
	done ; \
	$(top_srcdir)/share/doc/dep2dot.py $$list > $@; fi
	dist_noinst_DATA += $(WHIZARD_DEPENDENCY_GRAPHS_DOT) overview.dot
	endif

	## Rules for creating PDF
	if DISTRIBUTION
	if PDFLATEX_AVAILABLE
	.tex.pdf:
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; else \
	echo " PDFLATEX " $<; TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; fi
	@if $(AM_V_P); then \
	while grep 'Rerun to get cross-references right\.' $*.log; \
	do TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; \
	done; else \
	echo " PDFLATEX " $< "(for cross-references)"; \
	while grep 'Rerun to get cross-references right\.' $*.log >/dev/null; \
	do TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; \
	done; \
	fi
	@if test -r $*.mp; then \
	if $(AM_V_P); then $(GML) $; else echo " GML " $; $(GML) $* >/dev/null; fi; \
	fi
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; else \
	echo " PDFLATEX " $<; TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; fi
	endif PDFLATEX_AVAILABLE
	endif DISTRIBUTION

	## Rules for creating HTML
	if HEVEA_AVAILABLE
	HEVEAOPTS = -exec xxdate.exe -I $(top_srcdir)/share/doc \
	book.hva fancysection.hva custom.hva
	HACHAOPTS = -tocbis

	if DISTRIBUTION
	index.html: manual.html
	@if $(AM_V_P); then $(HACHA) $(HACHAOPTS) -o index.html manual.html; else \
	echo " HACHA " $@; $(HACHA) $(HACHAOPTS) -o index.html manual.html >/dev/null 2>&1; fi

	manual.html: variables.tex manual.tex $(MANUAL_PICS)
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(HEVEA) -fix $(HEVEAOPTS) manual.tex; else \
	echo " HEVEA " $@; \
	TEXINPUTS=$(TEX_FLAGS) $(HEVEA) -s -fix $(HEVEAOPTS) manual.tex >/dev/null 2>&1; fi
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(IMAGEN) -pdf manual; else \
	echo " IMAGEN manual"; TEXINPUTS=$(TEX_FLAGS) $(IMAGEN) -pdf manual >/dev/null 2>&1; fi
	### There are no Feynman diagrams at the moment inside the manual.
	# $(MPOST) manualpics.mp
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(HEVEA) -fix $(HEVEAOPTS) manual.tex; else \
	echo " HEVEA " $@; TEXINPUTS=$(TEX_FLAGS) $(HEVEA) -s -fix $(HEVEAOPTS) manual.tex; fi
	else
	@echo "HEVEA not available. The HTML manual cannot be made"
	endif !DISTRIBUTION
	endif HEVEA_AVAILABLE

	if NOWEB_AVAILABLE
	WHIZARD_NOWEB_SRC = \
	whizard-prelude.nw \
	utilities.nw \
	testing.nw \
	system.nw \
	combinatorics.nw \
	parsing.nw rng.nw physics.nw qed_pdf.nw qft.nw \
	types.nw \
	matrix_elements.nw \
	particles.nw \
	beams.nw \
	me_methods.nw \
	events.nw \
	phase_space.nw \
	vegas.nw \
	mci.nw \
	shower.nw muli.nw \
	blha.nw gosam.nw \
	openloops.nw fks.nw \
	model_features.nw \
	threshold.nw \
	process_integration.nw \
	matching.nw \
	transforms.nw \
	whizard.nw \
	whizard-postlude.nw

	$(PACKAGE).tex: $(WHIZARD_NOWEB_SRC)
	-rm -f $@
	@if $(AM_V_P); then :; else echo " NOWEAVE " $@; fi
	$(AM_V_at)$(NOWEAVE) -delay $^ \| $(CPIF) $@

	gamelan.sty: $(top_srcdir)/src/gamelan/gamelan.nw
	@if $(AM_V_P); then :; else echo " NOTANGLE " $@; fi
	$(AM_V_at)$(NOTANGLE) -R$@ $< \| $(CPIF) $@
	endif NOWEB_AVAILABLE

	## Cleanup tasks
	mostlyclean-latex:
	-rm -f .aux .log .dvi .toc .idx .out .ltp .mp .mpx .glo \
	gamelan_manual.[1-9] gamelan_manual.[1-9][0-9] \
	manual.pdf gamelan_manual.pdf \
	$(WHIZARD_DEPENDENCY_GRAPHS_DOT) $(WHIZARD_DEPENDENCY_GRAPHS_PDF) \
	overview.dot overview.pdf variables.tex
	-test "$(srcdir)" != "." && rm -f $(PACKAGE).pdf
	clean-latex:
	maintainer-clean-latex:
	-rm manual.pdf gamelan_manual.pdf
	if NOWEB_AVAILABLE
	mostlyclean-whizard:
	-rm -f $(PACKAGE).tex $(PACKAGE).pdf gamelan.sty
	maintainer-clean-whizard:
	else
	mostlyclean-whizard:
	maintainer-clean-whizard:
	endif
	.PHONY: mostlyclean-latex clean-latex maintainer-clean-latex
	.PHONY: mostlyclean-whizard maintainer-clean-whizard

	mostlyclean-html:
	-rm -f .haux .htoc *.css index.html contents_motif.gif \
	next_motif.gif previous_motif.gif contents_motif.svg \
	next_motif.svg previous_motif.svg manual.html manual.png \
	manual.image.tex
	clean-html:
	maintainer-clean-html:
	-rm -f manual*.html index.html contents_motif.gif \
	next_motif.gif previous_motif.gif contents_motif.svg \
	next_motif.svg previous_motif.svg
	.PHONY: mostlyclean-html clean-html maintainer-clean-html

	## Remove backup files
	maintainer-clean-backup:
	-rm -f *~
	.PHONY: maintainer-clean-backup

	## Register additional clean targets
	mostlyclean-local: mostlyclean-latex mostlyclean-html mostlyclean-whizard
	clean-local: clean-latex clean-html
	maintainer-clean-local: maintainer-clean-latex maintainer-clean-html \
	maintainer-clean-whizard maintainer-clean-backup

	if !DISTRIBUTION
	install-data-hook:
	-$(INSTALL) -m 644 manual.pdf $(DESTDIR)$(datarootdir)/doc/whizard
	-$(INSTALL) -m 644 $(PACKAGE).pdf $(DESTDIR)$(datarootdir)/doc/whizard
	-$(INSTALL) -m 644 gamelan_manual.pdf $(DESTDIR)$(datarootdir)/doc/whizard

	uninstall-hook:
	-rm -f $(DESTDIR)/$(datarootdir)/doc/whizard/manual.pdf
	-rm -f $(DESTDIR)/$(datarootdir)/doc/whizard/$(PACKAGE).pdf
	-rm -f $(DESTDIR)/$(datarootdir)/doc/whizard/gamelan_manual.pdf
	endif

	########################################################################
	## The End.
	########################################################################
	Index: trunk/share/tests/unit_tests/ref-output/prclib_interfaces_3.ref
	===================================================================
	--- trunk/share/tests/unit_tests/ref-output/prclib_interfaces_3.ref (revision 8883)
	+++ trunk/share/tests/unit_tests/ref-output/prclib_interfaces_3.ref (revision 8884)
	@@ -1,111 +1,111 @@
	* Test output: prclib_interfaces_3
	* Purpose: check the generated Makefile

	* Create a prclib driver object (2 processes)

	External matrix-element code library: prclib3
	static = F
	loaded = F
	MD5 sum = 'prclib_interfaces_3_md5sum '
	Mdl flags = ''

	DL access info:
	is open = F
	error = [none]

	Matrix-element code entries:
	test1 [Test_model]
	test_1: proc1
	test2 [Test_model]
	test_2: proc1 proc2

	* Write Makefile
	* File contents:

	# WHIZARD: Makefile for process library 'prclib3'
	# Automatically generated file, do not edit

	# Integrity check (don't modify the following line!)
	MD5SUM = 'prclib_interfaces_3_md5sum '

	# Library name
	BASE = prclib3

	# Compiler
	FC = fortran-compiler
	CC = c-compiler

	# Included libraries
	FCINCL = -I module-dir

	# Compiler flags
	FCFLAGS = -C=all
	FCFLAGS_PIC = -PIC
	CFLAGS = -I include-dir
	CFLAGS_PIC = -PIC
	LDFLAGS =

	# LaTeX setup
	LATEX = latex -halt-on-error
	MPOST = mpost --math=scaled -halt-on-error
	DVIPS = dvips
	PS2PDF = ps2pdf14
	-TEX_FLAGS = "$$TEXINPUTS:"
	-MP_FLAGS = "$$MPINPUTS:"
	+TEX_FLAGS = ":$$TEXINPUTS"
	+MP_FLAGS = ":$$MPINPUTS"

	# Libtool
	LIBTOOL = my-libtool
	FCOMPILE = $(LIBTOOL) --tag=FC --mode=compile
	CCOMPILE = $(LIBTOOL) --tag=CC --mode=compile
	LINK = $(LIBTOOL) --tag=FC --mode=link

	# Compile commands (default)
	LTFCOMPILE = $(FCOMPILE) $(FC) -c $(FCINCL) $(FCFLAGS) $(FCFLAGS_PIC)
	LTCCOMPILE = $(CCOMPILE) $(CC) -c $(CFLAGS) $(CFLAGS_PIC)

	# Default target
	all: link diags

	# Matrix-element code files
	# Makefile code for process test1 goes here.
	# Makefile code for process test2 goes here.

	# Library driver
	$(BASE).lo: $(BASE).f90 $(OBJECTS)
	$(LTFCOMPILE) $<

	# Library
	$(BASE).la: $(BASE).lo $(OBJECTS)
	$(LINK) $(FC) -module -rpath /dev/null $(FCFLAGS) $(LDFLAGS) -o $(BASE).la $^

	# Main targets
	link: compile $(BASE).la
	compile: source $(OBJECTS) $(TEX_OBJECTS) $(BASE).lo
	compile_tex: $(TEX_OBJECTS)
	source: $(SOURCES) $(BASE).f90 $(TEX_SOURCES)
	.PHONY: link diags compile compile_tex source

	# Specific cleanup targets
	clean-test1:
	.PHONY: clean-test1
	clean-test2:
	.PHONY: clean-test2

	# Generic cleanup targets
	clean-library:
	rm -f $(BASE).la
	clean-objects:
	rm -f $(BASE).lo $(BASE)_driver.mod $(CLEAN_OBJECTS)
	clean-source:
	rm -f $(CLEAN_SOURCES)
	clean-driver:
	rm -f $(BASE).f90
	clean-makefile:
	rm -f $(BASE).makefile
	.PHONY: clean-library clean-objects clean-source clean-driver clean-makefile

	clean: clean-library clean-objects clean-source
	distclean: clean clean-driver clean-makefile
	.PHONY: clean distclean

	* Test output end: prclib_interfaces_3
	Index: trunk/circe1/share/doc/Makefile.am
	===================================================================
	--- trunk/circe1/share/doc/Makefile.am (revision 8883)
	+++ trunk/circe1/share/doc/Makefile.am (revision 8884)
	@@ -1,318 +1,318 @@
	# Makefile.am --
	########################################################################
	#
	# Copyright (C) 1999-2023 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.
	#
	########################################################################

	CIRCE1_VER = 1
	CIRCE1_REV = 0

	WEBS = \
	prelude.nw \
	circe1.nw minuit.nw postlude.nw

	if DISTRIBUTION
	PDFS = circe1.pdf
	else
	PDFS =
	endif

	PICTURES_PDF = \
	figures1.pdf fit11.pdf fit12.pdf \
	fit21.pdf fit22.pdf fit13.pdf \
	fit23.pdf fit15.pdf fit25.pdf \
	dist78.pdf

	LATEX_STYLES = \
	noweb.sty thohacks.sty thopp.sty

	-TEX_FLAGS = "$$TEXINPUTS:$(top_srcdir)/circe1/share/doc"
	-MP_FLAGS = "$$MPINPUTS:$(top_srcdir)/circe1/share/doc"
	+TEX_FLAGS = "$(top_srcdir)/circe1/share/doc:$$TEXINPUTS"
	+MP_FLAGS = "$(top_srcdir)/circe1/share/doc:$$MPINPUTS"

	MP4_FILES = \
	circemacs.mp4 dist.mp4 fit.mp4 graphx.mp

	EXTRA_DIST = \
	tex-comments.sh \
	$(PICTURES_PDF) \
	$(LATEX_STYLES) \
	$(MP4_FILES)

	dist_doc_DATA = $(PDFS)

	if NOWEB_AVAILABLE
	pdf-local: circe1.pdf
	endif

	VPATH = $(srcdir):$(top_builddir)/circe1/src:$(top_srcdir)/circe1/src

	if NOWEB_AVAILABLE

	circe1.tex: $(WEBS)
	@if $(AM_V_P); then :; else echo " NOWEAVE " $@; fi
	$(AM_V_at)$(NOWEAVE) -filter ./tex-comments -delay -index \
	`for i in $^; do case $$i in *.nw) echo $$i;; esac done` \
	> $@

	circe1.tex: tex-comments

	endif NOWEB_AVAILABLE

	.mp4.mp: circemacs.mp4
	@if $(AM_V_P); then :; else echo " M4 " $@; fi
	$(AM_V_at)$(M4) -I$(top_srcdir)/circe1/share/doc $< >$@

	########################################################################
	# Old targets for the fit plots
	########################################################################

	fit.mp dist.mp: circemacs.mp4

	fit.11: fit.mp
	TEX=$(LATEX) TEXINPUTS=$(TEX_FLAGS) $(MPOST) $<

	########################################################################
	# The distribution plots for the write-up
	########################################################################

	dist.1: dist.mp \
	de-sband.dat dg-sband.dat de-tesla.dat dg-tesla.dat \
	de-xband.dat dg-xband.dat de-sbandt.dat dg-sbandt.dat \
	de-teslat.dat dg-teslat.dat de-xbandt.dat dg-xbandt.dat \
	de-tesla3.dat dg-tesla3.dat de-tesla8.dat dg-tesla8.dat \
	de-sband-ee.dat dg-sband-ee.dat de-tesla-ee.dat dg-tesla-ee.dat \
	de-xband-ee.dat dg-xband-ee.dat de-sbandt-ee.dat dg-sbandt-ee.dat \
	de-teslat-ee.dat dg-teslat-ee.dat de-xbandt-ee.dat dg-xbandt-ee.dat
	@if $(AM_V_P); then TEX=$(LATEX) TEXINPUTS=$(TEX_FLAGS) \
	MPINPUTS=$(MP_FLAGS) $(MPOST) $<; else \
	echo " METAPOST " $@; TEX=$(LATEX) TEXINPUTS=$(TEX_FLAGS) \
	MPINPUTS=$(MP_FLAGS) $(MPOST) $< >/dev/null; fi

	########################################################################
	# Generating CIRCE data
	########################################################################

	de-sband.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 500.0 1 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-sband.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 500.0 1 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-tesla.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 500.0 2 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-tesla.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 500.0 2 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-xband.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 500.0 3 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-xband.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 500.0 3 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-sbandt.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 1000.0 1 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-sbandt.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 1000.0 1 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-teslat.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 1000.0 2 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-teslat.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 1000.0 2 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-xbandt.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 1000.0 3 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-xbandt.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 1000.0 3 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-tesla3.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 350.0 2 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-tesla3.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 350.0 2 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-tesla8.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 800.0 2 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-tesla8.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 800.0 2 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-sband-ee.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 500.0 4 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-sband-ee.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 500.0 4 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-tesla-ee.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 500.0 5 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-tesla-ee.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 500.0 5 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-xband-ee.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 500.0 6 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-xband-ee.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 500.0 6 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-sbandt-ee.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 1000.0 4 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-sbandt-ee.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 1000.0 4 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-teslat-ee.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 1000.0 5 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-teslat-ee.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 1000.0 5 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	de-xbandt-ee.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 11 11 1000.0 6 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	dg-xbandt-ee.dat: $(top_builddir)/circe1/tools/circe1_plot
	@if $(AM_V_P); then :; else echo " PLOT " $@; fi
	$(AM_V_at)echo 1 0.001 1.0 50 -1.0 22 11 1000.0 6 $(CIRCE1_VER) $(CIRCE1_REV) \| $(CPLOT)

	CPLOT = $(top_builddir)/circe1/tools/circe1_plot \| $(GREP) -v circe1: \| $(SED) 's/E/e/g' > $@

	tex-comments: tex-comments.sh
	cp $< $@
	chmod +x $@

	SUFFIXES = .tex .pdf

	if DISTRIBUTION
	if PDFLATEX_AVAILABLE
	if CONTEXT_AVAILABLE
	.tex.pdf:
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; else \
	echo " PDFLATEX " $<; TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; fi
	if MAKEINDEX_AVAILABLE
	@if $(AM_V_P); then $(MAKEINDEX) -o $.ind $.idx; else \
	echo " MAKEINDEX " $.ind $.idx; $(MAKEINDEX) -q -o $.ind $.idx; fi
	endif MAKEINDEX_AVAILABLE
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; else \
	echo " PDFLATEX " $<; TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; fi
	@if $(AM_V_P); then \
	if grep -s 'Rerun to get cross-references right.' $*.log; then \
	TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; \
	fi; else \
	if grep -s 'Rerun to get cross-references right.' $*.log >/dev/null; then \
	echo " PDFLATEX " $< "(for cross-references)"; \
	TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; \
	fi; \
	fi
	endif CONTEXT_AVAILABLE
	endif PDFLATEX_AVAILABLE
	endif DISTRIBUTION

	if DISTRIBUTION
	if CONTEXT_AVAILABLE
	if PDFLATEX_AVAILABLE
	if !NOWEB_AVAILABLE
	circe1.pdf: $(PICTURES_PDF) dist.1
	else NOWEB_AVAILABLE
	circe1.pdf: $(PICTURES_PDF) dist.1 circe1.tex
	endif NOWEB_AVAILABLE
	endif PDFLATEX_AVAILABLE
	endif CONTEXT_AVAILABLE
	endif DISTRIBUTION


	########################################################################

	## Cleanup tasks
	mostlyclean-latex:
	-rm -f .data .mpx .[1-9] .t[1-9] circe.mp preview.mp \
	circe1.tex .out .log .aux .idx .ilg .ind *.toc \
	$(PICTURES_PDF) tex-comments circe1_plot *.dat dist.mp \
	fit.mp dist.11 dist.12 dist.13 dist.14
	-test "$(srcdir)" != "." && rm -f $(PDFS)
	clean-latex:
	maintainer-clean-latex:
	-rm -f $(PDFS)
	if NOWEB_AVAILABLE
	mostlyclean-circe1:
	-test "$(srcdir)" != "." && rm -f $(PDFS)
	maintainer-clean-circe1:
	else
	mostlyclean-circe1:
	maintainer-clean-circe1:
	endif
	.PHONY: mostlyclean-latex clean-latex maintainer-clean-latex
	.PHONY: mostlyclean-circe1 maintainer-clean-circe1

	## Remove backup files
	maintainer-clean-backup:
	-rm -f *~
	.PHONY: maintainer-clean-backup

	## Register additional clean targets
	mostlyclean-local: mostlyclean-latex mostlyclean-circe1
	clean-local: clean-latex
	maintainer-clean-local: maintainer-clean-backup \
	maintainer-clean-circe1 maintainer-clean-latex

	if !DISTRIBUTION
	install-data-hook:
	-$(INSTALL) -m 644 circe1.pdf $(DESTDIR)$(datarootdir)/doc/circe1

	uninstall-hook:
	-rm -f $(DESTDIR)/$(datarootdir)/doc/circe1/circe1.pdf
	endif

	########################################################################
	## The End.
	########################################################################

	Index: trunk/circe2/share/doc/Makefile.am
	===================================================================
	--- trunk/circe2/share/doc/Makefile.am (revision 8883)
	+++ trunk/circe2/share/doc/Makefile.am (revision 8884)
	@@ -1,237 +1,237 @@
	# Makefile.am --
	##
	## Process this file with automake to produce Makefile.in
	##
	########################################################################
	#
	# Copyright (C) 1999-2023 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.
	#
	########################################################################

	DISTCLEANFILES =

	include $(top_srcdir)/circe2/src/Makefile.sources

	VPATH = $(srcdir):$(top_builddir)/circe2/src:$(srcdir):$(top_srcdir)/circe2/src

	WEBS = prelude.nw circe2.nw postlude.nw

	if DISTRIBUTION
	PDFS = circe2.pdf
	else
	PDFS =
	endif

	LATEX_STYLES = \
	emp.sty noweb.sty thohacks.sty thopp.sty ocamlweb.sty

	-TEX_FLAGS = "$$TEXINPUTS:$(top_srcdir)/circe2/share/doc"
	-MP_FLAGS = "$$MPINPUTS:$(top_srcdir)/circe2/share/doc"
	+TEX_FLAGS = "$(top_srcdir)/circe2/share/doc:$$TEXINPUTS"
	+MP_FLAGS = "$(top_srcdir)/circe2/share/doc:$$MPINPUTS"

	CIRCE2_HISTOS = \
	x.20.histo x.20m.histo x.20q.histo x.20qm.histo x.input.histo \
	z.20.histo z.20m2.histo z.20m.histo z.20q.histo z.20qm.histo \
	z.50m2.histo z.input.histo \
	z_low.20.histo z_low.20m2.histo z_low.20m.histo z_low.20q.histo \
	z_low.20qm.histo z_low.50.histo z_low.50m2.histo z_low.50q.histo \
	z_low.input.histo

	CIRCE2_HISTOSDATA = $(CIRCE2_HISTOS:.histo=.data)

	DISTCLEANFILES += $(CIRCE2_HISTOS)

	EXTRA_DIST = \
	tex-comments.sh \
	$(LATEX_STYLES) \
	$(CIRCE2_HISTOSDATA)

	if DISTRIBUTION
	dist_doc_DATA = $(PDFS)
	endif

	if NOWEB_AVAILABLE
	pdf-local: circe2.pdf
	endif

	if NOWEB_AVAILABLE

	circe2.tex: $(WEBS)
	@if $(AM_V_P); then :; else echo " NOWEAVE " $@; fi
	$(AM_V_at)$(NOWEAVE) -filter ./tex-comments -delay -index \
	`for i in $^; do case $$i in *.nw) echo $$i;; esac done` \
	> $@

	circe2.tex: tex-comments

	endif NOWEB_AVAILABLE

	tex-comments: tex-comments.sh
	cp $< $@
	chmod +x $@

	.data.histo:
	@if $(AM_V_P); then :; else echo " CP " $@; fi
	$(AM_V_at)cp $< $@

	# preview.pdf: vegas.data vamp.data

	# vegas.data: vegas.d
	# cp $< $@
	#
	# vamp.data: vamp.d
	# cp $< $@

	SUFFIXES = \
	.mly .mll .ml .implementation .mli .interface \
	.data .histo .tex .pdf \
	.nw .dvi .eps .ps

	if !NOWEB_AVAILABLE

	circe2.pdf:

	else NOWEB_AVAILABLE

	circe2.pdf: $(CIRCE2_INTERFACE) $(CIRCE2_IMPLEMENTATION) \
	$(CIRCE2TOOL_IMPLEMENTATION) circe2.tex \
	index.tex $(CIRCE2_HISTOS)

	if DISTRIBUTION
	if OCAMLWEB_AVAILABLE

	.mll.implementation:
	@if $(AM_V_P); then :; else echo " OCAMLWEB " $@; fi
	$(AM_V_at)$(OCAMLWEB) --no-preamble --noweb --no-index $< >$@

	.mly.implementation:
	@if $(AM_V_P); then :; else echo " OCAMLWEB " $@; fi
	$(AM_V_at)$(OCAMLWEB) --no-preamble --noweb --no-index $< >$@

	.ml.implementation:
	@if $(AM_V_P); then :; else echo " OCAMLWEB " $@; fi
	$(AM_V_at)$(OCAMLWEB) --no-preamble --noweb --no-index $< >$@

	.mli.interface:
	@if $(AM_V_P); then :; else echo " OCAMLWEB " $@; fi
	$(AM_V_at)$(OCAMLWEB) --no-preamble --noweb --no-index $< >$@

	index.tex: $(CIRCE2_CAML) $(CIRCE2_DERIVED)
	@if $(AM_V_P); then :; else echo " OCAMLWEB " $@; fi
	$(AM_V_at)$(OCAMLWEB) --no-preamble --noweb $^ \| \
	sed -n '/\\ocwbeginindex{}/,/\\ocwendindex{}/p' >$@

	endif OCAMLWEB_AVAILABLE
	endif DISTRIBUTION

	endif NOWEB_AVAILABLE

	MPOST_LATEX = TEX=$(LATEX) TEXINPUTS=$(TEX_FLAGS) $(MPOST)

	if DISTRIBUTION
	if PDFLATEX_AVAILABLE
	if CONTEXT_AVAILABLE
	.tex.pdf:
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; else \
	echo " PDFLATEX " $<; TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; fi
	if MAKEINDEX_AVAILABLE
	@if $(AM_V_P); then $(MAKEINDEX) -o $.ind $.idx; else \
	echo " MAKEINDEX " $.ind $.idx; $(MAKEINDEX) -q -o $.ind $.idx; fi
	endif MAKEINDEX_AVAILABLE
	if MPOST_AVAILABLE
	@if $(AM_V_P); then test -r $.mp && $(MPOST_LATEX) $; else \
	echo " METAPOST " $.mp; test -r $.mp && $(MPOST_LATEX) $* >/dev/null; fi
	endif MPOST_AVAILABLE
	@if $(AM_V_P); then TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; else \
	echo " PDFLATEX " $<; TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; fi
	@if $(AM_V_P); then \
	if grep -s 'Rerun to get cross-references right.' $*.log; then \
	TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $<; \
	fi; else \
	if grep -s 'Rerun to get cross-references right.' $*.log >/dev/null; then \
	echo " PDFLATEX " $< "(for cross-references)"; \
	TEXINPUTS=$(TEX_FLAGS) $(PDFLATEX) $< >/dev/null; \
	fi; \
	fi
	endif CONTEXT_AVAILABLE
	endif PDFLATEX_AVAILABLE
	endif DISTRIBUTION

	## Cleanup tasks
	mostlyclean-latex:
	-rm -f .mpx .[1-9]* .t[1-9] circe.mp preview.mp \
	.out .log .aux .idx .ilg .ind tex-comments *.toc \
	circe2.tex
	clean-latex:
	maintainer-clean-latex:
	-rm $(PDFS)
	if NOWEB_AVAILABLE
	if OCAMLWEB_AVAILABLE
	mostlyclean-circe2:
	-test "$(srcdir)" != "." && rm -f $(PDFS)
	maintainer-clean-circe2:
	else
	mostlyclean-circe2:
	maintainer-clean-circe2:
	endif
	endif
	.PHONY: mostlyclean-latex clean-latex maintainer-clean-latex
	.PHONY: mostlyclean-circe2 maintainer-clean-circe2

	if OCAMLWEB_AVAILABLE
	mostlyclean-caml:
	-rm -f .interface .implementation index.tex
	else
	mostlyclean-caml:
	endif
	clean-caml:
	if OCAMLWEB_AVAILABLE
	maintainer-clean-caml:
	-rm -f .interface .implementation index.tex
	else
	maintainer-clean-caml:
	endif
	.PHONY: mostlyclean-caml clean-caml maintainer-clean-caml

	## Remove backup files
	maintainer-clean-backup:
	-rm -f *~
	.PHONY: maintainer-clean-backup

	## Register additional clean targets
	mostlyclean-local: mostlyclean-latex mostlyclean-circe2 \
	mostlyclean-caml
	clean-local: clean-latex clean-caml
	maintainer-clean-local: maintainer-clean-latex maintainer-clean-circe2 \
	maintainer-clean-caml maintainer-clean-backup

	if !DISTRIBUTION
	install-data-hook:
	-$(INSTALL) -m 644 circe2.pdf $(DESTDIR)$(datarootdir)/doc/circe2

	uninstall-hook:
	-rm -f $(DESTDIR)/$(datarootdir)/doc/circe2/circe2.pdf
	endif

	########################################################################
	## The End.
	########################################################################

File Metadata

Mime Type: text/x-diff
Expires: Tue, Nov 19, 9:20 PM (22 h, 42 m)
Storage Engine: blob
Storage Format: Raw Data
Storage Handle: 3806245
Default Alt Text: (827 KB)

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions